fpc/fvision/dialogs.pas

{ $Id$  }
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{                                                          }
{   System independent GRAPHICAL clone of DIALOGS.PAS      }
{                                                          }
{   Interface Copyright (c) 1992 Borland International     }
{                                                          }
{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
{   [email protected]  - primary e-mail addr           }
{   [email protected] - backup e-mail addr            }
{                                                          }
{****************[ THIS CODE IS FREEWARE ]*****************}
{                                                          }
{     This sourcecode is released for the purpose to       }
{   promote the pascal language on all platforms. You may  }
{   redistribute it and/or modify with the following       }
{   DISCLAIMER.                                            }
{                                                          }
{     This SOURCE CODE is distributed "AS IS" WITHOUT      }
{   WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR     }
{   ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED.     }
{                                                          }
{*****************[ SUPPORTED PLATFORMS ]******************}
{                                                          }
{ Only Free Pascal Compiler supported                      }
{                                                          }
{**********************************************************}

UNIT Dialogs;

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                  INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}

{==== Compiler directives ===========================================}


{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}

USES
   {$IFDEF OS_WINDOWS}                                { WIN/NT CODE }
       Windows,                                       { Standard units }
   {$ENDIF}

   {$IFDEF OS_OS2}                                    { OS2 CODE }
     OS2Def, OS2Base, OS2PMAPI,                       { Standard units }
   {$ENDIF}

   GFVGraph,                                          { GFV standard unit }
   Common, Objects, Drivers, Views, Validate;         { Standard GFV units }

{***************************************************************************}
{                              PUBLIC CONSTANTS                             }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                        COLOUR PALETTE DEFINITIONS                         }
{---------------------------------------------------------------------------}
CONST
   CGrayDialog    = #32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47 +
                    #48#49#50#51#52#53#54#55#56#57#58#59#60#61#62#63;
   CBlueDialog    = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79 +
                    #80#81#82#83#84#85#86#87#88#89#90#91#92#92#94#95;
   CCyanDialog    = #96#97#98#99#100#101#102#103#104#105#106#107#108 +
                    #109#110#111#112#113#114#115#116#117#118#119#120 +
                    #121#122#123#124#125#126#127;
   CStaticText    = #6#7#8#9;
   CLabel         = #7#8#9#9;
   CButton        = #10#11#12#13#14#14#14#15;
   CCluster       = #16#17#18#18#31#6;
   CInputLine     = #19#19#20#21#14;
   CHistory       = #22#23;
   CHistoryWindow = #19#19#21#24#25#19#20;
   CHistoryViewer = #6#6#7#6#6;

   CDialog = CGrayDialog;                             { Default palette }


{---------------------------------------------------------------------------}
{                     TDialog PALETTE COLOUR CONSTANTS                      }
{---------------------------------------------------------------------------}
CONST
   dpBlueDialog = 0;                                  { Blue dialog colour }
   dpCyanDialog = 1;                                  { Cyan dialog colour }
   dpGrayDialog = 2;                                  { Gray dialog colour }

{---------------------------------------------------------------------------}
{                           TButton FLAGS MASKS                             }
{---------------------------------------------------------------------------}
CONST
   bfNormal    = $00;                                 { Normal displayed }
   bfDefault   = $01;                                 { Default command }
   bfLeftJust  = $02;                                 { Left just text }
   bfBroadcast = $04;                                 { Broadcast command }
   bfGrabFocus = $08;                                 { Grab focus }

{---------------------------------------------------------------------------}
{          TMultiCheckBoxes FLAGS - (HiByte = Bits LoByte = Mask)           }
{---------------------------------------------------------------------------}
CONST
   cfOneBit    = $0101;                               { One bit masks }
   cfTwoBits   = $0203;                               { Two bit masks }
   cfFourBits  = $040F;                               { Four bit masks }
   cfEightBits = $08FF;                               { Eight bit masks }

{---------------------------------------------------------------------------}
{                        DIALOG BROADCAST COMMANDS                          }
{---------------------------------------------------------------------------}
CONST
   cmRecordHistory = 60;                              { Record history cmd }

{***************************************************************************}
{                            RECORD DEFINITIONS                             }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                          ITEM RECORD DEFINITION                           }
{---------------------------------------------------------------------------}
TYPE
   PSItem = ^TSItem;
   TSItem = RECORD
     Value: PString;                                  { Item string }
     Next: PSItem;                                    { Next item }
   END;

{***************************************************************************}
{                            OBJECT DEFINITIONS                             }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                      TDialog OBJECT - DIALOG OBJECT                       }
{---------------------------------------------------------------------------}
TYPE
   TDialog = OBJECT (TWindow)
      CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr);
      CONSTRUCTOR Load (Var S: TStream);
      FUNCTION GetPalette: PPalette; Virtual;
      FUNCTION Valid (Command: Word): Boolean; Virtual;
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
   END;
   PDialog = ^TDialog;

{---------------------------------------------------------------------------}
{                   TInputLine OBJECT - INPUT LINE OBJECT                   }
{---------------------------------------------------------------------------}
TYPE
   TInputLine = OBJECT (TView)
         MaxLen: Integer;                             { Max input length }
         CurPos: Integer;                             { Cursor position }
         FirstPos: Integer;                           { First position }
         SelStart: Integer;                           { Selected start }
         SelEnd: Integer;                             { Selected end }
         Data: PString;                               { Input line data }
         Validator: PValidator;                       { Validator of view }
      CONSTRUCTOR Init (Var Bounds: TRect; AMaxLen: Integer);
      CONSTRUCTOR Load (Var S: TStream);
      DESTRUCTOR Done; Virtual;
      FUNCTION DataSize: Word; Virtual;
      FUNCTION GetPalette: PPalette; Virtual;
      FUNCTION Valid (Command: Word): Boolean; Virtual;
      PROCEDURE Draw; Virtual;
      PROCEDURE DrawCursor; Virtual;
      PROCEDURE DrawbackGround; Virtual;
      PROCEDURE SelectAll (Enable: Boolean);
      PROCEDURE SetValidator (AValid: PValidator);
      PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
      PROCEDURE GetData (Var Rec); Virtual;
      PROCEDURE SetData (Var Rec); Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
      PRIVATE
      FUNCTION CanScroll (Delta: Integer): Boolean;
   END;
   PInputLine = ^TInputLine;

{---------------------------------------------------------------------------}
{                  TButton OBJECT - BUTTON ANCESTOR OBJECT                  }
{---------------------------------------------------------------------------}
TYPE
   TButton = OBJECT (TView)
         AmDefault: Boolean;                          { If default button }
         Flags    : Byte;                             { Button flags }
         Command  : Word;                             { Button command }
         Title    : PString;                          { Button title }
      CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ACommand: Word;
        AFlags: Word);
      CONSTRUCTOR Load (Var S: TStream);
      DESTRUCTOR Done; Virtual;
      FUNCTION GetPalette: PPalette; Virtual;
      PROCEDURE Press; Virtual;
      PROCEDURE DrawFocus; Virtual;
      PROCEDURE DrawState (Down: Boolean);
      PROCEDURE MakeDefault (Enable: Boolean);
      PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
      PRIVATE
      DownFlag: Boolean;
   END;
   PButton = ^TButton;

{---------------------------------------------------------------------------}
{                 TCluster OBJECT - CLUSTER ANCESTOR OBJECT                 }
{---------------------------------------------------------------------------}
TYPE
   TCluster = OBJECT (TView)
         Id        : Integer;                         { New communicate id }
         Sel       : Integer;                         { Selected item }
         Value     : LongInt;                         { Bit value }
         EnableMask: LongInt;                         { Mask enable bits }
         Strings   : TStringCollection;               { String collection }
      CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem);
      CONSTRUCTOR Load (Var S: TStream);
      DESTRUCTOR Done; Virtual;
      FUNCTION DataSize: Word; Virtual;
      FUNCTION GetHelpCtx: Word; Virtual;
      FUNCTION GetPalette: PPalette; Virtual;
      FUNCTION Mark (Item: Integer): Boolean; Virtual;
      FUNCTION MultiMark (Item: Integer): Byte; Virtual;
      FUNCTION ButtonState (Item: Integer): Boolean;
      PROCEDURE DrawFocus;                                           Virtual;
      PROCEDURE Press (Item: Integer); Virtual;
      PROCEDURE MovedTo (Item: Integer); Virtual;
      PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
      PROCEDURE DrawMultiBox (Const Icon, Marker: String);
      PROCEDURE DrawBox (Const Icon: String; Marker: Char);
      PROCEDURE SetButtonState (AMask: Longint; Enable: Boolean);
      PROCEDURE GetData (Var Rec); Virtual;
      PROCEDURE SetData (Var Rec); Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE HandleEvent (Var Event: TEvent);                     Virtual;
      PRIVATE
      FUNCTION FindSel (P: TPoint): Integer;
      FUNCTION Row (Item: Integer): Integer;
      FUNCTION Column (Item: Integer): Integer;
   END;
   PCluster = ^TCluster;

{---------------------------------------------------------------------------}
{                TRadioButtons OBJECT - RADIO BUTTON OBJECT                 }
{---------------------------------------------------------------------------}
TYPE
   TRadioButtons = OBJECT (TCluster)
      FUNCTION Mark (Item: Integer): Boolean; Virtual;
      PROCEDURE DrawFocus; Virtual;
      PROCEDURE Press (Item: Integer); Virtual;
      PROCEDURE MovedTo(Item: Integer); Virtual;
      PROCEDURE SetData (Var Rec); Virtual;
   END;
   PRadioButtons = ^TRadioButtons;

{---------------------------------------------------------------------------}
{                  TCheckBoxes OBJECT - CHECK BOXES OBJECT                  }
{---------------------------------------------------------------------------}
TYPE
   TCheckBoxes = OBJECT (TCluster)
      FUNCTION Mark (Item: Integer): Boolean; Virtual;
      PROCEDURE DrawFocus; Virtual;
      PROCEDURE Press (Item: Integer); Virtual;
   END;
   PCheckBoxes = ^TCheckBoxes;

{---------------------------------------------------------------------------}
{               TMultiCheckBoxes OBJECT - CHECK BOXES OBJECT                }
{---------------------------------------------------------------------------}
TYPE
   TMultiCheckBoxes = OBJECT (TCluster)
         SelRange: Byte;                              { Select item range }
         Flags   : Word;                              { Select flags }
         States  : PString;                           { Strings }
      CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem;
        ASelRange: Byte; AFlags: Word; Const AStates: String);
      CONSTRUCTOR Load (Var S: TStream);
      DESTRUCTOR Done; Virtual;
      FUNCTION DataSize: Word; Virtual;
      FUNCTION MultiMark (Item: Integer): Byte; Virtual;
      PROCEDURE DrawFocus; Virtual;
      PROCEDURE Press (Item: Integer); Virtual;
      PROCEDURE GetData (Var Rec); Virtual;
      PROCEDURE SetData (Var Rec); Virtual;
      PROCEDURE Store (Var S: TStream);
   END;
   PMultiCheckBoxes = ^TMultiCheckBoxes;

{---------------------------------------------------------------------------}
{                     TListBox OBJECT - LIST BOX OBJECT                     }
{---------------------------------------------------------------------------}
TYPE
   TListBox = OBJECT (TListViewer)
         List: PCollection;                           { List of strings }
      CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Word;
        AScrollBar: PScrollBar);
      CONSTRUCTOR Load (Var S: TStream);
      FUNCTION DataSize: Word; Virtual;
      FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
      PROCEDURE NewList(AList: PCollection); Virtual;
      PROCEDURE GetData (Var Rec); Virtual;
      PROCEDURE SetData (Var Rec); Virtual;
      PROCEDURE Store (Var S: TStream);
   END;
   PListBox = ^TListBox;

{---------------------------------------------------------------------------}
{                TStaticText OBJECT - STATIC TEXT OBJECT                    }
{---------------------------------------------------------------------------}
TYPE
   TStaticText = OBJECT (TView)
         Text: PString;                               { Text string ptr }
      CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String);
      CONSTRUCTOR Load (Var S: TStream);
      DESTRUCTOR Done; Virtual;
      FUNCTION GetPalette: PPalette; Virtual;
      PROCEDURE DrawBackGround;                                      Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE GetText (Var S: String); Virtual;
   END;
   PStaticText = ^TStaticText;

{---------------------------------------------------------------------------}
{              TParamText OBJECT - PARMETER STATIC TEXT OBJECT              }
{---------------------------------------------------------------------------}
TYPE
   TParamText = OBJECT (TStaticText)
         ParamCount: Integer;                         { Parameter count }
         ParamList : Pointer;                         { Parameter list }
      CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String;
        AParamCount: Integer);
      CONSTRUCTOR Load (Var S: TStream);
      FUNCTION DataSize: Word; Virtual;
      PROCEDURE GetData (Var Rec); Virtual;
      PROCEDURE SetData (Var Rec); Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE GetText (Var S: String); Virtual;
   END;
   PParamText = ^TParamText;

{---------------------------------------------------------------------------}
{                        TLabel OBJECT - LABEL OBJECT                       }
{---------------------------------------------------------------------------}
TYPE
   TLabel = OBJECT (TStaticText)
         Light: Boolean;
         Link: PView;                                 { Linked view }
      CONSTRUCTOR Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
      CONSTRUCTOR Load (Var S: TStream);
      FUNCTION GetPalette: PPalette; Virtual;
      PROCEDURE DrawBackGround; Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
   END;
   PLabel = ^TLabel;

{---------------------------------------------------------------------------}
{             THistoryViewer OBJECT - HISTORY VIEWER OBJECT                 }
{---------------------------------------------------------------------------}
TYPE
   THistoryViewer = OBJECT (TListViewer)
         HistoryId: Word;                             { History id }
      CONSTRUCTOR Init(Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
        AHistoryId: Word);
      FUNCTION HistoryWidth: Integer;
      FUNCTION GetPalette: PPalette; Virtual;
      FUNCTION GetText (Item: Integer; MaxLen: Integer): String; Virtual;
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
   END;
   PHistoryViewer = ^THistoryViewer;

{---------------------------------------------------------------------------}
{             THistoryWindow OBJECT - HISTORY WINDOW OBJECT                 }
{---------------------------------------------------------------------------}
TYPE
  THistoryWindow = OBJECT (TWindow)
         Viewer: PListViewer;                         { List viewer object }
      CONSTRUCTOR Init (Var Bounds: TRect; HistoryId: Word);
      FUNCTION GetSelection: String; Virtual;
      FUNCTION GetPalette: PPalette; Virtual;
      PROCEDURE InitViewer (HistoryId: Word); Virtual;
   END;
   PHistoryWindow = ^THistoryWindow;

{---------------------------------------------------------------------------}
{                   THistory OBJECT - HISTORY OBJECT                        }
{---------------------------------------------------------------------------}
TYPE
   THistory = OBJECT (TView)
         HistoryId: Word;
         Link: PInputLine;
      CONSTRUCTOR Init (Var Bounds: TRect; ALink: PInputLine; AHistoryId: Word);
      CONSTRUCTOR Load (Var S: TStream);
      FUNCTION GetPalette: PPalette; Virtual;
      FUNCTION InitHistoryWindow (Var Bounds: TRect): PHistoryWindow; Virtual;
      PROCEDURE Draw; Virtual;
      PROCEDURE RecordHistory (CONST S: String); Virtual;
      PROCEDURE Store (Var S: TStream);
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
   END;
   PHistory = ^THistory;

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           ITEM STRING ROUTINES                            }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-NewSItem-----------------------------------------------------------
Allocates memory for a new TSItem record and sets the text field
and chains to the next TSItem. This allows easy construction of
singly-linked lists of strings, to end a chain the next TSItem
should be nil.
28Apr98 LdB
---------------------------------------------------------------------}
FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                   DIALOG OBJECT REGISTRATION PROCEDURE                    }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{-RegisterDialogs----------------------------------------------------
This registers all the view type objects used in this unit.
30Sep99 LdB
---------------------------------------------------------------------}
PROCEDURE RegisterDialogs;

{***************************************************************************}
{                        STREAM REGISTRATION RECORDS                        }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                        TDialog STREAM REGISTRATION                        }
{---------------------------------------------------------------------------}
CONST
   RDialog: TStreamRec = (
     ObjType: 10;                                     { Register id = 10 }
     VmtLink: TypeOf(TDialog);
     Load:  @TDialog.Load;                            { Object load method }
     Store: @TDialog.Store                            { Object store method }
   );

{---------------------------------------------------------------------------}
{                      TInputLine STREAM REGISTRATION                       }
{---------------------------------------------------------------------------}
CONST
   RInputLine: TStreamRec = (
     ObjType: 11;                                     { Register id = 11 }
     VmtLink: TypeOf(TInputLine);
     Load:  @TInputLine.Load;                         { Object load method }
     Store: @TInputLine.Store                         { Object store method }
   );

{---------------------------------------------------------------------------}
{                        TButton STREAM REGISTRATION                        }
{---------------------------------------------------------------------------}
CONST
   RButton: TStreamRec = (
     ObjType: 12;                                     { Register id = 12 }
     VmtLink: TypeOf(TButton);
     Load:  @TButton.Load;                            { Object load method }
     Store: @TButton.Store                            { Object store method }
   );

{---------------------------------------------------------------------------}
{                       TCluster STREAM REGISTRATION                        }
{---------------------------------------------------------------------------}
CONST
   RCluster: TStreamRec = (
     ObjType: 13;                                     { Register id = 13 }
     VmtLink: TypeOf(TCluster);
     Load:  @TCluster.Load;                           { Object load method }
     Store: @TCluster.Store                           { Objects store method }
   );

{---------------------------------------------------------------------------}
{                    TRadioButtons STREAM REGISTRATION                      }
{---------------------------------------------------------------------------}
CONST
   RRadioButtons: TStreamRec = (
     ObjType: 14;                                     { Register id = 14 }
     VmtLink: TypeOf(TRadioButtons);
     Load:  @TRadioButtons.Load;                      { Object load method }
     Store: @TRadioButtons.Store                      { Object store method }
   );

{---------------------------------------------------------------------------}
{                     TCheckBoxes STREAM REGISTRATION                       }
{---------------------------------------------------------------------------}
CONST
   RCheckBoxes: TStreamRec = (
     ObjType: 15;                                     { Register id = 15 }
     VmtLink: TypeOf(TCheckBoxes);
     Load:  @TCheckBoxes.Load;                        { Object load method }
     Store: @TCheckBoxes.Store                        { Object store method }
   );

{---------------------------------------------------------------------------}
{                   TMultiCheckBoxes STREAM REGISTRATION                    }
{---------------------------------------------------------------------------}
CONST
   RMultiCheckBoxes: TStreamRec = (
     ObjType: 27;                                     { Register id = 27 }
     VmtLink: TypeOf(TMultiCheckBoxes);
     Load:  @TMultiCheckBoxes.Load;                   { Object load method }
     Store: @TMultiCheckBoxes.Store                   { Object store method }
   );

{---------------------------------------------------------------------------}
{                        TListBox STREAM REGISTRATION                       }
{---------------------------------------------------------------------------}
CONST
   RListBox: TStreamRec = (
     ObjType: 16;                                     { Register id = 16 }
     VmtLink: TypeOf(TListBox);
     Load:  @TListBox.Load;                           { Object load method }
     Store: @TListBox.Store                           { Object store method }
   );

{---------------------------------------------------------------------------}
{                      TStaticText STREAM REGISTRATION                      }
{---------------------------------------------------------------------------}
CONST
   RStaticText: TStreamRec = (
     ObjType: 17;                                     { Register id = 17 }
     VmtLink: TypeOf(TStaticText);
     Load:  @TStaticText.Load;                        { Object load method }
     Store: @TStaticText.Store                        { Object store method }
   );

{---------------------------------------------------------------------------}
{                        TLabel STREAM REGISTRATION                         }
{---------------------------------------------------------------------------}
CONST
   RLabel: TStreamRec = (
     ObjType: 18;                                     { Register id = 18 }
     VmtLink: TypeOf(TLabel);
     Load:  @TLabel.Load;                             { Object load method }
     Store: @TLabel.Store                             { Object store method }
   );

{---------------------------------------------------------------------------}
{                        THistory STREAM REGISTRATION                       }
{---------------------------------------------------------------------------}
CONST
   RHistory: TStreamRec = (
     ObjType: 19;                                     { Register id = 19 }
     VmtLink: TypeOf(THistory);
     Load:  @THistory.Load;                           { Object load method }
     Store: @THistory.Store                           { Object store method }
   );

{---------------------------------------------------------------------------}
{                      TParamText STREAM REGISTRATION                       }
{---------------------------------------------------------------------------}
CONST
   RParamText: TStreamRec = (
     ObjType: 20;                                     { Register id = 20 }
     VmtLink: TypeOf(TParamText);
     Load:  @TParamText.Load;                         { Object load method }
     Store: @TParamText.Store                         { Object store method }
   );

{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}

USES HistList;                                        { Standard GFV unit }

{***************************************************************************}
{                         PRIVATE DEFINED CONSTANTS                         }
{***************************************************************************}

{---------------------------------------------------------------------------}
{                 LEFT AND RIGHT ARROW CHARACTER CONSTANTS                  }
{---------------------------------------------------------------------------}
CONST LeftArr = #17; RightArr = #16;

{---------------------------------------------------------------------------}
{                               TButton MESSAGES                            }
{---------------------------------------------------------------------------}
CONST
   cmGrabDefault    = 61;                             { Grab default }
   cmReleaseDefault = 62;                             { Release default }

{---------------------------------------------------------------------------}
{  IsBlank -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB           }
{---------------------------------------------------------------------------}
FUNCTION IsBlank (Ch: Char): Boolean;
BEGIN
   IsBlank := (Ch = ' ') OR (Ch = #13) OR (Ch = #10); { Check for characters }
END;

{---------------------------------------------------------------------------}
{  HotKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB            }
{---------------------------------------------------------------------------}
FUNCTION HotKey (Const S: String): Char;
VAR I: Word;
BEGIN
   HotKey := #0;                                      { Preset fail }
   If (S <> '') Then Begin                            { Valid string }
     I := Pos('~', S);                                { Search for tilde }
     If (I <> 0) Then HotKey := UpCase(S[I+1]);       { Return hotkey }
   End;
END;

{***************************************************************************}
{                              OBJECT METHODS                               }
{***************************************************************************}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          TDialog OBJECT METHODS                           }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TDialog------------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TDialog.Init (Var Bounds: TRect; ATitle: TTitleStr);
BEGIN
   Inherited Init(Bounds, ATitle, wnNoNumber);        { Call ancestor }
   Options := Options OR ofVersion20;                 { Version two dialog }
   GrowMode := 0;                                     { Clear grow mode }
   Flags := wfMove + wfClose;                         { Close/moveable flags }
   Palette := dpGrayDialog;                           { Default gray colours }
END;

{--TDialog------------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TDialog.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   If (Options AND ofVersion = ofVersion10) Then Begin
     Palette := dpGrayDialog;                         { Set gray palette }
     Options := Options OR ofVersion20;               { Update version flag }
   End;
END;

{--TDialog------------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TDialog.GetPalette: PPalette;
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
    (CBlueDialog, CCyanDialog, CGrayDialog);          { Always normal string }
BEGIN
   GetPalette := @P[Palette];                         { Return palette }
END;

{--TDialog------------------------------------------------------------------}
{  Valid -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 25Apr98 LdB             }
{---------------------------------------------------------------------------}
FUNCTION TDialog.Valid (Command: Word): Boolean;
BEGIN
   If (Command = cmCancel) Then Valid := True         { Cancel returns true }
     Else Valid := TGroup.Valid(Command);             { Call group ancestor }
END;

{--TDialog------------------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE TDialog.HandleEvent (Var Event: TEvent);
BEGIN
   Inherited HandleEvent(Event);                      { Call ancestor }
   Case Event.What Of
     evNothing: Exit;                                 { Speed up exit }
     evKeyDown:                                       { Key down event }
       Case Event.KeyCode Of
         kbEsc: Begin                                 { Escape key press }
             Event.What := evCommand;                 { Command event }
             Event.Command := cmCancel;               { cancel command }
             Event.InfoPtr := Nil;                    { Clear info ptr }
             PutEvent(Event);                         { Put event on queue }
             ClearEvent(Event);                       { Clear the event }
           End;
         kbEnter: Begin                               { Enter key press }
             Event.What := evBroadcast;               { Broadcast event }
             Event.Command := cmDefault;              { Default command }
             Event.InfoPtr := Nil;                    { Clear info ptr }
             PutEvent(Event);                         { Put event on queue }
             ClearEvent(Event);                       { Clear the event }
           End;
       End;
     evCommand:                                       { Command event }
       Case Event.Command Of
         cmOk, cmCancel, cmYes, cmNo:                 { End dialog cmds }
           If (State AND sfModal <> 0) Then Begin     { View is modal }
             EndModal(Event.Command);                 { End modal state }
             ClearEvent(Event);                       { Clear the event }
           End;
       End;
   End;
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                       TInputLine OBJECT METHODS                           }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TInputLine---------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TInputLine.Init (Var Bounds: TRect; AMaxLen: Integer);
BEGIN
   Inherited Init(Bounds);                            { Call ancestor }
   State := State OR sfCursorVis;                     { Cursor visible }
   Options := Options OR (ofSelectable + ofFirstClick
     + ofVersion20);                                  { Set options }
   If (MaxAvail > AMaxLen + 1) Then Begin             { Check enough memory }
     GetMem(Data, AMaxLen + 1);                       { Allocate memory }
     Data^ := '';                                     { Data = empty string }
   End;
   MaxLen := AMaxLen;                                 { Hold maximum length }
END;

{--TInputLine---------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TInputLine.Load (Var S: TStream);
VAR B: Byte;
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   S.Read(MaxLen, 2);                                 { Read max length }
   S.Read(CurPos, 2);                                 { Read cursor position }
   S.Read(FirstPos, 2);                               { Read first position }
   S.Read(SelStart, 2);                               { Read selected start }
   S.Read(SelEnd, 2);                                 { Read selected end }
   S.Read(B, 1);                                      { Read string length }
   If (MaxAvail > MaxLen+1) Then Begin                { Check enough memory }
     GetMem(Data, MaxLen + 1);                        { Allocate memory }
     S.Read(Data^[1], Length(Data^));                 { Read string data }
     SetLength(Data^, B);                             { Xfer string length }
   End Else S.Seek(S.GetPos + B);                     { Move to position }
   If (Options AND ofVersion >= ofVersion20) Then     { Version 2 or above }
     Validator := PValidator(S.Get);                  { Get any validator }
   Options := Options OR ofVersion20;                 { Set version 2 flag }
END;

{--TInputLine---------------------------------------------------------------}
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB              }
{---------------------------------------------------------------------------}
DESTRUCTOR TInputLine.Done;
BEGIN
   If (Data <> Nil) Then FreeMem(Data, MaxLen + 1);    { Release any memory }
   SetValidator(Nil);                                  { Clear any validator }
   Inherited Done;                                     { Call ancestor }
END;

{--TInputLine---------------------------------------------------------------}
{  DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB          }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.DataSize: Word;
VAR DSize: Word;
BEGIN
   DSize := 0;                                        { Preset zero datasize }
   If (Validator <> Nil) AND (Data <> Nil) Then
     DSize := Validator^.Transfer(Data^, Nil,
       vtDataSize);                                   { Add validator size }
   If (DSize <> 0) Then DataSize := DSize             { Use validtor size }
     Else DataSize := MaxLen + 1;                     { No validator use size }
END;

{--TInputLine---------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.GetPalette: PPalette;
CONST P: String[Length(CInputLine)] = CInputLine;     { Always normal string }
BEGIN
   GetPalette := @P;                                  { Return palette }
END;

{--TInputLine---------------------------------------------------------------}
{  Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB             }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.Valid (Command: Word): Boolean;

   FUNCTION AppendError (Validator: PValidator): Boolean;
   BEGIN
     AppendError := False;                            { Preset false }
     If (Data <> Nil) Then
       With Validator^ Do
         If (Options AND voOnAppend <> 0) AND         { Check options }
         (CurPos <> Length(Data^)) AND                { Exceeds max length }
         NOT IsValidInput(Data^, True) Then Begin     { Check data valid }
           Error;                                     { Call error }
           AppendError := True;                       { Return true }
         End;
   END;

BEGIN
   Valid := Inherited Valid(Command);                 { Call ancestor }
   If (Validator <> Nil) AND (Data <> Nil) AND        { Validator present }
   (State AND sfDisabled = 0) Then                    { Not disabled }
     If (Command = cmValid) Then                      { Valid command }
       Valid := Validator^.Status = vsOk              { Validator result }
       Else If (Command <> cmCancel) Then             { Not cancel command }
         If AppendError(Validator) OR                 { Append any error }
         NOT Validator^.Valid(Data^) Then Begin       { Check validator }
           Select;                                    { Reselect view }
           Valid := False;                            { Return false }
         End;
END;

{--TInputLine---------------------------------------------------------------}
{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB              }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.Draw;
VAR Color: Byte; X, L, R: Integer; S, T: String;
BEGIN
   If (State AND sfFocused = 0) Then Color := 1       { Not focused colour }
     Else Color := 2;                                 { Focused colour }
   If CanScroll(-1) Then WriteStr(0, 0, LeftArr, 4);  { Set left scroll mark }
   If CanScroll(1) Then WriteStr(-(RawSize.X + 1 -
     TextWidth(RightArr)), 0, RightArr, 4);           { Set right scroll mark }
   If (Data <> Nil) Then S := Copy(Data^, FirstPos+1,
    Length(Data^)-FirstPos) Else S := '';             { Fetch data string }
   X := TextWidth(LeftArr);                           { left arrow width }
   While (TextWidth(S) > ((RawSize.X+1)-X-TextWidth(
     RightArr))) Do Delete(S, Length(S), 1);          { Cut to right length }
   If (State AND sfFocused <> 0) Then Begin
     L := SelStart - FirstPos;                        { Selected left end }
     R := SelEnd - FirstPos;                          { Selected right end }
     If (L < 0) Then L := 0;                          { Fix any negative }
     If (R > Length(S)) Then R := Length(S);          { Fix to long case }
     If (L > 0) Then Begin
       T := Copy(S, 1, L);                            { Unhighlight bit }
       WriteStr(-X, 0, T, Color);                     { Write string to screen }
       X := X + TextWidth(T);                         { New x position }
       Delete(S, 1, L);                               { Reduce string }
     End;
     If (L < R) Then Begin
       T := Copy(S, 1, R-L);                          { Highlight bit }
       WriteStr(-X, 0, T, 3);                         { Write string to screen }
       X := X + TextWidth(T);                         { New x position }
       Delete(S, 1, R-L);                             { Reduce string }
     End;
     If (Length(S) > 0) Then
       WriteStr(-X, 0, S, Color);                     { Write string to screen }
   End Else WriteStr(-X, 0, S, Color);                { Write string to screen }
   Cursor.X := CurPos - FirstPos + 1;                 { Update cursor position }
END;

{--TInputLine---------------------------------------------------------------}
{  DrawbackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB    }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.DrawBackGround;
BEGIN
   Inherited DrawBackGround;                          { Call ancestor }
END;

{--TInputLine---------------------------------------------------------------}
{  DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Oct99 LdB        }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.DrawCursor;
VAR I, X: Integer; S: String;
BEGIN
   If (State AND sfFocused <> 0) Then Begin           { Focused window }
     X := TextWidth(LeftArr);                         { Preset x position }
     I := 0;                                          { Preset cursor width }
     If (Data <> Nil) Then Begin                      { Data pointer valid }
       S := Copy(Data^, FirstPos+1, CurPos-FirstPos); { Copy the string }
       X := X + TextWidth(S);                         { Calculate position }
       If (State AND sfCursorIns <> 0) Then           { Check insert mode }
         If ((CurPos+1) <= Length(Data^)) Then
           I := TextWidth(Data^[CurPos+1])            { Insert caret width }
           Else I := FontWidth;                       { At end use fontwidth }
     End;
     If (State AND sfCursorIns <> 0) Then Begin       { Insert mode }
       If ((CurPos+1) <= Length(Data^)) Then          { Not beyond end }
         WriteStr(-X, 0, Data^[CurPos+1], 5)          { Create block cursor }
         Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
     End Else ClearArea(X, 0, X+I, FontHeight, Green);{ Line cursor }
   End;
END;

{--TInputLine---------------------------------------------------------------}
{  SelectAll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SelectAll (Enable: Boolean);
BEGIN
   CurPos := 0;                                       { Cursor to start }
   FirstPos := 0;                                     { First pos to start }
   SelStart := 0;                                     { Selected at start }
   If Enable AND (Data <> Nil) Then
     SelEnd := Length(Data^) Else SelEnd := 0;        { Selected which end }
   DrawView;                                          { Now redraw the view }
END;

{--TInputLine---------------------------------------------------------------}
{  SetValidator -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB      }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetValidator (AValid: PValidator);
BEGIN
   If (Validator <> Nil) Then Validator^.Free;        { Release validator }
   Validator := AValid;                               { Set new validator }
END;

{--TInputLine---------------------------------------------------------------}
{  SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB          }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetState (AState: Word; Enable: Boolean);
BEGIN
   Inherited SetState(AState, Enable);                { Call ancestor }
   If (AState = sfSelected) OR ((AState = sfActive)
   AND (State and sfSelected <> 0)) Then
     SelectAll(Enable) Else                           { Call select all }
     If (AState = sfFocused) Then DrawView;           { Redraw for focus }
END;

{--TInputLine---------------------------------------------------------------}
{  GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.GetData (Var Rec);
BEGIN
   If (Data <> Nil) Then Begin                        { Data ptr valid }
     If (Validator = Nil) OR (Validator^.Transfer(Data^,
     @Rec, vtGetData) = 0) Then Begin                 { No validator/data }
       FillChar(Rec, DataSize, #0);                   { Clear the data area }
       Move(Data^, Rec, Length(Data^) + 1);           { Transfer our data }
     End;
   End Else FillChar(Rec, DataSize, #0);              { Clear the data area }
END;

{--TInputLine---------------------------------------------------------------}
{  SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.SetData (Var Rec);
BEGIN
   If (Data <> Nil) Then Begin                        { Data ptr valid }
     If (Validator = Nil) OR (Validator^.Transfer(
       Data^, @Rec, vtSetData) = 0) Then              { No validator/data }
       Move(Rec, Data^[0], DataSize);                 { Set our data }
   End;
   SelectAll(True);                                   { Now select all }
END;

{--TInputLine---------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.Store (Var S: TStream);
BEGIN
   TView.Store(S);                                    { Implict TView.Store }
   S.Write(MaxLen, 2);                                { Read max length }
   S.Write(CurPos, 2);                                { Read cursor position }
   S.Write(FirstPos, 2);                              { Read first position }
   S.Write(SelStart, 2);                              { Read selected start }
   S.Write(SelEnd, 2);                                { Read selected end }
   S.WriteStr(Data);                                  { Write the data }
   S.Put(Validator);                                  { Write any validator }
END;

{--TInputLine---------------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE TInputLine.HandleEvent (Var Event: TEvent);
CONST PadKeys = [$47, $4B, $4D, $4F, $73, $74];
VAR WasAppending: Boolean; ExtendBlock: Boolean; OldData: String;
Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Integer;

   FUNCTION MouseDelta: Integer;
   BEGIN
     If (Event.Where.X <= RawOrigin.X+TextWidth(LeftArr))
       Then MouseDelta := -1 Else                     { To left of text area }
       If ((Event.Where.X-RawOrigin.X) >= RawSize.X -
       TextWidth(RightArr)) Then MouseDelta := 1      { To right of text area }
         Else MouseDelta := 0;                        { In area return 0 }
   END;

   FUNCTION MousePos: Integer;
   VAR Mp, Tw, Pos: Integer; S: String;
   BEGIN
     Mp := Event.Where.X - RawOrigin.X;               { Mouse position }
     If (Data <> Nil) Then S := Copy(Data^, FirstPos+1,
       Length(Data^)-FirstPos) Else S := '';          { Text area string }
     Tw := TextWidth(LeftArr);                        { Text width }
     Pos := 0;                                        { Zero position }
     While (Mp > Tw) AND (Pos <= Length(S)) Do Begin  { Still text to right }
       Tw := Tw + TextWidth(S[Pos+1]);                { Add next character }
       Inc(Pos);                                      { Next character }
     End;
     If (Pos > 0) Then Dec(Pos);
     MousePos := FirstPos + Pos;                      { Return mouse position }
   END;

   PROCEDURE DeleteSelect;
   BEGIN
     If (SelStart <> SelEnd) Then Begin               { An area selected }
       If (Data <> Nil) Then
         Delete(Data^, SelStart+1, SelEnd-SelStart);  { Delete the text }
       CurPos := SelStart;                            { Set cursor position }
     End;
   END;

   PROCEDURE AdjustSelectBlock;
   BEGIN
     If (CurPos < Anchor) Then Begin                  { Selection backwards }
       SelStart := CurPos;                            { Start of select }
       SelEnd := Anchor;                              { End of select }
     End Else Begin
       SelStart := Anchor;                            { Start of select }
       SelEnd := CurPos;                              { End of select }
     End;
   END;

   PROCEDURE SaveState;
   BEGIN
     If (Validator <> Nil) Then Begin                 { Check for validator }
       If (Data <> Nil) Then OldData := Data^;        { Hold data }
       OldCurPos := CurPos;                           { Hold cursor position }
       OldFirstPos := FirstPos;                       { Hold first position }
       OldSelStart := SelStart;                       { Hold select start }
       OldSelEnd := SelEnd;                           { Hold select end }
       If (Data = Nil) Then WasAppending := True      { Invalid data ptr }
         Else WasAppending := Length(Data^) = CurPos; { Hold appending state }
     End;
   END;

   PROCEDURE RestoreState;
   BEGIN
     If (Validator <> Nil) Then Begin                 { Validator valid }
       If (Data <> Nil) Then Data^ := OldData;        { Restore data }
       CurPos := OldCurPos;                           { Restore cursor pos }
       FirstPos := OldFirstPos;                       { Restore first pos }
       SelStart := OldSelStart;                       { Restore select start }
       SelEnd := OldSelEnd;                           { Restore select end }
     End;
   END;

   FUNCTION CheckValid (NoAutoFill: Boolean): Boolean;
   VAR OldLen: Integer; NewData: String;
   BEGIN
     If (Validator <> Nil) Then Begin                 { Validator valid }
       CheckValid := False;                           { Preset false return }
       If (Data <> Nil) Then OldLen := Length(Data^); { Hold old length }
       If (Validator^.Options AND voOnAppend = 0) OR
       (WasAppending AND (CurPos = OldLen)) Then Begin
         If (Data <> Nil) Then NewData := Data^       { Hold current data }
           Else NewData := '';                        { Set empty string }
         If NOT Validator^.IsValidInput(NewData,
         NoAutoFill) Then RestoreState Else Begin
           If (Length(NewData) > MaxLen) Then         { Exceeds maximum }
             SetLength(NewData, MaxLen);              { Set string length }
           If (Data <> Nil) Then Data^ := NewData;    { Set data value }
           If (Data <> Nil) AND (CurPos >= OldLen)    { Cursor beyond end }
           AND (Length(Data^) > OldLen) Then          { Cursor beyond string }
             CurPos := Length(Data^);                 { Set cursor position }
           CheckValid := True;                        { Return true result }
         End;
       End Else Begin
         CheckValid := True;                          { Preset true return }
         If (CurPos = OldLen) AND (Data <> Nil) Then  { Lengths match }
           If NOT Validator^.IsValidInput(Data^,
           False) Then Begin                          { Check validator }
             Validator^.Error;                        { Call error }
             CheckValid := False;                     { Return false result }
           End;
       End;
     End Else CheckValid := True;                     { No validator }
   END;

BEGIN
   Inherited HandleEvent(Event);                      { Call ancestor }
   If (State AND sfSelected <> 0) Then Begin          { View is selected }
     Case Event.What Of
       evNothing: Exit;                               { Speed up exit }
       evMouseDown: Begin                             { Mouse down event }
         Delta := MouseDelta;                         { Calc scroll value }
         If CanScroll(Delta) Then Begin               { Can scroll }
           Repeat
             If CanScroll(Delta) Then Begin           { Still can scroll }
               Inc(FirstPos, Delta);                  { Move start position }
               DrawView;                              { Redraw the view }
             End;
           Until NOT MouseEvent(Event, evMouseAuto);  { Until no mouse auto }
         End Else If Event.Double Then                { Double click }
           SelectAll(True) Else Begin                 { Select whole text }
             Anchor := MousePos;                      { Start of selection }
             Repeat
               If (Event.What = evMouseAuto)          { Mouse auto event }
               Then Begin
                 Delta := MouseDelta;                 { New position }
                 If CanScroll(Delta) Then             { If can scroll }
                   Inc(FirstPos, Delta);
               End;
               CurPos := MousePos;                    { Set cursor position }
               AdjustSelectBlock;                     { Adjust selected }
               DrawView;                              { Redraw the view }
             Until NOT MouseEvent(Event, evMouseMove
               + evMouseAuto);                        { Until mouse released }
           End;
         ClearEvent(Event);                           { Clear the event }
       End;
       evKeyDown: Begin
         SaveState;                                   { Save state of view }
         Event.KeyCode := CtrlToArrow(Event.KeyCode); { Convert keycode }
         If (Event.ScanCode IN PadKeys) AND
         (GetShiftState AND $03 <> 0) Then Begin      { Mark selection active }
           Event.CharCode := #0;                      { Clear char code }
           If (CurPos = SelEnd) Then                  { Find if at end }
             Anchor := SelStart Else                  { Anchor from start }
             Anchor := SelEnd;                        { Anchor from end }
             ExtendBlock := True;                     { Extended block true }
         End Else ExtendBlock := False;               { No extended block }
         Case Event.KeyCode Of
           kbLeft: If (CurPos > 0) Then Dec(CurPos);  { Move cursor left }
           kbRight: If (Data <> Nil) AND              { Move right cursor }
           (CurPos < Length(Data^)) Then Begin        { Check not at end }
             Inc(CurPos);                             { Move cursor }
             CheckValid(True);                        { Check if valid }
           End;
           kbHome: CurPos := 0;                       { Move to line start }
           kbEnd: Begin                               { Move to line end }
             If (Data = Nil) Then CurPos := 0         { Invalid data ptr }
               Else CurPos := Length(Data^);          { Set cursor position }
             CheckValid(True);                        { Check if valid }
           End;
           kbBack: If (Data <> Nil) AND (CurPos > 0)  { Not at line start }
           Then Begin
             Delete(Data^, CurPos, 1);                { Backspace over char }
             Dec(CurPos);                             { Move cursor back one }
             If (FirstPos > 0) Then Dec(FirstPos);    { Move first position }
             CheckValid(True);                        { Check if valid }
           End;
           kbDel: If (Data <> Nil) Then Begin         { Delete character }
             If (SelStart = SelEnd) Then              { Select all on }
               If (CurPos < Length(Data^)) Then Begin { Cursor not at end }
                 SelStart := CurPos;                  { Set select start }
                 SelEnd := CurPos + 1;                { Set select end }
               End;
             DeleteSelect;                            { Deselect selection }
             CheckValid(True);                        { Check if valid }
           End;
           kbIns: SetState(sfCursorIns, State AND
             sfCursorIns = 0);                        { Flip insert state }
           Else Case Event.CharCode Of
             ' '..#255: If (Data <> Nil) Then Begin   { Character key }
               If (State AND sfCursorIns <> 0) Then
                 Delete(Data^, CurPos + 1, 1) Else    { Overwrite character }
                 DeleteSelect;                        { Deselect selected }
               If CheckValid(True) Then Begin         { Check data valid }
                 If (Length(Data^) < MaxLen) Then     { Must not exceed maxlen }
                 Begin
                   If (FirstPos > CurPos) Then
                     FirstPos := CurPos;              { Advance first position }
                   Inc(CurPos);                       { Increment cursor }
                   Insert(Event.CharCode, Data^,
                     CurPos);                         { Insert the character }
                 End;
                 CheckValid(False);                   { Check data valid }
               End;
             End;
             ^Y: If (Data <> Nil) Then Begin          { Clear all data }
                Data^ := '';                          { Set empty string }
                CurPos := 0;                          { Cursor to start }
             End;
             Else Exit;                               { Unused key }
           End
         End;
         If ExtendBlock Then AdjustSelectBlock        { Extended block }
         Else Begin
           SelStart := CurPos;                        { Set select start }
           SelEnd := CurPos;                          { Set select end }
         End;
         If (FirstPos > CurPos) Then
           FirstPos := CurPos;                        { Advance first pos }
         If (Data <> Nil) Then OldData := Copy(Data^,
           FirstPos+1, CurPos-FirstPos)               { Text area string }
           Else OldData := '';                        { Empty string }
         Delta := FontWidth;                          { Safety = 1 char }
         While (TextWidth(OldData) > ((RawSize.X+1)-Delta)
         - TextWidth(LeftArr) - TextWidth(RightArr))  { Check text fits }
         Do Begin
           Inc(FirstPos);                             { Advance first pos }
           OldData := Copy(Data^, FirstPos+1,
             CurPos-FirstPos)                         { Text area string }
         End;
         DrawView;                                    { Redraw the view }
         ClearEvent(Event);                           { Clear the event }
       End;
     End;
   End;
END;

{***************************************************************************}
{                     TInputLine OBJECT PRIVATE METHODS                     }
{***************************************************************************}
{--TInputLine---------------------------------------------------------------}
{  CanScroll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB         }
{---------------------------------------------------------------------------}
FUNCTION TInputLine.CanScroll (Delta: Integer): Boolean;
VAR S: String;
BEGIN
   If (Delta < 0) Then CanScroll := FirstPos > 0      { Check scroll left }
     Else If (Delta > 0) Then Begin
       If (Data = Nil) Then S := '' Else              { Data ptr invalid }
         S := Copy(Data^, FirstPos+1, Length(Data^)
          - FirstPos);                                { Fetch max string }
       CanScroll := (TextWidth(S)) > (RawSize.X -
         TextWidth(LeftArr) - TextWidth(RightArr));   { Check scroll right }
     End Else CanScroll := False;                     { Zero so no scroll }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           TButton OBJECT METHODS                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TButton------------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TButton.Init (Var Bounds: TRect; ATitle: TTitleStr;
  ACommand: Word; AFlags: Word);
BEGIN
   Inherited Init(Bounds);                            { Call ancestor }
   EventMask := EventMask OR evBroadcast;             { Handle broadcasts }
   GOptions := GOptions OR goDrawFocus;               { Set new option mask }
   Options := Options OR (ofSelectable + ofFirstClick
     + ofPreProcess + ofPostProcess);                 { Set option flags }
   If NOT CommandEnabled(ACommand) Then
     State := State OR sfDisabled;                    { Check command state }
   Flags := AFlags;                                   { Hold flags }
   If (AFlags AND bfDefault <> 0) Then AmDefault := True
     Else AmDefault := False;                         { Check if default }
   Title := NewStr(ATitle);                           { Hold title string }
   Command := ACommand;                               { Hold button command }
   TabMask := TabMask OR (tmLeft + tmRight +
     tmTab + tmShiftTab + tmUp + tmDown);             { Set tab masks }
END;

{--TButton------------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TButton.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   Title := S.ReadStr;                                { Read title }
   S.Read(Command, 2);                                { Read command }
   S.Read(Flags, 1);                                  { Read flags }
   S.Read(AmDefault, 1);                              { Read if default }
   If NOT CommandEnabled(Command) Then                { Check command state }
     State := State OR sfDisabled Else                { Command disabled }
     State := State AND NOT sfDisabled;               { Command enabled }
END;

{--TButton------------------------------------------------------------------}
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB              }
{---------------------------------------------------------------------------}
DESTRUCTOR TButton.Done;
BEGIN
   If (Title <> Nil) Then DisposeStr(Title);          { Dispose title }
   Inherited Done;                                    { Call ancestor }
END;

{--TButton------------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TButton.GetPalette: PPalette;
CONST P: String[Length(CButton)] = CButton;           { Always normal string }
BEGIN
   GetPalette := @P;                                  { Get button palette }
END;

{--TButton------------------------------------------------------------------}
{  Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Apr98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TButton.Press;
VAR E: TEvent;
BEGIN
   Message(Owner, evBroadcast, cmRecordHistory, Nil); { Message for history }
   If (Flags AND bfBroadcast <> 0) Then               { Broadcasting button }
     Message(Owner, evBroadcast, Command, @Self)      { Send message }
     Else Begin
       E.What := evCommand;                           { Command event }
       E.Command := Command;                          { Set command value }
       E.InfoPtr := @Self;                            { Pointer to self }
       PutEvent(E);                                   { Put event on queue }
     End;
END;

{--TButton------------------------------------------------------------------}
{  DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB         }
{---------------------------------------------------------------------------}
PROCEDURE TButton.DrawFocus;
VAR B: Byte; I, Pos: Integer;
    Bc: Word; Db: TDrawBuffer;
    C : char;
BEGIN
   If not TextModeGFV then Begin
     If DownFlag Then B := 7 Else B := 0;               { Shadow colour }
     GraphRectangle(0, 0, RawSize.X, RawSize.Y, B);     { Draw backing shadow }
     GraphRectangle(1, 1, RawSize.X-1, RawSize.Y-1, B); { Draw backing shadow }
     If DownFlag Then B := 0 Else B := 15;              { Highlight colour }
     GraphLine(0, RawSize.Y, 0, 0, B);
     GraphLine(1, RawSize.Y-1, 1, 1, B);                { Left highlights }
     GraphLine(0, 0, RawSize.X, 0, B);
     GraphLine(1, 1, RawSize.X-1, 1, B);                { Top highlights }
     If DownFlag Then B := 8 Else B := 7;               { Select backing }
     If (State AND sfFocused <> 0) AND
       (DownFlag = False) Then B := 14;                 { Show as focused }
     GraphRectangle(2, 2, RawSize.X-2, RawSize.Y-2, B); { Draw first border }
     GraphRectangle(3, 3, RawSize.X-3, RawSize.Y-3, B); { Draw next border }
   End;
   If (State AND sfDisabled <> 0) Then                { Button disabled }
     Bc := GetColor($0404) Else Begin                 { Disabled colour }
       Bc := GetColor($0501);                         { Set normal colour }
       If (State AND sfActive <> 0) Then              { Button is active }
         If (State AND sfSelected <> 0) Then
           Bc := GetColor($0703) Else                 { Set selected colour }
             If AmDefault Then Bc := GetColor($0602); { Set is default colour }
     End;
   If (Title <> Nil) Then Begin                       { We have a title }
     If (Flags AND bfLeftJust = 0) Then Begin         { Not left set title }
       I := TextWidth(Title^);                        { Fetch title width }
       I := (RawSize.X - I) DIV 2;                    { Centre in button }
     End Else I := FontWidth;                         { Left edge of button }
     If TextModeGFV and DownFlag then Begin
       MoveChar(Db,' ',Bc,1);
       Pos:=1;
     end else Pos:=0;
     MoveCStr(Db[Pos], Title^, Bc);                        { Move title to buffer }
     If not TextModeGFV then Begin
       GOptions := GOptions OR goGraphView;             { Graphics co-ords mode }
       WriteLine(I, FontHeight DIV 2, CStrLen(Title^)+Pos,
         1, Db);                                        { Write the title }
       GOptions := GOptions AND NOT goGraphView;        { Return to normal mode }
     End Else Begin
       WriteLine(I div SysFontWidth, 0, CStrLen(Title^),
         1, Db);                  { Write the title }
       If Size.Y>1 then Begin
         Bc:={GetColor($0707)}$70;
         if DownFlag then c:=' '
         else c:='Ü';
         MoveChar(Db,c,Bc,1);
         WriteLine(Size.X-1, 0, 1, 1, Db);                                        { Write the title }
         MoveChar(Db,' ',Bc,1);
         if DownFlag then c:=' '
         else c:='ß';
         MoveChar(Db[1],c,Bc,Size.X-1);
         WriteLine(0, 1, Size.X, 1, Db);
       End;
     End;
   End;
END;

{--TButton------------------------------------------------------------------}
{  DrawState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB         }
{---------------------------------------------------------------------------}
PROCEDURE TButton.DrawState (Down: Boolean);
BEGIN
   DownFlag := Down;                                  { Set down flag }
   SetDrawMask(vdFocus);                              { Set focus mask }
   DrawView;                                          { Redraw the view }
END;

{--TButton------------------------------------------------------------------}
{  MakeDefault -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE TButton.MakeDefault (Enable: Boolean);
VAR C: Word;
BEGIN
   If (Flags AND bfDefault=0) Then Begin              { Not default }
     If Enable Then C := cmGrabDefault
       Else C := cmReleaseDefault;                    { Change default }
     Message(Owner, evBroadcast, C, @Self);           { Message to owner }
     AmDefault := Enable;                             { Set default flag }
     DrawView;                                        { Now redraw button }
   End;
END;

{--TButton------------------------------------------------------------------}
{  SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB          }
{---------------------------------------------------------------------------}
PROCEDURE TButton.SetState (AState: Word; Enable: Boolean);
BEGIN
   Inherited SetState(AState, Enable);                { Call ancestor }
   If (AState AND (sfSelected + sfActive) <> 0)       { Changing select }
     Then DrawView;                                   { Redraw required }
   If (AState AND sfFocused <> 0) Then
     MakeDefault(Enable);                             { Check for default }
END;

{--TButton------------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TButton.Store (Var S: TStream);
BEGIN
   TView.Store(S);                                    { Implict TView.Store }
   S.WriteStr(Title);                                 { Store title string }
   S.Write(Command, 2);                               { Store command }
   S.Write(Flags, 1);                                 { Store flags }
   S.Write(AmDefault, 1);                             { Store default flag }
END;

{--TButton------------------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE TButton.HandleEvent (Var Event: TEvent);
VAR Down: Boolean; C: Char; ButRect: TRect;
BEGIN
   ButRect.A := RawOrigin;                            { Get origin point }
   ButRect.B.X := RawOrigin.X + RawSize.X;            { Calc right side }
   ButRect.B.Y := RawOrigin.Y + RawSize.Y;            { Calc bottom }
   If (Event.What = evMouseDown) Then Begin           { Mouse down event }
     If NOT MouseInView(Event.Where) Then Begin       { If point not in view }
       ClearEvent(Event);                             { Clear the event }
       Exit;                                          { Speed up exit }
     End;
   End;
   If (Flags AND bfGrabFocus <> 0) Then               { Check focus grab }
     Inherited HandleEvent(Event);                    { Call ancestor }
   Case Event.What Of
     evNothing: Exit;                                 { Speed up exit }
     evMouseDown: Begin
       If (State AND sfDisabled = 0) Then Begin       { Button not disabled }
         Down := False;                               { Clear down flag }
         Repeat
           If (Down <> ButRect.Contains(Event.Where)) { State has changed }
           Then Begin
             Down := NOT Down;                        { Invert down flag }
             DrawState(Down);                         { Redraw button }
           End;
         Until NOT MouseEvent(Event, evMouseMove);    { Wait for mouse move }
         If Down Then Begin                           { Button is down }
           Press;                                     { Send out command }
           DrawState(False);                          { Draw button up }
         End;
       End;
       ClearEvent(Event);                             { Event was handled }
     End;
     evKeyDown: Begin
       If (Title <> Nil) Then C := HotKey(Title^)     { Key title hotkey }
         Else C := #0;                                { Invalid title }
       If (Event.KeyCode = GetAltCode(C)) OR          { Alt char }
       (Owner^.Phase = phPostProcess) AND (C <> #0)
       AND (Upcase(Event.CharCode) = C) OR            { Matches hotkey }
       (State AND sfFocused <> 0) AND                 { View focused }
       ((Event.CharCode = ' ') OR                     { Space bar }
       (Event.KeyCode=kbEnter)) Then Begin            { Enter key }
         DrawState(True);                             { Draw button down }
         Press;                                       { Send out command }
         ClearEvent(Event);                           { Clear the event }
         DrawState(False);                            { Draw button up }
       End;
     End;
     evBroadcast:
       Case Event.Command of
         cmDefault: If AmDefault AND                  { Default command }
         (State AND sfDisabled = 0) Then Begin        { Button enabled }
             Press;                                   { Send out command }
             ClearEvent(Event);                       { Clear the event }
         End;
         cmGrabDefault, cmReleaseDefault:             { Grab and release cmd }
           If (Flags AND bfDefault <> 0) Then Begin   { Change button state }
             AmDefault := Event.Command = cmReleaseDefault;
             DrawView;                                { Redraw the view }
           End;
         cmCommandSetChanged: Begin                   { Command set changed }
           SetState(sfDisabled, NOT
             CommandEnabled(Command));                { Set button state }
            DrawView;                                 { Redraw the view }
         End;
       End;
   End;
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           TCluster OBJECT METHODS                         }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

CONST TvClusterClassName = 'TVCLUSTER';

{--TCluster-----------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TCluster.Init (Var Bounds: TRect; AStrings: PSItem);
VAR I: Integer; P: PSItem;
BEGIN
   Inherited Init(Bounds);                            { Call ancestor }
   GOptions := GOptions OR goDrawFocus;               { Draw focus view }
   Options := Options OR (ofSelectable + ofFirstClick
     + ofPreProcess + ofPostProcess + ofVersion20);   { Set option masks }
   I := 0;                                            { Zero string count }
   P := AStrings;                                     { First item }
   While (P <> Nil) Do Begin
     Inc(I);                                          { Count 1 item }
     P := P^.Next;                                    { Move to next item }
   End;
   Strings.Init(I, 0);                                { Create collection }
   While (AStrings <> Nil) Do Begin
     P := AStrings;                                   { Transfer item ptr }
     Strings.AtInsert(Strings.Count, AStrings^.Value);{ Insert string }
     AStrings := AStrings^.Next;                      { Move to next item }
     Dispose(P);                                      { Dispose prior item }
   End;
   EnableMask := $FFFFFFFF;                           { Enable bit masks }
END;

{--TCluster-----------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TCluster.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   S.Read(Value, 4);                                  { Read value }
   S.Read(Sel, 2);                                    { Read select item }
   If ((Options AND ofVersion) >= ofVersion20)        { Version 2 TV view }
   Then S.Read(EnableMask, 4) Else Begin              { Read enable masks }
     EnableMask := $FFFFFFFF;                         { Enable all masks }
     Options := Options OR ofVersion20;               { Set version 2 mask }
   End;
   If (Options AND ofGFVModeView <> 0) Then           { GFV mode view check }
     S.Read(Id, 2);                                   { Read view id }
   Strings.Load(S);                                   { Load string data }
   SetButtonState(0, True);                           { Set button state }
END;

{--TCluster-----------------------------------------------------------------}
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB              }
{---------------------------------------------------------------------------}
DESTRUCTOR TCluster.Done;
VAR I: Integer;
BEGIN
   Strings.Done;                                      { Dispose of strings }
   Inherited Done;                                    { Call ancestor }
END;

{--TCluster-----------------------------------------------------------------}
{  DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB          }
{---------------------------------------------------------------------------}
FUNCTION TCluster.DataSize: Word;
BEGIN
   DataSize := SizeOf(Word);                          { Exchanges a word }
END;

{--TCluster-----------------------------------------------------------------}
{  GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TCluster.GetHelpCtx: Word;
BEGIN
   If (HelpCtx = hcNoContext) Then                    { View has no help }
     GetHelpCtx := hcNoContext Else                   { No help context }
     GetHelpCtx := HelpCtx + Sel;                     { Help of selected }
END;

{--TCluster-----------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TCluster.GetPalette: PPalette;
CONST P: String[Length(CCluster)] = CCluster;         { Always normal string }
BEGIN
   GetPalette := @P;                                  { Cluster palette }
END;

{--TCluster-----------------------------------------------------------------}
{  Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB              }
{---------------------------------------------------------------------------}
FUNCTION TCluster.Mark (Item: Integer): Boolean;
BEGIN
   Mark := False;                                     { Default false }
END;

{--TCluster-----------------------------------------------------------------}
{  MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB         }
{---------------------------------------------------------------------------}
FUNCTION TCluster.MultiMark (Item: Integer): Byte;
BEGIN
   MultiMark := Byte(Mark(Item) = True);              { Return multi mark }
END;

{--TCluster-----------------------------------------------------------------}
{  ButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB       }
{---------------------------------------------------------------------------}
FUNCTION TCluster.ButtonState (Item: Integer): Boolean;
BEGIN
   If (Item > 31) Then ButtonState := False Else      { Impossible item }
     ButtonState := ((1 SHL Item) AND EnableMask)<>0; { Return true/false }
END;

{--TCluster-----------------------------------------------------------------}
{  DrawFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Jul99 LdB         }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.DrawFocus;
BEGIN
END;

{--TCluster-----------------------------------------------------------------}
{  Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.Press (Item: Integer);
VAR P: PView;
BEGIN
   P := TopView;
   If (Id <> 0) AND (P <> Nil) Then NewMessage(P,
     evCommand, cmIdCommunicate, Id, Value, @Self);   { Send new message }
END;

{--TCluster-----------------------------------------------------------------}
{  MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.MovedTo (Item: Integer);
BEGIN                                                 { Abstract method }
END;

{--TCluster-----------------------------------------------------------------}
{  SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB          }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.SetState (AState: Word; Enable: Boolean);
BEGIN
   Inherited SetState(AState, Enable);                { Call ancestor }
   If (AState AND sfFocused <> 0) Then Begin
     SetDrawMask(vdFocus OR vdInner);                 { Set redraw masks }
     DrawView;                                        { Redraw masked areas }
   End;
END;

{--TCluster-----------------------------------------------------------------}
{  DrawMultiBox -> Platforms DOS/DPMI/WIN/NT - Updated 05Jun98 LdB          }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.DrawMultiBox (Const Icon, Marker: String);
VAR I, J, K, Cur, Col: Integer; CNorm, CSel, CDis, Color: Word; B: TDrawBuffer;
    Tb, SCOff: Byte;
BEGIN
   CNorm := GetColor($0301);                          { Normal colour }
   CSel := GetColor($0402);                           { Selected colour }
   CDis := GetColor($0505);                           { Disabled colour }
   If (Options AND ofFramed <>0) OR                   { Normal frame }
   (GOptions AND goThickFramed <>0) Then              { Thick frame }
     K := 1 Else  K := 0;                             { Select offset }
   For I := 0 To Size.Y-K-K-1 Do Begin                { For each line }
     MoveChar(B, ' ', Byte(CNorm), Size.X-K-K);       { Fill buffer }
     For J := 0 To (Strings.Count - 1) DIV Size.Y + 1
     Do Begin
       Cur := J*Size.Y + I;                           { Current line }
       If (Cur < Strings.Count) Then Begin
         Col := Column(Cur);                          { Calc column }
         If (Col + CStrLen(PString(Strings.At(Cur))^)+
         5 < Sizeof(TDrawBuffer) DIV SizeOf(Word))
         AND (Col < Size.X-K-K) Then Begin            { Text fits in column }
           If NOT ButtonState(Cur) Then
             Color := CDis Else If (Cur = Sel) AND    { Disabled colour }
             (State and sfFocused <> 0) Then
               Color := CSel Else                     { Selected colour }
               Color := CNorm;                        { Normal colour }
           MoveChar(B[Col], ' ', Byte(Color),
             Size.X-K-K-Col);                         { Set this colour }
           MoveStr(B[Col], Icon, Byte(Color));        { Transfer icon string }
           WordRec(B[Col+2]).Lo := Byte(Marker[
             MultiMark(Cur) + 1]);                    { Transfer marker }
           MoveCStr(B[Col+5], PString(Strings.At(
             Cur))^, Color);                          { Transfer item string }
           If ShowMarkers AND (State AND sfFocused <> 0)
           AND (Cur = Sel) Then Begin                 { Current is selected }
             WordRec(B[Col]).Lo := Byte(SpecialChars[0]);
              WordRec(B[Column(Cur+Size.Y)-1]).Lo
                := Byte(SpecialChars[1]);             { Set special character }
           End;
         End;
       End;
     End;
     WriteBuf(K, K+I, Size.X-K-K, 1, B);              { Write buffer }
   End;
END;

{--TCluster-----------------------------------------------------------------}
{  DrawBox -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.DrawBox (Const Icon: String; Marker: Char);
BEGIN
   DrawMultiBox(Icon, ' '+Marker);                    { Call draw routine }
END;

{--TCluster-----------------------------------------------------------------}
{  SetButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB    }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.SetButtonState (AMask: Longint; Enable: Boolean);
VAR I: Integer; M: Longint;
BEGIN
   If Enable Then EnableMask := EnableMask OR AMask   { Set enable bit mask }
     Else EnableMask := EnableMask AND NOT AMask;     { Disable bit mask }
   If (Strings.Count <= 32) Then Begin                { Valid string number }
     M := 1;                                          { Preset bit masks }
     For I := 1 To Strings.Count Do Begin             { For each item string }
       If ((M AND EnableMask) <> 0) Then Begin        { Bit enabled }
         Options := Options OR ofSelectable;          { Set selectable option }
         Exit;                                        { Now exit }
       End;
       M := M SHL 1;                                  { Create newbit mask }
     End;
     Options := Options AND NOT ofSelectable;         { Make not selectable }
   End;
END;

{--TCluster-----------------------------------------------------------------}
{  GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.GetData (Var Rec);
BEGIN
   Word(Rec) := Value;                                { Return current value }
END;

{--TCluster-----------------------------------------------------------------}
{  SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.SetData (Var Rec);
BEGIN
   Value := Word(Rec);                                { Set current value }
   SetDrawMask(vdFocus OR vdInner);                   { Set redraw mask }
   DrawView;                                          { Redraw masked areas }
END;

{--TCluster-----------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.Store (Var S: TStream);
BEGIN
   TView.Store(S);                                    { TView.Store called }
   If ((Options AND ofVersion) >= ofVersion20)        { Version 2 TV view }
   Then Begin
     S.Write(Value, SizeOf(LongInt));                 { Write value }
     S.Write(Sel, SizeOf(Sel));                       { Write select item }
     S.Write(EnableMask, SizeOf(EnableMask));         { Write enable masks }
   End Else Begin
     S.Write(Value, SizeOf(Word));                    { Write value }
     S.Write(Sel, SizeOf(Sel));                       { Write select item }
   End;
   If (Options AND ofGFVModeView <> 0) Then           { GFV mode view check }
     S.Write(Id, SizeOf(Id));                         { Write new id value }
   Strings.Store(S);                                  { Store strings }
END;

{--TCluster-----------------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Jun98 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE TCluster.HandleEvent (Var Event: TEvent);
VAR C: Char; I, J, S, Vh: Integer; Key: Word; Mouse: TPoint; Ts: PString;

   PROCEDURE MoveSel;
   BEGIN
     If (I <= Strings.Count) Then Begin
       Sel := S;                                      { Set selected item }
       MovedTo(Sel);                                  { Move to selected }
       SetDrawMask(vdInner OR vdFocus);               { Set draw masks }
       DrawView;                                      { Now draw changes }
     End;
   END;

BEGIN
   Inherited HandleEvent(Event);                      { Call ancestor }
   If ((Options AND ofSelectable) = 0) Then Exit;     { Check selectable }
   If (Event.What = evMouseDown) Then Begin           { MOUSE EVENT }
     MakeLocal(Event.Where, Mouse);                   { Make point local }
     I := FindSel(Mouse);                             { Find selected item }
     If (I <> -1) Then                                { Check in view }
       If ButtonState(I) Then Sel := I;               { If enabled select }
     SetDrawMask(vdFocus OR vdInner);                 { Set draw mask }
     DrawView;                                        { Now draw changes }
     Repeat
       MakeLocal(Event.Where, Mouse);                 { Make point local }
     Until NOT MouseEvent(Event, evMouseMove);        { Wait for mouse up }
     MakeLocal(Event.Where, Mouse);                   { Make point local }
     If (FindSel(Mouse) = Sel) AND ButtonState(Sel)   { If valid/selected }
     Then Begin
       Press(Sel);                                    { Call pressed }
       SetDrawMask(vdFocus OR vdInner);               { Set draw mask }
       DrawView;                                      { Now draw changes }
     End;
     ClearEvent(Event);                               { Event was handled }
   End Else If (Event.What = evKeyDown) Then Begin    { KEY EVENT }
     If (Options AND ofFramed <> 0) OR                { Normal frame }
     (GOptions AND goThickFramed <> 0) Then           { Thick frame }
       J := 1 Else J := 0;                            { Adjust value }
     Vh := Size.Y - J - J;                            { View height }
     S := Sel;                                        { Hold current item }
     Key := CtrlToArrow(Event.KeyCode);               { Convert keystroke }
     Case Key Of
       kbUp, kbDown, kbRight, kbLeft:
       If (State AND sfFocused <> 0) Then Begin       { Focused key event }
         I := 0;                                      { Zero process count }
         Repeat
           Inc(I);                                    { Inc process count }
           Case Key Of
             kbUp: Dec(S);                            { Next item up }
             kbDown: Inc(S);                          { Next item down }
             kbRight: Begin                           { Next column across }
               Inc(S, Vh);                            { Move to next column }
               If (S >= Strings.Count) Then           { No next column check }
                 S := (S+1) MOD Vh;                   { Move to last column }
             End;
             kbLeft: Begin                            { Prior column across }
               Dec(S, Vh);                            { Move to prior column }
               If (S < 0) Then  S := ((Strings.Count +
                 Vh - 1) DIV Vh) * Vh + S - 1;        { No prior column check }
             End;
           End;
           If (S >= Strings.Count) Then S := 0;       { Roll up to top }
           If (S < 0) Then S := Strings.Count - 1;    { Roll down to bottom }
         Until ButtonState(S) OR (I > Strings.Count); { Repeat until select }
         MoveSel;                                     { Move to selected }
         ClearEvent(Event);                           { Event was handled }
       End;
       Else Begin                                     { Not an arrow key }
         For I := 0 To Strings.Count-1 Do Begin       { Scan each item }
           Ts := Strings.At(I);                       { Fetch string pointer }
           If (Ts <> Nil) Then C := HotKey(Ts^)       { Check for hotkey }
             Else C := #0;                            { No valid string }
           If (GetAltCode(C) = Event.KeyCode) OR      { Hot key for item }
           (((Owner^.Phase = phPostProcess) OR        { Owner in post process }
           (State AND sfFocused <> 0)) AND (C <> #0)  { Non zero hotkey }
           AND (UpCase(Event.CharCode) = C))          { Matches current key }
           Then Begin
             If ButtonState(I) Then Begin             { Check mask enabled }
               If Focus Then Begin                    { Check view focus }
                 Sel := I;                            { Set selected }
                 MovedTo(Sel);                        { Move to selected }
                 Press(Sel);                          { Call pressed }
                 SetDrawMask(vdFocus OR vdInner);     { Set draw mask }
                 DrawView;                            { Now draw changes }
               End;
               ClearEvent(Event);                     { Event was handled }
             End;
             Exit;                                    { Now exit }
           End;
         End;
         If (Event.CharCode = ' ') AND                { Spacebar key }
         (State AND sfFocused <> 0) AND               { Check focused view }
         ButtonState(Sel) Then Begin                  { Check item enabled }
           Press(Sel);                                { Call pressed }
           SetDrawMask(vdFocus OR vdInner);           { Set draw mask }
           DrawView;                                  { Now draw changes }
           ClearEvent(Event);                         { Event was handled }
         End;
       End;
     End;
   End;
END;

{***************************************************************************}
{                      TCluster OBJECT PRIVATE METHODS                      }
{***************************************************************************}

{--TCluster-----------------------------------------------------------------}
{  FindSel -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB           }
{---------------------------------------------------------------------------}
FUNCTION TCluster.FindSel (P: TPoint): Integer;
VAR I, J, S, Vh: Integer; R: TRect;
BEGIN
   GetExtent(R);                                      { Get view extents }
   If R.Contains(P) Then Begin                        { Point in view }
     If (Options AND ofFramed <> 0) OR                { Normal frame }
     (GOptions AND goThickFramed <> 0) Then           { Thick frame }
       J := 1 Else J := 0;                            { Adjust value }
     Vh := Size.Y - J - J;                            { View height }
     I := 0;                                          { Preset zero value }
     While (P.X >= Column(I+Vh)) Do Inc(I, Vh);       { Inc view size }
     S := I + P.Y - J;                                { Line to select }
     If ((S >= 0) AND (S < Strings.Count))            { Valid selection }
       Then FindSel := S Else FindSel := -1;          { Return selected item }
   End Else FindSel := -1;                            { Point outside view }
END;

{--TCluster-----------------------------------------------------------------}
{  Row -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB               }
{---------------------------------------------------------------------------}
FUNCTION TCluster.Row (Item: Integer): Integer;
BEGIN
   If (Options AND ofFramed <> 0) OR                  { Normal frame }
  (GOptions AND goThickFramed <> 0) Then              { Thick frame }
    Row := Item MOD (Size.Y - 2) Else                 { Allow for frames }
    Row := Item MOD Size.Y;                           { Normal mod value }
END;

{--TCluster-----------------------------------------------------------------}
{  Column -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB            }
{---------------------------------------------------------------------------}
FUNCTION TCluster.Column (Item: Integer): Integer;
VAR I, J, Col, Width, L, Vh: Integer; Ts: PString;
BEGIN
   If (Options AND ofFramed <> 0) OR                  { Normal frame }
   (GOptions AND goThickFramed <> 0) Then             { Thick frame }
     J := 1 Else J := 0;                              { Adjust value }
   Vh := Size.Y - J - J;                              { Vertical size }
   If (Item >= Vh) Then Begin                         { Valid selection }
     Width := 0;                                      { Zero width }
     Col := -6;                                       { Start column at -6 }
     For I := 0 To Item Do Begin                      { For each item }
       If (I MOD Vh = 0) Then Begin                   { Start next column }
         Inc(Col, Width + 6);                         { Add column width }
         Width := 0;                                  { Zero width }
       End;
       If (I < Strings.Count) Then Begin              { Valid string }
         Ts := Strings.At(I);                         { Transfer string }
         If (Ts <> Nil) Then L := CStrLen(Ts^)        { Length of string }
           Else L := 0;                               { No string }
       End;
       If (L > Width) Then Width := L;                { Hold longest string }
     End;
     Column := Col;                                   { Return column }
   End Else Column := 0;                              { Outside select area }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        TRadioButtons OBJECT METHODS                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TRadioButtons------------------------------------------------------------}
{  Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB              }
{---------------------------------------------------------------------------}
FUNCTION TRadioButtons.Mark (Item: Integer): Boolean;
BEGIN
   Mark := Item = Value;                              { True if item = value }
END;

{--TRadioButtons------------------------------------------------------------}
{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB              }
{---------------------------------------------------------------------------}
PROCEDURE TRadioButtons.DrawFocus;
CONST Button = ' ( ) ';
BEGIN
   Inherited DrawFocus;
   DrawMultiBox(Button, #32#7);                       { Redraw the text }
END;

{--TRadioButtons------------------------------------------------------------}
{  Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TRadioButtons.Press (Item: Integer);
BEGIN
   Value := Item;                                     { Set value field }
   Inherited Press(Item);                             { Call ancestor }
END;

{--TRadioButtons------------------------------------------------------------}
{  MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TRadioButtons.MovedTo (Item: Integer);
BEGIN
   Value := Item;                                     { Set value to item }
   If (Id <> 0) Then NewMessage(Owner, evCommand,
     cmIdCommunicate, Id, Value, @Self);              { Send new message }
END;

{--TRadioButtons------------------------------------------------------------}
{  SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TRadioButtons.SetData (Var Rec);
BEGIN
   Sel := Integer(Rec);                               { Set selection }
   Inherited SetData(Rec);                            { Call ancestor }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        TCheckBoxes OBJECT METHODS                         }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TCheckBoxes--------------------------------------------------------------}
{  Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB              }
{---------------------------------------------------------------------------}
FUNCTION TCheckBoxes.Mark(Item: Integer): Boolean;
BEGIN
   If (Value AND (1 SHL Item) <> 0) Then              { Check if item ticked }
     Mark := True Else Mark := False;                 { Return result }
END;

{--TCheckBoxes--------------------------------------------------------------}
{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB              }
{---------------------------------------------------------------------------}
PROCEDURE TCheckBoxes.DrawFocus;
CONST Button = ' [ ] ';
BEGIN
   Inherited DrawFocus;
   DrawMultiBox(Button, ' X');                        { Redraw the text }
END;

{--TCheckBoxes--------------------------------------------------------------}
{  Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TCheckBoxes.Press (Item: Integer);
BEGIN
   Value := Value XOR (1 SHL Item);                   { Flip the item mask }
   Inherited Press(Item);                             { Call ancestor }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                      TMultiCheckBoxes OBJECT METHODS                      }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TMultiCheckBoxes---------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Jun98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TMultiCheckBoxes.Init (Var Bounds: TRect; AStrings: PSItem;
ASelRange: Byte; AFlags: Word; Const AStates: String);
BEGIN
   Inherited Init(Bounds, AStrings);                  { Call ancestor }
   SelRange := ASelRange;                             { Hold select range }
   Flags := AFlags;                                   { Hold flags }
   States := NewStr(AStates);                         { Hold string }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TMultiCheckBoxes.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   S.Read(SelRange, SizeOf(SelRange));                { Read select range }
   S.Read(Flags, SizeOf(Flags));                      { Read flags }
   States := S.ReadStr;                               { Read strings }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB              }
{---------------------------------------------------------------------------}
DESTRUCTOR TMultiCheckBoxes.Done;
BEGIN
   If (States <> Nil) Then DisposeStr(States);        { Dispose strings }
   Inherited Done;                                    { Call ancestor }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB          }
{---------------------------------------------------------------------------}
FUNCTION TMultiCheckBoxes.DataSize: Word;
BEGIN
   DataSize := SizeOf(LongInt);                       { Size to exchange }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB         }
{---------------------------------------------------------------------------}
FUNCTION TMultiCheckBoxes.MultiMark (Item: Integer): Byte;
BEGIN
   MultiMark := (Value SHR (Word(Item) *
    WordRec(Flags).Hi)) AND WordRec(Flags).Lo;        { Return mark state }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB              }
{---------------------------------------------------------------------------}
PROCEDURE TMultiCheckBoxes.DrawFocus;
CONST Button = ' [ ] ';
BEGIN
   Inherited DrawFocus;
   DrawMultiBox(Button, States^);                     { Draw the items }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TMultiCheckBoxes.Press (Item: Integer);
VAR CurState: ShortInt;
BEGIN
   CurState := (Value SHR (Word(Item) *
     WordRec(Flags).Hi)) AND WordRec(Flags).Lo;       { Hold current state }
   Dec(CurState);                                     { One down }
   If (CurState >= SelRange) OR (CurState < 0) Then
     CurState := SelRange - 1;                        { Roll if needed }
   Value := (Value AND NOT (LongInt(WordRec(Flags).Lo)
     SHL (Word(Item) * WordRec(Flags).Hi))) OR
    (LongInt(CurState) SHL (Word(Item) *
    WordRec(Flags).Hi));                              { Calculate value }
   Inherited Press(Item);                             { Call ancestor }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TMultiCheckBoxes.GetData (Var Rec);
BEGIN
   Longint(Rec) := Value;                             { Return value }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TMultiCheckBoxes.SetData (Var Rec);
BEGIN
   Value := Longint(Rec);                             { Set value }
   SetDrawMask(vdFocus OR vdInner);                   { Set redraw mask }
   DrawView;                                          { Redraw masked areas }
END;

{--TMultiCheckBoxes---------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TMultiCheckBoxes.Store (Var S: TStream);
BEGIN
   TCluster.Store(S);                                 { TCluster store called }
   S.Write(SelRange, SizeOf(SelRange));               { Write select range }
   S.Write(Flags, SizeOf(Flags));                     { Write select flags }
   S.WriteStr(States);                                { Write strings }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          TListBox OBJECT METHODS                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

TYPE
   TListBoxRec = PACKED RECORD
     List: PCollection;                               { List collection ptr }
     Selection: Word;                                 { Selected item }
   END;

{--TListBox-----------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TListBox.Init (Var Bounds: TRect; ANumCols: Word;
  AScrollBar: PScrollBar);
BEGIN
   Inherited Init(Bounds, ANumCols, Nil, AScrollBar); { Call ancestor }
   SetRange(0);                                       { Set range to zero }
END;

{--TListBox-----------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TListBox.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   List := PCollection(S.Get);                        { Fetch collection }
END;

{--TListBox-----------------------------------------------------------------}
{  DataSize -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 06Jun98 LdB          }
{---------------------------------------------------------------------------}
FUNCTION TListBox.DataSize: Word;
BEGIN
   DataSize := SizeOf(TListBoxRec);                   { Xchg data size }
END;

{--TListBox-----------------------------------------------------------------}
{  GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
FUNCTION TListBox.GetText (Item: Integer; MaxLen: Integer): String;
VAR P: PString;
BEGIN
   GetText := '';                                     { Preset return }
   If (List <> Nil) Then Begin                        { A list exists }
     P := PString(List^.At(Item));                    { Get string ptr }
     If (P <> Nil) Then GetText := P^;                { Return string }
   End;
END;

{--TListBox-----------------------------------------------------------------}
{  NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.NewList (AList: PCollection);
BEGIN
   If (List <> Nil) Then Dispose(List, Done);         { Dispose old list }
   List := AList;                                     { Hold new list }
   If (AList <> Nil) Then SetRange(AList^.Count)      { Set new item range }
     Else SetRange(0);                                { Set zero range }
   If (Range > 0) Then FocusItem(0);                  { Focus first item }
   DrawView;                                          { Redraw all view }
END;

{--TListBox-----------------------------------------------------------------}
{  GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.GetData (Var Rec);
BEGIN
   TListBoxRec(Rec).List := List;                     { Return current list }
   TListBoxRec(Rec).Selection := Focused;             { Return focused item }
END;

{--TListBox-----------------------------------------------------------------}
{  SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.SetData (Var Rec);
BEGIN
   NewList(TListBoxRec(Rec).List);                    { Hold new list }
   FocusItem(TListBoxRec(Rec).Selection);             { Focus selected item }
   DrawView;                                          { Redraw all view }
END;

{--TListBox-----------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TListBox.Store (Var S: TStream);
BEGIN
   TListViewer.Store(S);                              { TListViewer store }
   S.Put(List);                                       { Store list to stream }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                        TStaticText OBJECT METHODS                         }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TStaticText--------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TStaticText.Init (Var Bounds: TRect; Const AText: String);
BEGIN
   Inherited Init(Bounds);                            { Call ancestor }
   Text := NewStr(AText);                             { Create string ptr }
END;

{--TStaticText--------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TStaticText.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   Text := S.ReadStr;                                 { Read text string }
END;

{--TStaticText--------------------------------------------------------------}
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB              }
{---------------------------------------------------------------------------}
DESTRUCTOR TStaticText.Done;
BEGIN
   If (Text <> Nil) Then DisposeStr(Text);            { Dispose string }
   Inherited Done;                                    { Call ancestor }
END;

{--TStaticText--------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TStaticText.GetPalette: PPalette;
CONST P: String[Length(CStaticText)] = CStaticText;   { Always normal string }
BEGIN
   GetPalette := @P;                                  { Return palette }
END;

{--TStaticText--------------------------------------------------------------}
{  DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB    }
{---------------------------------------------------------------------------}
PROCEDURE TStaticText.DrawBackGround;
VAR Just: Byte; I, J, P, Y, L: Integer; S, T: String;
BEGIN
   Inherited DrawBackGround;                          { Call ancestor }
   GetText(S);                                        { Fetch text to write }
   P := 1;                                            { X start position }
   Y := 0;                                            { Y start position }
   L := Length(S);                                    { Length of text }
   While (Y < Size.Y) AND (P <= L) Do Begin
     Just := 0;                                       { Default left justify }
     If (S[P] = #2) Then Begin                        { Right justify char }
       Just := 2;                                     { Set right justify }
       Inc(P);                                        { Next character }
     End;
     If (S[P] = #3) Then Begin                        { Centre justify char }
       Just := 1;                                     { Set centre justify }
       Inc(P);                                        { Next character }
     End;
     I := P;                                          { Start position }
     While (P <= L) AND (S[P] <> #13) Do Inc(P);      { Scan for end }
     T := Copy(S, I, P-I);                            { String to write }
     Case Just Of
       0: J := 0;                                     { Left justify }
       1: J := (RawSize.X - TextWidth(T)) DIV 2;      { Centre justify }
       2: J := RawSize.X - TextWidth(T);              { Right justify }
     End;
     While (J < 0) Do Begin                           { Text to long }
       J := J + TextWidth(T[1]);                      { Add width to J }
       Delete(T, 1, 1);                               { Delete the char }
     End;
     WriteStr(-J, -(Y*FontHeight), T, 1);             { Write the text }
     While (P <= L) AND ((S[P] = #13) OR (S[P] = #10))
       Do Inc(P);                                     { Remove CR/LF }
     Inc(Y);                                          { Next line }
   End;
END;

{--TStaticText--------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TStaticText.Store (Var S: TStream);
BEGIN
   TView.Store(S);                                    { Call TView store }
   S.WriteStr(Text);                                  { Write text string }
END;

{--TStaticText--------------------------------------------------------------}
{  GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TStaticText.GetText (Var S: String);
BEGIN
   If (Text <> Nil) Then S := Text^                   { Copy text string }
     Else S := '';                                    { Return empty string }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                         TParamText OBJECT METHODS                         }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TParamText---------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TParamText.Init (Var Bounds: TRect; Const AText: String;
  AParamCount: Integer);
BEGIN
   Inherited Init(Bounds, AText);                     { Call ancestor }
   ParamCount := AParamCount;                         { Hold param count }
END;

{--TParamText---------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TParamText.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   S.Read(ParamCount, 2);                             { Read parameter count }
END;

{--TParamText---------------------------------------------------------------}
{  DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB          }
{---------------------------------------------------------------------------}
FUNCTION TParamText.DataSize: Word;
BEGIN
   DataSize := ParamCount * SizeOf(Pointer);          { Return data size }
END;

{--TParamText---------------------------------------------------------------}
{  GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TParamText.GetData (Var Rec);
BEGIN
   Pointer(Rec) := @ParamList;                        { Return parm ptr }
END;

{--TParamText---------------------------------------------------------------}
{  SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TParamText.SetData (Var Rec);
BEGIN
   ParamList := @Rec;                                 { Fetch parameter list }
   DrawView;                                          { Redraw all the view }
END;

{--TParamText---------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TParamText.Store (Var S: TStream);
BEGIN
   TStaticText.Store(S);                              { Statictext store }
   S.Write(ParamCount, 2);                            { Store param count }
END;

{--TParamText---------------------------------------------------------------}
{  GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB           }
{---------------------------------------------------------------------------}
PROCEDURE TParamText.GetText (Var S: String);
BEGIN
   If (Text = Nil) Then S := '' Else                  { Return empty string }
     FormatStr(S, Text^, ParamList^);                 { Return text string }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           TLabel OBJECT METHODS                           }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--TLabel-------------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TLabel.Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
BEGIN
   Inherited Init(Bounds, AText);                     { Call ancestor }
   Link := ALink;                                     { Hold link }
   Options := Options OR (ofPreProcess+ofPostProcess);{ Set pre/post process }
   EventMask := EventMask OR evBroadcast;             { Sees broadcast events }
END;

{--TLabel-------------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR TLabel.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   GetPeerViewPtr(S, Link);                           { Load link view }
END;

{--TLabel-------------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB        }
{---------------------------------------------------------------------------}
FUNCTION TLabel.GetPalette: PPalette;
CONST P: String[Length(CLabel)] = CLabel;             { Always normal string }
BEGIN
   GetPalette := @P;                                  { Return palette }
END;

{--TLabel-------------------------------------------------------------------}
{  DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB    }
{---------------------------------------------------------------------------}
PROCEDURE TLabel.DrawBackGround;
VAR SCOff: Byte; Color: Word; B: TDrawBuffer;
BEGIN
   TView.DrawBackGround;                              { Explict call to TView }
   If Light Then Begin                                { Light colour select }
     Color := GetColor($0402);                        { Choose light colour }
     SCOff := 0;                                      { Zero offset }
   End Else Begin
     Color := GetColor($0301);                        { Darker colour }
     SCOff := 4;                                      { Set offset }
   End;
   MoveChar(B[0], ' ', Byte(Color), Size.X);          { Clear the buffer }
   If (Text <> Nil) Then MoveCStr(B[1], Text^, Color);{ Transfer label text }
   If ShowMarkers Then WordRec(B[0]).Lo := Byte(
     SpecialChars[SCOff]);                            { Show marker if req }
   WriteLine(0, 0, Size.X, 1, B);                     { Write the text }
END;

{--TLabel-------------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE TLabel.Store (Var S: TStream);
BEGIN
   TStaticText.Store(S);                              { TStaticText.Store }
   PutPeerViewPtr(S, Link);                           { Store link view }
END;

{--TLabel-------------------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE TLabel.HandleEvent (Var Event: TEvent);
VAR C: Char;

   PROCEDURE FocusLink;
   BEGIN
     If (Link <> Nil) AND (Link^.Options AND
      ofSelectable <> 0) Then Link^.Focus;            { Focus link view }
     ClearEvent(Event);                               { Clear the event }
   END;

BEGIN
   Inherited HandleEvent(Event);                      { Call ancestor }
   Case Event.What Of
     evNothing: Exit;                                 { Speed up exit }
     evMouseDown: FocusLink;                          { Focus link view }
     evKeyDown: Begin
       C := HotKey(Text^);                            { Check for hotkey }
       If (GetAltCode(C) = Event.KeyCode) OR          { Alt plus char }
       ((C <> #0) AND (Owner^.Phase = phPostProcess)  { Post process phase }
       AND (UpCase(Event.CharCode) = C)) Then         { Upper case match }
         FocusLink;                                   { Focus link view }
     End;
     evBroadcast: If ((Event.Command = cmReceivedFocus)
       OR (Event.Command = cmReleasedFocus)) AND      { Focus state change }
       (Link <> Nil) Then Begin
         Light := Link^.State AND sfFocused <> 0;     { Change light state }
         DrawView;                                    { Now redraw change }
       End;
   End;
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                       THistoryViewer OBJECT METHODS                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--THistoryViewer-----------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR THistoryViewer.Init (Var Bounds: TRect; AHScrollBar,
AVScrollBar: PScrollBar; AHistoryId: Word);
BEGIN
   Inherited Init(Bounds, 1, AHScrollBar,
     AVScrollBar);                                    { Call ancestor }
   HistoryId := AHistoryId;                           { Hold history id }
   SetRange(HistoryCount(AHistoryId));                { Set history range }
   If (Range > 1) Then FocusItem(1);                  { Set to item 1 }
   If (HScrollBar <> Nil) Then
     HScrollBar^.SetRange(1, HistoryWidth-Size.X + 3);{ Set scrollbar range }
END;

{--THistoryViewer-----------------------------------------------------------}
{  HistoryWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB      }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.HistoryWidth: Integer;
VAR Width, T, Count, I: Integer;
BEGIN
   Width := 0;                                        { Zero width variable }
   Count := HistoryCount(HistoryId);                  { Hold count value }
   For I := 0 To Count-1 Do Begin                     { For each item }
     T := Length(HistoryStr(HistoryId, I));           { Get width of item }
     If (T > Width) Then Width := T;                  { Set width to max }
   End;
   HistoryWidth := Width;                             { Return max item width }
END;

{--THistoryViewer-----------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB        }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.GetPalette: PPalette;
CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
BEGIN
   GetPalette := @P;                                  { Return palette }
END;

{--THistoryViewer-----------------------------------------------------------}
{  GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB           }
{---------------------------------------------------------------------------}
FUNCTION THistoryViewer.GetText (Item: Integer; MaxLen: Integer): String;
BEGIN
   GetText := HistoryStr(HistoryId, Item);            { Return history string }
END;

{--THistoryViewer-----------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE THistoryViewer.HandleEvent (Var Event: TEvent);
BEGIN
   If ((Event.What = evMouseDown) AND (Event.Double)) { Double click mouse }
   OR ((Event.What = evKeyDown) AND
   (Event.KeyCode = kbEnter)) Then Begin              { Enter key press }
     EndModal(cmOk);                                  { End with cmOk }
     ClearEvent(Event);                               { Event was handled }
   End Else If ((Event.What = evKeyDown) AND
   (Event.KeyCode = kbEsc)) OR                        { Esc key press }
   ((Event.What = evCommand) AND
   (Event.Command = cmCancel)) Then Begin             { Cancel command }
     EndModal(cmCancel);                              { End with cmCancel }
     ClearEvent(Event);                               { Event was handled }
   End Else Inherited HandleEvent(Event);             { Call ancestor }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                       THistoryWindow OBJECT METHODS                       }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--THistoryWindow-----------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR THistoryWindow.Init (Var Bounds: TRect; HistoryId: Word);
BEGIN
   Inherited Init(Bounds, '', wnNoNumber);            { Call ancestor }
   Flags := wfClose;                                  { Close flag only }
   InitViewer(HistoryId);                             { Create list view }
END;

{--THistoryWindow-----------------------------------------------------------}
{  GetSelection -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB      }
{---------------------------------------------------------------------------}
FUNCTION THistoryWindow.GetSelection: String;
BEGIN
   If (Viewer = Nil) Then GetSelection := '' Else     { Return empty string }
     GetSelection := Viewer^.GetText(Viewer^.Focused,
       255);                                          { Get focused string }
END;

{--THistoryWindow-----------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB        }
{---------------------------------------------------------------------------}
FUNCTION THistoryWindow.GetPalette: PPalette;
CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
BEGIN
   GetPalette := @P;                                  { Return the palette }
END;

{--THistoryWindow-----------------------------------------------------------}
{  InitViewer -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB        }
{---------------------------------------------------------------------------}
PROCEDURE THistoryWindow.InitViewer(HistoryId: Word);
VAR R: TRect;
BEGIN
   GetExtent(R);                                      { Get extents }
   R.Grow(-1,-1);                                     { Grow inside }
   Viewer := New(PHistoryViewer, Init(R,
     StandardScrollBar(sbHorizontal + sbHandleKeyboard),
     StandardScrollBar(sbVertical + sbHandleKeyboard),
     HistoryId));                                     { Create the viewer }
   If (Viewer <> Nil) Then Insert(Viewer);            { Insert viewer }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                          THistory OBJECT METHODS                          }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{--THistory-----------------------------------------------------------------}
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR THistory.Init (Var Bounds: TRect; ALink: PInputLine;
AHistoryId: Word);
BEGIN
   Inherited Init(Bounds);                            { Call ancestor }
   Options := Options OR ofPostProcess;               { Set post process }
   EventMask := EventMask OR evBroadcast;             { See broadcast events }
   Link := ALink;                                     { Hold link view }
   HistoryId := AHistoryId;                           { Hold history id }
END;

{--THistory-----------------------------------------------------------------}
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB              }
{---------------------------------------------------------------------------}
CONSTRUCTOR THistory.Load (Var S: TStream);
BEGIN
   Inherited Load(S);                                 { Call ancestor }
   GetPeerViewPtr(S, Link);                           { Load link view }
   S.Read(HistoryId, 2);                              { Read history id }
END;

{--THistory-----------------------------------------------------------------}
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB        }
{---------------------------------------------------------------------------}
FUNCTION THistory.GetPalette: PPalette;
CONST P: String[Length(CHistory)] = CHistory;         { Always normal string }
BEGIN
   GetPalette := @P;                                  { Return the palette }
END;

{--THistory-----------------------------------------------------------------}
{  InitHistoryWindow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
{---------------------------------------------------------------------------}
FUNCTION THistory.InitHistoryWindow (Var Bounds: TRect): PHistoryWindow;
VAR P: PHistoryWindow;
BEGIN
   P := New(PHistoryWindow, Init(Bounds, HistoryId)); { Create history window }
   If (Link <> Nil) Then
     P^.HelpCtx := Link^.HelpCtx;                     { Set help context }
   InitHistoryWindow := P;                            { Return history window }
END;

PROCEDURE THistory.Draw;
VAR B: TDrawBuffer;
BEGIN
   MoveCStr(B, #222'~'#25'~'#221, GetColor($0102));   { Set buffer data }
   WriteLine(0, 0, Size.X, Size.Y, B);                { Write buffer }
END;

{--THistory-----------------------------------------------------------------}
{  RecordHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB     }
{---------------------------------------------------------------------------}
PROCEDURE THistory.RecordHistory (CONST S: String);
BEGIN
   HistoryAdd(HistoryId, S);                          { Add to history }
END;

{--THistory-----------------------------------------------------------------}
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB             }
{---------------------------------------------------------------------------}
PROCEDURE THistory.Store (Var S: TStream);
BEGIN
   TView.Store(S);                                    { TView.Store called }
   PutPeerViewPtr(S, Link);                           { Store link view }
   S.Write(HistoryId, 2);                             { Store history id }
END;

{--THistory-----------------------------------------------------------------}
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB       }
{---------------------------------------------------------------------------}
PROCEDURE THistory.HandleEvent (Var Event: TEvent);
VAR C: Word; Rslt: String; R, P: TRect; HistoryWindow: PHistoryWindow;
BEGIN
   Inherited HandleEvent(Event);                      { Call ancestor }
   If (Link = Nil) Then Exit;                         { No link view exits }
   If (Event.What = evMouseDown) OR                   { Mouse down event }
   ((Event.What = evKeyDown) AND
    (CtrlToArrow(Event.KeyCode) = kbDown) AND         { Down arrow key }
    (Link^.State AND sfFocused <> 0)) Then Begin      { Link view selected }
      If NOT Link^.Focus Then Begin
       ClearEvent(Event);                             { Event was handled }
       Exit;                                          { Now exit }
      End;
     RecordHistory(Link^.Data^);                      { Record current data }
     Link^.GetBounds(R);                              { Get view bounds }
     Dec(R.A.X);                                      { One char in from us }
     Inc(R.B.X);                                      { One char short of us }
     Inc(R.B.Y, 7);                                   { Seven lines down }
     Dec(R.A.Y,1);                                    { One line below us }
     Owner^.GetExtent(P);                             { Get owner extents }
     R.Intersect(P);                                  { Intersect views }
     Dec(R.B.Y,1);                                    { Shorten length by one }
     HistoryWindow := InitHistoryWindow(R);           { Create history window }
     If (HistoryWindow <> Nil) Then Begin             { Window crested okay }
       C := Owner^.ExecView(HistoryWindow);           { Execute this window }
       If (C = cmOk) Then Begin                       { Result was okay }
         Rslt := HistoryWindow^.GetSelection;         { Get history selection }
         If Length(Rslt) > Link^.MaxLen Then
            SetLength(Rslt, Link^.MaxLen);            { Hold new length }
         Link^.Data^ := Rslt;                         { Hold new selection }
         Link^.SelectAll(True);                       { Select all string }
         Link^.DrawView;                              { Redraw link view }
       End;
       Dispose(HistoryWindow, Done);                  { Dispose of window }
     End;
     ClearEvent(Event);                               { Event was handled }
   End Else If (Event.What = evBroadcast) Then        { Broadcast event }
     If ((Event.Command = cmReleasedFocus) AND
     (Event.InfoPtr = Link)) OR
     (Event.Command = cmRecordHistory) Then           { Record command }
       RecordHistory(Link^.Data^);                    { Record the history }
END;

{***************************************************************************}
{                            INTERFACE ROUTINES                             }
{***************************************************************************}

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                           ITEM STRING ROUTINES                            }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  NewSItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB          }
{---------------------------------------------------------------------------}
FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
VAR Item: PSItem;
BEGIN
   New(Item);                                         { Allocate item }
   Item^.Value := NewStr(Str);                        { Hold item string }
   Item^.Next := ANext;                               { Chain the ptr }
   NewSItem := Item;                                  { Return item }
END;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{                    DIALOG OBJECT REGISTRATION ROUTINES                    }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

{---------------------------------------------------------------------------}
{  RegisterDialogs -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB   }
{---------------------------------------------------------------------------}
PROCEDURE RegisterDialogs;
BEGIN
   RegisterType(RDialog);                             { Register dialog }
   RegisterType(RInputLine);                          { Register inputline }
   RegisterType(RButton);                             { Register button }
   RegisterType(RCluster);                            { Register cluster }
   RegisterType(RRadioButtons);                       { Register radiobutton }
   RegisterType(RCheckBoxes);                         { Register check boxes }
   RegisterType(RMultiCheckBoxes);                    { Register multi boxes }
   RegisterType(RListBox);                            { Register list box }
   RegisterType(RStaticText);                         { Register static text }
   RegisterType(RLabel);                              { Register label }
   RegisterType(RHistory);                            { Register history }
   RegisterType(RParamText);                          { Register parm text }
END;

END.
{
 $Log$
 Revision 1.10  2001-06-01 16:00:00  pierre
  * small changes for tbutton.draw

 Revision 1.9  2001/05/31 12:14:50  pierre
  Better button draw

 Revision 1.8  2001/05/10 16:46:27  pierre
  + some improovements made

 Revision 1.7  2001/05/07 22:22:03  pierre
  * removed NO_WINDOW cond, added GRAPH_API

 Revision 1.6  2001/05/04 10:46:01  pierre
  * various fixes  for win32 api mode

 Revision 1.5  2001/05/04 08:42:54  pierre
  * some corrections for linux

 Revision 1.4  2001/05/03 22:32:52  pierre
  new bunch of changes, displays something for dos at least

 Revision 1.3  2001/04/10 21:29:55  pierre
  * import of Leon de Boer's files

 Revision 1.2  2000/08/24 12:00:20  marco
  * CVS log and ID tags
}
{******************[ REVISION HISTORY ]********************}
{  Version  Date        Fix                                }
{  -------  ---------   ---------------------------------  }
{  1.00     11 Nov 96   First DOS/DPMI platform release.   }
{  1.10     13 Jul 97   Windows platform code added.       }
{  1.20     29 Aug 97   Platform.inc sort added.           }
{  1.30     13 Oct 97   Delphi 2 32 bit code added.        }
{  1.40     05 May 98   Virtual pascal 2.0 code added.     }
{  1.50     27 Oct 99   All objects completed and checked  }
{  1.51     03 Nov 99   FPC windows support added          }
{  1.60     26 Nov 99   Graphics stuff moved to GFVGraph   }
{**********************************************************}