home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / arc / arctool / demo1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-29  |  1.9 KB  |  73 lines
  1. {
  2.                        F i l e    I n f o r m a t i o n
  3.  
  4. * DESCRIPTION
  5. Demonstration program for TPPICK and TPDIR units.
  6.  
  7. * ASSOCIATED FILES
  8. TPDIR.PAS
  9. DEMO1.PAS
  10. DEMO1.EXE
  11. TPDIR.TPU
  12. TPPICK.PAS
  13. TPPICK.TPU
  14.  
  15. }
  16. {
  17. Demonstration program for TPPick and TPDir units.
  18.  
  19. This program requires the use of units from the commercial product Turbo
  20. Professional 4.0, by TurboPower Software. It demonstrates two new units,
  21. supplied here. The TPPick unit offers general-purpose scrolling "pick"
  22. windows, which allow the user to scroll though a list of strings and select
  23. one to return to the calling program. The TPDir unit offers a popup directory
  24. unit, useful wherever user entry of filenames is required.
  25.  
  26. Copyright (c) 1987 by TurboPower Software. May be freely used by and
  27. distributed to owners of Turbo Professional 4.0.
  28.  
  29. Turbo Professional 4.0 is a library of 400 general purpose procedures and
  30. functions especially optimized for Turbo Pascal 4.0. It costs $99 and includes
  31. complete source code and a 450 page manual. Contact TurboPower Software at
  32. 408-438-8608 or on Compuserve [72457,2131] for more information.
  33. }
  34.  
  35. {$R-,S-,I-,V-}
  36.  
  37. program Demo;
  38.   {-Demonstrate TPPick and TPDir units}
  39. uses
  40.   Dos,
  41.   TPString,
  42.   TPCrt,
  43.   TPWindow,
  44.   TPPick,
  45.   TPDir;
  46. var
  47.   Mask, Fname : string;
  48. begin
  49.   {Override default position of the pick window}
  50.   if CurrentWidth < 80 then
  51.     TPDir.XLow := 1
  52.   else
  53.     TPDir.XLow := 15;
  54.   TPDir.YHigh := CurrentHeight;
  55.  
  56.   WriteLn('Press Ctrl-Break to quit');
  57.  
  58.   repeat
  59.     Write('Enter a filename mask: ');
  60.     ReadLn(Mask);
  61.     case GetFileName(Mask, Fname) of
  62.       0 : WriteLn('Got filename=', Fname);
  63.       1 : WriteLn('Path not found');
  64.       2 : WriteLn('No matching files');
  65.       3 : WriteLn('Unsupported video mode');
  66.       4 : WriteLn('Insufficient memory');
  67.     else
  68.       WriteLn('Dos critical error');
  69.     end;
  70.   until False;
  71. end.
  72. 
  73.