source: branches/AlphaChannel/LocalPlayer/MessgEx.pas

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