LogViewClass.pas

   1 unit LogViewClass;
   2
   3 interface
   4
   5 uses
   6   ConstantsClass, CustomViewClass, FunctionsClass, HardwareClass,
   7   OperandEditClass, MemoryEditClass, PrefixTreeClass, ResourcesClass,
   8   TypesClass,
   9   Classes, Controls, Graphics, Grids, StdCtrls, Types, Menus;
  10
  11 type
  12
  13   { TLogView }
  14
  15   TLogView = class(TCustomView)
  16   private
  17     pMinWidth: Integer;
  18     function pGetSelectedLine: Integer; virtual;
  19     function pGetWidth: Integer; virtual;
  20     procedure pCustomDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); virtual;
  21     procedure pCustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
  22     procedure pCustomPopupClear(Sender: TObject); virtual;
  23     procedure pDrawSingleCell(Canvas: TCanvas; ACol, ARow: Integer; Rect: TRect; Colors: TColors); virtual;
  24     procedure pOnSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); virtual;
  25     procedure pSetSelectedLine(Line: Integer); virtual;
  26     procedure pSetWidth(Width: Integer); virtual;
  27   public
  28     constructor CreateLogView(AOwner: TComponent; Hw: THardware); virtual;
  29     procedure Clear(Sender: TObject); virtual;
  30     procedure Write(Sender: TObject; Log: String; Error: Boolean = False); virtual;
  31     property SelectedLine: Integer read pGetSelectedLine write pSetSelectedLine;
  32     property Width read pGetWidth write pSetWidth;
  33   end;
  34
  35 implementation
  36
  37 uses CustomStringGridClass;
  38
  39 // ************************************************************************** //
  40 // *                         TLogView implementation                        * //
  41 // ************************************************************************** //
  42
  43   function TLogView.pGetSelectedLine: Integer;
  44   begin
  45     Result := Selection.Top;
  46   end;
  47
  48   function TLogView.pGetWidth: Integer;
  49   begin
  50     Result := inherited Width;
  51   end;
  52
  53   procedure TLogView.pCustomDrawCell(Sender: TObject; ACol, ARow: Integer;
  54     Rect: TRect; State: TGridDrawState);
  55   begin
  56     if (gdSelected in State) and Selected then
  57       pDrawSingleCell(Canvas, ACol, ARow, Rect, ColorTheme.Line.Selected)
  58     else
  59       pDrawSingleCell(Canvas, ACol, ARow, Rect, ColorTheme.Line.None)
  60   end;
  61
  62   procedure TLogView.pCustomKeyDown(Sender: TObject; var Key: Word;
  63     Shift: TShiftState);
  64   begin
  65     case Key of
  66       KEY_DELETE:
  67         Clear(Sender);
  68     end;
  69   end;
  70
  71   procedure TLogView.pCustomPopupClear(Sender: TObject);
  72   var
  73     lkey: Word;
  74   begin
  75     lkey := KEY_DELETE;
  76     pCustomKeyDown(Sender, lkey, []);
  77   end;
  78
  79   procedure TLogView.pDrawSingleCell(Canvas: TCanvas; ACol, ARow: Integer;
  80     Rect: TRect; Colors: TColors);
  81   var
  82     lx, ly: Integer;
  83   begin
  84     with Rect do
  85     begin
  86       Canvas.Brush.Color := Colors.BG;
  87       if Changes[ACol, ARow] then Canvas.Font.Color := ColorTheme.Change
  88       else Canvas.Font.Color := Colors.FG;
  89       lx := Left + Canvas.TextWidth(' ');
  90       ly := (Bottom - Top - Canvas.TextHeight(Cells[ACol, ARow])) div 2 + Top;
  91       Canvas.FillRect(Rect);
  92       Canvas.TextOut(lx, ly, Cells[ACol, ARow]);
  93     end;
  94   end;
  95
  96   procedure TLogView.pOnSelectCell(Sender: TObject; ACol, ARow: Integer;
  97     var CanSelect: Boolean);
  98   begin
  99     CanSelect := True;
 100   end;
 101
 102   procedure TLogView.pSetSelectedLine(Line: Integer);
 103   var
 104     lselect: TGridRect;
 105   begin
 106     if (Line < 0) then Line := 0;
 107     if (Line > RowCount) then Line := RowCount - 1;
 108     {$IFDEF UNIX}
 109     SetColRow(0, Line);
 110     // Lazarus is really nice, by having incompatible calls :-(
 111     {$ELSE}
 112     lselect.Top := Line;
 113     lselect.Bottom := Line;
 114     lselect.Left := 0;
 115     lselect.Right := 1;
 116     Selection := lselect;
 117     {$ENDIF}
 118   end;
 119
 120   procedure TLogView.pSetWidth(Width: Integer);
 121   begin
 122     inherited Width := Width;
 123     pMinWidth := MaxOf(pMinWidth, ClientWidth);
 124     ColWidths[0] := pMinWidth;
 125   end;
 126
 127   constructor TLogView.CreateLogView(AOwner: TComponent; Hw: THardware);
 128   begin
 129     inherited CreateView(AOwner, Hw);
 130     ScrollBars := ssBoth;
 131     RowCount := 1;
 132     ColCount := 1;
 133     OnDrawCell := pCustomDrawCell;
 134     OnKeyDown := pCustomKeyDown;
 135     Log_Sender := Self;
 136     Log_OnClear := Clear;
 137     Log_OnWrite := Write;
 138     OnSelectCell := pOnSelectCell;
 139     PopupMenu := TPopupMenu.Create(Self);
 140     with PopupMenu do
 141     begin
 142       Items.Add(TMenuItem.Create(PopupMenu));
 143       with Items[Items.Count - 1] do
 144       begin
 145         Caption := LOG_VIEW_CLEAR;
 146         OnClick := pCustomPopupClear;
 147         Default := True;
 148       end;
 149     end;
 150     pMinWidth := 0;
 151   end;
 152
 153   procedure TLogView.Clear(Sender: TObject);
 154   begin
 155     RowCount := 1;
 156     Selected := False;
 157     Cells[0, 0] := '';
 158   end;
 159
 160   procedure TLogView.Write(Sender: TObject; Log: String; Error: Boolean = False
 161     );
 162   begin
 163     Log := TrimCharacterLeft(Log, ' ');
 164     if Error then Log := 'Error: ' + Log
 165     else if not(Log = '') then Log := '- ' + Log;
 166     Cells[0, RowCount - 1] := Log;
 167     Changes[0, RowCount - 1] := Error;
 168     pMinWidth := MaxOf(pMinWidth, Canvas.TextWidth(Log));
 169     ColWidths[0] := pMinWidth;
 170     SelectedLine := RowCount - 1;
 171     Selected := True;
 172     RowCount := RowCount + 1;
 173     Cells[0, RowCount - 1] := '';
 174   end;
 175
 176 end.