source: branches/delphi/Direct.pas

Last change on this file was 6, checked in by chronos, 7 years ago
  • Modified: Formated all project source files using Delphi formatter as original indentation and other formatting was really bad.
File size: 8.4 KB
Line 
1{$INCLUDE switches}
2unit Direct;
3
4interface
5
6uses
7 Messg,
8
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;
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: integer);
25 private
26 Info: string;
27 State: integer;
28 Gone, Quick: boolean;
29 procedure SetInfo(x: string);
30 procedure SetState(x: integer);
31 procedure OnGo(var m: TMessage); message WM_GO;
32 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;
33 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;
34 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;
35 end;
36
37var
38 DirectDlg: TDirectDlg;
39
40implementation
41
42uses
43 ScreenTools, Protocol, GameServer, Start, LocalPlayer, NoTerm, Back, ShellAPI;
44
45{$R *.DFM}
46
47procedure Notify(ID: integer);
48begin
49 DirectDlg.DlgNotify(ID);
50end;
51
52procedure TDirectDlg.DlgNotify(ID: integer);
53var
54 hMem: Cardinal;
55 p: pointer;
56 s: string;
57begin
58 case ID of
59 ntInitLocalHuman:
60 begin
61 SetMainTextureByAge(-1);
62 State := -1;
63 Info := Phrases.Lookup('BUSY_MODLH');
64 Show;
65 Invalidate;
66 Update;
67 end;
68 ntInitModule .. ntInitModule + maxBrain - 1:
69 if visible then
70 begin
71 s := Format(Phrases.Lookup('BUSY_MOD'),
72 [Brain[ID - ntInitModule].Name]);
73 while BiColorTextWidth(Canvas, s) + 64 > ClientWidth do
74 Delete(s, Length(s), 1);
75 SetInfo(s);
76 end;
77 ntCreateWorld:
78 if visible then
79 SetInfo(Phrases.Lookup('BUSY_START'));
80 ntInitPlayers:
81 if visible then
82 SetInfo(Phrases.Lookup('BUSY_INIT'));
83 ntDeactivationMissing .. ntDeactivationMissing + nPl - 1:
84 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),
85 [ID - ntDeactivationMissing]));
86 ntSetAIName .. ntSetAIName + nPl - 1:
87 LocalPlayer.SetAIName(ID - ntSetAIName, NotifyMessage);
88 ntException .. ntException + maxBrain - 1:
89 PostMessage(Handle, WM_AIEXCEPTION, ID - ntException, 0);
90 ntLoadBegin:
91 begin
92 Info := Phrases.Lookup('BUSY_LOAD');
93 SetState(0);
94 end;
95 ntLoadState .. ntLoadState + 128:
96 SetState(ID - ntLoadState);
97 ntDLLError .. ntDLLError + 128:
98 SimpleMessage(Format(Phrases.Lookup('DLLERROR'),
99 [Brain[ID - ntDLLError].FileName]));
100 ntAIError:
101 SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage]));
102 ntClientError .. ntClientError + 128:
103 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),
104 [Brain[ID - ntClientError].FileName]));
105 ntEndInfo:
106 begin
107 Hide;
108 background.Update
109 end;
110 ntLoadError:
111 begin
112 if OpenClipboard(Handle) then
113 begin // copy file path to clipboard
114 NotifyMessage := NotifyMessage + #0;
115 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE,
116 Length(NotifyMessage));
117 p := GlobalLock(hMem);
118 if p <> nil then
119 move(NotifyMessage[1], p^, Length(NotifyMessage));
120 GlobalUnlock(hMem);
121 SetClipboardData(CF_TEXT, hMem);
122 CloseClipboard;
123 end;
124 with MessgDlg do
125 begin
126 MessgText := Phrases.Lookup('LOADERROR');
127 Kind := mkYesNo;
128 ShowModal;
129 if ModalResult = mrOK then
130 ShellExecute(Handle, 'open',
131 'http://c-evo.org/_sg/contact/cevobug.html', '', '',
132 SW_SHOWNORMAL);
133 end
134 end;
135 ntStartDone:
136 if not Quick then
137 begin
138 StartDlg.Hide;
139 background.Update
140 end;
141 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps:
142 if Quick then
143 Close
144 else
145 begin
146 if ID = ntStartGoRefresh then
147 StartDlg.UpdateFormerGames
148 else if ID = ntStartGoRefreshMaps then
149 StartDlg.UpdateMaps;
150 StartDlg.Show;
151 end;
152 ntChangeClient:
153 PostMessage(Handle, WM_CHANGECLIENT, 0, 0);
154 ntNextPlayer:
155 PostMessage(Handle, WM_NEXTPLAYER, 0, 0);
156 ntDeinitModule .. ntDeinitModule + maxBrain - 1:
157 begin
158 Info := Format(Phrases2.Lookup('BUSY_DEINIT'),
159 [Brain[ID - ntDeinitModule].Name]);
160 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do
161 Delete(Info, Length(Info), 1);
162 SetMainTextureByAge(-1);
163 State := -1;
164 Show;
165 Invalidate;
166 Update;
167 end;
168 ntBackOn:
169 begin
170 background.Show;
171 background.Update;
172 sleep(50); // prevent flickering
173 end;
174 ntBackOff:
175 background.Close;
176 end;
177end;
178
179procedure TDirectDlg.FormCreate(Sender: TObject);
180begin
181 Gone := false;
182 State := -1;
183 Info := '';
184 GameServer.Init(Notify);
185 Brain[bixNoTerm].Client := NoTerm.Client;
186 Brain[bixSuper_Virtual].Client := nil;
187 Brain[bixTerm].Client := LocalPlayer.Client;
188 Brain[bixNoTerm].Name := Phrases.Lookup('AIT');
189 Brain[bixSuper_Virtual].Name := Phrases.Lookup('SUPER');
190 Brain[bixTerm].Name := Phrases.Lookup('HUMAN');
191 Brain[bixRandom].Name := Phrases.Lookup('RANDOMAI');
192 Canvas.Font.Assign(UniFont[ftNormal]);
193 Canvas.Brush.Style := bsClear;
194end;
195
196procedure TDirectDlg.FormShow(Sender: TObject);
197begin
198 if not Gone then
199 begin
200 PostMessage(Handle, WM_GO, 0, 0);
201 Gone := true
202 end
203end;
204
205procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction);
206begin
207 GameServer.Done;
208end;
209
210procedure TDirectDlg.OnGo(var m: TMessage);
211var
212 i: integer;
213 s: string;
214begin
215 Hide;
216 if nBrain = 3 then
217 begin
218 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0);
219 Close;
220 exit
221 end;
222 Quick := false;
223 if ParamCount > 0 then
224 begin
225 s := ParamStr(1);
226 if (s[1] = '-') or (s[1] = '/') then
227 begin // special mode
228 Delete(s, 1, 1);
229 for i := 1 to Length(s) do
230 if s[i] in ['a' .. 'z'] then
231 dec(s[i], 32);
232 if s = 'MAN' then
233 begin
234 Quick := true;
235 DirectHelp(cHelpOnly);
236 Close
237 end;
238 end
239 else if (FileExists(ParamStr(1))) then
240 begin
241 Quick := true;
242 if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1)
243 ), -1, false) then
244 begin
245 SimpleMessage(Phrases.Lookup('LOADERR'));
246 Close
247 end
248 end
249 end;
250 if not Quick then
251 begin
252 background.Show;
253 StartDlg.Show
254 end
255end;
256
257procedure TDirectDlg.OnChangeClient(var m: TMessage);
258begin
259 ChangeClient;
260end;
261
262procedure TDirectDlg.OnNextPlayer(var m: TMessage);
263begin
264 NextPlayer;
265end;
266
267procedure TDirectDlg.OnAIException(var Msg: TMessage);
268begin
269 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'),
270 [Brain[Msg.WParam].Name])), 'C-evo', 0);
271end;
272
273procedure TDirectDlg.FormPaint(Sender: TObject);
274begin
275 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
276 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
277 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
278 MainTexture.clBevelLight, MainTexture.clBevelShade);
279 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
280 MainTexture.clBevelLight, MainTexture.clBevelShade);
281 if State >= 0 then
282 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info))
283 div 2, 16, Info)
284 else
285 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2,
286 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info);
287 if State >= 0 then
288 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128,
289 MainTexture);
290end;
291
292procedure TDirectDlg.SetInfo(x: string);
293begin
294 Info := x;
295 Invalidate;
296 Update;
297end;
298
299procedure TDirectDlg.SetState(x: integer);
300begin
301 if (x < 0) <> (State < 0) then
302 begin
303 State := x;
304 Invalidate;
305 Update
306 end
307 else if x <> State then
308 begin
309 State := x;
310 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State,
311 128, MainTexture);
312 end
313end;
314
315end.
Note: See TracBrowser for help on using the repository browser.