home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / crt.swg / 0018_Small CRT Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  1.8 KB  |  83 lines
  1.  
  2. Unit sCrt;
  3.  
  4. InterFace
  5.  
  6. uses
  7.   Crt;
  8.  
  9. procedure init;
  10. procedure ws(X, Y, Atr : Byte; Ch : Char);
  11. function  rs(X, Y : byte) : Char;
  12. procedure wst(X, Y, Atr : Byte; S : String);
  13. procedure WstCenter(X, Y, Atr : Byte; Str : string);
  14. procedure WstRight(X, Y, Atr : Byte; Str : string);
  15.  
  16. Implementation
  17.  
  18. var
  19.   ScreenSeg : longint;
  20.   att       : byte;                (* atributt(se over) *)
  21.  
  22. procedure init;
  23. (* Denne prosedyren finner ut skjermadressen i RAM og setter att *)
  24. (* til 15 (hvitt p} sort), dette funker b}de p} farge og monoskjerm *)
  25. begin
  26.   if (Mem[0000:1040] and 48) <> 48 then
  27.     ScreenSeg := $B800
  28.   else
  29.     ScreenSeg := $B000;
  30.   Att := 15;
  31. end;
  32.  
  33. procedure ws(X, Y, Atr : Byte; Ch : Char);
  34. (* Skriver ut et tegn(thischar) i posisjon (col,row), der col er *)
  35. (* vanrett (1-80) og row er loddrett (1-25) *)
  36. var
  37.   locationCode : Integer;
  38. begin
  39.   Att := Atr;
  40.   locationCode := (X - 1) * 2 + (Y - 1) * 160;
  41.   Mem[screenseg : locationcode] := Ord(Ch);
  42.   Mem[screenseg : locationcode + 1] := Atr;
  43. end;
  44.  
  45. function rs(X, Y : byte) : Char;
  46. (* Leser et tegn p} skjermen i pos. col,row *)
  47. var
  48.   locationcode : Integer;
  49. begin
  50.    LocationCode := (X - 1) * 2 + (Y - 1) * 160;
  51.    rs := chr(Mem[ScreenSeg:LocationCode]);
  52. end;
  53.  
  54. procedure wst(X, Y, Atr : Byte; S : String);
  55. (* Skriver ut en streng til skjermen i pos. x,y *)
  56. var
  57.   t : Byte;
  58. begin
  59.    for t := 1 to Length(S) do
  60.      ws(x + t - 1, y, Atr, S(.t.));
  61. end;
  62.  
  63. procedure WstCenter(X, Y, Atr : Byte; Str : string);
  64. var
  65.   t : Byte;
  66. begin
  67.   for t := 1 to Length(Str) do
  68.     Ws(t + X - (Length(Str) div 2), Y, Atr, Str[t]);
  69. end;
  70.  
  71. procedure WstRight(X, Y, Atr : Byte; Str : string);
  72. var
  73.   t : Byte;
  74. begin
  75.   for t := 1 to Length(Str) do
  76.     Ws(t + X - Length(Str), Y, Atr, Str[t]);
  77. end;
  78.  
  79.  
  80. begin
  81.   Init;
  82. end.
  83.