home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 25 / CD_ASCQ_25_1095.iso / dos / prg / tjgold / install.002 / GOLDIO.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  101KB  |  3,354 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                      {********************************}
  12.                      {**       Unit:   GOLDIO       **}
  13.                      {********************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDIO; {++++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GOLDIO}
  19.    {$DEFINE GOLDIO}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. uses DOS, CRT, GoldAttr,
  25.      GoldHard, GoldTint, GoldMisc, GoldKey, GoldFast,
  26.      GoldWin, GoldLink, GoldStr, GoldDate, GoldReal;
  27.  
  28. const
  29.    MaxForms = 10;       {alter as necessary}
  30.    IntCharacters: set of char = [#129, #132,#142,#148,#153,#154,#225]; {international users modify for your country}
  31.    LabelLeft = 0;
  32.    LabelTop  = -1;
  33.    ButtonMarker = 9999;
  34.    IDLastField = 255;
  35.  
  36.  
  37.  
  38.    NoRules      = $00;
  39.    AllowNull    = $01;
  40.    SuppressZero = $02;
  41.    RightJustify = $04;
  42.    EraseDefault = $08;
  43.    JumpIfFull   = $10;
  44.  
  45.    NoMID = 255; {used in Makeform}
  46.  
  47.    IOZero     = 0;
  48.    IOString   = 1;
  49.    IOByte     = 2;
  50.    IOWord     = 3;
  51.    IOInteger  = 4;
  52.    IOLongInt  = 5;
  53.    IOReal     = 6;
  54.    IOPassword = 7;
  55.    IOSelect   = 8;
  56.    IODate     = 9;
  57.    IOOther    = 10;
  58.    IOHotkey   = 11;
  59.  
  60.    CheckFld = 1;
  61.    RadioFld = succ(CheckFld);
  62.    ListFld = succ(RadioFld);
  63.    ScrollFld = IOString;
  64.  
  65.    RefreshNone    = 0;
  66.    RefreshCurrent = 1;
  67.    RefreshAll     = 2;
  68.    RefreshOthers  = 3;
  69.    EndInput       = 99;
  70.    NoChar         = #0;
  71.  
  72.    FirstIOCol = IOEditErase;
  73.    LastIOCol  = IOListScroll;
  74.  
  75. type
  76.    gCursPos = (CursLeft,CursRight,CursPrev);
  77.    gStatus = (Activate, HiStatus, NormStatus, OffStatus);
  78.    gValidate = (ValidatebyField,ValidateAtEnd);
  79.    gAction = (None,NextField,PrevField,NextForm,PrevForm,
  80.               Refresh,Enter,Help,
  81.               Stop1,Stop2,Stop3,Stop4,Stop5,Stop6,Stop7,Stop8,Stop9,Stop10,
  82.               Stop11,Stop12,Stop13,Stop14,Stop15,Stop16,Stop17,Stop18,Stop19,Stop20,
  83.               Stop21,Stop22,Stop23,Stop24,Stop25,Stop26,Stop27,Stop28,Stop29,Stop30,
  84.               Stop31,Stop32,Stop33,Stop34,Stop35,Stop36,Stop37,Stop38,Stop39,Stop40,
  85.               Stop41,Stop42,Stop43,Stop44,Stop45,Stop46,Stop47,Stop48,Stop49,Stop50,
  86.               Stop51,Stop52,Stop53,Stop54,Stop55,Stop56,Stop57,Stop58,Stop59,Stop60,
  87.               Stop61,Stop62,Stop63,Stop64,Stop65,Stop66,Stop67,Stop68,Stop69,Stop70,
  88.               Stop71,Stop72,Stop73,Stop74,Stop75,Stop76,Stop77,Stop78,Stop79,Stop80,
  89.               Stop81,Stop82,Stop83,Stop84,Stop85,Stop86,Stop87,Stop88,Stop89,Stop90,
  90.               Stop91,Stop92,Stop93,Stop94,Stop95,Stop96,Stop97,Stop98,Stop99,
  91.               Finished,Cancel1,Cancel2,Cancel3,Cancel4,Cancel5,Cancel6,
  92.               Cancel7,Cancel8,Cancel9,Escaped);
  93.  
  94.    gActiveState = (FldOff, FldOn, FldHidden);
  95.  
  96.    IOCharSet = set of char;
  97.  
  98.    MoveFieldProc  = procedure(var CurrentField:byte;var Refresh:byte);
  99.    CharHookProc   = procedure(var K : word; var CurrentField:byte;var Refresh:byte);
  100.    InsProc        = procedure(Insert:boolean);
  101.    HindHookProc   = procedure(CurrentField:byte;var Refresh:byte);
  102.    FinishedProc   = function:byte;
  103.    FormCloseProc  = function(FormID: byte):boolean;
  104.  
  105.    FieldSettingsPtr = ^FieldSettings;
  106.  
  107.    ProcessKeyProc   = function(InKey:word;X,Y:byte):gAction;
  108.    SuspendProc      = function:boolean;
  109.    DisplayProc      = procedure(FNP:FieldSettingsPtr;Status:gStatus);
  110.    HotKeyProc       = function(FNP:FieldSettingsPtr;var Key:word;var Act:gAction):boolean;
  111.    GenericFieldProc = procedure(FNP:FieldSettingsPtr);
  112.  
  113.    IOTints   = array[FirstIOCol..LastIOCol] of byte;
  114.  
  115.    gActionCharSet = record
  116.       NextChar: word;
  117.       PrevChar: word;
  118.       FinishChar: word;
  119.       EscChar: word;
  120.       UpChar: word;
  121.       DownChar: word;
  122.       LeftChar: word;
  123.       RightChar: word;
  124.       EraseChar: word;
  125.    end; { gActionCharSet }
  126.  
  127.    ScrollInfoPtr = ^ScrollInfo;
  128.    ScrollInfo = record
  129.       Maxlen: byte;
  130.       StartChar: byte;
  131.       ForceCase: gCase;
  132.    end;
  133.  
  134.    FieldSettings = record
  135.       ID:integer;
  136.       MID: byte;
  137.       Upfield: byte;
  138.       Downfield: byte;
  139.       Leftfield: byte;
  140.       Rightfield: byte;
  141.       X1: byte;
  142.       Y1: byte;
  143.       X2: byte;
  144.       Y2: byte;
  145.       IconWidth: byte;
  146.       Hotkey: word;
  147.       Message: strscreen;
  148.       FieldLabel: strscreen;
  149.       MsgX: byte;
  150.       MsgY: byte;
  151.       LabX: shortint;
  152.       LabY: shortint;
  153.       CursorX: byte;
  154.       StrLocX: byte;
  155.       FieldLen: byte;
  156.       FieldStr: string;
  157.       FieldFmt: strscreen;
  158.       RealDP: byte;
  159.       FieldRules: word;
  160.       AllowChar: set of char;
  161.       DisAllowChar: set of char;
  162.       FirstCharPress: boolean;
  163.       UsesCursors: boolean;
  164.       UsesEnter: boolean;
  165.       Active: gActiveState;
  166.       Visible: boolean;
  167.       ProcessKeyHook: ProcessKeyProc;
  168.       SuspendHook: SuspendProc;
  169.       DisplayHook: DisplayProc;
  170.       RefreshFieldHook: GenericFieldProc;
  171.       UpdateVarHook: GenericFieldProc;
  172.       HotKeyHook: HotKeyProc;
  173.       DisposeHook: GenericFieldProc;
  174.       case FieldType:byte of
  175.         IOString   : (SPtr: ^string);
  176.         IOByte     : (BPtr: ^byte;BMax:byte;BMin:byte);
  177.         IOWord     : (WPtr: ^word;WMax:word;WMin:word);
  178.         IOInteger  : (IPtr: ^integer;IMax:integer;IMin:integer);
  179.         IOLongInt  : (LPtr: ^longInt;LMax:longint;LMin:longInt;Delta:longint);
  180.         IOReal     : (RPtr: ^extended;RMax:extended;RMin:extended);
  181.         IODate     : (DPtr: ^Dates;DFormat:gDate;DMax:Dates;DMin:Dates);
  182.         IOOther    : (SourcePtr:pointer; DataPtr,DataPtrS: pointer; DataSize:longint; OMisc:word);
  183.    end; { FieldSettings }
  184.  
  185.    FieldNodePtr = ^FieldNode;
  186.    FieldNode = record
  187.         FieldInfo: FieldSettingsPtr;
  188.         NextField: FieldNodePtr;
  189.    end; { FieldNode }
  190.  
  191.    FormSettingsPtr = ^FormSettings;
  192.    FormSettings = record
  193.       Col: IOTints;
  194.       AllowEsc: boolean;
  195.       WhiteSpace: char;
  196.       LeaveFieldHook: MoveFieldProc;
  197.       EnterFieldHook: MoveFieldProc;
  198.       CharHook: CharHookProc;
  199.       HindHook: HindHookProc;
  200.       FinishedHook: FinishedProc;
  201.       LaunchCloseProc: WinCloseProc;
  202.       InsertProc: InsProc;
  203.       TotalFields: byte;
  204.       ActionChars: gActionCharSet;
  205.       DefaultRules: word;
  206.       LastAction: gAction;
  207.       MsgX: byte;
  208.       MsgY: byte;
  209.       MsgRestrict: boolean;
  210.       MsgLastX: byte;
  211.       MsgLastY: byte;
  212.       MsgLastL: byte;
  213.       OldLine: array [1..160] of byte;
  214.       ValState:gValidate;
  215.       {INTERNAL}
  216.       ActiveField: byte;
  217.       PreviousField: byte;                 {used when help called}
  218.       ActiveFieldPtr: FieldNodePtr;
  219.       Displayed: boolean;
  220.       InsertMode: boolean;
  221.       ValidateOnStop: boolean;
  222.       FirstField: FieldNodePtr;
  223.       WinNum: integer;
  224.       DefaultButtonID: byte;
  225.       FieldFullOn: boolean;
  226.       TInputFinished: boolean;
  227.       TSRefresh,TSField: byte;
  228.       TRefresh: byte;
  229.       DeskFormCloseCallBack: FormCloseProc;
  230.    end; { FormSettings }
  231.  
  232.    IOSet = record
  233.       LastECode: integer;
  234.       EMsgFunc: ErrMsgFunc;
  235.       CurrentForm: byte;           {the Form with input focus}
  236.       TotalForms: byte;            {total number of defined Forms}
  237.       IChar : char;                 {last IO character input by user}
  238.       ActionChars: gActionCharSet;  {default action characters}
  239.       WhiteSpace: char;
  240.       AllowEsc: boolean;
  241.       FieldFullOn: Boolean;
  242.       Form: array[0..MaxForms] of FormSettingsPtr; {0th Form is for internal use only}
  243.       DefaultRules: word;
  244.       DefaultValidate:gValidate;
  245.       LastCT: byte;                 {updated by ActivatePrivateForm}
  246.       UsingPrivateForm: boolean;
  247.       ValidationMsgTitle:string[40];
  248.       ValidationMsgNum:string[60];
  249.       ValidationMsgDate:string[60];
  250.       ValidationMsgNumPart1:string[60];
  251.       ValidationMsgNumPart2:string[20];
  252.       ValidationMsgEmpty: string[40];
  253.       FieldFullTitle:string[20];
  254.       FieldFullMsg: string[100];
  255.    end; { IOSet }
  256.  
  257. {HOOKS}
  258. procedure NoFieldHook(var CurrentField:byte;var Refresh:byte);
  259. procedure NoCharHook(var Ch:word; var CurrentField:byte;var Refresh:byte);
  260. procedure NoHindHook(CurrentField:byte;var Refresh:byte);
  261. function  NoFinishedHook:byte;
  262. procedure DefaultInsertHook(On:boolean);
  263. procedure AssignLeaveFieldHook(Proc:MoveFieldProc);
  264. procedure AssignEnterFieldHook(Proc:MoveFieldProc);
  265. procedure AssignCharHook(Proc:CharHookProc);
  266. procedure AssignHindHook(Proc:HindHookProc);
  267. procedure AssignFinishedHook(Proc:FinishedProc);
  268. procedure AssignInsHook(Proc:InsProc);
  269. {Form}
  270. procedure ResetForm(FormNum:byte);
  271. procedure CreateForms(Count:byte);
  272. procedure ActivateForm(FormNo:byte);
  273. procedure DisposeForms;
  274. procedure AssignActionChars(Nxt,Prv,U,D,L,R,Fin,Esc,E: word);
  275. procedure AssignFinishChar(W:word);
  276. procedure AllowEsc(On:boolean);
  277. function  FieldWithFocus:integer;
  278. procedure SetDefaultRules(Rules:word);
  279. procedure SetDefaultButton(FieldID:integer);
  280. procedure SetMessageXY(X,Y:byte; InWindow: boolean);
  281. procedure SetInsertMode(On:boolean);
  282. procedure SetFormWindow(X1,Y1,X2,Y2,style:byte);
  283. procedure SetValidation(Val:gValidate);
  284. procedure IOSetColor(A:TintElement;C:byte);
  285. procedure DefineColors(HiFB,LoFB,MsgFB:byte);
  286. function  FormWinNum: byte;
  287. function  FormExitAction: gAction;
  288. procedure DisposeFormWin;
  289. {FIELD}
  290. procedure AddField(FieldID:integer;DefU,DefD,DefL,DefR,DefX,DefY:byte);
  291. procedure KwikAddField(FieldID:integer;DefX,DefY:byte);
  292. procedure KwikAddLastField(FieldID:integer;DefX,DefY:byte);
  293. procedure DisposeFields;
  294. {FIELD PROPERTIES}
  295. procedure SetMessage(FieldID,X,Y:integer; Str : string);
  296. procedure SetLabel(FieldID,X,Y:integer; Str : string);
  297. procedure SetHK(FieldID:integer; Hotkey: word);
  298. procedure FieldSetState(FieldID:integer; State:gActiveState);
  299. function  FieldGetState(FieldID:integer):gActiveState;
  300. procedure FieldRules(FieldID:integer;Rules:word;AChar:IOcharset;DChar:IOcharset);
  301. {Field Assignments}
  302. procedure StringField(FieldID:integer;var Strvar:String;DefFormat:string);
  303. procedure ByteField(FieldID:integer;var Bytevar:Byte;DefFormat:string;Min,Max:byte);
  304. procedure WordField(FieldID:integer;var Wordvar:Word;DefFormat:string;Min,Max : word);
  305. procedure IntegerField(FieldID:integer;var Integervar:Integer;DefFormat:string;Min,Max:Integer);
  306. procedure LongIntField(FieldID:integer;var LongIntvar:LongInt;DefFormat:string;Min,Max : LongInt);
  307. procedure DateField(FieldID:integer;var Datevar:Dates;DateFormat:gDate;DefFormat:string;Min,Max : Dates);
  308. procedure RealField(FieldID:integer;var Realvar:extended;DefFormat:string;Min,Max:extended);
  309. {display procedures}
  310. procedure DisplayAllLabels;
  311. procedure DisplayAllFields;
  312. procedure DisplayForm;
  313. procedure ProcessInput(StartField:byte);
  314. function  EditForm(StartField:byte):gAction;
  315. {desktop}
  316. function  LaunchFormInit(X1,Y1,X2,Y2,style:byte; CloseProc:FormCloseProc):byte;
  317. procedure LaunchForm(StartField:byte);
  318. {INTERNALS - used by other GOLD units}
  319. procedure IOSetError(ECode:integer);
  320. function  LastIOError: integer;
  321. function  FieldPtr(FieldID:integer):FieldNodePtr;
  322. procedure DisplayMessage(FSP:FieldSettingsPtr;var Msg:string);
  323. procedure RemoveMessage(FSP:FieldSettingsPtr);
  324. function  IsRule(RuleBase:word; Rule:word):boolean;
  325. procedure StrToVar(FSP:FieldSettingsPtr);
  326. procedure OutOfRangeMessage(MinS,MaxS:StrScreen);
  327. procedure CannotBeEmptyMessage;
  328. procedure FieldFullMessage;
  329. function  VarToStr(FSP:FieldSettingsPtr):string;
  330. function  VarToString(FieldID:integer):String;
  331. procedure BasicDisplay(FNP:FieldSettingsPtr;Status:gStatus);
  332. procedure BasicRefresh(FSP:FieldSettingsPtr);
  333. function  BasicKeyHandler(InKey:word;X,Y:byte):gAction;
  334. procedure BasicDisposeHook(FNP:FieldSettingsPtr);
  335. procedure SetCursor(FSP:FieldSettingsPtr);
  336. procedure ActivatePrivateForm;
  337. procedure DisposePrivateForm;
  338. {MakeForm exports}
  339. procedure CheckFormAllocation;
  340. function  FieldInfoPtr(Count:integer): FieldSettingsPtr;
  341. function  AllocateNewField:FieldSettingsPtr;
  342. procedure SetBasicHooks(FieldInfo:FieldSettingsPtr;SetCurs:boolean);
  343. function  FieldHit(X,Y:word; CheckActive:boolean):word;
  344. function  GetDateFormatStr(DateFormat:gDate):string;
  345. {$IFDEF TTT5}
  346. procedure Create_Tables(No_Of_Tables:byte);
  347. procedure Activate_Table(Table_no:byte);
  348. procedure Assign_LeaveFieldHook(Proc:MoveFieldProc);
  349. procedure Assign_EnterFieldHook(Proc:MoveFieldProc);
  350. procedure Assign_InsHook(Proc:InsProc);
  351. procedure Create_Fields(No_of_fields:byte);
  352. procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  353. procedure Add_Message(DefID,DefX,DefY:byte;DefString:string);
  354. procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  355. procedure String_Field(DefID:byte;var Strvar:String;DefFormat:string);
  356. procedure Assign_Finish_Char(Ch:char);
  357. procedure Byte_Field(DefID:byte;var ByteVar:Byte;DefFormat:string;Min,Max:byte);
  358. procedure Word_Field(DefID:byte;var Wordvar:Word;DefFormat:string;Min,Max:word);
  359. procedure Integer_Field(DefID:byte;var Integervar:integer;DefFormat:string;Min,Max:integer);
  360. procedure LongInt_Field(DefID:byte;var LongIntvar:longint;DefFormat:string;Min,Max:longint);
  361. procedure Date_Field(DefID:byte;var Datevar:Dates;DateFormat:gDate;DefFormat:string;
  362.                       Min,Max : Dates);
  363. procedure Real_Field(DefID:byte;var Realvar:real;DefFormat:string;Min,Max:real);
  364. procedure Set_Default_Rules(Rules:word);
  365. procedure Field_Rules(DefID:byte;Rules:word;AChar:IOcharset;DChar:IOcharset);
  366. procedure Update_Variables;
  367. procedure Display_All_Fields;
  368. procedure Allow_Esc(OK:boolean);
  369. procedure Allow_Beep(OK:boolean);
  370. procedure Init_Insert_Mode(ON:boolean);
  371. procedure Dispose_Fields;
  372. procedure Dispose_Tables;
  373. procedure Process_Input(StartField:byte);
  374. {$ENDIF}
  375.  
  376. var   IOVars: IOSet;
  377.       ActiveForm: FormSettingsPtr;
  378.  
  379. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  380.  
  381. const
  382.    Valid    = 0;
  383.    NotValid = 1;
  384. var
  385.   CurrentForm : byte;
  386.   TotalForms : byte;
  387.  
  388.                       {******************************}
  389.                       {**  Miscellaneous Routines  **}
  390.                       {******************************}
  391.  
  392. {$IFOPT F-}
  393.    {$DEFINE FOFF}
  394.    {$F+}
  395. {$ENDIF}
  396. function IoEMsg(ECode:integer): string;
  397. {}
  398. begin
  399.    case Ecode of
  400.       0: exit;
  401.       1001: IoEMsg := 'Form number out of range, see MAXFormS in GoldIO';
  402.       1002: IoEMsg := 'Not enough memory to create Forms';
  403.       1003: IoEMsg := 'Cannot activate Form - number out of range';
  404.       1004: IoEMsg := 'An AddField did not have a corresponding xxxField, e.g. StringField';
  405.       1005: IoEMsg := 'Invalid FieldID specified';
  406.       1006: IoEMsg := 'Forms already created - call DisposeForms first';
  407.       1007: IoEMsg := 'Field type incompatible with AddItem type';
  408.       1008: IoEMsg := 'Insufficient memory to AddItem';
  409.       1009: IoEMsg := 'Unable to create Form Window';
  410.       1010: IoEMsg := 'Field type incompatible with ScrollForceCase';
  411.       else
  412.          IoEMsg := 'Internal I/O error';
  413.    end; {case}
  414. end; { IoEMsg }
  415. {$IFDEF FOFF}
  416.    {$F-}
  417.    {$UNDEF FOFF}
  418. {$ENDIF}
  419.  
  420. procedure IOSetError(ECode:integer);
  421. {}
  422. {$IFOPT D+}
  423. var Msg: string;
  424. {$ENDIF}
  425. begin
  426.    IOVars.LastEcode := ECode;
  427. {$IFOPT D+}
  428.    if Ecode <> 0 then
  429.    begin
  430.       str(Ecode,Msg);
  431.       Msg := Msg+': '+IOVars.EMsgFunc(Ecode);
  432.       SetWinIgnore(true);
  433.       if PromptCustom(' GoldIO Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
  434.          Halt;
  435.       SetWinIgnore(false);
  436.    end;
  437. {$ENDIF}
  438. end; {IOSetError}
  439.  
  440. function LastIOError: integer;
  441. {}
  442. begin
  443.    LastIOError := IOVars.LastECode;
  444. end; { LastIOError }
  445.  
  446. {$IFOPT F-}
  447.    {$DEFINE FOFF}
  448.    {$F+}
  449. {$ENDIF}
  450.  
  451. procedure NoFieldHook(var CurrentField:byte;var Refresh:byte);
  452. {empty procs}
  453. begin
  454.    Refresh := RefreshNone;
  455. end; { NoFieldHook }
  456.  
  457. procedure NoCharHook(var Ch:word; var CurrentField:byte;var Refresh:byte);
  458. {empty procs}
  459. begin
  460.    Refresh := RefreshNone;
  461. end; { NoCharHook }
  462.  
  463. procedure NoHindHook(CurrentField:byte;var Refresh:byte);
  464. {empty procs}
  465. begin
  466.    Refresh := RefreshNone;
  467. end; { NoHindHook }
  468.  
  469. function NoFinishedHook:byte;
  470. {}
  471. begin
  472.    NoFinishedHook := 0;
  473. end; { NoFinishedHook }
  474.  
  475. procedure DefaultInsertHook(On:boolean);
  476. {}
  477. begin
  478.    if ON then
  479.       CursorOn
  480.    else
  481.       CursorFull;
  482. end; { DefaultInsertHook }
  483.  
  484. function DefaultProcessKey(InKey:word;X,Y:byte):gAction;
  485. {}
  486. begin
  487.    DefaultProcessKey := none;
  488. end; { DefaultProcessKey }
  489.  
  490. function DefaultSuspend:boolean;
  491. {}
  492. begin
  493.    DefaultSuspend := true;
  494. end; { DefaultSuspend }
  495.  
  496. procedure DefaultDisplay(Status:gStatus);
  497. {}
  498. begin
  499.    {abstract}
  500. end; { DefaultDisplay }
  501.  
  502. function BasicHotKeyHandler(FNP:FieldSettingsPtr;var Key:word;var Act:gAction):boolean;
  503. {}
  504. var Selected: boolean;
  505. begin
  506.    if FNP <> nil then with FNP^ do
  507.       Selected := (Key <> 0) and (Key = HotKey) and (Active = FldOn)
  508.    else
  509.       Selected := false;
  510.    if Selected then
  511.       Key := 0;  {absorb the key}
  512.    BasicHotkeyHandler := Selected;
  513. end; { BasicHotKeyHandler }
  514.  
  515. procedure BasicDisposeHook(FNP:FieldSettingsPtr);
  516. {abstract}
  517. begin
  518. end; { BasicDisposeHook }
  519.  
  520. {$IFDEF FOFF}
  521.    {$F-}
  522.    {$UNDEF FOFF}
  523. {$ENDIF}
  524.  
  525. function FieldPtr(FieldID:integer):FieldNodePtr;
  526. {}
  527. var FNP:FieldNodePtr;
  528. begin
  529.    FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  530.    if FieldID = IDLastField then
  531.       while (FNP^.NextField) <> nil do
  532.          FNP := FNP^.NextField
  533.    else
  534.       while (FNP <> nil) and (FNP^.FieldInfo^.ID <> FieldID) do
  535.          FNP := FNP^.NextField;
  536.    FieldPtr := FNP;
  537. end; { FieldPtr }
  538.  
  539. function FieldInfoPtr(Count:integer): FieldSettingsPtr;
  540. {}
  541. var FNP: FieldNodePtr;
  542. begin
  543.    FNP := FieldPtr(Count);
  544.    if FNP = nil then
  545.       FieldInfoPtr := nil
  546.    else
  547.       FieldInfoPtr := FNP^.FieldInfo;
  548. end; { FieldInfoPtr }
  549.  
  550. function FieldNumber(FNP:FieldNodePtr):integer;
  551. {}
  552. var P: FieldNodePtr;
  553.     FN: integer;
  554. begin
  555.    if FNP = nil then
  556.       FieldNumber := 0
  557.    else
  558.       FieldNumber := FNP^.FieldInfo^.ID;
  559. end; { FieldNumber }
  560.  
  561. function IsRule(RuleBase:word; Rule:word):boolean;
  562. {}
  563. begin
  564.    IsRule := (RuleBase and Rule) = Rule;
  565. end; { IsRule }
  566.  
  567.                           {**********************}
  568.                           {**  Form Routines  **}
  569.                           {**********************}
  570.  
  571. {$IFOPT F-}
  572.    {$DEFINE FOFF}
  573.    {$F+}
  574. {$ENDIF}
  575.  function IOCloseHandler(Handle: integer):boolean;
  576.  {}
  577.  var
  578.     WinP: WStructurePtr;
  579.  begin
  580.     {Check to see if form can be closed}
  581.     IOCloseHandler := true;
  582.     WinDispose(Handle);
  583.  end; {IOCloseHandler}
  584.  
  585.  function IgnoreFormClose(Form:byte):boolean;
  586.  {No op}
  587.  begin
  588.     IgnoreFormClose := true;
  589.  end; {IgnoreFormClose}
  590. {$IFDEF FOFF}
  591.    {$F-}
  592.    {$UNDEF FOFF}
  593. {$ENDIF}
  594.  
  595. procedure ResetForm(FormNum:byte);
  596. var A: TintElement;
  597. begin
  598.    with IOVars.Form[FormNum]^ do
  599.    begin
  600.       for A := FirstIOCol to LastIOCol do
  601.          Col[A] := Tint[A];
  602.       ActionChars := IOVars.ActionChars;
  603.       AllowEsc     := IOVars.AllowEsc;
  604.       WhiteSpace   := IOVars.Whitespace;
  605.       LeaveFieldHook := NoFieldHook;
  606.       EnterFieldHook := NoFieldHook;
  607.       CharHook := NoCharHook;
  608.       HindHook := NoHindHook;
  609.       LaunchCloseProc := IOCloseHandler;
  610.       FinishedHook := NoFinishedHook;
  611.       InsertProc := DefaultInsertHook;
  612.       FirstField := nil;
  613.       ActiveFieldPtr := nil;
  614.       TotalFields := 0;
  615.       ActiveField := 0;
  616.       PreviousField := 0;
  617.       WinNum := 0;
  618.       DefaultButtonID := 0;
  619.       Displayed    := false;
  620.       ValidateOnStop := true;
  621.       DefaultRules := IOVars.DefaultRules;
  622.       MsgX := 0;
  623.       MsgY := 50; {if its too large TTT automatically sets to last line of display}
  624.       MsgRestrict := true;  {write in active window}
  625.       MsgLastL := 0;
  626.       ValState := IOVars.DefaultValidate;
  627.       InsertMode := true;
  628.       FieldFullOn := IOVars.FieldFullOn;
  629.       DeskFormCloseCallBack := IgnoreFormClose;
  630.    end;
  631. end; { ResetForm }
  632.  
  633. procedure CreateForms(Count:byte);
  634. {}
  635. var I: integer;
  636.     RoomNeeded: integer;
  637. begin
  638.    if IOVars.TotalForms <> 0 then
  639.    begin
  640.       IOSetError(1006);  {Forms already created}
  641.       exit;
  642.    end;
  643.    if Count in [1..MaxForms] then
  644.    begin
  645.       RoomNeeded := sizeof(IOVars.Form[1]^);
  646.       for I := 1 to Count do
  647.       begin
  648.          if GoldMaxAvail >= RoomNeeded then
  649.          begin
  650.             getmem(IOVars.Form[I],RoomNeeded);
  651.             ResetForm(I)
  652.          end else  {not enough heap space}
  653.          begin
  654.             IOSetError(1002);
  655.             exit;
  656.          end;
  657.       end;
  658.       for I := succ(Count) to MaxForms do
  659.          IOVars.Form[I] := nil;
  660.       IOVars.TotalForms := Count;
  661.       IOVars.CurrentForm := 1;
  662.       ActiveForm := IOVars.Form[1];
  663.    end else
  664.       IOSetError(1001);  {Form out of range}
  665. end; { CreateForms }
  666.  
  667. procedure ActivatePrivateForm;
  668. {INTERNAL}
  669. var FormSize:integer;
  670. begin
  671.    FormSize := sizeof(IOVars.Form[0]^);
  672.    if GoldMaxAvail < FormSize then
  673.       IOSetError(1002)
  674.    else
  675.    begin
  676.       getmem(IOVars.Form[0],FormSize);
  677.       ResetForm(0);
  678.       IOVars.LastCT := IOVars.CurrentForm;
  679.       IOVars.CurrentForm := 0;
  680.       ActiveForm := IOVars.Form[0];
  681.       IOVars.UsingPrivateForm := true;
  682.    end;
  683. end; { ActivatePrivateForm }
  684.  
  685. procedure DisposePrivateForm;
  686. {INTERNAL}
  687. begin
  688.    with IOVars do
  689.    begin
  690.       freemem(Form[0],sizeof(Form[0]^));
  691.       CurrentForm := LastCT;
  692.       ActiveForm := Form[LastCT];
  693.       UsingPrivateForm := false;
  694.    end;
  695. end; { DisposePrivateForm }
  696.  
  697. procedure ActivateForm(FormNo:byte);
  698. {}
  699. begin
  700.    if FormNo > IOVars.TotalForms then
  701.         IOSetError(1003);
  702.    IOVars.CurrentForm := FormNo;
  703.    ActiveForm := IOVars.Form[FormNo];
  704. end; { ActivateForm }
  705.  
  706. procedure DisposeForms;
  707. {}
  708. var I: integer;
  709. begin
  710.    with IOVars do
  711.    begin
  712.       for I := 1 to TotalForms do
  713.       begin
  714.          if Form[I] <> nil then
  715.          begin
  716.             if Form[I]^.WinNum <> 0 then
  717.                WinDispose(Form[I]^.WinNum);
  718.             freemem(Form[I],sizeof(Form[I]^));
  719.             Form[I] := nil;
  720.          end;
  721.       end;
  722.       TotalForms := 0;
  723.    end;
  724. end; { DisposeForms }
  725.  
  726. procedure CheckFormAllocation;
  727. {}
  728. begin
  729.    if not IOVars.UsingPrivateForm and (IOVars.TotalForms = 0) then
  730.       CreateForms(1);
  731. end; { CheckFormAllocation }
  732.  
  733.                          {************************}
  734.                          {**  Form Properties  **}
  735.                          {************************}
  736.  
  737. procedure AssignActionChars(Nxt,Prv,U,D,L,R,Fin,Esc,E: word);
  738. {}
  739. begin
  740.    CheckFormAllocation;
  741.    with IOVars.Form[IOVars.CurrentForm]^.ActionChars do
  742.    begin
  743.       if Nxt <> 0 then
  744.          NextChar := Nxt;
  745.       if Prv <> 0 then
  746.          PrevChar := Prv;
  747.       if Fin <> 0 then
  748.          FinishChar := Fin;
  749.       if Esc <> 0 then
  750.          EscChar := Esc;
  751.       if U <> 0 then
  752.          UpChar := U;
  753.       if D <> 0 then
  754.          DownChar := D;
  755.       if L <> 0 then
  756.          LeftChar := L;
  757.       if R <> 0 then
  758.          RightChar := R;
  759.       if E <> 0 then
  760.          EraseChar := E;
  761.    end;
  762. end; { AssignActionChars }
  763.  
  764. procedure AllowEsc(On:boolean);
  765. {For TTT5 compatibility only - use AssignActionChars instead}
  766. begin
  767.   if On then
  768.      IOVars.Form[IOVars.CurrentForm]^.ActionChars.EscChar := 27
  769.   else
  770.      IOVars.Form[IOVars.CurrentForm]^.ActionChars.EscChar := 0;
  771. end; { AllowEsc }
  772.  
  773. function FieldWithFocus:integer;
  774. {}
  775. begin
  776.    FieldWithFocus := IOVars.Form[IOVars.CurrentForm]^.ActiveField;
  777. end; { FieldWithFocus }
  778.  
  779. procedure SetDefaultRules(Rules:word);
  780. {}
  781. begin
  782.    CheckFormAllocation;
  783.    IOVars.Form[IOVars.CurrentForm]^.DefaultRules := Rules;
  784. end; { SetDefaultRules }
  785.  
  786. procedure SetDefaultButton(FieldID:integer);
  787. {}
  788. begin
  789.    CheckFormAllocation;
  790.    IOVars.Form[IOVars.CurrentForm]^.DefaultButtonID := byte(FieldID);
  791. end; { SetDefaultRules }
  792.  
  793. procedure SetValidation(Val:gValidate);
  794. {}
  795. begin
  796.    CheckFormAllocation;
  797.    IOVars.Form[IOVars.CurrentForm]^.ValState := Val;
  798. end; { SetValidation }
  799.  
  800. procedure AssignLeaveFieldHook(Proc:MoveFieldProc);
  801. {}
  802. begin
  803.    CheckFormAllocation;
  804.    IOVars.Form[IOVars.CurrentForm]^.LeaveFieldHook := Proc;
  805. end; { AssignLeaveFieldHook }
  806.  
  807. procedure AssignEnterFieldHook(Proc:MoveFieldProc);
  808. {}
  809. begin
  810.    CheckFormAllocation;
  811.    IOVars.Form[IOVars.CurrentForm]^.EnterFieldHook := Proc;
  812. end; { AssignEnterFieldHook }
  813.  
  814. procedure AssignCharHook(Proc:CharHookProc);
  815. {}
  816. begin
  817.    CheckFormAllocation;
  818.    IOVars.Form[IOVars.CurrentForm]^.CharHook := Proc;
  819. end; { AssignCharHook }
  820.  
  821. procedure AssignFinishedHook(Proc:FinishedProc);
  822. {}
  823. begin
  824.    CheckFormAllocation;
  825.    IOVars.Form[IOVars.CurrentForm]^.FinishedHook := Proc;
  826. end; { AssignFinsihedHook }
  827.  
  828. procedure AssignHindHook(Proc:HindHookProc);
  829. {}
  830. begin
  831.    CheckFormAllocation;
  832.    IOVars.Form[IOVars.CurrentForm]^.HindHook := Proc;
  833. end; { AssignHindHook }
  834.  
  835. procedure AssignInsHook(Proc:InsProc);
  836. {}
  837. begin
  838.    CheckFormAllocation;
  839.    IOVars.Form[IOVars.CurrentForm]^.InsertProc := Proc;
  840. end; { AssignInsHook }
  841.  
  842. procedure AssignFinishChar(W:word);
  843. {For TTT5 compatibility only - use AssignActionChars instead}
  844. begin
  845.    CheckFormAllocation;
  846.    IOVars.Form[IOVars.CurrentForm]^.ActionChars.FinishChar := W;
  847. end; { AssignFinishChar }
  848.  
  849. procedure DefineColors(HiFB,LoFB,MsgFB:byte);
  850. {For TTT5 compatibility only - use SetxxxColors instead}
  851. begin
  852.    CheckFormAllocation;
  853.    with IOVars.Form[IOVars.CurrentForm]^ do
  854.    begin
  855.       Col[IOEditHi] := HiFB;
  856.       Col[IOEditNorm] := LoFB;
  857.       Col[IOMessage] := MsgFB;
  858.    end;
  859. end; { DefineColors }
  860.  
  861. procedure SetMessageXY(X,Y:byte; InWindow:boolean);
  862. {Defines the default location for messages. These cordinates are used
  863.  when an individual field is assigned an X,Y of 0,0}
  864. begin
  865.    CheckFormAllocation;
  866.    with IOVars.Form[IOVars.CurrentForm]^ do
  867.    begin
  868.       MsgX := X;
  869.       MsgY := Y;
  870.       MsgRestrict := InWindow;
  871.    end;
  872. end; { SetMessageXY }
  873.  
  874. procedure SetInsertMode(On:boolean);
  875. {}
  876. begin
  877.    CheckFormAllocation;
  878.    with IOVars.Form[IOVars.CurrentForm]^ do
  879.        InsertMode := On;
  880. end; { SetInsertMode }
  881.  
  882. procedure IOSetColor(A:TintElement;C:byte);
  883. {}
  884. begin
  885.    if A in [FirstIOCol..LastIOCol] then
  886.       IOVars.Form[IOVars.CurrentForm]^.Col[A] := C;
  887. end; { IOSetColor }
  888.  
  889. procedure SetFormWinColors(WinNum: byte);
  890. {}
  891. begin
  892.    with IOVars.Form[IOVars.CurrentForm]^ do
  893.    begin
  894.       WinSetColor(WinNum,WinBody,Col[IOWinBody]);
  895.       WinSetColor(WinNum,WinBorder,Col[IOWinBorder1]);
  896.       WinSetColor(WinNum,WinBorder,Col[IOWinBorder1]);
  897.       WinSetColor(WinNum,WinBorder3DOut,Col[IOWinBorder1]);
  898.       WinSetColor(WinNum,WinBorder3DIn,Col[IOWinBorder2]);
  899.       WinSetColor(WinNum,WinTitle,Col[IOWinTitle]);
  900.       WinSetColor(WinNum,WinIcons,Col[IOWinIcons]);
  901.       WinSetColor(WinNum,WinBorderOff,Col[IOWinBorderOff]);
  902.    end;
  903. end; {SetFormWinColors}
  904.  
  905. procedure SetFormWindow(X1,Y1,X2,Y2,style:byte);
  906. {}
  907. begin
  908.    with IOVars.Form[IOVars.CurrentForm]^ do
  909.    begin
  910.       WinNum := WinCreate(X1,Y1,X2,Y2,style);
  911.       if WinNum = 0 then
  912.          IOSetError(1009)
  913.       else
  914.          SetFormWinColors(WinNum);
  915.    end; {with}
  916. end; { SetFormWindow }
  917.  
  918. function FormWinNum: byte;
  919. {}
  920. begin
  921.   FormWinNum := IOVars.Form[IOVars.CurrentForm]^.WinNum;
  922. end; { FormWinNum }
  923.  
  924. function FormExitAction: gAction;
  925. {}
  926. begin
  927.   FormExitAction := IOVars.Form[IOVars.CurrentForm]^.LastAction;
  928. end; { FormExitAction }
  929.  
  930. function AllocateNewField:FieldSettingsPtr;
  931. {INTERNAL}
  932. begin
  933.    if GoldMaxAvail < sizeof(IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^)
  934.                      +
  935.                      sizeof(IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.FieldInfo^)
  936.    then
  937.    begin
  938.       IOSetError(8);   {not enough memory to create field}
  939.       AllocateNewField := nil;
  940.    end else
  941.    begin
  942.       if IOVars.Form[IOVars.CurrentForm]^.FirstField = nil then {first field}
  943.       begin
  944.          getmem(IOVars.Form[IOVars.CurrentForm]^.FirstField,
  945.                 sizeof(IOVars.Form[IOVars.CurrentForm]^.FirstField^));
  946.          IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  947.       end else
  948.       begin
  949.          getmem(IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.NextField,
  950.                 sizeof(IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^));
  951.          IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr := IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.NextField;
  952.       end;
  953.       IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.NextField := nil;
  954.       getmem(IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.FieldInfo,
  955.              sizeof(IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.FieldInfo^));
  956.       inc(IOVars.Form[IOVars.CurrentForm]^.ActiveField);
  957.       AllocateNewField := IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.FieldInfo;
  958.    end;
  959. end; { AllocateNewField }
  960.  
  961. procedure AddField(FieldID:integer;DefU,DefD,DefL,DefR,DefX,DefY:byte);
  962. {}
  963. var FieldDetails: FieldSettingsPtr;
  964. begin
  965.    CheckFormAllocation;
  966.    FieldDetails := AllocateNewField;
  967.    if FieldDetails <> nil then
  968.       with FieldDetails^ do
  969.       begin
  970.          ID := FieldID;
  971.          MID := NoMID;
  972.          Upfield := DefU;
  973.          Downfield := DefD;
  974.          Leftfield := DefL;
  975.          Rightfield := DefD;
  976.          X1 := DefX;
  977.          Y1 := DefY;
  978.          Y2 := Y1;
  979.          IconWidth := 0;
  980.          HotKey := 0;
  981.          HotKeyHook := BasicHotKeyHandler;
  982.          Message := '';
  983.          FieldLabel := '';
  984.          FieldFmt := '';
  985.          MsgX := 0;
  986.          MsgY := 0;
  987.          FieldRules := IOVars.Form[IOVars.CurrentForm]^.DefaultRules;
  988.          inc(IOVars.Form[IOVars.CurrentForm]^.TotalFields);
  989.          AllowChar := [NoChar];
  990.          DisAllowChar := [NoChar];
  991.          FieldType := 0;
  992.          UsesCursors := false;
  993.          UsesEnter := false;
  994.          Active := FldOn;
  995.          Visible := true;
  996.          DataPtr := nil;
  997.          DataSize := 0;
  998.          DataPtrS := nil;
  999.          OMisc := 0;
  1000.       end;
  1001. end; { AddField }
  1002.  
  1003. procedure KwikAddField(FieldID:integer;DefX,DefY:byte);
  1004. {}
  1005. begin
  1006.    if FieldID = 1 then
  1007.       AddField(FieldID,IDLastField,succ(FieldID),IDLastField,succ(FieldID),DefX,DefY)
  1008.    else
  1009.       AddField(FieldID,pred(FieldID),succ(FieldID),pred(FieldID),succ(FieldID),DefX,DefY);
  1010. end; { KwikAddField }
  1011.  
  1012. procedure KwikAddLastField(FieldID:integer;DefX,DefY:byte);
  1013. {}
  1014. begin
  1015.    AddField(FieldID,pred(FieldID),1,pred(FieldID),1,DefX,DefY);
  1016. end; { KwikAddLastField }
  1017.  
  1018. procedure DisposeFormWin;
  1019. {}
  1020. begin
  1021.    with IOVars.Form[IOVars.CurrentForm]^ do
  1022.    begin
  1023.       WinDispose(WinNum);
  1024.       WinNum := 0;
  1025.    end;
  1026. end; { DisposeFormWin }
  1027.  
  1028. procedure DisposeFields;
  1029. {Runs down the field list and disposes of the allocated memory}
  1030. var Temp1,Temp2: FieldNodePtr;
  1031. begin
  1032.    Temp1 := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  1033.    while Temp1 <> nil do
  1034.    begin
  1035.       Temp2 := Temp1^.NextField;
  1036.       if Temp1^.FieldInfo <> nil then
  1037.       begin
  1038.          Temp1^.FieldInfo^.DisposeHook(Temp1^.FieldInfo);
  1039.          freemem(Temp1^.FieldInfo,sizeof(Temp1^.FieldInfo^));
  1040.       end;
  1041.       freemem(Temp1,sizeof(Temp1^));
  1042.       Temp1 := Temp2;
  1043.    end;
  1044.    with IOVars.Form[IOVars.CurrentForm]^ do
  1045.    begin
  1046.       FirstField := nil;
  1047.       TotalFields := 0;
  1048.       ActiveField := 0;
  1049.       if WinNum <> 0 then
  1050.          DisposeFormWin;
  1051.       Displayed    := false;
  1052.    end;
  1053. end; { DisposeFields }
  1054.  
  1055.                          {************************}
  1056.                          {**  Field Properties  **}
  1057.                          {************************}
  1058.  
  1059. procedure SetMessage(FieldID,X,Y:integer; Str : string);
  1060. {}
  1061. var FSP: FieldSettingsPtr;
  1062. begin
  1063.    FSP := FieldInfoPtr(FieldID);
  1064.    if (FSP <> nil) then
  1065.       with FSP^ do
  1066.       begin
  1067.          MsgX := X;
  1068.          MsgY := Y;
  1069.          Message := Str;
  1070.       end
  1071.    else
  1072.       IOSetError(5);       {invalid field ID}
  1073. end; { SetMessage }
  1074.  
  1075. procedure SetLabel(FieldID,X,Y:integer; Str: string);
  1076. {}
  1077. var FSP: FieldSettingsPtr;
  1078. begin
  1079.    FSP := FieldInfoPtr(FieldID);
  1080.    if (FSP <> nil) then
  1081.    begin
  1082.       FSP^.FieldLabel := Str;
  1083.       FSP^.LabX := X;
  1084.       FSP^.LabY := Y;
  1085.    end
  1086.    else
  1087.       IOSetError(5);  {invalid field ID}
  1088. end; { SetLabel }
  1089.  
  1090. procedure SetHK(FieldID:integer; Hotkey: word);
  1091. {}
  1092. var FSP: FieldSettingsPtr;
  1093. begin
  1094.    FSP := FieldInfoPtr(FieldID);
  1095.    if (FSP <> nil) then
  1096.       FSP^.HotKey := HotKey
  1097.    else
  1098.       IOSetError(5);  {invalid field ID}
  1099. end; { SetHK }
  1100.  
  1101. procedure FieldSetState(FieldID:integer; State:gActiveState);
  1102. {}
  1103. var FSP: FieldSettingsPtr;
  1104. begin
  1105.    FSP := FieldInfoPtr(FieldID);
  1106.    if (FSP <> nil) then
  1107.       FSP^.Active := State;
  1108. end; { FieldSetActive }
  1109.  
  1110. function  FieldGetState(FieldID:integer):gActiveState;
  1111. {}
  1112. var FSP: FieldSettingsPtr;
  1113. begin
  1114.    FSP := FieldInfoPtr(FieldID);
  1115.    if (FSP <> nil) then
  1116.       FieldGetState := FSP^.Active
  1117.    else
  1118.       FieldGetState := FldHidden;
  1119. end; { FieldGetActive }
  1120.  
  1121.                      {*******************************}
  1122.                      {**  Internal Field Routines  **}
  1123.                      {*******************************}
  1124.  
  1125. function LastCharLeftJustified(Str,Fmt:string): byte;
  1126. var LenS,LenF,S,Counter: byte;
  1127. begin
  1128.    Counter := 0;
  1129.    S := 0;
  1130.    LenF := length(Fmt);
  1131.    LenS := length(Str);
  1132.    repeat
  1133.       inc(Counter);
  1134.       if Fmt[Counter] in FmtChars then
  1135.          Inc(S);
  1136.    until (S > LenS) or (Counter > LenF);
  1137.    LastCharLeftJustified := Counter;
  1138. end; { LastCharLeftJustified }
  1139.  
  1140. function PosofLastInputChar(DefFormat:string): byte;
  1141. var Counter: byte;
  1142. begin
  1143.    Counter := succ(length(DefFormat));
  1144.    repeat
  1145.      dec(Counter);
  1146.    until (DefFormat[Counter] in FmtChars) or (Counter = 0);
  1147.    PosofLastInputChar := counter;
  1148. end; { PosofLastInputChar }
  1149.  
  1150. procedure SetCursor(FSP:FieldSettingsPtr);
  1151. {}
  1152. begin
  1153.    if (FSP <> nil) then
  1154.    with FSP^ do
  1155.    begin
  1156.       if OMisc = ScrollFld then
  1157.       begin
  1158.          with FSP^ do
  1159.          with ScrollInfoPtr(DataPtrS)^ do
  1160.             if (StrLocX <= length(FieldStr)) then
  1161.             begin
  1162.                StrLocX := succ(length(FieldStr));
  1163.                if (StrLocX - StartChar) > FieldLen then
  1164.                begin
  1165.                   StartChar := StrLocX - FieldLen;
  1166.                   CursorX := X2;
  1167.                end else
  1168.                   CursorX := succ(X1) + StrLocX - StartChar;
  1169.          end;
  1170.       end else
  1171.       if IsRule(FieldRules,RightJustify) then
  1172.       begin
  1173.          CursorX := pred(X1) + PosofLastInputChar(FieldFmt);
  1174.          StrLocX := length(FieldStr);
  1175.       end else
  1176.       begin
  1177.          if FieldStr = '' then
  1178.             StrLocX := 1
  1179.          else
  1180.          begin
  1181.             StrLocX := succ(Length(FieldStr));
  1182.             if StrLocX > FieldLen then
  1183.                StrLocX := FieldLen;
  1184.          end;
  1185.          CursorX := LastCharLeftJustified(FieldStr,FieldFmt);
  1186.          if CursorX > length(FieldFmt) then
  1187.             dec(CursorX);
  1188.          while ( (FieldFmt[CursorX] in FmtChars) = false)
  1189.          and   (CursorX > 0) do
  1190.             dec(CursorX);
  1191.          CursorX := CursorX + pred(X1);
  1192.       end;
  1193.    end; {with}
  1194. end; { SetCursor }
  1195.  
  1196. function MaxStringlength(DefFormat:string) : byte;
  1197. var I,Counter: byte;
  1198. begin
  1199.    Counter := 0;
  1200.    for I := 1 to length(DefFormat) do
  1201.        if (DefFormat[I] in FmtChars) then
  1202.           inc(Counter);
  1203.    MaxStringlength := Counter;
  1204. end;  { MaxStringLength }
  1205.  
  1206.                          {***********************}
  1207.                          {**  Form Management  **}
  1208.                          {***********************}
  1209.  
  1210. function LabelXCoord(X,FX:shortint;FieldLabel:string): byte;
  1211. {Returns the starting column of the field label.
  1212.  X is the LabX value
  1213.  FX is the starting column of the field
  1214.  FieldLabel is the label string
  1215.  }
  1216. var LX: integer;
  1217. begin
  1218.    if X > 0 then
  1219.       LX := X
  1220.    else if X = LabelLeft then {zero}
  1221.       LX := pred(FX)-length(strip('A',Himarker,FieldLabel))
  1222.    else
  1223.       LX := FX;
  1224.    if LX < 1 then
  1225.       LabelXCoord := 0
  1226.    else
  1227.       LabelXCoord := LX;
  1228. end; { LabelXCoord }
  1229.  
  1230. function LabelYCoord(Y,FY:shortint;FieldLabel:string): byte;
  1231. {}
  1232. begin
  1233.    if Y > 0 then
  1234.       LabelYCoord := Y
  1235.    else if Y = LabelLeft then
  1236.       LabelYCoord := FY
  1237.    else
  1238.       LabelYCoord := pred(FY);
  1239. end; { LabelYCoord }
  1240.  
  1241. procedure DisplayLabel(FNP:FieldNodePtr; Hi:boolean);
  1242. {}
  1243. var X,Y,N,H: byte;
  1244.     LStart: integer;
  1245. begin
  1246.    if (FNP <> nil) then
  1247.       with FNP^.FieldInfo^ do
  1248.          with IOVars.Form[IOVars.CurrentForm]^ do
  1249.          begin
  1250.             if FieldLabel <> '' then
  1251.             begin
  1252.                if Hi then           {assign the display colors based on status}
  1253.                begin
  1254.                   N := Col[IOLabelHi];
  1255.                   H := Col[IOLabelHiHot];
  1256.                end else
  1257.                if Active = FldOn then
  1258.                begin
  1259.                   N := Col[IOLabelNorm];
  1260.                   H := Col[IOLabelNormHot];
  1261.                end else
  1262.                begin
  1263.                   N := Col[IOLabelOff];
  1264.                   H := Col[IOLabelOff];
  1265.                end;
  1266.                X := LabelXCoord(LabX,X1,FieldLabel);
  1267.                Y := LabelYCoord(LabY,Y1,FieldLabel);
  1268.                if X = 0 then
  1269.                   WriteRight(pred(X1),Y,N,strip('A',Himarker,FieldLabel))
  1270.                else
  1271.                   WriteHi(X,Y,H,N,FieldLabel);
  1272.             end;
  1273.          end;
  1274. end; { DisplayLabel }
  1275.  
  1276. procedure PaintForm;
  1277. {Displays fields, labels and background}
  1278. var Temp: WStructurePtr;
  1279. begin
  1280.    with IOVars.Form[IOVars.CurrentForm]^ do
  1281.    begin
  1282.       if WinNum <> 0 then
  1283.       begin
  1284.          Temp := WinPtr(WinNum);
  1285.          if (Temp <> nil) and not (Temp^.Painted) then
  1286.             WinPaint(WinNum);
  1287.          if WinNum = 1 then
  1288.             WinDrawAll;
  1289.          ShowNow := false;
  1290.          WinDisplay(WinNum);
  1291.       end;
  1292.       DisplayAllLabels;
  1293.       Displayed := true;
  1294.    end;
  1295. end; { PaintForm }
  1296.  
  1297. procedure DisplayAllFields;
  1298. var FNP: FieldNodePtr;
  1299. begin
  1300.     with IOVars.Form[IOVars.CurrentForm]^ do
  1301.     begin
  1302.        if not Displayed then
  1303.           PaintForm;
  1304.        FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  1305.        while FNP <> nil do
  1306.        begin
  1307.           if FNP^.FieldInfo^.MID = NoMID then  {not being used in Makeform}
  1308.              FNP^.FieldInfo^.RefreshFieldHook(FNP^.FieldInfo);
  1309.           case FNP^.FieldInfo^.Active of
  1310.              FldOff: FNP^.FieldInfo^.DisplayHook(FNP^.FieldInfo,OffStatus);
  1311.              FldOn: FNP^.FieldInfo^.DisplayHook(FNP^.FieldInfo,NormStatus);
  1312.           end; {case}
  1313.           FNP := FNP^.NextField;
  1314.        end;
  1315.     end; {with}
  1316. end; { DisplayAllFields }
  1317.  
  1318. procedure DisplayAllLabels;
  1319. var FNP: FieldNodePtr;
  1320. begin
  1321.    with IOVars.Form[IOVars.CurrentForm]^ do
  1322.    begin
  1323.       FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  1324.       while FNP <> nil do
  1325.       begin
  1326.          DisplayLabel(FNP,false);
  1327.          FNP := FNP^.NextField;
  1328.       end;
  1329.    end; {with}
  1330. end; { DisplayAllLabels }
  1331.  
  1332. procedure DisplayForm;
  1333. {}
  1334. begin
  1335.    PaintForm;
  1336.    DisplayAllFields;
  1337. end; { DisplayForm }
  1338.  
  1339. procedure UpdateVariables;
  1340. {}
  1341. var FNP: FieldNodePtr;
  1342. begin
  1343.    with IOVars.Form[IOVars.CurrentForm]^ do
  1344.    begin
  1345.       FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  1346.       while FNP <> nil do
  1347.       begin
  1348.          FNP^.FieldInfo^.UpdateVarHook(FNP^.FieldInfo);
  1349.          FNP := FNP^.NextField;
  1350.       end;
  1351.    end; {with}
  1352. end; { UpdateVariables }
  1353.  
  1354.                     {*********************************}
  1355.                     {**  Basic Variable Management  **}
  1356.                     {*********************************}
  1357.  
  1358. function VarToStr(FSP:FieldSettingsPtr):string;
  1359. {}
  1360. var Str: string;
  1361. begin
  1362.    if (FSP <> nil) then
  1363.    with FSP^ do
  1364.    begin
  1365.       case FieldType of
  1366.          IOString  : Str := SPtr^;
  1367.          IOByte    : if (FieldRules and SuppressZero = SuppressZero) and (BPtr^ = 0) then
  1368.                         Str := ''
  1369.                      else
  1370.                         Str := IntToStr(BPtr^);
  1371.          IOWord    : if (FieldRules and SuppressZero = SuppressZero) and (WPtr^ = 0) then
  1372.                         Str := ''
  1373.                      else
  1374.                         Str := IntToStr(WPtr^);
  1375.          IOInteger : if (FieldRules and SuppressZero = SuppressZero) and (IPtr^ = 0) then
  1376.                         Str := ''
  1377.                      else
  1378.                         Str := IntToStr(IPtr^);
  1379.          IOLongInt : if (FieldRules and SuppressZero = SuppressZero) and (LPtr^ = 0) then
  1380.                         Str := ''
  1381.                      else
  1382.                         Str := IntToStr(LPtr^);
  1383.          IODate    : if (FieldRules and SuppressZero = SuppressZero) and (DPtr^ = 0) then
  1384.                         Str := ''
  1385.                      else
  1386.                         Str := UnformattedDate(JulToStr(DPtr^,DFormat));
  1387.          IOReal    : if (FieldRules and SuppressZero = SuppressZero) and (RPtr^ = 0.0) then
  1388.                         Str := ''
  1389.                      else
  1390.                      begin
  1391.                         Str := RealToStr(RPtr^,RealDP);
  1392.                         if RealDP <> Floating then
  1393.                            delete(Str,LastPos('.',Str),1);
  1394.                      end;
  1395.       end; {case}
  1396.       VarToStr := Str;
  1397.    end;
  1398. end; { VarToStr }
  1399.  
  1400. function VarToString(FieldID:integer):String;
  1401. {}
  1402. var FSP: FieldNodePtr;
  1403. begin
  1404.    FSP := FieldPtr(FieldID);
  1405.    VarToString := VarToStr(FSP^.FieldInfo);
  1406.    SetCursor(FSP^.FieldInfo);
  1407. end; { VarToString }
  1408.  
  1409. procedure FieldRules(FieldID:integer;Rules:word;AChar:IOcharset;DChar:IOcharset);
  1410. {}
  1411. var FSP: FieldSettingsPtr;
  1412. begin
  1413.    FSP := FieldInfoPtr(FieldID);
  1414.    if (FSP <> nil) then
  1415.    with FSP^ do
  1416.    begin
  1417.       FieldRules := Rules;
  1418.       AllowChar := AChar;
  1419.       if (RealDP <> Floating) and (DChar = [#0])  and (FieldType = IOReal) then
  1420.          DisAllowChar := ['.']
  1421.       else
  1422.          DisallowChar := DChar;
  1423.       if (FieldType = IOReal)
  1424.       and (RealDP > 0)
  1425.       and (RealDP <> Floating) then
  1426.           FieldRules := FieldRules and RightJustify;
  1427.       FieldStr := VarToString(FieldID); {sets cursor and updates field string incase change to supress zero}
  1428.    end else
  1429.       IOSetError(5);       {invalid field ID}
  1430. end; {FieldRules}
  1431. {$IFOPT F-}
  1432.    {$DEFINE FOFF}
  1433.    {$F+}
  1434. {$ENDIF}
  1435.  
  1436. procedure BasicRefresh(FSP:FieldSettingsPtr);
  1437. {}
  1438. begin
  1439.    if (FSP <> nil) then
  1440.    with FSP^ do
  1441.    begin
  1442.       FieldStr := VarToStr(FSP);
  1443.       SetCursor(FSP);
  1444.    end;
  1445. end; { BasicRefresh }
  1446.  
  1447. procedure StrToVar(FSP:FieldSettingsPtr);
  1448. {Updates the variable attached to the field}
  1449. begin
  1450.    if (FSP <> nil) then
  1451.    with FSP^ do
  1452.    begin
  1453.       StrVars.SuppressErrors := true;
  1454.       case FieldType of
  1455.          IOString  : SPtr^ := FieldStr;
  1456.          IOByte    : BPtr^ := byte(StrtoInt(FieldStr));
  1457.          IOWord    : WPtr^ := word(StrtoInt(FieldStr));
  1458.          IOInteger : IPtr^ := StrtoInt(FieldStr);
  1459.          IOLongInt : LPtr^ := StrtoLong(FieldStr);
  1460.          IOReal    : with IOVars.Form[IOVars.CurrentForm]^ do
  1461.                       RPtr^ := StrtoReal(Strip('B',WhiteSpace,
  1462.                                PicFormat(FieldStr,FieldFmt,Whitespace,IsRule(FieldRules,RightJustify))));
  1463.          IODate    : If FieldStr = '' then
  1464.                         DPtr^ := 0
  1465.                      else
  1466.                         DPtr^ := StrtoJul(FieldStr,Dformat);
  1467.          IOOther   : if OMisc = IOString then
  1468.                         SPtr^ := FieldStr;
  1469.       end; {case}
  1470.       StrVars.SuppressErrors := false;
  1471.    end;   {with}
  1472. (* !! Why AM I DOING THIS
  1473.    SetCursor(FSP);
  1474. *)
  1475. end; {StrtoVar}
  1476. {$IFDEF FOFF}
  1477.    {$F-}
  1478.    {$UNDEF FOFF}
  1479. {$ENDIF}
  1480.  
  1481.                        {***************************}
  1482.                        {**  Basic Input Handler  **}
  1483.                        {***************************}
  1484.  
  1485. procedure EraseField(ID:byte);
  1486. {}
  1487. begin
  1488.    with ActiveForm^ do
  1489.    begin
  1490.       ActiveFieldPtr^.FieldInfo^.FieldStr := '';
  1491.       ActiveFieldPtr^.FieldInfo^.UpdateVarHook(ActiveFieldPtr^.FieldInfo);
  1492.       SetCursor(ActiveFieldPtr^.FieldInfo);
  1493.    end;
  1494. end; { EraseField }
  1495.  
  1496. procedure CursorRight;
  1497. {}
  1498. var RJ: boolean;
  1499. begin
  1500.    with ActiveForm^ do
  1501.       with ActiveFieldPtr^.FieldInfo^ do
  1502.       begin
  1503.          RJ := IsRule(FieldRules,RightJustify);
  1504.          if (RJ and (StrLocX < length(FieldStr)) and (StrLocX < FieldLen))
  1505.          or ((RJ=false) and (StrLocX <= length(FieldStr)) and (StrLocX < FieldLen)) then
  1506.          begin
  1507.             inc(StrLocX);
  1508.             repeat
  1509.                 inc(CursorX);
  1510.             until FieldFmt[CursorX + 1 - X1] in FmtChars;
  1511.          end;
  1512.          GotoXY(CursorX,Y1);
  1513.       end; {with}
  1514. end; { CursorRight }
  1515.  
  1516. procedure CursorLeft;
  1517. {}
  1518. begin
  1519.    with ActiveForm^ do
  1520.       with ActiveFieldPtr^.FieldInfo^ do
  1521.       begin
  1522.          if (StrLocX > 1)
  1523.          or (IsRule(FieldRules,RightJustify) and (StrLocX > 0) and (length(FieldStr) <> FieldLen)) then
  1524.          begin
  1525.             dec(StrLocX);
  1526.             repeat
  1527.                dec(CursorX);
  1528.             until FieldFmt[CursorX + 1 - X1] in FmtChars;
  1529.          end;
  1530.       end;  {with}
  1531. end;  { Cursorleft }
  1532.  
  1533. procedure CursorHome;
  1534. {}
  1535. var Counter1: byte;
  1536. begin
  1537.    with ActiveForm^ do
  1538.       with ActiveFieldPtr^.FieldInfo^ do
  1539.          repeat
  1540.             Counter1 := CursorX;
  1541.             CursorLeft;
  1542.          until Counter1 = CursorX;
  1543. end; { CursorHome }
  1544.  
  1545. procedure DeleteChar;
  1546. {}
  1547. var I: integer;
  1548. begin
  1549.    with ActiveForm^ do
  1550.       with ActiveFieldPtr^.FieldInfo^ do
  1551.       begin
  1552.          if StrLocX > 0 then
  1553.          begin
  1554.             delete(FieldStr,StrLocX,1);
  1555.             if IsRule(FieldRules,RightJustify) then
  1556.                dec(StrLocX);
  1557.          end;
  1558.       end;  {with}
  1559. end; { DeleteChar }
  1560.  
  1561. procedure FieldFullMessage;
  1562. {Display a FieldFull message}
  1563. begin
  1564.    Thunk;
  1565.    if ActiveForm^.FieldFullOn then
  1566.       PromptOK(IOvars.FieldFullTitle,IOvars.FieldFullMsg);
  1567. end; { FieldFullMessage }
  1568.  
  1569. procedure InsertCharacter(K : char);
  1570. {}
  1571. begin
  1572.    with ActiveForm^ do
  1573.      with ActiveFieldPtr^.FieldInfo^ do
  1574.      begin
  1575.         if (length(FieldStr) < FieldLen) then
  1576.         begin
  1577.            if IsRule(FieldRules,RightJustify) then
  1578.            begin
  1579.               inc(StrLocX);
  1580.               insert(K,FieldStr,StrLocX);
  1581.            end else
  1582.            begin
  1583.               insert(K,FieldStr,StrLocX);
  1584.               CursorRight;
  1585.            end;
  1586.         end else
  1587.         if (FieldLen = 1) then
  1588.            FieldStr := K
  1589.         else
  1590.            FieldFullMessage;
  1591.     end;
  1592. end;  { InsertCharacter }
  1593.  
  1594. procedure OverTypeCharacter(K : char);
  1595. {}
  1596. begin
  1597.    with ActiveForm^ do
  1598.       with ActiveFieldPtr^.FieldInfo^ do
  1599.       begin
  1600.          if (StrLocX = 0) and IsRule(FieldRules,RightJustify) then
  1601.          begin
  1602.             insert(K,FieldStr,StrLocX);
  1603.             inc(StrLocX);
  1604.          end else
  1605.          begin
  1606.             delete(FieldStr,StrLocX,1);
  1607.             insert(K,FieldStr,StrLocX);
  1608.             CursorRight;
  1609.          end;
  1610.       end;
  1611. end; { OverTypeCharacter }
  1612.  
  1613. procedure Backspaced;
  1614. {}
  1615. begin
  1616.    with ActiveForm^ do
  1617.       with ActiveFieldPtr^.FieldInfo^ do
  1618.       begin
  1619.          if StrLocX > 1 then
  1620.          begin
  1621.             if IsRule(FieldRules,RightJustify) then
  1622.             begin
  1623.                delete(FieldStr,pred(StrLocX),1);
  1624.                dec(StrLocX);
  1625.             end else
  1626.             begin
  1627.                CursorLeft;
  1628.                delete(FieldStr,StrLocX,1);
  1629.             end;
  1630.          end;
  1631.       end;
  1632. end;  { Backspaced }
  1633.  
  1634.                        {***************************}
  1635.                        {**  Basic Field Display  **}
  1636.                        {***************************}
  1637.  
  1638. procedure Hilight(FNP:FieldSettingsPtr);
  1639. {display cell in bright colors}
  1640. var Temp: StrScreen;
  1641.     L,P: byte;
  1642. begin
  1643.    if (FNP <> nil) then
  1644.       with FNP^ do
  1645.          with IOVars.Form[IOVars.CurrentForm]^ do
  1646.          begin
  1647.             Temp := PicFormat(FieldStr,FieldFmt,Whitespace,IsRule(FieldRules,RightJustify));
  1648.             if FirstCharPress
  1649.             and (length(FieldStr) <> 0)
  1650.             and IsRule(FieldRules,EraseDefault) then
  1651.             begin
  1652.                P := pos(WhiteSpace,Temp);
  1653.                if (P = 0) then
  1654.                   WriteAT(X1,Y1,Col[IOEditErase],Temp)
  1655.                else
  1656.                begin
  1657.                   if IsRule(FieldRules,RightJustify) then
  1658.                   begin
  1659.                      P := lastpos(WhiteSpace,Temp);
  1660.                      L := length(FieldFmt);
  1661.                      while (P < L) and not (FieldFmt[succ(P)] in FmtChars) do
  1662.                         inc(P);
  1663.                      WriteAT(X1,Y1,Col[IOEditHi],copy(Temp,1,P));
  1664.                      WriteAT(X1+P,Y1,Col[IOEditErase],copy(Temp,succ(P),80));
  1665.                   end else
  1666.                   begin
  1667.                      WriteAT(X1,Y1,Col[IOEditErase],copy(Temp,1,pred(P)));
  1668.                      WriteAT(X1+pred(P),Y1,Col[IOEditHi],copy(Temp,P,80));
  1669.                   end;
  1670.                end;
  1671.             end else
  1672.                WriteAT(X1,Y1,Col[IOEditHi],Temp);
  1673.          end;
  1674. end; { Hilight }
  1675.  
  1676. procedure LoLight(FNP:FieldSettingsPtr);
  1677. {display cell in dim colors}
  1678. var A: byte;
  1679. begin
  1680.    if (FNP <> nil) then
  1681.       with FNP^ do
  1682.          with IOVars.Form[IOVars.CurrentForm]^ do
  1683.          begin
  1684.             if FNP^.Active = FldOn then
  1685.                A := Col[IOEditNorm]
  1686.             else
  1687.                A := Col[IOEditOff];
  1688.             WriteAT(X1,Y1,A,PicFormat(FieldStr,FieldFmt,Whitespace,IsRule(FieldRules,RightJustify)));
  1689.          end;
  1690. end; { LoLight }
  1691.  
  1692. procedure ComputeStrLocX(LeftX,RightX:byte);
  1693. {Determines the value of StrLocX, based upon the value
  1694.  of CursorX}
  1695. var Temp: string;
  1696.     I,Counter: integer;
  1697. begin
  1698.    Counter := 0;
  1699.    with ActiveForm^ do
  1700.       with ActiveFieldPtr^.FieldInfo^ do
  1701.       begin
  1702.          if IsRule(FieldRules,RightJustify) then
  1703.          begin
  1704.             if CursorX = LeftX then
  1705.                StrLocX := 0
  1706.             else
  1707.             begin
  1708.                Temp := copy(FieldFmt,succ(CursorX-X1),255);
  1709.                for I := 1 to length(Temp) do
  1710.                   if Temp[I] in FmtChars then
  1711.                      inc(Counter);
  1712.                StrLocX := succ(length(FieldStr)-Counter);
  1713.             end;
  1714.          end else
  1715.          begin
  1716.             Temp := copy(FieldFmt,1,succ(RightX-LeftX));
  1717.             for I := 1 to succ(CursorX - X1) do
  1718.                if Temp[I] in FmtChars then
  1719.                   inc(Counter);
  1720.             StrLocX := Counter;
  1721.          end;
  1722.       end;
  1723. end; { ComputeStrLocX }
  1724.  
  1725. procedure MouseStretch;
  1726. {user has held mouse down - process the held-down key}
  1727. var L,C,R: boolean;
  1728.     LeftX,RightX,
  1729.     StartCursX,NewCursX,X,Y,P: byte;
  1730.     Temp:string;
  1731. begin
  1732.    with ActiveForm^ do
  1733.       with ActiveFieldPtr^.FieldInfo^ do
  1734.       begin
  1735.           StartCursX := 0;
  1736.           Temp := PicFormat(FieldStr,FieldFmt,Whitespace,IsRule(FieldRules,RightJustify));
  1737.           if IsRule(FieldRules,RightJustify) then
  1738.           begin
  1739.              P := lastpos(WhiteSpace,Temp);
  1740.              if P = 0 then
  1741.                 LeftX :=  X1
  1742.              else
  1743.                 LeftX := X1 + pred(P);
  1744.              RightX := X2;
  1745.           end else
  1746.           begin
  1747.              LeftX := X1;
  1748.              P := pos(WhiteSpace,Temp);
  1749.              if P = 0 then
  1750.                 RightX := X2
  1751.              else
  1752.                 RightX := pred(X1 + P);
  1753.           end;
  1754.           repeat
  1755.              MouseStatusWin(L,C,R,X,Y);
  1756.              if L and (Y = Y1) and (X >= X1) and (X <= X2) then
  1757.              begin
  1758.                 if (FieldFmt[succ(X - X1)] in FmtChars)
  1759.                 and (X >= LeftX)
  1760.                 and (X <= RightX) then
  1761.                 begin
  1762.                    NewCursX := X;
  1763.                    if StartCursX = 0 then
  1764.                       StartCursX := NewCursX;
  1765.                    gotoxy(NewCursX,Y1);
  1766.                    if (FirstCharPress) {and (NewCursX <> StartCursX)} then
  1767.                    begin  {clear the erase default setting}
  1768.                       FirstCharPress := false;
  1769.                       Hilight(ActiveFieldPtr^.FieldInfo);
  1770.                    end;
  1771.                    CursorX := NewCursX;
  1772.                 end;
  1773.              end;
  1774.           until not L;
  1775.           ComputeStrLocX(LeftX,RightX);
  1776.       end;
  1777. end; { MouseStretch }
  1778.  
  1779. {$IFOPT F-}
  1780.    {$DEFINE FOFF}
  1781.    {$F+}
  1782. {$ENDIF}
  1783.  
  1784. function BasicKeyHandler(InKey:word;X,Y:byte):gAction;
  1785. {Input handler used by the traditional TTT5 routines}
  1786. var K:char;
  1787. begin
  1788.    BasicKeyHandler := none;
  1789.    K := WordToChar(InKey);
  1790.    with ActiveForm^ do
  1791.       if  (ActiveFieldPtr^.FieldInfo^.AllowChar <> [#0])
  1792.       and (not (K in ActiveFieldPtr^.FieldInfo^.AllowChar)) then
  1793.       begin
  1794.           if K <> NoChar then
  1795.              Beep;
  1796.           exit;
  1797.       end;
  1798.    case Inkey of
  1799.       32..255 : begin
  1800.          with ActiveForm^ do
  1801.             with ActiveFieldPtr^.FieldInfo^ do
  1802.             begin
  1803.                 if FieldFmt[CursorX - X1 + 1] = '!' then
  1804.                    K := upcase(K);
  1805.                 if (
  1806.                      (AllowChar = [#0])
  1807.                      or ((AllowChar <> [#0]) and (K in AllowChar))
  1808.                    )
  1809.                 and
  1810.                    (
  1811.                      (DisAllowChar = [#0])
  1812.                      or ((DisAllowChar <> [#0]) and ((K in DisAllowChar)= false))
  1813.                    )
  1814.                 then
  1815.                 begin
  1816.                     if ((K in ['0'..'9','.','-','e','E']) and (FieldFmt[CursorX - X1 + 1] = '#'))
  1817.                     or (((K in ['a'..'z','A'..'Z',' ',',','.',';',':']) or (K in IntCharacters )) and
  1818.                                               (FieldFmt[CursorX - X1 + 1] = '@'))
  1819.                     or (FieldFmt[CursorX - X1 + 1] = '*')
  1820.                     or (FieldFmt[CursorX - X1 + 1] = '!') then
  1821.                     begin
  1822.                        if FirstCharPress then
  1823.                        begin
  1824.                           if IsRule(FieldRules,EraseDefault) then
  1825.                              EraseField(ActiveField);
  1826.                           FirstCharPress := false;
  1827.                        end;
  1828.                        if InsertMode then
  1829.                           InsertCharacter(K)
  1830.                        else
  1831.                           OverTypeCharacter(K);
  1832.                     end else
  1833.                        Beep;
  1834.                 end; {if}
  1835.             end;  {with}
  1836.       end;
  1837.       339: DeleteChar;
  1838.       331: CursorLeft;
  1839.       333: CursorRight;
  1840.       338: with ActiveForm^ do
  1841.            begin
  1842.               InsertMode := not InsertMode;
  1843.               InsertProc(InsertMode);
  1844.            end;
  1845.       327: CursorHome;
  1846.       335: with ActiveForm^ do
  1847.                SetCursor(ActiveFieldPtr^.FieldInfo);
  1848.       8  : Backspaced;
  1849.       500: MouseStretch;
  1850.       600..1000:; {don't beep}
  1851.       else
  1852.          Beep;
  1853.   end; {case}
  1854. end; { BasicKeyHandler }
  1855.  
  1856. procedure BasicDisplay(FNP:FieldSettingsPtr;Status:gStatus);
  1857. {Display routines used by the traditional TTT5 fields}
  1858. begin
  1859.    case Status of
  1860.       Activate,
  1861.       HiStatus: begin
  1862.          HiLight(FNP);
  1863.          with FNP^ do
  1864.             GotoXY(CursorX,Y1);
  1865.       end;
  1866.       NormStatus: LoLight(FNP);
  1867.       OffStatus: LoLight(FNP);
  1868.    end; {case}
  1869.    if (Status = Activate) and IsRule(FNP^.FieldRules,EraseDefault) then
  1870.    begin
  1871.       if IsRule(FNP^.FieldRules,RightJustify) then
  1872.          SetCursor(FNP)
  1873.       else
  1874.          CursorHome;
  1875.       with FNP^ do
  1876.          GotoXY(CursorX,Y1);
  1877.    end;
  1878. end; {BasicDisplay}
  1879. {$IFDEF FOFF}
  1880.    {$F-}
  1881.    {$UNDEF FOFF}
  1882. {$ENDIF}
  1883.  
  1884.                {*******************************************}
  1885.                {**  Basic Field Validation & Suspension  **}
  1886.                {*******************************************}
  1887.  
  1888. procedure InvalidMessage;
  1889. {Called when a non-numeric/out-of-range value is encountered}
  1890. begin
  1891.    Beep;
  1892.    PromptOK(IOvars.ValidationMsgTitle,IOvars.ValidationMsgNum);
  1893. end; { InvalidMessage }
  1894.  
  1895. procedure InvalidDateMessage(DateFormat:gDate);
  1896. {Called when an invalid date is entered}
  1897. var FmtStr: string[15];
  1898. begin
  1899.    Beep;
  1900.    case DateFormat of
  1901.       MMDDYY   : FmtStr := 'MM/DD/YY';
  1902.       MMDDYYYY : FmtStr := 'MM/DD/YYYY';
  1903.       MMYY     : FmtStr := 'MM/YY';
  1904.       MMYYYY   : FmtStr := 'MM/YYYY';
  1905.       DDMMYY   : FmtStr := 'DD/MM/YY';
  1906.       DDMMYYYY : FmtStr := 'DD/MM/YYYY';
  1907.       YYMMDD   : FmtStr := 'YY/MM/DD';
  1908.       YYYYMMDD : FmtStr := 'YYYY/MM/DD';
  1909.    end; {case}
  1910.    PromptOK(IOvars.ValidationMsgTitle,IOvars.ValidationMsgDate+FmtStr);
  1911. end; { InvalidDateMessage }
  1912.  
  1913. procedure OutOfRangeMessage(MinS,MaxS:StrScreen);
  1914. {Called when a number is entered outside accepForm range}
  1915. begin
  1916.    Beep;
  1917.    PromptOK(IOvars.ValidationMsgTitle,IOvars.ValidationMsgNumPart1+MinS+IOvars.ValidationMsgNumPart2+MaxS);
  1918. end; { OutOfRangeMessage }
  1919.  
  1920. procedure CannotBeEmptyMessage;
  1921. {}
  1922. begin
  1923.   PromptOK(IOvars.ValidationMsgTitle,IOvars.ValidationMsgEmpty);
  1924. end; { CannotBeEmptyMessage }
  1925.  
  1926. procedure ValidateField(FNP:FieldNodePtr; var gResult:byte);
  1927. {Called when a user switches from one field to another, or when
  1928.  the form is closed}
  1929. var VL: longint;
  1930.     VR: extended;
  1931.     ChV: char;
  1932.     RetCode: integer;
  1933.  
  1934.    procedure CheckNumber(Min,Max:longint; Len:byte; StrMax:string);
  1935.    {}
  1936.    begin
  1937.       with FNP^.FieldInfo^ do
  1938.       begin
  1939.          if (FieldStr = '') and IsRule(FieldRules,SuppressZero) then
  1940.          begin
  1941.             VL := 0;
  1942.             Retcode := 0;
  1943.          end else
  1944.             val(FieldStr,VL,Retcode);
  1945.          if Retcode <> 0 then
  1946.          begin
  1947.             InvalidMessage;
  1948.             gResult := NotValid;
  1949.          end else
  1950.          begin
  1951.              if (VL < Min)
  1952.              or (VL > Max)
  1953.              or ((length(FieldStr) > Len) and (FieldStr > StrMax)) then
  1954.              begin
  1955.                 OutOfRangeMessage(IntToStr(Min),IntToStr(Max));
  1956.                 gResult := NotValid;
  1957.              end else
  1958.                 gResult := valid;
  1959.          end;
  1960.       end;
  1961.    end; { CheckNumber }
  1962.  
  1963.    procedure CheckDate;
  1964.    {}
  1965.    begin
  1966.       with FNP^.FieldInfo^ do
  1967.       begin
  1968.          if not ValidDateStr(FieldStr,DFormat) then
  1969.          begin
  1970.             InvalidDateMessage(DFormat);
  1971.             gResult := NotValid;
  1972.          end else
  1973.          begin
  1974.             if (DMin <> 0) and (DMax <> 0) then
  1975.             begin
  1976.                VL := StrtoJul(FieldStr,DFormat);
  1977.                if (VL < DMin)
  1978.                or (VL > DMax) then
  1979.                begin
  1980.                   OutOfRangeMessage(JultoStr(DMin,DFormat),JultoStr(DMax,DFormat));
  1981.                   gResult := NotValid;
  1982.                end else
  1983.                   gResult := valid;
  1984.             end;
  1985.          end;
  1986.       end;
  1987.    end; { Checkdate }
  1988.  
  1989. begin
  1990.    gResult := Valid; {assume alls well}
  1991.    with FNP^.FieldInfo^ do
  1992.    begin
  1993.       if (FieldStr = '') and IsRule(FieldRules,AllowNull) then
  1994.          exit;
  1995.       case FieldType of
  1996.          IOString  : if FieldStr = '' then
  1997.                      begin
  1998.                         gResult := NotValid;
  1999.                         CannotBeEmptyMessage;
  2000.                      end;
  2001.          IOByte    : CheckNumber(BMin,BMax,2,'255');
  2002.          IOWord    : CheckNumber(WMin,WMax,4,'65535');
  2003.          IOInteger : CheckNumber(IMin,IMax,5,'32767');
  2004.          IOLongInt : CheckNumber(LMin,LMax,11,'2147483647');
  2005.          IODate    : CheckDate;
  2006.          IOReal    : begin
  2007.             with IOVars.Form[IOVars.CurrentForm]^ do
  2008.             val(Strip('B',WhiteSpace,
  2009.                       PicFormat(FieldStr,FieldFmt,Whitespace,IsRule(FieldRules,SuppressZero))),
  2010.                 VR,
  2011.                 Retcode);
  2012.             if Retcode <> 0 then
  2013.             begin
  2014.                InvalidMessage;
  2015.                gResult := NotValid;
  2016.             end else
  2017.             begin
  2018.                if (VR < RMin)
  2019.                or (VR > RMax) then
  2020.                begin
  2021.                   OutOfRangeMessage(RealToStr(RMin,RealDP),RealToStr(RMax,RealDP));
  2022.                   gResult := NotValid;
  2023.                end;
  2024.             end;
  2025.          end;
  2026.       end; {case}
  2027.    end;
  2028. end; { ValidateField }
  2029.  
  2030. {$IFOPT F-}
  2031.    {$DEFINE FOFF}
  2032.    {$F+}
  2033. {$ENDIF}
  2034.  
  2035. function BasicSuspend:boolean;
  2036. {Returns true if the input is valid -- used by the
  2037.  traditional TTT5 routines}
  2038. var ValidInput: byte;
  2039. begin
  2040.    ValidateField(ActiveForm^.ActiveFieldPtr,ValidInput);
  2041.    BasicSuspend := ValidInput = Valid;
  2042. end; { BasicSuspend }
  2043. {$IFDEF FOFF}
  2044.    {$F-}
  2045.    {$UNDEF FOFF}
  2046. {$ENDIF}
  2047.  
  2048.  
  2049. {$IFDEF TTT5}
  2050. procedure Create_Tables(No_Of_Tables:byte);
  2051. {}
  2052. begin
  2053.    CreateForms(No_Of_Tables);
  2054. end; { Create_Tables }
  2055.  
  2056. procedure Activate_Table(Table_No:byte);
  2057. {}
  2058. begin
  2059.    ActivateForm(Table_No);
  2060. end; { Activate_Table }
  2061.  
  2062. procedure Assign_LeaveFieldHook(Proc:MoveFieldProc);
  2063. {}
  2064. begin
  2065.    AssignLeaveFieldHook(Proc);
  2066. end; { Assign_LeaveFieldHook }
  2067.  
  2068. procedure Assign_EnterFieldHook(Proc:MoveFieldProc);
  2069. {}
  2070. begin
  2071.    AssignEnterFieldHook(Proc);
  2072. end; { Assign_EnterFieldHook }
  2073.  
  2074. procedure Assign_InsHook(Proc:InsProc);
  2075. {}
  2076. begin
  2077.    AssignInsHook(Proc);
  2078. end; { Assign_InsHook }
  2079.  
  2080. procedure Create_Fields(No_of_fields:byte);
  2081. {}
  2082. begin
  2083.    {abstract}
  2084. end; { Create_Fields }
  2085.  
  2086. procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  2087. {}
  2088. begin
  2089.    DefineColors(Cattr(HiF,HiB),Cattr(LoF,LoB),Cattr(MsgF,MsgB));
  2090. end; { Define_Colors }
  2091.  
  2092. procedure Add_Message(DefID,DefX,DefY:byte;DefString:string);
  2093. {}
  2094. begin
  2095.    SetMessage(DefID,DefX,DefY,DefString);
  2096. end; { Add_Message }
  2097.  
  2098. procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  2099. {}
  2100. begin
  2101.    AddField(DefID,DefU,DefD,DefL,DefR,DefX,DefY);
  2102. end; { Add_Field }
  2103.  
  2104. procedure String_Field(DefID:byte;var Strvar:String;DefFormat:string);
  2105. {}
  2106. begin
  2107.    StringField(DefID,Strvar,DefFormat);
  2108. end; { String_Field }
  2109.  
  2110. procedure Assign_Finish_Char(Ch:char);
  2111. {}
  2112. var WCh: word;
  2113. begin
  2114.    Wch := ord(Ch);
  2115.    AssignFinishChar(WCh);
  2116. end; { Assign_Finish_Char }
  2117.  
  2118. procedure Byte_Field(DefID:byte;var ByteVar:byte;DefFormat:string;Min,Max:byte);
  2119. {}
  2120. begin
  2121.    ByteField(DefID,ByteVar,DefFormat,Min,Max);
  2122. end; { Byte_Field }
  2123.  
  2124. procedure Word_Field(DefID:byte;var Wordvar:Word;DefFormat:string;Min,Max:word);
  2125. {}
  2126. begin
  2127.    WordField(DefID,Wordvar,DefFormat,Min,Max);
  2128. end; { Word_Field }
  2129.  
  2130. procedure Integer_Field(DefID:byte;var Integervar:Integer;DefFormat:string;Min,Max:integer);
  2131. {}
  2132. begin
  2133.    IntegerField(DefID,Integervar,DefFormat,Min,Max);
  2134. end; { Integer_Field }
  2135.  
  2136. procedure LongInt_Field(DefID:byte;var LongIntvar:longint;DefFormat:string;Min,Max:longint);
  2137. {}
  2138. begin
  2139.    LongIntField(DefID,LongIntvar,DefFormat,Min,Max);
  2140. end; { LongInt_Field }
  2141.  
  2142. procedure Date_Field(DefID:byte;var Datevar:Dates;DateFormat:gDate;DefFormat:string;
  2143.                       Min,Max : Dates);
  2144. {}
  2145. begin
  2146.    DateField(DefID,Datevar,DateFormat,DefFormat,Min,Max);
  2147. end; { Date_Field }
  2148.  
  2149. procedure Real_Field(DefID:byte;var Realvar:real;DefFormat:string;Min,Max:real);
  2150. {}
  2151. begin
  2152.    RealField(DefID,Realvar,DefFormat,Min,Max);
  2153. end; { Real_Field }
  2154.  
  2155. procedure Set_Default_Rules(Rules:word);
  2156. {}
  2157. begin
  2158.    SetDefaultRules(Rules);
  2159. end; { Set_Default_Rules }
  2160.  
  2161. procedure Field_Rules(DefID:byte;Rules:word;AChar:IOcharset;DChar:IOcharset);
  2162. {}
  2163. begin
  2164.    FieldRules(DefID,Rules,AChar,DChar);
  2165. end; { Field_Rules }
  2166.  
  2167. procedure Update_Variables;
  2168. {}
  2169. begin
  2170.    {abstract}
  2171. end; { Update_Variables }
  2172.  
  2173. procedure Display_All_Fields;
  2174. {}
  2175. begin
  2176.    DisplayAllFields;
  2177. end; { Display_All_Fields }
  2178.  
  2179. procedure Allow_Esc(OK:boolean);
  2180. {}
  2181. begin
  2182.    AllowEsc(OK);
  2183. end; { Allow_Esc }
  2184.  
  2185. procedure Allow_Beep(OK:boolean);
  2186. {}
  2187. begin
  2188.    {abstract}
  2189. end; { Allow_Beep }
  2190.  
  2191. procedure Init_Insert_Mode(ON:boolean);
  2192. {}
  2193. begin
  2194.    {abstract}
  2195. end; { Init_Insert_Mode }
  2196.  
  2197. procedure Dispose_Fields;
  2198. {}
  2199. begin
  2200.    DisposeFields;
  2201. end; { Dispose_Fields }
  2202.  
  2203. procedure Dispose_Tables;
  2204. {}
  2205. begin
  2206.    DisposeForms;
  2207. end; { Dispose_Tables }
  2208.  
  2209. procedure Process_Input(StartField:byte);
  2210. {}
  2211. begin
  2212.    ProcessInput(StartField);
  2213. end; { Process_Input }
  2214.  
  2215. {$ENDIF}
  2216.  
  2217.                         {*************************}
  2218.                         {**  Field Assignments  **}
  2219.                         {*************************}
  2220.  
  2221. procedure SetBasicHooks(FieldInfo:FieldSettingsPtr;SetCurs:boolean);
  2222. {}
  2223. begin
  2224.    if SetCurs then
  2225.       SetCursor(FieldInfo);
  2226.    with FieldInfo^ do
  2227.    begin
  2228.       ProcessKeyHook := BasicKeyHandler;
  2229.       SuspendHook := BasicSuspend;
  2230.       DisplayHook := BasicDisplay;
  2231.       UpdateVarHook := StrToVar;
  2232.       RefreshFieldHook := BasicRefresh;
  2233.       DisposeHook := BasicDisposeHook;
  2234.    end;
  2235. end; { SetBasicHooks }
  2236.  
  2237. procedure StringField(FieldID:integer; var Strvar:string; DefFormat:string);
  2238. {}
  2239. var FNP: FieldNodePtr;
  2240. begin
  2241.    FNP := FieldPtr(FieldID);
  2242.    if (FNP <> nil) then
  2243.       with FNP^.FieldInfo^ do
  2244.       begin
  2245.          FieldType     := IOString;
  2246.          SPtr          := @StrVar;
  2247.          FieldStr      := Sptr^;
  2248.          FieldFmt      := DefFormat;
  2249.          FieldLen      := MaxStringLength(FieldFmt);
  2250.          X2 := X1 + pred(length(FieldFmt));
  2251.          SetBasicHooks(FNP^.FieldInfo,true);
  2252.       end
  2253.    else
  2254.       IOSetError(1005);       {invalid field ID}
  2255. end; { StringField }
  2256.  
  2257. procedure ByteField(FieldID:integer;
  2258.                     var Bytevar:Byte;
  2259.                     DefFormat:string;
  2260.                     Min,Max : byte);
  2261. {}
  2262. var FNP: FieldNodePtr;
  2263. begin
  2264.    FNP := FieldPtr(FieldID);
  2265.    if (FNP <> nil) then
  2266.       with FNP^.FieldInfo^ do
  2267.       begin
  2268.          FieldType := IOByte;
  2269.          BPtr := @Bytevar;
  2270.          if DefFormat = '' then
  2271.             FieldFmt := '###'
  2272.          else
  2273.             FieldFmt := DefFormat;
  2274.          FieldStr := VarToString(FieldID);
  2275.          if (Max = 0) or (Max < Min) then
  2276.             BMax := 255
  2277.          else
  2278.             BMax := Max;
  2279.          if Min > BMax then
  2280.             BMin := 0
  2281.          else
  2282.             BMin := Min;
  2283.          FieldLen      := MaxStringLength(FieldFmt);
  2284.          X2 := X1 + pred(length(FieldFmt));
  2285.          SetBasicHooks(FNP^.FieldInfo,true);
  2286.     end;
  2287. end; { ByteField }
  2288.  
  2289. procedure WordField(FieldID:integer;
  2290.                      var Wordvar:Word;
  2291.                      DefFormat:string;
  2292.                      Min,Max : word);
  2293. {}
  2294. var FNP: FieldNodePtr;
  2295. begin
  2296.    FNP := FieldPtr(FieldID);
  2297.    if (FNP <> nil) then
  2298.       with FNP^.FieldInfo^ do
  2299.       begin
  2300.          FieldType := IOWord;
  2301.          WPtr := @WordVar;
  2302.          if DefFormat = '' then
  2303.             FieldFmt := '#####'
  2304.          else
  2305.             FieldFmt := DefFormat;
  2306.          FieldStr := VartoString(FieldID);
  2307.          if (Max = 0) or (Max < Min) then
  2308.              WMax := 65535
  2309.          else
  2310.             WMax := Max;
  2311.          if Min > WMax then
  2312.             WMin := 0
  2313.          else
  2314.             WMin := MIn;
  2315.          FieldLen := MaxStringLength(FieldFmt);
  2316.          X2 := X1 + pred(length(FieldFmt));
  2317.          SetBasicHooks(FNP^.FieldInfo,true);
  2318.     end;
  2319. end; { WordField }
  2320.  
  2321. procedure IntegerField(FieldID:integer;
  2322.                        var Integervar:Integer;
  2323.                        DefFormat:string;
  2324.                        Min,Max:Integer);
  2325. {}
  2326. var FNP: FieldNodePtr;
  2327. begin
  2328.    FNP := FieldPtr(FieldID);
  2329.    if (FNP <> nil) then
  2330.       with FNP^.FieldInfo^ do
  2331.       begin
  2332.          FieldType := IOInteger;
  2333.          IPtr := @IntegerVar;
  2334.          if DefFormat = '' then
  2335.             FieldFmt := '######'
  2336.          else
  2337.             FieldFmt := DefFormat;
  2338.          FieldStr := VartoString(FieldID);
  2339.          if (Max = 0) or (Max < Min) then
  2340.             IMax := 32767
  2341.          else
  2342.             IMax := Max;
  2343.          if ((Min = 0) and (Max = 0)) or (Min > WMax) then
  2344.             IMin := -32768
  2345.          else
  2346.             IMin := Min;
  2347.          FieldLen := MaxStringLength(FieldFmt);
  2348.          X2 := X1 + pred(length(FieldFmt));
  2349.          SetBasicHooks(FNP^.FieldInfo,true);
  2350.       end;
  2351. end; { IntegerField }
  2352.  
  2353. procedure LongIntField(FieldID:integer;
  2354.                        var LongIntvar:LongInt;
  2355.                        DefFormat:string;
  2356.                        Min,Max : LongInt);
  2357. {}
  2358. var FNP: FieldNodePtr;
  2359. begin
  2360.    FNP := FieldPtr(FieldID);
  2361.    if (FNP <> nil) then
  2362.       with FNP^.FieldInfo^ do
  2363.       begin
  2364.          FieldType := IOLongInt;
  2365.          LPtr          := @LongIntVar;
  2366.          if DefFormat = '' then
  2367.             FieldFmt := '###########'
  2368.          else
  2369.             FieldFmt := DefFormat;
  2370.          FieldStr      := VartoString(FieldID);
  2371.          if (max = 0) or (Max < Min) then
  2372.             LMax := 2147483647
  2373.          else
  2374.             LMax := Max;
  2375.          if ((Min = 0) and (Max = 0)) or (Min > LMax) then
  2376.             LMin := -2147483647
  2377.          else
  2378.             LMin := Min;
  2379.          FieldLen      := MaxStringLength(FieldFmt);
  2380.          X2 := X1 + pred(length(FieldFmt));
  2381.          SetBasicHooks(FNP^.FieldInfo,true);
  2382.        end;
  2383. end; { LongIntField }
  2384.  
  2385. function GetDateFormatStr(DateFormat:gDate):string;
  2386. {}
  2387. var FieldFmt: string;
  2388. begin
  2389.    case DateFormat of
  2390.       DDMMYY,
  2391.       MMDDYY,
  2392.       YYMMDD   : FieldFmt := '##'+DateVars.dSeparator+'##'+DateVars.dSeparator+'##';
  2393.       MMYY     : FIeldFmt := '##'+DateVars.dSeparator+'##';
  2394.       MMYYYY   : FieldFmt := '##'+DateVars.dSeparator+'####';
  2395.       DDMMYYYY,
  2396.       MMDDYYYY : FieldFmt := '##'+DateVars.dSeparator+'##'+DateVars.dSeparator+'####';
  2397.       YYYYMMDD : FieldFmt := '####'+DateVars.dSeparator+'##'+DateVars.dSeparator+'##';
  2398.    end; {case}
  2399.    GetDateFormatStr := FieldFmt;
  2400. end; { GetDateFormatStr }
  2401.  
  2402. procedure DateField(FieldID:integer;
  2403.                      var Datevar:Dates;
  2404.                      DateFormat:gDate;
  2405.                      DefFormat:string;
  2406.                      Min,Max : Dates);
  2407. {}
  2408. var FNP: FieldNodePtr;
  2409. begin
  2410.    FNP := FieldPtr(FieldID);
  2411.    if (FNP <> nil) then
  2412.       with FNP^.FieldInfo^ do
  2413.       begin
  2414.          FieldType := IODate;
  2415.          SPtr := @DateVar;
  2416.          if DateVar = 0 then
  2417.             FieldStr := ''
  2418.          else
  2419.             FieldStr := Unformatteddate(JultoStr(DateVar,DateFormat));
  2420.          if DefFormat = '' then
  2421.             FieldFmt := GetDateFormatStr(DateFormat)
  2422.          else
  2423.             FieldFmt := DefFormat;
  2424.          if (Max = 0) or (Max < Min) then
  2425.             DMax := 0
  2426.          else
  2427.             DMax := Max;
  2428.          if Min > WMax then
  2429.             DMin := 0
  2430.          else
  2431.             DMin := Min;
  2432.          DFormat := DateFormat;
  2433.          FieldLen := MaxStringLength(FieldFmt);
  2434.          X2 := X1 + pred(length(FieldFmt));
  2435.          SetBasicHooks(FNP^.FieldInfo,true);
  2436.       end;
  2437. end; { DateField }
  2438.  
  2439. procedure RealField(FieldID:integer;
  2440.                      var Realvar:extended;
  2441.                      DefFormat:string;
  2442.                      Min,Max : extended);
  2443. {}
  2444. var FNP: FieldNodePtr;
  2445.     P : byte;
  2446. begin
  2447.    FNP := FieldPtr(FieldID);
  2448.    if (FNP <> nil) then
  2449.       with FNP^.FieldInfo^ do
  2450.       begin
  2451.          FieldType := IOReal;
  2452.          RPtr          := @RealVar;
  2453.          if DefFormat = '' then
  2454.             FieldFmt := '############'
  2455.          else
  2456.             FieldFmt := DefFormat;
  2457.          P := LastPos('.',FieldFmt);
  2458.          if P = 0 then
  2459.             RealDP  := Floating
  2460.          else
  2461.          begin
  2462.             RealDP := Length(FieldFmt) - P;
  2463.             if RealDP = 0 then
  2464.                delete(FieldFmt,P,1);            {remove the end decimal place}
  2465.          end;
  2466.          RMax := Max;
  2467.          RMin := Min;
  2468.          if RealDP <> Floating then
  2469.          begin
  2470.             DisAllowChar := ['.'];
  2471.             if (RealDP <> 0) then
  2472.                FieldRules := FieldRules and RightJustify; {force right justify}
  2473.          end;
  2474.          FieldStr := VartoString(FieldID);
  2475.          FieldLen := MaxStringLength(FieldFmt);
  2476.          X2 := X1 + pred(length(FieldFmt));
  2477.          SetBasicHooks(FNP^.FieldInfo,true);
  2478.      end;
  2479. end; { RealField }
  2480.  
  2481.                           {*********************}
  2482.                           {**  Process Input  **}
  2483.                           {*********************}
  2484.  
  2485. function OnTarget(FNP:FieldNodePtr; X,Y:word):boolean;
  2486. {Do the XY coords fall within the specified field}
  2487. var Hit: boolean;
  2488.     XL,L:byte;
  2489. begin
  2490.    if FNP = nil then
  2491.       Hit := false
  2492.    else
  2493.       with FNP^.FieldInfo^ do
  2494.       begin
  2495.          Hit := (X >= X1)
  2496.                  and ( ((X <= X2) and (Y >= Y1) and (Y <= Y2))
  2497.                  or ((X <= X2 + IconWidth) and (Y = Y1)));
  2498.          if not Hit
  2499.          and (FieldLabel <> '')
  2500.          and (Y=LabelYCoord(LabY,Y1,FieldLabel)) then
  2501.          begin
  2502.             XL := LabelXCoord(LabX,X1,FieldLabel);
  2503.             L := length(strip('A',Himarker,FieldLabel));
  2504.             if XL = 0 then
  2505.                Hit := (X >= 1) and (X <= L)
  2506.             else
  2507.                Hit := (X >= XL) and (X < XL + L);
  2508.          end;
  2509.       end;
  2510.       OnTarget := Hit;
  2511. end; { OnTarget }
  2512.  
  2513. function FieldHit(X,Y:word; CheckActive:boolean):word;
  2514. {Determines if the coordinates fall on a specific field - if not
  2515.  a zero is returned}
  2516. var FNP: FieldNodePtr;
  2517.     Counter: integer;
  2518. begin
  2519.    with ActiveForm^ do
  2520.    begin
  2521.       if OnTarget(ActiveFieldPtr,X,Y) then
  2522.          FieldHit := ActiveField
  2523.       else
  2524.       begin
  2525.          FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  2526.          Counter := 1;
  2527.          while FNP <> nil do
  2528.          begin
  2529.             if OnTarget(FNP,X,Y)
  2530.             and (FNP^.FieldInfo^.Visible or (FNP^.FieldInfo^.HotKey = 500))
  2531.             and ( (CheckActive = false)
  2532.                   or (FNP^.FieldInfo^.Active = FldOn)
  2533.                 ) then
  2534.             begin
  2535.                FieldHit := Counter;
  2536.                exit;
  2537.             end else
  2538.             begin
  2539.                FNP := FNP^.NextField;
  2540.                inc(Counter);
  2541.             end;
  2542.          end;
  2543.          FieldHit := 0;
  2544.       end;
  2545.    end;
  2546. end; { FieldHit }
  2547.  
  2548. procedure DisplayMessage(FSP:FieldSettingsPtr;var Msg:string);
  2549. {}
  2550. var L: byte;
  2551. begin
  2552.    with ActiveForm^ do
  2553.    with FSP^ do
  2554.    begin
  2555.       if Msg <> '' then
  2556.       begin
  2557.          if (MsgX = 0) and (MsgY = 0) then
  2558.          begin
  2559.             MsgLastX := ActiveForm^.MsgX;
  2560.             MsgLastY := ActiveForm^.MsgY;
  2561.          end else
  2562.          begin
  2563.             MsgLastX := MsgX;
  2564.             MsgLastY := MsgY;
  2565.          end;
  2566.          L := length(Msg);
  2567.          if MsgLastX = 0 then   {Center the message}
  2568.          begin
  2569.             if L >= VideoTarget.Width then
  2570.                MsgLastX := 1
  2571.             else
  2572.                MsgLastX := (VideoTarget.Width - L) div 2;
  2573.          end;
  2574.          if MsgLastX < 1 then
  2575.             MsgLastX := 1;
  2576.          if (MsgLastY < 1) or (MsgLastY > HardVars.Depth) then
  2577.             MsgLastY := HardVars.Depth;
  2578.          with VideoTarget do
  2579.             if WindowActive and MsgRestrict then
  2580.                PartSave(MsgLastX+pred(WX1),MsgLastY+pred(WY1),MsgLastX+pred(WX1)+L,MsgLastY+pred(WY1),OldLine)
  2581.             else if MsgRestrict or (VideoTarget.TargetType <> WinTarget) then
  2582.                PartSave(MsgLastX,MsgLastY,MsgLastX+pred(WX1)+L,MsgLastY,OldLine);
  2583.          if not MsgRestrict and (VideoTarget.TargetType = WinTarget) then
  2584.          begin
  2585.             ActivateBackground;
  2586.             PartSave(MsgLastX,MsgLastY,MsgLastX+L,MsgLastY,OldLine);
  2587.             WriteAT(MsgLastX,MsgLastY,
  2588.                     IOVars.Form[IOVars.CurrentForm]^.Col[IOMessage],Msg);
  2589.             WinDrawAll;
  2590.             ActivateTopWindow;
  2591.          end else
  2592.             WriteAT(MsgLastX,MsgLastY,
  2593.                     IOVars.Form[IOVars.CurrentForm]^.Col[IOMessage],Msg);
  2594.          MsgLastL := L;
  2595.       end;
  2596.    end;
  2597. end; { DisplayMessage }
  2598.  
  2599. procedure RemoveMessage(FSP:FieldSettingsPtr);
  2600. var I,LocC: integer;
  2601. begin
  2602.    with ActiveForm^ do
  2603.    with FSP^ do
  2604.       if (MsgLastL > 0) then
  2605.       begin
  2606.          with VideoTarget do
  2607.          if WindowActive and MsgRestrict then
  2608.             PartRestore(MsgLastX+pred(WX1),MsgLastY+pred(WY1),pred(MsgLastX+MsgLastL)+pred(WX1),
  2609.                         MsgLastY+pred(WY1),OldLine)
  2610.          else if not MsgRestrict and (VideoTarget.TargetType = WinTarget) then
  2611.          begin
  2612.             ActivateBackground;
  2613.             PartRestore(MsgLastX,MsgLastY,pred(MsgLastX+MsgLastL),MsgLastY,OldLine);
  2614.             WinDrawAll;
  2615.             ActivateTopWindow;
  2616.          end else
  2617.             PartRestore(MsgLastX,MsgLastY,pred(MsgLastX+MsgLastL),MsgLastY,OldLine);
  2618.          MsgLastL := 0;
  2619.      end;
  2620. end; { RemoveMessage }
  2621.  
  2622. procedure CallIOHelp(CField:integer);
  2623. {Sets the help record and calls the general help function}
  2624. var Helpdata: HelpRecord;
  2625. begin
  2626.    with HelpData do
  2627.    begin
  2628.       Context := ContextIO + IOVars.CurrentForm;
  2629.       ID := CField;
  2630.       HelpLong := ActiveForm^.PreviousField;
  2631.    end;
  2632.    CallForHelp(ContextIO,HelpData);
  2633. end; { CallIOHelp }
  2634.  
  2635.                          {************************}
  2636.                          {**  Input Management  **}
  2637.                          {************************}
  2638. procedure CheckRefreshState(Refresh:byte; HiLightActiveFld:boolean);
  2639. {}
  2640. var FNP: FieldNodePtr;
  2641.     I: integer;
  2642. begin
  2643.    with ActiveForm^ do
  2644.    case Refresh of
  2645.       RefreshNone : ; {do nothing}
  2646.       RefreshCurrent: begin
  2647.          ActiveFieldPtr^.FieldInfo^.RefreshFieldHook(ActiveFieldPtr^.FieldInfo);
  2648.          if ActiveFieldPtr^.FieldInfo^.Active <> FldHidden then
  2649.             ActiveFieldPtr^.FieldInfo^.DisplayHook(ActiveFieldPtr^.FieldInfo,HiStatus);
  2650.       end;
  2651.       RefreshAll: begin
  2652.          DisplayAllFields;
  2653.          DisplayAllLabels;
  2654.          if HiLightActiveFld and (ActiveFieldPtr^.FieldInfo^.Active <> FldHidden) then
  2655.             ActiveFieldPtr^.FieldInfo^.DisplayHook(ActiveFieldPtr^.FieldInfo,HiStatus);
  2656.       end;
  2657.       RefreshOthers: begin
  2658.          with IOVars.Form[IOVars.CurrentForm]^ do
  2659.          begin
  2660.             FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  2661.             while FNP <> nil do
  2662.             begin
  2663.                if FNP^.FieldInfo^.ID <> ActiveField then
  2664.                begin
  2665.                   FNP^.FieldInfo^.RefreshFieldHook(FNP^.FieldInfo);
  2666.                   case FNP^.FieldInfo^.Active of
  2667.                     FldOff: FNP^.FieldInfo^.DisplayHook(FNP^.FieldInfo,OffStatus);
  2668.                     FldOn: FNP^.FieldInfo^.DisplayHook(FNP^.FieldInfo,NormStatus);
  2669.                   end; {case}
  2670.                end;
  2671.                FNP := FNP^.NextField;
  2672.             end;
  2673.             Displayed := true;
  2674.          end; {with}
  2675.       end;
  2676.       EndInput : begin
  2677.          DisplayAllFields;
  2678.          TInputFinished := true;
  2679.          ActiveForm^.LastAction := Finished;
  2680.       end;
  2681.    end; {case}
  2682. end; { CheckRefreshState }
  2683.  
  2684. function NextFieldID(Direction:byte): byte;
  2685. {Returns the ID of the next *ACTIVE* and *VISIBLE* field in the
  2686.  direction specified}
  2687. var StartFNP,
  2688.    FNP: FieldNodePtr;
  2689.    Counter: integer;
  2690. begin
  2691.    with ActiveForm^ do
  2692.    begin
  2693.       case Direction of
  2694.          1: begin
  2695.             if ActiveFieldPtr^.FieldInfo^.UpField = IDLastField then
  2696.                FNP := FieldPtr(TotalFields)
  2697.             else
  2698.                FNP := FieldPtr(ActiveFieldPtr^.FieldInfo^.UpField);
  2699.          end;
  2700.          2: FNP := FieldPtr(ActiveFieldPtr^.FieldInfo^.DownField);
  2701.          3: begin
  2702.             if ActiveFieldPtr^.FieldInfo^.LeftField = IDLastField then
  2703.                FNP := FieldPtr(TotalFields)
  2704.             else
  2705.                FNP := FieldPtr(ActiveFieldPtr^.FieldInfo^.LeftField);
  2706.          end;
  2707.          4: FNP := FieldPtr(ActiveFieldPtr^.FieldInfo^.RightField);
  2708.       end;
  2709.       StartFNP := nil;
  2710.       Counter := 1;
  2711.       while (FNP <> nil)
  2712.       and (FNP <> StartFNP)
  2713.       and (FNP^.FieldInfo <> nil)
  2714.       and ( (FNP^.FieldInfo^.Active <> FldOn)
  2715.             or
  2716.             (FNP^.FieldInfo^.Visible = false)
  2717.           )
  2718.       and (Counter <= 250) do {just in case it might loop forever}
  2719.       begin
  2720.          inc(Counter);
  2721.          if StartFNP = nil then
  2722.             StartFNP := FNP;
  2723.          case Direction of
  2724.             1: FNP := FieldPtr(FNP^.FieldInfo^.UpField);
  2725.             2: FNP := FieldPtr(FNP^.FieldInfo^.DownField);
  2726.             3: FNP := FieldPtr(FNP^.FieldInfo^.LeftField);
  2727.             4: FNP := FieldPtr(FNP^.FieldInfo^.RightField);
  2728.          end;
  2729.       end;
  2730.       if (FNP = nil) or (FNP^.FieldInfo = nil) then
  2731.          NextFieldID := 1
  2732.       else
  2733.          NextFieldID := FNP^.FieldInfo^.ID;
  2734.    end;
  2735. end; { NextFieldID }
  2736.  
  2737. procedure ChangeFields(ID:byte; Direction:byte);
  2738. {}
  2739. var LastField,
  2740.    CF,
  2741.    CField: byte;
  2742.    Refresh: byte;
  2743.    TempID: integer;
  2744.    FNP: FieldNodePtr;
  2745. begin
  2746.     with ActiveForm^ do
  2747.     begin
  2748.        if (ValState = ValidateByField)
  2749.        and (not (LastAction in [Cancel1..Escaped])) then
  2750.           if not ActiveFieldPtr^.FieldInfo^.SuspendHook then
  2751.               exit; {leave the user in the same field}
  2752.        ActiveFieldPtr^.FieldInfo^.UpdateVarHook(ActiveFieldPtr^.FieldInfo);
  2753.        ActiveFieldPtr^.FieldInfo^.DisplayHook(ActiveFieldPtr^.FieldInfo,NormStatus);
  2754.        DisplayLabel(ActiveFieldPtr,false);
  2755.        if ActiveFieldPtr^.FieldInfo^.MsgX <= 80 then
  2756.           RemoveMessage(ActiveFieldPtr^.FieldInfo);
  2757.        {Now call the "leave field" hook}
  2758.        CField := FieldNumber(ActiveFieldPtr);
  2759.        CF := CField;
  2760.        LastField := CField;
  2761.        Refresh := RefreshNone;
  2762.        LeaveFieldHook(CField,Refresh);
  2763.        if CField = 0 then
  2764.           ID := CF
  2765.        else
  2766.        begin
  2767.            if (CField <> CF)
  2768.            and (FieldPtr(CField)^.FieldInfo^.Active = FldOn)  then
  2769.               ID := CField; {user wants to go to a specific field}
  2770.            ActiveFieldPtr^.FieldInfo^.FirstCharPress := false;
  2771.        end;
  2772.        CheckRefreshState(Refresh,false);
  2773.        if TInputFinished then
  2774.           exit;
  2775.        if ID = 0 then
  2776.            TInputFinished := true
  2777.        else
  2778.        begin
  2779.           CField := ID;
  2780.           if CField > TotalFields then
  2781.              CField := TotalFields;
  2782.           {Enter Field Hook}
  2783.           repeat
  2784.              ActiveField := CField;
  2785.              Refresh := RefreshNone;
  2786.              EnterFieldHook(CField,Refresh);
  2787.              if (ActiveField <> CField)
  2788.              and (FieldPtr(CField)^.FieldInfo^.Active <> FldOn) then {try to change to inactive field}
  2789.                  CField := ActiveField;
  2790.              CheckRefreshState(Refresh,true);
  2791.              if TInputFinished then exit;
  2792.           until CField = ActiveField;
  2793.           if (ActiveField < 1)
  2794.           or (ActiveField > TotalFields) then
  2795.               exit;
  2796.           ActiveFieldPtr := FieldPtr(ActiveField);
  2797.           {make sure a hook hasn't disabled the field getting focus}
  2798.           if (ActiveFieldPtr^.FieldInfo^.Active <> FldOn)
  2799.             or
  2800.             (ActiveFieldPtr^.FieldInfo^.Visible = false) then
  2801.             ActiveFieldPtr := FieldPtr(NextFieldID(Direction));
  2802.           {time to highlight the field getting focus}
  2803.           ActiveFieldPtr^.FieldInfo^.FirstCharPress := true;
  2804.           ActiveFieldPtr^.FieldInfo^.DisplayHook(ActiveFieldPtr^.FieldInfo,Activate);
  2805.           DisplayLabel(ActiveFieldPtr,true);
  2806.           if ActiveFieldPtr^.FieldInfo^.MsgX <= 80 then
  2807.              DisplayMessage(ActiveFieldPtr^.FieldInfo,ActiveFieldPtr^.FieldInfo^.Message);
  2808.        end;  {if}
  2809.        {set lastfield in case help is pressed}
  2810.        if LastField <> ActiveField then {a field change occurred}
  2811.           PreviousField := LastField;
  2812.        {Now check the default button status}
  2813.        if  (DefaultButtonID <> 0)
  2814.        and (ActiveFieldPtr^.FieldInfo^.ID <> DefaultButtonID) then
  2815.        begin
  2816.           FNP := FieldPtr(DefaultButtonID);
  2817.           if  (FNP <> nil)
  2818.           and (ActiveFieldPtr^.FieldInfo^.FieldType = IOOther)
  2819.           and (ActiveFieldPtr^.FieldInfo^.DataSize = ButtonMarker)
  2820.           and (ActiveFieldPtr^.FieldInfo^.DataPtr = nil) then {another button active}
  2821.           begin
  2822.               TempID := DefaultButtonID;
  2823.               DefaultButtonID := 0;    {trick default button into displaying like standard button}
  2824.               FNP^.FieldInfo^.DisplayHook(FNP^.FieldInfo,NormStatus);
  2825.               DefaultButtonID := TempID;
  2826.           end else
  2827.               FNP^.FieldInfo^.DisplayHook(FNP^.FieldInfo,NormStatus);
  2828.        end;
  2829.    end; {with ActiveForm}
  2830. end;  { ChangeFields }
  2831.  
  2832. procedure FinishInput;
  2833. {}
  2834. var OldActiveField,
  2835.     FNP: FieldNodePtr;
  2836.     BadField: byte;
  2837.     StartingFocus: byte;
  2838. begin
  2839.    with ActiveForm^ do
  2840.    begin
  2841.       if ValState = ValidateByField then
  2842.       begin
  2843.          if ActiveFieldPtr^.FieldInfo^.SuspendHook then
  2844.          begin
  2845.             ActiveFieldPtr^.FieldInfo^.UpdateVarHook(ActiveFieldPtr^.FieldInfo);
  2846.             TInputFinished := true;
  2847.          end;
  2848.       end else  {check that all fields have valid data}
  2849.       begin
  2850.          OldActiveField := ActiveFieldPtr;
  2851.          StartingFocus := ActiveField;
  2852.          FNP := FirstField;
  2853.          while FNP <> nil do
  2854.          begin
  2855.             ActiveFieldPtr := FNP;
  2856.             ActiveField := FNP^.FieldInfo^.ID;
  2857.             if (FNP^.FieldInfo^.Active <> FldOn) or (FNP^.FieldInfo^.SuspendHook) then
  2858.                FNP := FNP^.NextField
  2859.             else {validation error}
  2860.             begin
  2861.                ActiveFieldPtr := OldActiveField;
  2862.                ActiveField := ActiveFieldPtr^.FieldInfo^.ID;
  2863.                ChangeFields(FNP^.FieldInfo^.ID,0);
  2864.                exit;
  2865.             end;
  2866.          end;
  2867.          ActiveField := StartingFocus;
  2868.          TInputFinished := true;
  2869.       end;
  2870.       if TInputFinished then  {call user-supplied finish hook}
  2871.       begin
  2872.          BadField := FinishedHook;
  2873.          if BadField <> 0 then
  2874.          begin
  2875.             TInputFinished := false;
  2876.             ChangeFields(BadField,0);
  2877.          end;
  2878.       end;
  2879.    end;
  2880. end; { FinishInput }
  2881.  
  2882.  
  2883. function HotkeyPressed(var Key:word; var NewFieldID:byte): gAction;
  2884. {}
  2885. var FNP: FieldNodePtr;
  2886.    Counter: integer;
  2887.    RetCode: gAction;
  2888. begin
  2889.    RetCode := None;
  2890.    {first check if it is a hotkey is the active field -- this
  2891.     allows radio buttons et al to use the same hotkeys for
  2892.     similar items in different "fields"}
  2893.    FNP := IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr;
  2894.    if FNP^.FieldInfo^.HotKeyHook(FNP^.FieldInfo,Key,RetCode) then
  2895.       NewFieldID := IOVars.Form[IOVars.CurrentForm]^.ActiveField
  2896.    else
  2897.    begin
  2898.       FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  2899.       Counter := 1;
  2900.       while FNP <> nil do
  2901.       begin
  2902.          if  (Counter <> IOVars.Form[IOVars.CurrentForm]^.ActiveField)
  2903.          and (FNP^.FieldInfo^.Active = FldOn)
  2904.          and FNP^.FieldInfo^.HotKeyHook(FNP^.FieldInfo,Key,RetCode) then
  2905.          begin
  2906.             NewFieldID := Counter;
  2907.             HotKeyPressed := RetCode;
  2908.             exit;
  2909.          end else
  2910.          begin
  2911.             FNP := FNP^.NextField;
  2912.             inc(Counter);
  2913.          end;
  2914.       end;
  2915.    end;
  2916.    HotKeyPressed := RetCode;
  2917. end; { HotkeyPressed }
  2918.  
  2919. function ActionKey(WKey:word):boolean;
  2920. {}
  2921. var   FNP: FieldNodePtr;
  2922. begin
  2923.    ActionKey := true;
  2924.    with ActiveForm^ do
  2925.    begin
  2926.       if WKey = ActionChars.FinishChar then
  2927.          FinishInput
  2928.       else if (WKey = 13)
  2929.            and (DefaultButtonID <> 0)
  2930.            and (ActiveFieldPtr^.FieldInfo^.UsesEnter = false) then
  2931.       begin
  2932.           FNP := FieldPtr(DefaultButtonID);
  2933.           if (FNP = nil) then
  2934.              ActionKey := false
  2935.           else
  2936.           begin
  2937.              LastAction := gAction(FNP^.FieldInfo^.OMisc);
  2938.              if LastAction in [Cancel1..Escaped] then
  2939.              begin
  2940.                 ActiveFieldPtr^.FieldInfo^.UpdateVarHook(ActiveFieldPtr^.FieldInfo);
  2941.                 TInputFinished := true;
  2942.              end else
  2943.                 FinishInput;
  2944.           end;
  2945.       end else
  2946.       if WKey = ActionChars.EscChar then
  2947.       begin
  2948.          TInputFinished := true;
  2949.          LastAction := Escaped;
  2950.       end else
  2951.       if WKey = ActionChars.NextChar then
  2952.          ChangeFields(NextFieldID(4),4)
  2953.       else if WKey = ActionChars.PrevChar then
  2954.          ChangeFields(NextFieldID(3),3)
  2955.       else if WKey = ActionChars.RightChar then
  2956.          ChangeFields(NextFieldID(4),4)
  2957.       else if WKey = ActionChars.LeftChar then
  2958.          ChangeFields(NextFieldID(3),3)
  2959.       else if WKey = ActionChars.EraseChar then
  2960.          EraseField(ActiveField)
  2961.       else if WKey = KeyVars.HelpKey then
  2962.          CallIOHelp(ActiveField)
  2963.       else if not ActiveFieldPtr^.FieldInfo^.UsesCursors
  2964.       and (WKey = ActionChars.UpChar) then
  2965.          ChangeFields(NextFieldID(1),1)
  2966.       else if not ActiveFieldPtr^.FieldInfo^.UsesCursors
  2967.       and (WKey = ActionChars.DownChar) then
  2968.          ChangeFields(NextFieldID(2),2)
  2969.       else
  2970.          ActionKey := false;
  2971.    end;
  2972. end; { ActionKey }
  2973.  
  2974. procedure Activity(Wait:boolean);
  2975. {}
  2976. var Wkey: word;
  2977.    K : char;
  2978.    ReturnStr: string;
  2979.    PriorCursorX : byte;
  2980.    ValidInput : byte;
  2981.    OldField : byte;
  2982.    CField : byte;
  2983.    LK:word;
  2984.    LX,LY:byte;
  2985.  
  2986.    procedure CheckAction;
  2987.    {}
  2988.    begin
  2989.       with ActiveForm^ do
  2990.       case LastAction of
  2991.          Cancel1..
  2992.          Escaped : TInputFinished := true;
  2993.          Finished,
  2994.          Stop1..Stop99 : if ActiveForm^.ValidateOnStop then
  2995.               FinishInput
  2996.             else
  2997.               TInputFinished := true;
  2998.          Help: CallIOhelp(CField);
  2999.          NextField: CField := NextFieldID(4);
  3000.          PrevField: CField := NextFieldID(3);
  3001.       end; {case}
  3002.    end; { CheckAction }
  3003.  
  3004. begin   {Activity}
  3005.    OldField := ActiveForm^.ActiveField;
  3006.    if (ActiveForm^.WinNum <> 0) then
  3007.       WinDrawTop;
  3008.    if Wait then
  3009.       GetInput;
  3010.    with KeyVars do
  3011.    begin
  3012.       LK := LastKey;
  3013.       LX:= LastX;
  3014.       LY := LastY;
  3015.    end;
  3016.    if (ActiveForm^.WinNum <> 0) then
  3017.    begin
  3018.       if IsWinKey(LK,LX,LY) then
  3019.          WinProcessKey(LK,LX,LY)
  3020.       else
  3021.       begin
  3022.          LX := WinLocalX(ActiveForm^.WinNum,LX);
  3023.          LY := WinLocalY(ActiveForm^.WinNum,LY);
  3024.       end;
  3025.    end;
  3026.    WKey := LK;
  3027.    {now the character hook}
  3028.    with ActiveForm^ do
  3029.    begin
  3030.       CField := OldField;
  3031.       TRefresh := RefreshNone;
  3032.       CharHook(WKey,CField,TRefresh);
  3033.       CheckRefreshState(TRefresh,true);
  3034.       if (CField <> ActiveField)
  3035.       and (FieldPtr(CField)^.FieldInfo^.Active = FldOn)  then
  3036.          ChangeFields(CField,2); {user wants to go to a specific field}
  3037.       {Check to see if user presses left mouse button on another field}
  3038.       if WKey = 500 then
  3039.       begin
  3040.          CField := FieldHit(LX,LY,true);
  3041.          if CField = 0 then
  3042.          begin
  3043.             if not OnTarget(ActiveForm^.ActiveFieldPtr,LX,LY) then
  3044.                MouseRelease;  {clicked off a field}
  3045.          end
  3046.          else if FieldPtr(CField)^.FieldInfo^.HotKey = 500 then {hotspot}
  3047.          begin
  3048.             LastAction := gAction(FieldPtr(CField)^.FieldInfo^.OMisc);
  3049.             WKey := 0;
  3050.             CheckAction;
  3051.          end
  3052.          else if (CField <> ActiveField) then
  3053.          begin
  3054.             ChangeFields(CField,2);
  3055.             (*
  3056.             MouseRelease;
  3057.             *)
  3058.          end;
  3059.       end else
  3060.       begin
  3061.          LastAction := HotKeyPressed(WKey,CField);
  3062.          CheckAction;
  3063.          if (CField <> 0)
  3064.          and (CField <> ActiveField)
  3065.          and( not (LastAction in [Finished,Stop1..Stop99])
  3066.          or (TInputFinished <> false)) then
  3067.             ChangeFields(CField,2);
  3068.       end;
  3069.       K := WordToChar(WKey);
  3070.       if WKey <> 0 then
  3071.       begin
  3072.          if not ActionKey(WKey) then
  3073.          begin
  3074.             if Wkey = 600 then
  3075.             begin
  3076.                if ActiveForm^.AllowEsc then
  3077.                begin
  3078.                   TInputFinished := true;
  3079.                   ActiveForm^.LastAction := Escaped;
  3080.                end;
  3081.             end else
  3082.             begin
  3083.                LastAction := ActiveFieldPtr^.FieldInfo^.ProcessKeyHook(WKey,LX,LY);
  3084.                ActiveFieldPtr^.FieldInfo^.UpdateVarHook(ActiveFieldPtr^.FieldInfo);
  3085.                CheckAction;
  3086.             end;
  3087.          end;
  3088.       end;
  3089.       if ActiveFieldPtr^.FieldInfo^.FirstCharPress
  3090.       and (Wkey < 500)
  3091.       and (Wkey > 0)
  3092.       and (ActiveField = OldField) then
  3093.          ActiveFieldPtr^.FieldInfo^.FirstCharPress := false;
  3094.       if not TInputFinished then
  3095.       begin
  3096.          ActiveFieldPtr^.FieldInfo^.DisplayHook(ActiveFieldPtr^.FieldInfo,HiStatus);
  3097.          with ActiveFieldPtr^.FieldInfo^ do
  3098.          begin
  3099.             if  (FirstCharPress = false)
  3100.             and IsRule(FieldRules,JumpifFull)
  3101.             and (StrLocX = FieldLen)
  3102.             and (Length(FieldStr) = FieldLen)
  3103.             and (InsertMode)
  3104.             and (K in [#32..#255]) then
  3105.                 ChangeFields(NextFieldID(4),4);
  3106.           end;
  3107.       end;
  3108.       IOVars.IChar := K;
  3109.       HindHook(ActiveField,TRefresh);
  3110.       CheckRefreshState(TRefresh,true);
  3111.    end; {with ActiveForm}
  3112. end; { Activity }
  3113.  
  3114. procedure CheckFieldTypes;
  3115. {Ensures that all added fields have non-zero field types, i.e. each
  3116.  AddField had a corresponding xxxField}
  3117. var FNP: FieldNodePtr;
  3118. begin
  3119.    FNP := IOVars.Form[IOVars.CurrentForm]^.FirstField;
  3120.    while (FNP <> nil) do
  3121.    begin
  3122.       if (FNP^.FieldInfo^.FieldType = 0)
  3123.       and (FNP^.FieldInfo^.HotKey <> 500) then
  3124.       begin
  3125.          clrscr;
  3126.          writeln('FieldID: ',FNP^.FieldInfo^.ID);
  3127.          IOSetError(1004);
  3128.       end;
  3129.       FNP := FNP^.NextField;
  3130.    end;
  3131. end; { CheckFieldTypes }
  3132.  
  3133. procedure PrepareforInput(StartField:byte);
  3134. {INTERNAL}
  3135. begin
  3136. {$IFDEF CHECK}
  3137.     CheckFieldTypes;
  3138. {$ENDIF}
  3139.     ActiveForm := IOVars.Form[IOVars.CurrentForm];
  3140.     with ActiveForm^ do
  3141.     begin
  3142.        if Displayed = false then
  3143.           DisplayForm;
  3144.        if not (StartField in [1..TotalFields]) then
  3145.           StartField := 1;
  3146.        ActiveField := StartField;
  3147.        ActiveFieldPtr := FieldPtr(ActiveField);
  3148.        ActiveFieldPtr^.FieldInfo^.FirstCharPress := true;
  3149.        LastAction := none;
  3150.        {Enter Field Hook}
  3151.        TSField := StartField;
  3152.        TInputFinished := false;
  3153.        repeat
  3154.           ActiveField := TSField;
  3155.           TSRefresh := RefreshNone;
  3156.           EnterFieldHook(TSField,TSRefresh);
  3157.           CheckRefreshState(TSRefresh,true);
  3158.           if TInputFinished then
  3159.              exit;
  3160.        until TSField = ActiveField;
  3161.        ActiveFieldPtr := FieldPtr(ActiveField);
  3162.        ActiveFieldPtr^.FieldInfo^.FirstCharPress := true;
  3163.        ActiveFieldPtr^.FieldInfo^.DisplayHook(ActiveFieldPtr^.FieldInfo,Activate);
  3164.        DisplayLabel(ActiveFieldPtr,true);
  3165.        if ActiveFieldPtr^.FieldInfo^.MsgX <= 80 then
  3166.           DisplayMessage(ActiveFieldPtr^.FieldInfo,ActiveFieldPtr^.FieldInfo^.Message);
  3167.        InsertProc(InsertMode);
  3168.        HindHook(0,TRefresh);   {pass a field of zero to indicate first time through}
  3169.        CheckRefreshState(TRefresh,true);
  3170.    end;
  3171. end; {PrepareforInput}
  3172.  
  3173. procedure ProcessInput(StartField:byte);
  3174. {}
  3175. begin
  3176.     PrepareforInput(StartField);
  3177.     ActiveForm := IOVars.Form[IOVars.CurrentForm];
  3178.     with ActiveForm^ do
  3179.     begin
  3180.        if not TInputFinished then
  3181.           repeat
  3182.              Activity(true);
  3183.           until TInputFinished;
  3184.        if ActiveFieldPtr^.FieldInfo^.MsgX <= 80 then
  3185.           RemoveMessage(ActiveFieldPtr^.FieldInfo);
  3186.    end;
  3187. end; { ProcessInput }
  3188.  
  3189. function EditForm(StartField:byte):gAction;
  3190. {}
  3191. begin
  3192.    ProcessInput(StartField);
  3193.    EditForm := IOVars.Form[IOVars.CurrentForm]^.LastAction;
  3194. end; { EditForm }
  3195.  
  3196.                           {************************}
  3197.                           {**  Desktop Routines  **}
  3198.                           {************************}
  3199. function FormWithFocus: byte;
  3200. {}
  3201. var
  3202.    TopWinNum: byte;
  3203.    Temp: WStructurePtr;
  3204.    I: integer;
  3205. begin
  3206.    Temp := WinPtr(0);
  3207.    TopWinNum := Temp^.WinNum; {number of the top win}
  3208.    for I := 1 to MaxForms do
  3209.       if (IOVars.Form[I] <> nil)
  3210.       and (IOVars.Form[I]^.WinNum = TopWinNum) then
  3211.       begin
  3212.          FormWithFocus := I;
  3213.          exit;
  3214.       end;
  3215.    FormWithFocus := 0;
  3216. end; {FormWithFocus}
  3217.  
  3218. {$IFOPT F-}
  3219.    {$DEFINE FOFF}
  3220.    {$F+}
  3221. {$ENDIF}
  3222. procedure IOProcessKeyOnDesktop;
  3223. {}
  3224. var
  3225.   TopForm: byte;
  3226. begin
  3227.    {set the active Form}
  3228.    TopForm := FormWithFocus;
  3229.    if TopForm <> 0 then
  3230.    begin
  3231.       ActivateForm(TopForm);
  3232.       with ActiveForm^ do
  3233.       begin
  3234.          Activity(false);
  3235.          if TInputFinished then
  3236.          begin
  3237.             if ActiveForm^.DeskFormCloseCallBack(FormWithFocus) then
  3238.                DisposeFormWin
  3239.             else
  3240.                TInputFinished := false;
  3241.          end;
  3242.       end;
  3243.    end;
  3244. end; { IOProcessKeyOnDesktop }
  3245.  
  3246. function FormCloseHandler(Handle: integer):boolean;
  3247. {}
  3248. var
  3249.    WinP: WStructurePtr;
  3250. begin
  3251.    WinP := WinPtr(Handle);
  3252.    FormCloseHandler := ActiveForm^.DeskFormCloseCallBack(FormWithFocus);
  3253.    DisposeFormWin;
  3254.    WinDispose(Handle);
  3255. end; {FormCloseHandler}
  3256.  
  3257. procedure FormFocusHandler(Handle: integer);
  3258. {}
  3259. var
  3260.    WinP: WStructurePtr;
  3261. begin
  3262.    WinP := WinPtr(Handle);
  3263.    ActivateForm(longint(Winp^.UserData));
  3264. end; {FormFocusHandler}
  3265.  
  3266. {$IFDEF FOFF}
  3267.    {$F-}
  3268.    {$UNDEF FOFF}
  3269. {$ENDIF}
  3270.  
  3271. function LaunchFormInit(X1,Y1,X2,Y2,style:byte;CloseProc:FormCloseProc): byte;
  3272. {}
  3273. var
  3274.    OldTopWin,NewTopWin: byte;
  3275.    WinP: WStructurePtr;
  3276. begin
  3277.    WinFadeTopWin;
  3278.    OldTopWin := WinWithFocus;
  3279.    SetFormWindow(X1,Y1,X2,Y2,style);
  3280.    NewTopWin := IOVars.Form[IOVars.CurrentForm]^.WinNum;
  3281.    if NewTopWin <> 0 then
  3282.    begin
  3283.       WinP := WinPtr(NewTopWin);
  3284.       WinP^.ProcessKeyProc := IOProcessKeyOnDeskTop;
  3285.       WinP^.CloseWinProc := FormCloseHandler;
  3286.       WinP^.ChangeFocusProc := FormFocusHandler;
  3287.       ActiveForm^.DeskFormCloseCallBack := CloseProc;
  3288.       longint(WinP^.UserData) := IOVars.CurrentForm;
  3289.    end;
  3290.    LaunchFormInit := NewTopWin;
  3291. end; {LaunchFormInit}
  3292.  
  3293. procedure LaunchForm(StartField:byte);
  3294. {}
  3295. begin
  3296.    PrepareforInput(StartField);
  3297. end; {LaunchForm}
  3298.  
  3299.               {*********************************************}
  3300.               {**  U N I T   I N I T I A L I Z A T I O N  **}
  3301.               {*********************************************}
  3302.  
  3303. procedure IODefaultSettings;
  3304. {}
  3305. begin
  3306.    with IOVars do
  3307.    begin
  3308.       WhiteSpace := #250;
  3309.       AllowEsc := true;
  3310.       FieldFullOn := true;
  3311.       DefaultRules := AllowNull+EraseDefault;
  3312.       TotalForms := 0;
  3313.       UsingPrivateForm := false;
  3314.       EMsgFunc := IoEMsg;
  3315.       with ActionChars do
  3316.       begin
  3317.          NextChar := 9;
  3318.          PrevChar := 271;
  3319.          FinishChar := 324;
  3320.          EscChar := 27;
  3321.          UpChar := 328;
  3322.          DownChar := 336;
  3323.          LeftChar := 411;         {Ctrl-Left}
  3324.          RightChar := 413;        {Ctrl-Right}
  3325.          EraseChar := 5;          {Ctrl-E}
  3326.       end;
  3327.       DefaultValidate := ValidatebyField;
  3328.       ValidationMsgTitle := ' Validation Error ';
  3329.       ValidationMsgNum := 'Invalid number - make correction!';
  3330.       ValidationMsgDate := 'Date Error: format is ';
  3331.       ValidationMsgNumPart1 := 'Error value must be in the range ';
  3332.       ValidationMsgNumPart2 := ' to ';
  3333.       ValidationMsgEmpty := 'This field cannot be empty!';
  3334.       FieldFullTitle := ' Field Full ';
  3335.       FieldFullMsg := 'The field is full. Press Ins to change to overtype|mode or delete some characters.';
  3336.       end; {with}
  3337. end; { IODefaultSettings }
  3338.  
  3339. procedure GoldIOInit;
  3340. {}
  3341. var I: integer;
  3342. begin
  3343.    with IOVars do
  3344.    begin
  3345.       for I := 1 to MaxForms do
  3346.          IOVars.Form[I] := nil;
  3347.       IODefaultSettings;
  3348.    end;
  3349. end; { GoldIOInit }
  3350.  
  3351. begin
  3352.    GoldIOInit;
  3353. end.
  3354.