source: tags/1.3.9/LocalPlayer/MessgEx.pas

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