home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WINDOW.ZIP / WINDOW32.INC < prev    next >
Encoding:
Text File  |  1987-02-20  |  13.4 KB  |  302 lines
  1. { =========================================================================== }
  2. { Window32.inc - Multi-level windowing routines             ver 3.2, 02-20-87 }
  3. {                                                                             }
  4. { This file allows you to produce quick multi-level windows for IBM PC/XT/AT  }
  5. { compatibles in any column mode (40/80/etc.).  You should get a copy of      }
  6. { QWIK21.ARC or a later version to make full use of quick screen writing      }
  7. { utilites.  This file has been released under the free Teamware concept.     }
  8. {   Editor:   Jim H. LeMay     (Author of QWIK21.INC and editor of this file) }
  9. {   Author:   Michael Burton   (Original author of WINDO.INC version 2.3)     }
  10. { =========================================================================== }
  11.  
  12. type
  13.   Borders = (NoBrdr, BlankBrdr, SingleBrdr, DoubleBrdr, MixedBrdr, SolidBrdr,
  14.              EvenSolidBrdr, ThinSolidBrdr, LhatchBrdr, MhatchBrdr,
  15.              HhatchBrdr, UserBrdr);
  16.   BrdrRec = record
  17.               TL,TH,TR,LV,RV,BL,BH,BR: string[1];
  18.             end;
  19.   DirType = (NoDir,Up,Down,VeryTop,Top,Bottom,VeryBottom,FarLeft,Left,Right,
  20.              FarRight,Center);
  21.   WndwStatType = record
  22.               WSrow,WScol,WSrows,WScols,WSWattr,WSBattr: byte;
  23.               WSbrdr: Borders;
  24.               WSshadow: DirType;
  25.               WSlastx,WSlasty: byte;
  26.             end;
  27.   BytePtr = ^byte;
  28.   Str160  = String[160];
  29.  
  30. { The following constants are typed so there's no need to change this file.  }
  31. { Just assign them new values in your main program like any other variable.  }
  32. { UserBrdr is also one you can use for scratch while keeping the others.     }
  33. const
  34.   Brdr: array [BlankBrdr..UserBrdr] of BrdrRec =
  35.     ((TL:' ';TH:' ';TR:' ';LV:' ';RV:' ';BL:' ';BH:' ';BR:' '),  { Blank     }
  36.      (TL:'┌';TH:'─';TR:'┐';LV:'│';RV:'│';BL:'└';BH:'─';BR:'┘'),  { Single    }
  37.      (TL:'╔';TH:'═';TR:'╗';LV:'║';RV:'║';BL:'╚';BH:'═';BR:'╝'),  { Double    }
  38.      (TL:'╒';TH:'═';TR:'╕';LV:'│';RV:'│';BL:'╘';BH:'═';BR:'╛'),  { Mixed     }
  39.      (TL:'█';TH:'█';TR:'█';LV:'█';RV:'█';BL:'█';BH:'█';BR:'█'),  { Solid     }
  40.      (TL:'█';TH:'▀';TR:'█';LV:'█';RV:'█';BL:'█';BH:'▄';BR:'█'),  { EvenSolid }
  41.      (TL:'▐';TH:'▀';TR:'▌';LV:'▐';RV:'▌';BL:'▐';BH:'▄';BR:'▌'),  { ThinSolid }
  42.      (TL:'░';TH:'░';TR:'░';LV:'░';RV:'░';BL:'░';BH:'░';BR:'░'),  { Lhatch    }
  43.      (TL:'▒';TH:'▒';TR:'▒';LV:'▒';RV:'▒';BL:'▒';BH:'▒';BR:'▒'),  { Mhatch    }
  44.      (TL:'▓';TH:'▓';TR:'▓';LV:'▓';RV:'▓';BL:'▓';BH:'▓';BR:'▓'),  { Hhatch    }
  45.      (TL:' ';TH:' ';TR:' ';LV:' ';RV:' ';BL:' ';BH:' ';BR:' ')); { User      }
  46.   ShadowEffect: DirType = NoDir;
  47.   ZoomEffect:   boolean = false;
  48.   ZoomDelay:    byte = 11;
  49.  
  50. var
  51.      WndwStat : Array [0..MaxWndw] of WndwStatType; { window stats         }
  52.      WndwPtr  : Array [1..MaxWndw] of BytePtr; { pointer to window on heap }
  53.      LI   : byte;                            { level index                 }
  54.      Tattr: byte absolute Dseg:$0008;        { Turbo's attribute value     }
  55.  
  56. { =========================================================================== }
  57. { NAME: Attr                                               ver 3.1,  02-11-87 }
  58. { DESCRIPTION: Converts Turbo color constants into an attribute               }
  59. {              and masks any accidental blink bit.                            }
  60. { PARAMETERS:  ForeGround - Color of text foreground                          }
  61. {              BackGround - Color of text background                          }
  62. { =========================================================================== }
  63. function Attr (Foreground,Background: byte): byte;
  64. begin
  65.   Attr := ((BackGround shl 4) + ForeGround) and 127;
  66. end;
  67.  
  68. { =========================================================================== }
  69. { NAME: Qbox                                               ver 3.1,  02-11-87 }
  70. { DESCRIPTION: Writes a window with optional border.  Since attribute         }
  71. {              is byte, the colors should always be specified.                }
  72. { PARAMETERS:  See QWIK21.DOC                                                 }
  73. { =========================================================================== }
  74. procedure Qbox (Row,Col,Rows,Cols,WndwAttr,BrdrAttr: byte; BrdrSel: Borders);
  75. begin
  76.   if (Rows>=2) and (Cols>=2) then
  77.   begin
  78.     if BrdrSel<>NoBrdr then
  79.       with Brdr[BrdrSel] do
  80.       begin
  81.         QwriteV (Row       ,Col                     ,BrdrAttr,TL);
  82.         Qfill   (Row       ,Col+1     ,1     ,Cols-2,BrdrAttr,TH);
  83.         QwriteV (Row       ,Col+Cols-1              ,BrdrAttr,TR);
  84.         Qfill   (Row+1     ,Col       ,Rows-2,1     ,BrdrAttr,LV);
  85.         Qfill   (Row+1     ,Col+Cols-1,Rows-2,1     ,BrdrAttr,RV);
  86.         QwriteV (Row+Rows-1,Col                     ,BrdrAttr,BL);
  87.         Qfill   (Row+Rows-1,Col+1     ,1     ,Cols-2,BrdrAttr,BH);
  88.         QwriteV (Row+Rows-1,Col+Cols-1              ,BrdrAttr,BR);
  89.         Qfill   (Row+1     ,Col+1     ,Rows-2,Cols-2,WndwAttr,' ')
  90.       end
  91.     else Qfill  (Row,Col,Rows,Cols,WndwAttr,' ');
  92.   end
  93. end;
  94.  
  95. { =========================================================================== }
  96. { NAME: InitWindow                                          ver 3.1, 02-11-87 }
  97. { DESCRIPTION:  Initializes the window variables.  Use this routine before    }
  98. {               using MakeWindow, RemoveWindow or TitleWindow                 }
  99. { PARAMETERS:                                                                 }
  100. {       Wattr - Starting window attribute                                     }
  101. { =========================================================================== }
  102. procedure InitWindow (Wattr: byte);
  103. begin
  104.    Qinit;                { QWIK21.INC initialization !!!! }
  105.    Tattr := Wattr;
  106.    LI := 0;
  107.    with WndwStat[LI] do
  108.    begin
  109.      WSrow   := 1;       { Initialize non-window zero }
  110.      WScol   := 1;
  111.      WSrows  := 25;
  112.      WScols  := 80;
  113.      WSWattr := Wattr;
  114.      WSBattr := Wattr;
  115.      WSbrdr  := NoBrdr;
  116.      WSlastx := WhereX;
  117.      WSlasty := WhereY
  118.    end;
  119.    Qfill ( 1, 1,25,80,Wattr,' ')
  120. end;
  121.  
  122. { =========================================================================== }
  123. { NAME: MakeWindow                                          ver 3.2, 02-20-87 }
  124. { DESCRIPTION:  Creates a window on your screen.                              }
  125. { PARAMETERS:                                                                 }
  126. {       Row    - First row        (1 - Screen limit)                          }
  127. {       Col    - First column     (1 - Screen limit)                          }
  128. {       Rows   - # of rows        (1 - Screen limit)                          }
  129. {       Cols   - # of columns     (1 - Screen limit)                          }
  130. {       Wattr  - Window attribute (0 - 255)                                   }
  131. {       Battr  - Border attribute (0 - 255)                                   }
  132. {       BrdSel - Border selection (NoBrdr - UserBrdr)                         }
  133. { =========================================================================== }
  134. procedure MakeWindow (Row,Col,Rows,Cols,Wattr,Battr: byte; BrdrSel: Borders);
  135. var wsize,r1,r2,c1,c2,ColRatio: integer;
  136. begin
  137.   if LI>=MaxWndw then WriteLn(^G^G,'Too many Windows!')
  138.   else
  139.   begin
  140.     case ShadowEffect of
  141.       Left:  begin
  142.                c1:=Col-2; c2:=Cols+2; r2:=Rows+1
  143.              end;
  144.       Right: begin
  145.                c1:=Col; c2:=Cols+2; r2:=Rows+1
  146.              end;
  147.       else   begin
  148.                c1:=Col; c2:=Cols; r2:=Rows;
  149.              end;
  150.     end;
  151.     wsize := r2*c2 shl 1;           { Memory size needed to store display }
  152.     if (0<memavail) and (memavail<=(wsize shr 4)) then
  153.       WriteLn(^G^G,'Not enough Heap space!')
  154.        { if memavail<0 then there's plenty of room (>512kb) }
  155.     else
  156.       begin
  157.         WndwStat[LI].WSlastx  := Wherex;   { Store old cursor coordinates }
  158.         WndwStat[LI].WSlasty  := Wherey;
  159.         LI := LI+1;            { Go to next window level }
  160.         Tattr := Wattr;
  161.         with WndwStat[LI] do
  162.         begin
  163.           WSrow   := Row;      { Store all variables for this window }
  164.           WScol   := Col;
  165.           WSrows  := Rows;
  166.           WScols  := Cols;
  167.           WSWattr := Wattr;
  168.           WSBattr := Battr;
  169.           WSbrdr  := BrdrSel;
  170.           WSshadow:= ShadowEffect
  171.         end;
  172.         GetMem (WndwPtr[LI],wsize);   { Get enough heap to store old display }
  173.         QstoreToMem (Row,c1,r2,c2,WndwPtr[LI]^);
  174.         if ZoomEffect then
  175.         begin
  176.           r1 := row+     (rows shr 1);
  177.           r2 := row+rows-(rows shr 1);
  178.           c1 := col+     (cols shr 1);
  179.           c2 := col+cols-(cols shr 1);
  180.           ColRatio := (cols div rows)+1;
  181.           if ColRatio>4 then ColRatio:=4;
  182.           repeat
  183.             if r1>row        then r1:=r1-1;
  184.             if r2<(row+rows) then r2:=r2+1;
  185.             if c1>col        then c1:=c1-ColRatio;
  186.             if c1<col        then c1:=col;
  187.             if c2<(col+cols) then c2:=c2+ColRatio;
  188.             if c2>(col+cols) then c2:=col+cols;
  189.             Qbox (r1,c1,r2-r1,c2-c1,Tattr,Battr,BrdrSel);
  190.             if Qwait=false then delay (ZoomDelay);
  191.           until  (c1=col) and (c2=col+cols) and (r1=row) and (r2=row+rows)
  192.         end
  193.         else Qbox (Row,Col,Rows,Cols,Wattr,Battr,BrdrSel);
  194.         case ShadowEffect of
  195.           Left:  begin
  196.                    Qfill (Row+1   ,Col-2,Rows-1,2   ,0,' ');
  197.                    Qfill (Row+Rows,Col-2,1     ,Cols,0,' ')
  198.                  end;
  199.           Right: begin
  200.                    Qfill (Row+1   ,Col+Cols,Rows-1,2   ,0,' ');
  201.                    Qfill (Row+Rows,Col+2   ,1     ,Cols,0,' ')
  202.                  end;
  203.         end;
  204.         if BrdrSel=NoBrdr then
  205.                Window (Col  ,Row  ,Col+Cols-1,Row+Rows-1)
  206.           else Window (Col+1,Row+1,Col+Cols-2,Row+Rows-2);
  207.         GotoXY (1,1)
  208.     end
  209.   end
  210. end;
  211.  
  212. { =========================================================================== }
  213. { NAME: RemoveWindow                                        ver 3.1, 02-11-87 }
  214. { DESCRIPTION: Remove the last window created from the screen.  To            }
  215. {              get back to the original screen, there must be as many         }
  216. {              RemoveWindow(s) as there are MakeWindow(s).                    }
  217. { =========================================================================== }
  218. procedure RemoveWindow;
  219. var wsize,r1,r2,c1,c2: integer;
  220. begin
  221.   if LI=0 then WriteLn (^G^G,'No Window To Remove!')
  222.   else
  223.   begin
  224.     with WndwStat[LI] do
  225.     begin
  226.       case WSshadow of
  227.         Left:  begin
  228.                  c1:=WScol-2; c2:=WScols+2; r2:=WSrows+1
  229.                end;
  230.         Right: begin
  231.                  c1:=WScol; c2:=WScols+2; r2:=WSrows+1
  232.                end;
  233.         else   begin
  234.                  c1:=WScol; c2:=WScols; r2:=WSrows;
  235.                end;
  236.       end;
  237.       wsize := r2*c2 shl 1;           { Memory size needed to restore display }
  238.       QstoreToScr (WSrow,c1,r2,c2,WndwPtr[LI]^);
  239.       FreeMem (WndwPtr[LI],wsize);
  240.     end;
  241.     LI := LI - 1;                   { Go to next lower level }
  242.     with WndwStat[LI] do
  243.     begin
  244.       Tattr:= WSWattr;
  245.       if WSbrdr=NoBrdr then
  246.              Window (WScol  ,WSrow  ,WScol+WScols-1,WSrow+WSrows-1)
  247.         else Window (WScol+1,WSrow+1,WScol+WScols-2,WSrow+WSrows-2);
  248.       GotoXY (WSlastx,WSlasty)
  249.     end
  250.   end
  251. end;
  252.  
  253. { =========================================================================== }
  254. { NAME: TitleWindow                                         ver 3.1, 02-11-87 }
  255. { DESCRIPTION: Places a centered title in the top border of a window          }
  256. { PARAMETERS:  Justify - justification of the title                           }
  257. {              Title - Optional title of the window                           }
  258. { =========================================================================== }
  259. procedure TitleWindow (Justify: DirType; title: Str160);
  260. begin
  261.   with WndwStat[LI] do
  262.     case Justify of
  263.        Left   : QwriteV  (WSrow,WScol+2, -1,title);
  264.        Center : QwriteCV (WSrow,WScol,WScol+WScols-1, -1,title);
  265.        Right  : QwriteV  (WSrow,WScol+WScols-Length(Title)-2, -1,title);
  266.     end;
  267. end;
  268.  
  269. { =========================================================================== }
  270. { NAME: ScrollWindow                                        ver 3.2, 02-20-87 }
  271. { DESCRIPTION: Scrolls a number of rows in a window.  Using a little          }
  272. {              thought, you can see how this is better than the InsLine       }
  273. {              and DelLine procedures.  This also works on any page.          }
  274. { PARAMETERS:  RowBegin,RowEnd - Rows to be affected                          }
  275. {              Dir             - 'Up' or 'Down'                               }
  276. { =========================================================================== }
  277. procedure ScrollWindow (RowBegin,RowEnd: byte; Dir: DirType);
  278. var BrdrWidth,R,C,Rs,Cs: byte;
  279. {}procedure Qscroll (MemRowBegin,ScrRowBegin,FillRow: byte);
  280.   var Temp: array[1..14000] of byte;   { large enough for 132x50 }
  281.   begin
  282.     QstoreToMem (MemRowBegin,C,Rs,Cs,Temp);
  283.     QstoreToScr (ScrRowBegin,C,Rs,Cs,Temp);
  284.     Qfill       (FillRow    ,C, 1,Cs,WndwStat[LI].WSWattr,' ')
  285. {}end;
  286. begin
  287.   with WndwStat[LI] do
  288.   begin
  289.     if WSbrdr=NoBrdr then
  290.          BrdrWidth:=0
  291.     else BrdrWidth:=1;
  292.     R  := WSrow+BrdrWidth+RowBegin-1;
  293.     C  := WScol+BrdrWidth;
  294.     Rs := RowEnd-RowBegin;
  295.     Cs := WScols-(BrdrWidth shl 1);
  296.     case Dir of
  297.       Up:   Qscroll (R+1,R  ,R+Rs);
  298.       Down: Qscroll (R  ,R+1,R   );
  299.     end
  300.   end
  301. end;
  302.