NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA

[FarAndBeyond]

Hi,
Ich wollte ein Nachrichtenfenster bzw. Errorfenster bauen, dass man einfach überall verwenden kann und nur eine Prozedur in ein Projekt kopieren muss. Ich hab' mal 'nen Post gelesen von Mirage228 und so 'was hatte ich zuvor noch nie gesehen.

Das Fenster sollte folgende Eigenschaften haben:
1) Nur schließbar mit OK-Taste
2) Topmost
3) Modal
4) Und alles was man braucht (Funktionen, Events, Antialiasing) in einer einzigen Prozedur (praktisch und portable)

Dieser QuellCode lässt sich compilieren unter D7. (Nicht auf das ExceptionHandling achten, damit fang ich gerade erst an..)

Das CloseQueryEvent scheint auch zu funktionieren, da das Fenster nicht mit Alt+F4 geschlossen werden kann.
Das KeyDownEvent schein zumindest teilweise zu funktionieren, da ich erst die AccessViolation bekomme bei der richtigen Tastenkombi.
Und dann bleibt er bei form_Notify.Close stehen...

Weis jemand warum das passiert???

Delphi-Quellcode:

Procedure NotifyWindow(WindowText: String);
 Var
  form_Notify      : TForm;
  Panel            : TPanel;
  Memo             : TMemo;
  OK               : TLabel;
  event_CloseQuery : TCloseQueryEvent;
  event_KeyDown    : TKeyEvent;

  Procedure AAFont(ObjFont: TFont);
     Var
      LogFont: TLogFont;
   Begin
    Try
     GetObject(ObjFont.Handle, SizeOf(TLogFont), @LogFont);
     LogFont.lfQuality := ANTIALIASED_QUALITY;
     ObjFont.Handle := CreateFontIndirect(LogFont);
    Except
     Exit;
    End;
   End;

  Function GetKey(Keycode: Integer) : Boolean;
   Begin
    Try
     GetKey := GetAsyncKeyState(KeyCode) <> 0;
    Except
     Exit;
    End;
   End;

  Function OK_Pressed : Boolean;
   Begin
    Try
     If GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'))
     Then OK_Pressed := True
     Else OK_Pressed := False;
    Except
     Exit;
    End;
   End;

  Procedure KeyDown(Self, Sender: TObject; Var Key: Word; Shift: TShiftState);
   Begin
    If OK_Pressed = True Then form_Notify.Close;
   End;

  Procedure CloseQuery(Self, Sender: TObject; Var CanClose: Boolean);
   Begin
    Try
     If OK_Pressed = True
     Then CanClose := True
     Else CanClose := False;
    Except
     Exit;
    End;
   End;

// M A I N  ===========================================================================
 Begin
  Try
   Try
    TMethod(event_CloseQuery).Code := @CloseQuery;
    TMethod(event_CloseQuery).Data := Nil;
    TMethod(event_KeyDown).Code    := @KeyDown;
    TMethod(event_KeyDown).Data    := Nil;
    
    form_Notify              := TForm.Create(Nil);
    form_Notify.Caption      := 'NotifyWindow';
    form_Notify.Height       := 374;
    form_Notify.Width        := 583;
    form_Notify.BorderStyle  := bsSingle;
    form_Notify.BorderIcons  := [];
    form_Notify.Color        := 898061;
    form_Notify.FormStyle    := fsStayOnTop;
    form_Notify.Left         := (Screen.Width  - form_Notify.Width)  Div 2;
    form_Notify.Top          := (Screen.Height - form_Notify.Height) Div 2;
    form_Notify.OnCloseQuery := event_CloseQuery;
    form_Notify.OnKeyDown    := event_KeyDown;

    Panel             := TPanel.Create(Nil);
    Panel.Borderstyle := bsNone;
    Panel.Color       := 898061;
    Panel.Enabled     := False;
    Panel.Height      := 296;
    Panel.Width       := 549;
    Panel.Left        := 14;
    Panel.Top         := 17;
    Panel.Parent      := form_Notify;

    Memo             := TMemo.Create(Nil);
    Memo.Alignment   := taLeftJustify;
    Memo.BorderStyle := bsSingle;
    Memo.Color       := 898061;
    Memo.Font.Color  := clBlack;
    Memo.Font.Size   := 14;
    Memo.Font.Name   := 'VerdanaB';
    Memo.Font.Style  := [fsBold];
    Memo.Height      := 284;
    Memo.Width       := 537;
    Memo.Left        := 6;
    Memo.Top         := 6;
    Memo.ReadOnly    := True;
    Memo.ScrollBars  := ssNone;
    Memo.Parent      := Panel;
    Memo.Text        := WindowText;

    OK            := TLabel.Create(Nil);
    OK.Caption    := 'CTRL + ALT + O + K';
    OK.Color      := 898061;
    OK.Font.Color := clBlue;
    OK.Font.Name  := 'VerdanaB';
    OK.Font.Size  := 14;
    OK.Font.Style := [fsBold];
    OK.AutoSize   := True;
    OK.Left       := 375;
    OK.Top        := 317;
    OK.Parent     := form_Notify;

    AAFont(Memo.Font);
    AAFont(OK.Font);
    form_Notify.ShowModal;
   Finally
    FreeAndNil(OK);
    FreeAndNil(Memo);
    FreeAndNil(Panel);
    FreeAndNil(form_Notify);
   End;
  Except;
   Exit;
  End;
 End;

Procedure TForm1.Button1Click(Sender: TObject);
 Begin
  NotifyWindow('Coole Sache !!!' +#13#10+ 'Haaa, Das is` ja`n Ding!!!');
 End;

So kann man das natürlich auch machen, aber das ist nicht so praktisch und ich brauche 'ne globale Variable, sonst kennt er form_Notify nicht.
Das hab' ich mal gesehen in einem Post von Omata... funktioniert gut.

Delphi-Quellcode:

 Type
  TEvents = Class
   Class Procedure CloseQuery(Sender: TObject; Var CanClose: Boolean);
   Class Procedure KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 End;

Class Procedure TEvents.CloseQuery(Sender: TObject; Var CanClose: Boolean);
 Begin
  Try
   If OK_Pressed = True
   Then CanClose := True
   Else CanClose := False;
  Except
   Exit;
  End;
 End;

Class Procedure TEvents.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 Begin
  If OK_Pressed = True Then form_Notify.Close; //globale Variable !!!
 End;

Früher hab' ich immer bei FormKeyDown "If Sender = form_Notify Then...." benutzt, aber da brauche ich auch 'ne globale Variable oder???
Gut, für das Panel braucht man noch "uses ExtCtrls"...

Gruß
Martin

[FarAndBeyond]

Hi,
tja, was ich auch mache das klappt bei mir nicht...
Also hab' ich jetzt einfach 'ne Unit daraus gemacht und die ist ja auch sehr praktisch... grins...
Das funzt wenigstens immer...

Wie schon erwähnt... nicht auf das ExceptionHandling achten...

Delphi-Quellcode:

Unit uNotifyWindow;

Interface

 Uses Windows, Forms, Classes, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls;

 Type
  TNotifyWindow = Class
   Class Procedure CloseQuery(Sender: TObject; Var CanClose: Boolean);
   Class Procedure KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);

   Public
    Class Procedure Show(WindowTitle: String; WindowText: String);
  End;

 Var
  form_Notify : TForm;

Implementation


Function GetKey(Keycode: Integer) : Boolean;
 Begin
  Try
   GetKey := GetAsyncKeyState(KeyCode) <> 0;
  Except
   Exit;
  End;
 End;


Function OK_Pressed : Boolean;
 Begin
  Try
   If GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'))
   Then OK_Pressed := True
   Else OK_Pressed := False;
  Except
   Exit;
  End;
 End;


Class Procedure TNotifyWindow.CloseQuery(Sender: TObject; Var CanClose: Boolean);
 Begin
  Try
   If OK_Pressed  = True
   Then CanClose := True
   Else CanClose := False;
  Except
   Exit;
  End;
 End;


Class Procedure TNotifyWindow.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 Begin
  Try
   If OK_Pressed = True Then form_Notify.Close;
  Except
   Exit;
  End;
 End;


Class Procedure TNotifyWindow.Show(WindowTitle: String; WindowText: String);
  Var
   panel_BehindMemo : TPanel;
   memo_Text        : TMemo;
   label_OKTaste    : TLabel;


  Procedure AAFont(ObjFont: TFont);
    Var
     LogFont: TLogFont;
   Begin
    Try
     GetObject(ObjFont.Handle, SizeOf(TLogFont), @LogFont);
     LogFont.lfQuality := ANTIALIASED_QUALITY;
     ObjFont.Handle := CreateFontIndirect(LogFont);
    Except
     Exit;
    End;
   End;

 Begin
  Try
   Try
    form_Notify              := TForm.Create(Nil);
    form_Notify.Caption      := WindowTitle;
    form_Notify.Height       := 374;
    form_Notify.Width        := 583;
    form_Notify.BorderStyle  := bsSingle;
    form_Notify.BorderIcons  := [];
    form_Notify.Color        := 898061;
    form_Notify.FormStyle    := fsStayOnTop;
    form_Notify.Left         := (Screen.Width  - form_Notify.Width)  Div 2;
    form_Notify.Top          := (Screen.Height - form_Notify.Height) Div 2;
    form_Notify.OnCloseQuery := TNotifyWindow.CloseQuery;
    form_Notify.OnKeyDown    := TNotifyWindow.KeyDown;

    panel_BehindMemo             := TPanel.Create(form_Notify);
    panel_BehindMemo.Borderstyle := bsNone;
    panel_BehindMemo.Color       := 898061;
    panel_BehindMemo.Enabled     := False;
    panel_BehindMemo.Height      := 296;
    panel_BehindMemo.Width       := 549;
    panel_BehindMemo.Left        := 14;
    panel_BehindMemo.Top         := 17;
    panel_BehindMemo.Parent      := form_Notify;

    memo_Text             := TMemo.Create(form_Notify);
    memo_Text.Alignment   := taLeftJustify;
    memo_Text.BorderStyle := bsSingle;
    memo_Text.Color       := 898061;
    memo_Text.Font.Color  := clBlack;
    memo_Text.Font.Size   := 14;
    memo_Text.Font.Name   := 'VerdanaB';
    memo_Text.Font.Style  := [fsBold];
    memo_Text.Height      := 284;
    memo_Text.Width       := 537;
    memo_Text.Left        := 6;
    memo_Text.Top         := 6;
    memo_Text.ReadOnly    := True;
    memo_Text.ScrollBars  := ssNone;
    memo_Text.Parent      := panel_BehindMemo;
    memo_Text.Text        := WindowText;

    label_OKTaste            := TLabel.Create(form_Notify);
    label_OKTaste.Caption    := 'CTRL + ALT + O + K';
    label_OKTaste.Color      := 898061;
    label_OKTaste.Font.Color := clBlue;
    label_OKTaste.Font.Name  := 'VerdanaB';
    label_OKTaste.Font.Size  := 14;
    label_OKTaste.Font.Style := [fsBold];
    label_OKTaste.AutoSize   := True;
    label_OKTaste.Left       := 375;
    label_OKTaste.Top        := 317;
    label_OKTaste.Parent     := form_Notify;

    AAFont(memo_Text.Font);
    AAFont(label_OKTaste.Font);
    form_Notify.ShowModal;
   Finally
    FreeAndNil(form_Notify);
   End;
  Except;
   Exit;
  End;
 End;

End.

Gruß
Martin

[FarAndBeyond]

Ich glaub' so ist das noch viel besser... grins.... in 100 Jahren ist die Unit vielleicht perfekt...

Delphi-Quellcode:

Unit uNotifyWindow;

Interface

 Uses Windows, Forms, Classes, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls;

 Type
  NotifyWindow = Class
   Class Procedure CloseQuery(Sender: TObject; Var CanClose: Boolean);
   Class Procedure KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
   
   Public
    Class Procedure Show(WindowTitle: String; WindowText: String);
  End;

 Var
  form_Notify   : TForm;
  boolean_Close : Boolean = False;

Implementation


Procedure ErrorLog(ErrorInfo: String);
  Var
   LogFile        : TStringlist;
   LoadedFile     : TStringlist;
   boolean_Loaded : Boolean;

  Procedure LoadErrorLog;
   Begin
    Try
     boolean_Loaded := False;
     If FileExists('ErrorLog.txt')
     Then
      Begin
       LoadedFile := TStringlist.Create;
       LoadedFile.LoadFromFile('ErrorLog.txt');
       boolean_Loaded := True;
      End;
    Except
     Exit;
    End;
   End;

  Procedure Free_LogFile;
   Begin
    Try
     FreeAndNil(LogFile);
    Except
     Exit;
    End;
   End;

  Procedure Free_LoadedFile;
   Begin
    Try
     FreeAndNil(LoadedFile);
    Except
     Exit;
    End;
   End;

 Begin
  LoadErrorLog;
   Try
    LogFile:= TStringlist.Create;
     Try
      If boolean_Loaded = True
      Then
       Begin
        LogFile.Add(ErrorInfo);
        LogFile.Text := LogFile.Text + LoadedFile.Text;
        Free_LoadedFile;
       End
      Else
       Begin
        LogFile.Add(ErrorInfo);
       End;

      LogFile.SaveToFile('ErrorLog.txt');
     Finally
      Free_LogFile;
     End;
   Except
    Free_LoadedFile;
    Exit;
   End;
 End;


Procedure Free_MainForm;
 Begin
  Try
   FreeAndNil(form_Notify);
  Except
   Exit;
  End;
 End;


Procedure Close_MainForm;
 Begin
  Try
   boolean_Close := True;
   form_Notify.Close;
  Except
   Exit;
  End;
 End;


Function GetKey(Keycode: Integer) : Boolean;
 Begin
  Try
   GetKey := GetAsyncKeyState(KeyCode) <> 0;
  Except
   ErrorLog('uNotifyWindow: Function GetKey (GetAsyncKeyState) Failed');
   Close_MainForm;
   Exit;
  End;
 End;


Function OK_Pressed : Boolean;
 Begin
  Try
   If GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'))
   Then OK_Pressed := True
   Else OK_Pressed := False;
  Except
   ErrorLog('uNotifyWindow: Function OK_Pressed (GetAsyncKeyState) Failed');
   Close_MainForm;
   Exit;
  End;
 End;


Class Procedure NotifyWindow.CloseQuery(Sender: TObject; Var CanClose: Boolean);
 Begin
  Try
   If OK_Pressed  = True
   Then CanClose := True
   Else CanClose := False;

   If boolean_Close = True Then CanClose := True;
  Except
   ErrorLog('uNotifyWindow: OnCloseQuery Failed');
   Close_MainForm;
   Exit;
  End;
 End;


Class Procedure NotifyWindow.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 Begin
  Try
   If OK_Pressed = True Then form_Notify.Close;
  Except
   ErrorLog('uNotifyWindow: OnKeyDown Failed');
   Close_MainForm;
   Exit;
  End;
 End;


Class Procedure NotifyWindow.Show(WindowTitle: String; WindowText: String);
  Var
   panel_BehindMemo : TPanel;
   memo_Text        : TMemo;
   label_OKTaste    : TLabel;

  Procedure AAFont(ObjFont: TFont);
    Var
     LogFont: TLogFont;
   Begin
    Try
     GetObject(ObjFont.Handle, SizeOf(TLogFont), @LogFont);
     LogFont.lfQuality := ANTIALIASED_QUALITY;
     ObjFont.Handle := CreateFontIndirect(LogFont);
    Except
     Exit;
    End;
   End;

 Begin
  Try
   Try
    form_Notify              := TForm.Create(Nil);
    form_Notify.Caption      := WindowTitle;
    form_Notify.Height       := 374;
    form_Notify.Width        := 583;
    form_Notify.BorderStyle  := bsSingle;
    form_Notify.BorderIcons  := [];
    form_Notify.Color        := 898061;
    form_Notify.FormStyle    := fsStayOnTop;
    form_Notify.Left         := (Screen.Width  - form_Notify.Width)  Div 2;
    form_Notify.Top          := (Screen.Height - form_Notify.Height) Div 2;
    form_Notify.OnCloseQuery := NotifyWindow.CloseQuery;
    form_Notify.OnKeyDown    := NotifyWindow.KeyDown;

    panel_BehindMemo             := TPanel.Create(form_Notify);
    panel_BehindMemo.Borderstyle := bsNone;
    panel_BehindMemo.Color       := 898061;
    panel_BehindMemo.Enabled     := False;
    panel_BehindMemo.Height      := 296;
    panel_BehindMemo.Width       := 549;
    panel_BehindMemo.Left        := 14;
    panel_BehindMemo.Top         := 17;
    panel_BehindMemo.Parent      := form_Notify;

    memo_Text             := TMemo.Create(form_Notify);
    memo_Text.Alignment   := taLeftJustify;
    memo_Text.BorderStyle := bsSingle;
    memo_Text.Color       := 898061;
    memo_Text.Font.Color  := clBlack;
    memo_Text.Font.Size   := 14;
    memo_Text.Font.Name   := 'Verdana';
    memo_Text.Font.Style  := [fsBold];
    memo_Text.Height      := 284;
    memo_Text.Width       := 537;
    memo_Text.Left        := 6;
    memo_Text.Top         := 6;
    memo_Text.ReadOnly    := True;
    memo_Text.ScrollBars  := ssNone;
    memo_Text.Parent      := panel_BehindMemo;
    memo_Text.Text        := WindowText;

    label_OKTaste            := TLabel.Create(form_Notify);
    label_OKTaste.Caption    := 'CTRL + ALT + O + K';
    label_OKTaste.Color      := 898061;
    label_OKTaste.Font.Color := clBlue;
    label_OKTaste.Font.Name  := 'Arial';
    label_OKTaste.Font.Size  := 14;
    label_OKTaste.Font.Style := [fsBold];
    label_OKTaste.AutoSize   := True;
    label_OKTaste.Left       := 375;
    label_OKTaste.Top        := 317;
    label_OKTaste.Parent     := form_Notify;

    AAFont(memo_Text.Font);
    AAFont(label_OKTaste.Font);
    form_Notify.ShowModal;
   Finally
    Free_MainForm;
   End;
  Except;
   ErrorLog('uNotifyWindow: OnShow Failed');
   Exit;
  End;
 End;
  

End.

[HolgerX]

Wozu Globale form_Notify ?

Delphi-Quellcode:

Class Procedure NotifyWindow.CloseQuery(Sender: TObject; Var CanClose: Boolean);
 Begin
  Try
   If OK_Pressed = True
   Then CanClose := True
   Else CanClose := False;

   If boolean_Close = True Then CanClose := True;
  Except
   ErrorLog('uNotifyWindow: OnCloseQuery Failed');
   Close_MainForm;
   Exit;
  End;
 End;


Class Procedure NotifyWindow.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 Begin
  Try
   If OK_Pressed = True Then form_Notify.Close;
  Except
   ErrorLog('uNotifyWindow: OnKeyDown Failed');
   Close_MainForm;
   Exit;
  End;
 End;

Was meinst Du wer 'Sender' ist?

Richtig, deine Form!

Also mach z.B. aus

Delphi-Quellcode:

Procedure Close_MainForm;
 Begin
  Try
   boolean_Close := True;
   form_Notify.Close;
  Except
   Exit;
  End;
 End;

Delphi-Quellcode:

Procedure Close_MainForm(AForm : TForm);
 Begin
  Try
   boolean_Close := True;
   AForm.Close;
  Except
   Exit;
  End;
 End;

Class Procedure NotifyWindow.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 Begin
  Try
   If OK_Pressed = True Then TForm(Sender).Close;
  Except
   ErrorLog('uNotifyWindow: OnKeyDown Failed');
   Close_MainForm(TForm(Sender));
   Exit;
  End;
 End;

Und schon hat sich deine Globale Form erledigt..

und packe dann

Delphi-Quellcode:

Var
  form_Notify : TForm;

in deine

Class Procedure Show(WindowTitle: String; WindowText: String);

als lokale Variable....

[blawen]

Noch eine (weitere) kleine Randbemerkung:

Mach aus

Delphi-Quellcode:

If OK_Pressed = True then...

lieber ein

Delphi-Quellcode:

If OK_Pressed then...

[DeddyH]

Und noch eine:

Zitat:

Delphi-Quellcode:

   If OK_Pressed = True
   Then CanClose := True
   Else CanClose := False;

   If boolean_Close = True Then CanClose := True;

Das entspricht doch

Delphi-Quellcode:

CanClose := OK_Pressed or boolean_Close;

, genauso wie

Zitat:

Delphi-Quellcode:

If GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'))
   Then OK_Pressed := True
   Else OK_Pressed := False;

sich auf

Delphi-Quellcode:

OK_Pressed := GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'));

zusammenkürzen lässt, und zwar ohne die fehlerträchtigen Boolean-Vergleiche ;)

[FarAndBeyond]

Stimmt man kann tatsächlich eine Globale VAR weglassen, ist mir gar nicht aufgefallen. Dazu musste ich einiges hin und herschieben...

@HolgerX:
Wenn die Funktionen ohne Sender VAR in die KeyDown-Prozedur geschoben werden dann geht's...
Oder kann man Funktionen auch 'ne Sender VAR verpassen ??
Danke, ist viel besser so, hat 'ne Weile gedauert bis ich das gesehen hab'...

@blawen:
Danke, so ähnlich wie bei Visible:=True und Show...

@DeddyH:
Danke, hab' ich total übersehen... ist auch optisch viel besser...
Der Compiler gibt immer noch 'ne Warnung 'raus "möglicher undefinierter Result", bei den beiden Funktionen... weis der Geier was da undefiniert sein soll, außerdem funktioniert das so sehr gut...
Zuerst dachte ich das liegt vielleicht an Result, dann hab' ich mal Result eingebaut, aber die Warnung kommt trotzdem(D7).

Jetzt sieht die Unit so aus:

Delphi-Quellcode:

Unit uNotifyWindow;

Interface

 Uses Windows, Forms, Classes, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls;

 Type
  NotifyWindow = Class
   Class Procedure CloseQuery(Sender: TObject; Var CanClose: Boolean);
   Class Procedure KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);

   Public
    Class Procedure Show(WindowTitle: String; WindowText: String);
  End;

 Var
  boolean_CanExit : Boolean = False;

Implementation


Procedure ErrorLog(ErrorInfo: String);
  Var
   LogFile        : TStringlist;
   LoadedFile     : TStringlist;
   boolean_Loaded : Boolean;

  Procedure LoadErrorLog;
   Begin
    Try
     boolean_Loaded := False;
     If FileExists('ErrorLog.txt')
     Then
      Begin
       LoadedFile := TStringlist.Create;
       LoadedFile.LoadFromFile('ErrorLog.txt');
       boolean_Loaded := True;
      End;
    Except
     Exit;
    End;
   End;

  Procedure Free_LogFile;
   Begin
    Try
     FreeAndNil(LogFile);
    Except
     Exit;
    End;
   End;

  Procedure Free_LoadedFile;
   Begin
    Try
     FreeAndNil(LoadedFile);
    Except
     Exit;
    End;
   End;

 Begin
  LoadErrorLog;
   Try
    LogFile:= TStringlist.Create;
     Try
      If boolean_Loaded = True
      Then
       Begin
        LogFile.Add(ErrorInfo);
        LogFile.Text := LogFile.Text + LoadedFile.Text;
        Free_LoadedFile;
       End
      Else
       Begin
        LogFile.Add(ErrorInfo);
       End;

      LogFile.SaveToFile('ErrorLog.txt');
     Finally
      Free_LogFile;
     End;
   Except
    Free_LoadedFile;
    Exit;
   End;
 End;


Procedure Close_MainForm(AForm: TForm);
 Begin
  Try
   boolean_CanExit := True;
   AForm.Close;
  Except
   Exit;
  End;
 End;


Class Procedure NotifyWindow.CloseQuery(Sender: TObject; Var CanClose: Boolean);
 Begin
  Try
   CanClose := boolean_CanExit;
  Except
   ErrorLog('uNotifyWindow: OnCloseQuery Failed');
   Close_MainForm(TForm(Sender));
   Exit;
  End;
 End;


Class Procedure NotifyWindow.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);

  Function GetKey(Keycode: Integer) : Boolean;
   Begin
    Try
     GetKey := GetAsyncKeyState(KeyCode) <> 0;
    Except
     ErrorLog('uNotifyWindow: Function GetKey (GetAsyncKeyState) Failed');
     Close_MainForm(TForm(Sender));
     Exit;
    End;
   End;

  Function OK_Pressed : Boolean;
   Begin
    Try
     OK_Pressed := GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'));
    Except
     ErrorLog('uNotifyWindow: Function OK_Pressed (GetAsyncKeyState) Failed');
     Close_MainForm(TForm(Sender));
     Exit;
    End;
   End;

 Begin
  Try
   If OK_Pressed
   Then
    Begin
     boolean_CanExit := True;
     TForm(Sender).Close;
    End;
  Except
   ErrorLog('uNotifyWindow: OnKeyDown Failed');
   Close_MainForm(TForm(Sender));
   Exit;
  End;
 End;


Class Procedure NotifyWindow.Show(WindowTitle: String; WindowText: String);
  Var
   form_Notify      : TForm;
   panel_BehindMemo : TPanel;
   memo_Text        : TMemo;
   label_OKTaste    : TLabel;

  Procedure Free_MainForm;
   Begin
    Try
     FreeAndNil(form_Notify);
    Except
     Exit;
    End;
   End;

  Procedure AAFont(ObjFont: TFont);
    Var
     LogFont: TLogFont;
   Begin
    Try
     GetObject(ObjFont.Handle, SizeOf(TLogFont), @LogFont);
     LogFont.lfQuality := ANTIALIASED_QUALITY;
     ObjFont.Handle := CreateFontIndirect(LogFont);
    Except
     Exit;
    End;
   End;

 Begin
  Try
   Try
    form_Notify              := TForm.Create(Nil);
    form_Notify.Caption      := WindowTitle;
    form_Notify.Height       := 374;
    form_Notify.Width        := 583;
    form_Notify.BorderStyle  := bsSingle;
    form_Notify.BorderIcons  := [];
    form_Notify.Color        := 898061;
    form_Notify.FormStyle    := fsStayOnTop;
    form_Notify.Left         := (Screen.Width  - form_Notify.Width)  Div 2;
    form_Notify.Top          := (Screen.Height - form_Notify.Height) Div 2;
    form_Notify.OnCloseQuery := NotifyWindow.CloseQuery;
    form_Notify.OnKeyDown    := NotifyWindow.KeyDown;

    panel_BehindMemo             := TPanel.Create(form_Notify);
    panel_BehindMemo.Borderstyle := bsNone;
    panel_BehindMemo.Color       := 898061;
    panel_BehindMemo.Enabled     := False;
    panel_BehindMemo.Height      := 296;
    panel_BehindMemo.Width       := 549;
    panel_BehindMemo.Left        := 14;
    panel_BehindMemo.Top         := 17;
    panel_BehindMemo.Parent      := form_Notify;

    memo_Text             := TMemo.Create(form_Notify);
    memo_Text.Alignment   := taLeftJustify;
    memo_Text.BorderStyle := bsSingle;
    memo_Text.Color       := 898061;
    memo_Text.Font.Color  := clBlack;
    memo_Text.Font.Size   := 14;
    memo_Text.Font.Name   := 'Verdana';
    memo_Text.Font.Style  := [fsBold];
    memo_Text.Height      := 284;
    memo_Text.Width       := 537;
    memo_Text.Left        := 6;
    memo_Text.Top         := 6;
    memo_Text.ReadOnly    := True;
    memo_Text.ScrollBars  := ssNone;
    memo_Text.Parent      := panel_BehindMemo;
    memo_Text.Text        := WindowText;

    label_OKTaste            := TLabel.Create(form_Notify);
    label_OKTaste.Caption    := 'CTRL + ALT + O + K';
    label_OKTaste.Color      := 898061;
    label_OKTaste.Font.Color := clBlue;
    label_OKTaste.Font.Name  := 'Arial';
    label_OKTaste.Font.Size  := 14;
    label_OKTaste.Font.Style := [fsBold];
    label_OKTaste.AutoSize   := True;
    label_OKTaste.Left       := 375;
    label_OKTaste.Top        := 317;
    label_OKTaste.Parent     := form_Notify;

    AAFont(memo_Text.Font);
    AAFont(label_OKTaste.Font);
    form_Notify.ShowModal;
   Finally
    Free_MainForm;
   End;
  Except;
   ErrorLog('uNotifyWindow: OnShow Failed');
   Exit;
  End;
 End;

End.

[FarAndBeyond]

So ist das noch besser:

- ErrorLog gepimpt ... grins
- keine Globale mehr
- Meldungsfenster mit ScrollFunktion

Naja, ein Meldungsfenster eben, nicht mehr und nicht weniger...

Delphi-Quellcode:

Unit uNotifyWindow;

Interface
 Uses Windows, Messages, Forms, Classes, SysUtils, Graphics, Controls, StdCtrls;

 Type
  NotifyWindow = Class
   Class Procedure KeyDown   (Sender: TObject; Var Key: Word; Shift: TShiftstate);

    Public
     Class Procedure Show    (WindowTitle: String; WindowText: String);
  End;

 Type
  WheelMemo = Class(TMemo)
   Class Procedure WheelUp   (Sender: TObject; Shift: TShiftState; MousePos: TPoint; Var Handled: Boolean);
   Class Procedure WheelDown (Sender: TObject; Shift: TShiftState; MousePos: TPoint; Var Handled: Boolean);
   Class Procedure KeyDown   (Sender: TObject; Var Key: Word; Shift: TShiftstate);
   Class Procedure NoMenu    (Sender: TObject; MousePos: TPoint; Var Handled: Boolean);

    Protected
     Procedure WMSetFocus    (Var MSG: TWMSETFOCUS); Message WM_SETFOCUS;
  End;

Implementation


Procedure ErrorLog(ErrorInfo: String);
  Var
   LoadErrorLog : TStringlist;
   SaveErrorInfo: TStringlist;
   ErrorLog     : String;

  Procedure Free_LoadErrorLog;
   Begin
    Try
     FreeAndNil(LoadErrorLog);
    Except
     Exit;
    End;
   End;

  Procedure Free_SaveErrorInfo;
   Begin
    Try
     FreeAndNil(SaveErrorInfo);
    Except
     Exit;
    End;
   End;

  Function ErrorLogExists : Boolean;
   Begin
    Try
     Result:= False;
      If FileExists('ErrorLog.txt')
      Then
       Begin
        Try
         LoadErrorLog:= TStringlist.Create;
         LoadErrorLog.LoadFromFile('ErrorLog.txt');
         ErrorLog:= LoadErrorLog.Text;
         Result:= True;
        Finally
         Free_LoadErrorLog;
        End;
       End;
    Except
     Exit;
    End;
   End;

 Begin
  Try
   Try
    SaveErrorInfo:= TStringlist.Create;
     SaveErrorInfo.Add(DateTimeToStr(Now));
     SaveErrorInfo.Add(ErrorInfo);
     
      If ErrorLogExists
      Then
       Begin
        SaveErrorInfo.Add(' ');
        SaveErrorInfo.Add(Trim(ErrorLog));
       End;

     SaveErrorInfo.SaveToFile('ErrorLog.txt');
   Finally
    Free_SaveErrorInfo;
   End;
  Except
   Exit;
  End;
 End;


Procedure Close_ErrorWindow(AForm: TForm);
 Begin
  Try
   AForm.Close;
  Except
   ErrorLog('uNotifyWindow: Close_ErrorWindow Failed');
   Exit;
  End;
 End;


Procedure WheelMemo.WMSetFocus(Var MSG: TWMSETFOCUS);
 Begin
  Try
   If MSG.Msg = WM_SETFOCUS
   Then HideCaret(Self.Handle)
   Else Inherited;
  Except
   ErrorLog('uNotifyWindow: WheelMemo.WMSetFocus Failed');
   Exit;
  End;
 End;


Class Procedure WheelMemo.NoMenu(Sender: TObject; MousePos: TPoint; Var Handled: Boolean);
 Begin
  Try
   Handled:= True;
  Except
   ErrorLog('uNotifyWindow: WheelMemo.NoMenu Failed');
   Exit;
  End;
 End;


Class Procedure WheelMemo.WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; Var Handled: Boolean);
 Begin
  Try
   If Sender Is WheelMemo
   Then WheelMemo(Sender).Perform(EM_SCROLL,SB_LINEDOWN,0);
  Except
   ErrorLog('uNotifyWindow: WheelMemo.WheelDown Failed');
   Exit;
  End;
 End;


Class Procedure WheelMemo.WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; Var Handled: Boolean);
 Begin
  Try
   If Sender Is WheelMemo
   Then WheelMemo(Sender).Perform(EM_SCROLL,SB_LINEUP,0);
  Except
   ErrorLog('uNotifyWindow: WheelMemo.WheelUp Failed');
   Exit;
  End;
 End;


Class Procedure WheelMemo.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);
 Begin
  Try
   Key:= 0;
  Except
   ErrorLog('uNotifyWindow: WheelMemo.KeyDown Failed');
   Exit;
  End;
 End;


Class Procedure NotifyWindow.KeyDown(Sender: TObject; Var Key: Word; Shift: TShiftstate);

  Function GetKey(Keycode: Integer) : Boolean;
   Begin
    GetKey:= GetAsyncKeyState(KeyCode) <> 0;
   End;

  Function OK_Pressed : Boolean;
   Begin
    OK_Pressed:= GetKey(VK_LControl) And GetKey(VK_LMenu) And GetKey(Ord('O')) And GetKey(Ord('K'));
   End;

 Begin
  Try
   If OK_Pressed
   Then TForm(Sender).Close;
  Except
   ErrorLog('uNotifyWindow: NotifyWindow.KeyDown Failed');
   Close_ErrorWindow(TForm(Sender));
   Exit;
  End;
 End;


Class Procedure NotifyWindow.Show(WindowTitle: String; WindowText: String);
  Var
   ErrorWindow: TForm;
   MEMO       : WheelMemo;
   PRG        : WheelMemo;
   PRESS      : TLabel;
   OK         : TLabel;

  Procedure Free_ErrorWindow;
   Begin
    Try
     FreeAndNil(ErrorWindow);
    Except
     Exit;
    End;
   End;

  Procedure AAFont(ObjFont: TFont);
    Var
     LogFont: TLogFont;
   Begin
    Try
     GetObject(ObjFont.Handle, SizeOf(TLogFont),@LogFont);
     LogFont.lfQuality:= ANTIALIASED_QUALITY;
     ObjFont.Handle:= CreateFontIndirect(LogFont);
    Except
     ErrorLog('uNotifyWindow: NotifyWindow.Show: AAFont Failed');
     Exit;
    End;
   End;

 Begin
  Try
   Try
    ErrorWindow               := TForm.Create(Nil);
    ErrorWindow.Height        := 418;
    ErrorWindow.Width         := 580;
    ErrorWindow.BorderStyle   := bsSingle;
    ErrorWindow.BorderIcons   := [];
    ErrorWindow.Color         := 898061;
    ErrorWindow.FormStyle     := fsStayOnTop;
    ErrorWindow.Left          := (Screen.Width  - ErrorWindow.Width)  Div 2;
    ErrorWindow.Top           := (Screen.Height - ErrorWindow.Height) Div 2;
    ErrorWindow.KeyPreview    := True;
    ErrorWindow.DoubleBuffered:= True;
    ErrorWindow.OnKeyDown     := NotifyWindow.KeyDown;

    MEMO                 := WheelMemo.Create(ErrorWindow);
    MEMO.Alignment       := taLeftJustify;
    MEMO.BorderStyle     := bsSingle;
    MEMO.Color           := 898061;
    MEMO.Font.Color      := clBlack;
    MEMO.Font.Size       := 14;
    MEMO.Font.Name       := 'Verdana';
    MEMO.Font.Style      := [fsBold];
    MEMO.Height          := 280;
    MEMO.Width           := ErrorWindow.Width-52;
    MEMO.Left            := 23;
    MEMO.Top             := 77;
    MEMO.ReadOnly        := True;
    MEMO.HideSelection   := True;
    MEMO.ScrollBars      := ssNone;
    MEMO.Parent          := ErrorWindow;
    MEMO.Text            := WindowText;
    MEMO.DoubleBuffered  := True;
    MEMO.Cursor          := crArrow;
    MEMO.OnKeyDown       := WheelMemo.KeyDown;
    MEMO.OnMouseWheelDown:= WheelMemo.WheelDown;
    MEMO.OnMouseWheelUp  := WheelMemo.WheelUp;
    MEMO.OnContextPopup  := WheelMemo.NoMenu;

    PRG                 := WheelMemo.Create(ErrorWindow);
    PRG.Alignment       := taLeftJustify;
    PRG.BorderStyle     := bsNone;
    PRG.Color           := 898061;
    PRG.Font.Color      := clBlue;
    PRG.Font.Size       := 18;
    PRG.Font.Name       := 'Arial';
    PRG.Font.Style      := [fsBold];
    PRG.Height          := 66;
    PRG.Width           := ErrorWindow.Width-52;
    PRG.Left            := 23;
    PRG.Top             :=  5;
    PRG.ReadOnly        := True;
    PRG.HideSelection   := True;
    PRG.ScrollBars      := ssNone;
    PRG.Parent          := ErrorWindow;
    PRG.Text            := WindowTitle;
    PRG.DoubleBuffered  := True;
    PRG.Cursor          := crArrow;
    PRG.OnKeyDown       := WheelMemo.KeyDown;
    PRG.OnMouseWheelDown:= WheelMemo.WheelDown;
    PRG.OnMouseWheelUp  := WheelMemo.WheelUp;
    PRG.OnContextPopup  := WheelMemo.NoMenu;

    PRESS            := TLabel.Create(ErrorWindow);
    PRESS.Caption    := 'PRESS   OK';
    PRESS.Transparent:= True;
    PRESS.Font.Color := clBlue;
    PRESS.Font.Name  := 'Arial';
    PRESS.Font.Size  := 14;
    PRESS.Font.Style := [fsBold];
    PRESS.AutoSize   := True;
    PRESS.Left       := 24;
    PRESS.Top        := 363;
    PRESS.Parent     := ErrorWindow;

    OK            := TLabel.Create(ErrorWindow);
    OK.Caption    := 'CTRL  +  ALT  +  O  +  K';
    OK.Transparent:= True;
    OK.Font.Color := clBlue;
    OK.Font.Name  := 'Arial';
    OK.Font.Size  := 14;
    OK.Font.Style := [fsBold];
    OK.AutoSize   := True;
    OK.Left       := 335;
    OK.Top        := 363;
    OK.Parent     := ErrorWindow;

    AAFont(PRG.Font);
    AAFont(MEMO.Font);
    AAFont(OK.Font);
    AAFont(PRESS.Font);

    ErrorWindow.ShowModal;
   Finally
    Free_ErrorWindow;
   End;
  Except;
   ErrorLog('uNotifyWindow: NotifyWindow.Show Failed');
   Exit;
  End;
 End;

End.

[Luckie]

Delphi-Quellcode:

Procedure Free_LoadErrorLog;
   Begin
    Try
     FreeAndNil(LoadErrorLog);
    Except
     Exit;
    End;
   End;

FreeAndNil wirft keine Exception. Davon abgesehen ist es eine ziemlich dumme Idee eine Exception zu verschlucken.

Delphi-Quellcode:

FileExists('ErrorLog.txt')

Ohne Pfadangabe ist das russisches Roulette.

[Sir Rufo]

Dein Exception-Handling ist schon etwas paranoid :stupid:

Delphi-Quellcode:

procedure foo;
begin
  try
    ...
  except
    ...
    Exit; // kann ersatzlos gestrichen werden, wenn nichts mehr danach kommt
  end;
end;

Das mit dem Errorlog ist bestimmt gut gemeint, aber nicht gut gemacht. Man weiß, dass etwas schief gelaufen ist, aber was?

Delphi-Quellcode:

try
  ...
except
  on e: Exception do
  begin
    Errorlog( Format( 'Da ging was in die Hose, wegen %s: %s', [e.ClassName, e.Message] ) );
    // ich würde hier noch ein
    raise;
    // aufrufen, damit ich im Programm auf diesen Fehler reagieren kann (nicht muss)
  end;
end;

Generell sind Exceptions nicht der Feind, den es um jeden Preis zu unterdrücken gilt.

Man stelle sich einmal vor, der Compiler wäre nach diesem Muster aufgebaut:

Zitat:

Da ist watt falsch in dem Code! Kann ich nicht compilieren.

Wäre nicht sehr hilfreich ;)

[FarAndBeyond]

Zitat:

Das mit dem Errorlog ist bestimmt gut gemeint, aber nicht gut gemacht. Man weiß, dass etwas schief gelaufen ist, aber was?

Ja, das stimmt, aber der ErrorLog ist eigentlich auch nur für mich und ich brauche ihn in erster Linie während der Programmerstellung. Nach Fertigstellung sehe ich normalerweise nie wieder was von ihm...
Ich weiß damit genau in welcher Unit und in welcher Prozedur das Problem entsteht. Auf der anderen Seite ist fraglich ob ein Nutzer mit den Exception-Meldungen vom OS besser klarkommt. Nichtmal ein ASM-Programmierer kann mir detailierte Informationen geben über "Read von Adresse blablabla hat nicht funktioniert.." und genauso sehen oft die OS-Meldungen aus. Um detailierte Informationen für einen Nutzer ausgeben zu können, müßte man sehr viel öfter TryExceptEnd benutzen und dann genau beschreiben was das Programm gerade macht oder versucht zu machen. Ich finde das ist nicht nötig und für meine eigenen Sachen sowieso nicht. Ein Nutzer wird sich sowieso an den Programmierer oder die Softwarefirma wenden und mit der Problembeschreibung und dem ErrorLog bleiben für mich keine Fragen offen. Aber das hier ist nur ein Beispiel wie man soetwas machen kann, es gibt zahlreiche Möglichkeiten und ich hab' ja nie behauptet, dass diese hier die Beste sei. Niemand muß das so nachmachen. Für mich ist das super, da der ErrorLog kurz ist und ich doch genau weiß wo ich suchen muß. Bei sehr langen Prozeduren kann man ja mehrere Unterteilungen machen.

Zitat:

Exit; // kann ersatzlos gestrichen werden, wenn nichts mehr danach kommt

Ja, allerdings hab' ich auch schon bemerkt, dass bei der Verwendung von z.B. OnClose ein Exit unverzichtbar ist sonst bleiben einige MB im Taskmanager hängen.
Ich dachte ich geh' mal auf Nummer sicher...

Zitat:

FreeAndNil wirft keine Exception. Davon abgesehen ist es eine ziemlich dumme Idee eine Exception zu verschlucken.

Ja, FreeAndNil prüft erst, aber da ich nicht weiß ob das wirklich in jedem erdenklichen Fall zu keiner Exception führt, dachte ich mir ich geh' nach dem Ausschlußprinzip vor.
Sicher ist sicher. Was soll ich mit einer Exception, die möglicherweise geworfen wird aufgrund einer Stringlist, die nicht freigegeben werden kann. Oder was soll ein Nutzer mit so einer Exception anfangen. Wo soll da der Nutzen sein. Ich gebe etwas frei und sollte das nicht funktionieren, dann muß eben später das OS aufräumen...
Eine Meldung will ich da gar nicht sehen und ein Nutzer kann da auch nichts machen wenn es dabei Probleme geben sollte. Natürlich könnte man fragen wie oft klappt so eine Freigabe nicht, aber sicher ist sicher.

Ich hab' selbst mit zu viel Fremdsoftware nervige Erfahrungen gemacht wenn es um überflüssige Errormeldungen und OS-Exceptions ging. Ich sehe da keinen Sinn drin.
Ich denke eine Meldung ist nur dann sinnvoll, wenn der Nutzer auch wirklich was damit anfangen kann bzw. etwas verändern kann.
Wenn ich dem Nutzer eine Meldung z.B. per NotifyWindow.Show(...,...); zukommen lassen möchte, dann mache ich das ausführlich, verständlich und vielleicht in Deutsch und Englisch und wozu brauche ich dann noch die OS-Exception? Die wird sicher nicht ausführlicher oder gar präziser sein können.

Die meisten Nutzer, die keine Programmierer sind werden sich von zu viel "Belästigung" nur gestört fühlen oder das Vertrauen in die Software verlieren. Zumal sehr schnell Themebereiche übersprungen werden und dann hört man plötzlich: "Die Software ist nicht sicher." oder etwas in der Richtung und das eine hat oft mit dem anderen nichts zu tun.

Zitat:

FileExists('ErrorLog.txt') Ohne Pfadangabe ist das russisches Roulette.

Bis jetzt nimmt sich mein Programm immer die richtige Textdatei wenn ich keinen Pfad angebe...
Normalerweise benutze ich

Delphi-Quellcode:

ApplicationPath:= ExtractFilePath(Application.ExeName);

.

[Sir Rufo]

Die Exception mit "Access-Violation Read From Address" ist doch relativ klar.

Du versuchst gerade auf eine

Delphi-Quellcode:

nil

Instanz zuzugreifen oder auf eine bereits entsorgte Instanz (dangling pointer).

Ja es gibt so erst einmal keinen Stacktrace (den kann man mit MadExcept aber erhalten).

Ein stumpfes Unterdrücken der Exceptions erschwert aber die Fehlersuche ungemein (gibt dazu einige Beispiele hier im Forum). Es tut nicht und ich weiß nicht warum und habe noch nicht einmal einen Anhaltspunkt.

Viel sinnvoller als das Unterdrücken ist das aktive Werfen von Exceptions z.B. beim Aufruf von Methoden, wo zunächst geprüft wird, ob die Argumente auch schlüssig sind.

Wenn nicht, wirft man eine Exception

Delphi-Quellcode:

EArgumentException

oder

Delphi-Quellcode:

EArgumentNilException

und gibt den Namen des Arguments mit an. Schon werden die Exceptions (wenn diese kommen) wesentlich informativer und leiten einen sehr schnell zur Ursache des Übels. ;)

[FarAndBeyond]

Zitat:

Ja es gibt so erst einmal keinen Stacktrace (den kann man mit MadExcept aber erhalten).

Ja, MadExcept hab' ich schon öfter mal gelesen... kann auch gleich 'nen Screenshot machen...

Zitat:

Ein stumpfes Unterdrücken der Exceptions erschwert aber die Fehlersuche ungemein (gibt dazu einige Beispiele hier im Forum). Es tut nicht und ich weiß nicht warum und habe noch nicht einmal einen Anhaltspunkt.

Ja, da hast du wohl Recht... da kann man lange grübeln..

EArgumentException und EArgumentNilException kannte ich noch nicht.. muß ich mal ausprobieren.

Wenn ich mal ein sehr viel größeres Programm schreibe, dann hab' ich ja vielleicht auch mal Bedarf auf spezielle Exception Gruppen oder Klassen eingehen zu können oder zu müssen.
Z.B. EMathError oder EOutOfMemory oder ERangeError oder EStackOverflow usw... um dann je nach auftreten etwas spezielles zu tun.
Dann wird sich das Exception-Handling sowieso total verändern.