Marco Web Center |
|
Chapter 03 - Project ErrorLog |
Project Structure |
ErrorLog.dpr |
program ErrorLog; uses Forms, LogForm in 'LogForm.pas' {FormLog}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TFormLog, FormLog); Application.Run; end. |
LogForm.pas |
unit LogForm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, AppEvnts; type TFormLog = class(TForm) Button1: TButton; Button2: TButton; CheckBoxSilent: TCheckBox; ApplicationEvents1: TApplicationEvents; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure LogException (Sender: TObject; E: Exception); end; var FormLog: TFormLog; implementation {$R *.DFM} procedure TFormLog.LogException(Sender: TObject; E: Exception); var Filename: string; LogFile: TextFile; begin // prepares log file Filename := ChangeFileExt (Application.Exename, '.log'); AssignFile (LogFile, Filename); if FileExists (FileName) then Append (LogFile) // open existing file else Rewrite (LogFile); // create a new one // write to the file and show error Writeln (LogFile, DateTimeToStr (Now) + ':' + E.Message); if not CheckBoxSilent.Checked then Application.ShowException (E); // close the file CloseFile (LogFile); end; procedure TFormLog.Button1Click(Sender: TObject); var a, b, c: Integer; begin a := 10; b := 0; c := a div b; ShowMessage (IntToStr (c)); end; procedure TFormLog.Button2Click(Sender: TObject); begin raise Exception.Create ('raise button pressed'); end; end. |
LogForm.dfm |
object FormLog: TFormLog Left = 192 Top = 107 Width = 182 Height = 163 Caption = 'ErrorLog' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 40 Top = 16 Width = 75 Height = 25 Caption = 'Div by 0' TabOrder = 0 OnClick = Button1Click end object Button2: TButton Left = 40 Top = 56 Width = 75 Height = 25 Caption = 'raise' TabOrder = 1 OnClick = Button2Click end object CheckBoxSilent: TCheckBox Left = 56 Top = 104 Width = 57 Height = 17 Caption = 'Silent' TabOrder = 2 end object ApplicationEvents1: TApplicationEvents OnException = LogException Left = 120 Top = 16 end end |