ExceptionViewClass.pas

   1 unit ExceptionViewClass;
   2
   3 interface
   4
   5 uses
   6   ConstantsClass, CustomViewClass, HardwareClass, ResourcesClass, TypesClass,
   7   Classes, Grids, Menus;
   8
   9 type
  10
  11   { TExceptionView }
  12
  13   TExceptionView = class(TCustomView)
  14   private
  15     function pGetWidth: Integer; virtual;
  16     procedure pCustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
  17     procedure pOnSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); virtual;
  18     procedure pOnState(Sender: TObject); virtual;
  19     procedure pSetWidth(Width: Integer); virtual;
  20   public
  21     constructor CreateExceptionView(AOwner: TComponent; Hw: THardware); virtual;
  22     procedure ToggleException(Line: Integer); virtual;
  23     procedure ToggleMask(Line: Integer); virtual;
  24     property Width read pGetWidth write pSetWidth;
  25   end;
  26
  27 implementation
  28
  29 // ************************************************************************** //
  30 // *                     TExceptionView implementation                      * //
  31 // ************************************************************************** //
  32
  33   function TExceptionView.pGetWidth: Integer;
  34   begin
  35     Result := inherited Width;
  36   end;
  37
  38   procedure TExceptionView.pCustomKeyDown(Sender: TObject; var Key: Word;
  39     Shift: TShiftState);
  40   var
  41     lselect: TGridCoord;
  42   begin
  43     lselect := Selection.TopLeft;
  44     case Key of
  45       KEY_RETURN, KEY_SPACE:
  46         case lselect.X of
  47           1: ToggleException(lselect.Y);
  48           2: ToggleMask(lselect.Y);
  49         end;
  50     end;
  51   end;
  52
  53   procedure TExceptionView.pOnSelectCell(Sender: TObject; ACol, ARow: Integer;
  54     var CanSelect: Boolean);
  55   begin
  56     CanSelect := False;
  57     if (ACol = 0) or (ARow = 0) then Exit;
  58     if (ACol = 2) and ((ARow = 1) or (ARow = 2)) then Exit;
  59     CanSelect := True;
  60   end;
  61
  62   procedure TExceptionView.pOnState(Sender: TObject);
  63   var
  64     i: Integer;
  65   begin
  66     Cells[0, 0] := EXC_VIEW_TYPE;
  67     Cells[1, 0] := EXC_VIEW_EXC;
  68     Cells[2, 0] := EXC_VIEW_MASK;
  69     for i := 1 to 8 do
  70     begin
  71       Changes[1, i] := not CompareStateException(Hardware, 8 - i);
  72       Changes[2, i] := not CompareStateMask(Hardware, 8 - i);
  73       Cells[0, i] := DESC_EXCE[i - 1];
  74       if GetException(Hardware.State, 8 - i) then Cells[1, i] := EXC_VIEW_TRUE
  75       else Cells[1, i] := EXC_VIEW_FALSE;
  76       if (i > 2) then
  77         if GetMask(Hardware.State, 8 - i) then Cells[2, i] := EXC_VIEW_TRUE
  78         else Cells[2, i] := EXC_VIEW_FALSE
  79       else Cells[2, i] := '';
  80     end;
  81   end;
  82
  83   procedure TExceptionView.pSetWidth(Width: Integer);
  84   begin
  85     inherited Width := Width;
  86     ColWidths[1] := Canvas.TextWidth(EXC_VIEW_EXC + ' ');
  87     ColWidths[2] := Canvas.TextWidth(EXC_VIEW_MASK + ' ');
  88     ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2];
  89   end;
  90
  91   constructor TExceptionView.CreateExceptionView(AOwner: TComponent;
  92     Hw: THardware);
  93   begin
  94     inherited CreateView(AOwner, Hw);
  95     RowCount := 9;
  96     ColCount := 3;
  97     OnKeyDown := pCustomKeyDown;
  98     OnState := pOnState;
  99     OnSelectCell := pOnSelectCell;
 100     PopupMenu := TPopupMenu.Create(Self);
 101     with PopupMenu do
 102     begin
 103       Items.Add(TMenuItem.Create(PopupMenu));
 104       with Items[Items.Count - 1] do
 105       begin
 106         Caption := EXC_VIEW_TOGGLE;
 107         OnClick := OnDblClick;
 108         Default := True;
 109       end;
 110     end;
 111     pOnState(Self);
 112   end;
 113
 114   procedure TExceptionView.ToggleException(Line: Integer);
 115   var
 116     lstate: THardwareState;
 117   begin
 118     if not(Line > 0) then Exit;
 119     Line := 8 - Line;
 120     lstate := Hardware.State;
 121     SetException(lstate, Line, not GetException(lstate, Line));
 122     Hardware.State := lstate;
 123   end;
 124
 125   procedure TExceptionView.ToggleMask(Line: Integer);
 126   var
 127     lstate: THardwareState;
 128   begin
 129     if not(Line > 2) then Exit;
 130     Line := 8 - Line;
 131     lstate := Hardware.State;
 132     SetMask(lstate, Line, not GetMask(lstate, Line));
 133     Hardware.State := lstate;
 134   end;
 135
 136 end.