home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / WNDW55.ZIP / WNDWDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  10.5 KB  |  330 lines
  1. { =========================================================================== }
  2. { WndwDemo.pas - Multi-level window demo for WNDW55.TPU     ver 5.5, 08-24-89 }
  3. {                                                                             }
  4. { This demo shows just a few features multi-level windows, including high     }
  5. { speed screen design.                                                        }
  6. {   Copyright (C) 1987-1989 by James H. LeMay,  All rights reserved.          }
  7. { =========================================================================== }
  8.  
  9. program WindowDemo;
  10.  
  11. {$M 16384, 10000, 10000 }
  12. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }       { TP4 directives }
  13. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}  { TP5 directives }
  14.  
  15. uses Crt,Qwik,Wndw,Goof,Strs;
  16.  
  17. type
  18.   Str40 = string[40];
  19.   Steps = (Step0,Step1,Step2,Step3,Step4,Step5);
  20.  
  21. var
  22.   Step:              Steps;
  23.   i,j:               word;
  24.   Key:               char;
  25.  
  26. const
  27.   FuncKey = #00;
  28.   RetKey = #13;
  29.   EscKey = #27;
  30.   StrA : array [1..16] of Str40 = (
  31.     'WNDW55.TPU works these ...',
  32.     '',
  33.     'COMPUTERS:           ADAPTERS:',
  34.     '──────────────────   ─────────',
  35.     'IBM PC               MDA',
  36.     'IBM XT               CGA',
  37.     'IBM AT               EGA',
  38.     'IBM PCjr             MCGA',
  39.     'IBM PC Convertible   VGA',
  40.     'IBM PS/2 Model 25    8514/A',
  41.     'IBM PS/2 Model 30    Hercules:',
  42.     'IBM PS/2 Model 50     HGC',
  43.     'IBM PS/2 Model 60     HGC Plus',
  44.     'IBM PS/2 Model 70     InColor',
  45.     'IBM PS/2 Model 80 ',
  46.     'IBM 3270 PC');
  47.  
  48.   StrB : array [1..10] of Str40 = (
  49.     'If you have any questions or comments,',
  50.     'please write to or call:',
  51.     '',
  52.     '     Eagle Performance Software',
  53.     '     TP/TC Products',
  54.     '     Attn: Jordan Gallagher',
  55.     '           (CIS 73557,2342)',
  56.     '     P.O. Box 292786',
  57.     '     Ft. Worth, TX  76029-2786',
  58.     '     1-(214)-539-7855');
  59.  
  60. procedure DisplayBaseScreen;
  61. begin
  62.   { -- Create initial screen -- }
  63.   WWriteC ( 2,'Multi-Level Virtual Windows');
  64.   WWriteC ( 3,'Version 5.5 for');
  65.   WWriteC ( 4,'Turbo Pascal 5.5');
  66.   TWS.WndwAttr := LightGrayBG;
  67.   WWriteC ( 6,'For each of the following displays:');
  68.   WWriteC ( 8,'1. Press RETURN to continue.');
  69.   WWriteC ( 9,'2. Press ESC to back up.    ');
  70.   TWS.WSline := SingleBrdr;
  71.   WLineH  (12, 1,CRTcols);
  72.   WWriteC (16,'This is the base screen without windows.  Let''s just see ');
  73.   WWriteC (17,'how fast WNDW can create complex screen designs.  As soon');
  74.   WWriteC (18,'as you press return, WNDW will start creating a screen   ');
  75.   WWriteC (19,'from scratch.  Nothing has been done yet.  Then WNDW will');
  76.   WWRiteC (20,'display the resulting window on the screen.  Try to time ');
  77.   WWRiteC (21,'it, but don''t blink!                                     ');
  78.   Step:=Step0;
  79. end;
  80.  
  81. procedure DisplayScreenDesign;
  82. {}procedure DoAssets;
  83.   begin
  84.   SetWindowModes (SeeThruMode+RelMode);
  85.   MakeWindow ( 3, 1,12,39,GreenBG,SameAttr,NoBrdr,aWindow);
  86.   with TWS do
  87.     begin
  88.       WndwAttr := LightGrayBG;
  89.       WClrLine (1);
  90.       WWriteC ( 1,    'A S S E T S');
  91.       WEosToRC ( 3,33);
  92.       QfillEos (12, 7,LightGrayBG,' ');
  93.       WndwAttr := OrigAttr;
  94.       WWrite  ( 2, 2, 'Current Assets:');
  95.       WWrite  ( 3, 3,  'Cash and Equivalents');
  96.       WWrite  ( 4, 3,  'Accounts Receivable:');
  97.       WClrEos (WndwAttr);
  98.       WWrite  ( 5, 4,   'United States');
  99.       WWrite  ( 6, 4,   'Canada');
  100.       WWrite  ( 7, 4,   'Europe');
  101.       WWrite  ( 8, 3,  'Contracts in process');
  102.       WWrite  ( 9, 3,  'Inventories');
  103.       WWrite  (10, 3,  'Prepaid expenses');
  104.       WWrite  (11, 2, 'Total Current Assets');
  105.       WWrite  (12, 2, 'Property and Equipment');
  106.       WWrite  (14, 2, 'Total Assets:');
  107.     end;
  108. {}end;
  109. {}procedure DoAssetNums;
  110.   const
  111.     Cash:         integer =   128;
  112.     US:           integer =  1757;
  113.     Canada:       integer =  1827;
  114.     Europe:       integer =  1426;
  115.     Contracts:    integer = 10802;
  116.     Inventory:    integer =  4872;
  117.     Prepaid:      integer =   443;
  118.     Property:     integer =  1140;
  119.   var
  120.    TotalCA,TotalAssets: longint;
  121.   begin
  122.   MakeWindow ( 3,33,12, 7,LightGrayBG,SameAttr,NoBrdr,aWindow);
  123.   TotalCA := Cash+US+Canada+Europe+Contracts+Inventory;
  124.   TotalAssets := TotalCA+PrePaid;
  125.   WWriteC ( 3,StrLF(Cash       ,5));
  126.   WWriteC ( 5,StrLF(US         ,5));
  127.   WWriteC ( 6,StrLF(Canada     ,5));
  128.   WWriteC ( 7,StrLF(Europe     ,5));
  129.   WWriteC ( 8,StrLF(Contracts  ,5));
  130.   WWriteC ( 9,StrLF(Inventory  ,5));
  131.   WWriteC (10,StrLF(Prepaid    ,5));
  132.   WWriteC (11,StrLF(TotalCA    ,5));
  133.   WWriteC (12,StrLF(Property   ,5));
  134.   WWriteC (14,StrLF(TotalAssets,5));
  135. {}end;
  136. {}procedure DoLiabilities;
  137.   begin
  138.   MakeWindow ( 3,41,12,38,GreenBG,SameAttr,NoBrdr,aWindow);
  139.   with TWS do
  140.     begin
  141.       WEosToRC ( 3,32);
  142.       QfillEos (12, 7,LightGrayBG,' ');
  143.       WndwAttr := White+RedBG;
  144.       WClrLine (1);
  145.       WWriteC ( 1,    'L I A B I L I T I E S');
  146.       WndwAttr := OrigAttr;
  147.       WWrite  ( 2, 2, 'Current Liabilities:');
  148.       WClrEos (WndwAttr);
  149.       WWrite  ( 3, 3,  'Commercial paper');
  150.       WWrite  ( 4, 3,  'Accounts payable');
  151.       WWrite  ( 5, 3,  'Accrued salariess');
  152.       WWrite  ( 6, 3,  'Deferred taxes');
  153.       WWrite  ( 7, 2, 'Total Current');
  154.       WWrite  ( 8, 2, 'Noncurrent Liabilities:');
  155.       WClrEos (WndwAttr);
  156.       WWrite  ( 9, 3,  'Long-term debt');
  157.       WWrite  (10, 3,  'Product liability');
  158.       WWrite  (11, 3,  'Deferred taxes');
  159.       WWrite  (12, 2, 'Total Noncurrent');
  160.       WWrite  (14, 2, 'Total Liabilities:');
  161.     end;
  162. {}end;
  163. {}procedure DoLiabNums;
  164.   const
  165.     Paper:        integer =  3331;
  166.     Payable:      integer =  5776;
  167.     Salaries:     integer =  6430;
  168.     Taxes1:       integer =  2344;
  169.     LongTerm:     integer =   402;
  170.     Product:      integer =  1876;
  171.     Taxes2:       integer =  1096;
  172.   var
  173.    TotalCL,TotalNL,TotalLiabs: longint;
  174.   begin
  175.   MakeWindow ( 3,72,12, 7,LightGrayBG,SameAttr,NoBrdr,aWindow);
  176.   TotalCL := Paper+Payable+Salaries+Taxes1;
  177.   TotalNL := LongTerm+Product+Taxes2;
  178.   TotalLiabs := TotalCL+TotalNL;
  179.   WWriteC ( 3,StrLF(Paper      ,5));
  180.   WWriteC ( 4,StrLF(Payable    ,5));
  181.   WWriteC ( 5,StrLF(Salaries   ,5));
  182.   WWriteC ( 6,StrLF(Taxes1     ,5));
  183.   WWriteC ( 7,StrLF(TotalCL    ,5));
  184.   WWriteC ( 9,StrLF(LongTerm   ,5));
  185.   WWriteC (10,StrLF(Product    ,5));
  186.   WWriteC (11,StrLF(Taxes2     ,5));
  187.   WWriteC (12,StrLF(TotalNL    ,5));
  188.   WWriteC (14,StrLF(TotalLiabs ,5));
  189. {}end;
  190. {}procedure DoAuditor;
  191.   begin
  192.   MakeWindow (18, 1, 6,78,GreenBG,SameAttr,NoBrdr,aWindow);
  193.   with TWS do
  194.     begin
  195.       WWrite   ( 1, 2,'Auditor:');
  196.       WWrite   ( 2, 2,'Business Address:');
  197.       WWrite   ( 3, 2,'Mailing Address:');
  198.       WWrite   ( 4, 2,'Contact:');
  199.       WWrite   ( 5, 2,'Comments:');
  200.       SetWindowModes (RelMode);
  201.       MakeWindow (18,19, 6,60,White+BrownBG,SameAttr,NoBrdr,aWindow);
  202.       WWrite   ( 1, 1,'Ferret Auditors of Texas, Inc.');
  203.       WWrite   ( 2, 1,'1234 Technical Avenue      ');
  204.       QwriteEos (GreenBG,' State: ');
  205.       QwriteEos (SameAttr,'Texas    ');
  206.       QwriteEos (GreenBG,' Zip: ');
  207.       QwriteEos (SameAttr,'76125-1200');
  208.       WWrite   ( 3, 1,'P.O. Box 122237            ');
  209.       QwriteEos (GreenBG,' State: ');
  210.       QwriteEos (SameAttr,'Texas    ');
  211.       QwriteEos (GreenBG,' Zip: ');
  212.       QwriteEos (SameAttr,'76125-1281');
  213.       WWrite   ( 4, 1,'John Q. Public, CPA        ');
  214.       QwriteEos (GreenBG,' Phone: ');
  215.       QwriteEos (SameAttr,'(817)-555-1212');
  216.       WWrite   ( 5, 1,'Was this screen fast enough for you?');
  217.       WWrite   ( 6, 1,'Press RETURN to continue or ESC to back up.');
  218.     end;
  219. {}end;
  220. {}procedure DoPartitions;
  221.   begin
  222.   RemoveWindow;   { Back to parent window. }
  223.   with TWS do
  224.     begin
  225.       WWriteC ( 1,'1989 CONSOLIDATED BALANCE (Dollars in thousands)');
  226.       WSline := SingleBrdr;
  227.       WLineH    ( 2, 1,Wcols);
  228.       WLineH    (15, 1,Wcols);
  229.       WLineV    ( 3,40,14);
  230.       WLinePart ( 2,40,BrdrTT);
  231.       WLinePart (15,40,BrdrCL);
  232.       WBrdrH (17);
  233.     end;
  234. {}end;
  235. begin
  236.   { -- You can compare how much slower it would be if we didn't use -- }
  237.   { -- HiddenMode.  Try without it and comment out WriteToHidden.   -- }
  238.   SetWindowModes (HiddenMode+CursorOffMode);
  239.   MakeWindow ( 1, 1,25,80,black+GreenBG,White+GreenBG,HdoubleBrdr,Window1);
  240.   WriteToHidden (Window1);
  241.   TitleWindow (Top,Left,Yellow+GreenBG,' High Speed Screen Design ');
  242.   DoAssets;
  243.   DoAssetNums;
  244.   DoLiabilities;
  245.   DoLiabNums;
  246.   DoAuditor;
  247.   DoPartitions;
  248.   ShowWindow (Window1);
  249. end;
  250.  
  251. procedure DisplayEquipmentList;
  252. begin
  253.   { -- Compatible computers and adapters for WNDW55.TPU -- }
  254.   SetWindowModes (ZoomMode);
  255.   MakeWindow ( 4,35,18,34,White+BlueBG,LightCyan+blueBG,HdoubleBrdr,aWindow);
  256.   TitleWindow (Top,Center,SameAttr,' Software Compatibility ');
  257.   for j:=1 to 16 do
  258.     WWrite (j, 2,StrA[j]);
  259. end;
  260.  
  261. procedure DisplayAuthor;
  262. begin
  263.   { -- Author for WNDW55.TPU -- }
  264.   SetWindowModes (ZoomMode);
  265.   if VideoMode<>7 then
  266.       SetWindowModes (WindowModes+ShadowRight);
  267.   Brdr[UserBrdr2].BrdrArray:='┌┴┐┤├└┬┘┼─┼┼│┼┼';
  268.   MakeWindow ( 6,20,13,42,White+BrownBG,BrownBG,UserBrdr2,aWindow);
  269.   for j:=1 to 10 do
  270.     WWrite (j,2,StrB[j]);
  271.   TitleWindow (Bottom,Center,SameAttr,' Press RETURN to exit ');
  272. end;
  273.  
  274. procedure GetKey;
  275. var
  276.   ExtKey: boolean;
  277. begin
  278.   repeat
  279.     Key:=ReadKey;                        { Read keyboard input.      }
  280.     if KeyPressed and (Key=FuncKey) then { If first Char was #00 ... }
  281.       begin
  282.         Key:=ReadKey;                    { ... read second char.     }
  283.         ExtKey := true
  284.       end
  285.     else ExtKey:=false;
  286.   until (Key=RetKey) or (Key=EscKey);
  287. end;
  288.  
  289. procedure FindNextStep;
  290. begin
  291.   case Key of
  292.   EscKey: if Step>Step0 then
  293.            begin
  294.              RemoveWindow;
  295.              dec (Step);
  296.            end;
  297.   RetKey: inc (Step);
  298.   end  { case }
  299. end;
  300.  
  301. procedure DisplayWindows;
  302. begin
  303.   repeat
  304.     GetKey;
  305.     FindNextStep;
  306.     if Key=RetKey then
  307.       case Step of
  308.         Step1:  DisplayScreenDesign;
  309.         Step2:  DisplayEquipmentList;
  310.         Step3:  DisplayAuthor;
  311.       end;
  312.    until Step=Step4;
  313. end;
  314.  
  315. begin
  316. { Qsnow := false; }
  317.   ModCursor (CursorOff);
  318.   PreferMultiTask := true;
  319.   InitWindow (blue+LightGrayBG,true);
  320.   DisplayBaseScreen;
  321.   DisplayWindows;
  322.   { -- Use the following statment to return to the original screen.-- }
  323.   for i:=1 to LI do RemoveWindow;
  324.   WClrScr;
  325.   WWriteC (12,'Copyright (c) 1986-1989  James H. LeMay');
  326.   WWriteC (13,'Eagle Performance Software');
  327.   ModCursor (CursorOn);
  328.   GotoRC (CRTrows,1);
  329. end.
  330.