source: tags/1.3.4/LocalPlayer/MessgEx.pas

Last change on this file was 570, checked in by chronos, 18 months ago
  • Fixed: Workaround for incorrectly styling TEdit controls under Gtk2.
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);
189 Gtk2DisableControlStyling(EInput);
190end;
191
192function TMessgExDlg.ShowModal: Integer;
193var
194 Ticks0: TDateTime;
195 Ticks: TDateTime;
196begin
197 Caption := Phrases.Lookup('TITLE_MESSAGE');
198 if GameMode = cMovie then
199 begin
200 if not ((GameMode = cMovie) and (MovieSpeed = 4)) then
201 begin
202 MovieCancelled := False;
203 Show;
204 Ticks0 := NowPrecise;
205 repeat
206 Application.ProcessMessages;
207 Sleep(1);
208 Ticks := NowPrecise;
209 until MovieCancelled or (Round((Ticks - Ticks0) / OneMillisecond) >= 1500);
210 Hide;
211 end;
212 Result := mrOk;
213 end
214 else
215 Result := inherited;
216 //Gtk2Fix;
217end;
218
219procedure TMessgExDlg.CancelMovie;
220begin
221 MovieCancelled := True;
222end;
223
224procedure TMessgExDlg.PaintBook(Canvas: TCanvas; X, Y, clPage, clCover: Integer);
225const
226 xScrewed = 77;
227 yScrewed = 10;
228 wScrewed = 43;
229 hScrewed = 27;
230type
231 TScrewed = array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of Single;
232var
233 ix, iy, xDst, yDst, dx, dy, xIcon, yIcon: Integer;
234 BookRect: TRect;
235 x1, xR, yR, Share: Single;
236 Screwed: TScrewed;
237 SrcPtr: TPixelPointer;
238 Width: Integer;
239 Height: Integer;
240begin
241 Width := xSizeBig;
242 Height := ySizeBig;
243 if IconIndex >= 0 then begin
244 xIcon := IconIndex mod 7 * xSizeBig;
245 yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig;
246 // prepare screwed icon
247 Screwed := Default(TScrewed);
248 BigImp.BeginUpdate;
249 SrcPtr := TPixelPointer.Create(BigImp, ScaleToNative(xIcon), ScaleToNative(yIcon));
250 for iy := 0 to ScaleToNative(Height) - 1 do begin
251 for ix := 0 to ScaleToNative(Width) - 1 do begin
252 xR := ScaleFromNative(ix) * (37 + ScaleFromNative(iy) * 5 / Height) / Width;
253 xDst := Trunc(xR);
254 xR := Frac(xR);
255 x1 := (120 - ScaleFromNative(ix)) * (120 - ScaleFromNative(ix)) - 10000;
256 yR := ScaleFromNative(iy) * 18 / Height + x1 * x1 / 4000000;
257 yDst := Trunc(yR);
258 yR := Frac(yR);
259 for dx := 0 to 1 do
260 for dy := 0 to 1 do begin
261 if dx = 0 then
262 Share := 1 - xR
263 else
264 Share := xR;
265 if dy = 0 then
266 Share := Share * (1 - yR)
267 else
268 Share := Share * yR;
269 if (xDst + dx < wScrewed) and
270 (yDst + dy < hScrewed) then begin
271 Screwed[xDst + dx, yDst + dy, 0] := Screwed[xDst + dx, yDst + dy, 0]
272 + Share * SrcPtr.PixelB;
273 Screwed[xDst + dx, yDst + dy, 1] := Screwed[xDst + dx, yDst + dy, 1]
274 + Share * SrcPtr.PixelG;
275 Screwed[xDst + dx, yDst + dy, 2] := Screwed[xDst + dx, yDst + dy, 2]
276 + Share * SrcPtr.PixelR;
277 Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy,
278 3] + Share;
279 end;
280 end;
281 SrcPtr.NextPixel;
282 end;
283 SrcPtr.NextLine;
284 end;
285 BigImp.EndUpdate;
286 BookRect := BigBook.BoundsRect;
287 end
288 else
289 begin
290 BookRect := SmallBook.BoundsRect;
291 end;
292 X := X - BookRect.Width div 2;
293
294 // paint
295 UnshareBitmap(DrawBuffer);
296 DrawBufferEnsureSize(BookRect.Width, BookRect.Height);
297 BitBltCanvas(DrawBuffer.Canvas, 0, 0, BookRect.Width, BookRect.Height, Canvas, X, Y);
298
299 if IconIndex >= 0 then
300 for iy := 0 to hScrewed - 1 do
301 for ix := 0 to wScrewed - 1 do
302 if Screwed[ix, iy, 3] > 0.01 then
303 DrawBuffer.Canvas.Pixels[xScrewed + ix, yScrewed + iy] :=
304 Trunc(Screwed[ix, iy, 2] / Screwed[ix, iy, 3]) +
305 Trunc(Screwed[ix, iy, 1] / Screwed[ix, iy, 3]) shl 8 +
306 Trunc(Screwed[ix, iy, 0] / Screwed[ix, iy, 3]) shl 16;
307
308 ImageOp_BCC(DrawBuffer, Templates.Data, Point(0, 0), BookRect, clCover, clPage);
309
310 BitBltCanvas(Canvas, X, Y, BookRect.Width, BookRect.Height, DrawBuffer.Canvas, 0, 0);
311end;
312
313procedure TMessgExDlg.PaintMyArmy;
314begin
315end;
316
317procedure TMessgExDlg.PaintEnemyArmy;
318var
319 emix, ix, iy, X, Y, Count, UnitsInLine: Integer;
320begin
321 ix := 0;
322 iy := 0;
323 if nLostArmy > LostUnitsPerLine then
324 UnitsInLine := LostUnitsPerLine
325 else
326 UnitsInLine := nLostArmy;
327 for emix := 0 to MyRO.nEnemyModel - 1 do
328 for Count := 0 to LostArmy[emix] - 1 do
329 begin
330 X := Width div 2 + ix * 64 - UnitsInLine * 32;
331 Y := 26 + Border + TopSpace + Lines * MessageLineSpacing + iy * 48;
332 with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do
333 begin
334 Sprite(Canvas, HGr, X, Y, 64, 48, pix mod 10 * 65 + 1, pix div 10 * 49 + 1);
335 end;
336
337 // next position
338 Inc(ix);
339 if ix = LostUnitsPerLine then
340 begin // next line
341 ix := 0;
342 Inc(iy);
343 if iy = 6 then
344 Exit;
345 UnitsInLine := nLostArmy - LostUnitsPerLine * iy;
346 if UnitsInLine > LostUnitsPerLine then
347 UnitsInLine := LostUnitsPerLine;
348 end;
349 end;
350end;
351
352procedure TMessgExDlg.FormPaint(Sender: TObject);
353var
354 p1, clSaveTextLight, clSaveTextShade: Integer;
355begin
356 if (IconKind = mikImp) and (IconIndex = 27) then
357 begin // "YOU WIN" message
358 clSaveTextLight := MainTexture.ColorTextLight;
359 clSaveTextShade := MainTexture.ColorTextShade;
360 MainTexture.ColorTextLight := $000000; // gold
361 MainTexture.ColorTextShade := $0FDBFF;
362 inherited;
363 MainTexture.ColorTextLight := clSaveTextLight;
364 MainTexture.ColorTextShade := clSaveTextShade;
365 end
366 else
367 inherited;
368
369 case IconKind of
370 mikImp:
371 if Imp[IconIndex].Kind = ikWonder then
372 begin
373 p1 := MyRO.Wonder[IconIndex].EffectiveOwner;
374 UnshareBitmap(Buffer);
375 BitBltCanvas(Buffer.Canvas, 0, 0, xSizeBig + 2 * GlowRange,
376 ySizeBig + 2 * GlowRange, Canvas,
377 Width div 2 - (28 + GlowRange), 24 - GlowRange);
378 BitBltBitmap(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig,
379 BigImp, IconIndex mod 7 * xSizeBig,
380 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig);
381 if p1 < 0 then
382 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000)
383 else
384 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig,
385 Tribe[p1].Color);
386 BitBltCanvas(Canvas, Width div 2 - (28 + GlowRange),
387 24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange,
388 Buffer.Canvas, 0, 0);
389 end
390 else
391 ImpImage(Canvas, Width div 2 - 28, 24, IconIndex);
392 mikAge:
393 begin
394 if IconIndex = 0 then
395 ImpImage(Canvas, Width div 2 - 28, 24, -7)
396 else
397 ImpImage(Canvas, Width div 2 - 28, 24, 24 + IconIndex);
398 end;
399 mikModel:
400 with Tribe[Me].ModelPicture[IconIndex] do
401 begin
402 FrameImage(Canvas, BigImp, Width div 2 - 28, 24, xSizeBig,
403 ySizeBig, 0, 0);
404 Sprite(Canvas, HGr, Width div 2 - 32, 20, 64, 44, pix mod 10 * 65 + 1,
405 pix div 10 * 49 + 1);
406 end;
407 mikBook:
408 PaintBook(Canvas, Width div 2, 24, MainTexture.ColorPage,
409 MainTexture.ColorCover);
410 mikTribe:
411 if Assigned(Tribe[IconIndex].faceHGr) then
412 begin
413 Frame(Canvas, Width div 2 - 32 - 1, 24 - 1,
414 Width div 2 + 32, 24 + 48, $000000, $000000);
415 BitBltCanvas(Canvas, Width 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, Width div 2 - 28, 24, xSizeBig, ySizeBig,
422 IconIndex mod 7 * xSizeBig, IconIndex div 7 * ySizeBig);
423 mikBigIcon:
424 FrameImage(Canvas, BigImp, Width 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 (Width - 140) div 2, 24);
431 ImageOp_BCC(Buffer, Templates.Data, Point(0, 0), StarshipDeparted.BoundsRect, 0, $FFFFFF);
432 BitBltCanvas(Canvas, (Width - 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, Width div 2 - 31, 24, 63, 63, 1, 281);
441 mikShip:
442 PaintColonyShip(Canvas, IconIndex, 17, Width - 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 MainScreen.HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo)
461 else if Kind = mkModel then
462 MainScreen.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 MainScreen.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 MainScreen.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 MainScreen.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: TLinkCategory; ContextNo: Integer);
528begin
529 with MainScreen.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.