Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB16.ZIP/WNDW_RTN.PAS

Pascal/Delphi Source File | 1986-02-06 | 13.8 KB | 412 lines

Program WindowDemo;

{ WINDOW DEMONSTRATION IN TURBO PASCAL --

  Translated from BASIC by Lars Ecklund 12/19/85

Comments:     This program is IBM-PC specific in regard to the GetChar
           procedure and Screen function.

              Those inclined may wish to make the Window data arrays into
           one single record.

              Programmers thinking of implementing these procedures will
           probably want to restructure them a bit... They are a little
           messy!                                                        }

const
     MaxWindows = 20;
     MaxHSelectWidth = 5;
     HNumSelections  = 5;
     HSelectWidth    = 10;
     MaxVSelections  = 4;
     MaxVSelectWidth = 12;
     CR              = 13;
     ESC             = 27;
     MonoChrome = $B000;
     Colour     = $B800;

type
     WindowInfo  = array[1..MaxWindows] of byte;
     HSelections = array[1..HNumSelections] of string[MaxHSelectWidth];
     VSelections = array[1..MaxVSelections] of string[MaxVSelectWidth];
     String80    = String[80];

var
     NumWindows                        : byte;
     NumLines                          : integer;
     WindowX,WindowY,WindowH,WindowW   : WindowInfo;
     SStr                              : array[1..4000] of char;

Procedure GotoWXY(W,X,Y:byte);
{ Place cursor at relative (X,Y) coordinates in window w }
begin
     GotoXY(X+WindowX[W],Y+WindowY[W]);
end; { Goto (x,y) within window }

Procedure WriteText(TStr:String80; X,Y,W:byte; Inverse:boolean);
var
     StringSize:byte;
begin
     if Length(TStr)>WindowW[W] then
         StringSize:=WindowW[W]
     else
         StringSize:=Length(TStr);
     if Inverse then { Inverse text colour } begin
         TextColor(0); TextBackGround(7); end;
     GotoWXY(W,X,Y);            { If too big to fit in window, }
     Write(Copy(TStr,1,StringSize)); { truncate the text. }
     if Inverse then { Restore screen colours } begin
         TextColor(7); TextBackGround(0); NormVideo; end;
end; { Write Text }

Procedure DisplayInitialText;
var
     TStr    : String80;
     X,Y,W   : byte;
begin
     X:=1; Y:=4; W:=1;
     TStr:='This is a dummy main screen to show you how Turbo can be used for';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='making windows and menus.';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+2; TStr:='Windows can definately enhance the user interface, providing a';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='clear way of displaying multiple events on one screen. They can';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='also be used for menu selections and other prompts, as demonstrated';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='in this program.';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+2; TStr:='To make a selection, just use the arrow keys to "point" to the';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='desired selection. On a horizontal menu, use the left and right';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='keys to make the selection. On a vertical, "pull-down" menu, use';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='the up and down arrow keys. Once your selection has been made,';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+1; TStr:='press <CR>. That''s all there is to making a selection!';
     WriteText(TStr,X,Y,W,False);

     Y:=Y+3; TStr:='Press any key to continue with this demo...';
     WriteText(TStr,X,Y,W,False);
end; { Display initial text }

Function Screen(X,Y:byte) : char;
{ Returns char at (X,Y) coor on screen }
var
     Mode : byte;
     VideoSegment : integer;
begin
     Mode:=Mem[$0040:$0049];  { Grab screen attribute byte }
     if (Mode=2) or (Mode=3) then { RGB monitor }
         VideoSegment:=Colour
     else { Monochrome monitor }
         VideoSegment:=MonoChrome;
     Screen:=chr(Mem[VideoSegment:(X-1)*2+((Y-1)*160)]);
end; { Function screen }

Procedure SaveText(X,Y,WWidth,WHeight:byte);
var
     IY,IX : byte;
begin
     WWidth:=WWidth+2; WHeight:=WHeight+2; { Add 2 chars for border }
     for IY:=Y to (Y+WHeight-1) do { Copy each row into SStr }
         for IX:=X to (X+WWidth-1) do { Copy each char to SStr } begin
              SStr[NumLines]:=Screen(IX,IY);
              NumLines:=NumLines+1;
         end;
end; { Save Text }

Procedure DrawWindow(X,Y,WWidth,WHeight:byte);
var
     IY,I          : byte;
     BarStr,SPCStr : String80;
begin
         BarStr:=''; SPCStr:='';
     for i:=1 to WWidth do begin      { Prepare two strings for use }
         BarStr:=BarStr+chr(196);     { in drawing the window   }
         SPCStr:=SPCStr+chr(32); end;
     GotoXY(X,Y);                     { Draw the top of the }
     Write(chr(218),BarStr,chr(191)); { window   }
     for iy:=(Y+1) to (Y+WHeight-1) do begin   { Draw the middle of the }
         GotoXY(X,IY);                         { window }
         Write(chr(179),SPCStr,chr(179)); end;
     GotoXY(X,Y+WHeight-1);           { Draw the bottom of the }
     Write(chr(192),BarStr,chr(217)); { window }
end; { Draw window }

Procedure AddWindow(X,Y,WWidth,WHeight:byte);
{ x,y             = (x,y) coordinates for upperleft of window
  WWidth, WHeight = window's width, wheight             }
begin
     NumWindows:=NumWindows+1; { Add one more window }
     WindowX[NumWindows]:=X; { Record window parameters in }
     WindowY[NumWindows]:=Y; { window arrays }
     WindowW[NumWindows]:=WWidth;
     WindowH[NumWindows]:=WHeight;
     SaveText(X,Y,WWidth,WHeight); { Save text within window }
     DrawWindow(X,Y,WWidth,WHeight); { Draw the window }
end; { Add window }

Procedure InitializeWindowRoutines;
begin
     NormVideo; ClrScr;
     NumLines:=1; NumWindows:=0;
     AddWindow(1,1,77,21);
     DisplayInitialText;
     Sound(440); Delay(30); NoSound;
     Repeat until KeyPressed;
end; { Initialize window routines }

Procedure RestoreText(X,Y,WWidth,WHeight:byte);
var
     IX,IY : byte;
begin
     WWidth:=WWidth+2; WHeight:=WHeight+2; { Add 2 chars for border }
     for IY:=(Y+WHeight-1) downto Y do
         for IX:=(X+WWidth-1) downto X do begin
              GotoXY(IX,IY);
              NumLines:=NumLines-1;
              Write(SStr[NumLines]);
         end;
end; { Restore text }

Procedure RemoveWindow;
{ Remove the last window generated }
var
     X,Y,WWidth,WHeight : byte;
begin
     X      :=WindowX[NumWindows];    { Let (X,Y) equal upper left }
     Y      :=WindowY[NumWindows];    { of window to remove. }
     WWidth :=WindowW[NumWindows];    { Window's width }
     WHeight:=WindowH[NumWindows];    { Window's height }
     NumWindows:=NumWindows-1;        { One less window now }
     RestoreText(X,Y,WWidth,WHeight); { Restore text }
end; { Remove window }

Procedure GetChar(var AH,AL:byte);

{ GetChar subroutine to fetch the scan code of a keypress via
  Turbo Pascal's interrupt facility by Andy Decepida. }

type
     RegPack = record
                   AX,BX,CX,DX,BP,SI,DS,ES,Flags:integer;
               end;
var
     Regs:RegPack;
begin
    AH:= $00;
    Regs.AX:=AH shl 8 + AL;
    Intr($16,Regs);
    AH:=Regs.AX shr 8;   { Grab high byte of AX -- contains the scan code  }
    AL:=Regs.AX mod 256; { Grab  low byte of AX -- contains the ascii code }
end; { Procedure GetChar }

Function HMenuSelection(HSelectionStr:HSelections; HNumSelections,HSelectionWidth,W:byte; CreateWindow:boolean):byte;
{ Hortizontal menu selection

  Inputs to this function:
   W               Which window to display the menu within
   HSelectionStr   The text of each menu selection
   HNumSelections  How many selections are in the menu
   HSelectWidth    How many columns each menu item gets
   CreateWindow    If true, create the window, else use the window
                   specified by W

   Returns the # of menu selection chosen.   }
label
     ExitHMS;
var
     X,Y,IY,WWidth,WHeight : byte;
     ScanByte,AsciiByte    : byte;
     Selection             : byte;
     TStr                  : String80;
begin
     X:=WindowX[W]; Y:=WindowY[W]; WWidth:=WindowW[W]; WHeight:=WindowH[W];
     if CreateWindow then { Create window if specified } begin
         AddWindow(X,Y,WWidth,WHeight);
         W:=NumWindows; end;
     X:=1; Y:=1; TStr:='';
     for iy:=1 to WWidth do TStr:=TStr+' '; { Blank inside of window only }
     WriteText(TStr,X,Y,W,False); { Clear out the current line }
     for iy:=1 to HNumSelections do { Display the selections } begin
         TStr:=HSelectionStr[iy];
         WriteText(TStr,X,Y,W,False);
         X:=X+HSelectWidth;
     end;
     X:=1; Selection:=1;
     repeat
         WriteText(HSelectionStr[Selection],X,Y,W,True);
         GetChar(ScanByte,AsciiByte);
         case ScanByte of
              75 : { Left arrow } begin
                   if (Selection>1) then begin
                        WriteText(HSelectionStr[Selection],X,Y,W,False);
                        X:=X-HSelectWidth;
                        Selection:=Selection-1;
              end; end;
              77 : { Right arrow } begin
                   if (Selection<HNumSelections) then begin
                        WriteText(HSelectionStr[Selection],X,Y,W,False);
                        X:=X+HSelectWidth;
                        Selection:=Selection+1;
              end; end;
         end;
     until (AsciiByte=CR);
ExitHMS:
     HMenuSelection:=Selection;
end; { Hortizontal menu selection }

Function VMenuSelection(W,Selection,HSelectWidth,VNumSelections,VSelectWidth:byte; VSelectionStr:VSelections):byte;
{ Vertical pull-down menu ----

  Input to this function:
        W                The # of the window holding the hort. menu
        Selection        The item selected on the hortizontal menu
        HSelectWidth     The # of columns for each item in that menu
        VSelectionStr()  A list of each menu item to appear
        VNumSelections   The # of selections in the pull-down menu
        VSelectWidth     How wide the pull-down menu should be

  Returns the # of the chosen menu selection }
label
     ExitVMS;
var
     iy,x,y : byte;
     ScanByte,AsciiByte : byte;
begin
     X:=WindowX[W]+(Selection-1)*HSelectWidth;   { Display window for menu }
     Y:=WindowY[W]+2;
     AddWindow(X,Y,VSelectWidth,VNumSelections+2); { Add two chars to height for borders }
     X:=1; Y:=1; W:=NumWindows;
     for iy:=1 to VNumSelections do begin
         WriteText(VSelectionStr[iy],X,Y,W,False);
         Y:=Y+1; end;
     X:=1; Y:=1; Selection:=1;
     repeat
         WriteText(VSelectionStr[Selection],X,Y,W,True);
         GetChar(ScanByte,AsciiByte);
         case ScanByte of
              72 { Up arrow } : begin
                   if (Selection>1) then begin
                        WriteText(VSelectionStr[Selection],X,Y,W,False);
                        Y:=Y-1; Selection:=Selection-1;
              end; end;
              80 { Down arrow } : begin
                   if (Selection<VNumSelections) then begin
                        WriteText(VSelectionStr[Selection],X,Y,W,False);
                        Y:=Y+1; Selection:=Selection+1;
              end; end;
         end;
     until (AsciiByte=CR);
ExitVMS:
     VMenuSelection:=Selection;
end; { Vertical pull-down menu }

Procedure Edit;
var
     TStr : String80;
     ScanByte,AsciiByte : byte;
begin
     TStr:='Edit: Enter text, press <ESC> when finished      ';
     WriteText(TStr,1,1,2,False);
     GetChar(ScanByte,AsciiByte);
     repeat until (AsciiByte=ESC);
     TStr:='                                            ';
     WriteText(TStr,1,1,2,False);
end; { Edit }

Procedure Exit;
begin
     RemoveWindow;
     RemoveWindow;
     GotoXY(36,12); WriteLn('Good Bye!');
     Halt;
end; { Exit }

Procedure Files;
var
     VSelectionStr : VSelections;
begin
     VSelectionStr[1]:='Get';
     VSelectionStr[2]:='Save';
     VSelectionStr[3]:='Delete';
     VSelectionStr[4]:='Return';
     case VMenuSelection(NumWindows,2,HSelectWidth,4,10,VSelectionStr) of
         1 : { Get file;  } Delay(1);
         2 : { Save file; } Delay(1);
         3 : { Del file;  } Delay(1);
         4 : { Do nothing;} Delay(1);
     end;
     RemoveWindow; { Remove the pull-down menu }
end; { Files }

Procedure Help;
var
     VSelectionStr : VSelections;
begin
     VSelectionStr[1]:='for Edit';
     VSelectionStr[2]:='for Files';
     VSelectionStr[3]:='for Print';
     VSelectionStr[4]:='Return';
     case VMenuSelection(NumWindows,4,HSelectWidth,4,10,VSelectionStr) of
         1 : { Edit help; } Sound(392);
         2 : { Files help;} Sound(440);
         3 : { Print help;} Sound(880);
         4 : { Do nothing;} Sound(1568);
     end;
         NoSound;
     RemoveWindow; { Remove the pull-down menu }
end; { Help }

Procedure Print;
var
     VSelectionStr : VSelections;
begin
     VSelectionStr[1]:='to Printer';
     VSelectionStr[2]:='to Disk';
     VSelectionStr[3]:='Return';
     case VMenuSelection(NumWindows,3,HSelectWidth,3,11,VSelectionStr) of
         1 : { Print to printer; } Delay(8);
         2 : { Print to disk;    } Delay(8);
         3 : { Do nothing...;    } Delay(8);
     end;
     RemoveWindow; { Remove the pull-down menu }
end; { Print }

var
     HSelectionStr : HSelections;
     CreateWindow  : boolean;
BEGIN
     InitializeWindowRoutines;
     CreateWindow:=True;
     HSelectionStr[1]:='Edit';
     HSelectionStr[2]:='Files';
     HSelectionStr[3]:='Print';
     HSelectionStr[4]:='Help';
     HSelectionStr[5]:='Exit';
     repeat
         case HMenuSelection(HSelectionStr,HNumSelections,HSelectWidth,NumWindows,CreateWindow) of
              1 : Edit;
              2 : Files;
              3 : Print;
              4 : Help;
              5 : Exit;
         end;
         CreateWindow:=False;
     until { Limbo } (CreateWindow=True);
END. { Main control block }