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
 
FarAndBeyond
(Gast)

n/a Beiträge
 
#3

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

  Alt 30. Aug 2015, 01: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.
  Mit Zitat antworten Zitat
 

 

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 02:30 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