tstatus.pas

Turbo Pascal 6.0编译器源码

unit TStatus;

{$O+,F+,S-}

interface

uses Objects, Menus, App;

type

  PTurboStatusLine = ^TTurboStatusLine;
  TTurboStatusLine = object(TStatusLine)
    Overridden: Boolean;
    constructor Init;
    function Hint(AHelpCtx: Word): String; virtual;
    procedure PrintStr(I: Word; Params: Pointer);
    procedure Update; virtual;
  end;

const

  RTurboStatusLine: TStreamRec = (
    ObjType: 5001;
    VMTLink: Ofs(TypeOf(TTurboStatusLine)^);
    Load:    @TTurboStatusLine.Load;
    Store:   @TTurboStatusLine.Store
  );

var

  StatusLine: PTurboStatusLine absolute App.StatusLine;

implementation

uses Drivers, Views, TVars, Context, StrNames;

const

  kbCtrlN = $310E;
  kbCtrlY = $1519;

constructor TTurboStatusLine.Init;
var
  R: TRect;
begin
  R.Assign(0, 24, 80, 25);
  TStatusLine.Init(R,
    NewStatusDef(hcDragging, hcDragging,
      NewStatusKey('~'#24#25#26#27'~ Move', 0, 0,
      NewStatusKey('~Shift-'#24#25#26#27'~ Resize', 0, 0,
      NewStatusKey('~'#17'馁~ Done', 0, 0,
      NewStatusKey('~Esc~ Cancel', 0, 0, nil)))),
    NewStatusDef(hcNoContext, hcClipboard,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~F2~ Save',kbF2, cmSave,
      NewStatusKey('~F3~ Open', kbf3, cmOpen,
      NewStatusKey('~Alt-F9~ Compile', kbAltF9, cmCompile,
      NewStatusKey('~F9~ Make', kbF9, cmMake,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu, nil)))))),
    NewStatusDef(hcWatchWindow, hcWatchWindow,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~F7~ Trace', kbF7, cmTraceInto,
      NewStatusKey('~F8~ Step', kbF8, cmStepOver,
      NewStatusKey('~'#17'馁~ Edit', kbEnter, cmEditWatch,
      NewStatusKey('~Ins~ Add', kbIns, cmAddWatch,
      NewStatusKey('~Del~ Delete', kbDel, cmDeleteWatch,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
      NewStatusKey('', kbCtrlY, cmDeleteWatch,
      NewStatusKey('', kbCtrlN, cmAddWatch, nil))))))))),
    NewStatusDef(hcOutputWindow, hcOutputWindow,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~'#24#25#26#27'~ Scroll', 0, 0,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu, nil))),
    NewStatusDef(hcCpuWindow, hcDebugging,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~F7~ Trace', kbF7, cmTraceInto,
      NewStatusKey('~F8~ Step', kbF8, cmStepOver,
      NewStatusKey('~F9~ Make', kbF9, cmMake,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu, nil))))),
    NewStatusDef(hcHelpWindow, hcHelpWindow,
      NewStatusKey('~F1~ Help on help', kbF1, cmHelpOnHelp,
      NewStatusKey('~Alt-F1~ Previous topic', kbAltF1, cmPreviousTopic,
      NewStatusKey('~Shift-F1~ Help index', kbShiftF1, cmHelpIndex,
      NewStatusKey('~Esc~ Close help', kbEsc, cmClose,
      NewStatusKey('', kbF10, cmMenu, nil))))),
    NewStatusDef(hcCallStackWindow, hcCallStackWindow,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~'#17'馁~ View source', kbEnter, cmViewSource,
      NewStatusKey('~F7~ Trace', kbF7, cmTraceInto,
      NewStatusKey('~F8~ Step', kbF8, cmStepOver,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu, nil))))),
    NewStatusDef(500, 1000,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('~F2~ Save', kbF2, cmSave,
      NewStatusKey('~F3~ Open', kbF3, cmOpen,
      NewStatusKey('~Alt-F9~ Compile', kbAltF9, cmCompile,
      NewStatusKey('~F9~ Make', kbF9, cmMake,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu, nil)))))),
    NewStatusDef(0, $FFFF,
      NewStatusKey('~F1~ Help', kbF1, cmHelp,
      NewStatusKey('', kbF5, cmZoom,
      NewStatusKey('', kbCtrlF5, cmResize,
      NewStatusKey('', kbAltF3, cmClose,
      NewStatusKey('', kbF10, cmMenu, nil))))), nil))))))))));
end;

function TTurboStatusLine.Hint(AHelpCtx: Word): String;
begin
  Hint := Strings^.Get(AHelpCtx + sStatusBase);
end;

procedure TTurboStatusLine.PrintStr(I: Word; Params: Pointer);
var
  B: TDrawBuffer;
  S: String;
begin
  FormatStr(S, Strings^.Get(I), Params^);
  MoveChar(B, ' ', GetColor(1), Size.X);
  MoveStr(B[1], S, GetColor(1));
  WriteLine(0, 0, Size.X, 1, B);
  Overridden := True;
end;

procedure TTurboStatusLine.Update;
begin
  if Overridden then
  begin
    DrawView;
    Overridden := False;
  end else 
    TStatusLine.Update;
end;

end.