source: branches/highdpi/Direct.pas

Last change on this file was 467, checked in by chronos, 5 months ago
  • Modified: DpiControls unit split into multiple units according to their LCL names.
File size: 8.5 KB
Line 
1{$INCLUDE Switches.inc}
2unit Direct;
3
4interface
5
6uses
7 Dpi.Forms,
8 Messg, LCLIntf, LCLType, {$IFDEF UNIX}LMessages, {$ENDIF}Messages, SysUtils,
9 Classes, Graphics, Controls, Forms, DrawDlg, GameServer;
10
11const
12 WM_GO = WM_USER;
13 WM_CHANGECLIENT = WM_USER + 1; // hand over control to other client
14 WM_NEXTPLAYER = WM_USER + 2; // active player's turn ended, next player
15 WM_AIEXCEPTION = WM_USER + 3;
16
17type
18 TDirectDlg = class(TDrawDlg)
19 procedure FormShow(Sender: TObject);
20 procedure FormCreate(Sender: TObject);
21 procedure FormPaint(Sender: TObject);
22 procedure FormClose(Sender: TObject; var Action: TCloseAction);
23 public
24 procedure DlgNotify(ID: TNotify; Index: Integer = 0);
25 private
26 Info: string;
27 State: Integer;
28 Gone: Boolean;
29 Quick: Boolean;
30 procedure SetInfo(X: string);
31 procedure SetState(X: Integer);
32 procedure OnGo(var Msg: TMessage); message WM_GO;
33 procedure OnChangeClient(var Msg: TMessage); message WM_CHANGECLIENT;
34 procedure OnNextPlayer(var Msg: TMessage); message WM_NEXTPLAYER;
35 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;
36 end;
37
38var
39 DirectDlg: TDirectDlg;
40
41
42implementation
43
44uses
45 ScreenTools, Protocol, Start, LocalPlayer, NoTerm, Back, Global, NetworkServer,
46 NetworkClient;
47
48{$R *.lfm}
49
50procedure Notify(ID: TNotify; Index: Integer = 0);
51begin
52 DirectDlg.DlgNotify(ID, Index);
53end;
54
55procedure TDirectDlg.DlgNotify(ID: TNotify; Index: Integer = 0);
56var
57// hMem: Cardinal;
58// p: pointer;
59 S: string;
60Begin
61 case ID of
62 ntInitLocalHuman: begin
63 MainTexture.Age := -1;
64 State := -1;
65 Info := Phrases.Lookup('BUSY_MODLH');
66 Show;
67 Gtk2Fix;
68 Invalidate;
69 Update;
70 end;
71 ntInitModule:
72 if visible then
73 begin
74 S := Format(Phrases.Lookup('BUSY_MOD'), [Brains[Index].Name]);
75 while BiColorTextWidth(Canvas, S) + 64 > ClientWidth do
76 Delete(S, Length(S), 1);
77 SetInfo(S);
78 end;
79 ntCreateWorld:
80 if visible then
81 SetInfo(Phrases.Lookup('BUSY_START'));
82 ntInitPlayers:
83 if visible then
84 SetInfo(Phrases.Lookup('BUSY_INIT'));
85 ntDeactivationMissing:
86 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'), [Index]));
87 ntSetAIName:
88 LocalPlayer.SetAIName(Index, NotifyMessage);
89 ntException:
90 PostMessage(Handle, WM_AIEXCEPTION, Index, 0);
91 ntLoadBegin: begin
92 Info := Phrases.Lookup('BUSY_LOAD');
93 SetState(0);
94 end;
95 ntLoadState: SetState(Index);
96 ntDLLError:
97 SimpleMessage(Format(Phrases.Lookup('DLLERROR'), [Brains[Index].FileName]));
98 ntAIError:
99 SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage]));
100 ntClientError:
101 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),
102 [Brains[Index].FileName]));
103 ntEndInfo: begin
104 Hide;
105 Background.Update;
106 end;
107 ntLoadError: begin
108(* TODO if OpenClipboard(Handle) then
109 begin // copy file path to clipboard
110 NotifyMessage := NotifyMessage + #0;
111 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
112 Length(NotifyMessage));
113 P := GlobalLock(hMem);
114 if P <> nil then
115 Move(NotifyMessage[1], P^, Length(NotifyMessage));
116 GlobalUnlock(hMem);
117 SetClipboardData(CF_TEXT, hMem);
118 CloseClipboard;
119 end;
120 with MessgDlg do
121 begin
122 MessgText := Phrases.Lookup('LOADERROR');
123 Kind := mkYesNo;
124 ShowModal;
125 if ModalResult = mrOK then
126 OpenURL(CevoContactBug);
127 end
128 *)
129 end;
130 ntStartDone:
131 if not Quick then begin
132 StartDlg.Hide;
133 Background.Update;
134 end;
135 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
136 if Quick then Close
137 else begin
138 if ID = ntStartGoRefresh then
139 StartDlg.UpdateFormerGames
140 else if ID = ntStartGoRefreshMaps then
141 StartDlg.UpdateMaps;
142 StartDlg.Show;
143 end;
144 ntChangeClient: PostMessage(Handle, WM_CHANGECLIENT, 0, 0);
145 ntNextPlayer: PostMessage(Handle, WM_NEXTPLAYER, 0, 0);
146 ntDeinitModule:
147 begin
148 Info := Format(Phrases2.Lookup('BUSY_DEINIT'),
149 [Brains[Index].Name]);
150 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do
151 Delete(Info, Length(Info), 1);
152 MainTexture.Age := -1;
153 State := -1;
154 Show;
155 Gtk2Fix;
156 Invalidate;
157 Update;
158 end;
159 ntBackOn: begin
160 Background.Show;
161 Background.Update;
162 Sleep(50); // prevent flickering
163 end;
164 ntBackOff: Background.Close;
165 end;
166end;
167
168procedure TDirectDlg.FormCreate(Sender: TObject);
169begin
170 Gone := False;
171 State := -1;
172 Info := '';
173 GameServer.Init(Notify);
174 BrainNoTerm.Client := NoTerm.Client;
175 BrainNoTerm.Name := Phrases.Lookup('AIT');
176 BrainSuperVirtual.Client := nil;
177 BrainSuperVirtual.Name := Phrases.Lookup('SUPER');
178 BrainTerm.Client := LocalPlayer.Client;
179 BrainTerm.Name := Phrases.Lookup('HUMAN');
180 if NetworkEnabled then begin
181 BrainNetworkServer.Client := NetworkServer.Client;
182 BrainNetworkServer.Name := Phrases.Lookup('NETWORK_SERVER');
183 BrainNetworkClient.Client := NetworkClient.Client;
184 BrainNetworkClient.Name := Phrases.Lookup('NETWORK_CLIENT');
185 end;
186 BrainRandom.Name := Phrases.Lookup('RANDOMAI');
187 Canvas.Font.Assign(UniFont[ftNormal]);
188 Canvas.Brush.Style := bsClear;
189end;
190
191procedure TDirectDlg.FormShow(Sender: TObject);
192begin
193 if not Gone then
194 begin
195 PostMessage(Handle, WM_GO, 0, 0);
196 Gone := True;
197 end;
198end;
199
200procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
201begin
202 GameServer.Done;
203end;
204
205procedure TDirectDlg.OnGo(var Msg: TMessage);
206var
207 I: Integer;
208 S: string;
209 FileName: string;
210begin
211 Hide;
212 if Brains.Count = 3 then
213 begin
214 DpiApplication.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);
215 Close;
216 Exit;
217 end;
218 Quick := False;
219 if ParamCount > 0 then
220 begin
221 S := ParamStr(1);
222 if (S[1] = '-') {$IFDEF WINDOWS}or (S[1] = '/'){$ENDIF} then
223 begin // special mode
224 Delete(S, 1, 1);
225 for I := 1 to Length(S) do
226 if S[I] in ['a' .. 'z'] then
227 Dec(S[I], 32);
228 if S = 'MAN' then
229 begin
230 Quick := True;
231 DirectHelp(cHelpOnly);
232 Close;
233 end;
234 end
235 else if (FileExists(ParamStr(1))) then begin
236 FileName := ParamStr(1);
237 if ExtractFileExt(FileName) = CevoExt then begin
238 Quick := True;
239 if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1)
240 ), -1, False) then begin
241 SimpleMessage(Phrases.Lookup('LOADERR'));
242 Close;
243 end;
244 end else
245 if ExtractFileExt(FileName) = CevoMapExt then begin
246 Quick := True;
247 EditMap(FileName, lxmax, lymax, 30);
248 end else begin
249 SimpleMessage(Phrases.Lookup('LOADERR'));
250 Close;
251 end;
252 end;
253 end;
254 if not Quick then begin
255 Background.Show;
256 StartDlg.Show;
257 end;
258end;
259
260procedure TDirectDlg.OnChangeClient(var Msg: TMessage);
261begin
262 ChangeClient;
263end;
264
265procedure TDirectDlg.OnNextPlayer(var Msg: TMessage);
266begin
267 NextPlayer;
268end;
269
270procedure TDirectDlg.OnAIException(var Msg: TMessage);
271begin
272 DpiApplication.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
273 [Brains[Msg.WParam].Name])), 'C-evo', 0);
274end;
275
276procedure TDirectDlg.FormPaint(Sender: TObject);
277begin
278 PaintBackground(Self, 3, 3, ClientWidth - 6, ClientHeight - 6);
279 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
280 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
281 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
282 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
283 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
284 if State >= 0 then
285 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info))
286 div 2, 16, Info)
287 else
288 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2,
289 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info);
290 if State >= 0 then
291 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128,
292 MainTexture);
293end;
294
295procedure TDirectDlg.SetInfo(X: string);
296begin
297 Info := X;
298 Invalidate;
299 Update;
300 {$IFDEF UNIX}
301 DpiApplication.ProcessMessages;
302 {$ENDIF}
303end;
304
305procedure TDirectDlg.SetState(X: Integer);
306begin
307 if (X < 0) <> (State < 0) then begin
308 State := X;
309 Invalidate;
310 Update;
311 end
312 else if X <> State then begin
313 State := X;
314 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State,
315 128, MainTexture);
316 end;
317end;
318
319end.
Note: See TracBrowser for help on using the repository browser.