ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/WNDW55.ZIP/WNDWMGR.PAS

Pascal/Delphi Source File | 1989-08-24 | 9.8 KB | 323 lines

{ =========================================================================== }
{ WndwMgr.pas - Multi-level Virtual Window demo             ver 5.5, 08-24-89 }
{               to demonstrate powerful window management.                    }
{                                                                             }
{ This program shows you how the window management utilities allow you to     }
{ access any window at any time.  You can even hide the top level window for  }
{ displaying later.                                                           }
{   The demo places a very heavy load on screen processing by doing full      }
{ screen scrolling on the virtual screens and then updating them on the CRT.  }
{ Notice that the full windows are updated even if covered.  The constantly   }
{ scrolling screens are there just to make it more apparent where and how     }
{ fast the windows are being updated.                                         }
{   ** !! NOTE: Set UseInt9handler to false when using integrated debugging.  }
{   ** !!       Set back to true only when fully debugged and running.        }
{   Run program.  Instructions are on the screen.                             }
{   Copyright (C) 1987-1989 by James H. LeMay,  All rights reserved.          }
{ =========================================================================== }
program ManagementDemo;

{$M 16384, 50000, 50000 }
{ R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }       { TP4 directives }
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}  { TP5 directives }

uses
  Crt,Qwik,Wndw,Keyb,Goof;

type
  Str80 = string[80];

const
  StrA: array[1..25] of Str80 = (
    '╓──────────────────────────────────────────────────────────╖',
    '╙─╥────────── E A G L E  Performance Software ───────────╥─╜',
    '  ╙─╥───── P.O. Box 292786, Lewisville, TX  75029 ─────╥─╜',
    '    ╙──────────────────────────────────────────────────╜',
    'WNDW55.TPU  gives you  unparalleled  performance  in  window',
    'software for  Turbo Pascal 5.5.  It features  fixed, hidden,',
    'and true virtual windows with true random-access.   Now your',
    'windows can be dynamically updated even if they are covered!',
    'The  speed of  hidden and  virtual screens is phenomenal  as',
    'they use the virtual writing routines of QWIK55.TPU.',
    '',
    'RANDOM ACCESS  is the power to  pull any  window  to the top',
    'even  if they  are covered without  shuffling!   This  means',
    'your  windows  can be in any order  and not  just stacked or',
    'tiled.',
    '',
    'VIRTUAL WINDOWS -  The screens for virtual windows can be of',
    'any  row  and  column  size in  a 64k buffer.  The  rows and',
    'columns  can  range  from 1 to 255.  These  windows  can  be',
    'resized, zoomed, or scrolled right on the screen!',
    '',
    'Programmers  will find the code very easy to use and simple.',
    'All  the  hard  working  code is  kept transparent.  Several',
    'window-relative and window management routines are included.',
    '');

  { ASCII Key codes: }
  Alt1     = #120;
  Alt2     = #121;
  Alt3     = #122;
  Alt4     = #123;
  LArr     = #75;
  RArr     = #77;
  UArr     = #72;
  DArr     = #80;
  HomeKey  = #71;
  EndKey   = #79;
  PgUp     = #73;
  PgDn     = #81;
  EscKey   = #27;
  RetKey   = #13;
  F5Key    = #63;
  F10Key   = #68;

  ScrollLock = $10;
  MoveMode   = $01;
  ResizeMode = $02;
  ScrollMode = $04;
  AlterMode: byte = MoveMode;

var
  RowStep,ColStep,i,Line,
  FastRowStep,FastColStep: byte;
  NumOfRows,NumOfCols:     integer;
  Name:                    WindowNames;
  Key:                     char;
  ExtKey,Typematic:        boolean;

function ScrollLockOn: boolean;
begin
  ScrollLockOn:=((KeyStatus and ScrollLock)<>0);
end;

procedure UpdateKeyStatus;
var S: string[20];
begin
  if ScrollLockOn then
    begin
      if not VirtualFlag then AlterMode:=MoveMode;
      Qwrite (CRTrows,61,White+GreenBG,#24#25#27#26);
      case AlterMode of
        MoveMode:   S:='-Move   ';
        ResizeMode: S:='-Resize ';
        ScrollMode: S:='-Scroll ';
      end;
      QwriteEos (Black +GreenBG,S);
      QwriteEos (Yellow+GreenBG,' SCROLL');
    end
  else Qfill (CRTrows,61,1,20,GreenBG,' ');
end;

{ For this demo, not only are the windows being scrolled on the screen, }
{ but also in RAM whether they are seen or not!  So, let's give it a    }
{ heavy CPU and video load, but still see how fast it can go. }
procedure UpdateWindows;
begin
  WriteToVirtual (Name);
  WscrollUp;                 { For the heaviest load, scroll up entire screen }
  WWrite (25,2,StrA[Line]);  { Wrap a new line at the bottom }
  VUpdateWindow;
  inc (Name);
  if Name=Window4 then
    begin
      Name := Window1;
      inc (Line);
      Line := succ(pred(Line) mod 25);
    end;
end;

{ Here's where the windows are updated!  When the keyboard is idle, the  }
{ following procedure is run.  You may change the contents of course.    }
{$F+}
procedure KbdIdle;
begin
  UpdateWindows;
  WriteToCRT;
  UpdateKeyStatus;
end;
{$F-}

procedure InitStepRates;
begin
  if CRTrows>40 then
       FastRowStep:=4
  else FastRowStep:=2;
  FastColStep:=CRTcols div 20;
end;

procedure AdjustStepRates;
begin
  if Typematic then
    begin
      ColStep:=FastColStep;
      RowStep:=FastRowStep;
    end
  else
    begin
      ColStep:=1;
      RowStep:=1;
    end;
end;

procedure GetSteps (VAR NumOfRows,NumOfCols: integer);
var Rows,Cols: integer;
begin
  AdjustStepRates;
  Rows:=0;
  Cols:=0;
  case Key of
    UArr:    Rows :=-RowStep;
    DArr:    Rows := RowStep;
    LArr:    Cols :=-ColStep;
    RArr:    Cols := ColStep;
    PgUp:    Rows :=-255;
    PgDn:    Rows := 255;
    HomeKey: Cols :=-255;
    EndKey:  Cols := 255;
  end;
  NumOfRows := Rows;
  NumOfCols := Cols;
end;

procedure AlterWindow;
var Rows,Cols: integer;
begin
  if not VirtualFlag then AlterMode:=MoveMode;
  if ExtKey then
    begin
      GetSteps (Rows,Cols);
      case AlterMode of
        MoveMode:    MoveWindow    (Rows,Cols);
        ResizeMode:  VResizeWindow (Rows,Cols);
        ScrollMode:  VScrollView   (Rows,Cols);
      end;
    end
  else
    if VirtualFlag then
      case Key of
        'M','m': AlterMode:=MoveMode;
        'R','r': AlterMode:=ResizeMode;
        'S','s': AlterMode:=ScrollMode;
      end;
end;

procedure WriteContents;
begin
  for i:=1 to 25 do
    WWrite (i,2,StrA[i]);
end;

procedure CreateScreen;
begin
  PreferMultiTask := true;
  InitWindow (Yellow+BlackBG,true);
  SetVirtualSize (25,80);   { To keep heap limited }
  TitleOfs := 0;            { Place titles at extreme left or right }
  with Margins do
    begin
    { TopMargin:=2; }
      BottomMargin:=pred(CRTrows);
    { RightMargin:=79;
      Leftmargin:=2; }
    end;
  Qfill (CRTrows,1,1,CRTcols,GreenBG,' ');
  Qwrite (CRTrows,2,White+GreenBG,'Alt:1-4');
  QwriteEos (Black+GreenBG,'-Window Num  ');
  QwriteEos (White+GreenBG,'ESC');
  QwriteEos (Black+GreenBG,'-Hide  ');
  QwriteEos (White+GreenBG,'F5');
  QwriteEos (Black+GreenBG,'-Zoom  ');
  QwriteEos (White+GreenBG,'F10');
  QwriteEos (Black+GreenBG,'-Quit  ');
  InitStepRates;
  SetWindowModes ({ZoomMode or} CursorOffMode or VirtualMode);

  { -- Virtual Window 1 -- }
  MakeWindow ( 1, 1,20,60,Black+BrownBG,Black+BrownBG,SingleBrdr,Window1);
  WriteToVirtual (TWS.WSname);
  TitleWindow (Top,Left,White+BrownBG,'1 Virtual Window ');
  WriteContents;
  VUpdateWindow;

  { -- Virtual Window 2 -- }
  WriteToCRT;
  MakeWindow ( 6,10,16,60,White+GreenBG,White+GreenBG,SingleBrdr,Window2);
  WriteToVirtual (TWS.WSname);
  TitleWindow (Top,Left,Yellow+GreenBG,'2 Virtual Window  ');
  WriteContents;
  VUpdateWindow;

  { -- Virtual Window 3 -- }
  WriteToCRT;
  MakeWindow (11,20,14,59,White+BlueBG,White+BlueBG,SingleBrdr,Window3);
  WriteToVirtual (TWS.WSname);
  TitleWindow (Top,Left,Yellow+BlueBG,'3 Virtual Window  ');
  WriteContents;
  VUpdateWindow;

  { -- Fixed Window 4 -- }
  WriteToCRT;
  SetWindowModes (CursorOffMode);
  MakeWindow ( 7,42,17,32,Black+LightGrayBG,Black+LightGrayBG,HDoubleBrdr,
              Window4);
  TitleWindow (Top,Left  ,SameAttr,'4');
  TitleWindow (Top,Center,SameAttr,' Fixed Window ');
  WWriteC ( 1,'DYNAMIC UPDATING!!');
  WBrdrH  ( 2);
  WWriteC ( 3,'Instructions:');
  TWS.WSLine := SingleBrdr;
  WLineH  ( 4,3,TWS.Wcols-4);
  WWrite  ( 5,3, 'ESC - Hide top window');
  WWrite  ( 6,3, 'F5  - Zoom virtual window');
  WWrite  ( 7,3, 'F10 - Quit');
  WWrite  ( 8,3, 'Alt:1-4 - Access window');
  WWrite  ( 9,3, 'With ScrollLock on:');
  WWrite  (10,5,   'R - Resize mode');
  WWrite  (11,5,   'S - Scroll mode');
  WWrite  (12,5,   'M - Move   mode');
  WWrite  (13,5,   'Then arrow keys.');
  WWrite  (14,3, 'Ctrl-NumLock to freeze.');
  WWrite  (15,3, 'Any other key to pause.');
  WGotoRC (TWS.Wrows,1);
  ChangeBorder (DoubleBrdr);
end;

begin
{ Qsnow := false; }
  Keyb.AddrKbdIdle := @KbdIdle;   { Set hook for KbdIdle routine! }
  Keyb.UseInt9handler (true );    { Set to true for solid keyboard action. }
                                  { !!! Set false for debugging !!! }
  CreateScreen;
  Line:=1;
  Name:=Window1;

  repeat
    Keyb.ReadKbd (Key,ExtKey,Typematic);
    if ScrollLockOn then
      AlterWindow;
    if ExtKey then
      case Key of
        Alt1..Alt4:
          begin
            RestoreBorder;
            AccessWindow (WindowNames (ord(Key)-pred(ord(Alt1))) );
            ChangeBorder (DoubleBrdr);
          end;
        F5Key: VZoomWindow;
      end
    else
      case Key of
        EscKey: begin
                  HideWindow;
                  ChangeBorder (DoubleBrdr);
                end;
      end;
  until ExtKey and (Key=F10Key);

  AccessWindow (Window0);
  WClrScr;
  SetCursor (CursorInitial);
end.