home *** CD-ROM | disk | FTP | other *** search
- (*************************************************************************)
- (* jBooster *)
- (* (c) pulsar@mail.primorye.ru *)
- (*************************************************************************)
- Unit ReportForm;
- {$H+,A+,B-,I-}
-
- Interface
-
- Uses
- { standart }
- Windows, Messages, SysUtils, Classes,
- { vcl }
- Graphics, Controls, Forms, Dialogs, StdCtrls,
- { private }
- Support;
-
- Type
- TFormReport = class(TForm)
- ReportListBox: TListBox;
- { buttons }
- ButtonStop: TButton;
- ButtonClose: TButton;
- { handlers }
- procedure ButtonCloseClick(Sender: TObject);
- procedure FormActivate(Sender: TObject);
- procedure FormDeactivate(Sender: TObject);
- procedure ButtonStopClick(Sender: TObject);
- procedure ReportListBoxDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
- private
- ListWidth : integer;
- procedure SaveList (const FileName: string);
- end; { TFormReport }
-
- Var
- FormReport: TFormReport;
-
- Implementation
-
- {$R *.DFM}
-
- procedure PutReport (const Mssg: string; Pfx: TMsgDlgType);
- var
- w : integer;
- begin
- Report := Alarm;
- { put }
- With FormReport do begin
- With ReportListBox do begin
- Items.Add (Mssg);
- ItemIndex := Pred (Items.Count);
- w := Canvas.TextWidth (Mssg);
- end; { With }
- if w > ListWidth then ListWidth := w;
- end; { With }
- { restore }
- Report := PutReport;
- end; { PutReport }
-
- procedure TFormReport.SaveList (const FileName: string);
- begin
- Try
- ReportListBox.Items.SaveToFile (FileName);
- Except
- on E: Exception do Error (Catalog + FileName, E.Message);
- end;
- end; { SaveList }
-
- procedure TFormReport.FormDeactivate(Sender: TObject);
- begin
- { save }
- if ReportListBox.Items.Count > 0 then SaveList (ExePath + LogName);
- { free }
- ReportListBox.Clear;
- end; { FormDeactivate }
-
- procedure TFormReport.FormActivate(Sender: TObject);
- begin
- Caption := LogName;
- { buttons }
- ButtonStop.Enabled := true;
- ButtonClose.Enabled := false;
- { clear }
- With ReportListBox do begin
- Clear;
- SendMessage (Handle, LB_SETHORIZONTALEXTENT, 0, 0);
- Cursor := crHourGlass;
- end; { With }
- { init }
- ListWidth := 0;
- Report := PutReport;
- { work }
- Images.Run;
- { restore handler }
- Report := Alarm;
- { update }
- With ReportListBox do begin
- SendMessage (Handle, LB_SETHORIZONTALEXTENT, ListWidth + 4, 0);
- Cursor := crDefault;
- end; { With }
- { buttons }
- ButtonClose.Enabled := true;
- ButtonStop.Enabled := false;
- end; { FormActivate }
-
- procedure TFormReport.ReportListBoxDrawItem
- (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
- var
- S : string;
- begin
- With ReportListBox do begin
- Canvas.Font.Color := clBlack;
- Canvas.Brush.Color := clWindow;
- Canvas.FillRect (Rect);
- S := Items [Index];
- { color }
- if S [2] = AnyPrefix then begin
- Case S [1] of
- ErrPrefix: Canvas.Font.Color := clRed;
- BegPrefix: Canvas.Font.Color := clGreen;
- EndPrefix: Canvas.Font.Color := clGreen;
- end; { case }
- end; { if }
- Canvas.TextOut (Rect.Left + 2, Rect.Top - 1, S);
- end; { With }
- end; { ReportListBoxDrawItem }
-
- procedure TFormReport.ButtonStopClick(Sender: TObject);
- begin
- Cancel := true;
- end; { ButtonStopClick }
-
- procedure TFormReport.ButtonCloseClick(Sender: TObject);
- begin
- Close;
- end; { ButtonCloseClick }
-
- End.
-