source: tags/1.3.1/LocalPlayer/MessgEx.pas

Last change on this file was 442, checked in by chronos, 4 years ago
  • Modified: Code cleanup.
File size: 16.0 KB
Line 
1{$INCLUDE Switches.inc}
2unit MessgEx;
3
4interface
5
6uses
7 Messg, Protocol, ScreenTools, Platform, DateUtils, LCLIntf, LCLType, Messages,
8 SysUtils, Classes, Graphics, Controls, Forms, ButtonA, ButtonB, StdCtrls,
9 DrawDlg;
10
11type
12 TMessageIconKind = (mikNone, mikImp, mikModel, mikTribe, mikBook, mikAge,
13 mikPureIcon, mikMyArmy, mikEnemyArmy, mikFullControl, mikShip, mikBigIcon,
14 mikEnemyShipComplete);
15
16 { TMessgExDlg }
17
18 TMessgExDlg = class(TBaseMessgDlg)
19 Button1: TButtonA;
20 Button2: TButtonA;
21 Button3: TButtonA;
22 RemoveBtn: TButtonB;
23 EInput: TEdit;
24 procedure FormCreate(Sender: TObject);
25 procedure FormPaint(Sender: TObject);
26 procedure FormShow(Sender: TObject);
27 procedure Button1Click(Sender: TObject);
28 procedure Button2Click(Sender: TObject);
29 procedure Button3Click(Sender: TObject);
30 procedure FormKeyPress(Sender: TObject; var Key: char);
31 procedure FormClose(Sender: TObject; var Action: TCloseAction);
32 procedure RemoveBtnClick(Sender: TObject);
33 public
34 Kind: TMessageKind;
35 IconIndex: Integer;
36 HelpKind: Integer;
37 HelpNo: Integer;
38 CenterTo: Integer;
39 IconKind: TMessageIconKind;
40 OpenSound: string;
41 function ShowModal: integer; override;
42 procedure CancelMovie;
43 private
44 MovieCancelled: boolean;
45 procedure PaintBook(ca: TCanvas; x, y, clPage, clCover: integer);
46 procedure PaintMyArmy;
47 procedure PaintEnemyArmy;
48 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;
49 end;
50
51var
52 MessgExDlg: TMessgExDlg;
53
54procedure SoundMessageEx(SimpleText, SoundItem: string);
55procedure TribeMessage(p: integer; SimpleText, SoundItem: string);
56function SimpleQuery(QueryKind: TMessageKind; SimpleText, SoundItem: string)
57 : integer;
58procedure ContextMessage(SimpleText, SoundItem: string;
59 ContextKind, ContextNo: integer);
60
61
62implementation
63
64uses
65 ClientTools, BaseWin, Term, Help, UnitStat, Tribes, UPixelPointer,
66 Diagram, Sound;
67
68{$R *.lfm}
69
70const
71 LostUnitsPerLine = 6;
72
73procedure TMessgExDlg.FormCreate(Sender: TObject);
74begin
75 inherited;
76 IconKind := mikNone;
77 CenterTo := 0;
78 OpenSound := '';
79end;
80
81procedure TMessgExDlg.FormShow(Sender: TObject);
82var
83 i: integer;
84begin
85 if IconKind = mikEnemyArmy then
86 InitAllEnemyModels;
87
88 Button1.Visible := GameMode <> cMovie;
89 Button2.Visible := (GameMode <> cMovie) and (Kind <> mkOk);
90 Button3.Visible := (GameMode <> cMovie) and (Kind = mkYesNoCancel);
91 RemoveBtn.Visible := (GameMode <> cMovie) and (Kind = mkOkCancelRemove);
92 EInput.Visible := (GameMode <> cMovie) and (Kind = mkModel);
93 if Button3.Visible then
94 begin
95 Button1.Left := 43;
96 Button2.Left := 159;
97 end
98 else if Button2.Visible then
99 begin
100 Button1.Left := 101;
101 Button2.Left := 217;
102 end
103 else
104 Button1.Left := 159;
105 RemoveBtn.Left := ClientWidth - 38;
106 case Kind of
107 mkYesNo, mkYesNoCancel:
108 begin
109 Button1.Caption := Phrases.Lookup('BTN_YES');
110 Button2.Caption := Phrases.Lookup('BTN_NO')
111 end;
112 mkOKCancel, mkOkCancelRemove:
113 begin
114 Button1.Caption := Phrases.Lookup('BTN_OK');
115 Button2.Caption := Phrases.Lookup('BTN_CANCEL');
116 end;
117 else
118 begin
119 Button1.Caption := Phrases.Lookup('BTN_OK');
120 Button2.Caption := Phrases.Lookup('BTN_INFO');
121 end;
122 end;
123 Button3.Caption := Phrases.Lookup('BTN_CANCEL');
124 RemoveBtn.Hint := Phrases.Lookup('BTN_DELGAME');
125
126 case IconKind of
127 mikImp, mikModel, mikAge, mikPureIcon:
128 TopSpace := 56;
129 mikBigIcon:
130 TopSpace := 152;
131 mikEnemyShipComplete:
132 TopSpace := 136;
133 mikBook:
134 if IconIndex >= 0 then
135 TopSpace := 84
136 else
137 TopSpace := 47;
138 mikTribe:
139 begin
140 Tribe[IconIndex].InitAge(GetAge(IconIndex));
141 if Assigned(Tribe[IconIndex].faceHGr) then
142 TopSpace := 64;
143 end;
144 mikFullControl:
145 TopSpace := 80;
146 mikShip:
147 TopSpace := 240;
148 else
149 TopSpace := 0;
150 end;
151
152 SplitText(true);
153 ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing;
154 if GameMode = cMovie then
155 ClientHeight := ClientHeight - 32;
156 if Kind = mkModel then
157 ClientHeight := ClientHeight + 36;
158 if IconKind in [mikMyArmy, mikEnemyArmy] then
159 begin
160 if nLostArmy > LostUnitsPerLine * 6 then
161 ClientHeight := ClientHeight + 6 * 48
162 else
163 ClientHeight := ClientHeight + ((nLostArmy - 1) div LostUnitsPerLine
164 + 1) * 48;
165 end;
166 case CenterTo of
167 0:
168 begin
169 Left := (Screen.Width - ClientWidth) div 2;
170 Top := (Screen.Height - ClientHeight) div 2 - MapCenterUp;
171 end;
172 1:
173 begin
174 Left := (Screen.Width - ClientWidth) div 4;
175 Top := (Screen.Height - ClientHeight) * 2 div 3 - MapCenterUp;
176 end;
177 -1:
178 begin
179 Left := (Screen.Width - ClientWidth) div 4;
180 Top := (Screen.Height - ClientHeight) div 3 - MapCenterUp;
181 end;
182 end;
183 for i := 0 to ControlCount - 1 do
184 Controls[i].Top := ClientHeight - (34 + Border);
185 if Kind = mkModel then
186 EInput.Top := ClientHeight - (76 + Border);
187end;
188
189function TMessgExDlg.ShowModal: integer;
190var
191 Ticks0: TDateTime;
192 Ticks: TDateTime;
193begin
194 Caption := Phrases.Lookup('TITLE_MESSAGE');
195 if GameMode = cMovie then
196 begin
197 if not((GameMode = cMovie) and (MovieSpeed = 4)) then
198 begin
199 MovieCancelled := false;
200 Show;
201 Ticks0 := NowPrecise;
202 repeat
203 Application.ProcessMessages;
204 Sleep(1);
205 Ticks := NowPrecise;
206 until MovieCancelled or (Round((Ticks - Ticks0) / OneMillisecond) >= 1500);
207 Hide;
208 end;
209 result := mrOk;
210 end
211 else
212 result := inherited;
213 Gtk2Fix;
214end;
215
216procedure TMessgExDlg.CancelMovie;
217begin
218 MovieCancelled := true;
219end;
220
221procedure TMessgExDlg.PaintBook(ca: TCanvas; x, y, clPage, clCover: integer);
222const
223 xScrewed = 77;
224 yScrewed = 10;
225 wScrewed = 43;
226 hScrewed = 27;
227type
228 TScrewed = array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of Single;
229var
230 ix, iy, xDst, yDst, dx, dy, xIcon, yIcon: integer;
231 BookRect: TRect;
232 x1, xR, yR, share: single;
233 Screwed: TScrewed;
234 SrcPtr: TPixelPointer;
235 Width: Integer;
236 Height: Integer;
237begin
238 Width := 56;
239 Height := 40;
240 if IconIndex >= 0 then begin
241 xIcon := IconIndex mod 7 * xSizeBig;
242 yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig;
243 // prepare screwed icon
244 Screwed := Default(TScrewed);
245 BigImp.BeginUpdate;
246 SrcPtr := PixelPointer(BigImp, ScaleToNative(xIcon), ScaleToNative(yIcon));
247 for iy := 0 to ScaleToNative(Height) - 1 do begin
248 for ix := 0 to ScaleToNative(Width) - 1 do begin
249 xR := ScaleFromNative(ix) * (37 + ScaleFromNative(iy) * 5 / Height) / Width;
250 xDst := Trunc(xR);
251 xR := Frac(xR);
252 x1 := (120 - ScaleFromNative(ix)) * (120 - ScaleFromNative(ix)) - 10000;
253 yR := ScaleFromNative(iy) * 18 / Height + x1 * x1 / 4000000;
254 yDst := Trunc(yR);
255 yR := Frac(yR);
256 for dx := 0 to 1 do
257 for dy := 0 to 1 do begin
258 if dx = 0 then
259 share := 1 - xR
260 else
261 share := xR;
262 if dy = 0 then
263 share := share * (1 - yR)
264 else
265 share := share * yR;
266 Screwed[xDst + dx, yDst + dy, 0] := Screwed[xDst + dx, yDst + dy, 0]
267 + share * SrcPtr.Pixel^.B;
268 Screwed[xDst + dx, yDst + dy, 1] := Screwed[xDst + dx, yDst + dy, 1]
269 + share * SrcPtr.Pixel^.G;
270 Screwed[xDst + dx, yDst + dy, 2] := Screwed[xDst + dx, yDst + dy, 2]
271 + share * SrcPtr.Pixel^.R;
272 Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy,
273 3] + share;
274 end;
275 SrcPtr.NextPixel;
276 end;
277 SrcPtr.NextLine;
278 end;
279 BigImp.EndUpdate;
280 BookRect := BigBook.BoundsRect;
281 end
282 else
283 begin
284 BookRect := SmallBook.BoundsRect;
285 end;
286 x := x - BookRect.Width div 2;
287
288 // paint
289 UnshareBitmap(LogoBuffer);
290 BitBltCanvas(LogoBuffer.Canvas, 0, 0, BookRect.Width, BookRect.Height, ca, x, y);
291
292 if IconIndex >= 0 then
293 for iy := 0 to hScrewed - 1 do
294 for ix := 0 to wScrewed - 1 do
295 if Screwed[ix, iy, 3] > 0.01 then
296 LogoBuffer.Canvas.Pixels[xScrewed + ix, yScrewed + iy] :=
297 Trunc(Screwed[ix, iy, 2] / Screwed[ix, iy, 3]) +
298 Trunc(Screwed[ix, iy, 1] / Screwed[ix, iy, 3]) shl 8 +
299 Trunc(Screwed[ix, iy, 0] / Screwed[ix, iy, 3]) shl 16;
300
301 ImageOp_BCC(LogoBuffer, Templates.Data, Point(0, 0), BookRect, clCover, clPage);
302
303 BitBltCanvas(ca, x, y, BookRect.Width, BookRect.Height, LogoBuffer.Canvas, 0, 0);
304end;
305
306procedure TMessgExDlg.PaintMyArmy;
307begin
308end;
309
310procedure TMessgExDlg.PaintEnemyArmy;
311var
312 emix, ix, iy, x, y, count, UnitsInLine: integer;
313begin
314 ix := 0;
315 iy := 0;
316 if nLostArmy > LostUnitsPerLine then
317 UnitsInLine := LostUnitsPerLine
318 else
319 UnitsInLine := nLostArmy;
320 for emix := 0 to MyRO.nEnemyModel - 1 do
321 for count := 0 to LostArmy[emix] - 1 do
322 begin
323 x := ClientWidth div 2 + ix * 64 - UnitsInLine * 32;
324 y := 26 + Border + TopSpace + Lines * MessageLineSpacing + iy * 48;
325 with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do
326 begin
327 BitBltCanvas(Canvas, x, y, 64, 48, HGr.Mask.Canvas,
328 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCAND);
329 BitBltCanvas(Canvas, x, y, 64, 48, HGr.Data.Canvas,
330 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCPAINT);
331 end;
332
333 // next position
334 inc(ix);
335 if ix = LostUnitsPerLine then
336 begin // next line
337 ix := 0;
338 inc(iy);
339 if iy = 6 then
340 exit;
341 UnitsInLine := nLostArmy - LostUnitsPerLine * iy;
342 if UnitsInLine > LostUnitsPerLine then
343 UnitsInLine := LostUnitsPerLine;
344 end;
345 end;
346end;
347
348procedure TMessgExDlg.FormPaint(Sender: TObject);
349var
350 p1, clSaveTextLight, clSaveTextShade: integer;
351begin
352 if (IconKind = mikImp) and (IconIndex = 27) then
353 begin // "YOU WIN" message
354 clSaveTextLight := MainTexture.ColorTextLight;
355 clSaveTextShade := MainTexture.ColorTextShade;
356 MainTexture.ColorTextLight := $000000; // gold
357 MainTexture.ColorTextShade := $0FDBFF;
358 inherited;
359 MainTexture.ColorTextLight := clSaveTextLight;
360 MainTexture.ColorTextShade := clSaveTextShade;
361 end
362 else
363 inherited;
364
365 case IconKind of
366 mikImp:
367 if Imp[IconIndex].Kind = ikWonder then
368 begin
369 p1 := MyRO.Wonder[IconIndex].EffectiveOwner;
370 UnshareBitmap(Buffer);
371 BitBltCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange,
372 ySizeBig + 2 * GlowRange, Canvas,
373 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange);
374 BitBltCanvas(Buffer.Canvas, GlowRange, GlowRange, xSizeBig, ySizeBig,
375 BigImp.Canvas, IconIndex mod 7 * xSizeBig,
376 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig);
377 if p1 < 0 then
378 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000)
379 else
380 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig,
381 Tribe[p1].Color);
382 BitBltCanvas(Canvas, ClientWidth div 2 - (28 + GlowRange),
383 24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange,
384 Buffer.Canvas, 0, 0);
385 end
386 else
387 ImpImage(Canvas, ClientWidth div 2 - 28, 24, IconIndex);
388 mikAge:
389 begin
390 if IconIndex = 0 then
391 ImpImage(Canvas, ClientWidth div 2 - 28, 24, -7)
392 else
393 ImpImage(Canvas, ClientWidth div 2 - 28, 24, 24 + IconIndex)
394 end;
395 mikModel:
396 with Tribe[me].ModelPicture[IconIndex] do
397 begin
398 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig,
399 ySizeBig, 0, 0);
400 BitBltCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44,
401 HGr.Mask.Canvas, pix mod 10 * 65 + 1,
402 pix div 10 * 49 + 1, SRCAND);
403 BitBltCanvas(Canvas, ClientWidth div 2 - 32, 20, 64, 44,
404 HGr.Data.Canvas, pix mod 10 * 65 + 1,
405 pix div 10 * 49 + 1, SRCPAINT);
406 end;
407 mikBook:
408 PaintBook(Canvas, ClientWidth div 2, 24, MainTexture.ColorPage,
409 MainTexture.ColorCover);
410 mikTribe:
411 if Assigned(Tribe[IconIndex].faceHGr) then
412 begin
413 Frame(Canvas, ClientWidth div 2 - 32 - 1, 24 - 1,
414 ClientWidth div 2 + 32, 24 + 48, $000000, $000000);
415 BitBltCanvas(Canvas, ClientWidth div 2 - 32, 24, 64, 48,
416 Tribe[IconIndex].faceHGr.Data.Canvas,
417 1 + Tribe[IconIndex].facepix mod 10 * 65,
418 1 + Tribe[IconIndex].facepix div 10 * 49)
419 end;
420 mikPureIcon:
421 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, ySizeBig,
422 IconIndex mod 7 * xSizeBig, IconIndex div 7 * ySizeBig);
423 mikBigIcon:
424 FrameImage(Canvas, BigImp, ClientWidth div 2 - 3 * 28, 32, xSizeBig * 3,
425 ySizeBig * 3, IconIndex mod 2 * 3 * xSizeBig,
426 IconIndex div 2 * 3 * ySizeBig);
427 mikEnemyShipComplete:
428 begin
429 BitBltCanvas(Buffer.Canvas, 0, 0, 140, 120, Canvas,
430 (ClientWidth - 140) div 2, 24);
431 ImageOp_BCC(Buffer, Templates.Data, Point(0, 0), StarshipDeparted.BoundsRect, 0, $FFFFFF);
432 BitBltCanvas(Canvas, (ClientWidth - 140) div 2, 24, 140, 120,
433 Buffer.Canvas, 0, 0);
434 end;
435 mikMyArmy:
436 PaintMyArmy;
437 mikEnemyArmy:
438 PaintEnemyArmy;
439 mikFullControl:
440 Sprite(Canvas, HGrSystem2, ClientWidth div 2 - 31, 24, 63, 63, 1, 281);
441 mikShip:
442 PaintColonyShip(Canvas, IconIndex, 17, ClientWidth - 34, 38);
443 end;
444
445 if EInput.Visible then
446 EditFrame(Canvas, EInput.BoundsRect, MainTexture);
447
448 if OpenSound <> '' then
449 PostMessage(Handle, WM_PLAYSOUND, 0, 0);
450end;
451
452procedure TMessgExDlg.Button1Click(Sender: TObject);
453begin
454 ModalResult := mrOk;
455end;
456
457procedure TMessgExDlg.Button2Click(Sender: TObject);
458begin
459 if Kind = mkOkHelp then
460 HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo)
461 else if Kind = mkModel then
462 UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex)
463 else
464 ModalResult := mrIgnore;
465end;
466
467procedure TMessgExDlg.Button3Click(Sender: TObject);
468begin
469 ModalResult := mrCancel;
470end;
471
472procedure TMessgExDlg.RemoveBtnClick(Sender: TObject);
473begin
474 ModalResult := mrNo;
475end;
476
477procedure TMessgExDlg.FormKeyPress(Sender: TObject; var Key: char);
478begin
479 if Key = #13 then
480 ModalResult := mrOk
481 else if (Key = #27) then
482 if Button3.Visible then
483 ModalResult := mrCancel
484 else if Button2.Visible then
485 ModalResult := mrIgnore;
486end;
487
488procedure SoundMessageEx(SimpleText, SoundItem: string);
489// because Messg.SoundMessage not capable of movie mode
490begin
491 with MessgExDlg do
492 begin
493 MessgText := SimpleText;
494 OpenSound := SoundItem;
495 Kind := mkOk;
496 ShowModal;
497 end;
498end;
499
500procedure TribeMessage(p: integer; SimpleText, SoundItem: string);
501begin
502 with MessgExDlg do
503 begin
504 OpenSound := SoundItem;
505 MessgText := SimpleText;
506 Kind := mkOk;
507 IconKind := mikTribe;
508 IconIndex := p;
509 ShowModal;
510 end;
511end;
512
513function SimpleQuery(QueryKind: TMessageKind; SimpleText, SoundItem: string)
514 : integer;
515begin
516 with MessgExDlg do
517 begin
518 MessgText := SimpleText;
519 OpenSound := SoundItem;
520 Kind := QueryKind;
521 ShowModal;
522 result := ModalResult;
523 end;
524end;
525
526procedure ContextMessage(SimpleText, SoundItem: string;
527 ContextKind, ContextNo: integer);
528begin
529 with MessgExDlg do
530 begin
531 MessgText := SimpleText;
532 OpenSound := SoundItem;
533 Kind := mkOkHelp;
534 HelpKind := ContextKind;
535 HelpNo := ContextNo;
536 ShowModal;
537 end;
538end;
539
540procedure TMessgExDlg.FormClose(Sender: TObject; var Action: TCloseAction);
541begin
542 IconKind := mikNone;
543 CenterTo := 0;
544end;
545
546procedure TMessgExDlg.OnPlaySound(var Msg: TMessage);
547begin
548 Play(OpenSound);
549 OpenSound := '';
550end;
551
552end.
Note: See TracBrowser for help on using the repository browser.