home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 552 / SHOWOFF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  5KB  |  178 lines
  1. program ShowOff;
  2. {$N+,E+}
  3. uses
  4.    SmplStuf,
  5.    XtraStuf,
  6.    GSOBShel,
  7.    GSOB_Inx,
  8.    GSOB_Var,
  9.    CRT,
  10.    DOS;
  11.  
  12. var
  13.    NameOfFile: string;
  14.    NameOfIndx: string;
  15.    SelectLine: GSP_IndxColl;
  16.    WorkStr   : string;
  17.    lctn      : integer;
  18.    LinItem   : longint;
  19.  
  20. Procedure MainScreenDraw;
  21. begin
  22.     window(1,1,80,25);
  23.    SetScreenColors(Yellow,LightCyan,Blue,Blue,LightGray);
  24.    SetNmMode;
  25.    ClrScr;
  26.    if NameOfFile <> '' then
  27.    begin
  28.       GotoXY(34,10);
  29.       write('Active File:');
  30.       GoToXY((40-length(NameOfFile) div 2),11);
  31.       write(NameOfFile);
  32.       if NameOfIndx <> '' then
  33.       begin
  34.          GotoXY(34,13);
  35.          write('Index File:');
  36.          GoToXY((40-length(NameOfIndx) div 2),14);
  37.          write(NameOfIndx);
  38.       end;
  39.    end;
  40. end;
  41.  
  42.  
  43. Procedure InitMenuBar;
  44. begin
  45.    SelectLine := New(GSP_IndxColl, Init(8, NoSort));
  46.    SelectLine^.InsertKey(1,' File');
  47.    SelectLine^.InsertKey(2,' Index');
  48.    SelectLine^.InsertKey(3,' Edit');
  49.    SelectLine^.InsertKey(4,' Append');
  50.    SelectLine^.InsertKey(5,' Browse');
  51.    SelectLine^.InsertKey(6,' Quit');
  52. end;
  53.  
  54. Function SelectMenuItem: longint;
  55. var
  56.    slct : word;
  57.    mItem: GSP_IndxEtry;
  58. begin
  59.    window(1,25,80,25);
  60.    SetScreenColors(Yellow,White,Red,Blue,LightGray);
  61.    SetNmMode;
  62.    ClrScr;
  63.    slct := 1;
  64.    mItem := GS_Pick_Line(SelectLine,slct);
  65.    if mItem <> nil then
  66.       SelectMenuItem := mItem^.Tag
  67.    else
  68.       SelectMenuItem := 0;
  69. end;
  70.  
  71. Function SelectAFile(fpath, wcard : string; alldir : boolean): string;
  72. var
  73.    s : string;
  74. begin
  75.    window(25,3,54,20);
  76.    SetScreenColors(Black,Yellow,Green,White,Green);
  77.    SetNmMode;
  78.    ClrScr;
  79.    MakeABox('Select File');
  80.    s := GS_FindFiles(fpath,wcard,alldir);
  81.    lctn := pos('.',s);
  82.    if lctn > 0 then delete(s,lctn,4);
  83.    SelectAFile := s;
  84. end;
  85.  
  86. begin
  87.    TextBackGround(Blue);
  88.    ClrScr;
  89.    InitMenuBar;
  90.    NameOfFile := '';
  91.    NameOfIndx := '';
  92.    Select(1);
  93.  
  94.    repeat
  95.       MainScreenDraw;
  96.       LinItem := SelectMenuItem;
  97.       case LinItem of
  98.          1 : begin                          {Get a file}
  99.                 WorkStr := SelectAFile('','*.DBF',true);
  100.                 MainScreenDraw;
  101.                 if WorkStr <> '-' then
  102.                 begin
  103.                    NameOfFile := WorkStr;
  104.                    NameOfIndx := '';
  105.                    Use(NameOfFile);
  106.                    SetDBFCacheOn;
  107.                 end
  108.                 else
  109.                    NameOfFile := '';
  110.              end;
  111.          2 : begin                          {Get a file}
  112.                 if NameOfFile <> '' then
  113.                 begin
  114.                    WorkStr := NameOfFile;
  115.                    lctn := length(WorkStr);
  116.                    while lctn > 0 do
  117.                    begin
  118.                       if WorkStr[lctn] <> '\' then
  119.                          system.delete(WorkStr,lctn,1)
  120.                       else lctn := 0;
  121.                       dec(lctn);
  122.                    end;
  123.                    NameOfIndx := SelectAFile(WorkStr,'*.NDX',false);
  124.                    MainScreenDraw;
  125.                    if NameOfIndx <> '-' then
  126.                       Index(NameOfIndx)
  127.                    else
  128.                       NameOfIndx := '';
  129.                 end;
  130.              end;
  131.          3 : begin                          {Do Edit}
  132.                 if NameOfFile <> '' then
  133.                 begin
  134.                    MainScreenDraw;
  135.                    lctn := RecNo;
  136.                    if RecNo < 1 then GoTop else Go(RecNo);
  137.                    while (FieldUpDateScreen) and (not dEOF) do
  138.                    begin
  139.                       if RecChanged and (GS_KeyI_Chr <> Kbd_Esc) then Replace;
  140.                       if GS_KeyI_Chr = Kbd_PgUp then
  141.                          Skip(-1)
  142.                       else
  143.                          Skip(1);
  144.                    end;
  145.                    MainScreenDraw;
  146.                 end;
  147.              end;
  148.          4 : begin                          {Do Append}
  149.                 if NameOfFile <> '' then
  150.                 begin
  151.                    SetDBFCacheOff;
  152.                    MainScreenDraw;
  153.                    while (FieldAppendScreen(true)) and (not dEOF) do
  154.                       if GS_KeyI_Chr <> Kbd_Esc then Append;
  155.                    MainScreenDraw;
  156.                    SetDBFCacheOn;
  157.                    Go(RecCount);
  158.                 end;
  159.              end;
  160.          5 : begin                          {Do Browse}
  161.                 if NameOfFile <> '' then
  162.                 begin
  163.                    SetDBFCacheOff;
  164.                    MainScreenDraw;
  165.                    FieldBrowseScreen;
  166.                    MainScreenDraw;
  167.                    SetDBFCacheOn;
  168.                 end;
  169.              end;
  170.       end;
  171.    until LinItem > 5;
  172.    Dispose(SelectLine, Done);
  173.    CloseDataBases;
  174. end.
  175.  
  176.  
  177.  
  178.