home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PULL55.ZIP / PULLDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  2.2 KB  |  62 lines
  1. { =========================================================================== }
  2. { PullDemo.pas - Full demonstration of pull-down menus.     ver 5.5, 08-24-89 }
  3. {                                                                             }
  4. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  5. { =========================================================================== }
  6.  
  7. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  8. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  9.  
  10. {$M 16384,18000,18000 }
  11.  
  12. program PullDemo;
  13.  
  14. uses
  15.   Crt,Qwik,Wndw,Pull,
  16.   { You must include the following units for this demo! : }
  17.   PullStat,PullData,PullWork,Goof;
  18.  
  19. var
  20.   OrigPathName: string[67];
  21.  
  22. procedure DisplayScreen;
  23. begin
  24.   WWrite ( 1, 1,'PULLDEMO v5.5             Multi-level Pu'+
  25.                 'll-down Menus       Copr 1989  J H LeMay');
  26.   ShowTopLine;
  27.   SetWindowModes (PermMode);
  28.   MakeWindow (3,1,CRTrows-3,CRTcols,White+BlueBG,LightGray+BlackBG,DoubleBrdr,
  29.               Window1);
  30.   SetWindowModes (0);
  31.   TitleWindow (Top,Left,SameAttr,'1');
  32.   TWS.WndwAttr := Yellow+BlueBG;
  33.   WWriteC ( 2,'PULL55.ARC - MULTI-LEVEL PULL-DOWN MENUS');
  34.   WWriteC ( 9,'This is Work Window 1.');
  35.   TWS.WndwAttr := TWS.OrigAttr;
  36.   WWriteC ( 4,'Use F1 everywhere for some descriptions.');
  37.   WWriteC ( 5,'Use ''Quit'' to exit demo program.        ');
  38.   WWriteC ( 6,'Be sure to try a CR at "≡" marked lines.');
  39.   WWriteC ( 7,'Also try all the EnterData lines.       ');
  40.   WWrite(11, 9,'The following Data Entry fields have some arbitrary values');
  41.   WWrite(12, 9,'and ranges.  Move the highlight and edit.  Press F1 for help.');
  42. end;
  43.  
  44. begin
  45. { Qsnow := false; }
  46.   GetDir (0,OrigPathName);
  47.   PathName := OrigPathName;
  48.   PreferMultiTask := true;   { Use Multi-tasking MTVB if possible. }
  49.   InitPull (LightGray,false); { <<-- Be sure you do this!! }
  50.   DisplayScreen;
  51.   GotoKeyDispatcher;          { <<-- All keyboard entries go through here! }
  52.   if OrigPathName<>PathName then
  53.     begin
  54.       {$I-} ChDir(OrigPathName); {$I+}
  55.       if IOresult<>0 then;
  56.     end;
  57.   AccessWindow (Window0);
  58.   WClrScr;
  59.   WGotoRC (CRTrows,1);
  60.   SetCursor (CursorInitial);
  61. end.
  62.