Unit ProtMenu;

Interface

Uses Classes,Graphics,Forms,Controls,Windows,ExtCtrls;

Const
  FontName  : String  = 'Courier New';
  FontSize  : Integer = 10;
  FontStyle : TFontStyles = [fsBold];

  MaxBufferSize = 32;

  Black        = 0;
  Blue         = 1;
  Green        = 2;
  Cyan         = 3;
  Red          = 4;
  Magenta      = 5;
  Brown        = 6;
  LightGray    = 7;
  DarkGray     = 8;
  LightBlue    = 9;
  LightGreen   = 10;
  LightCyan    = 11;
  LightRed     = 12;
  LightMagenta = 13;
  Yellow       = 14;
  White        = 15;

  TextPalette : Array[0..15] Of LongInt =
   ($00000000, $00AA0000, $0000AA00, $00AAAA00,
    $000000AA, $00AA00AA, $000055AA, $00AAAAAA,
    $00555555, $00FF5555, $0055FF55, $00FFFF55,
    $005555FF, $00FF55FF, $0055FFFF, $00FFFFFF);

Type
  Rect = Record
    Active      : Boolean;
    X1,Y1,X2,Y2 : Integer;
    AUL,AUR,ABL,ABR,AHZ,AVT : String[1];
    PUL,PUR,PBL,PBR,PHZ,PVT : String[1];
    PFore,PBack : Byte;
    AFore,ABack : Byte;
  End;

Const
  ScreenWidth = 200;
{ ------------------------ Keys ------------------------ }
  Key_Null    = #0;
  Key_Tab     = #9;
  Key_Enter   = #13;
  Key_Esc     = #27;
  Key_F1      = #59;
  Key_Alt_F5  = #108;
  Key_Alt_F10 = #113;
  Key_Up      = #72;
  Key_Down    = #80;
  Key_Left    = #75;
  Key_Right   = #77;
  Key_PgUp    = #73;
  Key_PgDn    = #81;
  Key_Home    = #71;
  Key_End     = #79;
{ -------------------------------------------------------- }
{ FastScroll speeds up character drawing for VESA graphics }
{ modes by cutting corners: it causes characters to be     }
{ written only if the character or attribute has changed.  }
{ This is OK for text applications, but could cause        }
{ strange results on screen if graphics is drawn on the    }
{ screen.                                                  }
{ -------------------------------------------------------- }
  FastWriteChar : Boolean = True;

Type
  BorderType = (SingleBorder,DoubleBorder,NoBorder);
  ScreenStr  = String[ScreenWidth];
  TWindowCallback = Procedure Of Object;
  TMouseCallback = Procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Integer) Of Object;
  TMouseMoveCallback = Procedure(Shift: TShiftState; X, Y: Integer) Of Object;
  DScreen = Class
  Private
    CharBufSize  : Word;
    Procedure   VESAWriteTrue(X,Y: Integer; Color: Byte; Var S: String);
    Procedure   VESAMove(Var P: Array Of Byte; Source,Dest,NumBytes: LongInt);
    Procedure   VESAScrollWindowUp;
  Public
    Canvas      : TCanvas;
    CharBuf     : Array Of Byte;
    Width       : Word;
    Height      : Word;
    TextAttr    : Word;
    WhereX      : Word;
    WhereY      : Word;
    WindMin     : Word;
    WindMax     : Word;
    CursorStart : Byte;
    CursorEnd   : Byte;
    CursorOn    : Boolean;
    MaxX        : Integer;
    MaxY        : Integer;
    Variable    : Boolean;
    Constructor Create(ACanvas: TCanvas; W,H: Integer);
    Destructor  Destroy; Override;
    Procedure   FastWrite(X,Y: Integer; Color: Byte; S: String);
    Procedure   ClrScr;
    Procedure   ClrEol;
    Procedure   TextColor(Color: Byte);
    Procedure   TextBackground(Color: Byte);
    Procedure   GotoXY(X,Y: Byte);
    Procedure   Write(St: String);
    Procedure   WriteLn(St: String);
    Procedure   FastMove(Var P: Array Of Byte; Source,Addr,NumBytes: LongInt);
    Procedure   Window(X1,Y1,X2,Y2: Integer);
    Procedure   SetTextAttr(Attr: Byte);
    Procedure   ShowCursor(Show: Boolean);
    Procedure   SetCursor(MinC,MaxC: Byte);
    Procedure   Resize(ACanvas: TCanvas; W,H: Integer);
    Procedure   SetFont;
    Procedure   TextWrite(Var P: Array Of Byte; X,Y: Integer; Color: Byte; S: String);
    Procedure   WriteAt(X,Y: Integer; Fore,Back: Byte; _St: String);
    Procedure   WriteAtAttr(X,Y: Integer; Attr: Byte; _St: String);
  End;
  DWindow = Class(TCustomControl)
  Private
    KeyBufRead       : Integer;
    KeyBufWrite      : Integer;
    KeyBuffer        : Array[0..MaxBufferSize - 1] Of Char;
    CreatedOwnForm   : Boolean;
    MouseX           : Integer;
    MouseY           : Integer;
    OldKeyState      : TKeyboardState;
    Procedure WriteFrame(Var R: Rect; CaptionTop,CaptionBot: String);
    Procedure DoKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState); Virtual;
    Procedure DoKeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState); Virtual;
    Procedure DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Virtual;
    Procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Virtual;
    Procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Virtual;
  Public
    X2,Y2             : Integer;
    WindowAttr        : Byte;
    BorderAttr        : Byte;
    CaptionAttr       : Byte;
    CaptionTop        : ScreenStr;
    CaptionBot        : ScreenStr;
    Border            : BorderType;
    _Visible          : Boolean;
    LastWindMin       : Word;
    LastWindMax       : Word;
    Screen            : DScreen;
    Form              : TForm;
    KeyCallbackDown   : TWindowCallback;
    KeyCallbackUp     : TWindowCallback;
    PaintCallback     : TWindowCallback;
    MouseDownCallback : TMouseCallback;
    MouseUpCallback   : TMouseCallback;
    MouseMoveCallback : TMouseMoveCallback;
    BlankOnPaint      : Boolean;
    Constructor Create(_Width,_Height: Integer;
                     WFore,WBack,BFore,BBack,CFore,CBack: Byte;
                     BType: BorderType; CapTop,CapBot: ScreenStr;
                     _Parent: TWinControl = Nil); Reintroduce;
    Procedure   Paint;      Override;
    Procedure   Remove;     Virtual;
    Destructor  Destroy;    Override;

    Function    KeyPressed: Boolean;
    Function    ReadKey: Char;
    Function    BufLen(WX,WY: Integer; InitString: String; Fore,Back: Byte; MaxLen,WindowLen: Integer): String;
    Procedure   DoResize(Form: TForm); Virtual;
  End;
  DSelection = Class
  Private
    WindowAttr     : Byte;
    HotCharAttr    : Byte;
    SelAttr        : Byte;
    SelHotCharAttr : Byte;
    ProtectedAttr  : Byte;
    SelProtAttr    : Byte;
    Parent         : DWindow;
  Public
    X,Y            : Integer;
    Width          : Integer;
    SelStr         : ScreenStr;
    HotChar        : Byte;
    IsProtected    : Boolean;
    Checked        : Boolean;
    Asterisk       : Boolean;
    Bar            : Integer;
    Constructor Create(_X,_Y,_Width: Integer;
                       Const _SelStr: ScreenStr;
                       _HotChar: Byte;
                       _Protected: Boolean;
                       _Checked: Boolean;
                       _WindowAttr: Byte;
                       _HotCharAttr: Byte;
                       _SelAttr: Byte;
                       _SelHotCharAttr: Byte;
                       _ProtectedAttr: Byte;
                       _SelProtAttr: Byte;
                       _Parent: DWindow);
    Destructor  Destroy; Override;
    Procedure   Show(Selected: Boolean; Top: Integer);
  End;
  DMenuCallback = Procedure Of Object;
  DMenu = Class(DWindow)
  Private
    KeyHit         : Boolean;
    OldSel         : Integer;
    _Top           : Integer;
    MaxSelY        : Integer;
    HotCharAttr    : Byte;
    SelAttr        : Byte;
    SelHotCharAttr : Byte;
    ProtectedAttr  : Byte;
    SelProtAttr    : Byte;
    HiliteItem     : Integer;
    Timer          : TTimer;
    Procedure   CheckTop;
    Procedure   OnClose(Sender: TObject; var Action: TCloseAction);
    Procedure   OnMenuKeyDown; 
    Procedure   WriteArrows(Up,Down: Boolean);
    Procedure   DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Override;
    Procedure   DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); Override;
    Function    ItemFromXY(X,Y: Integer): Integer;
    Procedure   OnTimer(Sender: TObject);
  Public
    CurSel         : Integer;
    Callback       : DMenuCallback;
    SelList        : TStringList;
    Constructor Create(_Width,_Height: Integer;
                       WFore,WBack,BFore,BBack,CFore,CBack,HCFore,HCBack,
                       SFore,SBack,SHCFore,SHCBack,PFore,PBack,SPFore,SPBack: Byte;
                       BType: BorderType; CapTop,CapBot: ScreenStr; 
                       _Parent: TWinControl = Nil);
    Procedure   Paint; Override;
    Procedure   AddSelection(_X,_Y,SelWidth: Integer; HotCh: Byte;
                             Protect,Checked: Boolean; St: ScreenStr);
    Procedure   SetSelection(Sel: Integer);
    Procedure   Execute;
    Procedure   Remove;  Override;
    Destructor  Destroy;    Override;
    Function    GetSelection(Sel: Integer): DSelection;
    Procedure   DisplaySelection(Sel: Integer);
  End;

Const
  WindowRect: Rect = (Active : False;
                      X1     : 1;
                      Y1     : 1;
                      X2     : 1;
                      Y2     : 1;
                      AUL    : 'É';
                      AUR    : '»';
                      ABL    : 'È';
                      ABR    : '¼';
                      AHZ    : 'Í';
                      AVT    : 'º';
                      PUL    : 'Ú';
                      PUR    : '¿';
                      PBL    : 'À';
                      PBR    : 'Ù';
                      PHZ    : 'Ä';
                      PVT    : '³';
                      PFore  : LightGray;
                      PBack  : Black;
                      AFore  : LightGray;
                      ABack  : Black);

Implementation

Uses HexWrite,frmMenuUnt,Keyboard;

Const
  _32BIT_OPERAND = $66;
  CopyLastPixel : Array[0..255] Of Byte =
   (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 00 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 10 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 20 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 30 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 40 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 50 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 60 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 70 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 80 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 90 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { A0 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { B0 }
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,   { C0 }
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,   { D0 }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,   { 0E }
    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);  { F0 }
  MenuTimerInterval = 100;  // milliseconds

Type
  TRGBQuad = Record
    B,G,R,A: Byte;
  End;

{ ------------------------------ }
{ DScreen                        }
{ ------------------------------ }

Constructor DScreen.Create(ACanvas: TCanvas; W,H: Integer);
Begin
  Inherited Create;
  Canvas      := ACanvas;
  Width       := W;
  Height      := H;
  SetFont;
  WhereX      := 1;
  WhereY      := 1;
  CursorStart := 6;
  CursorEnd   := 7;
  CursorOn    := True;
  Variable    := True;
End; { DScreen.Init }

Procedure DScreen.SetFont;
Var I: Integer;
Begin
  Canvas.Font.Name  := FontName;
  Canvas.Font.Size  := FontSize;
  Canvas.Font.Style := FontStyle;
  MaxX        := Width Div Canvas.TextWidth('M');
  MaxY        := Height Div Canvas.TextHeight('Mg');
  CharBufSize := MaxX * MaxY * 2;
  SetLength(CharBuf,CharBufSize);
  For I := 1 To CharBufSize Div 2 Do
  Begin
    CharBuf[(I - 1) * 2]     := 32;
    CharBuf[(I - 1) * 2 + 1] := 7;
  End; // For I
  Window(1,1,MaxX,MaxY);
End; // DScreen.SetFont

Destructor DScreen.Destroy;
Begin
  Inherited;
End; { DScreen.Done }

Procedure DScreen.TextWrite(Var P: Array Of Byte; X,Y: Integer; Color: Byte; S: String);
Var
  I,J  : Integer;
  Addr : Integer;

Begin
  If S <> '' Then
  Begin
    If X < 1 Then X := 1;
    If Y < 1 Then Y := 1;
    Addr := ((Y - 1) * MaxX + X - 1) * 2;
    J := Length(S);
    I := 1;
    If (X - 1) + (J - 1) >= MaxX Then J := MaxX - (X - 1) + 1;
    While (I <= J) And ((Addr + 1) < Length(P)) Do
    Begin
      P[Addr]     := Ord(S[I]);
      P[Addr + 1] := Color;
      Inc(Addr,2);
      Inc(I);
    End; // While
  End;
End; { TScreen.TextWrite }

Procedure DScreen.VESAWriteTrue(X,Y: Integer; Color: Byte; Var S: String);
Var
  I,J  : Integer;
  St   : String;
  W    : Integer;
  H    : Integer;
  Addr : Integer;
  WS   : Integer;

Begin
{
  Canvas.Pen.Color := clBlack;
  Canvas.MoveTo(0,0);
  Canvas.LineTo(Width,Height);

  ShowMessage('MaxX = ' + IntToStr(MaxX) + #13#10 +
              'MaxY = ' + IntToStr(MaxY) + #13#10 +
              'X = ' + IntToStr(X) + #13#10 +
              'Y = ' + IntToStr(Y) + #13#10 +
              'Lo(WindMin) = ' + IntToStr(Lo(WindMin)) + #13#10 +
              'Lo(WindMax) = ' + IntToStr(Lo(WindMax)) + #13#10 +
              'S = |' + S + '|');
}

  TextWrite(CharBuf,X,Y,Color,S);
  If Not Variable Then
   X := (X - 1) * Canvas.TextWidth('M')
  Else
  Begin
    Addr := ((Y - 1) * MaxX) * 2;
    St   := '';
    I    := 1;
    While I < X Do
    Begin
      If Addr < Length(CharBuf) Then
      Begin
        St := St + Chr(CharBuf[Addr]);
        Inc(Addr,2);
      End;
      Inc(I);
    End; // While
    For I := 1 To Length(St) Do
    Begin
      Case St[I] Of
        #0..#31,#128..#250,#252..#255: St[I] := 'M';
        #251: St[I] := ' ';
      End; // Case
    End;

    // Subtract off WindMin

    St := Copy(St,Lo(WindMin) + 1,Length(St) - Lo(WindMin));
    X := Canvas.TextWidth(St) + Lo(WindMin) * Canvas.TextWidth('M');
  End;
  Y  := (Y - 1) * Canvas.TextHeight('Mg');
  W  := Canvas.TextWidth('M');
  H  := Canvas.TextHeight('Mg');
  WS := Canvas.TextWidth(' ');

  // Shorten the string if it's too long

  While (S <> '') And
        (X + Canvas.TextWidth(S) > (Lo(WindMax) + 1) * W) Do S := Copy(S,1,Length(S) - 1);

  // Blank out everything underneath if necessary

  If Not Variable Then
  Begin
    Canvas.Font.Color  := TextPalette[Color Shr 4];
    Canvas.Pen.Color   := TextPalette[Color Shr 4];
    Canvas.Brush.Color := TextPalette[Color Shr 4];
    I := X + Length(S) * W;
    J := Y + H;
    If I > MaxX * W Then I := MaxX * W;
    If J > MaxY * H Then J := MaxY * H;
    Canvas.Rectangle(X,Y,I,J);
  End;

  // Display the string

  Canvas.Font.Color  := TextPalette[Color And $F];
  Canvas.Pen.Color   := TextPalette[Color And $F];
  Canvas.Brush.Color := TextPalette[Color Shr 4];
  St := S;
  For I := 1 To Length(St) Do
   If (Ord(St[I]) < 32) Or (Ord(St[I]) > 127) Then St[I] := ' ';
  Canvas.TextOut(X,Y,St);

  // Draw any special characters

  For I := 1 To Length(S) Do
  Begin
    If (S[I] < #32) Or (S[I] > #127) Then
    Begin
      Canvas.Font.Color  := TextPalette[Color Shr 4];
      Canvas.Pen.Color   := TextPalette[Color Shr 4];
      Canvas.Brush.Color := TextPalette[Color Shr 4];
      Canvas.Rectangle(X,Y,X + W,Y + H);
    End;
    Canvas.Font.Color  := TextPalette[Color And $F];
    Canvas.Pen.Color   := TextPalette[Color And $F];
    Canvas.Brush.Color := TextPalette[Color Shr 4];
    Case S[I] Of
       #24: Begin
              Canvas.MoveTo(X + (W Div 2),Y + 1);
              Canvas.LineTo(X + (W Div 2),Y + H - 1);
              Canvas.MoveTo(X + (W Div 2) - 3,Y + 4);
              Canvas.LineTo(X + (W Div 2),Y + 1);
              Canvas.MoveTo(X + (W Div 2) + 3,Y + 4);
              Canvas.LineTo(X + (W Div 2),Y + 1);
            End;
       #25: Begin
              Canvas.MoveTo(X + (W Div 2),Y + 1);
              Canvas.LineTo(X + (W Div 2),Y + H - 1);
              Canvas.MoveTo(X + (W Div 2) - 3,Y + H - 4);
              Canvas.LineTo(X + (W Div 2),Y + H - 1);
              Canvas.MoveTo(X + (W Div 2) + 3,Y + H - 4);
              Canvas.LineTo(X + (W Div 2),Y + H - 1);
            End;
      #179: Begin
              Canvas.MoveTo(X + (W Div 2),Y);
              Canvas.LineTo(X + (W Div 2),Y + H);
            End;
      #180: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + (W Div 2),Y + (H Div 2));
              Canvas.MoveTo(X + (W Div 2),Y);
              Canvas.LineTo(X + (W Div 2),Y + H);
            End;
      #186: Begin
              Canvas.MoveTo(X + (W Div 2) - 1,Y);
              Canvas.LineTo(X + (W Div 2) - 1,Y + H);
              Canvas.MoveTo(X + (W Div 2) + 1,Y);
              Canvas.LineTo(X + (W Div 2) + 1,Y + H);
            End;
      #187: Begin
              Canvas.MoveTo(X,Y + (H Div 2) + 1);
              Canvas.LineTo(X + (W Div 2) - 1,Y + (H Div 2) + 1);
              Canvas.LineTo(X + (W Div 2) - 1,Y + H);
              Canvas.MoveTo(X,Y + (H Div 2) - 1);
              Canvas.LineTo(X + (W Div 2) + 1,Y + (H Div 2) - 1);
              Canvas.LineTo(X + (W Div 2) + 1,Y + H);
            End;
      #188: Begin
              Canvas.MoveTo(X,Y + (H Div 2) - 1);
              Canvas.LineTo(X + (W Div 2) - 1,Y + (H Div 2) - 1);
              Canvas.LineTo(X + (W Div 2) - 1,Y - 1);
              Canvas.MoveTo(X,Y + (H Div 2) + 1);
              Canvas.LineTo(X + (W Div 2) + 1,Y + (H Div 2) + 1);
              Canvas.LineTo(X + (W Div 2) + 1,Y - 1);
            End;
      #191: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + (W Div 2),Y + (H Div 2));
              Canvas.LineTo(X + (W Div 2),Y + H);
            End;
      #192: Begin
              Canvas.MoveTo(X + (W Div 2),Y);
              Canvas.LineTo(X + (W Div 2),Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
            End;
      #193: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
              Canvas.MoveTo(X + (W Div 2),Y);
              Canvas.LineTo(X + (W Div 2),Y + (H Div 2));
            End;
      #194: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
              Canvas.MoveTo(X + (W Div 2),Y + (H Div 2));
              Canvas.LineTo(X + (W Div 2),Y + H);
            End;
      #195: Begin
              Canvas.MoveTo(X + (W Div 2),Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
              Canvas.MoveTo(X + (W Div 2),Y);
              Canvas.LineTo(X + (W Div 2),Y + H);
            End;
      #196: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
            End;
      #197: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
              Canvas.MoveTo(X + (W Div 2),Y);
              Canvas.LineTo(X + (W Div 2),Y + H);
            End;
      #200: Begin
              Canvas.MoveTo(X + (W Div 2) + 1,Y);
              Canvas.LineTo(X + (W Div 2) + 1,Y + (H Div 2) - 1);
              Canvas.LineTo(X + W,Y + (H Div 2) - 1);
              Canvas.MoveTo(X + (W Div 2) - 1,Y);
              Canvas.LineTo(X + (W Div 2) - 1,Y + (H Div 2) + 1);
              Canvas.LineTo(X + W,Y + (H Div 2) + 1);
            End;
      #201: Begin
              Canvas.MoveTo(X + (W Div 2) + 1,Y + H);
              Canvas.LineTo(X + (W Div 2) + 1,Y + (H Div 2) + 1);
              Canvas.LineTo(X + W,Y + (H Div 2) + 1);
              Canvas.MoveTo(X + (W Div 2) - 1,Y + H);
              Canvas.LineTo(X + (W Div 2) - 1,Y + (H Div 2) - 1);
              Canvas.LineTo(X + W,Y + (H Div 2) - 1);
            End;
      #205: Begin
              Canvas.MoveTo(X,Y + (H Div 2) - 1);
              Canvas.LineTo(X + W,Y + (H Div 2) - 1);
              Canvas.MoveTo(X,Y + (H Div 2) + 1);
              Canvas.LineTo(X + W,Y + (H Div 2) + 1);
            End;
      #217: Begin
              Canvas.MoveTo(X,Y + (H Div 2));
              Canvas.LineTo(X + (W Div 2),Y + (H Div 2));
              Canvas.LineTo(X + (W Div 2),Y - 1);
            End;
      #218: Begin
              Canvas.MoveTo(X + (W Div 2),Y + H);
              Canvas.LineTo(X + (W Div 2),Y + (H Div 2));
              Canvas.LineTo(X + W,Y + (H Div 2));
            End;
      #251: Begin
              Canvas.MoveTo(X + 1,Y + H - 4);
              Canvas.LineTo(X + (WS Div 2),Y + H - 1);
              Canvas.LineTo(X + WS,Y + 1);
            End;
    End; // Case
    Inc(X,W);
  End; // For I
End; // DScreen.VESAWriteTrue


Procedure DScreen.VESAMove(Var P: Array Of Byte; Source,Dest,NumBytes: LongInt);
Var X,Y,B,Col: LongInt;
Begin
  While NumBytes > 0 Do
  Begin
    B   := P[Source];
    Col := P[Source + 1];
    X   := (Dest Mod MaxY) * Canvas.TextWidth('M');
    Y   := (Dest Div MaxY) * Canvas.TextHeight('Mg');
    Canvas.Font.Color  := TextPalette[Col And $F];
    Canvas.Brush.Color := TextPalette[Col Shr 4];
    Canvas.TextOut(X,Y,Chr(B));
  End; // While
End; // DScreen.VESAMove


Procedure DScreen.FastWrite(X,Y: Integer; Color: Byte; S: String);
Begin
  If S <> '' Then VESAWriteTrue(X,Y,Color,S);
End; { DScreen.FastWrite }


Procedure DScreen.ShowCursor(Show: Boolean);
Begin
{
  If Show Then VESAShowCursor;
  If (Not Show) And CursorOn Then VESAHideCursor;
}  
  CursorOn := Show;
End; { DScreen.ShowCursor }


Procedure DScreen.SetCursor(MinC,MaxC: Byte);
Begin
  CursorStart := MinC;
  CursorEnd   := MaxC;
  ShowCursor(CursorOn);
End; { DScreen.SetCursor }


Procedure DScreen.ClrScr;
Var
  St : String;
  I  : Integer;
  V  : Boolean;

Begin
  St := '';
  V  := Variable;
  Variable := False;
  While Length(St) < Lo(WindMax) - Lo(WindMin) + 1 Do St := St + ' ';
  For I := Hi(WindMin) + 1 To Hi(WindMax) + 1 Do
   FastWrite(Lo(WindMin) + 1,I,TextAttr,St);
  ShowCursor(CursorOn);
  Variable := V;
End; { DScreen.ClrScr }


Procedure DScreen.Resize(ACanvas: TCanvas; W,H: Integer);
Begin
  Width       := W;
  Height      := H;
  Canvas      := ACanvas;
  SetFont;
End; // DScreen.Resize


Procedure DScreen.ClrEol;
Var
  St : String;
  V  : Boolean;

Begin
  St       := '';
  V        := Variable;
  Variable := False;
  While Length(St) < Lo(WindMax) - Lo(WindMin) - WhereX + 2 Do St := St + ' ';
  FastWrite(WhereX + Lo(WindMin),WhereY + Hi(WindMin),TextAttr,St);
  ShowCursor(CursorOn);
  Variable := V;
End; { DScreen.ClrEol }


Procedure DScreen.TextColor(Color: Byte);
Begin
  TextAttr := (TextAttr And $F0) + (Color And $F);
End; { DScreen.TextColor }


Procedure DScreen.TextBackground(Color: Byte);
Begin
  TextAttr := (TextAttr And $F) + (Color Shl 4);
End; { DScreen.TextBackground }


Procedure DScreen.SetTextAttr(Attr: Byte);
Begin
  TextAttr := Attr;
End; { DScreen.SetTextAttr }


Procedure DScreen.GotoXY(X,Y: Byte);
Begin
//  VESAHideCursor;
  WhereX := X;
  WhereY := Y;
  ShowCursor(CursorOn);
End; { DScreen.GotoXY }

Procedure DScreen.VESAScrollWindowUp;
Var I,J: Integer;
Begin
//  VESAHideCursor;
  J := Lo(WindMax) - Lo(WindMin) + 1;
  For I := Hi(WindMin) To Hi(WindMax) - 1 Do
  Begin
    VESAMove(CharBuf,((I + 1) * MaxX + Lo(WindMin)) * 2,
     (I * MaxX + Lo(WindMin)) * 2,J * 2);
  End; { For I }
  WhereY := Hi(WindMax) - Hi(WindMin) + 1;
  ClrEol;
End; { DScreen.VESAScrollWindowUp }

Procedure DScreen.Write(St: String);
Var Cursor: Boolean;
Begin
  Cursor := CursorOn;
  ShowCursor(False);
  If St <> '' Then
   FastWrite(WhereX + Lo(WindMin),WhereY + Hi(WindMin),TextAttr,St);
  Inc(WhereX,Length(St));
  While WhereX > (Lo(WindMax) - Lo(WindMin) + 1) Do
  Begin
    Dec(WhereX,Lo(WindMax) - Lo(WindMin) + 1);
    Inc(WhereY);
  End; { While }
  If WhereY > (Hi(WindMax) - Hi(WindMin) + 1) Then
   VESAScrollWindowUp;
  ShowCursor(Cursor);
End; { DScreen.Write }

Procedure DScreen.WriteLn(St: String);
Var Cursor : Boolean;
Begin
  Cursor := CursorOn;
  ShowCursor(False);
  If St <> '' Then
   FastWrite(WhereX + Lo(WindMin),WhereY + Hi(WindMin),TextAttr,St);
  WhereX := 1;
  Inc(WhereY);
  If WhereY > (Hi(WindMax) - Hi(WindMin) + 1) Then
   VESAScrollWindowUp;
  ShowCursor(Cursor);
End; { DScreen.WriteLn }

Procedure DScreen.FastMove(Var P: Array Of Byte; Source,Addr,NumBytes: LongInt);
Begin
//  VESAHideCursor;
  VESAMove(P,Source,Addr,NumBytes);
  ShowCursor(CursorOn);
End; { DScreen.FastMove }

Procedure DScreen.Window(X1,Y1,X2,Y2: Integer);
Begin
  Dec(Y1);
  Dec(Y2);
  WindMin := (X1 - 1) + (Y1 Shl 8);
  WindMax := (X2 - 1) + (Y2 Shl 8);
  WhereX  := 1;
  WhereY  := 1;
End; { DScreen.Window }

Procedure DScreen.WriteAt(X,Y: Integer; Fore,Back: Byte; _St: String);
Begin
  If _St <> '' Then
  Begin
    Inc(X,Lo(WindMin));
    Inc(Y,Hi(WindMin));
    FastWrite(X,Y,Fore + (Back Shl 4),_St);
  End;
End; { DScreen.WriteAt }


Procedure DScreen.WriteAtAttr(X,Y: Integer; Attr: Byte; _St: String);
Begin
  If _St <> '' Then
  Begin
    Inc(X,Lo(WindMin));
    Inc(Y,Hi(WindMin));
    FastWrite(X,Y,Attr,_St);
  End;  
End; { DScreen.WriteAtAttr }

{------------------------------- }
{ DSelection                     }
{------------------------------- }

Constructor DSelection.Create(_X,_Y,_Width: Integer;
                              Const _SelStr: ScreenStr;
                              _HotChar: Byte;
                              _Protected: Boolean;
                              _Checked: Boolean;
                              _WindowAttr: Byte;
                              _HotCharAttr: Byte;
                              _SelAttr: Byte;
                              _SelHotCharAttr: Byte;
                              _ProtectedAttr: Byte;
                              _SelProtAttr: Byte;
                              _Parent: DWindow);
Begin
  Inherited Create;
  X              := _X;
  Y              := _Y;
  Width          := _Width;
  SelStr         := _SelStr;
  HotChar        := _HotChar;
  IsProtected    := _Protected;
  Checked        := _Checked;
  WindowAttr     := _WindowAttr;
  HotCharAttr    := _HotCharAttr;
  SelAttr        := _SelAttr;
  SelHotCharAttr := _SelHotCharAttr;
  ProtectedAttr  := _ProtectedAttr;
  SelProtAttr    := _SelProtAttr;
  Parent         := _Parent;
  Asterisk       := False;
  Bar            := -1;
End; { DSelection.Init }

Destructor DSelection.Destroy;
Begin
  Inherited;
End; { DSelection.Done }

Procedure DSelection.Show(Selected: Boolean; Top: Integer);
Var St: ScreenStr;

  Procedure BlankLine(Attr: Byte);
  Begin
    Parent.Screen.TextAttr := Attr;
    Parent.Screen.GotoXY(X,Y - Top);
//    Parent.Screen.ClrEol;
  End; // BlankLine

Begin
  St := SelStr;
  If Checked Then
  Begin
    If St = '' Then St := ' ';
    St[1] := 'û';
  End;
  If Asterisk Then
  Begin
    If St = '' Then St := '  ';
    St[2] := '*';
  End;
  If Bar >= 0 Then
  Begin
    If St = '' Then St := '  ';
    Case (Bar And 3) Of
      0: St[2] := '-';
      1: St[2] := '/';
      2: St[2] := '³';
      3: St[2] := '\';
    End; { Case }
  End;
  While Length(St) < Width Do St := St + ' ';

  { Display the entry }

  If (Y - Top > 0) And (Y - Top < Hi(Parent.Screen.WindMax) - Hi(Parent.Screen.WindMin) + 2) Then
  Begin
    If Not IsProtected Then
    Begin
      If Not Selected Then
      Begin
        BlankLine(WindowAttr);
        Parent.Screen.WriteAtAttr(X,Y - Top,WindowAttr,St);
        If HotChar > 0 Then
         Parent.Screen.WriteAtAttr(X + HotChar - 1,Y - Top,HotCharAttr,Copy(St,HotChar,1));
      End
      Else
      Begin
        BlankLine(SelAttr);
        Parent.Screen.WriteAtAttr(X,Y - Top,SelAttr,St);
        If HotChar > 0 Then
         Parent.Screen.WriteAtAttr(X + HotChar - 1,Y - Top,SelHotCharAttr,Copy(St,HotChar,1));
      End;
    End
    Else
    Begin
      If Not Selected Then
      Begin
        BlankLine(ProtectedAttr);
        Parent.Screen.WriteAtAttr(X,Y - Top,ProtectedAttr,St);
        If HotChar > 0 Then
         Parent.Screen.WriteAtAttr(X + HotChar - 1,Y - Top,HotCharAttr,Copy(St,HotChar,1));
      End
      Else
      Begin
        BlankLine(SelProtAttr);
        Parent.Screen.WriteAtAttr(X,Y - Top,SelProtAttr,St);
        If HotChar > 0 Then
         Parent.Screen.WriteAtAttr(X + HotChar - 1,Y - Top,SelHotCharAttr,Copy(St,HotChar,1));
      End
    End;
  End;
End; { DSelection.Show }

{------------------------------- }
{ DWindow                        }
{------------------------------- }

Constructor DWindow.Create(_Width,_Height: Integer;
                           WFore,WBack,BFore,BBack,CFore,CBack: Byte;
                           BType: BorderType; CapTop,CapBot: ScreenStr;
                           _Parent: TWinControl = Nil);
Var TheForm: TForm;
Begin
  Inherited Create(Nil);
  If _Parent <> Nil Then
  Begin
    Parent := _Parent;
    If Parent Is TForm
     Then Form := TForm(_Parent)
     Else Form := TForm(_Parent.Owner);
    CreatedOwnForm := False;
  End
  Else
  Begin
    TheForm          := TForm.CreateNew(Application);
    Parent           := TheForm;
    Form             := TheForm;
    Form.Position    := poScreenCenter;
    Form.Caption     := '';
    Form.BorderStyle := bsToolWindow;
    Form.AutoScroll  := False;
    CreatedOwnForm   := True;
  End;
  Form.OnKeyDown    := DoKeyDown;
  Form.OnKeyUp      := DoKeyUp;
  OnMouseDown       := DoMouseDown;
  OnMouseUp         := DoMouseUp;
  OnMouseMove       := DoMouseMove;
  Canvas.Font.Name  := FontName;
  Canvas.Font.Size  := FontSize;
  Canvas.Font.Style := FontStyle;
  Top               := 0;
  Left              := 0;
  BlankOnPaint      := True;
  If CreatedOwnForm Then
  Begin
    Width             := _Width  * Canvas.TextWidth('M');
    Height            := _Height * Canvas.TextHeight('Mg');
    Form.ClientWidth  := Width;
    Form.ClientHeight := Height;
    X2                := _Width;
    Y2                := _Height;
  End
  Else
  Begin
    X2     := Form.ClientWidth  Div Canvas.TextWidth('M');
    Y2     := Form.ClientHeight Div Canvas.TextHeight('Mg');
    Width  := Parent.Width;
    Height := Parent.Height;
//    Width  := Form.ClientWidth;
//    Height := Form.ClientHeight;
  End;
  KeyCallbackDown   := Nil;
  KeyCallbackUp     := Nil;
  PaintCallback     := Nil;
  MouseDownCallback := Nil;
  MouseUpCallback   := Nil;
  MouseMoveCallback := Nil;
  MouseX            := -1;
  MouseY            := -1;
  Screen            := DScreen.Create(Canvas,Width,Height);
  WindowAttr        := (WFore And $F) + (WBack Shl 4);
  BorderAttr        := (BFore And $F) + (BBack Shl 4);
  CaptionAttr       := (CFore And $F) + (CBack Shl 4);
  CaptionTop        := CapTop;
  CaptionBot        := CapBot;
  Border            := BType;
  _Visible          := False;
  KeyBufRead        := 0;
  KeyBufWrite       := 0;
  Color             := TextPalette[(WindowAttr Shr 4) And $F];
  GetKeyboardState(OldKeyState);
End; { DWindow.Create }


Procedure DWindow.WriteFrame(Var R: Rect; CaptionTop,CaptionBot: String);
Var
  I         : Integer;
  V         : Boolean;
  WMin,WMax : Integer;
  XTop,XBot : Integer;

Begin
  V    := Screen.Variable;
  WMin := Screen.WindMin;
  WMax := Screen.WindMax;
  Screen.Window(1,1,Screen.MaxX,Screen.MaxY);
  Screen.Variable := False;
  XTop := (X2 Div 2) + 1 - (Length(CaptionTop) Div 2);
  XBot := (X2 Div 2) + 1 - (Length(CaptionBot) Div 2);
  If R.Active Then
  Begin
    Screen.WriteAt(R.X1,R.Y1,R.AFore,R.ABack,R.AUL);
    Screen.WriteAt(R.X2,R.Y1,R.AFore,R.ABack,R.AUR);
    Screen.WriteAt(R.X1,R.Y2,R.AFore,R.ABack,R.ABL);
    Screen.WriteAt(R.X2,R.Y2,R.AFore,R.ABack,R.ABR);
    For I := R.X1 + 1 To R.X2 - 1 Do
    Begin
      If ((I - R.X1 + 1) < XTop) Or
         ((I - R.X1 + 1) >= XTop + Length(CaptionTop))
       Then Screen.WriteAt(I,R.Y1,R.AFore,R.ABack,R.AHZ)
       Else Screen.WriteAt(I,R.Y1,R.AFore,R.ABack,' ');
      If ((I - R.X1 + 1) < XBot) Or
         ((I - R.X1 + 1) >= XBot + Length(CaptionBot))
       Then Screen.WriteAt(I,R.Y2,R.AFore,R.ABack,R.AHZ)
       Else Screen.WriteAt(I,R.Y2,R.AFore,R.ABack,' ');
    End; { For I }
    For I := R.Y1 + 1 To R.Y2 - 1 Do
    Begin
      Screen.WriteAt(R.X1,I,R.AFore,R.ABack,R.AVT);
      Screen.WriteAt(R.X2,I,R.AFore,R.ABack,R.AVT);
    End; { For I }
  End
  Else
  Begin
    Screen.WriteAt(R.X1,R.Y1,R.PFore,R.PBack,R.PUL);
    Screen.WriteAt(R.X2,R.Y1,R.PFore,R.PBack,R.PUR);
    Screen.WriteAt(R.X1,R.Y2,R.PFore,R.PBack,R.PBL);
    Screen.WriteAt(R.X2,R.Y2,R.PFore,R.PBack,R.PBR);
    For I := R.X1 + 1 To R.X2 - 1 Do
    Begin
      If ((I - R.X1 + 1) < XTop) Or
         ((I - R.X1 + 1) >= XTop + Length(CaptionTop))
       Then Screen.WriteAt(I,R.Y1,R.PFore,R.PBack,R.PHZ)
       Else Screen.WriteAt(I,R.Y1,R.PFore,R.PBack,' ');
      If ((I - R.X1 + 1) < XBot) Or
         ((I - R.X1 + 1) >= XBot + Length(CaptionBot))
       Then Screen.WriteAt(I,R.Y2,R.PFore,R.PBack,R.PHZ)
       Else Screen.WriteAt(I,R.Y2,R.PFore,R.PBack,' ');
    End; { For I }
    For I := R.Y1 + 1 To R.Y2 - 1 Do
    Begin
      Screen.WriteAt(R.X1,I,R.PFore,R.PBack,R.PVT);
      Screen.WriteAt(R.X2,I,R.PFore,R.PBack,R.PVT);
    End; { For I }
  End;
  Screen.Variable := V;
  Screen.WindMin := WMin;
  Screen.WindMax := WMax;
End; { DWindow.WriteFrame }

Procedure DWindow.Paint;
Var
  KeyState : TKeyboardState;
  PW,PH    : Integer;

Begin
  GetKeyboardState(KeyState);
  KeyState[VK_NUMLOCK] := KeyState[VK_NUMLOCK] Or 1;
  SetKeyboardState(KeyState);

  Screen.SetFont;

  If Width  <> X2 * Canvas.TextWidth('M')   Then Width  := X2 * Canvas.TextWidth('M');
  If Height <> Y2 * Canvas.TextHeight('Mg') Then Height := Y2 * Canvas.TextHeight('Mg');

  If CreatedOwnForm Then
  Begin
    PW := Form.ClientWidth;
    PH := Form.ClientHeight;
  End
  Else
  Begin
    PW := Parent.Width;
    PH := Parent.Height;
  End;

  If (PW <> Width) Or (PH <> Height) Then
  Begin
    If CreatedOwnForm Then
    Begin
      Form.ClientWidth  := Width;
      Form.ClientHeight := Height;
      PW := Form.ClientWidth;
      PH := Form.ClientHeight;
      X2 := PW Div Canvas.TextWidth('M');
      Y2 := PH Div Canvas.TextHeight('Mg');
    End;
    Screen.Resize(Canvas,Width,Height);
  End;

  If Not Form.Visible Then Form.ShowModal;

  LastWindMin := Screen.WindMin;
  LastWindMax := Screen.WindMax;
  Screen.Window(1,1,Screen.MaxX,Screen.MaxY);

  Screen.SetTextAttr(BorderAttr);
  WindowRect.X1 := 1;
  WindowRect.Y1 := 1;
  WindowRect.X2 := X2;
  WindowRect.Y2 := Y2;
  WindowRect.AFore := BorderAttr And $F;
  WindowRect.ABack := BorderAttr Shr 4;
  WindowRect.PFore := BorderAttr And $F;
  WindowRect.PBack := BorderAttr Shr 4;
  Case Border Of
    SingleBorder: WindowRect.Active := False;
    DoubleBorder: WindowRect.Active := True;
  End; { Case }
  If Border <> NoBorder Then
  Begin
    WriteFrame(WindowRect,CaptionTop,CaptionBot);
    Screen.Window(1,1,X2,Y2);
    If CaptionTop <> '' Then
    Begin
      Screen.SetTextAttr(CaptionAttr);
      Screen.WriteAtAttr((X2 Div 2) + 1 - (Length(CaptionTop) Div 2),1,
       CaptionAttr,CaptionTop);
    End;
    If CaptionBot <> '' Then
    Begin
      Screen.SetTextAttr(CaptionAttr);
      Screen.WriteAtAttr((X2 Div 2) + 1 - (Length(CaptionBot) Div 2),Y2,
       CaptionAttr,CaptionBot);
    End;
    Screen.Window(2,2,X2 - 1,Y2 - 1);
  End
  Else Screen.Window(1,1,X2,Y2);
  Screen.SetTextAttr(WindowAttr);
  If BlankOnPaint Then Screen.ClrScr;
  _Visible := True;
  If Assigned(PaintCallBack) Then PaintCallBack;
End; { DWindow.Paint }

Procedure DWindow.Remove;
Begin
  _Visible := False;
  SetKeyboardState(OldKeyState);
  Form.Close;
End; { DWindow.Remove }

Destructor DWindow.Destroy;
Begin
  Parent := Nil;
  If _Visible Then Remove;
  Screen.Free;
  Inherited;
End; { DWindow.Done }

Procedure DWindow.DoKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Var
  I        : Integer;
  KeyState : TKeyboardState;

Begin
  LoadKeyArray;
  I := KeyBufWrite + 1;
  If I >= MaxBufferSize Then I := 0;
  If I <> KeyBufRead Then
  Begin
    KeyBuffer[KeyBufWrite] := VKLo(Key,Shift);
    KeyBufWrite := I;
    If VKNum(Key,Shift) = 2 Then
    Begin
      I := KeyBufWrite + 1;
      If I >= MaxBufferSize Then I := 0;
      If I <> KeyBufRead Then
      Begin
        KeyBuffer[KeyBufWrite] := VKHi(Key,Shift);
        KeyBufWrite := I;
      End;
    End;
  End;
  If Assigned(KeyCallbackDown) Then KeyCallbackDown;

  GetKeyboardState(KeyState);
  KeyState[VK_NUMLOCK] := KeyState[VK_NUMLOCK] Or 1;
  SetKeyboardState(KeyState);
  Key := 0;
End; // DWindow.DoKeyDown

Procedure DWindow.DoKeyUp(Sender: TObject; Var Key: Word; Shift: TShiftState);
Var KeyState: TKeyboardState;
Begin
  GetKeyboardState(KeyState);
  KeyState[Key] := KeyState[Key] And $7F;
  SetKeyboardState(KeyState);
  LoadKeyArray;
  Key := 0;
  If Assigned(KeyCallbackUp) Then KeyCallbackUp;
  GetKeyboardState(KeyState);
  KeyState[VK_NUMLOCK] := KeyState[VK_NUMLOCK] Or 1;
  SetKeyboardState(KeyState);
End; // DWindow.DoKeyUp

Procedure DWindow.DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
  MouseX := X;
  MouseY := Y;
  If Assigned(MouseDownCallBack) Then MouseDownCallBack(Button,Shift,X,Y);
End; // DWindow.DoMouseDown

Procedure DWindow.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
  MouseX := X;
  MouseY := Y;
  If Assigned(MouseUpCallBack) Then MouseUpCallBack(Button,Shift,X,Y);
End; // DWindow.DoMouseUp

Procedure DWindow.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Begin
  MouseX := X;
  MouseY := Y;
  If Assigned(MouseMoveCallBack) Then MouseMoveCallBack(Shift,X,Y);
End; // DWindow.DoMouseMove

Function DWindow.KeyPressed: Boolean;
Begin
  KeyPressed := (KeyBufRead <> KeyBufWrite);
End; // KeyPressed;

Function DWindow.ReadKey: Char;
Begin
  If Not KeyPressed Then
   Repeat
     Application.ProcessMessages;
   Until KeyPressed;
  ReadKey := KeyBuffer[KeyBufRead];
  Inc(KeyBufRead);
  If KeyBufRead >= MaxBufferSize Then KeyBufRead := 0;
End; // DWindow.ReadKey

Function DWindow.BufLen(WX,WY: Integer; InitString: String; Fore,Back: Byte; MaxLen,WindowLen: Integer): String;
{ ---------------------------------------------------------------------- }
{ Allows the user to type in a text string                               }
{    X .................. X coord of text input box                      }
{    Y .................. Y coord of text input box                      }
{    InitString ......... Initial text string                            }
{    Fore ............... Text foreground color                          }
{    Back ............... Text background color                          }
{    MaxLen ............. Maximum string length                          }
{    WindowLen .......... Displayed string length, for scrollable window }
{ ---------------------------------------------------------------------- }
Var
  Work : String;
  Ch   : Char;
  Ch1  : Char;
  _Top : Integer;
  X    : Integer;
  Ins  : Boolean;
  On   : Boolean;
  Key  : Boolean;

  Procedure Cursor;
  { --------------------------------- }
  { Toggle to display/hide the cursor }
  { --------------------------------- }
  Begin
    On := Not On;
    If On Then
    Begin
      If Ins Then Screen.SetCursor(6,7) Else Screen.SetCursor(0,7);
    End;
    Screen.ShowCursor(On);
    Screen.GotoXY(WX + X - _Top,WY);
  End; { Cursor }


  Procedure WriteStr;
  Var St : String;
  Begin
    St := Copy(Work,_Top,WindowLen);
    While Length(St) < WindowLen Do St := St + ' ';
    Screen.GotoXY(WX,WY);
    Screen.Write(St);
    Screen.GotoXY(WX + X - _Top,WY);
  End; { WriteStr }


  Procedure ScrollLeft;
  { --------------------------- }
  { Scroll the text window left }
  { --------------------------- }
  Begin
    Inc(_Top);
    WriteStr;
  End; { ScrollLeft }


  Procedure ScrollRight;
  { ---------------------------- }
  { Scroll the text window right }
  { ---------------------------- }
  Begin
    Dec(_Top);
    WriteStr;
  End; { ScrollRight }

Begin

  { Blank the window }

  Screen.TextColor(Fore);
  Screen.TextBackground(Back);
  Work := InitString;{'';}
  While Length(Work) < WindowLen Do Work := Work + ' ';
  Screen.GotoXY(WX,WY);
  Screen.Write(Work);
  Screen.GotoXY(WX,WY);

  Work := InitString;{'';}
  _Top := 1;
  X    := 1;
  Ins  := True;
  On   := False;
  Key  := False;

  Cursor;
  Ch := ' ';
  While Not (Ch In [#13,#27]) Do
  Begin
    If KeyPressed Then
    Begin
      Ch := ReadKey;
      Case Ch Of
   #13,#27: Begin
            End;
        #8: Begin                                   { Backspace }
              If X > 1 Then
              Begin
                Cursor;
                Delete(Work,X - 1,1);
                If X > _Top Then WriteStr;
                Dec(X);
                If X < _Top Then ScrollRight;
                Cursor;
              End;
            End;
        #0: Begin
              While Not KeyPressed Do Begin End;
              Ch1 := ReadKey;
              Case Ch1 Of
                #71: If X > 1 Then                  { Home }
                     Begin
                       Cursor;
                       If _Top <> 1 Then
                       Begin
                         _Top := 1;
                         WriteStr;
                       End;
                       X := 1;
                       Cursor;
                     End;
                #75: If X > 1 Then                  { Cursor Left }
                     Begin
                       Cursor;
                       Dec(X);
                       If X < _Top Then ScrollRight;
                       Cursor;
                     End;
                #77: If X <= Length(Work) Then      { Cursor Right }
                     Begin
                       Cursor;
                       Inc(X);
                       If X - _Top = WindowLen Then ScrollLeft;
                       Cursor;
                     End;
                #79: If X <= Length(Work) Then      { End }
                     Begin
                       Cursor;
                       If _Top < Length(Work) - WindowLen + 2 Then
                       Begin
                         _Top := Length(Work) - WindowLen + 2;
                         WriteStr;
                       End;
                       X := Length(Work) + 1;
                       Cursor;
                     End;
                #82: Begin                          { Insert }
                       Cursor;
                       Ins := Not Ins;
                       Cursor;
                     End;
                #83: Begin                          { Delete }
                       If ((Work <> '') And (X <= Length(Work))) Then
                       Begin
                         Cursor;
                         Delete(Work,X,1);
                         WriteStr;
                         Cursor;
                       End;
                     End;
              End; { Case }
            End;
      Else
        Cursor;
        If Not Key Then
        Begin
          Work := Ch;    { If the user just started typing, replace the }
          WriteStr;      { string outright                              }
          Key := True;
        End
        Else
        Begin
          If (X > Length(Work)) Or Ins Then
          Begin
            If (Length(Work) < MaxLen) Then
            Begin
              Insert(Ch,Work,X);
              WriteStr;
            End;
          End
          Else
          Begin
            Work[X] := Ch;
            WriteStr;
          End;
        End;
        If Not ((X > Length(Work)) And (Length(Work) = MaxLen)) Then
        Begin
          Inc(X);
          { Check to see if I must scroll the text left }
          If X - _Top = WindowLen Then ScrollLeft;
        End;
        Cursor;
      End; { Case }
    End;
  End; { While }
  If Ch = #27 Then Work := InitString;
  Screen.GotoXY(WX,WY);
  WriteStr;
  BufLen := Work;
End; { DWindow.BufLen }

Procedure DWindow.DoResize(Form: TForm);
Begin
  Screen.SetFont;
  Screen.Resize(Canvas,Width,Height);
  If CreatedOwnForm Then
  Begin
    Width  := Form.ClientWidth;
    Height := Form.ClientHeight;
  End
  Else
  Begin
    Width  := Parent.Width;
    Height := Parent.Height;
  End;
  X2 := Width  Div Canvas.TextWidth('M');
  Y2 := Height Div Canvas.TextHeight('Mg');
  If _Visible Then
  Begin
    _Visible := False;
    Repaint;
  End;  
End; // DWindow.DoResize

{------------------------------- }
{ DMenu                          }
{------------------------------- }

Constructor DMenu.Create(_Width,_Height: Integer;
                         WFore,WBack,BFore,BBack,CFore,CBack,HCFore,HCBack,
                         SFore,SBack,SHCFore,SHCBack,PFore,PBack,SPFore,SPBack: Byte;
                         BType: BorderType; CapTop,CapBot: ScreenStr;
                         _Parent: TWinControl = Nil);
Begin
  Inherited Create(_Width,_Height,WFore,WBack,BFore,BBack,CFore,CBack,BType,CapTop,CapBot,_Parent);
  HotCharAttr     := (HCFore  And $F) + (HCBack  Shl 4);
  SelAttr         := (SFore   And $F) + (SBack   Shl 4);
  SelHotCharAttr  := (SHCFore And $F) + (SHCBack Shl 4);
  ProtectedAttr   := (PFore   And $F) + (PBack   Shl 4);
  SelProtAttr     := (SPFore  And $F) + (SPBack  Shl 4);
  CurSel          := 1;
  OldSel          := 0;
  SelList         := TStringList.Create;
  Callback        := Nil;
  _Top            := 0;
  MaxSelY         := 0;
  Form.OnClose    := OnClose;
  KeyCallBackDown := OnMenuKeyDown;
  KeyHit          := False;
  BlankOnPaint    := False;
  Timer           := TTimer.Create(Form);
  Timer.Interval  := MenuTimerInterval;
  Timer.OnTimer   := OnTimer;
  Timer.Enabled   := True;
End; { DMenu.Create }


Procedure DMenu.AddSelection(_X,_Y,SelWidth: Integer; HotCh: Byte;
                             Protect,Checked: Boolean; St: ScreenStr);
Begin
  SelList.AddObject('',DSelection.Create(_X,_Y,SelWidth,St,HotCh,Protect,Checked,
                    WindowAttr,HotCharAttr,SelAttr,SelHotCharAttr,ProtectedAttr,
                    SelProtAttr,Self));
  If _Y > MaxSelY Then MaxSelY := _Y;
  CurSel := 0;
End; { DMenu.AddSelection }


Function DMenu.GetSelection(Sel: Integer): DSelection;
Begin
  If (Sel >= 1) And (Sel <= SelList.Count)
   Then GetSelection := DSelection(SelList.Objects[Sel - 1])
   Else GetSelection := Nil;
End; { DMenu.GetSelection }


Procedure DMenu.SetSelection(Sel: Integer);
Var SelWork: DSelection;
Begin
  If (Sel <> OldSel) And (SelList.Count > 0) Then
  Begin
    CurSel  := Sel;
    If (OldSel > 0) And (OldSel <= SelList.Count) Then
    Begin
      SelWork := DSelection(SelList.Objects[OldSel - 1]);
      SelWork.Show(False,_Top);
    End;
    OldSel := CurSel;
    If (OldSel > 0) And (OldSel <= SelList.Count) Then
    Begin
      SelWork := DSelection(SelList.Objects[OldSel - 1]);
      SelWork.Show(True,_Top);
    End;
  End;
End; { DMenu.SetSelection }


Procedure DMenu.WriteArrows(Up,Down: Boolean);
Var
  UpSt,DnSt : String[1];
  WMin,WMax : Word;
  V         : Boolean;

Begin
  V := Screen.Variable;
  Screen.Variable := False;
  WMin := Screen.WindMin;
  WMax := Screen.WindMax;
  Screen.Window(1,1,Screen.MaxX,Screen.MaxY);
  If Border = DoubleBorder Then
  Begin
    If Up   Then UpSt := #24 Else UpSt := WindowRect.AVT;
    If Down Then DnSt := #25 Else DnSt := WindowRect.AVT;
  End
  Else
  Begin
    If Up   Then UpSt := #24 Else UpSt := WindowRect.PVT;
    If Down Then DnSt := #25 Else DnSt := WindowRect.PVT;
  End;
  If Up
   Then Screen.WriteAt(X2,2,BorderAttr Shr 4 ,BorderAttr And $F,UpSt)
   Else Screen.WriteAt(X2,2,BorderAttr And $F,BorderAttr Shr 4 ,UpSt);
  If Down
   Then Screen.WriteAt(X2,Y2 - 1,BorderAttr Shr 4 ,BorderAttr And $F,DnSt)
   Else Screen.WriteAt(X2,Y2 - 1,BorderAttr And $F,BorderAttr Shr 4 ,DnSt);
  Screen.Window(Lo(WMin) + 1,Hi(WMin) + 1,Lo(WMax) + 1,Hi(WMax) + 1);
  Screen.Variable := V;
End; { DMenu.WriteArrows }


Procedure DMenu.Paint;
Var
  SelWork : DSelection;
  I,W,H   : Integer;

Begin
  Inherited;
//  If Assigned(Callback) Then Callback;
  I := 1;
  While I <= SelList.Count Do
  Begin
    SelWork := DSelection(SelList.Objects[I - 1]);
    SelWork.Show(I = CurSel,_Top);
    Inc(I);
  End; { While }
  If CurSel <= 0 Then CurSel := 1;
  SetSelection(CurSel);
  WriteArrows(_Top > 0,_Top < MaxSelY - (Y2 - 2));
  If (HiliteItem >= 0) And (HiliteItem < SelList.Count) Then
  Begin
    SelWork := DSelection(SelList.Objects[HiliteItem]);
    W       := Screen.Canvas.TextWidth('M');
    H       := Screen.Canvas.TextHeight('Mg');
    Canvas.Pen.Color   := TextPalette[CaptionAttr And $F];
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(SelWork.X * W,SelWork.Y * H,(SelWork.X + SelWork.Width) * W,(SelWork.Y + 1) * H);
    Canvas.Brush.Style := bsSolid;
  End;
End; { DMenu.Paint }


Procedure DMenu.OnClose(Sender: TObject; var Action: TCloseAction);
Begin
  If Not KeyHit Then SetSelection(0);
  Action := caHide;
End; // DMenu.OnClose


Procedure DMenu.DisplaySelection(Sel: Integer);
Var SelWork: DSelection;
Begin
  If (Sel >= 1) And (Sel <= SelList.Count) Then
  Begin
    SelWork := DSelection(SelList.Objects[Sel - 1]);
    SelWork.Show(Sel = CurSel,_Top);
  End;
End; { DMenu.DisplaySelection }


Destructor DMenu.Destroy;
Begin
  SelList.Free;
  Timer.Free;
  Inherited;
End; { DMenu.Done }


Procedure DMenu.CheckTop;
Var Sel: DSelection;
Begin
  Sel := GetSelection(CurSel);
  If Sel.Y - _Top > Y2 - 2 Then
  Begin
    _Top := Sel.Y - (Y2 - 2);
    Repaint;
  End;
  If Sel.Y - _Top < 1 Then
  Begin
    _Top := Sel.Y - 1;
    Repaint;
  End;
End; { DMenu.CheckTop }


Procedure DMenu.Execute;
Begin
  KeyHit     := False;
  HiliteItem := -1;
  If Not Form.Visible Then Form.ShowModal;
  Remove;
End; // DMenu.Execute


Procedure DMenu.OnMenuKeyDown;
Var
  Key       : Char;
  ScanCode  : Char;
  SelWork   : DSelection;
  Sel       : Integer;
  FoundChar : Boolean;
  Found     : Boolean;
  Y         : Integer;
  I         : Integer;

Begin
  KeyHit := False;
  If KeyPressed Then
  Begin
    Key := UpCase(ReadKey);
    Case Key Of
      Key_Esc:
      Begin
        SetSelection(0);
        KeyHit := True;
        Remove;
      End;
      Key_Enter:
      Begin
        SelWork := DSelection(SelList.Objects[CurSel - 1]);
        If Not SelWork.IsProtected Then
        Begin
          KeyHit := True;
          Remove;
        End;
      End;
      Key_Null:
      Begin
        ScanCode := ReadKey;
        Case ScanCode Of
          Key_Up: Begin
                    Sel := CurSel - 1;
                    If Sel < 1 Then Sel := SelList.Count;
                    While (Sel <> CurSel) And GetSelection(Sel).IsProtected Do
                    Begin
                      Dec(Sel);
                      If Sel < 1 Then Sel := SelList.Count;
                    End; { While }
                    SetSelection(Sel);
                    CheckTop;
                  End;
        Key_Down: Begin
                    Sel := CurSel + 1;
                    If Sel > SelList.Count Then Sel := 1;
                    While (Sel <> CurSel) And GetSelection(Sel).IsProtected Do
                    Begin
                      Inc(Sel);
                      If Sel > SelList.Count Then Sel := 1;
                    End; { While }
                    SetSelection(Sel);
                    CheckTop;
                  End;
        Key_Left: Begin
                    Sel   := CurSel;
                    Y     := GetSelection(CurSel).Y;
                    Found := False;
                    Repeat
                      Dec(Sel);
                      If Sel > 0 Then
                      Begin
                        SelWork := GetSelection(Sel);
                        If (SelWork.Y = Y) And Not SelWork.IsProtected Then Found := True;
                      End;
                    Until (Sel < 1) Or Found;
                    If Found Then
                    Begin
                      SetSelection(Sel);
                      CheckTop;
                    End;
                  End;
       Key_Right: Begin
                    Sel   := CurSel;
                    Y     := GetSelection(CurSel).Y;
                    Found := False;
                    Repeat
                      Inc(Sel);
                      If Sel <= SelList.Count Then
                      Begin
                        SelWork := GetSelection(Sel);
                        If (SelWork.Y = Y) And Not SelWork.IsProtected Then Found := True;
                      End;
                    Until (Sel > SelList.Count) Or Found;
                    If Found Then
                    Begin
                      SetSelection(Sel);
                      CheckTop;
                    End;
                  End;
        Key_Home: Begin
                    Sel := 1;
                    While (Sel < SelList.Count) And GetSelection(Sel).IsProtected Do Inc(Sel);
                    SetSelection(Sel);
                    CheckTop;
                  End;
         Key_End: Begin
                    Sel := SelList.Count;
                    While (Sel > 1) And GetSelection(Sel).IsProtected Do Dec(Sel);
                    SetSelection(Sel);
                    CheckTop;
                  End;
        End; { Case }
      End;
      Else
      Begin
        FoundChar := False;
        I         := CurSel;
        Repeat
          SelWork := DSelection(SelList.Objects[I - 1]);
          If (SelWork.HotChar > 0) And
             (Key = UpCase(SelWork.SelStr[SelWork.HotChar])) And
             Not SelWork.IsProtected Then FoundChar := True
          Else
          Begin
            Inc(I);
            If I > SelList.Count Then I := 1;
          End;
        Until (I = CurSel) Or FoundChar;
        If FoundChar Then
        Begin
          SetSelection(I);
          KeyHit := True;
          Remove;
        End;
      End;
    End; { Case }
  End;
End; { DMenu.OnMenuKeyDown }

Procedure DMenu.Remove;
Begin
  OldSel := 0;
  Inherited;
End; { DMenu.Remove }

Function DMenu.ItemFromXY(X,Y: Integer): Integer;
Var
  I,SX,SY,W,H : Integer;
  Found       : Boolean;
  SelWork     : DSelection;

Begin
  W  := Screen.Canvas.TextWidth('M');
  H  := Screen.Canvas.TextHeight('Mg');
  SX := X Div W;
  SY := Y Div H;
  If (SX >= 1) And (SY >= 1) And (SX < X2 - 1) And (SY < Y2 - 1) Then
  Begin
    I     := 0;
    Found := False;
    While (I < SelList.Count) And Not Found Do
    Begin
      SelWork := DSelection(SelList.Objects[I]);
      If (SX >= SelWork.X) And
         (SX < SelWork.X + SelWork.Width) And
         (SY = SelWork.Y - _Top) And
         Not SelWork.IsProtected Then Found := True Else Inc(I);
    End; // While
    If Found Then ItemFromXY := I Else ItemFromXY := -1;
  End
  Else ItemFromXY := -1;
End; // DMenu.ItemFromXY

Procedure DMenu.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var I: Integer;
Begin
  Inherited;
  Case Button Of
    mbLeft:
    Begin
      I := ItemFromXY(X,Y);
      If I >= 0 Then
      Begin
        SetSelection(I + 1);
        CheckTop;
        KeyHit := True;
        Remove;
      End;
    End;
    mbRight:
    Begin
      SetSelection(0);
      KeyHit := True;
      Remove;
    End;
  End; // Case
End; // DMenu.DoMouseUp

Procedure DMenu.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Var I: Integer;
Begin
  Inherited;
  I := ItemFromXY(X,Y);
  If I >= 0 Then
  Begin
    If HiliteItem <> I Then
    Begin
      HiliteItem := I;
      Paint;
    End;
  End
  Else
  Begin
    If HiliteItem >= 0 Then
    Begin
      HiliteItem := -1;
      Paint;
    End;
  End;
End; // DMenu.DoMouseMove

Procedure DMenu.OnTimer(Sender: TObject);
Begin
  If Assigned(Callback) Then Callback;
End; // DMenu.OnTimer

End.
