twindows.pas

Turbo Pascal 6.0编译器源码

unit TWindows;

{$O+,F+,S-}

interface

uses Objects, Drivers, Views, App;

const

  wpEditWindow      = 0;
  wpHelpWindow      = 1;
  wpWatchWindow     = 2;
  wpCallStackWindow = 3;
  wpCPUWindow       = 4;
  wpOutputWindow    = 5;
  wpCompileWindow   = 6;

  wfPutOnBottom = $10;
  wfSaveable    = $20;

  CColor = App.CColor +
    #$17#$1F#$1A#$31#$31#$1E#$71#$4E#$4F#$30#$00#$00#$00#$00#$00#$00 +
    #$31#$3F#$3A#$13#$13#$30#$31#$3E#$1E#$70#$71#$7E#$0E#$00#$00#$00 +
    #$31#$3F#$3A#$13#$13#$31#$2F#$00 +
    #$31#$3F#$3A#$13#$13#$31#$2F#$00 +
    #$31#$3F#$3A#$13#$13#$31#$2F#$00 +
    #$07#$0F#$0A#$31#$31#$00#$00#$00 +
    #$70#$7F#$7A#$13#$13#$70#$1F#$00;
  CBlackWhite = App.CBlackWhite +
    #$07#$0F#$07#$70#$70#$07#$70#$70#$70#$70#$00#$00#$00#$00#$00#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$0F#$0F#$70#$0F#$08#$78#$00#$00#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$00 +
    #$07#$0F#$07#$70#$70#$00#$00#$00 +
    #$70#$70#$70#$0F#$0F#$70#$0F#$00;
  CMonochrome = App.CMonochrome +
    #$07#$0F#$07#$70#$70#$07#$70#$70#$70#$70#$00#$00#$00#$00#$00#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$0F#$0F#$70#$0F#$70#$70#$00#$00#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$00 +
    #$07#$0F#$07#$70#$70#$07#$70#$00 +
    #$07#$0F#$07#$70#$70#$00#$00#$00 +
    #$70#$70#$70#$0F#$0F#$70#$0F#$00;

type

  PTurboWindow = ^TTurboWindow;
  TTurboWindow = object(TWindow)
    constructor Init(var Bounds: TRect; ATitle: TTitleStr;
      ANumber, APalette: Integer);
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SizeLimits(var Min, Max: TPoint); virtual;
  end;

const

  RTurboWindow: TStreamRec = (
    ObjType: 8001;
    VMTLink: Ofs(TypeOf(TTurboWindow)^);
    Load:    @TTurboWindow.Load;
    Store:   @TTurboWindow.Store
  );

const

  CEditWindow:      string[16] = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79;
  CHelpWindow:      string[16] = #80#81#82#83#84#85#86#87#88#89#90#91#92#93#94#95;
  CWatchWindow:     string[8]  = #96#97#98#99#100#101#102#103;
  CCallStackWindow: string[8]  = #104#105#106#107#108#109#110#111;
  CCPUWindow:       string[8]  = #112#113#114#115#116#117#118#119;
  COutputWindow:    string[8]  = #120#121#122#123#124#125#126#127;
  CCompileWindow:   string[8]  = #128#129#130#131#132#133#134#135;

  WindowPalettes: array[0..6] of PPalette=(
    @CEditWindow,
    @CHelpWindow,
    @CWatchWindow,
    @CCallStackWindow,
    @CCPUWindow,
    @COutputWindow,
    @CCompileWindow);

  ColorTable: array[apColor..apMonochrome] of string[Length(CColor)] =
    (CColor, CBlackWhite, CMonochrome);

implementation

uses TStatus, TVars;

constructor TTurboWindow.Init(var Bounds: TRect; ATitle: TTitleStr;
  ANumber, APalette: Integer);
begin
  TWindow.Init(Bounds, ATitle, ANumber);
  Palette := APalette;
  Flags := Flags or wfSaveable;
end;

function TTurboWindow.GetPalette: PPalette;
begin
  GetPalette := WindowPalettes[Palette];
end;

procedure TTurboWindow.HandleEvent(var Event: TEvent);
begin
  TWindow.HandleEvent(Event);
  if Event.What = evBroadcast then case Event.Command of
    cmMakeDesktop:
      if Flags and wfSaveable <> 0 then
        PCollection(Event.InfoPtr)^.Insert(@Self);
    cmFindBottomLimit:
      if (Flags and wfPutOnBottom <> 0) and (Origin.Y < Event.InfoInt) then
        Event.InfoInt := Origin.Y;
  end;
end;

procedure TTurboWindow.SizeLimits(var Min, Max: TPoint);
begin
  TWindow.SizeLimits(Min, Max);
  if Palette = wpEditWindow then
    Min.X := 23;
end;

end.