home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / turbo55 / install / demos.arc / WIN.PAS < prev    next >
Pascal/Delphi Source File  |  1989-05-02  |  3KB  |  131 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 5.5                        }
  5. {       Window Interface Unit                           }
  6. {                                                       }
  7. {       Copyright (C) 1989 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Win;
  12.  
  13. {$D-,S-}
  14.  
  15. interface
  16.  
  17. uses Crt;
  18.  
  19. type
  20.  
  21. { Window title string }
  22.  
  23.   TitleStr = string[63];
  24.  
  25. { Window frame characters }
  26.  
  27.   FrameChars = array[1..8] of Char;
  28.  
  29. { Window state record }
  30.  
  31.   WinState = record
  32.     WindMin, WindMax: Word;
  33.     WhereX, WhereY: Byte;
  34.     TextAttr: Byte;
  35.   end;
  36.  
  37. const
  38.  
  39. { Standard frame character sets }
  40.  
  41.   SingleFrame: FrameChars = '┌─┐││└─┘';
  42.   DoubleFrame: FrameChars = '╔═╗║║╚═╝';
  43.  
  44. { Direct write routines }
  45.  
  46. procedure WriteStr(X, Y: Byte; S: String; Attr: Byte);
  47. procedure WriteChar(X, Y, Count: Byte; Ch: Char; Attr: Byte);
  48.  
  49. { Window handling routines }
  50.  
  51. procedure FillWin(Ch: Char; Attr: Byte);
  52. procedure ReadWin(var Buf);
  53. procedure WriteWin(var Buf);
  54. function WinSize: Word;
  55. procedure SaveWin(var W: WinState);
  56. procedure RestoreWin(var W: WinState);
  57. procedure FrameWin(Title: TitleStr; var Frame: FrameChars;
  58.   TitleAttr, FrameAttr: Byte);
  59. procedure UnFrameWin;
  60.  
  61. implementation
  62.  
  63. {$L WIN}
  64.  
  65. procedure WriteStr(X, Y: Byte; S: String; Attr: Byte);
  66. external {WIN};
  67.  
  68. procedure WriteChar(X, Y, Count: Byte; Ch: Char; Attr: Byte);
  69. external {WIN};
  70.  
  71. procedure FillWin(Ch: Char; Attr: Byte);
  72. external {WIN};
  73.  
  74. procedure WriteWin(var Buf);
  75. external {WIN};
  76.  
  77. procedure ReadWin(var Buf);
  78. external {WIN};
  79.  
  80. function WinSize: Word;
  81. external {WIN};
  82.  
  83. procedure SaveWin(var W: WinState);
  84. begin
  85.   W.WindMin := WindMin;
  86.   W.WindMax := WindMax;
  87.   W.WhereX := WhereX;
  88.   W.WhereY := WhereY;
  89.   W.TextAttr := TextAttr;
  90. end;
  91.  
  92. procedure RestoreWin(var W: WinState);
  93. begin
  94.   WindMin := W.WindMin;
  95.   WindMax := W.WindMax;
  96.   GotoXY(W.WhereX, W.WhereY);
  97.   TextAttr := W.TextAttr;
  98. end;
  99.  
  100. procedure FrameWin(Title: TitleStr; var Frame: FrameChars;
  101.   TitleAttr, FrameAttr: Byte);
  102. var
  103.   W, H, Y: Word;
  104. begin
  105.   W := Lo(WindMax) - Lo(WindMin) + 1;
  106.   H := Hi(WindMax) - Hi(WindMin) + 1;
  107.   WriteChar(1, 1, 1, Frame[1], FrameAttr);
  108.   WriteChar(2, 1, W - 2, Frame[2], FrameAttr);
  109.   WriteChar(W, 1, 1, Frame[3], FrameAttr);
  110.   if Length(Title) > W - 2 then Title[0] := Chr(W - 2);
  111.   WriteStr((W - Length(Title)) shr 1 + 1, 1, Title, TitleAttr);
  112.   for Y := 2 to H - 1 do
  113.   begin
  114.     WriteChar(1, Y, 1, Frame[4], FrameAttr);
  115.     WriteChar(W, Y, 1, Frame[5], FrameAttr);
  116.   end;
  117.   WriteChar(1, H, 1, Frame[6], FrameAttr);
  118.   WriteChar(2, H, W - 2, Frame[7], FrameAttr);
  119.   WriteChar(W, H, 1, Frame[8], FrameAttr);
  120.   Inc(WindMin, $0101);
  121.   Dec(WindMax, $0101);
  122. end;
  123.  
  124. procedure UnFrameWin;
  125. begin
  126.   Dec(WindMin, $0101);
  127.   Inc(WindMax, $0101);
  128. end;
  129.  
  130. end.
  131.