AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi NotifyWindow, dynamisches Fenster in nur einer Prozedur inklusive Events und AA
Thema durchsuchen
Ansicht
Themen-Optionen

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

Ein Thema von FarAndBeyond · begonnen am 27. Jul 2015 · letzter Beitrag vom 16. Nov 2015
Antwort Antwort
FarAndBeyond
(Gast)

n/a Beiträge
 
#1

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

  Alt 30. Aug 2015, 02:44
Ich glaub' so ist das noch viel besser... grins.... in 100 Jahren ist die Unit vielleicht perfekt...
zusammenfalten · markieren
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.
  Mit Zitat antworten Zitat
HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
981 Beiträge
 
Delphi 6 Professional
 
#2

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

  Alt 30. Aug 2015, 14:09
Wozu Globale form_Notify ?

zusammenfalten · markieren
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
markieren
Delphi-Quellcode:
Procedure Close_MainForm;
 Begin
  Try
   boolean_Close := True;
   form_Notify.Close;
  Except
   Exit;
  End;
 End;

zusammenfalten · markieren
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

markieren
Delphi-Quellcode:
Var
  form_Notify : TForm;
in deine

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

als lokale Variable....
  Mit Zitat antworten Zitat
Benutzerbild von blawen
blawen

Registriert seit: 1. Dez 2003
Ort: Luterbach (CH)
694 Beiträge
 
Delphi 12 Athens
 
#3

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

  Alt 30. Aug 2015, 14:21
Noch eine (weitere) kleine Randbemerkung:

Mach aus
If OK_Pressed = True then... lieber ein

If OK_Pressed then...
Roland
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.656 Beiträge
 
Delphi 12 Athens
 
#4

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

  Alt 30. Aug 2015, 14:35
Und noch eine:
Zitat:
markieren
Delphi-Quellcode:
   If OK_Pressed = True
   Then CanClose := True
   Else CanClose := False;

   If boolean_Close = True Then CanClose := True;
Das entspricht doch
CanClose := OK_Pressed or boolean_Close; , genauso wie
Zitat:
markieren
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
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
  Mit Zitat antworten Zitat
FarAndBeyond
(Gast)

n/a Beiträge
 
#5

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

  Alt 31. 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:
zusammenfalten · markieren
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.
  Mit Zitat antworten Zitat
Antwort Antwort

« Vorheriges Thema | Nächstes Thema »
 

Forumregeln

Es 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
Gehe zu:

• Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:21 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz