home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / GLEN / TOTDEM.ZIP / DEMIO21.PAS < prev    next >
Pascal/Delphi Source File  |  1991-02-11  |  15KB  |  513 lines
  1. program DemoIOTwentyOne;
  2. {demIO21 - This example illustrates how you could use the
  3.  Toolkit to develop a database application}
  4.  
  5. Uses DOS, CRT,
  6.      totFAST, totREAL, totIO1, totIO2, totIO3, totSTR, totDATE, totMSG;
  7.  
  8. Const
  9.    MsgX=1;
  10.    MsgY=25;
  11. Type                   
  12. Comments = array[1..7] of string[50];
  13.  
  14. RecordInfo = record
  15.    FirstLast: string[40];
  16.    Company: string[40];
  17.    Addr1: string[40];
  18.    Addr2: string[40];
  19.    City: string[25];
  20.    State: string[20];
  21.    Zip: string[9];
  22.    Country: string[30];
  23.    Tel: string[20];
  24.    OrderDate: longint;
  25.    OrderQuantity: word;
  26.    UnitPrice: extended;
  27.    Info: Comments;
  28. end;
  29.  
  30. Var
  31.   ActiveRecord: RecordInfo;
  32.   Browsing: boolean;
  33.   Totalrecords: longint;
  34.   RecordNumber:integer;
  35.   Result: tAction;
  36.   {Now the input fields}
  37.   NextBut,PrevBut,EditBut,AddBut,SaveBut, QuitBut,HelpBut: Strip3DIOOBJ;
  38.   FirstLastField,
  39.   CompanyField,
  40.   Addr1Field,
  41.   Addr2Field,
  42.   CityField,
  43.   StateField,
  44.   CountryField: StringIOOBJ;
  45.   ZipField,
  46.   TelField: PictureIOOBJ;
  47.   OrderDateField: DateIOOBJ;
  48.   OrderQuantityField: IntIOOBJ;
  49.   UnitPriceField: FixedRealIOOBJ;
  50.   InfoField: WWArrayIOOBJ;
  51.   Controlkeys: ControlKeysIOOBJ;
  52.   Manager: FormOBJ;
  53.  
  54. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  55. {                                                         }
  56. {     D a t a b a s e   A c c e s s   R o u t i n e s     }
  57. {                                                         }
  58. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  59.  
  60. function LoadRecord(RecNo:longint; var Rec:RecordInfo):boolean;
  61. {This function would be responsible for getting the information from
  62.  the data base file, and might return a boolean to indicate if the 
  63.  operation was a success. 
  64.  
  65.  In this template, the function simply loads TechnoJock's details
  66.  in the record.}
  67. begin
  68.    fillchar(Rec,sizeof(Rec),#0);
  69.    with Rec do
  70.    case RecNo of
  71.       1: begin
  72.          FirstLast :=  'Bob Ainsbury';
  73.          Company := 'TechnoJock Sofware, Inc.';
  74.          Addr1 := 'PO Box 820927';
  75.          Addr2 := '';
  76.          City :=  'Houston';
  77.          State := 'TX';
  78.          Zip := '77282';
  79.          Country := '';
  80.          Tel := '7134936354';
  81.          OrderDate := GregtoJul(2,11,1991);
  82.          OrderQuantity := 7;
  83.          UnitPrice := 89.95;
  84.          Info[1] := 'Just a few comments about the good balance ';
  85.          Info[2] := 'between ease of use and power. He intends to ';
  86.          Info[3] := 'use the Toolkit to build an employee system. ';
  87.       end;
  88.       2: begin
  89.          FirstLast :=  'Joe Cholesterol';
  90.          Company := 'The Heffer Restaurant';
  91.          Addr1 := '1101 Old Spanish Trail';
  92.          Addr2 := 'The Heights';
  93.          City :=  'El Paso';
  94.          State := 'TX';
  95.          Zip := '73008';
  96.          Country := '';
  97.          Tel := '6884946324';
  98.          OrderDate := GregtoJul(2,13,1991);
  99.          OrderQuantity := 1;
  100.          UnitPrice := 89.95;
  101.          Info[1] := 'Joe said he wants to use the Toolkit to keep ';
  102.          Info[2] := 'track of his beef in the meat lockers. ';
  103.       end;
  104.       3: begin
  105.          FirstLast :=  'Mr T Vision';
  106.          Company := 'Borland International';
  107.          Addr1 := '1800 Green Hills Road';
  108.          Addr2 := 'PO Box 660001';
  109.          City :=  'Scotts Valley';
  110.          State := 'CA';
  111.          Zip := '950670001';
  112.          Country := '';
  113.          OrderDate := GregtoJul(2,20,1991);
  114.          OrderQuantity := 11;
  115.          UnitPrice := 89.95;
  116.          Info[1] := 'No comments';
  117.       end;
  118.    end; {case}
  119.    LoadRecord := true;
  120. end; {LoadRecord}
  121.  
  122. function AddRecord(Rec:RecordInfo): boolean;
  123. {Saves a new record to the database, and returns true
  124.  if successful. In this template, there is no disk access.}
  125. begin
  126.    {your record saving code would go here}
  127.    AddRecord := true;
  128. end; {AddRecord}
  129.   
  130. function ModifyRecord(RecNo:longint; Rec:RecordInfo):boolean;
  131. {Changes the value of a record in the database, and returns true
  132.  if successful. In this template, there is no disk access.}
  133. begin
  134.    ModifyRecord := true;
  135. end; {ModifyRecord}
  136. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  137. {                                                 }
  138. {     S c r e e n   F o r m   R o u t i n e s     }
  139. {                                                 }
  140. {|||||||||||||||||||||||||||||||||||||||||||||||||}
  141. procedure RecordToForm;
  142. {Updates the form objects with the contents of the record - a more efficient
  143.  way would be to use MOVE, but let's not get too fancy for the demo}
  144. begin
  145.    with ActiveRecord do
  146.    begin
  147.       FirstLastField.SetValue(FirstLast);
  148.       CompanyField.SetValue(Company);
  149.       Addr1Field.SetValue(Addr1);
  150.       Addr2Field.SetValue(Addr2);
  151.       CityField.SetValue(City);
  152.       StateField.SetValue(State);
  153.       CountryField.SetValue(Country);
  154.       ZipField.SetValue(Zip);
  155.       TelField.SetValue(Tel);
  156.       OrderDateField.SetValue(OrderDate);
  157.       OrderQuantityField.SetValue(OrderQuantity);
  158.       UnitPriceField.SetValue(UnitPrice);
  159.       InfoField.AssignList(Info,7,50);
  160.       InfoField.WrapFull; 
  161.    end;
  162. end; {RecordToForm}
  163.  
  164. procedure FormToRecord;
  165. {Updates the record with the values entered into the form}
  166. begin
  167.    with ActiveRecord do
  168.    begin
  169.       Firstlast := FirstLastField.GetValue;
  170.       Company := CompanyField.GetValue;
  171.       Addr1 := Addr1Field.GetValue;
  172.       Addr2 := Addr2Field.GetValue;
  173.       City := CityField.GetValue;
  174.       State := StateField.GetValue;
  175.       Country := CountryField.GetValue;
  176.       Zip := ZipField.GetValue;
  177.       Tel := TelField.GetValue;
  178.       OrderDate := OrderDateField.GetValue;
  179.       OrderQuantity := OrderQuantityField.GetValue;
  180.       UnitPrice := UnitPriceField.GetValue;
  181.    end;
  182. end; {FormToRecord}
  183.  
  184. procedure InitFields;
  185. {Initializes all of the field objects}
  186. begin
  187.   with NextBut do
  188.   begin
  189.      Init(69,5,'  ~N~ext  ',Stop1);
  190.      SetID(100);
  191.      SetHotkey(305);
  192.      SetMessage(MsgX,MsgY,'View the next record in the database');
  193.   end;
  194.   with PrevBut do
  195.   begin
  196.      Init(69,7,'  ~P~rev  ',Stop2);
  197.      SetID(101);
  198.      SetHotkey(281);
  199.      SetMessage(MsgX,MsgY,'View the previous record in the database');
  200.   end;
  201.   with EditBut do
  202.   begin
  203.      Init(69,9,'  ~E~dit  ',Stop3);
  204.      SetID(102);
  205.      SetHotkey(274);
  206.      SetMessage(MsgX,MsgY,'Modify the contents of this record');
  207.   end;
  208.   with AddBut do
  209.   begin
  210.      Init(69,11,'  ~A~dd   ',Stop4);
  211.      SetID(103);
  212.      SetHotkey(286);
  213.      SetMessage(MsgX,MsgY,'Add a new record to the database');
  214.   end;
  215.   with SaveBut do
  216.   begin
  217.      Init(69,13,'  ~S~ave  ',Stop5);
  218.      SetID(104);
  219.      SetHotkey(287);
  220.      SetMessage(MsgX,MsgY,'Save the new record to the database');
  221.   end;
  222.   with QuitBut do
  223.   begin
  224.      Init(69,15,'  ~Q~uit  ',Finished);
  225.      SetID(105);
  226.      SetHotkey(272);
  227.      SetMessage(MsgX,MsgY,'Stop this nonsense and go home');
  228.   end;
  229.   with HelpBut do
  230.   begin
  231.      Init(69,17,'  ~H~elp  ',Help);
  232.      SetID(HelpID);
  233.      SetHotkey(291);
  234.      SetMessage(MsgX,MsgY,'Seek further guidance from the machine!');
  235.   end;
  236.   with FirstLastField do
  237.   begin
  238.      Init(20,4,40);
  239.      SetID(1);
  240.      SetForceCase(true);
  241.      SetCase(Upper);
  242.      SetLabel('Customer Name');
  243.      SetMessage(MsgX,MsgY,'Name in FIRST M. LAST format');
  244.   end;
  245.   with CompanyField do
  246.   begin
  247.      Init(20,5,40);
  248.      SetID(2);
  249.      SetLabel('Company');
  250.      SetMessage(MsgX,MsgY,'Enter the FULL company name');
  251.   end;
  252.   with Addr1Field do
  253.   begin
  254.      Init(20,6,40);
  255.      SetID(3);
  256.      SetLabel('Address');
  257.      SetMessage(MsgX,MsgY,'Street address only no PO BOXES!');
  258.   end;
  259.   with Addr2Field do
  260.   begin
  261.      Init(20,7,40);
  262.      SetID(4);
  263.      SetMessage(MsgX,MsgY,'Add second line if necessary.');
  264.   end;
  265.   with CityField do
  266.   begin
  267.      Init(20,8,25);
  268.      SetID(5);
  269.      SetLabel('City');
  270.      SetMessage(MsgX,MsgY,'Enter the City name');
  271.   end;
  272.   with StateField do
  273.   begin
  274.      Init(20,9,20);
  275.      SetID(6);
  276.      SetForceCase(true);
  277.      SetCase(Upper);
  278.      SetLabel('State');
  279.      SetMessage(MsgX,MsgY,'Enter the State, Province or County');
  280.   end;
  281.   with ZipField do
  282.   begin
  283.      Init(50,9,'#####-####');
  284.      SetID(7);
  285.      SetLabel('Zip');
  286.      SetMessage(MsgX,MsgY,'Enter the 9 digit ZIP or postal code');
  287.   end; 
  288.   with CountryField do
  289.   begin
  290.      Init(20,10,30);
  291.      SetID(8);
  292.      SetForceCase(true);
  293.      SetCase(Upper);
  294.      SetLabel('Country');
  295.      SetMessage(MsgX,MsgY,'Leave empty for USA customers');
  296.   end;
  297.   with TelField do
  298.   begin
  299.      Init(20,12,'(###) ###-####');
  300.      SetID(9);
  301.      SetLabel('Telephone');
  302.      SetMessage(MsgX,MsgY,'Leave empty for international customers');
  303.   end;
  304.   with OrderDateField do
  305.   begin
  306.      Init(20,14,MMDDYY);
  307.      SetID(10);
  308.      SetLabel('Order date');
  309.      SetRules(EraseDefault);
  310.      SetMessage(MsgX,MsgY,'Enter date in format MM/DD/YY');
  311.   end;
  312.   with OrderQuantityField do
  313.   begin
  314.      Init(40,14,2);
  315.      SetID(11);
  316.      SetMinMax(1,15);
  317.      SetLabel('Quantity');
  318.      SetRules(EraseDefault);
  319.      SetMessage(MsgX,MsgY,'Enter number of units ordered');
  320.   end;
  321.   with UnitPriceField do
  322.   begin
  323.      Init(54,14,3,2);
  324.      SetID(12);
  325.      SetMinMax(10.0,499.99);
  326.      SetLabel('Price');
  327.      SetRules(EraseDefault);
  328.      SetMessage(MsgX,MsgY,'Enter price per item');
  329.   end;
  330.   with InfoField do
  331.   begin
  332.      Init(7,16,54,7,'Comments');
  333.      SetID(13);
  334.      SetMessage(MsgX,MsgY,'Enter any comments (especially praise)');
  335.   end;
  336.   Controlkeys.Init;
  337.   with Manager do
  338.   begin
  339.      Init;
  340.      AddItem(Controlkeys);
  341.      AddItem(FirstLastField);
  342.      AddItem(CompanyField);
  343.      AddItem(Addr1Field);
  344.      AddItem(Addr2Field);
  345.      AddItem(CityField);
  346.      AddItem(StateField);
  347.      AddItem(ZipField);
  348.      AddItem(CountryField);
  349.      AddItem(TelField);
  350.      AddItem(OrderDateField);
  351.      AddItem(OrderQuantityField);
  352.      AddItem(UnitPriceField);
  353.      AddItem(InfoField);
  354.      AddItem(NextBut);
  355.      AddItem(PrevBut);
  356.      AddItem(EditBut);
  357.      AddItem(AddBut);
  358.      AddItem(SaveBut);
  359.      AddItem(QuitBut);
  360.      AddItem(HelpBut);
  361.    end;
  362. end; {InitFields}
  363.  
  364. procedure SetForBrowse(On:boolean);
  365. {DeActivates all the edit files and enables browsing files, or vica versa}
  366. begin
  367.    FirstLastField.SetActiveStatus(not On);
  368.    CompanyField.SetActiveStatus(not On);
  369.    Addr1Field.SetActiveStatus(not On);
  370.    Addr2Field.SetActiveStatus(not On);
  371.    CityField.SetActiveStatus(not On);
  372.    StateField.SetActiveStatus(not On);
  373.    ZipField.SetActiveStatus(not On);
  374.    CountryField.SetActiveStatus(not On);
  375.    TelField.SetActiveStatus(not On);
  376.    OrderDateField.SetActiveStatus(not On);
  377.    OrderQuantityField.SetActiveStatus(not On);
  378.    UnitPriceField.SetActiveStatus(not On);
  379.    InfoField.SetActiveStatus(not On);
  380.    NextBut.SetActiveStatus(On);
  381.    PrevBut.SetActiveStatus(On);
  382.    EditBut.SetActiveStatus(On);
  383.    AddBut.SetActiveStatus(On);
  384.    SaveBut.SetActiveStatus(not On);
  385.    if On then
  386.       Manager.SetActiveItem(100)
  387.    else
  388.       Manager.SetActiveItem(1);
  389. end; {SetForBrowse}
  390. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  391. {                                                       }
  392. {     S c r e e n   D i s p l a y   R o u t i n e s     }
  393. {                                                       }
  394. {|||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  395. procedure DisplayRecordNumber;
  396. {}
  397. begin
  398.    Screen.WriteAt(2,2,CAttr(lightgray,battr(IOTOT^.LabelCol(3))),
  399.                   'Record: '+IntToStr(RecordNumber)+'  ');
  400. end; {DisplayRecordNumber}
  401.  
  402. procedure DisplayStatus;
  403. {}
  404. begin
  405.    if Browsing then
  406.       Screen.WritePlain(67,3,'Browse Mode')
  407.    else
  408.       Screen.WritePlain(67,3,'Edit Mode  ');
  409. end; {DisplayStatus}
  410.  
  411. procedure SetUpScreen;
  412. {}
  413. begin
  414.    with Screen do
  415.    begin
  416.       {use the color settings used in the IO form}
  417.       TitledBox(1,1,80,24,
  418.                 IOTOT^.LabelCol(3),
  419.                 IOTOT^.LabelCol(4),
  420.                 IOTOT^.LabelCol(3),
  421.                 1,' TechnoJock''s Database Demo ');
  422.       PartClear(1,25,80,25,IOTOT^.FieldCOL(2),' ');
  423.       SmartVertLine(65,1,24,IOTOT^.LabelCol(3),1);
  424.    end;
  425. end; {SetUpScreen}
  426.  
  427. procedure SaveIt;
  428. {mock up of a save}
  429. var Msg : MessageOBJ;
  430. begin
  431.    with Msg do
  432.    begin
  433.       Init(1,' Record Saved ');
  434.       WinForm^.Win^.SetColors(23,31,30,28);
  435.       AddLine('');
  436.       AddLine(' In a real application, your edits would now ');
  437.       AddLine(' be saved in the database. Just imagine that ');
  438.       AddLine(' it happened!');
  439.       AddLine('');
  440.       AddLine(' We will now go back into database browse mode. ');
  441.       AddLine('');
  442.       Show;
  443.       Done;
  444.    end;
  445.    RecordNumber := 1;
  446.    Browsing := true;
  447.    SetForBrowse(browsing);
  448.    if LoadRecord(RecordNumber,ActiveRecord) then
  449.       RecordToForm;
  450. end; {Saveit}
  451. {||||||||||||||||||||||||||||||||||}
  452. {                                  }
  453. {     M a i n    P r o g r a m     }
  454. {                                  }
  455. {||||||||||||||||||||||||||||||||||}
  456.  
  457. begin
  458.    RecordNumber := 1;
  459.    TotalRecords := 3;  {normally you would get this data by polling the d/b}
  460.    Browsing := true;
  461.    InitFields;
  462.    if LoadRecord(RecordNumber,ActiveRecord) then
  463.       RecordToForm;
  464.    SetForBrowse(browsing);
  465.    SetUpScreen;
  466.    repeat
  467.       DisplayRecordNumber;
  468.       DisplayStatus;
  469.       Result := Manager.Go;
  470.       case Result of
  471.          Stop1: begin
  472.             if RecordNumber < TotalRecords then
  473.                Inc(RecordNumber)
  474.             else
  475.                RecordNumber := 1;
  476.             if LoadRecord(RecordNumber,ActiveRecord) then
  477.                RecordToForm;
  478.          end;
  479.          Stop2: begin
  480.             if RecordNumber > 1 then
  481.                dec(RecordNumber)
  482.             else
  483.                RecordNumber := TotalRecords;
  484.             if LoadRecord(RecordNumber,ActiveRecord) then
  485.                RecordToForm;
  486.          end;
  487.          Stop3: begin
  488.             Browsing := false;
  489.             SetForBrowse(Browsing);
  490.          end;
  491.          Stop4: begin
  492.             Browsing := false;
  493.             SetForBrowse(Browsing);
  494.             RecordNumber := succ(TotalRecords);
  495.             Fillchar(ActiveRecord,sizeof(ActiveRecord),#0);
  496.             with ActiveRecord do
  497.             begin
  498.                OrderDate := TodayInJul;
  499.                OrderQuantity := 11;
  500.                UnitPrice := 89.95;
  501.             end;
  502.             RecordToForm;
  503.          end;
  504.          Stop5: begin
  505.             SaveIt;
  506.          end;
  507.       end; {case}
  508.    until Result in [Finished,Escaped];
  509.    clrscr;
  510.    {dispose of objects if not end of prog}
  511. end.
  512.  
  513.