1 | unit UTextScreen;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Types, Graphics, SysUtils, UConsole, Forms;
|
---|
7 |
|
---|
8 | type
|
---|
9 | TTextScreenCharacter = record
|
---|
10 | Character: Char;
|
---|
11 | TextColor: TColor;
|
---|
12 | BackgroundColor: TColor;
|
---|
13 | end;
|
---|
14 |
|
---|
15 | TTextMatrix = array of array of TTextScreenCharacter;
|
---|
16 |
|
---|
17 | TOnPaintCharEvent = procedure(Position: TPoint; Character: Char; TextColor, BackgroundColor: TColor; CursorVisible: Boolean) of object;
|
---|
18 | TOnSizeChangeEvent = procedure(Size: TPoint) of object;
|
---|
19 |
|
---|
20 | TTextScreen = class
|
---|
21 | private
|
---|
22 | Dimensions: TPoint;
|
---|
23 | CharMatrix: TTextMatrix;
|
---|
24 | FOnPaintChar: TOnPaintCharEvent;
|
---|
25 | FOnSizeChange: TOnSizeChangeEvent;
|
---|
26 | procedure WriteChar(Character: Char);
|
---|
27 | public
|
---|
28 | CursorBlinkState: Boolean;
|
---|
29 | CursorPosition: TPoint;
|
---|
30 | TextColor: TColor;
|
---|
31 | BackgroundColor: TColor;
|
---|
32 | CursorVisible: Boolean;
|
---|
33 | constructor Create;
|
---|
34 | function Width: Integer;
|
---|
35 | function Height: Integer;
|
---|
36 | procedure WriteLn(Text: string); overload;
|
---|
37 | procedure WriteLn; overload;
|
---|
38 | procedure Write(Text: string);
|
---|
39 | procedure GotoXY(X, Y: Integer);
|
---|
40 | procedure Clear;
|
---|
41 | procedure ClearEol;
|
---|
42 | procedure Scroll;
|
---|
43 | procedure SetSize(Size: TPoint);
|
---|
44 | procedure PaintChar(Position: TPoint);
|
---|
45 | procedure Paint;
|
---|
46 | property OnPaintChar: TOnPaintCharEvent read FOnPaintChar write FOnPaintChar;
|
---|
47 | property OnSizeChange: TOnSizeChangeEvent read FOnSizeChange write FOnSizeChange;
|
---|
48 | end;
|
---|
49 |
|
---|
50 | implementation
|
---|
51 |
|
---|
52 | { TTextScreen }
|
---|
53 |
|
---|
54 | procedure TTextScreen.Clear;
|
---|
55 | var
|
---|
56 | X: Integer;
|
---|
57 | Y: Integer;
|
---|
58 | begin
|
---|
59 | for Y := 0 to Dimensions.Y - 1 do
|
---|
60 | for X := 0 to Dimensions.X - 1 do begin
|
---|
61 | CharMatrix[Y, X].Character := ' ';
|
---|
62 | CharMatrix[Y, X].TextColor := TextColor;
|
---|
63 | CharMatrix[Y, X].BackgroundColor := BackGroundColor;
|
---|
64 | end;
|
---|
65 | CursorPosition := Point(0, 0);
|
---|
66 | Paint;
|
---|
67 | end;
|
---|
68 |
|
---|
69 | procedure TTextScreen.ClearEol;
|
---|
70 | var
|
---|
71 | I: Integer;
|
---|
72 | begin
|
---|
73 | for I := CursorPosition.X to Dimensions.X - 1 do
|
---|
74 | WriteChar(' ');
|
---|
75 | end;
|
---|
76 |
|
---|
77 | constructor TTextScreen.Create;
|
---|
78 | begin
|
---|
79 | SetSize(Point(40, 25));
|
---|
80 | BackGroundColor := clBlack;
|
---|
81 | TextColor := clWhite;
|
---|
82 | CursorVisible := True;
|
---|
83 | Clear;
|
---|
84 | end;
|
---|
85 |
|
---|
86 | procedure TTextScreen.GotoXY(X, Y: Integer);
|
---|
87 | begin
|
---|
88 | CursorPosition := Point(X, Y);
|
---|
89 | end;
|
---|
90 |
|
---|
91 | function TTextScreen.Height: Integer;
|
---|
92 | begin
|
---|
93 | Result := Dimensions.Y;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | procedure TTextScreen.Paint;
|
---|
97 | var
|
---|
98 | X: Integer;
|
---|
99 | Y: Integer;
|
---|
100 | begin
|
---|
101 | for Y := 0 to Dimensions.Y - 1 do
|
---|
102 | for X := 0 to Dimensions.X - 1 do
|
---|
103 | PaintChar(Point(X, Y));
|
---|
104 | end;
|
---|
105 |
|
---|
106 | procedure TTextScreen.PaintChar(Position: TPoint);
|
---|
107 | begin
|
---|
108 | if Assigned(FOnPaintChar) then
|
---|
109 | with CharMatrix[Position.Y, Position.X] do
|
---|
110 | FOnPaintChar(Position, Character, TextColor, BackgroundColor, CursorVisible and (CursorPosition.X = Position.X) and
|
---|
111 | (CursorPosition.Y = Position.Y) and CursorBlinkState);
|
---|
112 | end;
|
---|
113 |
|
---|
114 | procedure TTextScreen.Scroll;
|
---|
115 | var
|
---|
116 | X: Integer;
|
---|
117 | Y: Integer;
|
---|
118 | begin
|
---|
119 | // Shift lines up
|
---|
120 | for Y := 0 to Dimensions.Y - 2 do
|
---|
121 | for X := 0 to Dimensions.X - 1 do begin
|
---|
122 | CharMatrix[Y, X] := CharMatrix[Y + 1, X];
|
---|
123 | end;
|
---|
124 | // Clear last bottom line
|
---|
125 | for X := 0 to Dimensions.X - 1 do begin
|
---|
126 | CharMatrix[Dimensions.Y - 1, X].Character := ' ';
|
---|
127 | CharMatrix[Dimensions.Y - 1, X].TextColor := TextColor;
|
---|
128 | CharMatrix[Dimensions.Y - 1, X].BackgroundColor := BackGroundColor;
|
---|
129 | end;
|
---|
130 | Paint;
|
---|
131 | end;
|
---|
132 |
|
---|
133 | procedure TTextScreen.SetSize(Size: TPoint);
|
---|
134 | begin
|
---|
135 | Dimensions := Size;
|
---|
136 | SetLength(CharMatrix, Size.Y, Size.X);
|
---|
137 | if Assigned(FOnSizeChange) then FOnSizeChange(Size);
|
---|
138 | Paint;
|
---|
139 | end;
|
---|
140 |
|
---|
141 | function TTextScreen.Width: Integer;
|
---|
142 | begin
|
---|
143 | Result := Dimensions.X;
|
---|
144 | end;
|
---|
145 |
|
---|
146 | procedure TTextScreen.WriteChar(Character: Char);
|
---|
147 | begin
|
---|
148 | CursorBlinkState := False;
|
---|
149 | if Character = #8 then begin
|
---|
150 | PaintChar(CursorPosition);
|
---|
151 | Dec(CursorPosition.X);
|
---|
152 | if CursorPosition.X < 0 then begin
|
---|
153 | CursorPosition.X := Dimensions.X - 1;
|
---|
154 | Dec(CursorPosition.Y);
|
---|
155 | if CursorPosition.Y < 0 then CursorPosition.Y := 0;
|
---|
156 | end;
|
---|
157 | CharMatrix[CursorPosition.Y, CursorPosition.X].Character := ' ';
|
---|
158 | PaintChar(CursorPosition);
|
---|
159 | end else
|
---|
160 | if Character = #13 then begin
|
---|
161 | CursorPosition.X := 0;
|
---|
162 | Inc(CursorPosition.Y);
|
---|
163 | if CursorPosition.Y >= Dimensions.Y then begin
|
---|
164 | Dec(CursorPosition.Y);
|
---|
165 | Scroll;
|
---|
166 | end;
|
---|
167 | end else
|
---|
168 | if Character < #32 then begin
|
---|
169 | end else begin
|
---|
170 | CharMatrix[CursorPosition.Y, CursorPosition.X].Character := Character;
|
---|
171 | CharMatrix[CursorPosition.Y, CursorPosition.X].TextColor := TextColor;
|
---|
172 | CharMatrix[CursorPosition.Y, CursorPosition.X].BackgroundColor := BackGroundColor;
|
---|
173 | PaintChar(CursorPosition);
|
---|
174 | Inc(CursorPosition.X);
|
---|
175 | if CursorPosition.X >= Dimensions.X then begin
|
---|
176 | CursorPosition.X := 0;
|
---|
177 | Inc(CursorPosition.Y);
|
---|
178 | if CursorPosition.Y >= Dimensions.Y then begin
|
---|
179 | Dec(CursorPosition.Y);
|
---|
180 | Scroll;
|
---|
181 | end;
|
---|
182 | end;
|
---|
183 | end;
|
---|
184 | end;
|
---|
185 |
|
---|
186 | procedure TTextScreen.WriteLn;
|
---|
187 | begin
|
---|
188 | Write(#13#10);
|
---|
189 | end;
|
---|
190 |
|
---|
191 | procedure TTextScreen.WriteLn(Text: string);
|
---|
192 | begin
|
---|
193 | Write(Text + #13#10);
|
---|
194 | end;
|
---|
195 |
|
---|
196 | procedure TTextScreen.Write(Text: string);
|
---|
197 | var
|
---|
198 | I: Integer;
|
---|
199 | begin
|
---|
200 | for I := 1 to Length(Text) do begin
|
---|
201 | if Text[I] = #13 then CursorPosition.X := 0
|
---|
202 | else if Text[I] = #10 then begin
|
---|
203 | Inc(CursorPosition.Y);
|
---|
204 | if CursorPosition.Y >= Dimensions.Y then begin
|
---|
205 | Dec(CursorPosition.Y);
|
---|
206 | Scroll;
|
---|
207 | end;
|
---|
208 | end else WriteChar(Text[I]);
|
---|
209 | end;
|
---|
210 | end;
|
---|
211 |
|
---|
212 | end.
|
---|