home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / TBASE551.ARJ / MY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-20  |  3.0 KB  |  99 lines
  1.  
  2. {$D- , N-, R-, O-, S-}
  3. Uses  Dbwin, Tbase, Crt , Dbdate, DbStr, Dbedit;
  4.  
  5. Var mine : ^DBF ;
  6.  
  7. {$F+}  (* Only a far procedure can be passed in SetHelpProc *)
  8. Procedure MyEditHelp;
  9. Var Ch : Char ;
  10. Begin
  11.     OpenWindow(5,5,75,20, ' Help - Editing Keys ', ' Press Any Key ',
  12.     white + 16*blue , black + 16*Green );
  13.     Writeln('    Standard Edit Keys            Special for this program only');
  14.     Writeln;
  15.     Writeln(' Left  : Move cursor Left         PgUp      : Previous Record');
  16.     Writeln(' Right : Move cursor right        PgDn      : Next Record');
  17.     Writeln(' Up    : Move to Previous Field   Ctrl-Pgup : Move to First record');
  18.     Writeln(' Down  : Move to next Field       Ctrl-PgDn : Move to Last record');
  19.     Writeln(' Ctrl-Left:Move to Previous word  Ctrl-N    : Append Blank record');
  20.     Writeln(' Ctrl-Right: Move to next word    F1        : This Help ');
  21.     Writeln(' Home  : Move Cursor to Start     Ctrl-End  : Quit ');
  22.     Writeln(' End   : Move cursor to End        Alt-X    : Quit ');
  23.     Writeln(' ESC   : Restore Line             Ctrl_Brk  : Restore Record');
  24.     Writeln(' INS   : Toggles insert/overwrite mode ');
  25.     Writeln;
  26.     Write(' Nasir Haniffa. BITNET ( ACDH083@SAUPM00.BITNET ) ');
  27.     Repeat until keypressed ;
  28.     While Keypressed do ch := Readkey ;
  29.     CloseWindow;
  30.  
  31. End;
  32. {$F-}
  33. Procedure Screen;
  34. (* Draws editing screen *)
  35. Begin
  36.       OpenWindow(1,3,67,23,' Editing Demo ' ,' Ctrl-End = Exit ' ,
  37.         white + blue*16, Yellow + 16*blue );
  38.       GotoXy(2,1);         Write('Name of Procedure : ');
  39.       GotoXy(2,3);        Write('Description ');
  40.       GotoXy(2,7);        Write('Syntax ');
  41.       GotoXy(2,10);        Write('Remark ');
  42.       GotoXy(2,14);        Write('Warning ');
  43.       GotoXy(2,17);        Write('See Also ');
  44. End;
  45.  
  46. Procedure GetData ;
  47.     
  48. Begin
  49.     GotoXy( 55, 1 ) ;
  50.     Write( Cstr( mine^.RecNo,3,0) + '/' + Cstr(Mine^.RecCount,3,0) );
  51.     SetEditColor( White , cyan );  (* Set edit color *)
  52.     SetHelpProc( MyEditHelp ); (* You can even assign help for each field *)
  53.     get(20,  0, Mine , 'Name');
  54.     get( 2,  3, Mine , 'Discript1');
  55.     get( 2,  4, Mine , 'Discript2');
  56.     get( 2,  7, Mine , 'Use1');
  57.     get( 2,  8, Mine , 'Use2 ');
  58.     get( 2, 10, Mine , 'Remark1');
  59.     get( 2, 11, Mine , 'Remark2');
  60.     get( 2, 12, Mine , 'Remark3');
  61.     get( 2, 14, Mine , 'Warning1');
  62.     get( 2, 15, Mine , 'Warning2');
  63. SetHelpProc( NoHelp ) ;             (* Just to demonstrate.. *)
  64.     get( 2, 17, Mine , 'SeeAlso');  (* Now This field will NOT trigger Help *)
  65.  
  66.     DbRead; (* Ok... Edit them *)
  67. End;
  68.  
  69. Begin
  70.   CheckBreak := False;
  71.   Initwindow('');
  72.   WriteHeader(' Manual Writer ');
  73.   GotoXy(1,24);
  74.   WriteFoot('  Press F1 for Help on Editing Keys  ');
  75.   Screen;
  76.   New( mine, Init( ParamStr(1) ) );
  77.  
  78.   Repeat
  79.     GetData;
  80.  
  81.     With Mine^ do
  82.     Case ReadExitCode of
  83. {PgUp}        4    : PrevRec;
  84. {PgDn}            5    : Skip ;  { PgDn, F10, ENTER all will skip }
  85. {Ctrl_N}    7    : Begin ClearMemRec; AddDbRec End;
  86. {Ctrl_Brk}    8    : GetDbrec(Current);
  87.         9    : GoTop;
  88.         10   : GoBottom;
  89.     End;
  90.  
  91.   Until ReadExitCode = 6 ; { Ctrl_End }
  92.  
  93.   Dispose(Mine,done ) ;
  94.   CloseWindow; CloseWindow ;
  95.   TextAttr := lightgray ;
  96.   Clrscr;
  97. End.
  98.  
  99.