home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / wndw70 / wndwmgr.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-23  |  10KB  |  335 lines
  1. { ========================================================================== }
  2. { WndwMgr.pas - Multi-level Virtual Window demo           ver 7.0c, 09-23-93 }
  3. {               to demonstrate powerful window management.                   }
  4. {                                                                            }
  5. { This program shows you how the window management utilities allow you to    }
  6. { access any window at any time.  You can even hide the top level window for }
  7. { displaying later.                                                          }
  8. {   The demo places a very heavy load on screen processing by doing full     }
  9. { screen scrolling on the virtual screens and then updating them on the CRT. }
  10. { Notice that the full windows are updated even if covered.  The constantly  }
  11. { scrolling screens are there just to make it more apparent where and how    }
  12. { fast the windows are being updated.                                        }
  13. {   Run program.  Instructions are on the screen.                            }
  14. {   Copyright (C) 1993 by James H. LeMay,  All rights reserved.              }
  15. { ========================================================================== }
  16. program ManagementDemo;
  17.  
  18. {$M 16384, 50000, 50000 }
  19. {$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
  20.  
  21. uses
  22.   Crt,Qwik,Wndw,Keyb,Goof;
  23.  
  24. type
  25.   Str80 = string[80];
  26.  
  27. const
  28.   StrA: array[1..25] of Str80 = (
  29.     '╓──────────────────────────────────────────────────────────╖',
  30.     '╙─╥────────── E A G L E  Performance Software ───────────╥─╜',
  31.     '  ╙─╥───── 6341 Klamath Road, Ft. Worth, TX  76116 ────╥─╜',
  32.     '    ╙──────────────────────────────────────────────────╜',
  33.     'WNDW70C.TPU  gives you  unparalleled  performance in  window',
  34.     'software for Borland Pascal 7.0.  It features fixed, hidden,',
  35.     'and true virtual windows with true random-access.   Now your',
  36.     'windows can be dynamically updated even if they are covered!',
  37.     'The  speed of  hidden and  virtual screens is phenomenal  as',
  38.     'they use the virtual writing routines of QWIK71.TPU.',
  39.     '',
  40.     'RANDOM ACCESS  is the power to  pull any  window  to the top',
  41.     'even  if they  are covered without  shuffling!   This  means',
  42.     'your  windows  can be in any order  and not  just stacked or',
  43.     'tiled.',
  44.     '',
  45.     'VIRTUAL WINDOWS -  The screens for virtual windows can be of',
  46.     'any  row  and  column  size in  a 64k buffer.  The  rows and',
  47.     'columns  can  range  from 1 to 255.  These  windows  can  be',
  48.     'resized, zoomed, or scrolled right on the screen!',
  49.     '',
  50.     'Programmers  will find the code very easy to use and simple.',
  51.     'All  the  hard  working  code is  kept transparent.  Several',
  52.     'window-relative and window management routines are included.',
  53.     '');
  54.  
  55.   { ASCII Key codes: }
  56.   Alt1     = #120;
  57.   Alt2     = #121;
  58.   Alt3     = #122;
  59.   Alt4     = #123;
  60.   AltX     = #45;
  61.   LArr     = #75;
  62.   RArr     = #77;
  63.   UArr     = #72;
  64.   DArr     = #80;
  65.   HomeKey  = #71;
  66.   EndKey   = #79;
  67.   PgUp     = #73;
  68.   PgDn     = #81;
  69.   EscKey   = #27;
  70.   RetKey   = #13;
  71.   F5Key    = #63;
  72.   F10Key   = #68;
  73.  
  74.   ScrollLock = $10;
  75.   MoveMode   = $01;
  76.   ResizeMode = $02;
  77.   ScrollMode = $04;
  78.   AlterMode: byte = MoveMode;
  79.  
  80. var
  81.   RowStep,ColStep,i,Line,
  82.   FastRowStep,FastColStep: byte;
  83.   NumOfRows,NumOfCols:     integer;
  84.   Name:                    WindowNames;
  85.   Key:                     char;
  86.   ExtKey,Typematic:        boolean;
  87.  
  88. function ScrollLockOn: boolean;
  89. begin
  90.   ScrollLockOn:=((KeyStatus and ScrollLock)<>0);
  91. end;
  92.  
  93. procedure UpdateKeyStatus;
  94. var S: string[20];
  95. begin
  96.   if ScrollLockOn then
  97.     begin
  98.       if not VirtualFlag then AlterMode:=MoveMode;
  99.       Qwrite (CRTrows,61,White+GreenBG,#24#25#27#26);
  100.       case AlterMode of
  101.         MoveMode:   S:='-Move   ';
  102.         ResizeMode: S:='-Resize ';
  103.         ScrollMode: S:='-Scroll ';
  104.       end;
  105.       QwriteEos (Black +GreenBG,S);
  106.       QwriteEos (Yellow+GreenBG,' SCROLL');
  107.     end
  108.   else Qfill (CRTrows,61,1,20,GreenBG,' ');
  109. end;
  110.  
  111. { For this demo, not only are the windows being scrolled on the screen, }
  112. { but also in RAM whether they are seen or not!  So, let's give it a    }
  113. { heavy CPU and video load, but still see how fast it can go. }
  114. procedure UpdateWindows;
  115. begin
  116.   WriteToVirtual (Name);
  117.   WscrollUp;                { For the heaviest load, scroll up entire screen }
  118.   WWrite (25,2,StrA[Line]); { Wrap a new line at the bottom }
  119.   VUpdateWindow;
  120.   inc (Name);
  121.   if Name=Window4 then
  122.     begin
  123.       Name := Window1;
  124.       inc (Line);
  125.       Line := succ(pred(Line) mod 25);
  126.     end;
  127. end;
  128.  
  129. { Here's where the windows are updated!  When the keyboard is idle, the  }
  130. { following procedure is run.  You may change the contents of course.    }
  131. procedure UpdateWhenIdle; far;
  132. begin
  133.   UpdateWindows;
  134.   WriteToCRT;
  135.   UpdateKeyStatus;
  136. end;
  137.  
  138. procedure InitStepRates;
  139. begin
  140.   if CRTrows>40 then
  141.        FastRowStep:=4
  142.   else FastRowStep:=2;
  143.   FastColStep:=CRTcols div 20;
  144. end;
  145.  
  146. procedure AdjustStepRates;
  147. begin
  148.   if Typematic then
  149.     begin
  150.       ColStep:=FastColStep;
  151.       RowStep:=FastRowStep;
  152.     end
  153.   else
  154.     begin
  155.       ColStep:=1;
  156.       RowStep:=1;
  157.     end;
  158. end;
  159.  
  160. procedure GetSteps (VAR NumOfRows,NumOfCols: integer);
  161. var Rows,Cols: integer;
  162. begin
  163.   AdjustStepRates;
  164.   Rows:=0;
  165.   Cols:=0;
  166.   case Key of
  167.     UArr:    Rows :=-RowStep;
  168.     DArr:    Rows := RowStep;
  169.     LArr:    Cols :=-ColStep;
  170.     RArr:    Cols := ColStep;
  171.     PgUp:    Rows :=-255;
  172.     PgDn:    Rows := 255;
  173.     HomeKey: Cols :=-255;
  174.     EndKey:  Cols := 255;
  175.   end;
  176.   NumOfRows := Rows;
  177.   NumOfCols := Cols;
  178. end;
  179.  
  180. procedure AlterWindow;
  181. var Rows,Cols: integer;
  182. begin
  183.   if not VirtualFlag then AlterMode:=MoveMode;
  184.   if ExtKey then
  185.     begin
  186.       GetSteps (Rows,Cols);
  187.       case AlterMode of
  188.         MoveMode:    MoveWindow    (Rows,Cols);
  189.         ResizeMode:  VResizeWindow (Rows,Cols);
  190.         ScrollMode:  VScrollView   (Rows,Cols);
  191.       end;
  192.     end
  193.   else
  194.     if VirtualFlag then
  195.       case upcase(Key) of
  196.         'M': AlterMode:=MoveMode;
  197.         'R': AlterMode:=ResizeMode;
  198.         'S': AlterMode:=ScrollMode;
  199.       end;
  200. end;
  201.  
  202. procedure WriteContents;
  203. begin
  204.   for i:=1 to 25 do
  205.     WWrite (i,2,StrA[i]);
  206. end;
  207.  
  208. procedure CreateScreen;
  209. begin
  210.   PreferMultiTask := true;
  211.   InitWindow (LightGray+BlackBG,true);
  212.   SetVirtualSize (25,80);   { To keep heap limited }
  213.   TitleOfs := 0;            { Place titles at extreme left or right }
  214.   with Margins do
  215.     begin
  216.     { TopMargin:=2; }
  217.       BottomMargin:=pred(CRTrows);
  218.     { RightMargin:=79;
  219.       Leftmargin:=2; }
  220.     end;
  221.   Qfill (CRTrows,1,1,CRTcols,GreenBG,' ');
  222.   Qwrite (CRTrows,2,White+GreenBG,'Alt:1-4');
  223.   QwriteEos (Black+GreenBG,'-Window Num  ');
  224.   QwriteEos (White+GreenBG,'ESC');
  225.   QwriteEos (Black+GreenBG,'-Hide  ');
  226.   QwriteEos (White+GreenBG,'F5');
  227.   QwriteEos (Black+GreenBG,'-Zoom  ');
  228.   QwriteEos (White+GreenBG,'F10');
  229.   QwriteEos (Black+GreenBG,'-Quit  ');
  230.   InitStepRates;
  231.   SetWindowModes ({ZoomMode or} CursorOffMode or VirtualMode);
  232.  
  233.   { -- Virtual Window 1 -- }
  234.   MakeWindow ( 1, 1,20,60,Black+BrownBG,Black+BrownBG,SingleBrdr,Window1);
  235.   WriteToVirtual (TWS.WSname);
  236.   TitleWindow (Top,Left,White+BrownBG,'1 Virtual Window ');
  237.   WriteContents;
  238.   VUpdateWindow;
  239.  
  240.   { -- Virtual Window 2 -- }
  241.   WriteToCRT;
  242.   MakeWindow ( 6,10,16,60,White+GreenBG,White+GreenBG,SingleBrdr,Window2);
  243.   WriteToVirtual (TWS.WSname);
  244.   TitleWindow (Top,Left,Yellow+GreenBG,'2 Virtual Window  ');
  245.   WriteContents;
  246.   VUpdateWindow;
  247.  
  248.   { -- Virtual Window 3 -- }
  249.   WriteToCRT;
  250.   MakeWindow (11,20,14,59,White+BlueBG,White+BlueBG,SingleBrdr,Window3);
  251.   WriteToVirtual (TWS.WSname);
  252.   TitleWindow (Top,Left,Yellow+BlueBG,'3 Virtual Window  ');
  253.   WriteContents;
  254.   VUpdateWindow;
  255.  
  256.   { -- Fixed Window 4 -- }
  257.   WriteToCRT;
  258.   SetWindowModes (CursorOffMode);
  259.   MakeWindow ( 7,42,16,32,Black+LightGrayBG,Black+LightGrayBG,HDoubleBrdr,
  260.               Window4);
  261.   TitleWindow (Top,Left  ,SameAttr,'4');
  262.   TitleWindow (Top,Center,SameAttr,' Fixed Window ');
  263.   WWriteC ( 1,'DYNAMIC UPDATING!!');
  264.   WBrdrH  ( 2);
  265.   WWriteC ( 3,'Instructions:');
  266.   TWS.WSLine := SingleBrdr;
  267.   WLineH  ( 4,3,TWS.Wcols-4);
  268.   WWrite  ( 5,3, 'ESC - Hide top window');
  269.   WWrite  ( 6,3, 'F5  - Zoom virtual window');
  270.   WWrite  ( 7,3, 'F10 - Quit');
  271.   WWrite  ( 8,3, 'Alt:1-4 - Access window');
  272.   WWrite  ( 9,3, 'With ScrollLock on:');
  273.   WWrite  (10,5,   'R - Resize mode');
  274.   WWrite  (11,5,   'S - Scroll mode');
  275.   WWrite  (12,5,   'M - Move   mode');
  276.   WWrite  (13,5,   'Then arrow keys.');
  277.   WWrite  (14,3, 'Any other key to pause.');
  278.   WGotoRC (TWS.Wrows,1);
  279.   ChangeBorder (DoubleBrdr);
  280. end;
  281.  
  282. procedure SignOff;
  283. begin
  284.   { -- Use the following statment to return to the original screen.-- }
  285.   AccessWindow (Window0);
  286.   WClrScr;
  287.   SetWindowModes (0);
  288.   MakeWindow (0,0,6,40,White+BlueBG,LightGray+BlueBG,DoubleBrdr,Window0);
  289.   WWriteC ( 2,'Copyright (c) 1993 James H. LeMay');
  290.   WWriteC ( 3,'Eagle Performance Software');
  291.   SetCursor (CursorInitial);
  292.   GotoRC (CRTrows-1,1);
  293. end;
  294.  
  295. begin
  296. { Qsnow := false; }
  297.   Keyb.KbdIdle := UpdateWhenIdle; { Set hook for KbdIdle routine! }
  298.   {$ifopt D- }
  299.   Keyb.UseInt9handler (true );    { Set to true for solid keyboard action. }
  300.   {$else }
  301.   Keyb.UseInt9handler (false);    { !!! Set false for debugging !!! }
  302.   {$endif }
  303.  
  304.   CreateScreen;
  305.   Line:=1;
  306.   Name:=Window1;
  307.  
  308.   repeat
  309.     Keyb.ReadKbd (Key,ExtKey,Typematic);
  310.     if ScrollLockOn then
  311.       AlterWindow;
  312.     if ExtKey then
  313.       case Key of
  314.         Alt1..Alt4:
  315.           begin
  316.             RestoreBorder;
  317.             if Key=Alt4 then
  318.               i := i;
  319.             AccessWindow (WindowNames (ord(Key)-pred(ord(Alt1))) );
  320.             ChangeBorder (DoubleBrdr);
  321.           end;
  322.         F5Key: VZoomWindow;
  323.       end
  324.     else
  325.       case Key of
  326.         EscKey: begin
  327.                   HideWindow;
  328.                   ChangeBorder (DoubleBrdr);
  329.                 end;
  330.       end;
  331.   until ExtKey and ((Key=F10Key) or (Key=AltX));
  332.  
  333.   SignOff;
  334. end.
  335.