home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / navody / JBOOSTER.ZIP / Source / ReportForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-06-15  |  3.8 KB  |  139 lines
  1. (*************************************************************************)
  2. (*                                jBooster                               *)
  3. (*                        (c) pulsar@mail.primorye.ru                    *)
  4. (*************************************************************************)
  5.  Unit ReportForm;
  6.  {$H+,A+,B-,I-}
  7.  
  8.  Interface
  9.  
  10.  Uses
  11.    { standart }
  12.      Windows, Messages, SysUtils, Classes,
  13.    { vcl }
  14.      Graphics, Controls, Forms, Dialogs, StdCtrls,
  15.    { private }
  16.      Support;
  17.  
  18.  Type
  19.     TFormReport = class(TForm)
  20.       ReportListBox: TListBox;
  21.     { buttons }
  22.       ButtonStop: TButton;
  23.       ButtonClose: TButton;
  24.     { handlers }
  25.       procedure ButtonCloseClick(Sender: TObject);
  26.       procedure FormActivate(Sender: TObject);
  27.       procedure FormDeactivate(Sender: TObject);
  28.       procedure ButtonStopClick(Sender: TObject);
  29.       procedure ReportListBoxDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  30.     private
  31.       ListWidth : integer;
  32.       procedure SaveList (const FileName: string);
  33.     end; { TFormReport }
  34.  
  35.  Var
  36.     FormReport: TFormReport;
  37.  
  38.  Implementation
  39.  
  40. {$R *.DFM}
  41.  
  42.  procedure PutReport (const Mssg: string; Pfx: TMsgDlgType);
  43.  var
  44.      w : integer;
  45.  begin
  46.      Report := Alarm;
  47.    { put }
  48.      With FormReport do begin
  49.           With ReportListBox do begin
  50.                Items.Add (Mssg);
  51.                ItemIndex := Pred (Items.Count);
  52.                w := Canvas.TextWidth (Mssg);
  53.           end; { With }
  54.           if w > ListWidth then ListWidth := w;
  55.     end; { With }
  56.   { restore }
  57.     Report := PutReport;
  58.  end; { PutReport }
  59.  
  60.  procedure TFormReport.SaveList (const FileName: string);
  61.  begin
  62.      Try
  63.        ReportListBox.Items.SaveToFile (FileName);
  64.      Except
  65.        on E: Exception do Error (Catalog + FileName, E.Message);
  66.      end;
  67.  end; { SaveList }
  68.  
  69.  procedure TFormReport.FormDeactivate(Sender: TObject);
  70.  begin
  71.   { save }
  72.     if ReportListBox.Items.Count > 0 then SaveList (ExePath + LogName);
  73.   { free }
  74.     ReportListBox.Clear;
  75.  end;  { FormDeactivate }
  76.  
  77.  procedure TFormReport.FormActivate(Sender: TObject);
  78.  begin
  79.      Caption := LogName;
  80.    { buttons }
  81.      ButtonStop.Enabled := true;
  82.      ButtonClose.Enabled := false;
  83.    { clear }
  84.      With ReportListBox do begin
  85.           Clear;
  86.           SendMessage (Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  87.           Cursor := crHourGlass;
  88.      end; { With }
  89.    { init }
  90.      ListWidth := 0;
  91.      Report := PutReport;
  92.    { work }
  93.      Images.Run;
  94.    { restore handler }
  95.      Report := Alarm;
  96.    { update }
  97.      With ReportListBox do begin
  98.           SendMessage (Handle, LB_SETHORIZONTALEXTENT, ListWidth + 4, 0);
  99.           Cursor := crDefault;
  100.      end; { With }
  101.    { buttons }
  102.      ButtonClose.Enabled := true;
  103.      ButtonStop.Enabled := false;
  104.  end; { FormActivate }
  105.  
  106.  procedure TFormReport.ReportListBoxDrawItem
  107.  (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  108.  var
  109.      S : string;
  110.  begin
  111.      With ReportListBox do begin
  112.         Canvas.Font.Color := clBlack;
  113.         Canvas.Brush.Color := clWindow;
  114.         Canvas.FillRect (Rect);
  115.         S := Items [Index];
  116.       { color }
  117.         if S [2] = AnyPrefix then begin
  118.            Case S [1] of
  119.               ErrPrefix: Canvas.Font.Color := clRed;
  120.               BegPrefix: Canvas.Font.Color := clGreen;
  121.               EndPrefix: Canvas.Font.Color := clGreen;
  122.            end; { case }
  123.         end; { if }
  124.         Canvas.TextOut (Rect.Left + 2, Rect.Top - 1, S);
  125.      end; { With }
  126.  end; { ReportListBoxDrawItem }
  127.  
  128.  procedure TFormReport.ButtonStopClick(Sender: TObject);
  129.  begin
  130.      Cancel := true;
  131.  end; { ButtonStopClick }
  132.  
  133.  procedure TFormReport.ButtonCloseClick(Sender: TObject);
  134.  begin
  135.      Close;
  136.  end; { ButtonCloseClick }
  137.  
  138. End.
  139.