Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu
Online

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.056 Beiträge
 
Delphi 12 Athens
 
#6

Re: MessageBox und Timer(Messages)

  Alt 8. Okt 2006, 12:36
Speziell geht es um diese Funktionen.

BasicMessage sollte halt den aktuellen Thread sperren (solange angezeigt wird)
und bei BasicError muß alles stoppen.

Zum BasicError ist mir jetzt eingefallen, daß ich dort auch alle zum Prozess gehörenden Timer löschen und andere Threads pausieren lassen könnte (diese werden ja eh nicht mehr benötigt )


Hab aber gehofft, daß es 'ne "einfachere Möglichkeit gibt, ls das Fenser komplett selber zu machen (es sollte ja vorallem im selben Stil wie das "normale" Fehlerfenster erscheinen, was beim selbermachen nicht mehr so leicht is -.-''

Delphi-Quellcode:
Function BasicMessage(ResStringRec: PResStringRec): Boolean; Overload;
Function BasicMessage(ResStringRec: PResStringRec; P: PAnsiChar): Boolean; Overload;
Function BasicMessage(ResStringRec: PResStringRec; P: PWideChar): Boolean; Overload;
Function BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameA): Boolean; Overload;
Function BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameW): Boolean; Overload;
Procedure BasicError (ResStringRec: PResStringRec); Overload;
Procedure BasicError (ResStringRec: PResStringRec; P: PAnsiChar); Overload;
Procedure BasicError (ResStringRec: PResStringRec; P: PWideChar); Overload;
Procedure BasicError (ResStringRec: PResStringRec; Const Param: TFileNameA); Overload;
Procedure BasicError (ResStringRec: PResStringRec; Const Param: TFileNameW); Overload;



// die jeweiligen Funktionen mit PWideChar sind die Hauptfunktionen

  Procedure SystemHalt;
    Begin
      If Pointer(GetPropA(GlobalUCCMessageWindow, 'LogData')) <> nil Then Begin
        LogWrite(SystemLogModule, lSystemHalt or slFatalError, @System.ExitCode, SizeOf(LongInt));
        FinalizeLogging;
      End;
      {$IFDEF UseODS} OutputDebugStringA('SystemHalt'); {$ENDIF}
      System.Halt;
    End;

  Function BasicMessage(ResStringRec: PResStringRec): Boolean;
    Const PW: PWideChar = nil;
    Begin Result := BasicMessage(ResStringRec, PW); End;

  Function BasicMessage(ResStringRec: PResStringRec; P: PAnsiChar): Boolean;
    Var Buffer: Array[0..2047] of WideChar;
      i: Integer;

    Begin
      If P <> nil Then Begin
        i := Min(MultiByteToWideChar(0, 0, P, InvalidValue, nil, 0), High(Buffer));
        MultiByteToWideChar(0, 0, P, InvalidValue, @Buffer, i + 1);
        Buffer[i] := #0;
      End Else Buffer[0] := #0;
      Result := BasicMessage(ResStringRec, PWideChar(@Buffer));
    End;

  Function BasicMessage(ResStringRec: PResStringRec; P: PWideChar): Boolean;
    Var Buffer: Array[0..2047] of WideChar;
      FileName: TFileNameW;
      i, i2, i3: Integer;

    Begin
      If ResStringRec^.Identifier <= $0000FFFF Then
        i := LoadStringW(FindResourceHInstance(ResStringRec^.Module^), ResStringRec^.Identifier, Buffer, SizeOf(Buffer))
      Else Begin
        i := 0;
        While (i < High(Buffer)) and (PWideCharArray(ResStringRec^.Identifier)^[i] <> #0) do Inc(i);
        Internal_CopyMem(@Buffer, Pointer(ResStringRec^.Identifier), (i + 1) * 2);
      End;
      If P <> nil Then Begin
        i2 := 0;
        While (i2 <= High(Buffer)) and (PWideCharArray(P)^[i2] <> #0) do Inc(i2);
        i3 := i - 1;
        While (i3 >= 0) and (Buffer[i3] <> #0)
          and ((Buffer[i3] <> '%') or (Buffer[i3 + 1] <> 's')) do Dec(i3);
        If i3 >= 0 Then Begin
          If i2 > SizeOf(Buffer) - i3 Then i2 := SizeOf(Buffer) - i3;
          Internal_CopyMem(@Buffer[i3 + 2], @Buffer[i3 + i2], (i - i3 - 1) * 2);
          Internal_CopyMem(P, @Buffer[i3], i2 * 2);
        End;
      End;
      {$IFDEF DebugMode} LogWrite(ExceptionsData^.LogModule, lBasicMessage or slWarning, PWideChar(@Buffer)); {$ENDIF}
      {$IFDEF UseODS} OutputDebugStringW(@Buffer); {$ENDIF}
      GetModuleFileNameW(HInstance, @FileName, MAX_PATH);
      Result := MessageBoxExW(0, @Buffer, @FileName, MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2 or MB_TASKMODAL or scLanguageBMParam, scLanguageID) = idYes;
    End;

  Function BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameA): Boolean;
    Var ParamW: TFileNameW;

    Begin
      MultiByteToWideChar(0, 0, @Param, InvalidValue, @ParamW, MAX_PATH);
      Result := BasicMessage(ResStringRec, ParamW);
    End;

  Function BasicMessage(ResStringRec: PResStringRec; Const Param: TFileNameW): Boolean;
    Begin Result := BasicMessage(ResStringRec, PWideChar(@Param)); End;

  Procedure BasicError(ResStringRec: PResStringRec);
    Const PW: PWideChar = nil;
    Begin BasicError(ResStringRec, PW); End;

  Procedure BasicError(ResStringRec: PResStringRec; P: PAnsiChar);
    Var Buffer: Array[0..2047] of WideChar;
      i: Integer;

    Begin
      If P <> nil Then Begin
        i := Min(MultiByteToWideChar(0, 0, P, InvalidValue, nil, 0), High(Buffer));
        MultiByteToWideChar(0, 0, P, InvalidValue, @Buffer, i + 1);
        Buffer[i] := #0;
      End Else Buffer[0] := #0;
      BasicError(ResStringRec, PWideChar(@Buffer));
    End;

  Procedure BasicError(ResStringRec: PResStringRec; P: PWideChar);
    Var Buffer: Array[0..2047] of WideChar;
      FileName: TFileNameW;
      i, i2, i3: Integer;

    Begin
      If ResStringRec^.Identifier <= $0000FFFF Then
        i := LoadStringW(FindResourceHInstance(ResStringRec^.Module^), ResStringRec^.Identifier, Buffer, SizeOf(Buffer))
      Else Begin
        i := 0;
        While (i < High(Buffer)) and (PWideCharArray(ResStringRec^.Identifier)^[i] <> #0) do Inc(i);
        Internal_CopyMem(@Buffer, Pointer(ResStringRec^.Identifier), (i + 1) * 2);
      End;
      If P <> nil Then Begin
        i2 := 0;
        While (i2 <= High(Buffer)) and (PWideCharArray(P)^[i2] <> #0) do Inc(i2);
        i3 := i - 1;
        While (i3 >= 0) and (Buffer[i3] <> #0)
          and ((Buffer[i3] <> '%') or (Buffer[i3 + 1] <> 's')) do Dec(i3);
        If i3 >= 0 Then Begin
          If i2 > SizeOf(Buffer) - i3 Then i2 := SizeOf(Buffer) - i3;
          Internal_CopyMem(@Buffer[i3 + 2], @Buffer[i3 + i2], (i - i3 - 1) * 2);
          Internal_CopyMem(P, @Buffer[i3], i2 * 2);
        End;
      End;
      {$IFDEF DebugMode} LogWrite(ExceptionsData^.LogModule, lBasicError or slError, PWideChar(@Buffer)); {$ENDIF}
      {$IFDEF UseODS} OutputDebugStringW(@Buffer); {$ENDIF}
      GetModuleFileNameW(HInstance, @FileName, MAX_PATH);
      MessageBoxExW(0, @Buffer, @FileName, MB_OK or MB_ICONERROR or MB_TASKMODAL or scLanguageBMParam, scLanguageID);
      SystemHalt;
    End;

  Procedure BasicError(ResStringRec: PResStringRec; Const Param: TFileNameA);
    Var ParamW: TFileNameW;

    Begin
      MultiByteToWideChar(0, 0, @Param, InvalidValue, @ParamW, MAX_PATH);
      BasicError(ResStringRec, ParamW);
    End;

  Procedure BasicError(ResStringRec: PResStringRec; Const Param: TFileNameW);
    Begin BasicError(ResStringRec, PWideChar(@Param)); End;

[add]
das mit dem eigenem thread hab ich noch nicht bedacht

[add2]
bei BasicMessage wäre es wie schon erähnt nicht schön, wenn da Messages verloren gingen.
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.
  Mit Zitat antworten Zitat