source: tags/1.3.0/LocalPlayer/MessgEx.pas

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