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.