home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / DSKCACHE / EVALCACH.ZIP / CHARSCRN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-26  |  4.2 KB  |  195 lines
  1. {
  2. ***************************************************************************
  3. CHARSCRN.PAS -- Character-oriented screen routines/objects for Turbo Pascal
  4. Copyright 1989 L. Brett Glass -- All rights reserved.
  5. ***************************************************************************
  6. }
  7. unit CharScrn;
  8.  
  9. interface
  10.  
  11. uses DOS,CRT;
  12.  
  13. const
  14.   FIRSTCOL = 1; {Numbering of rows and columns}
  15.   SECONDCOL = Succ(FIRSTCOL);
  16.   LASTCOL = 80;
  17.  
  18.   FIRSTROW = 1;
  19.   LASTROW = 25;
  20.  
  21.   SCREENHEIGHT = Succ(LASTROW - FIRSTROW);
  22.   SCREENWIDTH = Succ(LASTCOL - FIRSTCOL);
  23.  
  24.   CURSOROFF = $2000; {Cursor mode which turns cursor off on all video cards }
  25.  
  26. type
  27.   ColType = FIRSTCOL..LASTCOL;
  28.   RowType = FIRSTROW..LASTROW;
  29.   WidthType = 1..SCREENWIDTH;
  30.   HeightType = 1..SCREENHEIGHT;
  31.  
  32.   CharObject = object
  33.     x : ColType;
  34.     y : RowType
  35.     end;
  36.  
  37.   ScreenParms = object (CharObject)
  38.     {Used to save screen parameters during routines}
  39.     cursorMode : Integer;  {that change them while they work}
  40.     attribute : Byte;
  41.     {Methods}
  42.     procedure Save;
  43.     procedure Restore;
  44.     end;
  45.  
  46.   VisibleCharObject = object (CharObject)
  47.     color : Byte;
  48.     dirty : Boolean;
  49.     {Methods}
  50.     procedure Draw; virtual;
  51.     procedure Refresh; {Draw if dirty}
  52.     end;
  53.  
  54.   TitledCharObject = object(VisibleCharObject)
  55.     title : String[SCREENWIDTH];
  56.     {Methods}
  57.     procedure DispTitle; virtual;
  58.     procedure Draw; virtual;
  59.     end;
  60.  
  61. var
  62.   cursorOn : Word; {Cursor mode to turn cursor on for this specific card}
  63.  
  64. procedure CharToScreen(x : ColType; y : RowType; ch : Char);
  65.   {Write a character to the screen at an arbitrary spot}
  66.  
  67. procedure CharsToScreen(x : ColType; y : RowType; len : Word; var chars);
  68.   {Write an array of characters to the screen.}
  69.  
  70. procedure FillBox(left : ColType; top : RowType;
  71.                   width : WidthType; height : HeightType;
  72.                   value : Char);
  73.   { Fill a rectangular region of the screen with the character, using
  74.     the current attribute.}
  75.  
  76. { Cursor operations }
  77.  
  78. function GetCursorMode: Word;
  79.   {Get cursor mode from BIOS}
  80.  
  81. procedure SetCursorMode(mode : Word);
  82.   {Set cursor mode through BIOS}
  83.  
  84. implementation
  85.  
  86. procedure CharToScreen(x : ColType; y : RowType; ch : Char);
  87. begin
  88. GoToXY(x,y);
  89. Write(ch)
  90. end; {CharsToScreen}
  91.  
  92. procedure CharsToScreen(x : ColType; y : RowType; len : Word; var chars);
  93. var
  94.   charPtr : ^Char;
  95.   charOfs : Word absolute charPtr;
  96.   i : Word;
  97. begin
  98. GoToXY(x,y);
  99. charPtr := Addr(chars);
  100. for i := 1 to len do
  101.   begin
  102.   Write(charPtr^);
  103.   Inc(charOfs)
  104.   end
  105. end; {CharsToScreen}
  106.  
  107. procedure FillBox(left : ColType; top : RowType;
  108.                   width : WidthType; height : HeightType; value : Char);
  109. var
  110.   i,j : Word;
  111. begin
  112. for i := top to Pred(top + height) do
  113.   begin
  114.   GoToXY(left,i);
  115.   for j := left to Pred(left + width) do
  116.     Write(value)
  117.   end
  118. end; {FillBox}
  119.  
  120. function GetCursorMode : Word;
  121. var
  122.   regs : Registers;
  123.  
  124. begin {GetCursorMode}
  125. regs.ax := $300;
  126. Intr($10,regs);
  127. GetCursorMode := regs.cx;
  128. end;  {GetCursorMode}
  129.  
  130. procedure SetCursorMode(mode : Word);
  131. var
  132.   regs : Registers;
  133. begin {SetCursorMode}
  134. regs.ax := $100;
  135. regs.cx := mode;
  136. Intr($10,regs)
  137. end;  {SetCursorMode}
  138.  
  139. procedure ScreenParms.Save;
  140. begin
  141. cursorMode := GetCursorMode;
  142. attribute  := TextAttr;
  143. x := WhereX;
  144. y := WhereY;
  145. end;
  146.  
  147. procedure ScreenParms.Restore;
  148. begin
  149. SetCursorMode(cursorMode);
  150. TextAttr := attribute;
  151. GotoXY(x,y);
  152. end;
  153.  
  154. procedure VisibleCharObject.Refresh;
  155. begin
  156. if dirty then
  157.   self.Draw
  158. end; {VisibleCharObject.Refresh}
  159.  
  160. procedure VisibleCharObject.Draw;
  161. const
  162.   questionChar : Char = '?';
  163. var
  164.   p : ScreenParms;
  165. begin
  166. p.Save;
  167. TextAttr := color;
  168. CharsToScreen(x,y,1,questionChar);
  169. p.Restore;
  170. end; {VisibleCharObject.Draw}
  171.  
  172. procedure TitledCharObject.DispTitle;
  173. var
  174.   p : ScreenParms;
  175. begin
  176. p.Save;
  177. TextAttr := color;
  178. CharsToScreen(x,y,Length(title),title[1]);
  179. p.Restore
  180. end; {TitledCharObject.DispTitle}
  181.  
  182. procedure TitledCharObject.Draw;
  183. begin
  184. if Length(title) = 0 then
  185.   VisibleCharObject.Draw
  186. else
  187.   self.DispTitle
  188. end; {TitledCharObject.DispTitle}
  189.  
  190. begin
  191. if lastMode = MONO then
  192.   cursorOn := $0B0C { start/end scan lines }
  193. else
  194.   cursorOn := $0607;
  195. end.