|
Antwort |
FarAndBeyond
(Gast)
n/a Beiträge |
#1
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:
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.
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; Das hab' ich mal gesehen in einem Post von Omata... funktioniert gut.
Delphi-Quellcode:
Früher hab' ich immer bei FormKeyDown "If Sender = form_Notify Then...." benutzt, aber da brauche ich auch 'ne globale Variable oder???
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; Gut, für das Panel braucht man noch "uses ExtCtrls"... Gruß Martin |
Zitat |
FarAndBeyond
(Gast)
n/a Beiträge |
#2
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA28. Jul 2015, 20:06
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:
Gruß
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. Martin |
Zitat |
FarAndBeyond
(Gast)
n/a Beiträge |
#3
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA30. Aug 2015, 02:44
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. |
Zitat |
Registriert seit: 10. Apr 2006 Ort: Leverkusen 969 Beiträge Delphi 6 Professional |
#4
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA30. Aug 2015, 14:09
Wozu Globale form_Notify ?
Delphi-Quellcode:
Was meinst Du wer 'Sender' ist?
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; 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:
Und schon hat sich deine Globale Form erledigt..
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 packe dann
Delphi-Quellcode:
in deine
Var
form_Notify : TForm; Class Procedure Show(WindowTitle: String; WindowText: String); als lokale Variable.... |
Zitat |
Registriert seit: 1. Dez 2003 Ort: Luterbach (CH) 676 Beiträge Delphi 12 Athens |
#5
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA30. Aug 2015, 14:21
Noch eine (weitere) kleine Randbemerkung:
Mach aus If OK_Pressed = True then... lieber ein If OK_Pressed then...
Roland
|
Zitat |
Registriert seit: 17. Sep 2006 Ort: Barchfeld 27.617 Beiträge Delphi 12 Athens |
#6
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA30. Aug 2015, 14:35
Und noch eine:
Zitat:
Delphi-Quellcode:
If OK_Pressed = True
Then CanClose := True Else CanClose := False; If boolean_Close = True Then CanClose := True; 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; 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
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein) Dieser Tag ist längst gekommen |
Zitat |
FarAndBeyond
(Gast)
n/a Beiträge |
#7
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA31. Aug 2015, 00:46
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. |
Zitat |
FarAndBeyond
(Gast)
n/a Beiträge |
#8
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA14. Nov 2015, 21:30
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. |
Zitat |
Registriert seit: 29. Mai 2002 37.621 Beiträge Delphi 2006 Professional |
#9
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA14. Nov 2015, 21:53
Delphi-Quellcode:
FreeAndNil wirft keine Exception. Davon abgesehen ist es eine ziemlich dumme Idee eine Exception zu verschlucken.
Procedure Free_LoadErrorLog;
Begin Try FreeAndNil(LoadErrorLog); Except Exit; End; End; FileExists('ErrorLog.txt') Ohne Pfadangabe ist das russisches Roulette.
Michael
Ein Teil meines Codes würde euch verunsichern. |
Zitat |
Registriert seit: 5. Jan 2005 Ort: Stadthagen 9.454 Beiträge Delphi 10 Seattle Enterprise |
#10
AW: NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA14. Nov 2015, 21:58
Dein Exception-Handling ist schon etwas paranoid
Delphi-Quellcode:
Das mit dem Errorlog ist bestimmt gut gemeint, aber nicht gut gemacht. Man weiß, dass etwas schief gelaufen ist, aber was?
procedure foo;
begin try ... except ... Exit; // kann ersatzlos gestrichen werden, wenn nichts mehr danach kommt end; end;
Delphi-Quellcode:
Generell sind Exceptions nicht der Feind, den es um jeden Preis zu unterdrücken gilt.
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; 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.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60) Geändert von Sir Rufo (14. Nov 2015 um 22:01 Uhr) |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |