home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUILLET / TBDISPLA.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  7KB  |  203 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 276 of 295                                                               
  3. From : Bryce Ostenson                      1:282/4028.0         27 Jun 93  17:40
  4. To   : John Linden                                                               
  5. Subj : Timers            1/                                                   
  6. ────────────────────────────────────────────────────────────────────────────────
  7. JL>BO> Output the time directly to the screen using a absolute memory location.
  8. JL>BO> This does NOT use the cursor and is EASILY implemented in a TSR...  Just
  9. JL>BO> a thought...  On the timer interrupt...  It's called 18.2 times per
  10. JL>BO> second (approx.) and the error would add up... If the user was in your
  11. JL>BO> program too long the error WOULD become evident.  So I suggest perhaps,
  12. JL>BO> hooking onto the timer interrupt and obtaining the time such as through
  13. JL>BO> GETTIME() (I think that's right but I don't use it too much).  So the
  14. JL>BO> time is updated 18.2 times per second and yet is much more accurate,
  15.  
  16. JL>Do you have some code on doing this? So how do you write to the absolute?
  17.  
  18. JL>PrintTimer : STRING ABSOLUTE $B800: ???
  19.  
  20. JL>Then if you say PrintTimer := 5 will it print at at the location?? I'm
  21. JL>confused...
  22.  
  23. JL>C-Ya...}
  24.  
  25. Unit TBDisplay;
  26.  
  27.                                                                 INTERFACE
  28.  
  29. Const
  30.         { Colors }
  31.         Black = 0;
  32.         Blue = 1;
  33.         Green = 2;
  34.         Cyan = 3;
  35.         Red = 4;
  36.         Magenta = 5;
  37.         Brown = 6;
  38.         White = 7;
  39.         Gray = 8;
  40.         BrightBlue = 9;
  41.         BrightGreen = 10;
  42.         BrightCyan = 11;
  43.         BrightRed = 12;
  44.         BrightMagenta = 13;
  45.         BrightYellow = 14;
  46.         BrightWhite = 15;
  47.  
  48. Type
  49.         CharData = Record
  50.                 AsciiCode : Byte;
  51.                 Attribute : Byte;
  52.                 End;
  53.         DisplayCursor = Record
  54.                 X, Y : Byte;
  55.                 End;
  56.  
  57. Var { Global Variables }
  58.         DispArray : Array[1..2000] of CharData ABSOLUTE $B800:0000;
  59.         WordWrap : Boolean;
  60.         CurrentAttrib : Byte;
  61.         DispCrsr : DisplayCursor;
  62.  
  63. Procedure OutStr_DVid(OutStr : String; PosX, PosY : Byte);
  64. Procedure SetAttr_DVid(Blink : Boolean; Background : Byte;
  65.                                                 Foreground : Byte);
  66. Procedure ClrScr_DVid;
  67. Procedure SetCrsrPos_DVid(X, Y : Byte);
  68. Procedure GetCrsrPos_DVid(Var X, Y : Byte);
  69. Procedure ColorLine_DVid(LineNum, Color : Byte);
  70.  
  71.                                                           IMPLEMENTATION
  72.  
  73. Function StrToChar(SourceStr : String;
  74.                    Index : Byte) : Char;
  75.  
  76. Var
  77.         Temp_char : String[1];
  78.         Overlap : ^Word;
  79.  
  80. Begin
  81.         Temp_char := Copy(SourceStr,Index,1);
  82.         Overlap := @Temp_char;
  83.         StrToChar := Chr(Overlap^ DIV $FF);
  84. End;
  85.  
  86. Procedure ClrScr_DVid;
  87.  
  88. Var
  89.         Index : Word;
  90.  
  91. Begin
  92.         For Index := 1 to 2000 do
  93.         Begin
  94.                 DispArray[Index].AsciiCode := 32;
  95.                 DispArray[Index].Attribute := CurrentAttrib;
  96.         End;
  97. End;
  98.  
  99. Procedure OutStr_DVid(OutStr : String; PosX, PosY : Byte);
  100.  
  101. Var
  102.         Index : Integer;
  103.         Ch : Byte;
  104.         ArrayPos : Word;
  105.  
  106. Begin
  107.         For Index := 1 to Length(OutStr) do
  108.         Begin
  109.                 Ch := Ord(StrToChar(OutStr,Index));
  110.                 ArrayPos := PosY * 80 + PosX + Index;
  111.                 If (PosX = $FF) AND (PosY = $FF) then
  112.                 Begin
  113.                         DispArray[DispCrsr.X + DispCrsr.Y * 80].AsciiCode :=
  114. ch;
  115.                         DispArray[DispCrsr.X + DispCrsr.Y * 80].Attribute :=
  116. Cur
  117.                         DispCrsr.X := DispCrsr.X + 1;
  118.                         If DispCrsr.X > 79 then
  119.                         Begin
  120.                                 DispCrsr.X := 0;
  121.                                 DispCrsr.Y := DispCrsr.Y + 1;
  122.                         End;
  123.                 End
  124.                 Else
  125.                 Begin
  126.                         DispArray[ArrayPos].AsciiCode := ch;
  127.                         DispArray[ArrayPos].Attribute := CurrentAttrib;
  128.                 End;
  129.                 If (WordWrap = False) AND ((Index + PosX) > 80) then
  130.                         Exit;
  131.         End;
  132. End;
  133.  
  134. Procedure SetAttr_DVid(Blink : Boolean; Background : Byte;
  135.                                                 Foreground : Byte);
  136.  
  137. Begin
  138.         If Blink = true then
  139.                 CurrentAttrib := $80
  140.         Else
  141.                 CurrentAttrib := 0;
  142.         CurrentAttrib := CurrentAttrib + $10 * (Background AND $07);
  143.         CurrentAttrib := CurrentAttrib + Foreground;
  144. End;
  145.  
  146. Procedure SetCrsrPos_DVid(X, Y : Byte);
  147.  
  148. Begin
  149.         DispCrsr.X := X;
  150.         DispCrsr.Y := Y;
  151. End;
  152.  
  153. Procedure GetCrsrPos_DVid(Var X, Y : Byte);
  154.  
  155. Begin
  156.         X := DispCrsr.X;
  157.         Y := DispCrsr.Y;
  158. End;
  159.  
  160. Procedure ColorLine_DVid(LineNum, Color : Byte);
  161.  
  162. Var
  163.         Index : Byte;
  164.  
  165. Begin
  166.         For Index := 1 to 80 do
  167.                 DispArray[LineNum*80 + Index].Attribute := (Color AND $07) *
  168. 16;
  169. End;
  170.  
  171. Begin
  172.         WordWrap := True;  { Initalize word wrap to true. }
  173.         CurrentAttrib := $07; { Set current text colors to White on black. }
  174. End.
  175.  
  176. Here's the unit I use, I decided to just import it.
  177.  
  178. Program TestTimer;
  179.  
  180. Uses
  181.         TBDisp;
  182.  
  183. Begin
  184.         {First get the time, you can do that}
  185.         {Create the string to be displayed, again I'll let you do that.}
  186.         {Set the text color for the display}
  187.         SetAttr_DVid(False,Blue,Yellow);
  188.         {Display the text}
  189.         OutStr_DVid(TimeStr,70,25);
  190.         {That's it}
  191. End.
  192.  
  193. Ok, it will display TimeStr in Yellow type on a blue background at row
  194. 25, column 70.  Sorry, but I didn't use many comments in the unit as you
  195. are the first person that I've given it to, and since I wrote it and use
  196. it very often, I know it.  A small note, If you use the OutStr_DVid
  197. procedure and supply it with text positions of 255($FF) for it column
  198. and 255($FF) for it's row, it will display the text at IT'S cursor
  199. position not the cursor position as used by GotoXY or Write(ln), etc...
  200. In other words it HAS it's own cursor, but it's purely logical, not
  201. actually displayed on the screen.  One other thing, SetAttr_DVid,
  202. changes this UNITS, text color and background color, not the ones used
  203. by Writeln, etc...  I hope this helps...