home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOT_2.ZIP / DEMO.EXE / arc / DEMIO22.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-11  |  10.7 KB  |  422 lines
  1. program DemoIOTwentyTwo;
  2. {demIO22 - This example illustrates how you could use the
  3.  Toolkit to develop a two-screen input form}
  4.  
  5. Uses DOS, CRT,
  6.      totFAST, totREAL, totIO1, totIO2, totSTR, totDATE, totMSG;
  7.  
  8. Const
  9.    MsgX=25;
  10.    MsgY=19;
  11.  
  12. Type
  13. RecordInfo = record
  14.    FirstLast: string[40];
  15.    Company: string[40];
  16.    Addr1: string[40];
  17.    Addr2: string[40];
  18.    City: string[25];
  19.    State: string[20];
  20.    Zip: string[9];
  21.    Country: string[30];
  22.    Tel: string[20];
  23.    OrderDate: longint;
  24.    OrderQuantity: word;
  25.    UnitPrice: extended;
  26.    OtherGarbage: array[1..5] of string[40];
  27. end;
  28.  
  29. var
  30.   ActivePage:shortint;
  31.   ActiveRecord: RecordInfo;
  32.   Result: tAction;
  33.   {Now the input fields}
  34.   UpKey,DownKey,PgDnKey,PgUpKey,F1key: HotkeyIOOBJ;
  35.   Page1But, Page2But, OKBut, CancelBut, HelpBut: Strip3DIOOBJ;
  36.   FirstLastField,
  37.   CompanyField,
  38.   Addr1Field,
  39.   Addr2Field,
  40.   CityField,
  41.   StateField,
  42.   CountryField,
  43.   Field2A,Field2B,Field2C,Field2D,Field2E: StringIOOBJ;
  44.   ZipField,
  45.   TelField: PictureIOOBJ;
  46.   OrderDateField: DateIOOBJ;
  47.   OrderQuantityField: IntIOOBJ;
  48.   UnitPriceField: FixedRealIOOBJ;
  49.   Controlkeys: ControlKeysIOOBJ;
  50.   Page1,Page2: FormOBJ;
  51.  
  52. {$F+}
  53. procedure ContexturalHelp(ID:word);
  54. {A not too helpful help window!}
  55. var HelpTxt:  MessageOBJ;
  56. begin
  57.    with HelpTxt do
  58.    begin
  59.       Init(1,' Help ');
  60.       AddLine('');
  61.       Addline(' You need help!!  It''s going ');
  62.       Addline(' to be a long day. Just press ');
  63.       if (ID in [101..104]) or (ID = HelpID) then
  64.       begin
  65.          Addline('enter to select the button, ');
  66.          Addline('or TAB to change fields. ');
  67.       end
  68.       else
  69.       begin
  70.          Addline(' the keys and enter the');
  71.          case ID of
  72.            1: AddLine(' Customer''s name. ');
  73.            2: AddLine(' Company name. ');
  74.            3,4: AddLine(' Company''s street address. ');
  75.            5: AddLine(' Company''s City. ');
  76.            6: AddLine(' Company''s State. ');
  77.            7: AddLine(' Company''s Zip. ');
  78.            8: AddLine(' Company''s country details. ');
  79.            9: AddLine(' telephone number. ');
  80.           10: AddLine(' order date. ');
  81.           11: AddLine(' order quantity. ');
  82.           12: AddLine(' unit price. ');
  83.           21: AddLine(' A data! ');
  84.           22: AddLine(' B data! ');
  85.           23: AddLine(' C data! ');
  86.           24: AddLine(' D data! ');
  87.           25: AddLine(' E data! ');
  88.           else AddLine('something!');
  89.          end; {Case}
  90.       end;
  91.       AddLine('');
  92.       Show;
  93.       Done;
  94.    end;
  95. end; {ContexturalHelp}
  96. {$F-}
  97.  
  98. procedure RecordToForm;
  99. {Updates the form objects with the contents of the record}
  100. begin
  101.    with ActiveRecord do
  102.    begin
  103.       FirstLastField.SetValue(FirstLast);
  104.       CompanyField.SetValue(Company);
  105.       Addr1Field.SetValue(Addr1);
  106.       Addr2Field.SetValue(Addr2);
  107.       CityField.SetValue(City);
  108.       StateField.SetValue(State);
  109.       CountryField.SetValue(Country);
  110.       ZipField.SetValue(Zip);
  111.       TelField.SetValue(Tel);
  112.       OrderDateField.SetValue(OrderDate);
  113.       OrderQuantityField.SetValue(OrderQuantity);
  114.       UnitPriceField.SetValue(UnitPrice);
  115.       Field2A.SetValue(OtherGarbage[1]);
  116.       Field2B.SetValue(OtherGarbage[2]);
  117.       Field2C.SetValue(OtherGarbage[3]);
  118.       Field2D.SetValue(OtherGarbage[4]);
  119.       Field2E.SetValue(OtherGarbage[5]);
  120.    end;
  121. end; {RecordToForm}
  122.  
  123. procedure FormToRecord;
  124. {Updates the record with the values entered into the form}
  125. begin
  126.    with ActiveRecord do
  127.    begin
  128.       Firstlast := FirstLastField.GetValue;
  129.       Company := CompanyField.GetValue;
  130.       Addr1 := Addr1Field.GetValue;
  131.       Addr2 := Addr2Field.GetValue;
  132.       City := CityField.GetValue;
  133.       State := StateField.GetValue;
  134.       Country := CountryField.GetValue;
  135.       Zip := ZipField.GetValue;
  136.       Tel := TelField.GetValue;
  137.       OrderDate := OrderDateField.GetValue;
  138.       OrderQuantity := OrderQuantityField.GetValue;
  139.       UnitPrice := UnitPriceField.GetValue;
  140.       OtherGarbage[1] := Field2A.GetValue;
  141.       OtherGarbage[2] := Field2B.GetValue;
  142.       OtherGarbage[3] := Field2C.GetValue;
  143.       OtherGarbage[4] := Field2D.GetValue;
  144.       OtherGarbage[5] := Field2E.GetValue;
  145.    end;
  146. end; {FormToRecord}
  147.  
  148. procedure InitFields;
  149. {Initializes all of the field objects}
  150. begin
  151.    F1Key.Init(315,help);
  152.    PgDnKey.Init(337,Stop2);
  153.    PgUpKey.Init(329,Stop3);
  154.    UpKey.Init(328,PrevField);
  155.    DownKey.Init(336,NextField);
  156.    with Page1But do
  157.    begin
  158.      Init(10,23,'  Page ~1~   ',Stop1);
  159.      SetID(101);
  160.      SetHotkey(376);
  161.      SetMessage(MsgX,MsgY,'Edit page one data');
  162.    end;
  163.    with Page2But do
  164.    begin
  165.      Init(10,23,'  Page ~2~   ',Stop1);
  166.      SetID(102);
  167.      SetHotkey(377);
  168.      SetMessage(MsgX,MsgY,'Edit page two data');
  169.    end;
  170.    with OKBut do
  171.    begin
  172.      Init(25,23,'    ~O~K    ',Finished);
  173.      SetID(103);
  174.      SetHotkey(280);
  175.      SetMessage(MsgX,MsgY,'Save input to database');
  176.    end;
  177.    with CancelBut do
  178.    begin
  179.      Init(40,23,'  ~C~ancel  ',Escaped);
  180.      SetID(104);
  181.      SetHotkey(302);
  182.      SetMessage(MsgX,MsgY,'Abort and go home');
  183.    end;
  184.    with HelpBut do
  185.    begin
  186.      Init(55,23,'   ~H~elp   ',Help);
  187.      SetID(HelpID);
  188.      SetHotkey(291);
  189.      SetMessage(MsgX,MsgY,'Seek further guidance from the machine!');
  190.    end;
  191.    with FirstLastField do
  192.    begin
  193.      Init(25,4,40);
  194.      SetID(1);
  195.      SetForceCase(true);
  196.      SetCase(Upper);
  197.      SetLabel('Customer Name');
  198.      SetMessage(MsgX,MsgY,'Name in FIRST M. LAST format');
  199.    end;
  200.    with CompanyField do
  201.    begin
  202.      Init(25,5,40);
  203.      SetID(2);
  204.      SetLabel('Company');
  205.      SetMessage(MsgX,MsgY,'Enter the FULL company name');
  206.    end;
  207.    with Addr1Field do
  208.    begin
  209.      Init(25,6,40);
  210.      SetID(3);
  211.      SetLabel('Address');
  212.      SetMessage(MsgX,MsgY,'Street address only no PO BOXES!');
  213.    end;
  214.    with Addr2Field do
  215.    begin
  216.      Init(25,7,40);
  217.      SetID(4);
  218.      SetMessage(MsgX,MsgY,'Add second line if necessary.');
  219.    end;
  220.    with CityField do
  221.    begin
  222.      Init(25,8,25);
  223.      SetID(5);
  224.      SetLabel('City');
  225.      SetMessage(MsgX,MsgY,'Enter the City name');
  226.    end;
  227.    with StateField do
  228.    begin
  229.      Init(25,9,20);
  230.      SetID(6);
  231.      SetForceCase(true);
  232.      SetCase(Upper);
  233.      SetLabel('State');
  234.      SetMessage(MsgX,MsgY,'Enter the State, Province or County');
  235.    end;
  236.    with ZipField do
  237.    begin
  238.      Init(55,9,'#####-####');
  239.      SetID(7);
  240.      SetLabel('Zip');
  241.      SetMessage(MsgX,MsgY,'Enter the 9 digit ZIP or postal code');
  242.    end; 
  243.    with CountryField do
  244.    begin
  245.      Init(25,10,30);
  246.      SetID(8);
  247.      SetForceCase(true);
  248.      SetCase(Upper);
  249.      SetLabel('Country');
  250.      SetMessage(MsgX,MsgY,'Leave empty for USA customers');
  251.    end;
  252.    with TelField do
  253.    begin
  254.      Init(25,12,'(###) ###-####');
  255.      SetID(9);
  256.      SetLabel('Telephone');
  257.      SetMessage(MsgX,MsgY,'Leave empty for international customers');
  258.    end;
  259.    with OrderDateField do
  260.    begin
  261.      Init(25,14,MMDDYY);
  262.      SetID(10);
  263.      SetLabel('Order date');
  264.      SetRules(EraseDefault+AllowNull);
  265.      SetMessage(MsgX,MsgY,'Enter date in format MM/DD/YY');
  266.    end;
  267.    with OrderQuantityField do
  268.    begin
  269.      Init(45,14,2);
  270.           SetID(11);
  271.      SetMinMax(1,15);
  272.      SetLabel('Quantity');
  273.      SetRules(EraseDefault+AllowNull);
  274.      SetMessage(MsgX,MsgY,'Enter number of units ordered');
  275.    end;
  276.    with UnitPriceField do
  277.    begin
  278.      Init(59,14,3,2);
  279.      SetID(12);
  280.      SetMinMax(10.0,499.99);
  281.      SetLabel('Price');
  282.      SetRules(EraseDefault+AllowNull);
  283.      SetMessage(MsgX,MsgY,'Enter price per item');
  284.    end;
  285.    with Field2A do
  286.    begin
  287.      Init(25,4,40);
  288.      SetID(21);
  289.      SetLabel('Field A');
  290.      SetMessage(MsgX,MsgY,'Enter the Field A data');
  291.    end;
  292.    with Field2B do
  293.    begin
  294.      Init(25,7,40);
  295.      SetID(22);
  296.      SetLabel('Field B');
  297.      SetMessage(MsgX,MsgY,'Enter the Field B data');
  298.    end;
  299.    with Field2C do
  300.    begin
  301.      Init(25,10,40);
  302.      SetID(23);
  303.      SetLabel('Field C');
  304.      SetMessage(MsgX,MsgY,'Enter the Field C data');
  305.    end;
  306.    with Field2D do
  307.    begin
  308.      Init(25,13,40);
  309.      SetID(24);
  310.      SetLabel('Field D');
  311.      SetMessage(MsgX,MsgY,'Enter the Field D data');
  312.    end;
  313.    with Field2E do
  314.    begin
  315.      Init(25,16,40);
  316.      SetID(25);
  317.      SetLabel('Field E');
  318.      SetMessage(MsgX,MsgY,'Enter the Field E data');
  319.    end;
  320.    Controlkeys.Init;
  321.    with Page1 do
  322.    begin
  323.      Init;
  324.      AddItem(Controlkeys);
  325.      AddItem(F1Key);
  326.      AddItem(PgDnkey);
  327.      AddItem(Upkey);
  328.      AddItem(Downkey);
  329.      AddItem(FirstLastField);
  330.      AddItem(CompanyField);
  331.      AddItem(Addr1Field);
  332.      AddItem(Addr2Field);
  333.      AddItem(CityField);
  334.      AddItem(StateField);
  335.      AddItem(ZipField);
  336.      AddItem(CountryField);
  337.      AddItem(TelField);
  338.      AddItem(OrderDateField);
  339.      AddItem(OrderQuantityField);
  340.      AddItem(UnitPriceField);
  341.      AddItem(Page2But);
  342.      AddItem(OKBut);
  343.      AddItem(CancelBut);
  344.      AddItem(HelpBut);
  345.      SetHelpHook(ContexturalHelp);
  346.    end;
  347.    with Page2 do
  348.    begin
  349.       Init;
  350.       AddItem(Controlkeys);
  351.       AddItem(PgUpKey);
  352.       AddItem(UpKey);
  353.       AddItem(DownKey);
  354.       AddItem(F1Key);
  355.       AddItem(Field2A);
  356.       AddItem(Field2B);
  357.       AddItem(Field2C);
  358.       AddItem(Field2D);
  359.       AddItem(Field2E);
  360.       AddItem(Page1But);
  361.       AddItem(OKBut);
  362.       AddItem(CancelBut);
  363.       AddItem(HelpBut);
  364.       SetHelpHook(ContexturalHelp);
  365.     end;
  366. end; {InitFields}
  367.  
  368. procedure SetUpScreen;
  369. {}
  370. begin
  371.    with Screen do
  372.    begin
  373.       {use the color settings used in the IO for}
  374.       TitledBox(1,1,80,21,
  375.                 IOTOT^.LabelCol(3),
  376.                 IOTOT^.LabelCol(4),
  377.                 IOTOT^.LabelCol(3),
  378.                 1,' TechnoJock''s Two-Page Form Demo ');
  379.       PartClear(1,22,80,25,IOTOT^.FieldCOL(2),' ');
  380.    end;
  381. end; {SetUpScreen}
  382.  
  383. procedure SwitchActivePage;
  384. {}
  385. begin
  386.    Screen.PartClear(2,2,79,20,IOTOT^.FieldCOL(4),' ');
  387.    if ActivePage = 1 then
  388.    begin
  389.       Page2.SetActiveItem(21);
  390.       ActivePage := 2;
  391.    end
  392.    else
  393.    begin
  394.       Page1.SetActiveItem(1);
  395.       ActivePage := 1;
  396.    end;
  397.    Screen.WritePlain(5,2,'Page '+IntToStr(ActivePage));
  398. end; {SwitchActivePage}
  399.  
  400. begin  {main program}
  401.    InitFields;
  402.    SetUpScreen;
  403.    ActivePage := 1;
  404.    repeat
  405.       if ActivePage = 1 then
  406.          Result := Page1.Go
  407.       else
  408.          Result := Page2.Go;
  409.       case Result of
  410.         Stop1: SwitchActivePage;
  411.         Stop2: SwitchActivePage;
  412.         Stop3: SwitchActivePage;
  413.         Finished: begin
  414.            FormToRecord;
  415.            {update database...etc.}
  416.         end;    
  417.       end;
  418.    until Result in [Finished,Escaped];
  419.    clrscr;
  420.    {dispose of objects if not end of prog}
  421. end.
  422.