home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GSDB25.ZIP / DB_XPL08.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-07-30  |  3.3 KB  |  143 lines
  1. program DB_Xpl08;
  2. uses
  3.    CRT,
  4.    DOS,
  5.    Printer,
  6.    GS_KeyI,
  7.    GS_Pick,
  8.    GS_Winfc,
  9.    GS_dBFld,
  10.    GS_dBTbl,
  11.    GS_dBase;
  12.  
  13. const
  14.    Initial_Choice : array [1..3] of string[9] =
  15.                     (' Choose  ',' Print   ',' Exit    ');
  16.  
  17. var
  18.    Health  : GS_dBFld_Objt;
  19.    HlthTab : dbTabl_Pick_Obj;
  20.  
  21.    AskWin,
  22.    StatusWin,
  23.    HlthWin     : GS_Wind_Objt;
  24.  
  25. procedure ShowFile;
  26. begin
  27.    StatusWin.SetWin;
  28.    write('':10,'ESC to Abort,  F10 to Quit and Save,',
  29.                '  F9 to Delete/Undelete');
  30.    HlthWin.SetWin;
  31.    if HlthTab.Addrec then
  32.    begin
  33.       Health.Blank;
  34.       if Health.FieldUpdateScreen then
  35.       begin
  36.          Health.Append;
  37.          HlthTab.Reset_dBTabl;
  38.       end;
  39.    end
  40.    else
  41.      if Health.FieldUpdateScreen then Health.PutRec(Health.RecNumber);
  42.    HlthWin.RelWin;
  43.    StatusWin.RelWin;
  44. end;
  45.  
  46. procedure FileDisplay;
  47. var
  48.    t : string[8];
  49.    i : integer;
  50.    z,
  51.    wcr : boolean;
  52. begin
  53.    wcr := Health.Wait_CR;
  54.    Health.Wait_Cr := true;
  55.    AskWin.NamWin('[ Food Name ]');
  56.    AskWin.SetWin;
  57.    gotoxy(1,1);
  58.    write('Enter food name:');
  59.    t := Health.EditString('',8,3,20);
  60.    Health.Wait_CR := wcr;
  61.    HlthTab.Reset_dBTabl;
  62.    repeat
  63.       StatusWin.SetWin;
  64.       write('':22,'ESC to Exit,  RETURN to Select Entry');
  65.       if HlthTab.Tabl = nil then
  66.          z := HlthTab.Scan_dBTabl('FOOD',t,'FOOD+"  ("+FOOD_CODE+")"')
  67.       else
  68.       begin
  69.          HlthTab.Pick_Win.SetWin;
  70.          z := HlthTab.Choose_dBTabl;
  71.          HlthTab.Pick_Win.RelWin;
  72.       end;
  73.       StatusWin.RelWin;
  74.       if z then ShowFile;
  75.    until not z;
  76.    HlthTab.Reset_dBTabl;
  77.    AskWin.RelWin
  78. end;
  79.  
  80. procedure Print_List;
  81. begin
  82.    ClrScr;
  83.    writeln(lst,'  REC#    FOOD                    CODE',
  84.                '   QUANT    MEASUR    CALORIES');
  85.    writeln(lst);
  86.    with Health do
  87.    begin
  88.       GetRec(Top_Record);
  89.       while not File_EOF do
  90.       begin
  91.          writeln(FieldGet('food'):20,
  92.                  FieldGet('food_code'):8,
  93.                  FieldGet('quantity'):8,
  94.                  FieldGet('unittype'):5,
  95.                  FieldGet('cals'):6);
  96.          writeln(lst,RecNumber:6,
  97.                      FieldGet('food'):24,
  98.                      FieldGet('food_code'):8,
  99.                      FieldGet('quantity'):8,
  100.                      FieldGet('unittype'):10,
  101.                      FieldGet('cals'):12);
  102.          GetRec(Next_Record);
  103.       end;
  104.    end;
  105.    writeln(lst,#12);
  106. end;
  107.  
  108. procedure What_Now;
  109. var
  110.    c1 : char;
  111.    q : integer;
  112. begin
  113.    q := 1;
  114.    while q < 3 do
  115.    begin
  116.       StatusWin.SetWin;
  117.       q := GS_Pick_Line_Item(Initial_Choice,10,3,q);
  118.       StatusWin.RelWin;
  119.       case q of
  120.          0 : q := 3;
  121.          1 : FileDisplay;
  122.          2 : Print_List;
  123.       end;
  124.    end;
  125. end;
  126.  
  127. begin
  128.    ClrScr;
  129.    Health.Init('HEALTH');
  130.    Health.Open;
  131.    Health.Index('FOODNAME');
  132.    HlthTab.Init_dbTabl(Health, '[ FOODS ]',20,2,60,22,
  133.                        Yellow,Green,LightGray,Black,LightGray);
  134.    HlthWin.InitWin(1,1,80,24,Yellow,blue,Yellow,Blue,LightGray,True,
  135.                        '[ FILE INFORMATION ]',true);
  136.    AskWin.InitWin(20,8,60,12,Yellow,Blue,Yellow,Black,LightGray,true,
  137.                   '',true);
  138.    StatusWin.InitWin(1,25,80,25,Yellow,Red,Yellow,Red,LightGray,false,'',true);
  139.    HlthTab.Append_dBTabl(true);
  140.    What_Now;
  141.    Health.Close;
  142. end.
  143.