source: trunk/LocalPlayer/MessgEx.pas

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