1 | unit UMainForm;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
---|
7 | Dialogs, ExtCtrls, UMyConsoleApp, StdCtrls;
|
---|
8 |
|
---|
9 | type
|
---|
10 | TMainForm = class;
|
---|
11 |
|
---|
12 | TMainThread = class(TThread)
|
---|
13 | Parent: TMainForm;
|
---|
14 | Character: Char;
|
---|
15 | TextColor: TColor;
|
---|
16 | BackgroundColor: TColor;
|
---|
17 | Position: TPoint;
|
---|
18 | CursorVisible: Boolean;
|
---|
19 | Size: TPoint;
|
---|
20 | procedure DoPaintChar;
|
---|
21 | procedure DoSizeChange;
|
---|
22 | procedure Execute; override;
|
---|
23 | end;
|
---|
24 |
|
---|
25 | TMainForm = class(TForm)
|
---|
26 | Image1: TImage;
|
---|
27 | Timer1: TTimer;
|
---|
28 | Button1: TButton;
|
---|
29 | procedure Timer1Timer(Sender: TObject);
|
---|
30 | procedure FormDestroy(Sender: TObject);
|
---|
31 | procedure FormCreate(Sender: TObject);
|
---|
32 | procedure FormKeyPress(Sender: TObject; var Key: Char);
|
---|
33 | procedure Button1Click(Sender: TObject);
|
---|
34 | private
|
---|
35 | Dimensions: TPoint;
|
---|
36 | CharacterSize: TPoint;
|
---|
37 | MainThread: TMainThread;
|
---|
38 | procedure TextScreenPaintChar(Position: TPoint; Character: Char; TextColor, BackgroundColor: TColor; CursorVisible: Boolean);
|
---|
39 | procedure TextScreenSizeChange(Size: TPoint);
|
---|
40 | public
|
---|
41 | MyConsoleApp: TMyConsoleApp;
|
---|
42 | end;
|
---|
43 |
|
---|
44 | var
|
---|
45 | MainForm: TMainForm;
|
---|
46 |
|
---|
47 | implementation
|
---|
48 |
|
---|
49 | uses UTextScreen;
|
---|
50 |
|
---|
51 | {$R *.dfm}
|
---|
52 |
|
---|
53 | procedure TMainForm.Button1Click(Sender: TObject);
|
---|
54 | begin
|
---|
55 | MainThread.Free;
|
---|
56 | MainThread := TMainThread.Create(True);
|
---|
57 | MainThread.Parent := Self;
|
---|
58 | Button1.Enabled := False;
|
---|
59 | MainThread.Resume;
|
---|
60 | end;
|
---|
61 |
|
---|
62 | procedure TMainThread.DoPaintChar;
|
---|
63 | begin
|
---|
64 | with Parent, Self, Image1.Picture.Bitmap.Canvas do begin
|
---|
65 | Brush.Color := BackgroundColor;
|
---|
66 | Pen.Color := BackgroundColor;
|
---|
67 | Rectangle(Position.X * CharacterSize.X, Position.Y * CharacterSize.Y,
|
---|
68 | (Position.X + 1) * CharacterSize.X, (Position.Y + 1) * CharacterSize.Y);
|
---|
69 | Font.Color := TextColor;
|
---|
70 | TextOut(Position.X * CharacterSize.X, Position.Y * CharacterSize.Y, Character);
|
---|
71 |
|
---|
72 | if CursorVisible then begin
|
---|
73 | Brush.Color := TextColor;
|
---|
74 | Pen.Color := TextColor;
|
---|
75 | Rectangle(Position.X * CharacterSize.X, (Position.Y + 1) * CharacterSize.Y - 2,
|
---|
76 | (Position.X + 1) * CharacterSize.X, (Position.Y + 1) * CharacterSize.Y);
|
---|
77 | end;
|
---|
78 | end;
|
---|
79 | end;
|
---|
80 |
|
---|
81 | procedure TMainForm.FormCreate(Sender: TObject);
|
---|
82 | begin
|
---|
83 | MyConsoleApp := TMyConsoleApp.Create;
|
---|
84 | MyConsoleApp.Screen.OnPaintChar := TextScreenPaintChar;
|
---|
85 | MyConsoleApp.Screen.OnSizeChange := TextScreenSizeChange;
|
---|
86 | MainThread := TMainThread.Create(True);
|
---|
87 | MainThread.Parent := Self;
|
---|
88 | DoubleBuffered := True;
|
---|
89 | Dimensions := Point(40, 25);
|
---|
90 | CharacterSize := Point(16, 16);
|
---|
91 | with Image1.Picture.Bitmap, Canvas do begin
|
---|
92 | Font.Name := 'Lucida Console';
|
---|
93 | Font.Height := CharacterSize.Y + 2;
|
---|
94 | Width := Dimensions.X * CharacterSize.X;
|
---|
95 | Height := Dimensions.Y * CharacterSize.Y;
|
---|
96 | end;
|
---|
97 | MyConsoleApp.Screen.SetSize(Dimensions);
|
---|
98 | end;
|
---|
99 |
|
---|
100 | procedure TMainForm.FormDestroy(Sender: TObject);
|
---|
101 | begin
|
---|
102 | MainThread.Free;
|
---|
103 | MyConsoleApp.Destroy;
|
---|
104 | end;
|
---|
105 |
|
---|
106 | procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
|
---|
107 | begin
|
---|
108 | MyConsoleApp.Keyboard.PressKey(Key);
|
---|
109 | end;
|
---|
110 |
|
---|
111 | procedure TMainForm.TextScreenPaintChar(Position: TPoint; Character: Char; TextColor, BackgroundColor: TColor; CursorVisible: Boolean);
|
---|
112 | begin
|
---|
113 | MainThread.Position := Position;
|
---|
114 | MainThread.Character := Character;
|
---|
115 | MainThread.TextColor := TextColor;
|
---|
116 | MainThread.BackgroundColor := BackgroundColor;
|
---|
117 | MainThread.CursorVisible := CursorVisible;
|
---|
118 | MainThread.Synchronize(MainThread.DoPaintChar);
|
---|
119 | end;
|
---|
120 |
|
---|
121 | procedure TMainForm.TextScreenSizeChange(Size: TPoint);
|
---|
122 | begin
|
---|
123 | MainThread.Size := Size;
|
---|
124 | MainThread.Synchronize(MainThread.DoSizeChange);
|
---|
125 | end;
|
---|
126 |
|
---|
127 | procedure TMainForm.Timer1Timer(Sender: TObject);
|
---|
128 | begin
|
---|
129 | with MyConsoleApp.Screen do begin
|
---|
130 | CursorBlinkState := not CursorBlinkState;
|
---|
131 | PaintChar(CursorPosition);
|
---|
132 | end;
|
---|
133 | end;
|
---|
134 |
|
---|
135 | { TMainThread }
|
---|
136 |
|
---|
137 | procedure TMainThread.DoSizeChange;
|
---|
138 | begin
|
---|
139 | with Parent, Image1.Picture.Bitmap do begin
|
---|
140 | Width := Dimensions.X * CharacterSize.X;
|
---|
141 | Height := Dimensions.Y * CharacterSize.Y;
|
---|
142 | end;
|
---|
143 | end;
|
---|
144 |
|
---|
145 | procedure TMainThread.Execute;
|
---|
146 | begin
|
---|
147 | inherited;
|
---|
148 | Parent.MyConsoleApp.Execute;
|
---|
149 | Parent.Button1.Enabled := True;
|
---|
150 | end;
|
---|
151 |
|
---|
152 | end.
|
---|