home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TOTSRC.ZIP / TOTIO1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-10  |  59.7 KB  |  2,278 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.00                             }
  6.  
  7. Unit totIO1;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.  
  13. }
  14.  
  15. INTERFACE
  16.  
  17. uses DOS, CRT,
  18.      totSYS, totLOOK, totFAST, totWIN, totSTR, totINPUT;
  19.  
  20. CONST
  21.    NoRules      = $00;
  22.    AllowNull    = $01;
  23.    SuppressZero = $02;
  24.    EraseDefault = $08;
  25.    JumpIfFull   = $10;
  26.    MaxButtonWidth = 25;  {alter as necessary}
  27.    HelpID = 65535;
  28.  
  29. TYPE
  30.  
  31. tCursPos = (CursLeft,CursRight,CursPrev);
  32. tStatus = (HiStatus, Norm, Off);
  33. tAction = (None,NextField,PrevField,Finished,Escaped,
  34.            Refresh,Signal,Enter,Help,Stop1,Stop2,Stop3,Stop4,
  35.            Stop5,Stop6,Stop7,Stop8,Stop9);
  36. tColor = array[1..4] of byte;
  37.  
  38. StringBut = string[MaxButtonWidth];
  39.  
  40. LeaveFieldfunc = function(var FieldID:word): tAction;
  41. EnterFieldfunc = function(var NewID:word; OldID:word): tAction;
  42. CharFunc =       function(var K:word;var X,Y:byte; var FieldID:word): tAction;
  43. HelpProc =       procedure(ID:word);
  44.  
  45. tSignal = record
  46.    ID: word;
  47.    MsgType: word;
  48.    case word of           {variant record}
  49.    0: (MsgPtr: pointer);
  50.    1: (MsgLong: longint);
  51.    2: (MsgWord: word);
  52.    3: (MsgInt: integer);
  53.    4: (MsgByte: byte);
  54.    5: (MsgChar: char);
  55. end;
  56.  
  57. InputOBJ = object  {defines the default attributes for the fields}
  58.    vLabel: tColor;
  59.    vButton: tColor;
  60.    vGroup: tColor;
  61.    vList: tColor;
  62.    vField: tColor;  {Off, On, Mask, Inactive}
  63.    vMessage: byte;
  64.    vInputPad: char;
  65.    vCase: tCase;
  66.    vForceCase: boolean;     {adjust case of characters during input}
  67.    vInputJust: tJust;
  68.    vCursorLoc: tCursPos;
  69.    vInsert: boolean;      {is field initially in insert mode}
  70.    vRules: byte;          {erasedefault, jumpiffull..... etc.}
  71.    {methods...}
  72.    constructor Init;
  73.    procedure   SetDefaults;
  74.    procedure   SetColLabel(Off,OffHot,On,OnHot: byte);
  75.    procedure   SetColButton(Off,OffHot,On,OnHot: byte);
  76.    procedure   SetColGroup(Off,OffHot,On,OnHot: byte);
  77.    procedure   SetColList(Off,OffHot,On,OnHot: byte);
  78.    procedure   SetColField(Off,On,Mask,Inactive: byte);
  79.    procedure   SetColMsg(Col:byte);
  80.    procedure   SetIns(InsOn:boolean);
  81.    procedure   SetRules(Rules:byte);
  82.    procedure   SetPadChar(Pad:char);
  83.    procedure   SetJust(Just:tJust);
  84.    procedure   SetCursor(Curs: tCursPos);
  85.    procedure   SetCase(Cas:tCase);
  86.    procedure   SetForceCase(On:boolean);
  87.    function    LabelCol(Element:byte): byte;
  88.    function    ButtonCol(Element:byte): byte;
  89.    function    GroupCol(Element:byte): byte;
  90.    function    ListCol(Element:byte): byte;
  91.    function    FieldCol(Element:byte): byte;
  92.    function    MessageCol: byte;
  93.    function    InputPad: char;
  94.    function    InputIns:boolean;
  95.    function    InputRules: byte;
  96.    function    InputPadChar: char;
  97.    function    InputJust: tJust;
  98.    function    InputCursorLoc: tCursPos;
  99.    function    InputCase: tCase;
  100.    function    InputForceCase: boolean;
  101.    destructor  Done;
  102. end; {InputOBJ}
  103.  
  104. pItemIOOBJ = ^ItemIOOBJ;
  105. ItemIOOBJ = object
  106.    vBoundary: tCoords;
  107.    vHotKey: word;
  108.    vID: word;
  109.    vActive: boolean;
  110.    {methods ...}
  111.    constructor Init;
  112.    procedure   SetActiveStatus(Selectable:boolean);
  113.    function    Active:boolean;
  114.    function    GetHotKey: word;
  115.    procedure   SetHotkey(HK:word);
  116.    function    GetID: word;
  117.    procedure   SetID(ID:word);
  118.    function    Ontarget(X,Y: byte): boolean;                           VIRTUAL;
  119.    function    Visible: boolean;                                       VIRTUAL;
  120.    procedure   RaiseSignal(var TheSig:tSignal);                        VIRTUAL;
  121.    procedure   HandleSignal(var BaseSig:tSignal; var NewSig:tSignal);  VIRTUAL;
  122.    procedure   ShutdownSignal(var BaseSig:tSignal);                    VIRTUAL;
  123.    function    IsHotkey(HK:word):boolean;                              VIRTUAL;
  124.    procedure   WriteLabel(Status:tStatus);                             VIRTUAL;
  125.    procedure   Display(Status:tStatus);                                VIRTUAL;
  126.    function    Select(K:word; X,Y:byte):tAction;                       VIRTUAL;
  127.    function    ProcessKey(InKey:word;X,Y:byte):tAction;                VIRTUAL;
  128.    function    Suspend:boolean;                                        VIRTUAL;
  129.    destructor  Done;                                                   VIRTUAL;
  130. end; {ItemIOOBJ}
  131.  
  132. pHotkeyIOOBJ = ^HotkeyIOOBJ;
  133. HotkeyIOOBJ = object (ItemIOOBJ)
  134.    vActionCode: tAction;
  135.    {methods ...}
  136.    constructor Init(HK:Word;Act:tAction);
  137.    function    IsHotkey(HK:word):boolean;                              VIRTUAL;
  138.    function    Select(K:word; X,Y:byte):tAction;                       VIRTUAL;
  139.    destructor  Done;                                                   VIRTUAL;
  140. end; {HotkeyIOOBJ}
  141.  
  142. pControlKeysIOOBJ = ^ControlKeysIOOBJ;
  143. ControlKeysIOOBJ = object (ItemIOOBJ)
  144.    vFinKey: word;
  145.    vNexkey: word;
  146.    vPreKey: word;
  147.    vEscKey: word;
  148.    {methods ...}
  149.    constructor Init;
  150.    procedure   SetKeys(Next,Prev,Fin,Esc:Word);
  151.    function    IsHotkey(HK:word):boolean;                              VIRTUAL;
  152.    function    Select(K:word; X,Y:byte):tAction;                       VIRTUAL;
  153.    destructor  Done;                                                   VIRTUAL;
  154. end; {ControlKeysIOOBJ}
  155.  
  156. pVisibleIOOBJ = ^VisibleIOOBJ;
  157. VisibleIOOBJ = object (ItemIOOBJ)
  158.   vLblPtr: pointer;
  159.   vMsgPtr: pointer;
  160.   vMsgX: byte;
  161.   vMsgY: byte;
  162.   {methods ...}
  163.   constructor Init;
  164.   procedure   SetLabel(Lbl:string);
  165.   procedure   SetMessage(X,Y:byte; Msg:string);
  166.   procedure   WriteMessage;
  167.   function    Ontarget(X,Y: byte): boolean;             VIRTUAL;
  168.   function    Visible: boolean;                         VIRTUAL;
  169.   procedure   WriteLabel(Status:tStatus);               VIRTUAL;
  170.   function    Suspend:boolean;                          VIRTUAL;
  171.   destructor  Done;                                     VIRTUAL;
  172. end; {VisibleIOOBJ}
  173.  
  174. pStripIOOBJ = ^StripIOOBJ;
  175. StripIOOBJ = object(VisibleIOOBJ)
  176.    vTitle: StringBut;
  177.    vActionCode: tAction;
  178.    {methods ...}
  179.    constructor Init(X1,Y1:byte;Tit:string;Act:tAction);
  180.    function    Ontarget(X,Y: byte): boolean;            VIRTUAL;
  181.    function    IsHotkey(HK:word):boolean;               VIRTUAL;
  182.    procedure   Display(Status:tStatus);                 VIRTUAL;
  183.    function    Select(K:word; X,Y:byte):tAction;        VIRTUAL;
  184.    function    ProcessKey(InKey:word;X,Y:byte):tAction; VIRTUAL;
  185.    destructor  Done;                                    VIRTUAL;
  186. end; {StripIOOBJ}
  187.  
  188. pStrip3dIOOBJ = ^Strip3dIOOBJ;
  189. Strip3dIOOBJ = object(StripIOOBJ)
  190.    {methods ...}
  191.    constructor Init(X1,Y1:byte;Tit:string;Act:tAction);
  192.    procedure   Display(Status:tStatus);                 VIRTUAL;
  193.    destructor  Done;                                    VIRTUAL;
  194. end; {Strip3dIOOBJ}
  195.  
  196. pButtonIOOBJ = ^ButtonIOOBJ;
  197. ButtonIOOBJ = object(StripIOOBJ)
  198.    {methods ...}
  199.    constructor Init(X1,Y1:byte;Tit:string;Act:tAction);
  200.    procedure   Display(Status:tStatus);                 VIRTUAL;
  201.    destructor  Done;                                    VIRTUAL;
  202. end; {ButtonIOOBJ}
  203.  
  204. pMultiLineIOOBJ = ^MultiLineIOOBJ;
  205. MultiLineIOOBJ = object (VisibleIOOBJ)
  206.    vBorder: tCoords;
  207.    vTitle: StrVisible;
  208.    vRows: byte;
  209.    {methods ...}
  210.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  211.    procedure   SetBoxOn(On:boolean);
  212.    procedure   Display(Status:tStatus);                  VIRTUAL;          
  213.    procedure   Activate;                                 VIRTUAL;
  214.    destructor  Done;                                     VIRTUAL;
  215. end; {MultiLineIOOBJ}
  216.  
  217. GroupItemPtr = ^GroupItem;
  218. GroupItem = record
  219.    NextNode: GroupItemPtr;
  220.    PrevNode: GroupItemPtr;
  221.    StrPtr: Pointer;
  222.    HK: word;
  223.    Selected: boolean;
  224. end;
  225.  
  226. pGroupIOOBJ = ^GroupIOOBJ;
  227. GroupIOOBJ = object (MultiLineIOOBJ)
  228.    vItemStack: GroupItemPtr;
  229.    vTotalItems: byte;
  230.    vActiveItem: byte;
  231.    vOnStr: string[3];
  232.    vOffStr: string[3];
  233.    vSubHotkeysActive : boolean;
  234.    {methods ...}
  235.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  236.    procedure   SetSubHotkeysActive(On:boolean);
  237.    function    EndNode: GroupItemPtr;
  238.    function    NodePtr(Item:byte): GroupItemPtr;
  239.    procedure   AddItem(Str:string;HK:word;Selected:boolean);
  240.    function    HotKeyItem(HK:word): integer;
  241.    function    HitItem(X,Y:byte):byte;
  242.    procedure   WriteItem(Item:byte; IsActive:boolean);
  243.    function    Select(K:word; X,Y:byte):tAction;                     VIRTUAL;
  244.    function    IsHotkey(HK:word):boolean;                            VIRTUAL;
  245.    procedure   Display(Status:tStatus);                              VIRTUAL;
  246.    destructor  Done;                                                 VIRTUAL;
  247. end;  {GroupIOOBJ}
  248.  
  249. pCheckIOOBJ = ^CheckIOOBJ;
  250. CheckIOOBJ = object (GroupIOOBJ)
  251.    {methods ...}
  252.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  253.    procedure   SetValue(Item:byte;Selected:boolean);
  254.    function    GetValue(Item:byte):boolean;
  255.    function    ProcessKey(InKey:word;X,Y:byte):tAction;              VIRTUAL;
  256.    function    Select(K:word; X,Y:byte):tAction;                     VIRTUAL;
  257.    destructor  Done;                                                 VIRTUAL;
  258. end; {CheckIOOBJ}
  259.  
  260. pRadioIOOBJ = ^RadioIOOBJ;
  261. RadioIOOBJ = object (GroupIOOBJ)
  262.    {methods ...}
  263.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  264.    procedure   SetValue(Item:byte);
  265.    function    GetValue: byte;
  266.    function    ProcessKey(InKey:word;X,Y:byte):tAction;              VIRTUAL;
  267.    function    Select(K:word; X,Y:byte):tAction;                     VIRTUAL;
  268.    destructor  Done;                                                 VIRTUAL;
  269. end; {RadioIOOBJ}
  270.  
  271. pItemNode = ^ItemNode;
  272. ItemNode = record
  273.    Item: pItemIOOBJ;
  274.    NextNode: pItemNode;
  275.    PrevNode: pItemNode;
  276. end; {ItemList}
  277.  
  278. pFormOBJ = ^FormOBJ;
  279. FormOBJ = object
  280.    vItemStack: pItemNode;
  281.    vActiveItem: pItemNode;
  282.    vCharHook: CharFunc;
  283.    vLeaveHook: LeaveFieldFunc;
  284.    vEnterHook: EnterFieldFunc;
  285.    vHelpHook:  HelpProc;
  286.    {methods ...}
  287.    constructor Init;
  288.    procedure   AddItem(var NewItem: ItemIOOBJ);
  289.    procedure   SetCharHook(Func:CharFunc);
  290.    procedure   SetLeaveHook(Func:LeaveFieldFunc);
  291.    procedure   SetEnterHook(Func:EnterFieldFunc);
  292.    procedure   SetHelpHook(Proc:HelpProc);
  293.    function    EndNode: pItemNode;
  294.    procedure   SetActiveItem(ID:word);
  295.    function    HotKeyItemPtr(HotKey:word):pItemNode;
  296.    function    IDItemPtr(ID:word):pItemNode;
  297.    function    HotSpotItemPtr(X,Y:byte):pItemNode;
  298.    function    Go: tAction;
  299.    procedure   BroadcastSignal(TheSig:tSignal; SignalSource: pItemNode);
  300.    procedure   DisplayItems;                                
  301.    procedure   AdjustKey(var Key:word;var X,Y: byte);          VIRTUAL;
  302.    procedure   HelpTask(ID:word);                              VIRTUAL;
  303.    function    CharTask(var K:word;var X,Y:byte;
  304.                         var FieldID:word):tAction;             VIRTUAL;
  305.    function    EnterTask(var NewID:word; OldID:word): tAction; VIRTUAL;
  306.    function    LeaveTask(var FieldID:word): tAction;           VIRTUAL;
  307.    destructor  Done;                                           VIRTUAL;
  308. end; {FormOBJ}
  309.  
  310. WinFormPtr = ^WinFormOBJ;
  311. pWinFormOBJ = WinFormPtr;
  312. WinFormOBJ = object (FormOBJ)
  313.    vWinPtr: MoveWinPtr;
  314.    {methods ...}
  315.    constructor Init;
  316.    function    Win: MoveWinPtr;
  317.    procedure   Draw;
  318.    procedure   AdjustKey(var Key:word;var X,Y: byte);       VIRTUAL;
  319.    destructor  Done;                                        VIRTUAL;
  320. end; {WinFormOBJ}
  321.  
  322. procedure IO1Init;
  323. function NoCharHook(var K:word;var X,Y:byte;var FieldID:word): tAction;
  324. function NoEnterHook(var FieldID:word; OtherID:word): tAction;
  325. function NoLeaveHook(var ID:word): tAction;
  326. procedure NoHelpHook(ID:word);
  327. procedure AssignColors(Main,Inactive:tColor; Status:tStatus; var High,Nor:byte);
  328.  
  329. var
  330.   IOTOT: ^InputOBJ;
  331.  
  332. IMPLEMENTATION
  333. Var
  334.    FormHelpCalled,
  335.    EscapingForm: boolean;
  336. {|||||||||||||||||||||||||||||||||||||||||||||}
  337. {                                             }
  338. {     M i s c.  P r o c s   &   F u n c s     }
  339. {                                             }
  340. {|||||||||||||||||||||||||||||||||||||||||||||}
  341. {$F+}
  342. function NoCharHook(var K:word;var X,Y:byte;var FieldID:word): tAction;
  343. {}
  344. begin
  345.    NoCharHook := None;
  346. end; {NoCharHook}
  347.  
  348. function NoEnterHook(var FieldID:word; OtherID:word): tAction;
  349. {}
  350. begin
  351.    NoEnterHook := none;
  352. end; {NoEnterHook}
  353.  
  354. function NoLeaveHook(var ID:word): tAction;
  355. {}
  356. begin
  357.    NoLeaveHook := none;
  358. end; {NoLeaveHook}
  359.  
  360. procedure NoHelpHook(ID:word);
  361. {}
  362. begin
  363.    Ding;
  364. end; {NoHelpHook}
  365. {$IFNDEF OVERLAY}
  366.    {$F-}
  367. {$ENDIF}
  368.  
  369. procedure AssignColors(Main,Inactive:tColor; Status:tStatus; var High,Nor:byte);
  370. {}
  371. begin
  372.    Case Status of
  373.       HiStatus: begin
  374.          High := Main[4];
  375.          Nor := Main[3];
  376.       end;
  377.       Norm: begin
  378.          High := Main[2];
  379.          Nor := Main[1];
  380.       end;
  381.       Off: begin
  382.          High := Inactive[4];
  383.          Nor := Inactive[4];
  384.       end;
  385.    end; {case}
  386. end; {AssignColors}
  387. {|||||||||||||||||||||||||||||||||||||||||}
  388. {                                         }
  389. {     I n p u t O B J   M E T H O D S     }
  390. {                                         }
  391. {|||||||||||||||||||||||||||||||||||||||||}
  392. constructor InputOBJ.Init;
  393. {}
  394. begin
  395.    SetDefaults;
  396. end; {InputlOBJ.Init}
  397.  
  398. procedure InputOBJ.SetDefaults;
  399. {}
  400. begin
  401.    if Monitor^.ColorOn then {color System}
  402.    begin
  403.       SetColLabel(78,76,79,76);
  404.       SetColButton(32,46,47,46);
  405.       SetColGroup(48,62,63,62);
  406.       SetColList(48,62,31,30);
  407.       SetColField(48,31,23,71);
  408.    end
  409.    else
  410.    begin
  411.       SetColLabel(7,15,15,15);
  412.       SetColButton(7,15,15,15);
  413.       SetColGroup(7,15,15,15);
  414.       SetColList(7,15,15,15);
  415.       SetColField(7,15,15,15);
  416.    end;
  417.    SetColMsg(0);
  418.    vInputPad := chr(250);
  419.    vCase := Leave;
  420.    vForceCase := false;
  421.    vInputJust :=  JustLeft;
  422.    vCursorLoc := CursPrev;
  423.    vInsert := false;
  424.    vRules :=  AllowNull;
  425. end; {InputOBJ.SetDefaults}
  426.  
  427. procedure InputOBJ.SetColLabel(Off,OffHot,On,OnHot: byte);
  428. {}
  429. begin
  430.    vLabel[1] := Off;
  431.    vLabel[2] := OffHot;
  432.    vLabel[3] := On;
  433.    vLabel[4] := OnHot;
  434. end; {InputOBJ.SetColLabel}
  435.  
  436. procedure InputOBJ.SetColButton(Off,OffHot,On,OnHot: byte);
  437. {}
  438. begin
  439.    vButton[1] := Off;
  440.    vButton[2] := OffHot;
  441.    vButton[3] := On;
  442.    vButton[4] := OnHot;
  443. end; {InputOBJ.SetColButton}
  444.  
  445. procedure InputOBJ.SetColGroup(Off,OffHot,On,OnHot: byte);
  446. {}
  447. begin
  448.    vGroup[1] := Off;
  449.    vGroup[2] := OffHot;
  450.    vGroup[3] := On;
  451.    vGroup[4] := OnHot;
  452. end; {InputOBJ.SetColGroup}
  453.  
  454. procedure InputOBJ.SetColList(Off,OffHot,On,OnHot: byte);
  455. {}
  456. begin
  457.    vList[1] := Off;
  458.    vList[2] := OffHot;
  459.    vList[3] := On;
  460.    vList[4] := OnHot;
  461. end; {InputOBJ.SetColList}
  462.  
  463. procedure InputOBJ.SetColField(Off,On,Mask,Inactive: byte);
  464. {}
  465. begin
  466.    vField[1] := Off;
  467.    vField[2] := On;
  468.    vField[3] := Mask;
  469.    vField[4] := InActive;
  470. end; {InputOBJ.SetColField}
  471.  
  472. procedure InputOBJ.SetColMsg(Col:byte);
  473. {}
  474. begin
  475.    vMessage := Col;
  476. end; {InputOBJ.SetColMsg}
  477.  
  478. function InputOBJ.LabelCol(Element:byte): byte;
  479. {}
  480. begin
  481.    LabelCol := vLabel[Element];
  482. end; {InputOBJ.LabelCol}
  483.  
  484. function InputOBJ.ButtonCol(Element:byte): byte;
  485. {}
  486. begin
  487.    ButtonCol := vButton[Element];
  488. end; {InputOBJ.ButtonCol}
  489.  
  490. function InputOBJ.GroupCol(Element:byte): byte;
  491. {}
  492. begin
  493.    GroupCol := vGroup[Element];
  494. end; {InputOBJ.GroupCol}
  495.  
  496. function InputOBJ.ListCol(Element:byte): byte;
  497. {}
  498. begin
  499.    ListCol := vList[Element];
  500. end; {InputOBJ.ListCol}
  501.  
  502. function InputOBJ.FieldCol(Element:byte): byte;
  503. {}
  504. begin
  505.    FieldCol := vField[Element];
  506. end; {InputOBJ.FieldCol}
  507.  
  508. function InputOBJ.MessageCol: byte;
  509. {}
  510. begin
  511.    MessageCol := vMessage;
  512. end; {InputOBJ.MessageCol}
  513.  
  514. procedure InputOBJ.SetIns(InsOn:boolean);
  515. {}
  516. begin
  517.    vInsert := InsOn;
  518. end; {InputOBJ.SetIns}
  519.  
  520. procedure InputOBJ.SetRules(Rules:byte);
  521. {}
  522. begin
  523.    vRules := Rules;
  524. end; {SetRules}
  525.  
  526. procedure InputOBJ.SetPadChar(Pad:char);
  527. {}
  528. begin
  529.    vInputPad := Pad;
  530. end; {InputOBJ.SetPadChar}
  531.  
  532. procedure InputOBJ.SetCursor(Curs:tCursPos);
  533. {}
  534. begin
  535.    vCursorLoc := Curs;
  536. end; {InputOBJ.SetCurs}
  537.  
  538. procedure InputOBJ.SetJust(Just:tJust);
  539. {}
  540. begin
  541.    vInputJust := Just;
  542. end; {InputOBJ.SetJust}
  543.  
  544. procedure InputOBJ.SetCase(Cas:tCase);
  545. {}
  546. begin
  547.    vCase := Cas;
  548. end; {InputOBJ.SetCase}
  549.  
  550. procedure InputOBJ.SetForceCase(On:boolean);
  551. {}
  552. begin
  553.    vForceCase := On;
  554. end; {InputOBJ.SetForceCase}
  555.  
  556. function InputOBJ.InputPad: char;
  557. {}
  558. begin
  559.    InputPad := vInputPad;
  560. end; {of func InputOBJ.InputPad}
  561.  
  562. function InputOBJ.InputIns:boolean;
  563. {}
  564. begin
  565.    InputIns := vInsert;
  566. end; {InputOBJ.InputIns}
  567.  
  568. function InputOBJ.InputRules:byte;
  569. {}
  570. begin
  571.    InputRules := vRules;
  572. end; {InputOBJ.InputRules}
  573.  
  574. function InputOBJ.InputPadChar:char;
  575. {}
  576. begin
  577.    InputPadChar := vInputPad;
  578. end; {InputOBJ.InputPadChar}
  579.  
  580. function InputOBJ.InputJust:tJust;
  581. {}
  582. begin
  583.    InputJust := vInputJust;
  584. end; {InputOBJ.InputJust}
  585.  
  586. function InputOBJ.InputCursorLoc:tCursPos;
  587. {}
  588. begin
  589.    InputCursorLoc := vCursorLoc;
  590. end; {InputOBJ.InputCursorLoc}
  591.  
  592. function InputOBJ.InputCase:tCase;
  593. {}
  594. begin
  595.    InputCase := vCase;
  596. end; {InputOBJ.InputCase}
  597.  
  598. function InputOBJ.InputForceCase:boolean;
  599. {}
  600. begin
  601.    InputForceCase := vForceCase;
  602. end; {InputOBJ.InputForceCase}
  603.  
  604. destructor InputOBJ.Done;
  605. begin end;
  606. {||||||||||||||||||||||||||||||||||||||}
  607. {                                      }
  608. {     I t e m O B J   M E T H O D S    }
  609. {                                      }
  610. {||||||||||||||||||||||||||||||||||||||}
  611. constructor ItemIOOBJ.Init;
  612. {}
  613. begin
  614.    vActive := false;
  615.    vHotKey := 0;
  616.    vID := 0;
  617.    vBoundary.X1 := 0;
  618.    vBoundary.Y1 := 0;
  619.    vBoundary.X2 := 0;
  620.    vBoundary.Y2 := 0;
  621. end; {cons ItemIOOBJ.Init}
  622.  
  623. procedure ItemIOOBJ.SetActiveStatus(Selectable:boolean);
  624. {}
  625. begin
  626.    vActive := Selectable;
  627. end; {ItemIOOBJ.SetActiveStatus}
  628.  
  629. procedure ItemIOOBJ.SetHotkey(HK:word);
  630. {}
  631. begin
  632.     vHotKey := HK;
  633. end; {ItemIOOBJ.SetHotkey}
  634.  
  635. function ItemIOOBJ.GetHotKey:word;
  636. {}
  637. begin
  638.    GetHotKey := vHotkey;
  639. end; {ItemIOOBJ.GetHotKey}
  640.  
  641. procedure ItemIOOBJ.SetID(ID:word);
  642. {}
  643. begin
  644.     vID := ID;
  645. end; {ItemIOOBJ.SetID}
  646.  
  647. function ItemIOOBJ.GetID:word;
  648. {}
  649. begin
  650.    GetID := vID;
  651. end; {ItemIOOBJ.GetID}
  652.  
  653. function ItemIOOBJ.Visible: boolean;
  654. {}
  655. begin
  656.    Visible := false;
  657. end; {ItemIOOBJ.Visible}
  658.  
  659. function ItemIOOBJ.Active:boolean;
  660. {}
  661. begin
  662.    Active := vActive;
  663. end; {ItemIOOBJ.Active}
  664.  
  665. function ItemIOOBJ.IsHotKey(HK:word):boolean;
  666. {}
  667. begin
  668.    IsHotKey := (HK = vHotKey);
  669. end; {ItemIOOBJ.IsHotKey}
  670.  
  671. function ItemIOOBJ.OnTarget(X,Y: byte):boolean;
  672. {}
  673. begin
  674.    Ontarget :=     (X >= vBoundary.X1)
  675.                and (X <= vBoundary.X2)
  676.                and (Y >= vBoundary.Y1)
  677.                and (Y <= vBoundary.Y2)
  678.                and vActive;
  679. end; {ItemIOOBJ.HotKey}
  680.  
  681. function ItemIOOBJ.Select(K:word; X,Y:byte):tAction;
  682. {}
  683. begin
  684.    Select := None;
  685. end;
  686.  
  687. function ItemIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  688. {}
  689. begin
  690.    ProcessKey := None;
  691. end;
  692.  
  693. procedure ItemIOOBJ.WriteLabel(Status:tStatus);
  694. {}
  695. begin end;
  696.  
  697. procedure ItemIOOBJ.Display(Status:tStatus);
  698. {}
  699. begin end;
  700.  
  701. function ItemIOOBJ.Suspend;
  702. {}
  703. begin
  704.    Display(Norm);
  705.    Suspend := true;
  706. end; {ItemIOOBJ.Suspend}
  707.  
  708. procedure ItemIOOBJ.RaiseSignal(var TheSig:tSignal);
  709. {abstract}
  710. begin end;
  711.  
  712. procedure ItemIOOBJ.HandleSignal(var BaseSig:tSignal; var NewSig:tSignal);
  713. {abstract}
  714. begin end;
  715.  
  716. procedure ItemIOOBJ.ShutDownSignal(var BaseSig:tSignal);
  717. {abstract}
  718. begin end;
  719.  
  720. destructor ItemIOOBJ.Done;
  721. {}
  722. begin end;
  723.  
  724. {||||||||||||||||||||||||||||||||||||||||||}
  725. {                                          }
  726. {     H o t k e y O B J   M E T H O D S    }
  727. {                                          }
  728. {||||||||||||||||||||||||||||||||||||||||||}
  729.  
  730. constructor HotkeyIOOBJ.Init(HK:word; Act:tAction);
  731. {}
  732. begin
  733.    ItemIOOBJ.Init;
  734.    vBoundary.X1 := -128;
  735.    vBoundary.X2 := -128;
  736.    vBoundary.Y1 := -128;
  737.    vBoundary.Y2 := -128;
  738.    vActionCode := Act;
  739.    vHotKey := HK;
  740. end; {cons HotkeyIOOBJ.Init}
  741.  
  742. function HotkeyIOOBJ.Select(K:word; X,Y:byte):tAction;
  743. {}
  744. begin
  745.    Select := vActionCode;
  746. end; {HotkeyIOOBJ.Select}
  747.  
  748. function HotkeyIOOBJ.IsHotKey(HK:word):boolean;
  749. {}
  750. begin
  751.    if HK = vHotKey then
  752.    begin
  753.       EscapingForm := (vActionCode = Escaped);
  754.       FormHelpCalled := (vActionCode = Help);
  755.       IsHotkey := true
  756.    end
  757.    else
  758.      IsHotKey := false;
  759. end; {HotkeyIOOBJ.IsHotKey}
  760.  
  761. destructor HotkeyIOOBJ.Done;
  762. {}
  763. begin
  764.    ItemIOOBJ.Done;
  765. end; {dest HotkeyIOOBJ.Done}
  766. {||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  767. {                                                        }
  768. {     C o n t r o l K e y s I O O B J   M E T H O D S    }
  769. {                                                        }
  770. {||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  771. constructor ControlKeysIOOBJ.Init;
  772. {}
  773. begin
  774.    ItemIOOBJ.Init;
  775.    vFinKey:= 324;
  776.    vNexkey:= 9;
  777.    vPreKey:= 271;
  778.    vEscKey:= 27;
  779. end; {ControlKeysIOOBJ.Init}
  780.  
  781. procedure ControlKeysIOOBJ.SetKeys(Next,Prev,Fin,Esc:Word);
  782. {}
  783. begin
  784.    vFinKey:= Fin;
  785.    vNexkey:= Next;
  786.    vPreKey:= Prev;
  787.    vEscKey:= Esc;
  788. end; {ControlKeysIOOBJ.SetKeys}
  789.  
  790. function ControlKeysIOOBJ.IsHotkey(HK:word):boolean;       
  791. {}
  792. begin
  793.    if (Hk=vEscKey) then
  794.       EscapingForm := true;
  795.    IsHotKey := (   (HK=vFinKey)
  796.                 or (HK=vNexKey)
  797.                 or (HK=vPreKey)
  798.                 or (Hk=vEscKey)
  799.                );
  800. end; {ControlKeysIOOBJ.IsHotkey}
  801.  
  802. function ControlKeysIOOBJ.Select(K:word; X,Y:byte):tAction;
  803. {}
  804. begin
  805.    if AlphabetTOT^.IsLower(K) then
  806.       K := ord(AlphabetTOT^.GetUpcase(chr(K)));
  807.    if (K = vFinKey) then
  808.       Select := Finished
  809.    else if (K = vNexkey) then
  810.       Select := NextField
  811.    else if (K = vPreKey) then
  812.       Select := PrevField
  813.    else if (K = vEscKey) then
  814.       Select := Escaped
  815.    else
  816.       Select := None;
  817. end; {ControlKeysIOOBJ.Select}
  818.  
  819. destructor ControlKeysIOOBJ.Done;                            
  820. {}
  821. begin
  822.    ItemIOOBJ.Done;
  823. end; {ControlKeysIOOBJ.Done}
  824. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  825. {                                                      }
  826. {     V i s i b l e F i e l d O B J   M E T H O D S    }
  827. {                                                      }
  828. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  829. constructor VisibleIOOBJ.Init;
  830. {}
  831. begin
  832.   ItemIOOBJ.Init;
  833.   vActive := true;
  834.   vLblPtr := nil;
  835.   vMsgPtr := nil;
  836. end; {VisibleIOOBJ.Init}
  837.  
  838. function VisibleIOOBJ.Visible: boolean;
  839. {}
  840. begin
  841.    Visible := true;
  842. end; {VisibleIOOBJ.Visible}
  843.  
  844. procedure VisibleIOOBJ.SetLabel(Lbl:string);
  845. {}
  846. var L : word;
  847. begin
  848.    L := succ(length(Lbl));
  849.    if MaxAvail >= L then
  850.    begin
  851.       getmem(vLblPtr,L);
  852.       move(Lbl[0],vLblPtr^,L);
  853.    end;
  854. end; {VisibleIOOBJ.SetLabel}
  855.  
  856. function VisibleIOOBJ.OnTarget(X,Y: byte):boolean;
  857. {}
  858. var LabelLen: byte;
  859. begin
  860.    if vLblPtr = nil then
  861.       LabelLen := 0
  862.    else
  863.    begin
  864.       move(vLblPtr^,LabelLen,1);
  865.       if LabelLen > 1 then
  866.          inc(LabelLen);
  867.    end;
  868.    OnTarget :=     (X >= vBoundary.X1 - LabelLen)
  869.                and (X <= vBoundary.X2)
  870.                and (Y >= vBoundary.Y1)
  871.                and (Y <= vBoundary.Y2)
  872.                and vActive;
  873. end; {VisibleIOOBJ.OnTarget}
  874.  
  875. procedure VisibleIOOBJ.SetMessage(X,Y:byte; Msg:string);
  876. {}
  877. var L : word;
  878. begin
  879.    L := succ(length(Msg));
  880.    if MaxAvail >= L then
  881.    begin
  882.       getmem(vMsgPtr,L);
  883.       move(Msg[0],vMsgPtr^,L);
  884.       vMsgX := X;
  885.       vMsgY := Y;
  886.    end;
  887. end; {VisibleIOOBJ.SetMessage}
  888.  
  889. procedure VisibleIOOBJ.WriteLabel(Status:tStatus);
  890. {}
  891. var
  892.   Temp: string;
  893.   Norm,Hi,L: byte;
  894. begin
  895.    if vLblPtr <> nil then
  896.    begin
  897.       move(vLblPtr^,L,1);
  898.       if L > 0 then
  899.       begin
  900.          move(vLblPtr^,Temp,succ(L));
  901.          AssignColors(IOTOT^.vLabel,IOTOT^.vField,Status,Hi,Norm);
  902.          if (Hi = 0) or (Norm = 0) then
  903.             Screen.WritePlain(pred(vBoundary.X1) - length(Temp),vBoundary.Y1,Temp)
  904.          else
  905.             Screen.WriteHi(pred(vBoundary.X1)-length(strip('A',Screen.Himarker,Temp)),vBoundary.Y1,Hi,Norm,Temp);
  906.       end;
  907.    end;
  908. end; {VisibleIOOBJ.WriteLabel}
  909.  
  910. procedure VisibleIOOBJ.WriteMessage;
  911. {}
  912. var
  913.   Temp: string;
  914.   Col,L: byte;
  915. begin
  916.    if vMsgPtr <> nil then
  917.    begin
  918.       move(vMsgPtr^,L,1);
  919.       if L > 0 then
  920.       begin
  921.          move(vMsgPtr^,Temp,succ(L));
  922.          Col := IOTOT^.MessageCol;
  923.          if Col = 0 then
  924.             Screen.WritePlain(vMsgX,vMsgY,Temp)
  925.          else
  926.             Screen.WriteAt(vMsgX,vMsgY,Col,Temp);
  927.       end;
  928.    end;
  929. end; {VisibleIOOBJ.WriteMessage}
  930.  
  931. function VisibleIOOBJ.Suspend:boolean;
  932. {}
  933. var Col,L: byte;
  934. begin
  935.    Display(Norm);
  936.    WriteLabel(Norm);
  937.    if vMsgPtr <> Nil then   {clear the message}
  938.    begin
  939.       move(vMsgPtr^,L,1);
  940.       if L > 0 then
  941.       begin
  942.          Col := IOTOT^.MessageCol;
  943.          if Col = 0 then
  944.             Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
  945.          else
  946.             Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
  947.  
  948.       end;
  949.    end;
  950.    Suspend := true;
  951. end; {VisibleIOOBJ.Suspend}
  952.  
  953. destructor VisibleIOOBJ.Done;
  954. {}
  955. var Len : byte;
  956. begin
  957.    ItemIOOBJ.Done;
  958.    if vLblPtr <> Nil then
  959.    begin
  960.       Move(vLblPtr^,Len,1);
  961.       FreeMem(vLblPtr,Len);
  962.    end;
  963.    if vMsgPtr <> Nil then
  964.    begin
  965.       Move(vMsgPtr^,Len,1);
  966.       FreeMem(vMsgPtr,Len);
  967.    end;
  968. end; {desc VisibleIOOBJ.Done}
  969.  
  970. {||||||||||||||||||||||||||||||||||||||||}
  971. {                                        }
  972. {     S t r i p O B J   M E T H O D S    }
  973. {                                        }
  974. {||||||||||||||||||||||||||||||||||||||||}
  975.  
  976. constructor StripIOOBJ.Init(X1,Y1:byte;Tit:string;Act:tAction);
  977. {}
  978. begin
  979.    VisibleIOOBJ.Init;
  980.    vBoundary.X1 := X1;
  981.    vBoundary.Y1 := Y1;
  982.    vBoundary.X2 := X1 + pred(length(Strip('A','~',Tit)));
  983.    vBoundary.Y2 := Y1;
  984.    vTitle := Tit;
  985.    vActionCode := Act;
  986. end; {StripIOOBJ.Init}
  987.  
  988. function StripIOOBJ.IsHotKey(HK:word):boolean;
  989. {}
  990. begin
  991.    IsHotKey := (HK = vHotKey);
  992.    if HK = vHotKey then
  993.    begin
  994.       EscapingForm := (vActionCode = Escaped);
  995.       FormHelpCalled := (vActionCode = Help);
  996.    end;
  997. end; {StripIOOBJ.IsHotKey}
  998.  
  999. function StripIOOBJ.OnTarget(X,Y: byte):boolean;
  1000. {}
  1001. Var BullsEye: boolean;
  1002. begin
  1003.    BullsEye := VisibleIOOBJ.OnTarget(X,Y);
  1004.    if BullsEye then
  1005.    begin
  1006.       EscapingForm := (vActionCode = Escaped);
  1007.       FormHelpCalled := (vActionCode = Help);
  1008.    end;
  1009.    OnTarget := BullsEye;
  1010. end; {ItemIOOBJ.HotKey}
  1011.  
  1012. procedure StripIOOBJ.Display(Status:tStatus);
  1013. {}
  1014. var
  1015.    Nor,High: Byte;
  1016. begin
  1017.    AssignColors(IOTOT^.vButton,IOTOT^.vField,Status,High,Nor);
  1018.    with vBoundary do
  1019.    begin
  1020.       Screen.WriteHi(X1,Y1,High,Nor,vTitle);
  1021.       if Status = HiStatus then
  1022.          GotoXY(X1 + (X2-X1) div 2,Y1 + (Y2 - Y1) div 2);
  1023.    end;
  1024. end; {StripIOOBJ.Display}
  1025.  
  1026. function StripIOOBJ.Select(K:word; X,Y:byte):tAction;      
  1027. {}
  1028. begin
  1029.    Display(HiStatus);
  1030.    WriteMessage;
  1031.    if AlphabetTOT^.IsLower(K) then
  1032.       K := ord(AlphabetTOT^.GetUpcase(chr(K)));
  1033.    if ((K <> 0) and (K = vHotKey)) or (K = 513) then
  1034.       Select := vActionCode
  1035.    else
  1036.       Select := none;
  1037. end; {StripIOOBJ.Select}
  1038.  
  1039. function StripIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  1040. {}
  1041. begin
  1042.    if (InKey = 13) or (InKey = 513) then
  1043.       ProcessKey := vActionCode
  1044.    else
  1045.       Processkey := None;
  1046. end; {StripIOOBJ.ProcessKey}
  1047.  
  1048. destructor StripIOOBJ.Done;
  1049. {}
  1050. begin
  1051.    VisibleIOOBJ.Done;
  1052. end; {StripIOOBJ.Done}
  1053. {||||||||||||||||||||||||||||||||||||||||||||}
  1054. {                                            }
  1055. {     S t r i p 3 d O B J   M E T H O D S    }
  1056. {                                            }
  1057. {||||||||||||||||||||||||||||||||||||||||||||}
  1058. constructor Strip3dIOOBJ.Init(X1,Y1:byte;Tit:string;Act:tAction);
  1059. {}
  1060. begin
  1061.    StripIOOBJ.Init(X1,Y1,Tit,Act);
  1062. end; {Strip3dIOOBJ.Init}
  1063.  
  1064. procedure Strip3dIOOBJ.Display(Status:tStatus);
  1065. {}
  1066. var High,Nor,A: byte;
  1067. begin
  1068.    StripIOOBJ.Display(Status);
  1069.    A := Screen.ReadAttr(succ(vBoundary.X1),succ(vBoundary.Y1));
  1070.    if Monitor^.ColorOn then {color System}
  1071.       A := Cattr(black,battr(A))
  1072.    else
  1073.       A := Cattr(darkgray,battr(A));
  1074.    Screen.WriteAT(succ(vBoundary.X1),succ(vBoundary.Y1),A,
  1075.                   replicate(succ(vBoundary.X2-vBoundary.X1),char(223)));
  1076.    Screen.WriteAT(succ(vBoundary.X2),vBoundary.Y1,A,char(220));
  1077. end; {Strip3dIOOBJ.Display}
  1078.  
  1079. destructor Strip3dIOOBJ.Done;
  1080. {}
  1081. begin
  1082.    StripIOOBJ.Done;
  1083. end; {desc Strip3dIOOBJ.Done}
  1084.  
  1085. {||||||||||||||||||||||||||||||||||||||||||}
  1086. {                                          }
  1087. {     B u t t o n O B J   M E T H O D S    }
  1088. {                                          }
  1089. {||||||||||||||||||||||||||||||||||||||||||}
  1090.  
  1091. constructor ButtonIOOBJ.Init(X1,Y1:byte;Tit:string;Act:tAction);
  1092. {}
  1093. var L : byte;
  1094. begin
  1095.    StripIOOBJ.Init(X1,Y1,Tit,Act);
  1096.    L := length(Strip('A','~',Tit));
  1097.    vBoundary.X2 := succ(X1 + L);
  1098.    vBoundary.Y2 := Y1 + 2;
  1099. end; {ButtonIOOBJ.Init}
  1100.  
  1101. procedure ButtonIOOBJ.Display(Status:tStatus);
  1102. {}
  1103. var
  1104.    High,Nor,Style: Byte;
  1105. begin
  1106.    AssignColors(IOTOT^.vButton,IOTOT^.vField,Status,High,Nor);
  1107.    if Status = HiStatus then
  1108.       Style := 5
  1109.    else
  1110.       Style := 1;
  1111.    with vBoundary do
  1112.    begin
  1113.       Screen.FillBox(X1,Y1,X2,Y2,Nor,Style);
  1114.       Screen.WriteHi(succ(X1),succ(Y1),High,Nor,vTitle);
  1115.       if Status = HiStatus then
  1116.          GotoXY(X1 + (X2-X1) div 2,Y1 + (Y2 - Y1) div 2);
  1117.    end;
  1118. end; {ButtonIOOBJ.Display}
  1119.  
  1120. destructor ButtonIOOBJ.Done;
  1121. {}
  1122. begin
  1123.    StripIOOBJ.Done;
  1124. end; {desc ButtonIOOBJ.Done}
  1125.  
  1126. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1127. {                                                }
  1128. {     M u l t i L i n e O B J   M E T H O D S    }
  1129. {                                                }
  1130. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1131.  
  1132. constructor MultiLineIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1133. {}
  1134. begin
  1135.    VisibleIOOBJ.Init;
  1136.    vTitle:= Title;
  1137.    vBoundary.X1 := X1;
  1138.    vBoundary.Y1 := Y1;
  1139.    vBoundary.X2 := pred(X1+width);
  1140.    vBoundary.Y2 := pred(Y1+depth);
  1141.    SetBoxOn(False);
  1142. end; {MultiLineIOOBJ.Init}
  1143.  
  1144. procedure MultiLineIOOBJ.SetBoxOn(On:boolean);
  1145. {}
  1146. begin
  1147.    if On then
  1148.    begin
  1149.       vBorder.X1 := succ(vBoundary.X1);
  1150.       vBorder.X2 := pred(vBoundary.X2);
  1151.       if vTitle = '' then
  1152.          vBorder.Y1 := succ(vBoundary.Y1)
  1153.       else
  1154.          vBorder.Y1 := (vBoundary.Y1+2);
  1155.       vBorder.Y2 := pred(vBoundary.Y2);
  1156.    end
  1157.    else
  1158.    begin
  1159.       vBorder.X1 := vBoundary.X1;
  1160.       vBorder.X2 := vBoundary.X2;
  1161.       if vTitle = '' then
  1162.          vBorder.Y1 := vBoundary.Y1
  1163.       else
  1164.          vBorder.Y1 := succ(vBoundary.Y1);
  1165.       vBorder.Y2 := vBoundary.Y2;
  1166.    end;
  1167.    vRows := vBorder.Y2 - pred(vBorder.Y1);
  1168. end; {MultiLineIOOBJ.SetBoxOn}
  1169.  
  1170. procedure MultiLineIOOBJ.Display(Status:tStatus);
  1171. {}
  1172. var
  1173.   High,Nor: byte;
  1174.   Style: byte;
  1175.   I : integer;
  1176. begin
  1177.    AssignColors(IOTOT^.vLabel,IOTOT^.vField,Status,High,Nor);
  1178.    if Status = HiStatus then
  1179.       Style := 2
  1180.    else
  1181.       Style := 1;
  1182.    with Screen do
  1183.    begin
  1184.       if vTitle <> '' then
  1185.          WriteHi(vBoundary.X1,vBoundary.Y1,High,Nor,vTitle);
  1186.       if vBoundary.X1 < vBorder.X1 then  {box}
  1187.          with vBorder do
  1188.             Box(pred(X1),pred(Y1),succ(X2),succ(Y2),Nor,Style);
  1189.    end;
  1190. end; {MultiLineIOOBJ.Display}
  1191.  
  1192. procedure MultiLineIOOBJ.Activate;
  1193. {}
  1194. var
  1195.    Action: tAction;
  1196. begin
  1197.    repeat
  1198.       Action := Select(0,0,0);
  1199.       Display(HiStatus);
  1200.       WriteLabel(HiStatus);
  1201.       with Key do 
  1202.       repeat
  1203.          GetInput;
  1204.          if LastKey = 27 then
  1205.             Action := Escaped
  1206.          else
  1207.             Action := ProcessKey(LastKey,LastX,LastY);
  1208.       until Action in [Finished,Escaped,Enter,NextField,PrevField,Stop1..Stop9];
  1209.    until Suspend;
  1210. end; {MultiLineIOOBJ.Activate}
  1211.  
  1212. destructor MultiLineIOOBJ.Done;
  1213. {}
  1214. begin
  1215.    VisibleIOOBJ.Done;
  1216. end; {MultiLineIOOBJ.Done}
  1217. {||||||||||||||||||||||||||||||||||||||||}
  1218. {                                        }
  1219. {     G r o u p O B J   M E T H O D S    }
  1220. {                                        }
  1221. {||||||||||||||||||||||||||||||||||||||||}
  1222. constructor GroupIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1223. {}
  1224. begin
  1225.    MultiLineIOOBJ.Init(X1,Y1,width,depth,Title);
  1226.    vItemStack := nil;
  1227.    vActiveItem := 0;
  1228.    vTotalItems := 0;
  1229.    vSubHotkeysActive := false;
  1230. end; {GroupIOOBJ.Init}
  1231.  
  1232. procedure GroupIOOBJ.SetSubHotkeysActive(On:boolean);
  1233. {}
  1234. begin
  1235.    vSubHotkeysActive := On;
  1236. end; {GroupIOOBJ.SetSubHotkeysActive}
  1237.  
  1238. procedure GroupIOOBJ.WriteItem(Item:byte; IsActive:boolean);
  1239. {}
  1240. var
  1241.   Temp: GroupItemPtr;
  1242.   High,Nor:byte;
  1243.   Status: tStatus;
  1244.   Len : byte;
  1245.   Str : string;
  1246. begin
  1247.    if IsActive then
  1248.       Status := HiStatus
  1249.    else
  1250.       Status := Norm;
  1251.    AssignColors(IOTOT^.vGroup,IOTOT^.vField,Status,High,Nor);
  1252.    Temp := NodePtr(Item);
  1253.    if (Temp = nil) or (Temp^.StrPtr = nil) then
  1254.       exit
  1255.    else
  1256.    begin
  1257.       move(Temp^.StrPtr^,Len,1);
  1258.       if Len > 0 then
  1259.          move(Temp^.StrPtr^,Str,succ(Len))
  1260.       else
  1261.          Str := '';
  1262.       if Temp^.Selected then
  1263.          Str := vOnStr+' '+Str
  1264.       else
  1265.          Str := vOffStr+' '+Str;
  1266.       Str := Padleft(Str,vBorder.X2 
  1267.                         - pred(vBorder.X1) 
  1268.                         + length(Str) 
  1269.                         - length(strip('A',Screen.HiMarker,Str)),
  1270.                         ' ');
  1271.       Screen.WriteHi(vBorder.X1,vBorder.Y1+pred(Item),High,Nor,Str);
  1272.       if IsActive then
  1273.          Screen.GotoXY(succ(vBorder.X1),vBorder.Y1+pred(Item));
  1274.    end;
  1275. end; {GroupIOOBJ.WriteItem}
  1276.  
  1277. procedure GroupIOOBJ.Display(Status:tStatus);
  1278. {}
  1279. var
  1280.   BorderCol : byte;
  1281.   Style: byte;
  1282.   I : integer;
  1283. begin
  1284.    MultiLineIOOBJ.Display(Status);
  1285.    for I := 1 to vTotalItems do
  1286.       WriteItem(I,((I=vActiveItem) and (Status=HiStatus)));
  1287. end; {GroupIOOBJ.Display}
  1288.  
  1289. function GroupIOOBJ.Select(K:word; X,Y:byte):tAction;
  1290. {}
  1291. begin
  1292.    Display(HiStatus);
  1293.    Select := none;
  1294. end; {StripIOOBJ.Select}
  1295.  
  1296. function GroupIOOBJ.HotKeyItem(HK:word): integer;
  1297. {}
  1298. var 
  1299.    Counter:integer;
  1300.    Temp: GroupItemPtr;
  1301.    Found : boolean;
  1302. begin
  1303.    if vSubHotkeysActive then
  1304.    begin
  1305.       if AlphabetTOT^.IsLower(HK) then
  1306.          HK := ord(AlphabetTOT^.GetUpcase(chr(HK)));
  1307.       Found := false;
  1308.       Counter := 1;
  1309.       Temp := vItemStack;
  1310.       while (Temp <> nil) and (Found = false) do
  1311.       begin
  1312.          Found := (Temp^.HK = HK);
  1313.          if not Found then
  1314.          begin
  1315.             inc(Counter);
  1316.             Temp := Temp^.NextNode;
  1317.          end;
  1318.       end;
  1319.       if Found then
  1320.          HotKeyItem := Counter
  1321.       else
  1322.          HotKeyItem := 0;
  1323.    end
  1324.    else
  1325.      HotkeyItem := 0;
  1326. end; {GroupIOOBJ.HotKeyItem}
  1327.  
  1328. function GroupIOOBJ.IsHotkey(HK:word):boolean;
  1329. {}
  1330. var
  1331.   Found : boolean;
  1332.   Temp: GroupItemPtr;
  1333. begin
  1334.    Found := (HK = vHotkey);
  1335.    if (Found = false) then
  1336.       Found := (HotKeyItem(HK) > 0);
  1337.    IsHotkey := found;   
  1338. end;  {GroupIOOBJ.IsHotkey}
  1339.  
  1340. function GroupIOOBJ.EndNode: GroupItemPtr;
  1341. {returns a pointer to the last item in the list}
  1342. var
  1343.    Temp : GroupItemPtr;
  1344. begin
  1345.    Temp := vItemStack;
  1346.    while (Temp <> nil) and (Temp^.NextNode <> nil) do
  1347.       Temp := Temp^.NextNode;
  1348.    EndNode := Temp;
  1349. end; {GroupIOOBJ.EndNode}
  1350.  
  1351. procedure GroupIOOBJ.AddItem(Str:string;HK:word;Selected:boolean);
  1352. {}
  1353. var Temp: GroupItemPtr;
  1354. begin
  1355.    if MaxAvail < SizeOf(vItemStack^) + succ(Length(Str)) then
  1356.       exit
  1357.    else
  1358.    begin
  1359.       if vItemStack = Nil then
  1360.       begin
  1361.          getmem(vItemStack,sizeof(vItemStack^));
  1362.          vActiveItem := 1;
  1363.          vItemStack^.PrevNode := Nil;
  1364.          Temp := vItemStack;
  1365.       end
  1366.       else
  1367.       begin
  1368.          Temp := EndNode;
  1369.          getmem(Temp^.NextNode, sizeof(Temp^));
  1370.          Temp^.NextNode^.PrevNode := Temp;
  1371.          Temp := Temp^.NextNode;
  1372.       end;
  1373.       Temp^.NextNode := nil;
  1374.       inc(vTotalItems);
  1375.       getmem(Temp^.StrPtr,succ(length(Str)));
  1376.       move(Str[0],Temp^.StrPtr^,succ(length(Str)));
  1377.       Temp^.HK := HK;
  1378.       Temp^.Selected := Selected;
  1379.       if HK <> 0 then
  1380.          vSubHotKeysActive := true;
  1381.    end;
  1382. end; {GroupIOOBJ.AddItem}
  1383.  
  1384. function GroupIOOBJ.HitItem(X,Y:byte):byte;
  1385. {returns the item number of the item falling on line Y, else returns 0}
  1386. var
  1387.   B: integer;
  1388. begin
  1389.     B := Y - pred(vBorder.Y1);
  1390.     if (B > vTotalItems) or (B < 0) or (X < vBorder.X1) or (X> vBorder.X2) then
  1391.        HitItem := 0
  1392.     else
  1393.        HitItem := B;
  1394. end; {GroupIOOBJ.HitItem}
  1395.  
  1396. function GroupIOOBJ.NodePtr(Item:byte): GroupItemPtr;
  1397. {}
  1398. var
  1399.   Temp: GroupItemPtr;
  1400.   I: integer;
  1401. begin
  1402.    Temp := vItemStack;
  1403.    if Item > 1 then
  1404.       for I := 2 to Item do
  1405.          if Temp <> Nil then
  1406.             Temp := Temp^.NextNode;
  1407.    NodePtr := Temp;
  1408. end; {GroupIOOBJ.NodePtr}
  1409.  
  1410. destructor GroupIOOBJ.Done;
  1411. {}
  1412. var 
  1413.   Temp: GroupItemPtr;
  1414.   Len: byte;
  1415. begin
  1416.    MultiLineIOOBJ.Done;
  1417.    Temp := EndNode;
  1418.    while Temp <> Nil do
  1419.    begin
  1420.       if Temp^.StrPtr <> Nil then
  1421.       begin
  1422.          Move(Temp^.StrPtr^,Len,1);
  1423.          FreeMem(Temp^.StrPtr,Len);
  1424.       end;
  1425.       if Temp^.PrevNode = nil then
  1426.       begin
  1427.          FreeMem(Temp,sizeof(temp^));
  1428.          Temp := nil;
  1429.       end
  1430.       else
  1431.       begin
  1432.          Temp := Temp^.PrevNode;
  1433.          FreeMem(Temp^.NextNode,sizeof(temp^));
  1434.       end;
  1435.    end;
  1436. end; {desc GroupIOOBJ.Done}
  1437.  
  1438. {||||||||||||||||||||||||||||||||||||||||}
  1439. {                                        }
  1440. {     C h e c k O B J   M E T H O D S    }
  1441. {                                        }
  1442. {||||||||||||||||||||||||||||||||||||||||}
  1443.  
  1444. constructor CheckIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1445. {}
  1446. begin
  1447.    GroupIOOBJ.Init(X1,Y1,width,depth,Title);
  1448.    vOnstr := '[X]';
  1449.    vOffStr := '[ ]';
  1450. end; {CheckIOOBJ.Init}
  1451.  
  1452. function CheckIOOBJ.Select(K:word; X,Y:byte):tAction;
  1453. {}
  1454. var
  1455.   Temp: GroupItemPtr;
  1456.   New: byte;
  1457. begin
  1458.    Display(HiStatus);
  1459.    WriteMessage;
  1460.    New := HotKeyItem(K);
  1461.    if New > 0 then
  1462.    begin
  1463.       if vActiveItem <> New then
  1464.          WriteItem(vActiveItem,false);
  1465.       vActiveItem := New;
  1466.       Temp := NodePtr(vActiveItem);
  1467.       vActiveItem := New;
  1468.       Temp^.Selected := Not Temp^.Selected;
  1469.       WriteItem(vActiveItem,true);
  1470.    end;
  1471.    if K = 513 then
  1472.    begin
  1473.       New := HitItem(X,Y);
  1474.       if New > 0 then
  1475.       begin
  1476.          WriteItem(vActiveItem,false);
  1477.          vActiveItem := New;
  1478.          Temp := NodePtr(vActiveItem);
  1479.          Temp^.Selected := Not Temp^.Selected;
  1480.          WriteItem(vActiveItem,true);
  1481.       end;
  1482.    end;
  1483.    Select := none;
  1484. end; {CheckIOOBJ.Select}
  1485.  
  1486. function CheckIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  1487. {}
  1488. var
  1489.   Temp: GroupItemPtr;
  1490.   New : byte;
  1491. begin
  1492.    New := HotKeyItem(InKey);
  1493.    if New > 0 then
  1494.    begin
  1495.       if New <> vActiveItem then
  1496.       begin
  1497.           WriteItem(vActiveItem,false);
  1498.           vActiveItem := New;
  1499.       end;
  1500.       Temp := NodePtr(vActiveItem);
  1501.       Temp^.Selected := Not Temp^.Selected;
  1502.       WriteItem(vActiveItem,true);
  1503.    end
  1504.    else
  1505.       case InKey of
  1506.          32:  {space bar}
  1507.          begin
  1508.             Temp := NodePtr(vActiveItem);
  1509.             Temp^.Selected := Not Temp^.Selected;
  1510.             WriteItem(vActiveItem,true);
  1511.          end;
  1512.          513: {mouse enter}
  1513.          begin
  1514.             New := HitItem(X,Y);
  1515.             if New > 0 then
  1516.             begin
  1517.                WriteItem(vActiveItem,false);
  1518.                vActiveItem := New;
  1519.                Temp := NodePtr(vActiveItem);
  1520.                Temp^.Selected := Not Temp^.Selected;
  1521.                WriteItem(vActiveItem,true);
  1522.                delay(175);
  1523.             end;
  1524.          end;
  1525.          336: {down arrow}
  1526.          begin
  1527.             WriteItem(vActiveItem,false);
  1528.             if vActiveItem < vTotalItems then
  1529.                inc(vActiveItem)
  1530.             else
  1531.                vActiveItem := 1;
  1532.             WriteItem(vActiveItem,true);
  1533.          end;
  1534.          328: {up arrow}
  1535.          begin
  1536.             WriteItem(vActiveItem,false);
  1537.             if vActiveItem > 1 then
  1538.                dec(vActiveItem)
  1539.             else
  1540.                vActiveItem := vTotalItems;
  1541.             WriteItem(vActiveItem,true);
  1542.          end;
  1543.       end; {case}
  1544.    if InKey = 13 then
  1545.       ProcessKey := NextField
  1546.    else
  1547.       ProcessKey := None;
  1548. end; {CheckIOOBJ.ProcessKey}
  1549.  
  1550. procedure CheckIOOBJ.SetValue(Item:byte;Selected:boolean);
  1551. {}
  1552. var Temp: GroupItemPtr;
  1553. begin
  1554.    Temp := NodePtr(Item);
  1555.    if Temp <> nil then
  1556.       Temp^.Selected := Selected;
  1557. end; {CheckIOOBJ.SetValue}
  1558.  
  1559. function CheckIOOBJ.GetValue(Item:byte):boolean;
  1560. {}
  1561. var
  1562.   Temp: GroupItemPtr;
  1563. begin
  1564.    Temp := NodePtr(Item);
  1565.    if Temp <> nil then
  1566.       GetValue := Temp^.Selected
  1567.    else
  1568.       GetValue := false;
  1569. end; {CheckIOOBJ.GetValue}
  1570.  
  1571. destructor CheckIOOBJ.Done;
  1572. {}
  1573. begin
  1574.    GroupIOOBJ.Done;
  1575. end; {dest CheckIOOBJ.Done}
  1576.  
  1577. {||||||||||||||||||||||||||||||||||||||||}
  1578. {                                        }
  1579. {     R a d i o O B J   M E T H O D S    }
  1580. {                                        }
  1581. {||||||||||||||||||||||||||||||||||||||||}
  1582.  
  1583. constructor RadioIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1584. {}
  1585. begin
  1586.    GroupIOOBJ.Init(X1,Y1,width,depth,Title);
  1587.    vOnstr :=  '(∙)';
  1588.    vOffStr := '( )';
  1589. end; {RadioIOOBJ.Init}
  1590.  
  1591. procedure RadioIOOBJ.SetValue(Item:byte);
  1592. {}
  1593. var I : Integer;
  1594. begin
  1595.    for I := 1 to vTotalItems do
  1596.       NodePtr(I)^.Selected := (I=Item);
  1597. end; {RadioIOOBJ.SetValue}
  1598.  
  1599. function RadioIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  1600. {}
  1601. var
  1602.   Temp: GroupItemPtr;
  1603.   I : integer;
  1604.   New: byte;
  1605. begin
  1606.    New := HotKeyItem(InKey);
  1607.    if New <> 0 then
  1608.    begin
  1609.       if New <> vActiveItem then
  1610.       begin
  1611.          vActiveItem := New;
  1612.           Temp := NodePtr(vActiveItem);
  1613.           if not Temp^.Selected then
  1614.           begin
  1615.              SetValue(vActiveItem);
  1616.              for I := 1 to vTotalItems do
  1617.                 WriteItem(I,(I=vActiveItem));
  1618.           end;
  1619.       end;
  1620.    end
  1621.    else
  1622.       case InKey of
  1623.          32:  {space bar}
  1624.          begin
  1625.             Temp := NodePtr(vActiveItem);
  1626.             if not Temp^.Selected then
  1627.             begin
  1628.                SetValue(vActiveItem);
  1629.                for I := 1 to vTotalItems do
  1630.                   WriteItem(I,(I=vActiveItem));
  1631.             end;
  1632.          end;
  1633.          513: {mouse enter}
  1634.          begin
  1635.             New := HitItem(X,Y);
  1636.             if New > 0 then
  1637.             begin
  1638.                vActiveItem := New;
  1639.                Temp := NodePtr(vActiveItem);
  1640.                if not Temp^.Selected then
  1641.                begin
  1642.                   SetValue(vActiveItem);
  1643.                   for I := 1 to vTotalItems do
  1644.                      WriteItem(I,(I=vActiveItem));
  1645.                end;
  1646.             end;
  1647.          end;
  1648.          336: {down arrow}
  1649.          begin
  1650.             WriteItem(vActiveItem,false);
  1651.             if vActiveItem < vTotalItems then
  1652.                inc(vActiveItem)
  1653.             else
  1654.                vActiveItem := 1;
  1655.             WriteItem(vActiveItem,true);
  1656.          end;
  1657.          328: {up arrow}
  1658.          begin
  1659.             WriteItem(vActiveItem,false);
  1660.             if vActiveItem > 1 then
  1661.                dec(vActiveItem)
  1662.             else
  1663.                vActiveItem := vTotalItems;
  1664.             WriteItem(vActiveItem,true);
  1665.          end;
  1666.       end; {case}
  1667.    if InKey = 13 then
  1668.       ProcessKey := NextField
  1669.    else
  1670.       ProcessKey := None;
  1671. end; {RadioIOOBJ.ProcessKey}
  1672.  
  1673. function RadioIOOBJ.Select(K:word; X,Y:byte):tAction;
  1674. {}
  1675. var
  1676.   Temp: GroupItemPtr;
  1677.   New: byte;
  1678.   I : integer;
  1679. begin
  1680.    vActiveItem := GetValue;
  1681.    Display(HiStatus);
  1682.    WriteMessage;
  1683.    I := HotKeyItem(K);
  1684.    if I > 0 then
  1685.    begin
  1686.       vActiveItem := I;
  1687.       Temp := NodePtr(vActiveItem);
  1688.       if not Temp^.Selected then
  1689.       begin
  1690.          SetValue(vActiveItem);
  1691.          for I := 1 to vTotalItems do
  1692.             WriteItem(I,(I=vActiveItem));
  1693.       end;
  1694.    end;
  1695.    if K = 513 then
  1696.    begin
  1697.       New := HitItem(X,Y);
  1698.       if New > 0 then
  1699.       begin
  1700.          vActiveItem := New;
  1701.          Temp := NodePtr(vActiveItem);
  1702.          if not Temp^.Selected then
  1703.          begin
  1704.             SetValue(vActiveItem);
  1705.             for I := 1 to vTotalItems do
  1706.                WriteItem(I,(I=vActiveItem));
  1707.          end;
  1708.       end;
  1709.    end;
  1710.    Select := none;
  1711. end; {RadioIOOBJ.Select}
  1712.  
  1713. function RadioIOOBJ.GetValue: byte;
  1714. {}
  1715. var I : integer;
  1716. begin
  1717.    I := 1;
  1718.    While (NodePtr(I)^.Selected = false) and (I < vTotalItems) do
  1719.      inc(I);
  1720.    GetValue := I;
  1721. end; {RadioIOOBJ.GetValue}
  1722.  
  1723. destructor RadioIOOBJ.Done;
  1724. {}
  1725. begin
  1726.    GroupIOOBJ.Done;
  1727. end; {dest RadioIOOBJ.Done}
  1728. {||||||||||||||||||||||||||||||||||||||||||}
  1729. {                                          }
  1730. {     A c t i o n O B J   M E T H O D S    }
  1731. {                                          }
  1732. {||||||||||||||||||||||||||||||||||||||||||}
  1733. constructor FormOBJ.Init;
  1734. {}
  1735. begin
  1736.    vItemStack := nil;
  1737.    vActiveItem := nil;
  1738.    vCharHook := NoCharHook;
  1739.    vLeaveHook := NoLeaveHook;
  1740.    vEnterHook := NoEnterHook;
  1741.    vHelpHook := NoHelpHook;
  1742. end; {cons FormOBJ.Init}
  1743.  
  1744. function FormOBJ.EndNode: pItemNode;
  1745. {returns a pointer to the last item in the last}
  1746. var
  1747.    Temp : pItemNode;
  1748. begin
  1749.    Temp := vItemStack;
  1750.    while (Temp <> nil) and (Temp^.NextNode <> nil) do
  1751.       Temp := Temp^.NextNode;
  1752.    EndNode := Temp;
  1753. end; {FormOBJ.EndNode}
  1754.  
  1755. procedure FormOBJ.AddItem(var NewItem: ItemIOOBJ);
  1756. {}
  1757. var
  1758.    Temp : pItemNode;
  1759. begin
  1760.    if vItemStack = nil then
  1761.    begin
  1762.       GetMem(vItemStack,sizeOf(vItemStack^));
  1763.       vItemStack^.Item := @NewItem;
  1764.       vItemStack^.NextNode := nil;
  1765.       vItemStack^.PrevNode := nil;
  1766.       vActiveItem := vItemStack;
  1767.    end
  1768.    else
  1769.    begin
  1770.       Temp := EndNode;
  1771.       GetMem(Temp^.NextNode,sizeof(Temp^));
  1772.       Temp^.NextNode^.PrevNode := Temp;
  1773.       Temp := Temp^.NextNode;
  1774.       Temp^.Item := @NewItem;
  1775.       Temp^.NextNode := nil;
  1776.    end;
  1777. end; {FormOBJ.AddItem}
  1778.  
  1779. procedure FormOBJ.SetCharHook(Func:CharFunc);
  1780. {}
  1781. begin
  1782.    vCharHook := Func;
  1783. end; {FormOBJ.SetCharHook}
  1784.  
  1785. procedure FormOBJ.SetLeaveHook(Func:LeaveFieldFunc);
  1786. {}
  1787. begin
  1788.    vLeaveHook := Func;
  1789. end; {FormOBJ.SetLeaveHook}
  1790.  
  1791. procedure FormOBJ.SetEnterHook(Func:EnterFieldFunc);
  1792. {}
  1793. begin
  1794.    vEnterHook := Func;
  1795. end; {FormOBJ.SetEnterHook}
  1796.  
  1797. procedure FormOBJ.SetHelpHook(Proc:HelpProc);
  1798. {}
  1799. begin
  1800.    vHelpHook := Proc;
  1801. end; {FormOBJ.SetHelpHook}
  1802.  
  1803. procedure FormOBJ.DisplayItems;
  1804. {}
  1805. var
  1806.    Temp: pItemNode;
  1807. begin
  1808.    Temp := vItemStack;
  1809.    while Temp <> Nil do
  1810.    begin
  1811.       if Temp^.Item^.Active then
  1812.       begin
  1813.          if Temp = vActiveItem then
  1814.          begin
  1815.             Temp^.Item^.Display(HiStatus);
  1816.             Temp^.Item^.WriteLabel(HiStatus);
  1817.          end
  1818.          else
  1819.          begin
  1820.             Temp^.Item^.Display(Norm);
  1821.             Temp^.Item^.WriteLabel(Norm);
  1822.          end;
  1823.       end
  1824.       else
  1825.       begin
  1826.          Temp^.Item^.Display(Off);
  1827.          Temp^.Item^.WriteLabel(Off);
  1828.       end;
  1829.       Temp := Temp^.NextNode;
  1830.    end;
  1831. end; {FormOBJ.DisplayItems}
  1832.  
  1833. function FormOBJ.IDItemPtr(ID:word):pItemNode;
  1834. {returns a pointer to the item which has the specified ID --
  1835.  if no item is found the function returns nil}
  1836. var
  1837.   Temp: pItemNode;
  1838.   proceed: boolean;
  1839. begin
  1840.    Temp := vItemStack;
  1841.    Proceed := true;
  1842.    while (Temp <> Nil) and Proceed do
  1843.    begin
  1844.       if Temp^.Item^.GetID = ID then
  1845.          Proceed := false
  1846.       else
  1847.          Temp := Temp^.NextNode;
  1848.    end;
  1849.    IDItemPtr := Temp;
  1850. end; {FormOBJ.IDItemPtr}
  1851.  
  1852. procedure FormOBJ.SetActiveItem(ID:word);
  1853. {}
  1854. begin
  1855.    vActiveItem := IDItemPtr(ID);
  1856.    if vActiveItem = nil then
  1857.       vActiveItem := vItemStack;
  1858. end; {FormOBJ.SetActiveItem}
  1859.  
  1860. function FormOBJ.HotkeyItemPtr(Hotkey:word):pItemNode;
  1861. {returns a pointer to the item which can be selected with the hotkey --
  1862.  if no item is found the function returns nil}
  1863. var
  1864.   Temp: pItemNode;
  1865.   proceed: boolean;
  1866. begin
  1867.    Temp := vItemStack;
  1868.    Proceed := true;
  1869.    if AlphabetTOT^.IsLower(HotKey) then
  1870.       HotKey := ord(AlphabetTOT^.GetUpcase(chr(HotKey)));
  1871.    while (Temp <> Nil) and Proceed do
  1872.    begin
  1873.       if Temp^.Item^.IsHotKey(Hotkey) then
  1874.          Proceed := false
  1875.       else
  1876.          Temp := Temp^.NextNode;
  1877.    end;
  1878.    HotkeyItemPtr := Temp;
  1879. end; {FormOBJ.HotkeyItemPtr}
  1880.  
  1881. function FormOBJ.HotSpotItemPtr(X,Y:byte):pItemNode;
  1882. {returns a pointer to the item which can has been clicked on with the mouse --
  1883.  if no item is found the function returns nil}
  1884. var
  1885.   Temp: pItemNode;
  1886.   proceed: boolean;
  1887. begin
  1888.    Temp := vItemStack;
  1889.    Proceed := true;
  1890.    while (Temp <> Nil) and Proceed do
  1891.    begin
  1892.       if Temp^.Item^.OnTarget(X,Y) then
  1893.          Proceed := false
  1894.       else
  1895.          Temp := Temp^.NextNode;
  1896.    end;
  1897.    HotSpotItemPtr := Temp;
  1898. end; {FormOBJ.HotSpotItemPtr}
  1899.  
  1900. procedure FormOBJ.BroadcastSignal(TheSig:tSignal; SignalSource: pItemNode);
  1901. {recursive signal passer - an item which is handling a signal may raise
  1902.  an additional signal}
  1903. var
  1904.   ItemPtr: pItemNode;
  1905.   NewSig: tSignal;
  1906. begin
  1907.    ItemPtr := SignalSource;
  1908.    repeat
  1909.       {move on to next node}
  1910.       if ItemPtr^.NextNode <> nil then
  1911.          ItemPtr := ItemPtr^.NextNode
  1912.       else
  1913.          ItemPtr := vItemStack;
  1914.       NewSig.ID := 0;  {do nothing}
  1915.       ItemPtr^.Item^.HandleSignal(TheSig,NewSig);
  1916.       if NewSig.ID <> 0 then
  1917.          BroadcastSignal(NewSig,ItemPtr);
  1918.       if TheSig.ID = 0 then
  1919.       begin
  1920.          SignalSource^.Item^.ShutdownSignal(TheSig);
  1921.          if TheSIG.ID = 0 then
  1922.             exit
  1923.          else
  1924.             BroadcastSignal(TheSig,SignalSource);
  1925.       end;
  1926.    until ItemPtr = SignalSource;
  1927.    SignalSource^.Item^.ShutdownSignal(TheSig);
  1928. end; {FormOBJ.BroadcastSignal}
  1929.  
  1930. procedure FormOBJ.HelpTask(ID:word);
  1931. {}
  1932. begin
  1933.    vHelpHook(ID);
  1934. end; {FormOBJ.HelpTask}
  1935.  
  1936. function FormOBJ.CharTask(var K:word;var X,Y:byte;var FieldID:word):tAction;             
  1937. {}
  1938. begin
  1939.    CharTask := vCharHook(K,X,Y,FieldID);
  1940. end; {FormOBJ.CharTask}
  1941.  
  1942. function FormOBJ.EnterTask(var NewID:word; OldID:word): tAction; 
  1943. {}
  1944. begin
  1945.    EnterTask := vEnterHook(NewID,OldID);
  1946. end; {FormOBJ.EnterTask}
  1947.  
  1948. function FormOBJ.LeaveTask(var FieldID:word): tAction;           
  1949. {}
  1950. begin
  1951.    LeaveTask := vLeaveHook(FieldID);
  1952. end; {FormOBJ.LeaveTask}
  1953.  
  1954. procedure FormOBJ.AdjustKey(var Key:word;var X,Y: byte);
  1955. {abstract}
  1956. begin end;
  1957.  
  1958. function FormOBJ.Go: tAction;
  1959. {}
  1960. var
  1961.    HookAction,
  1962.    Task : tAction;
  1963.    NewItemPtr: pItemNode;
  1964.    LastActiveItemID,ID,K,W: word;
  1965.    X,Y:byte;
  1966.    Mvisible:boolean;
  1967.  
  1968.    procedure ProcessTask;
  1969.    {}
  1970.    var TheSig: tSignal;
  1971.    begin
  1972.       case Task of
  1973.          NextField: begin
  1974.                        NewItemPtr := vActiveItem;
  1975.                        repeat
  1976.                           if NewItemPtr^.NextNode <> Nil then
  1977.                              NewItemPtr := NewItemPtr^.NextNode
  1978.                           else
  1979.                              NewItemPtr := vItemStack;
  1980.                         until NewItemPtr^.Item^.Active;
  1981.                     end;
  1982.          PrevField: begin
  1983.                        NewItemPtr := vActiveItem;
  1984.                        repeat
  1985.                           if NewItemPtr^.PrevNode <> Nil then
  1986.                              NewItemPtr := NewItemPtr^.PrevNode
  1987.                           else
  1988.                              NewItemPtr := EndNode;
  1989.                         until NewItemPtr^.Item^.Active;
  1990.                     end;
  1991.          Refresh: DisplayItems;
  1992.          Signal: begin
  1993.                     vActiveItem^.Item^.RaiseSignal(TheSig);
  1994.                     if TheSig.ID <> 0 then
  1995.                        BroadcastSignal(TheSig,vActiveItem);
  1996.                  end;
  1997.          Help: begin
  1998.                   HelpTask(LastActiveItemID);
  1999.                   if LastActiveItemID <> 0 then
  2000.                   begin
  2001.                      if LastActiveItemID <> HelpID then
  2002.                         if vActiveItem^.Item^.Suspend then
  2003.                            vActiveItem := IDItemPtr(LastActiveItemID);
  2004.                   end;
  2005.                   Task := vActiveItem^.Item^.Select(0,X,Y);
  2006.                end;
  2007.       end; {case}
  2008.    end; {ProcessTask}
  2009.  
  2010.    procedure ProcessChar;
  2011.    {}
  2012.    var Bypassing, Ignore : boolean;
  2013.    begin
  2014.       Key.GetInput;
  2015.       K := Key.LastKey;
  2016.       X := Key.LastX;
  2017.       Y := key.LastY;
  2018.       Ignore := false;
  2019.       AdjustKey(K,X,Y);
  2020.       if K = 600 then
  2021.          HookAction := Escaped
  2022.       else
  2023.       begin
  2024.          ID := vActiveItem^.Item^.GetID;
  2025.          HookAction := CharTask(K,X,Y,ID);
  2026.       end;
  2027.       Case HookAction of
  2028.          Escaped,
  2029.          Finished,
  2030.          Stop1..Stop9 : begin
  2031.                           Task := HookAction;
  2032.                           exit;
  2033.                         end;
  2034.          Refresh: DisplayItems;
  2035.       end; {case}
  2036.       if ID <> vActiveItem^.Item^.GetID then {hook changed the active field}
  2037.          NewItemPtr := IDItemPtr(ID)
  2038.       else
  2039.          NewItemPtr := HotKeyItemPtr(K);
  2040.       if NewItemPtr = nil then {no hotkey pressed}
  2041.       begin
  2042.          if (K = 513) or (K=523) then  {mouse Pressed}
  2043.          begin
  2044.             NewItemPtr := HotSpotItemPtr(X,Y);
  2045.             if NewItemPtr = vActiveItem then
  2046.             begin
  2047.                Task := vActiveItem^.Item^.ProcessKey(K,X,Y);
  2048.                ProcessTask;
  2049.                Ignore := true;
  2050.             end;
  2051.             if NewItemPtr = nil then
  2052.                Ignore := true;
  2053.          end
  2054.          else
  2055.          begin
  2056.             Task := vActiveItem^.Item^.ProcessKey(K,X,Y);
  2057.             ProcessTask;
  2058.          end;
  2059.       end;
  2060.       if (NewItemPtr <> Nil) and (Ignore = false) then
  2061.       begin
  2062.          ByPassing := false;
  2063.          repeat
  2064.             if EscapingForm then
  2065.             begin
  2066.                Task := Escaped;
  2067.             end
  2068.             else if FormHelpCalled then
  2069.             begin
  2070.                HelpTask(vActiveItem^.Item^.GetID);
  2071.                Task := none;
  2072.                FormHelpCalled := false;
  2073.             end
  2074.             else
  2075.             begin
  2076.                if Bypassing or vActiveItem^.Item^.Suspend then
  2077.                begin
  2078.                   {Leave Hook}
  2079.                   if (vActiveItem^.Item^.Active)
  2080.                   and (Bypassing = false) then {don't Hook if Bypassing}
  2081.                   begin
  2082.                      ID := vActiveItem^.Item^.GetID;
  2083.                      HookAction := LeaveTask(ID);
  2084.                      Case HookAction of
  2085.                         Escaped,
  2086.                         Finished,
  2087.                         Stop1..Stop9 : begin
  2088.                                           Task := HookAction;
  2089.                                           exit;
  2090.                                         end;
  2091.                         Refresh: DisplayItems;
  2092.                      end; {case}
  2093.                      if ID <> vActiveItem^.Item^.GetID then {hook changed the active field}
  2094.                         NewItemPtr := IDItemPtr(ID);
  2095.                   end;
  2096.                   {Change active fields}
  2097.                   if NewItemPtr^.Item^.Active then
  2098.                   begin
  2099.                      vActiveItem := NewItemPtr;
  2100.                      {Enter Hook}
  2101.                      ID := vActiveItem^.Item^.GetID;
  2102.                      HookAction := EnterTask(ID,LastActiveItemID);
  2103.                      Case HookAction of
  2104.                         Escaped,
  2105.                         Finished,
  2106.                         Stop1..Stop9: begin
  2107.                                          Task := HookAction;
  2108.                                          exit;
  2109.                                       end;
  2110.                         Refresh: DisplayItems;
  2111.                      end; {case}
  2112.                      if ID <> vActiveItem^.Item^.GetID then {hook changed the active field}
  2113.                      begin
  2114.                         ByPassing := true;
  2115.                         NewItemPtr := IDItemPtr(ID);
  2116.                         Task := None;
  2117.                      end
  2118.                      else
  2119.                      begin
  2120.                         ByPassing := false;
  2121.                         W := vActiveItem^.Item^.GetID;
  2122.                         if ((W <> 0) and (W <> HelpID))
  2123.                         or ((W = HelpID) and ((K <> 513) and (K <> vActiveItem^.Item^.GetHotKey))) then
  2124.                            LastActiveItemID := W;
  2125.                         Task := vActiveItem^.Item^.Select(K,X,Y);
  2126.                      end;
  2127.                   end
  2128.                   else
  2129.                      {No Enter Hook for inactive tasks}
  2130.                      Task := NewItemPtr^.Item^.Select(K,X,Y);
  2131.                   ProcessTask;
  2132.                end
  2133.                else    {suspension failed due to validation error}
  2134.                   Task := None; {don't leave field}
  2135.             end;
  2136.          until (Bypassing = false) and ((Task in [NextField,PrevField]) = false);
  2137.       end;
  2138.    end; {ProcessChar}
  2139.  
  2140. begin
  2141.    EscapingForm := false;
  2142.    FormHelpCalled := false;
  2143.    DisplayItems;
  2144.    Mvisible := Mouse.Visible;
  2145.    if not MVisible then
  2146.       Mouse.Show;
  2147.    {No Enter Hook at initial start-up}
  2148.    if not vActiveItem^.Item^.Visible then
  2149.    begin
  2150.       vActiveItem := vItemStack;
  2151.       while (vActiveItem <> Nil) and (vActiveItem^.Item^.Visible = false) do
  2152.          vActiveItem := vActiveItem^.NextNode;
  2153.    end;
  2154.    Task := vActiveItem^.Item^.Select(0,0,0);
  2155.    LastActiveItemID := vActiveItem^.Item^.GetID;
  2156.    Task := None;
  2157.    Repeat
  2158.       ProcessChar;
  2159.    Until (Task in [Finished,Escaped,Stop1..Stop9]);
  2160.    if Task <> Escaped then
  2161.      if vActiveItem^.Item^.Suspend then;
  2162.    Go := Task;
  2163.    if not MVisible then
  2164.       Mouse.Hide;
  2165.    EscapingForm := false;
  2166.    FormHelpCalled := false;
  2167. end; {FormOBJ.Go}
  2168.  
  2169. destructor FormOBJ.Done;
  2170. {frees all allocated memory for the linked list}
  2171. var
  2172.   Temp1, Temp2: pItemNode;
  2173. begin
  2174.    if vItemStack <> nil then
  2175.    begin
  2176.       Temp1 := vItemStack;
  2177.       Temp2 := Temp1^.NextNode;
  2178.       while Temp2 <> nil do
  2179.       begin
  2180.           Freemem(Temp1,sizeof(Temp1^));
  2181.           Temp1 := Temp2;
  2182.           Temp2 := Temp1^.NextNode;
  2183.       end;
  2184.       Freemem(Temp1,sizeof(Temp1^));
  2185.    end;
  2186. end; {destructor FormOBJ.Done}
  2187. {||||||||||||||||||||||||||||||||||||||||||||||||}
  2188. {                                                }
  2189. {     W i n A c t i o n O B J   M E T H O D S    }
  2190. {                                                }
  2191. {||||||||||||||||||||||||||||||||||||||||||||||||}
  2192.  
  2193. constructor WinFormOBJ.Init;
  2194. {}
  2195. begin
  2196.    New(vWinPtr,Init);
  2197.    FormOBJ.Init;
  2198. end; {WinFormOBJ.Init}
  2199.  
  2200. procedure WinFormOBJ.AdjustKey(var Key:word;var X,Y: byte);
  2201. {}
  2202. var WX,WY: byte;
  2203.     TempX,TempY: integer;
  2204. begin
  2205.    vWinPtr^.WinKey(Key,X,Y);
  2206.    TempX := X;
  2207.    TempY := Y;
  2208.    WX := vWinPtr^.GetX;
  2209.    WY := vWinPtr^.GetY;
  2210.    if (Key > 600) or (TempX < WX) or (TempY < WY) then
  2211.    begin
  2212.       TempX := 0;
  2213.       TempY := 0;
  2214.    end
  2215.    else
  2216.    begin
  2217.        Case vWinPtr^.GetStyle of
  2218.        0: begin
  2219.           dec(TempX,pred(WX));
  2220.           dec(TempY,pred(WY));
  2221.        end;
  2222.        6: begin
  2223.           dec(TempX,pred(WX));
  2224.           dec(TempY,WY + 2);
  2225.        end;
  2226.        else begin
  2227.           dec(TempX,WX);
  2228.           dec(TempY,WY);
  2229.        end;
  2230.        end; {case}
  2231.    end;
  2232.    if TempX > 0 then
  2233.       X := TempX
  2234.    else
  2235.       X := 0;
  2236.    if TempY > 0 then
  2237.       Y := TempY
  2238.    else
  2239.       Y := 0;
  2240. end; {WinFormOBJ.AdjustKey}
  2241.  
  2242. function WinFormOBJ.Win: MoveWinPtr;
  2243. {}
  2244. begin
  2245.    Win := vWinPtr;
  2246. end; {WinFormOBJ.Win}
  2247.  
  2248. procedure WinFormOBJ.Draw;                       
  2249. {}
  2250. begin
  2251.    vWinPtr^.Draw;
  2252. end; {WinFormOBJ.DisplayItems}
  2253.  
  2254. destructor WinFormOBJ.Done;
  2255. {}
  2256. begin
  2257.    Dispose(vWinPtr,Done);
  2258.    FormOBJ.Done;
  2259. end; {WinFormOBJ.Done}
  2260.  
  2261. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2262. {                                               }
  2263. {     U N I T   I N I T I A L I Z A T I O N     }
  2264. {                                               }
  2265. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2266. procedure IO1Init;
  2267. {initilizes objects and global variables}
  2268. begin
  2269.    new(IOTOT,Init);
  2270. end; {IO1Init}
  2271.  
  2272. {end of unit - add initialization routines below}
  2273. {$IFNDEF OVERLAY}
  2274. begin
  2275.    IO1Init;
  2276. {$ENDIF}
  2277. end.
  2278.