source: trunk/LocalPlayer/Select.pas

Last change on this file was 693, checked in by chronos, 3 months ago
  • Fixed: Select dialog switching with left and right keys.
File size: 69.0 KB
Line 
1{$INCLUDE Switches.inc}
2unit Select;
3
4interface
5
6uses
7 Protocol, ClientTools, ScreenTools, PVSB, BaseWin, LCLIntf, LCLType, Messages,
8 SysUtils, Classes, ButtonB, ButtonBase, Types, Math, Generics.Collections,
9 {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.ExtCtrls, Dpi.Menus,
10 Dpi.Common, System.UITypes{$ELSE}
11 Graphics, Controls, Forms, ExtCtrls, Menus{$ENDIF};
12
13type
14 TListKind = (kProject, kAdvance, kFarAdvance, kCities, kCityEvents, kModels,
15 kEnemyModels, kAllEnemyModels, kTribe, kScience, kShipPart, kEnemyShipPart,
16 kChooseTech, kChooseEnemyTech, kChooseModel, kChooseEnemyModel, kChooseCity,
17 kChooseEnemyCity, kStealTech, kGovernment, kMission);
18
19 TLayerIndex = (laImprovements, laWonders, laClasses);
20
21 { TLine }
22
23 TLine = class
24 Code: Integer;
25 Model: Integer;
26 ModelSortValue: Integer;
27 procedure Assign(Source: TLine);
28 end;
29
30 { TLayer }
31
32 TLayer = class
33 Index: TLayerIndex;
34 FirstShrinkedLine: Integer;
35 Lines: TObjectList<TLine>;
36 procedure AddLine(Code: Integer; Model: Integer = 0; ModelSortValue: Integer = 0);
37 procedure SwapLine(I, J: Integer);
38 procedure SortModels;
39 procedure SortCities;
40 procedure SortTechs;
41 constructor Create(AIndex: TLayerIndex);
42 destructor Destroy; override;
43 end;
44
45 { TListDlg }
46
47 TListDlg = class(TFramedDlg)
48 CloseBtn: TButtonB;
49 LayerClassesButton: TButtonB;
50 LayerWondersButton: TButtonB;
51 LayerImprovementsButton: TButtonB;
52 ToggleBtn: TButtonB;
53 Popup: TPopupMenu;
54 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
55 procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
56 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
57 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
58 X, Y: Integer);
59 procedure FormCreate(Sender: TObject);
60 procedure FormDestroy(Sender: TObject);
61 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
62 Shift: TShiftState; X, Y: Integer);
63 procedure FormPaint(Sender: TObject);
64 procedure CloseBtnClick(Sender: TObject);
65 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
66 procedure FormShow(Sender: TObject);
67 procedure ModeBtnClick(Sender: TObject);
68 procedure ToggleBtnClick(Sender: TObject);
69 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
70 procedure PlayerClick(Sender: TObject);
71 private
72 Kind: TListKind;
73 LineDistance: Integer;
74 MaxLines: Integer;
75 cixProject: Integer;
76 PlayerView: Integer;
77 Selected: Integer;
78 DispLines: Integer;
79 Layer: TLayer;
80 nColumn: Integer;
81 TechNameSpace: Integer;
82 ScienceNation: Integer;
83 ScrollBar: TPVScrollbar;
84 Layers: array [TLayerIndex] of TLayer;
85 Column: array [0 .. nPl - 1] of Integer;
86 Closable: Boolean;
87 MultiPage: Boolean;
88 ScienceNationDotBuffer: TBitmap;
89 function GetSelectionIndex: Integer;
90 procedure ScrollBarUpdate(Sender: TObject);
91 procedure InitLines;
92 procedure PaintLine(ca: TCanvas; L: Integer; NonText, Lit: Boolean);
93 function RenameModel(mix: Integer): Boolean;
94 procedure OnScroll(var Msg: TMessage); message WM_VSCROLL;
95 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
96 procedure SetSelectionIndex(Index: Integer);
97 protected
98 procedure DoOnResize; override;
99 public
100 Result: Integer;
101 function RenameCity(cix: Integer): Boolean;
102 function OnlyChoice(TestKind: TListKind): Integer;
103 // -2=empty, -1=ambiguous, other=only choice
104 procedure OffscreenPaint; override;
105 procedure ShowNewContent(NewMode: TWindowMode; ListKind: TListKind);
106 procedure ShowNewContent_CityProject(NewMode: TWindowMode; cix: Integer);
107 procedure ShowNewContent_MilReport(NewMode: TWindowMode; Player: Integer);
108 procedure EcoChange;
109 procedure TechChange;
110 procedure AddCity;
111 procedure RemoveUnit;
112 end;
113
114 TModalSelectDlg = TListDlg;
115
116const
117 cpType = $10000;
118 mixAll = $10000;
119 adAll = $10000;
120
121
122implementation
123
124uses
125 Term, CityScreen, Help, UnitStat, Tribes, Inp, CmdList;
126
127{$R *.lfm}
128
129const
130 CityNameSpace = 127;
131
132 MustChooseKind = [kTribe, kStealTech, kGovernment];
133
134{ TLine }
135
136procedure TLine.Assign(Source: TLine);
137begin
138 Code := Source.Code;
139 Model := Source.Model;
140 ModelSortValue := Source.ModelSortValue;
141end;
142
143{ TLayer }
144
145procedure TLayer.AddLine(Code: Integer; Model: Integer = 0; ModelSortValue: Integer = 0);
146var
147 NewLine: TLine;
148begin
149 NewLine := TLine.Create;
150 NewLine.Code := Code;
151 NewLine.Model := Model;
152 NewLine.ModelSortValue := ModelSortValue;
153 Lines.Add(NewLine);
154end;
155
156procedure TLayer.SwapLine(I, J: Integer);
157var
158 Temp: TLine;
159begin
160 Temp := TLine.Create;
161 Temp.Assign(Lines[I]);
162 Lines[I].Assign(Lines[J]);
163 Lines[J].Assign(Temp);
164 Temp.Free;
165end;
166
167procedure TLayer.SortModels;
168var
169 I, J: Integer;
170begin
171 for I := 0 to Lines.Count - 2 do
172 for J := I + 1 to Lines.Count - 1 do
173 if Lines[I].ModelSortValue > Lines[J].ModelSortValue then
174 begin
175 SwapLine(I, J);
176 end;
177end;
178
179procedure TLayer.SortTechs;
180var
181 I, J: Integer;
182begin // sort by advancedness
183 for I := 0 to Lines.Count - 2 do
184 if Lines[I].Code < adMilitary then
185 for J := I + 1 to Lines.Count - 1 do
186 if AdvValue[Lines[I].Code] * nAdv + Lines[I].Code < AdvValue[Lines[J].Code] *
187 nAdv + Lines[J].Code then
188 begin
189 SwapLine(I, J);
190 end;
191end;
192
193procedure TLayer.SortCities;
194var
195 I, J: Integer;
196begin
197 for I := 0 to Lines.Count - 2 do
198 for J := I + 1 to Lines.Count - 1 do
199 if CityName(MyCity[Lines[I].Code].ID) > CityName(MyCity[Lines[J].Code].ID) then
200 begin
201 SwapLine(I, J);
202 end;
203end;
204
205constructor TLayer.Create(AIndex: TLayerIndex);
206begin
207 Lines := TObjectList<TLine>.Create;
208 Index := AIndex;
209end;
210
211destructor TLayer.Destroy;
212begin
213 FreeAndNil(Lines);
214 inherited;
215end;
216
217procedure TListDlg.FormCreate(Sender: TObject);
218begin
219 inherited;
220 Layers[laImprovements] := TLayer.Create(laImprovements);
221 Layers[laWonders] := TLayer.Create(laWonders);
222 Layers[laClasses] := TLayer.Create(laClasses);
223 Canvas.Font.Assign(UniFont[ftNormal]);
224 ScrollBar := TPVScrollbar.Create(Self);
225 ScrollBar.SetBorderSpacing(36, 10, 36);
226 ScrollBar.OnUpdate := ScrollBarUpdate;
227 InitButtons;
228 Kind := kMission;
229 LayerImprovementsButton.Hint := Phrases.Lookup('BTN_IMPRS');
230 LayerWondersButton.Hint := Phrases.Lookup('BTN_WONDERS');
231 LayerClassesButton.Hint := Phrases.Lookup('BTN_CLASSES');
232 ScienceNationDotBuffer := TBitmap.Create;
233 ScienceNationDotBuffer.PixelFormat := TPixelFormat.pf24bit;
234 ScienceNationDotBuffer.SetSize(17, 17);
235 ScienceNationDotBuffer.Canvas.FillRect(0, 0, ScienceNationDotBuffer.Width, ScienceNationDotBuffer.Height);
236end;
237
238procedure TListDlg.FormDestroy(Sender: TObject);
239begin
240 FreeAndNil(ScrollBar);
241 FreeAndNil(ScienceNationDotBuffer);
242 FreeAndNil(Layers[laImprovements]);
243 FreeAndNil(Layers[laWonders]);
244 FreeAndNil(Layers[laClasses]);
245end;
246
247procedure TListDlg.CloseBtnClick(Sender: TObject);
248begin
249 Closable := True;
250 Close;
251end;
252
253procedure TListDlg.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
254begin
255 CanClose := Closable or not (Kind in MustChooseKind);
256end;
257
258procedure TListDlg.OnScroll(var Msg: TMessage);
259begin
260 { TODO: Handled by MouseWheel event
261 if ScrollBar.Process(Msg) then begin
262 Selected := -2;
263 SmartUpdateContent(True);
264 end;
265 }
266end;
267
268procedure TListDlg.OnMouseLeave(var Msg: TMessage);
269begin
270 if not Closable and (Selected <> -2) then
271 begin
272 PaintLine(Canvas, Selected, False, False);
273 Selected := -2;
274 end;
275end;
276
277procedure TListDlg.FormPaint(Sender: TObject);
278var
279 S: string;
280begin
281 inherited;
282 Canvas.Font.Assign(UniFont[ftNormal]);
283 if Selected <> -2 then
284 PaintLine(Canvas, Selected, False, True);
285 S := '';
286 if (Kind = kAdvance) and (MyData.FarTech <> adNone) then
287 S := Format(Phrases.Lookup('TECHFOCUS'),
288 [Phrases.Lookup('ADVANCES', MyData.FarTech)])
289 else if Kind = kModels then
290 S := Tribe[Me].TPhrase('SHORTNAME')
291 else if Kind = kEnemyModels then
292 S := Tribe[PlayerView].TPhrase('SHORTNAME') + ' (' +
293 TurnToString(MyRO.EnemyReport[PlayerView].TurnOfMilReport) + ')';
294 if S <> '' then
295 LoweredTextOut(Canvas, -1, MainTexture,
296 (Width - BiColorTextWidth(Canvas, S)) div 2, 31, S);
297 if not MultiPage and (Kind in [kProject, kAdvance, kFarAdvance]) and
298 not Phrases2FallenBackToEnglish then begin
299 S := Phrases2.Lookup('SHIFTCLICK');
300 LoweredTextOut(Canvas, -2, MainTexture,
301 (Width - BiColorTextWidth(Canvas, S)) div 2, Height - 29, S);
302 end;
303end;
304
305procedure TListDlg.PaintLine(ca: TCanvas; L: Integer; NonText, Lit: Boolean);
306// paint a line
307
308 procedure DisplayProject(X, Y, pix: Integer);
309 begin
310 if pix and (cpType or cpImp) = 0 then
311 with Tribe[Me].ModelPicture[pix and cpIndex] do
312 Sprite(Offscreen, HGr, X, Y, 64, 48, pix mod 10 * 65 + 1,
313 pix div 10 * 49 + 1)
314 else
315 begin
316 Frame(Offscreen.Canvas, X + (16 - 1), Y + (16 - 2), X + (16 + xSizeSmall),
317 Y + (16 - 1 + ySizeSmall), MainTexture.ColorBevelLight,
318 MainTexture.ColorBevelShade);
319 if pix and cpType = 0 then
320 if (pix and cpIndex = imPalace) and (MyRO.Government <> gAnarchy) then
321 BitBltBitmap(Offscreen, X + 16, Y + (16 - 1), xSizeSmall,
322 ySizeSmall, SmallImp, (MyRO.Government - 1) *
323 xSizeSmall, ySizeSmall)
324 else
325 BitBltBitmap(Offscreen, X + 16, Y + (16 - 1), xSizeSmall,
326 ySizeSmall, SmallImp, pix and cpIndex mod 7 *
327 xSizeSmall, (pix and cpIndex + SystemIconLines * 7) div 7 *
328 ySizeSmall)
329 else
330 BitBltBitmap(Offscreen, X + 16, Y + (16 - 1), xSizeSmall,
331 ySizeSmall, SmallImp, (3 + pix and cpIndex) *
332 xSizeSmall, 0);
333 end;
334 end;
335
336 procedure ReplaceText(X, Y, Color: Integer; S: string);
337 var
338 TextSize: TSize;
339 begin
340 if ca = Canvas then
341 begin
342 TextSize.cx := BiColorTextWidth(ca, S);
343 TextSize.cy := ca.TextHeight(S);
344 if Y + TextSize.cy >= TitleHeight + InnerHeight then
345 TextSize.cy := TitleHeight + InnerHeight - Y;
346 Fill(ca, X, Y, TextSize.cx, TextSize.cy, (Maintexture.Width - Width)
347 div 2, (Maintexture.Height - Height) div 2);
348 end;
349 LoweredTextOut(ca, Color, MainTexture, X, Y, S);
350 end;
351
352var
353 Icon, ofs, X, Y, y0, lix, I, J, TextColor, Available, First, Test,
354 FutureCount, Growth, TrueFood, TrueProd: Integer;
355 CityReport: TCityReportNew;
356 mox: ^TModelInfo;
357 S, Number: string;
358 CanGrow: Boolean;
359begin
360 lix := Layer.Lines[ScrollBar.Position + L].Code;
361 y0 := 2 + (L + 1) * LineDistance;
362
363 if ScrollBar.Position + L >= Layer.FirstShrinkedLine then
364 ofs := (ScrollBar.Position + L - Layer.FirstShrinkedLine) and 1 * 33
365 else { if Layers[Layer].FirstShrinkedLine < Layers[Layer].Lines.Count then }
366 ofs := 33;
367
368 if Kind in [kCities, kCityEvents] then
369 with TCity(MyCity[lix]) do
370 begin
371 X := 104 - 76;
372 Y := y0;
373 if ca = Canvas then
374 begin
375 X := X + SideFrame;
376 Y := Y + TitleHeight;
377 end;
378 if Lit then
379 TextColor := MainTexture.ColorLitText
380 else
381 TextColor := -1;
382 S := CityName(ID);
383 while BiColorTextWidth(ca, S) > CityNameSpace do
384 Delete(S, Length(S), 1);
385 ReplaceText(X + 15, Y, TextColor, S);
386
387 if NonText then
388 with Offscreen.Canvas do
389 begin // city size
390 Brush.Color := $000000;
391 FillRect(Rect(X - 4 - 11, Y + 1, X - 4 + 13, Y + 21));
392 Brush.Color := $FFFFFF;
393 FillRect(Rect(X - 4 - 12, Y, X - 4 + 12, Y + 20));
394 Brush.Style := TBrushStyle.bsClear;
395 Font.Color := $000000;
396 S := IntToStr(MyCity[lix].Size);
397 TextOut(X - 4 - TextWidth(S) div 2, Y, S);
398 end;
399
400 if Kind = kCityEvents then
401 begin
402 First := -1;
403 for J := 0 to nCityEventPriority - 1 do
404 if (Flags and CityRepMask and CityEventPriority[J] <> 0) then
405 begin
406 First := J;
407 Break;
408 end;
409 if First >= 0 then
410 begin
411 I := 0;
412 Test := 1;
413 while Test < CityEventPriority[First] do
414 begin
415 Inc(I);
416 Inc(Test, Test);
417 end;
418 S := CityEventName(I);
419 { if CityEventPriority[First] = chNoGrowthWarning then
420 if Built[imAqueduct] = 0 then
421 S := Format(S, [Phrases.Lookup('IMPROVEMENTS', imAqueduct)])
422 else begin S := Format(S, [Phrases.Lookup('IMPROVEMENTS', imSewer)]); I := 17 end; }
423 ReplaceText(X + (CityNameSpace + 4 + 40 + 18 + 8), Y, TextColor, S);
424 if NonText then
425 begin
426 Sprite(Offscreen, HGrSystem, 105 - 76 + CityNameSpace + 4 + 40,
427 y0 + 1, 18, 18, 1 + I mod 3 * 19, 1 + I div 3 * 19);
428 X := InnerWidth - 26;
429 for J := nCityEventPriority - 1 downto First + 1 do
430 if (Flags and CityRepMask and CityEventPriority[J] <> 0) then
431 begin
432 I := 0;
433 Test := 1;
434 while Test < CityEventPriority[J] do
435 begin
436 Inc(I);
437 Inc(Test, Test);
438 end;
439 if (CityEventPriority[J] = chNoGrowthWarning) and
440 (Built[imAqueduct] > 0) then
441 I := 17;
442 Sprite(Offscreen, HGrSystem, X, y0 + 1, 18, 18,
443 1 + I mod 3 * 19, 1 + I div 3 * 19);
444 Dec(X, 20);
445 end;
446 end;
447 end;
448 end
449 else
450 begin
451 CityReport.HypoTiles := -1;
452 CityReport.HypoTaxRate := -1;
453 CityReport.HypoLuxuryRate := -1;
454 Server(sGetCityReportNew, Me, lix, CityReport);
455 TrueFood := Food;
456 TrueProd := Prod;
457 if Supervising then
458 begin // normalize city from after-turn state
459 Dec(TrueFood, CityReport.FoodSurplus);
460 if TrueFood < 0 then
461 TrueFood := 0; // shouldn't happen
462 Dec(TrueProd, CityReport.Production);
463 if TrueProd < 0 then
464 TrueProd := 0; // shouldn't happen
465 end;
466
467 S := ''; // disorder info
468 if Flags and chCaptured <> 0 then
469 S := Phrases.Lookup('CITYEVENTS', 14)
470 else if CityReport.HappinessBalance < 0 then
471 S := Phrases.Lookup('CITYEVENTS', 0);
472 if S <> '' then
473 begin { disorder }
474 if NonText then
475 begin
476 DarkGradient(Offscreen.Canvas, 99 + 31 + CityNameSpace + 4,
477 y0 + 2, 131, 3);
478 ca.Font.Assign(UniFont[ftSmall]);
479 RisedTextOut(Offscreen.Canvas, 103 + CityNameSpace + 4 + 31,
480 y0 + 1, S);
481 ca.Font.Assign(UniFont[ftNormal]);
482 end;
483 end
484 else
485 begin
486 { s := IntToStr(CityReport.FoodSurplus);
487 ReplaceText(X + (CityNameSpace + 4 + 48) - BiColorTextWidth(ca, S), Y, TextColor, S); }
488 S := IntToStr(CityReport.Science);
489 ReplaceText(X + CityNameSpace + 4 + 370 + 48 - BiColorTextWidth(ca,
490 S), Y, TextColor, S);
491 S := IntToStr(CityReport.Production);
492 ReplaceText(X + CityNameSpace + 4 + 132 - BiColorTextWidth(ca, S), Y,
493 TextColor, S);
494 if NonText then
495 begin
496 // Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 333 + 1, y + 6, 10, 10, 66, 115);
497 Sprite(Offscreen, HGrSystem, X + CityNameSpace + 4 + 370 + 48 + 1,
498 Y + 6, 10, 10, 77, 126);
499 Sprite(Offscreen, HGrSystem, X + CityNameSpace + 4 + 132 + 1, Y + 6,
500 10, 10, 88, 115);
501 end;
502 end;
503 S := IntToStr(CityTaxBalance(lix, CityReport));
504 ReplaceText(X + CityNameSpace + 4 + 370 - BiColorTextWidth(ca, S), Y,
505 TextColor, S);
506 // if Project and (cpImp + cpIndex) <> cpImp + imTrGoods then
507 // ReplaceText(x + CityNameSpace + 4 + 333 + 1, y, TextColor, Format('%d/%d', [TrueProd,CityReport.ProjectCost]));
508 if NonText then
509 begin
510 Sprite(Offscreen, HGrSystem, X + CityNameSpace + 4 + 370 + 1, Y + 6,
511 10, 10, 132, 115);
512
513 // food progress
514 CanGrow := (Size < MaxCitySize) and (MyRO.Government <> gFuture) and
515 (CityReport.FoodSurplus > 0) and
516 ((Size < NeedAqueductSize) or (Built[imAqueduct] = 1) and
517 (Size < NeedSewerSize) or (Built[imSewer] = 1));
518 Growth := CutCityFoodSurplus(CityReport.FoodSurplus,
519 (MyRO.Government <> gAnarchy) and (Flags and chCaptured = 0),
520 MyRO.Government, Size);
521 PaintRelativeProgressBar(Offscreen.Canvas, 1, X + 15 + CityNameSpace +
522 4, Y + 7, 68, TrueFood, Growth, CityReport.Storage, CanGrow, MainTexture);
523
524 if Project <> cpImp + imTrGoods then
525 begin
526 DisplayProject(ofs + 104 - 76 + X - 28 + CityNameSpace + 4 + 206 -
527 60, y0 - 15, Project);
528
529 // production progress
530 Growth := CityReport.Production;
531 if (Growth < 0) or (MyRO.Government = gAnarchy) or
532 (Flags and chCaptured <> 0) then
533 Growth := 0;
534 PaintRelativeProgressBar(Offscreen.Canvas, 4,
535 X + CityNameSpace + 4 + 304 - 60 + 9, Y + 7, 68, TrueProd, Growth,
536 CityReport.ProjectCost, True, MainTexture);
537 end;
538 end;
539 end;
540 end
541 else if Kind in [kModels, kEnemyModels] then
542 begin
543 X := 104;
544 Y := y0;
545 if ca = Canvas then
546 begin
547 X := X + SideFrame;
548 Y := Y + TitleHeight;
549 end;
550 if Lit then
551 TextColor := MainTexture.ColorLitText
552 else
553 TextColor := -1;
554 if Kind = kModels then
555 begin
556 Available := 0;
557 for J := 0 to MyRO.nUn - 1 do
558 if (MyUn[J].Loc >= 0) and (MyUn[J].mix = lix) then
559 Inc(Available);
560 if MainScreen.mNames.Checked then
561 S := Tribe[Me].ModelName[lix]
562 else
563 S := Format(Tribe[Me].TPhrase('GENMODEL'), [lix]);
564 if NonText then
565 DisplayProject(8 + ofs, y0 - 15, lix);
566 end
567 else
568 begin
569 Available := MyRO.EnemyReport[PlayerView].UnCount[lix];
570 if MainScreen.mNames.Checked then
571 S := Tribe[PlayerView].ModelName[lix]
572 else
573 S := Format(Tribe[PlayerView].TPhrase('GENMODEL'), [lix]);
574 if NonText then
575 with Tribe[PlayerView].ModelPicture[lix] do
576 Sprite(Offscreen, HGr, 8 + ofs, y0 - 15, 64, 48, pix mod 10 * 65 + 1,
577 pix div 10 * 49 + 1);
578 end;
579 if Available > 0 then
580 ReplaceText(X + 32 - BiColorTextWidth(ca, IntToStr(Available)), Y,
581 TextColor, IntToStr(Available));
582 ReplaceText(X + 40, Y, TextColor, S);
583 end
584 else
585 begin
586 case Kind of
587 kAllEnemyModels, kChooseEnemyModel:
588 if lix = mixAll then
589 S := Phrases.Lookup('PRICECAT_ALLMODEL')
590 else
591 begin
592 mox := @MyRO.EnemyModel[lix];
593 if MainScreen.mNames.Checked then
594 begin
595 S := Tribe[mox.Owner].ModelName[mox.mix];
596 if (Kind = kAllEnemyModels) and (Layers[laImprovements].Lines[ScrollBar.Position + L].Model = 0) then
597 S := Format(Tribe[mox.Owner].TPhrase('OWNED'), [S]);
598 end
599 else
600 S := Format(Tribe[mox.Owner].TPhrase('GENMODEL'), [mox.mix]);
601 if NonText then
602 with Tribe[mox.Owner].ModelPicture[mox.mix] do
603 Sprite(Offscreen, HGr, 8 + ofs, y0 - 15, 64, 48,
604 pix mod 10 * 65 + 1, pix div 10 * 49 + 1);
605 end;
606 kChooseModel:
607 if lix = mixAll then
608 S := Phrases.Lookup('PRICECAT_ALLMODEL')
609 else
610 begin
611 S := Tribe[Me].ModelName[lix];
612 if NonText then
613 DisplayProject(8 + ofs, y0 - 15, lix);
614 end;
615 kProject:
616 begin
617 if lix and cpType <> 0 then
618 S := Phrases.Lookup('CITYTYPE', lix and cpIndex)
619 else if lix and cpImp = 0 then
620 with MyModel[lix and cpIndex] do
621 begin
622 S := Tribe[Me].ModelName[lix and cpIndex];
623 if lix and cpConscripts <> 0 then
624 S := Format(Phrases.Lookup('CONSCRIPTS'), [S]);
625 end
626 else
627 begin
628 S := Phrases.Lookup('IMPROVEMENTS', lix and cpIndex);
629 if (Imp[lix and cpIndex].Kind in [ikNatLocal, ikNatGlobal]) and
630 (MyRO.NatBuilt[lix and cpIndex] > 0) or
631 (lix and cpIndex in [imPower, imHydro, imNuclear]) and
632 (MyCity[cixProject].Built[imPower] + MyCity[cixProject].Built
633 [imHydro] + MyCity[cixProject].Built[imNuclear] > 0) then
634 S := Format(Phrases.Lookup('NATEXISTS'), [S]);
635 end;
636 if NonText then
637 DisplayProject(8 + ofs, y0 - 15, lix);
638 end;
639 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseEnemyTech, kStealTech:
640 begin
641 if lix = adAll then
642 S := Phrases.Lookup('PRICECAT_ALLTECH')
643 else
644 begin
645 if lix = adNexus then
646 S := Phrases.Lookup('NEXUS')
647 else if lix = adNone then
648 S := Phrases.Lookup('NOFARTECH')
649 else if lix = adMilitary then
650 S := Phrases.Lookup('INITUNIT')
651 else
652 begin
653 S := Phrases.Lookup('ADVANCES', lix);
654 if (Kind = kAdvance) and (lix in FutureTech) then
655 if MyRO.Tech[lix] < tsApplicable then
656 S := S + ' 1'
657 else
658 S := S + ' ' + IntToStr(MyRO.Tech[lix] + 1);
659 end;
660 if BiColorTextWidth(ca, S) > TechNameSpace + 8 then
661 begin
662 repeat
663 Delete(S, Length(S), 1);
664 until BiColorTextWidth(ca, S) <= TechNameSpace + 5;
665 S := S + '.';
666 end;
667
668 if NonText then
669 begin // show tech Icon
670 if lix = adNexus then
671 begin
672 Frame(Offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36),
673 y0 + 20, MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
674 Dump(Offscreen, HGrSystem, (8 + 16), y0, 36, 20, 223, 295)
675 end
676 else if lix = adNone then
677 begin
678 Frame(Offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36),
679 y0 + 20, MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
680 Dump(Offscreen, HGrSystem, (8 + 16), y0, 36, 20, 260, 295)
681 end
682 else if lix = adMilitary then
683 begin
684 Frame(Offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36),
685 y0 + 20, MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
686 Dump(Offscreen, HGrSystem, (8 + 16), y0, 36, 20, 38, 295)
687 end
688 else
689 begin
690 Frame(Offscreen.Canvas, (8 + 16 - 1), y0 - 1,
691 (8 + 16 + xSizeSmall), y0 + ySizeSmall,
692 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
693 if AdvIcon[lix] < 84 then
694 BitBltBitmap(Offscreen, (8 + 16), y0, xSizeSmall,
695 ySizeSmall, SmallImp,
696 (AdvIcon[lix] + SystemIconLines * 7) mod 7 * xSizeSmall,
697 (AdvIcon[lix] + SystemIconLines * 7) div 7 *
698 ySizeSmall)
699 else
700 Dump(Offscreen, HGrSystem, (8 + 16), y0, 36, 20,
701 1 + (AdvIcon[lix] - 84) mod 8 * 37,
702 295 + (AdvIcon[lix] - 84) div 8 * 21);
703 J := AdvValue[lix] div 1000;
704 BitBltBitmap(Offscreen, (8 + 16 - 4), y0 + 2, 14, 14,
705 HGrSystem.Mask, 127 + J * 15,
706 85, SRCAND);
707 Sprite(Offscreen, HGrSystem, (8 + 16 - 5), y0 + 1, 14, 14,
708 127 + J * 15, 85);
709 end;
710 end;
711 end;
712
713 if NonText and (Kind in [kAdvance, kScience]) then
714 begin // show research state
715 for J := 0 to nColumn - 1 do
716 begin
717 FutureCount := 0;
718 if J = 0 then // own science
719 if lix = MyRO.ResearchTech then
720 begin
721 Server(sGetTechCost, Me, 0, Icon);
722 Icon := 4 + MyRO.Research * 4 div Icon;
723 if Icon > 4 + 3 then
724 Icon := 4 + 3
725 end
726 else if (lix >= adMilitary) then
727 Icon := -1
728 else if lix in FutureTech then
729 begin
730 Icon := -1;
731 FutureCount := MyRO.Tech[lix];
732 end
733 else if MyRO.Tech[lix] = tsSeen then
734 Icon := 1
735 else if MyRO.Tech[lix] >= tsApplicable then
736 Icon := 2
737 else
738 Icon := -1
739 else
740 with MyRO.EnemyReport[Column[J]]^ do // enemy science
741 if (MyRO.Alive and (1 shl Column[J]) <> 0) and
742 (TurnOfCivilReport >= 0) and (lix = ResearchTech) and
743 ((lix = adMilitary) or (lix in FutureTech) or
744 (Tech[lix] < tsApplicable)) then
745 begin
746 Icon := 4 + ResearchDone div 25;
747 if Icon > 4 + 3 then
748 Icon := 4 + 3;
749 end
750 else if lix = adMilitary then
751 Icon := -1
752 else if lix in FutureTech then
753 begin
754 Icon := -1;
755 FutureCount := Tech[lix]
756 end
757 else if Tech[lix] >= tsApplicable then
758 Icon := 2
759 else if Tech[lix] = tsSeen then
760 Icon := 1
761 else
762 Icon := -1;
763 if Icon >= 0 then
764 Sprite(Offscreen, HGrSystem, 104 - 33 + 15 + 3 + TechNameSpace +
765 24 * J, y0 + 3, 14, 14, 67 + Icon * 15, 85)
766 else if (Kind = kScience) and (FutureCount > 0) then
767 begin
768 Number := IntToStr(FutureCount);
769 RisedTextOut(ca, 104 - 33 + 15 + 10 + TechNameSpace + 24 * J -
770 BiColorTextWidth(ca, Number) div 2, y0, Number);
771 end;
772 end;
773 end;
774 end; // kAdvance, kScience
775 kTribe:
776 S := TribeNames[lix];
777 kShipPart:
778 begin
779 S := Phrases.Lookup('IMPROVEMENTS', imShipComp + lix) + ' (' +
780 IntToStr(MyRO.Ship[Me].Parts[lix]) + ')';
781 if NonText then
782 DisplayProject(8 + ofs, y0 - 15, cpImp + imShipComp + lix);
783 end;
784 kEnemyShipPart:
785 begin
786 S := Phrases.Lookup('IMPROVEMENTS', imShipComp + lix) + ' (' +
787 IntToStr(MyRO.Ship[DipMem[Me].pContact].Parts[lix]) + ')';
788 if NonText then
789 DisplayProject(8 + ofs, y0 - 15, cpImp + imShipComp + lix);
790 end;
791 kGovernment:
792 begin
793 S := Phrases.Lookup('GOVERNMENT', lix);
794 if NonText then
795 begin
796 Frame(Offscreen.Canvas, 8 + 16 - 1, y0 - 15 + (16 - 2),
797 8 + 16 + xSizeSmall, y0 - 15 + (16 - 1 + ySizeSmall),
798 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
799 BitBltBitmap(Offscreen, 8 + 16, y0 - 15 + (16 - 1),
800 xSizeSmall, ySizeSmall, SmallImp, (lix - 1) * xSizeSmall, ySizeSmall);
801 end;
802 end;
803 kMission:
804 S := Phrases.Lookup('SPYMISSION', lix);
805 end;
806 case Kind of
807 kTribe, kMission: // center text
808 if Layers[laImprovements].Lines.Count > MaxLines then
809 X := (InnerWidth - GetSystemMetrics(SM_CXVSCROLL)) div 2 -
810 BiColorTextWidth(ca, S) div 2
811 else
812 X := InnerWidth div 2 - BiColorTextWidth(ca, S) div 2;
813 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseEnemyTech,
814 kStealTech, kGovernment:
815 X := 104 - 33;
816 kAllEnemyModels:
817 X := 104;
818 else
819 X := 104 + 15;
820 end;
821 Y := y0;
822 if ca = Canvas then
823 begin
824 X := X + SideFrame;
825 Y := Y + TitleHeight;
826 end;
827 if Lit then
828 TextColor := MainTexture.ColorLitText
829 else
830 TextColor := -1;
831 { if Kind = kTribe then ReplaceText_Tribe(X, Y, TextColor,
832 Integer(TribeNames.Objects[lix]), S)
833 else } ReplaceText(X, Y, TextColor, S);
834 end;
835end;
836
837procedure TListDlg.OffscreenPaint;
838var
839 I, J: Integer;
840begin
841 case Kind of
842 kCities:
843 Caption := Tribe[Me].TPhrase('TITLE_CITIES');
844 kCityEvents:
845 Caption := Format(Phrases.Lookup('TITLE_EVENTS'),
846 [TurnToString(MyRO.Turn)]);
847 end;
848
849 inherited;
850 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
851 FillOffscreen(0, 0, InnerWidth, InnerHeight);
852 with Offscreen.Canvas do
853 begin
854 if Kind = kScience then
855 for I := 1 to nColumn - 1 do
856 begin
857 Pen.Color := $000000;
858 MoveTo(104 - 33 + 15 + TechNameSpace + 24 * I, 0);
859 LineTo(104 - 33 + 15 + TechNameSpace + 24 * I, InnerHeight);
860 MoveTo(104 - 33 + 15 + TechNameSpace + 9 * 2 + 24 * I, 0);
861 LineTo(104 - 33 + 15 + TechNameSpace + 9 * 2 + 24 * I, InnerHeight);
862 if MyRO.EnemyReport[Column[I]].TurnOfCivilReport >= MyRO.Turn - 1 then
863 begin
864 Brush.Color := Tribe[Column[I]].Color;
865 FillRect(rect(104 - 33 + 14 + TechNameSpace + 24 * I + 1 * 2, 0,
866 104 - 33 + 17 + TechNameSpace + 24 * I + 8 * 2, InnerHeight));
867 Brush.Style := TBrushStyle.bsClear;
868 end
869 else
870 begin // colored player columns
871 Pen.Color := Tribe[Column[I]].Color;
872 for J := 1 to 8 do
873 begin
874 MoveTo(104 - 33 + 15 + TechNameSpace + 24 * I + J * 2, 0);
875 LineTo(104 - 33 + 15 + TechNameSpace + 24 * I + J * 2, InnerHeight);
876 end;
877 end;
878 end;
879
880 for I := -1 to DispLines do
881 if (I + ScrollBar.Position >= 0) and (I + ScrollBar.Position < Layer.Lines.Count) then
882 PaintLine(Offscreen.Canvas, I, True, False);
883 end;
884 MarkUsedOffscreen(InnerWidth, 8 + 48 + DispLines * LineDistance);
885end;
886
887procedure TListDlg.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState;
888 X, Y: Integer);
889var
890 i0, Sel0, iColumn, OldScienceNation, xScreen: Integer;
891 S: string;
892begin
893 Y := Y - TitleHeight;
894 i0 := ScrollBar.Position;
895 Sel0 := Selected;
896 if (X >= SideFrame) and (X < SideFrame + InnerWidth) and (Y >= 0) and
897 (Y < InnerHeight) and (Y mod LineDistance >= 4) and (Y mod LineDistance < 20)
898 then
899 Selected := Y div LineDistance - 1
900 else
901 Selected := -2;
902 if (Selected < -1) or (Selected > DispLines) or (Selected + i0 < 0) or
903 (Selected + i0 >= Layer.Lines.Count) then
904 Selected := -2;
905 if Selected <> Sel0 then begin
906 if Sel0 <> -2 then
907 PaintLine(Canvas, Sel0, False, False);
908 if Selected <> -2 then
909 PaintLine(Canvas, Selected, False, True);
910 end;
911
912 if Kind = kScience then
913 begin // show nation under cursor position
914 OldScienceNation := ScienceNation;
915 ScienceNation := -1;
916 if (X >= SideFrame + (104 - 33 + 15 + TechNameSpace)) and
917 ((X - SideFrame - (104 - 33 + 15 + TechNameSpace)) mod 24 <= 18) and
918 (Y >= 0) and (Y < InnerHeight) then
919 begin
920 iColumn := (X - SideFrame - (104 - 33 + 15 + TechNameSpace)) div 24;
921 if (iColumn >= 1) and (iColumn < nColumn) then
922 ScienceNation := Column[iColumn];
923 end;
924 if ScienceNation <> OldScienceNation then
925 begin
926 Fill(Canvas, 9, Height - 29, Width - 18, 24,
927 (Maintexture.Width - Width) div 2,
928 (Maintexture.Height - Height) div 2);
929 if ScienceNation >= 0 then
930 begin
931 S := Tribe[ScienceNation].TPhrase('SHORTNAME');
932 if MyRO.Alive and (1 shl ScienceNation) = 0 then
933 S := Format(Phrases.Lookup('SCIENCEREPORT_EXTINCT'), [S]) // extinct
934 else if MyRO.EnemyReport[ScienceNation].TurnOfCivilReport < MyRO.Turn - 1
935 then
936 S := S + ' (' + TurnToString(MyRO.EnemyReport[ScienceNation]
937 .TurnOfCivilReport) + ')'; // old report
938 xScreen := (Width - BiColorTextWidth(Canvas, S)) div 2;
939 LoweredTextOut(Canvas, -1, MainTexture, xScreen + 10,
940 Height - 29, S);
941 BitBltCanvas(ScienceNationDotBuffer.Canvas, 0, 0, ScienceNationDot.Width,
942 ScienceNationDot.Height, Canvas, xScreen - 10, Height - 27);
943 ImageOp_BCC(ScienceNationDotBuffer, Templates.Data, Point(0, 0),
944 ScienceNationDot.BoundsRect, MainTexture.ColorBevelShade, Tribe[ScienceNation].Color);
945 BitBltCanvas(Canvas, xScreen - 10, Height - 27, ScienceNationDot.Width,
946 ScienceNationDot.Height, ScienceNationDotBuffer.Canvas, 0, 0);
947 end;
948 end;
949 end;
950end;
951
952procedure TListDlg.FormMouseWheel(Sender: TObject; Shift: TShiftState;
953 WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
954begin
955 if ScrollBar.ProcessMouseWheel(WheelDelta) then begin
956 PaintBox1MouseMove(nil, [], MousePos.X - Left,
957 MousePos.Y - Top);
958 end;
959end;
960
961procedure TListDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction);
962begin
963 //Gtk2Fix;
964end;
965
966function TListDlg.RenameCity(cix: Integer): Boolean;
967var
968 CityNameInfo: TCityNameInfo;
969begin
970 InputDlg.Caption := Phrases.Lookup('TITLE_CITYNAME');
971 InputDlg.EditInput.Text := CityName(MyCity[cix].ID);
972 InputDlg.CenterToRect(BoundsRect);
973 InputDlg.ShowModal;
974 if (InputDlg.ModalResult = mrOK) and (InputDlg.EditInput.Text <> '') and
975 (InputDlg.EditInput.Text <> CityName(MyCity[cix].ID)) then
976 begin
977 CityNameInfo.ID := MyCity[cix].ID;
978 CityNameInfo.NewName := InputDlg.EditInput.Text;
979 if CityNameInfo.GetCommandDataSize > CommandDataMaxSize then
980 Delete(CityNameInfo.NewName, Length(CityNameInfo.NewName) -
981 (CityNameInfo.GetCommandDataSize - 1 - CommandDataMaxSize), MaxInt);
982 Server(CommandWithData(cSetCityName, CityNameInfo.GetCommandDataSize),
983 Me, 0, CityNameInfo);
984 if MainScreen.CityDlg.Visible then
985 begin
986 MainScreen.CityDlg.FormShow(nil);
987 MainScreen.CityDlg.Invalidate;
988 end;
989 Result := True;
990 end
991 else
992 Result := False;
993end;
994
995function TListDlg.RenameModel(mix: Integer): Boolean;
996var
997 ModelNameInfo: TModelNameInfo;
998begin
999 InputDlg.Caption := Phrases.Lookup('TITLE_MODELNAME');
1000 InputDlg.EditInput.Text := Tribe[Me].ModelName[mix];
1001 InputDlg.CenterToRect(BoundsRect);
1002 InputDlg.ShowModal;
1003 if (InputDlg.ModalResult = mrOK) and (InputDlg.EditInput.Text <> '') and
1004 (InputDlg.EditInput.Text <> Tribe[Me].ModelName[mix]) then
1005 begin
1006 ModelNameInfo.mix := mix;
1007 ModelNameInfo.NewName := InputDlg.EditInput.Text;
1008 if ModelNameInfo.GetCommandDataSize > CommandDataMaxSize then
1009 Delete(ModelNameInfo.NewName, Length(ModelNameInfo.NewName) -
1010 (ModelNameInfo.GetCommandDataSize - 1 - CommandDataMaxSize), MaxInt);
1011 Server(CommandWithData(cSetModelName, ModelNameInfo.GetCommandDataSize),
1012 Me, 0, ModelNameInfo);
1013 if MainScreen.UnitStatDlg.Visible then
1014 begin
1015 MainScreen.UnitStatDlg.FormShow(nil);
1016 MainScreen.UnitStatDlg.Invalidate;
1017 end;
1018 Result := True;
1019 end
1020 else
1021 Result := False;
1022end;
1023
1024procedure TListDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
1025 Shift: TShiftState; X, Y: Integer);
1026var
1027 lix: Integer;
1028begin
1029 if ScrollBar.Position + Selected >= 0 then
1030 lix := Layer.Lines[ScrollBar.Position + Selected].Code;
1031 if Kind in [kScience, kCities, kCityEvents, kModels, kEnemyModels, kAllEnemyModels]
1032 then
1033 Include(Shift, ssShift); // don't close list window
1034 if (ssLeft in Shift) and not (ssShift in Shift) then
1035 begin
1036 if Selected <> -2 then
1037 begin
1038 Result := lix;
1039 Closable := True;
1040 Close;
1041 end;
1042 end
1043 else if (ssLeft in Shift) and (ssShift in Shift) then
1044 begin // show help/info popup
1045 if Selected <> -2 then
1046 case Kind of
1047 kCities:
1048 MainScreen.ZoomToCity(MyCity[lix].Loc);
1049 kCityEvents:
1050 MainScreen.ZoomToCity(MyCity[lix].Loc, False, MyCity[lix].Flags and
1051 CityRepMask);
1052 kModels, kChooseModel:
1053 if lix <> mixAll then
1054 MainScreen.UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, lix);
1055 kEnemyModels:
1056 MainScreen.UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent,
1057 Layers[laImprovements].Lines[ScrollBar.Position + Selected].Code);
1058 kAllEnemyModels, kChooseEnemyModel:
1059 if lix <> mixAll then
1060 MainScreen.UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent, lix);
1061 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseEnemyTech, kStealTech:
1062 if lix = adMilitary then
1063 MainScreen.HelpDlg.ShowNewContent(wmPersistent, hkText,
1064 MainScreen.HelpDlg.TextIndex('MILRES'))
1065 else if lix < adMilitary then
1066 MainScreen.HelpDlg.ShowNewContent(wmPersistent, hkAdv, lix);
1067 kProject:
1068 if lix = cpImp + imTrGoods then
1069 MainScreen.HelpDlg.ShowNewContent(wmPersistent, hkText,
1070 MainScreen.HelpDlg.TextIndex('TRADINGGOODS'))
1071 else if lix and (cpImp + cpType) = 0 then
1072 MainScreen.UnitStatDlg.ShowNewContent_OwnModel(wmPersistent,
1073 lix and cpIndex)
1074 else if (lix and cpType = 0) and (lix <> cpImp + imTrGoods) then
1075 MainScreen.HelpDlg.ShowNewContent(wmPersistent, hkImp,
1076 lix and cpIndex);
1077 kGovernment:
1078 MainScreen.HelpDlg.ShowNewContent(wmPersistent, hkMisc,
1079 Integer(miscGovList));
1080 kShipPart, kEnemyShipPart:
1081 ;
1082 end;
1083 end
1084 else if ssRight in Shift then
1085 begin
1086 if Selected <> -2 then
1087 case Kind of
1088 kCities, kCityEvents:
1089 if RenameCity(lix) then begin
1090 SmartUpdateContent;
1091 Term.MainScreen.RepaintAll;
1092 end;
1093 kModels:
1094 if RenameModel(lix) then begin
1095 SmartUpdateContent;
1096 Term.MainScreen.RepaintAll;
1097 end;
1098 end;
1099 end;
1100end;
1101
1102procedure TListDlg.InitLines;
1103var
1104 Required: array [0 .. nAdv - 1] of Integer;
1105
1106 procedure TryAddImpLine(Layer: TLayer; Project: Integer);
1107 begin
1108 if Server(sSetCityProject - sExecute, Me, cixProject, Project) >= rExecuted
1109 then
1110 begin
1111 Layer.AddLine(Project);
1112 end;
1113 end;
1114
1115 function ModelSortValue(const ModelInfo: TModelInfo;
1116 MixPlayers: Boolean = False): Integer;
1117 begin
1118 Result := (ModelInfo.Domain + 1) shl 28 - ModelInfo.mix;
1119 if MixPlayers then
1120 Dec(Result, ModelCode(ModelInfo) shl 16);
1121 end;
1122
1123 procedure MarkPreqs(I: Integer);
1124 begin
1125 Required[I] := 1;
1126 if MyRO.Tech[I] < tsSeen then
1127 begin
1128 if (AdvPreq[I, 0] >= 0) then
1129 MarkPreqs(AdvPreq[I, 0]);
1130 if (AdvPreq[I, 1] >= 0) then
1131 MarkPreqs(AdvPreq[I, 1]);
1132 end;
1133 end;
1134
1135var
1136 L: TLayerIndex;
1137 Loc1, I, J, p1, dx, dy, mix, emix, EnemyType, TestEnemyType: Integer;
1138 ModelInfo: TModelInfo;
1139 PPicture, PTestPicture: ^TModelPicture;
1140 ModelOk: array [0 .. 4095] of Boolean;
1141 Model: Integer;
1142 Ok: Boolean;
1143begin
1144 for L := Low(TLayerIndex) to High(TLayerIndex) do
1145 begin
1146 Layers[L].Lines.Clear;
1147 Layers[L].FirstShrinkedLine := MaxInt;
1148 end;
1149
1150 case Kind of
1151 kProject:
1152 begin
1153 // improvements
1154 Layers[laImprovements].AddLine(cpImp + imTrGoods);
1155 for I := nWonder to nImp - 1 do
1156 if Imp[I].Kind = ikCommon then
1157 TryAddImpLine(Layers[laImprovements], I + cpImp);
1158 for I := nWonder to nImp - 1 do
1159 if not (Imp[I].Kind in [ikCommon, ikTrGoods]) and
1160 ((MyRO.NatBuilt[I] = 0) or (Imp[I].Kind = ikNatLocal)) then
1161 TryAddImpLine(Layers[laImprovements], I + cpImp);
1162 for I := 0 to nCityType - 1 do
1163 if MyData.ImpOrder[I, 0] >= 0 then
1164 Layers[laImprovements].AddLine(cpType + I);
1165
1166 // wonders
1167 for I := 0 to nWonder - 1 do
1168 TryAddImpLine(Layers[laWonders], I + cpImp);
1169
1170 // units
1171 for I := 0 to MyRO.nModel - 1 do
1172 begin
1173 { if MyModel[i].Kind = mkSlaves then
1174 Ok := MyRO.Wonder[woPyramids].EffectiveOwner = Me
1175 else } if MyModel[I].Domain = dSea then
1176 begin
1177 Ok := False;
1178 for dx := -2 to 2 do
1179 for dy := -2 to 2 do
1180 if Abs(dx) + Abs(dy) = 2 then
1181 begin
1182 Loc1 := dLoc(MyCity[cixProject].Loc, dx, dy);
1183 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) and
1184 ((MyMap[Loc1] and fTerrain = fShore) or
1185 (MyMap[Loc1] and fCanal > 0)) then begin
1186 Ok := True;
1187 Break;
1188 end;
1189 end;
1190 end
1191 else
1192 Ok := True;
1193 if Ok then
1194 begin
1195 if MyModel[I].Status and msObsolete = 0 then
1196 begin
1197 Layers[laClasses].AddLine(I);
1198 end;
1199 if MyModel[I].Status and msAllowConscripts <> 0 then
1200 begin
1201 Layers[laClasses].AddLine(I + cpConscripts);
1202 end;
1203 end;
1204 end;
1205 Layers[laClasses].FirstShrinkedLine := 0;
1206 end;
1207 kAdvance:
1208 begin
1209 nColumn := 1;
1210 if MyData.FarTech <> adNone then
1211 begin
1212 FillChar(Required, SizeOf(Required), 0);
1213 MarkPreqs(MyData.FarTech);
1214 end;
1215 for I := 0 to nAdv - 1 do
1216 if ((I in FutureTech) or (MyRO.Tech[I] < tsApplicable)) and
1217 (Server(sSetResearch - sExecute, Me, I, nil^) >= rExecuted) and
1218 ((MyData.FarTech = adNone) or (Required[I] > 0)) then
1219 begin
1220 Layers[laImprovements].AddLine(I);
1221 end;
1222 Layers[laImprovements].SortTechs;
1223 if Layers[laImprovements].Lines.Count = 0 then // no more techs -- offer nexus
1224 Layers[laImprovements].AddLine(adNexus);
1225 Ok := False;
1226 for I := 0 to nDomains - 1 do
1227 if (upgrade[I, 0].Preq = preNone) or
1228 (MyRO.Tech[upgrade[I, 0].Preq] >= tsApplicable) then begin
1229 Ok := True;
1230 Break;
1231 end;
1232 if Ok then { new unit class }
1233 Layers[laImprovements].AddLine(adMilitary);
1234 end;
1235 kFarAdvance:
1236 begin
1237 Layers[laImprovements].AddLine(adNone);
1238 for I := 0 to nAdv - 1 do
1239 if not (I in FutureTech) and (MyRO.Tech[I] < tsApplicable) and
1240 ((AdvValue[I] < 2000) or (MyRO.Tech[adMassProduction] > tsNA)) and
1241 ((AdvValue[I] < 1000) or (MyRO.Tech[adScience] > tsNA)) then
1242 begin
1243 Layers[laImprovements].AddLine(I);
1244 end;
1245 Layers[laImprovements].SortTechs;
1246 end;
1247 kChooseTech:
1248 begin
1249 for I := 0 to nAdv - 1 do
1250 if not (I in FutureTech) and (MyRO.Tech[I] >= tsApplicable) and
1251 (MyRO.EnemyReport[DipMem[Me].pContact].Tech[I] < tsSeen) then
1252 begin
1253 Layers[laImprovements].AddLine(I);
1254 end;
1255 Layers[laImprovements].SortTechs;
1256 // if Layers[0].Lines.Count > 1 then
1257 begin
1258 Layers[laImprovements].AddLine(adAll);
1259 end;
1260 end;
1261 kChooseEnemyTech:
1262 begin
1263 for I := 0 to nAdv - 1 do
1264 if not (I in FutureTech) and (MyRO.Tech[I] < tsSeen) and
1265 (MyRO.EnemyReport[DipMem[Me].pContact].Tech[I] >= tsApplicable) then
1266 begin
1267 Layers[laImprovements].AddLine(I);
1268 end;
1269 Layers[laImprovements].SortTechs;
1270 // if LAyers[0].Lines.Count > 1 then
1271 begin
1272 Layers[laImprovements].AddLine(adAll);
1273 end;
1274 end;
1275 kStealTech:
1276 begin
1277 for I := 0 to nAdv - 1 do
1278 if Server(sStealTech - sExecute, Me, I, nil^) >= rExecuted then
1279 begin
1280 Layers[laImprovements].AddLine(I);
1281 end;
1282 Layers[laImprovements].SortTechs;
1283 end;
1284 kScience:
1285 begin
1286 Column[0] := Me;
1287 nColumn := 1;
1288 for EnemyType := 0 to 2 do
1289 for p1 := 0 to nPl - 1 do
1290 if (MyRO.EnemyReport[p1] <> nil) and
1291 ((MyRO.EnemyReport[p1].TurnOfContact >= 0) or
1292 (MyRO.EnemyReport[p1].TurnOfCivilReport >= 0)) then
1293 begin
1294 if MyRO.Alive and (1 shl p1) = 0 then
1295 TestEnemyType := 2 // extinct enemy -- move to right end
1296 else if MyRO.EnemyReport[p1].TurnOfCivilReport >= MyRO.Turn - 1
1297 then
1298 TestEnemyType := 0 // current report -- move to left end
1299 else
1300 TestEnemyType := 1;
1301 if TestEnemyType = EnemyType then
1302 begin
1303 Column[nColumn] := p1;
1304 Inc(nColumn);
1305 end;
1306 end;
1307 for I := 0 to nAdv - 1 do
1308 begin
1309 Ok := (MyRO.Tech[I] <> tsNA) or (MyRO.ResearchTech = I);
1310 for J := 1 to nColumn - 1 do
1311 with MyRO.EnemyReport[Column[J]]^ do
1312 if (Tech[I] <> tsNA) or (TurnOfCivilReport >= 0) and
1313 (ResearchTech = I) then
1314 Ok := True;
1315 if Ok then
1316 Layers[laImprovements].AddLine(I);
1317 end;
1318 Layers[laImprovements].SortTechs;
1319
1320 Ok := MyRO.ResearchTech = adMilitary;
1321 for J := 1 to nColumn - 1 do
1322 with MyRO.EnemyReport[Column[J]]^ do
1323 if (MyRO.Alive and (1 shl Column[J]) <> 0) and
1324 (TurnOfCivilReport >= 0) and (ResearchTech = adMilitary) then begin
1325 Ok := True;
1326 Break;
1327 end;
1328 if Ok then
1329 Layers[laImprovements].AddLine(adMilitary);
1330 end;
1331 kCities { , kChooseCity } :
1332 begin
1333 if ClientMode < scContact then
1334 for I := 0 to MyRO.nCity - 1 do
1335 if MyCity[I].Loc >= 0 then
1336 begin
1337 Layers[laImprovements].AddLine(I);
1338 end;
1339 Layers[laImprovements].SortCities;
1340 Layers[laImprovements].FirstShrinkedLine := 0;
1341 end;
1342 kCityEvents:
1343 begin
1344 for I := 0 to MyRO.nCity - 1 do
1345 if (MyCity[I].Loc >= 0) and (MyCity[I].Flags and CityRepMask <> 0)
1346 then begin
1347 Layers[laImprovements].AddLine(I);
1348 end;
1349 Layers[laImprovements].SortCities;
1350 Layers[laImprovements].FirstShrinkedLine := 0;
1351 end;
1352 { kChooseEnemyCity:
1353 begin
1354 for I := 0 to MyRO.nEnemyCity - 1 do
1355 if (MyRO.EnemyCity[I].Loc >= 0)
1356 and (MyRO.EnemyCity[I].Owner = DipMem[Me].pContact) then
1357 begin
1358 Layers[laImprovements].AddCode(I);
1359 end;
1360 Layers[laImprovements].FirstShrinkedLine := 0;
1361 end; }
1362 kModels:
1363 begin
1364 for mix := 0 to MyRO.nModel - 1 do
1365 begin
1366 MakeModelInfo(Me, mix, MyModel[mix], ModelInfo);
1367 Layers[laImprovements].AddLine(mix, 0, ModelSortValue(ModelInfo));
1368 end;
1369 Layers[laImprovements].SortModels;
1370 Layers[laImprovements].FirstShrinkedLine := 0;
1371 end;
1372 kChooseModel:
1373 begin
1374 for mix := 3 to MyRO.nModel - 1 do
1375 begin // check if opponent already has this model
1376 MakeModelInfo(Me, mix, MyModel[mix], ModelInfo);
1377 Ok := True;
1378 for emix := 0 to MyRO.nEnemyModel - 1 do
1379 if (MyRO.EnemyModel[emix].Owner = DipMem[Me].pContact) and
1380 IsSameModel(MyRO.EnemyModel[emix], ModelInfo) then begin
1381 Ok := False;
1382 Break;
1383 end;
1384 if Ok then
1385 begin
1386 MakeModelInfo(Me, mix, MyModel[mix], ModelInfo);
1387 Layers[laImprovements].AddLine(mix, 0, ModelSortValue(ModelInfo));
1388 end;
1389 end;
1390 Layers[laImprovements].SortModels;
1391 Layers[laImprovements].AddLine(mixAll);
1392 Layers[laImprovements].FirstShrinkedLine := 0;
1393 end;
1394 kChooseEnemyModel:
1395 begin
1396 if MyRO.TestFlags and tfUncover <> 0 then
1397 Server(sGetModels, Me, 0, nil^);
1398 for emix := 0 to MyRO.nEnemyModel - 1 do
1399 ModelOk[emix] := MyRO.EnemyModel[emix].Owner = DipMem[Me].pContact;
1400 for mix := 0 to MyRO.nModel - 1 do
1401 begin // don't list models I already have
1402 MakeModelInfo(Me, mix, MyModel[mix], ModelInfo);
1403 for emix := 0 to MyRO.nEnemyModel - 1 do
1404 ModelOk[emix] := ModelOk[emix] and
1405 not IsSameModel(MyRO.EnemyModel[emix], ModelInfo);
1406 end;
1407 for emix := 0 to MyRO.nEnemyModel - 1 do
1408 if ModelOk[emix] then
1409 begin
1410 if not Assigned(Tribe[DipMem[Me].pContact].ModelPicture
1411 [MyRO.EnemyModel[emix].mix].HGr) then
1412 InitEnemyModel(emix);
1413 Layers[laImprovements].AddLine(emix, 0, ModelSortValue(MyRO.EnemyModel[emix]));
1414 end;
1415 Layers[laImprovements].SortModels;
1416 // if not IsMilReportNew(DipMem[me].pContact) or (Layers[laImprovements].Lines > 1) then
1417 begin
1418 Layers[laImprovements].AddLine(mixAll);
1419 end;
1420 Layers[laImprovements].FirstShrinkedLine := 0;
1421 end;
1422 kEnemyModels:
1423 begin
1424 for I := 0 to MyRO.EnemyReport[PlayerView].nModelCounted - 1 do
1425 begin
1426 Model := MyRO.nEnemyModel - 1;
1427
1428 while (Model >= 0) and
1429 not ((MyRO.EnemyModel[Model].Owner = PlayerView) and
1430 (MyRO.EnemyModel[Model].mix = I)) do
1431 Dec(Model);
1432
1433 if not Assigned(Tribe[PlayerView].ModelPicture[I].HGr) then
1434 InitEnemyModel(Model);
1435
1436 Layers[laImprovements].AddLine(I, Model, ModelSortValue(MyRO.EnemyModel[Model]));
1437 end;
1438 Layers[laImprovements].SortModels;
1439 Layers[laImprovements].FirstShrinkedLine := 0;
1440 end;
1441 kAllEnemyModels:
1442 begin
1443 if (MyRO.TestFlags and tfUncover <> 0) or (G.Difficulty[Me] = 0) then
1444 Server(sGetModels, Me, 0, nil^);
1445 for emix := 0 to MyRO.nEnemyModel - 1 do
1446 if (MyRO.EnemyModel[emix].mix >= 3) and
1447 (MyRO.EnemyModel[emix].Kind in [mkSelfDeveloped, mkEnemyDeveloped])
1448 then
1449 begin
1450 PPicture := @Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture
1451 [MyRO.EnemyModel[emix].mix];
1452 if not Assigned(PPicture.HGr) then
1453 InitEnemyModel(emix);
1454 Ok := True;
1455 if MainScreen.mNames.Checked then
1456 for J := 0 to Layers[laImprovements].Lines.Count - 1 do
1457 begin
1458 Model := Layers[laImprovements].Lines[J].Code;
1459 PTestPicture := @Tribe[MyRO.EnemyModel[Model].Owner]
1460 .ModelPicture[MyRO.EnemyModel[Model].mix];
1461 if (PPicture.HGr = PTestPicture.HGr) and
1462 (PPicture.pix = PTestPicture.pix) and
1463 (ModelHash(MyRO.EnemyModel[emix])
1464 = ModelHash(MyRO.EnemyModel[Model])) then
1465 begin
1466 Layers[laImprovements].Lines[J].Model := 1;
1467 Ok := False;
1468 Break;
1469 end;
1470 end;
1471 if Ok then begin
1472 Layers[laImprovements].AddLine(emix, 0, ModelSortValue(MyRO.EnemyModel[emix], True));
1473 end;
1474 end;
1475 Layers[laImprovements].SortModels;
1476 Layers[laImprovements].FirstShrinkedLine := 0;
1477 end;
1478 kTribe:
1479 for I := 0 to TribeNames.Count - 1 do
1480 begin
1481 Layers[laImprovements].AddLine(I);
1482 end;
1483 (* kDeliver:
1484 if MyRO.Treaty[DipMem[Me].pContact] < trAlliance then
1485 begin // suggest next treaty level
1486 Layers[laImprovements].AddLine(opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1);
1487 end;
1488 if MyRO.Treaty[DipMem[Me].pContact] = trNone then
1489 begin // suggest peace
1490 Layers[laImprovements].AddLine(opTreaty + trPeace);
1491 end;
1492 if MyRO.Treaty[DipMem[Me].pContact] > trNone then
1493 begin // suggest next treaty level
1494 Layers[laImprovements].AddLine(opTreaty + MyRO.Treaty[DipMem[Me].pContact] - 1);
1495 end; *)
1496 kShipPart:
1497 begin
1498 Layers[laImprovements].Lines.Clear;
1499 for I := 0 to nShipPart - 1 do
1500 if MyRO.Ship[Me].Parts[I] > 0 then
1501 begin
1502 Layers[laImprovements].AddLine(I);
1503 end;
1504 end;
1505 kEnemyShipPart:
1506 begin
1507 Layers[laImprovements].Lines.Clear;
1508 for I := 0 to nShipPart - 1 do
1509 if MyRO.Ship[DipMem[Me].pContact].Parts[I] > 0 then
1510 begin
1511 Layers[laImprovements].AddLine(I);
1512 end;
1513 end;
1514 kGovernment:
1515 for I := 1 to nGov - 1 do
1516 if (GovPreq[I] <> preNA) and
1517 ((GovPreq[I] = preNone) or (MyRO.Tech[GovPreq[I]] >= tsApplicable))
1518 then
1519 begin
1520 Layers[laImprovements].AddLine(I);
1521 end;
1522 kMission:
1523 for I := 0 to nSpyMission - 1 do
1524 begin
1525 Layers[laImprovements].AddLine(I);
1526 end;
1527 end;
1528
1529 // Test if choice fitting to one screen
1530 if Kind = kProject then
1531 if Layers[laImprovements].Lines.Count + Layers[laWonders].Lines.Count + Layers[laClasses].Lines.Count <= MaxLines then
1532 begin
1533 // Add wonders to first page
1534 for I := 0 to Layers[laWonders].Lines.Count - 1 do
1535 Layers[laImprovements].AddLine(Layers[laWonders].Lines[I].Code, Layers[laWonders].Lines[I].Model, Layers[laWonders].Lines[I].ModelSortValue);
1536 Layers[laWonders].Lines.Clear;
1537
1538 Layers[laImprovements].FirstShrinkedLine := Layers[laImprovements].Lines.Count;
1539
1540 // Add models to first page
1541 for I := 0 to Layers[laClasses].Lines.Count - 1 do
1542 Layers[laImprovements].AddLine(Layers[laClasses].Lines[I].Code, Layers[laClasses].Lines[I].Model, Layers[laClasses].Lines[I].ModelSortValue);
1543 Layers[laClasses].Lines.Clear;
1544 end;
1545end;
1546
1547function TListDlg.OnlyChoice(TestKind: TListKind): Integer;
1548begin
1549 Kind := TestKind;
1550 InitLines;
1551 if Layers[laImprovements].Lines.Count = 0 then
1552 Result := -2
1553 else if Layers[laImprovements].Lines.Count > 1 then
1554 Result := -1
1555 else
1556 Result := Layers[laImprovements].Lines[0].Code;
1557end;
1558
1559procedure TListDlg.FormShow(Sender: TObject);
1560var
1561 L: TLayerIndex;
1562 NewTop, NewLeft: Integer;
1563begin
1564 Result := -1;
1565 Closable := False;
1566
1567 if Kind = kTribe then
1568 begin
1569 LineDistance := 21; // looks ugly with scrollbar
1570 MaxLines := (Maintexture.Height - (24 + TitleHeight + NarrowFrame))
1571 div LineDistance - 1;
1572 end
1573 else
1574 begin
1575 LineDistance := 24;
1576 MaxLines := (Maintexture.Height - (24 + TitleHeight + WideFrame))
1577 div LineDistance - 1;
1578 end;
1579 InitLines;
1580
1581 MultiPage := False;
1582 for L := laWonders to High(TLayerIndex) do
1583 if Layers[L].Lines.Count > 0 then begin
1584 MultiPage := True;
1585 Break;
1586 end;
1587
1588 WideBottom := MultiPage or (Kind = kScience) or
1589 not Phrases2FallenBackToEnglish and
1590 (Kind in [kProject, kAdvance, kFarAdvance]);
1591 if (Kind = kAdvance) and (MyData.FarTech <> adNone) or (Kind = kModels) or
1592 (Kind = kEnemyModels) then begin
1593 ScrollBar.SetBorderSpacing(56, 10, 10);
1594 TitleHeight := WideFrame + 20;
1595 end else begin
1596 ScrollBar.SetBorderSpacing(36, 10, 34);
1597 TitleHeight := WideFrame;
1598 end;
1599
1600 DispLines := Layers[laImprovements].Lines.Count;
1601 for L := Low(TLayerIndex) to High(TLayerIndex) do
1602 if Layers[L].Lines.Count > DispLines then
1603 DispLines := Layers[L].Lines.Count;
1604 if WideBottom then
1605 begin
1606 if DispLines > MaxLines then
1607 DispLines := MaxLines;
1608 InnerHeight := LineDistance * (DispLines + 1) + 24;
1609 Height := InnerHeight + TitleHeight + WideFrame;
1610 end
1611 else
1612 begin
1613 if DispLines > MaxLines then
1614 DispLines := MaxLines;
1615 InnerHeight := LineDistance * (DispLines + 1) + 24;
1616 Height := InnerHeight + TitleHeight + NarrowFrame;
1617 end;
1618 Assert(Height <= Maintexture.Height);
1619
1620 TechNameSpace := 224;
1621 case Kind of
1622 kGovernment:
1623 InnerWidth := 272;
1624 kCities, kCityEvents:
1625 InnerWidth := 640 - 18;
1626 kTribe:
1627 if Layers[laImprovements].Lines.Count > MaxLines then
1628 InnerWidth := 280 + GetSystemMetrics(SM_CXVSCROLL)
1629 else
1630 InnerWidth := 280;
1631 kScience:
1632 begin
1633 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 * nColumn +
1634 GetSystemMetrics(SM_CXVSCROLL);
1635 if InnerWidth + 2 * SideFrame > 640 then
1636 begin
1637 TechNameSpace := TechNameSpace + 640 - InnerWidth - 2 * SideFrame;
1638 InnerWidth := 640 - 2 * SideFrame
1639 end;
1640 end;
1641 kAdvance, kFarAdvance:
1642 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 +
1643 GetSystemMetrics(SM_CXVSCROLL);
1644 kChooseTech, kChooseEnemyTech, kStealTech:
1645 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace +
1646 GetSystemMetrics(SM_CXVSCROLL);
1647 else
1648 InnerWidth := 363;
1649 end;
1650 Width := InnerWidth + 2 * SideFrame;
1651
1652 CloseBtn.Left := Width - 38;
1653 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width;
1654 CaptionRight := CloseBtn.Left;
1655 SetWindowPos(ScrollBar.ScrollBar.Handle, 0, SideFrame + InnerWidth - GetSystemMetrics(SM_CXVSCROLL),
1656 TitleHeight, GetSystemMetrics(SM_CXVSCROLL), LineDistance * DispLines + 48,
1657 SWP_NOZORDER or SWP_NOREDRAW);
1658
1659 if WindowMode = wmModal then
1660 begin { center on screen }
1661 if Kind = kTribe then
1662 NewLeft := Screen.PrimaryMonitor.Left + (Screen.PrimaryMonitor.Width - 800) * 3 div 8 + 130
1663 else
1664 NewLeft := Screen.PrimaryMonitor.Left + (Screen.PrimaryMonitor.Width - Width) div 2;
1665 NewTop := Screen.PrimaryMonitor.Top + (Screen.PrimaryMonitor.Height - Height) div 2;
1666 if Kind = kProject then
1667 NewTop := NewTop + 48;
1668 BoundsRect := Bounds(NewLeft, NewTop, Width, Height);
1669 end;
1670
1671 LayerImprovementsButton.Visible := MultiPage and (Layers[laImprovements].Lines.Count > 0);
1672 LayerWondersButton.Visible := MultiPage and (Layers[laWonders].Lines.Count > 0);
1673 LayerClassesButton.Visible := MultiPage and (Layers[laClasses].Lines.Count > 0);
1674
1675 if Kind = kProject then
1676 begin
1677 LayerImprovementsButton.Top := Height - 31;
1678 LayerImprovementsButton.Left := Width div 2 - (12 + 29);
1679 LayerImprovementsButton.Down := True;
1680 LayerWondersButton.Top := Height - 31;
1681 LayerWondersButton.Left := Width div 2 - (12 - 29);
1682 LayerWondersButton.Down := False;
1683 LayerClassesButton.Top := Height - 31;
1684 LayerClassesButton.Left := Width div 2 - 12;
1685 LayerClassesButton.Down := False;
1686 end;
1687
1688 Layer := Layers[laImprovements];
1689 Selected := -2;
1690 ScienceNation := -1;
1691 ScrollBar.Init(Layer.Lines.Count - 1, DispLines);
1692
1693 OffscreenPaint;
1694end;
1695
1696procedure TListDlg.ShowNewContent(NewMode: TWindowMode; ListKind: TListKind);
1697var
1698 I: Integer;
1699 ShowFocus, ForceClose: Boolean;
1700begin
1701 ForceClose := (ListKind <> Kind) and
1702 not ((Kind = kCities) and (ListKind = kCityEvents)) and
1703 not ((Kind = kCityEvents) and (ListKind = kCities)) and
1704 not ((Kind = kModels) and (ListKind = kEnemyModels)) and
1705 not ((Kind = kEnemyModels) and (ListKind = kModels));
1706
1707 Kind := ListKind;
1708 ModalIndication := not (Kind in MustChooseKind);
1709 case Kind of
1710 kProject:
1711 Caption := Phrases.Lookup('TITLE_PROJECT');
1712 kAdvance:
1713 Caption := Phrases.Lookup('TITLE_TECHSELECT');
1714 kFarAdvance:
1715 Caption := Phrases.Lookup('TITLE_FARTECH');
1716 kModels, kEnemyModels:
1717 Caption := Phrases.Lookup('FRMILREP');
1718 kAllEnemyModels:
1719 Caption := Phrases.Lookup('TITLE_EMODELS');
1720 kTribe:
1721 Caption := Phrases.Lookup('TITLE_TRIBE');
1722 kScience:
1723 Caption := Phrases.Lookup('TITLE_SCIENCE');
1724 kShipPart, kEnemyShipPart:
1725 Caption := Phrases.Lookup('TITLE_CHOOSESHIPPART');
1726 kChooseTech, kChooseEnemyTech:
1727 Caption := Phrases.Lookup('TITLE_CHOOSETECH');
1728 kChooseModel, kChooseEnemyModel:
1729 Caption := Phrases.Lookup('TITLE_CHOOSEMODEL');
1730 kStealTech:
1731 Caption := Phrases.Lookup('TITLE_CHOOSETECH');
1732 kGovernment:
1733 Caption := Phrases.Lookup('TITLE_GOV');
1734 kMission:
1735 Caption := Phrases.Lookup('TITLE_SPYMISSION');
1736 end;
1737
1738 case Kind of
1739 kMission:
1740 HelpContext := 'SPYMISSIONS';
1741 else
1742 HelpContext := 'CONCEPTS'
1743 end;
1744
1745 if Kind = kAdvance then
1746 begin
1747 ToggleBtn.ButtonIndex := 13;
1748 ToggleBtn.Hint := Phrases.Lookup('FARTECH');
1749 end
1750 else if Kind = kCities then
1751 begin
1752 ToggleBtn.ButtonIndex := 15;
1753 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE');
1754 end
1755 else
1756 begin
1757 ToggleBtn.ButtonIndex := 28;
1758 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT');
1759 end;
1760
1761 if Kind = kAdvance then // show focus button?
1762 if MyData.FarTech <> adNone then
1763 ShowFocus := True
1764 else
1765 begin
1766 ShowFocus := False;
1767 for I := 0 to nAdv - 1 do
1768 if not (I in FutureTech) and (MyRO.Tech[I] < tsApplicable) and
1769 ((AdvValue[I] < 2000) or (MyRO.Tech[adMassProduction] > tsNA)) and
1770 ((AdvValue[I] < 1000) or (MyRO.Tech[adScience] > tsNA)) and
1771 (Server(sSetResearch - sExecute, Me, I, nil^) < rExecuted) then begin
1772 ShowFocus := True;
1773 Break;
1774 end;
1775 end;
1776 ToggleBtn.Visible := (Kind = kCities) and not Supervising or (Kind = kAdvance)
1777 and ShowFocus or (Kind = kModels) or (Kind = kEnemyModels);
1778 CloseBtn.Visible := not (Kind in MustChooseKind);
1779
1780 inherited ShowNewContent(NewMode, ForceClose);
1781end;
1782
1783procedure TListDlg.ShowNewContent_CityProject(NewMode: TWindowMode; cix: Integer);
1784begin
1785 cixProject := cix;
1786 ShowNewContent(NewMode, kProject);
1787end;
1788
1789procedure TListDlg.ShowNewContent_MilReport(NewMode: TWindowMode; Player: Integer);
1790begin
1791 PlayerView := Player;
1792 if Player = Me then
1793 ShowNewContent(NewMode, kModels)
1794 else
1795 ShowNewContent(NewMode, kEnemyModels);
1796end;
1797
1798procedure TListDlg.PlayerClick(Sender: TObject);
1799begin
1800 if TComponent(Sender).Tag = Me then
1801 Kind := kModels
1802 else
1803 begin
1804 Kind := kEnemyModels;
1805 PlayerView := TComponent(Sender).Tag;
1806 end;
1807 InitLines;
1808 Selected := -2;
1809 ScrollBar.Init(Layer.Lines.Count - 1, DispLines);
1810 OffscreenPaint;
1811 Invalidate;
1812end;
1813
1814procedure TListDlg.ModeBtnClick(Sender: TObject);
1815begin
1816 LayerImprovementsButton.Down := Sender = LayerImprovementsButton;
1817 LayerWondersButton.Down := Sender = LayerWondersButton;
1818 LayerClassesButton.Down := Sender = LayerClassesButton;
1819 Layer := Layers[TLayerIndex(TComponent(Sender).Tag)];
1820
1821 Selected := -2;
1822 ScrollBar.Init(Layer.Lines.Count - 1, DispLines);
1823 SmartUpdateContent;
1824end;
1825
1826procedure TListDlg.ToggleBtnClick(Sender: TObject);
1827var
1828 p1: Integer;
1829 M: TMenuItem;
1830begin
1831 case Kind of
1832 kAdvance:
1833 begin
1834 Result := adFar;
1835 Closable := True;
1836 Close;
1837 end;
1838 kCities, kCityEvents:
1839 begin
1840 if Kind = kCities then
1841 Kind := kCityEvents
1842 else
1843 Kind := kCities;
1844 OffscreenPaint;
1845 Invalidate;
1846 end;
1847 kModels, kEnemyModels:
1848 begin
1849 EmptyMenu(Popup.Items);
1850 if G.Difficulty[Me] > 0 then
1851 begin
1852 M := TMenuItem.Create(Popup);
1853 M.RadioItem := True;
1854 M.Caption := Tribe[Me].TPhrase('SHORTNAME');
1855 M.Tag := Me;
1856 M.OnClick := PlayerClick;
1857 if Kind = kModels then
1858 M.Checked := True;
1859 Popup.Items.Add(M);
1860 end;
1861 for p1 := 0 to nPl - 1 do
1862 if (p1 <> Me) and (MyRO.EnemyReport[p1] <> nil) and
1863 (MyRO.EnemyReport[p1].TurnOfMilReport >= 0) then
1864 begin
1865 M := TMenuItem.Create(Popup);
1866 M.RadioItem := True;
1867 M.Caption := Tribe[p1].TPhrase('SHORTNAME');
1868 M.Tag := p1;
1869 M.OnClick := PlayerClick;
1870 if (Kind = kEnemyModels) and (p1 = PlayerView) then
1871 M.Checked := True;
1872 Popup.Items.Add(M);
1873 end;
1874 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top +
1875 ToggleBtn.Height);
1876 end;
1877 end;
1878end;
1879
1880function TListDlg.GetSelectionIndex: Integer;
1881begin
1882 if Selected >= 0 then Result := ScrollBar.Position + Selected
1883 else Result := -1;
1884end;
1885
1886procedure TListDlg.SetSelectionIndex(Index: Integer);
1887var
1888 NewSelected: Integer;
1889 NewScrollBarPos: Integer;
1890 Over: Integer;
1891 Under: Integer;
1892begin
1893 if Index < 0 then Index := 0;
1894 if Index > Layer.Lines.Count - 1 then Index := Layer.Lines.Count - 1;
1895
1896 NewSelected := Index - ScrollBar.Position;
1897 NewScrollBarPos := ScrollBar.Position;
1898
1899 Over := NewSelected - Min(DispLines, Layer.Lines.Count - NewScrollBarPos);
1900 if Over > 0 then begin
1901 Inc(NewScrollBarPos, Over);
1902 Dec(NewSelected, Over);
1903 end;
1904
1905 Under := -NewSelected;
1906 if Under > 0 then begin
1907 Dec(NewScrollBarPos, Under);
1908 Inc(NewSelected, Under);
1909 end;
1910
1911 if (NewSelected <> Selected) or (NewScrollBarPos <> ScrollBar.Position) then begin
1912 if Selected >= 0 then PaintLine(Canvas, Selected, False, False);
1913
1914 ScrollBar.Position := NewScrollBarPos;
1915 Selected := NewSelected;
1916
1917 PaintLine(Canvas, Selected, False, True);
1918 end;
1919end;
1920
1921procedure TListDlg.DoOnResize;
1922begin
1923 inherited;
1924 CloseBtn.Left := Width - 38;
1925end;
1926
1927procedure TListDlg.FormKeyDown(Sender: TObject; var Key: Word;
1928 Shift: TShiftState);
1929var
1930 LastSelectionIndex: Integer;
1931begin
1932 if (Key = VK_RIGHT) or (Key = VK_NUMPAD6) then begin
1933 if MultiPage and (Layer.Index <= High(TLayerIndex)) then begin
1934 LastSelectionIndex := GetSelectionIndex;
1935
1936 if (Layer = Layers[laImprovements]) and (Layers[laClasses].Lines.Count > 0) then
1937 Layer := Layers[laClasses]
1938 else if (Layer = Layers[laClasses]) and (Layers[laWonders].Lines.Count > 0) then
1939 Layer := Layers[laWonders];
1940
1941 LayerImprovementsButton.Down := Layer = Layers[laImprovements];
1942 LayerWondersButton.Down := Layer = Layers[laWonders];
1943 LayerClassesButton.Down := Layer = Layers[laClasses];
1944 ScrollBar.Init(Layer.Lines.Count - 1, DispLines);
1945 Selected := -1;
1946 SetSelectionIndex(LastSelectionIndex);
1947 SmartUpdateContent;
1948 end;
1949 end else
1950 if (Key = VK_LEFT) or (Key = VK_NUMPAD4) then begin
1951 if MultiPage and (Layer.Index > laImprovements) then begin
1952 LastSelectionIndex := GetSelectionIndex;
1953
1954 if (Layer = Layers[laWonders]) and (Layers[laClasses].Lines.Count > 0) then
1955 Layer := Layers[laClasses]
1956 else if (Layer = Layers[laClasses]) and (Layers[laImprovements].Lines.Count > 0) then
1957 Layer := Layers[laImprovements];
1958
1959 LayerImprovementsButton.Down := Layer = Layers[laImprovements];
1960 LayerWondersButton.Down := Layer = Layers[laWonders];
1961 LayerClassesButton.Down := Layer = Layers[laClasses];
1962 ScrollBar.Init(Layer.Lines.Count - 1, DispLines);
1963 Selected := -1;
1964 SetSelectionIndex(LastSelectionIndex);
1965 SmartUpdateContent;
1966 end;
1967 end else
1968 if (Key = VK_UP) or (Key = VK_NUMPAD8) then begin
1969 SetSelectionIndex(GetSelectionIndex - 1);
1970 end else
1971 if (Key = VK_DOWN) or (Key = VK_NUMPAD2) then begin
1972 SetSelectionIndex(GetSelectionIndex + 1);
1973 end else
1974 if (Key = VK_HOME) or (Key = VK_NUMPAD7) then begin
1975 SetSelectionIndex(0);
1976 end else
1977 if (Key = VK_END) or (Key = VK_NUMPAD1) then begin
1978 SetSelectionIndex(Layer.Lines.Count);
1979 end else
1980 if (Key = VK_PRIOR) or (Key = VK_NUMPAD9) then begin
1981 SetSelectionIndex(GetSelectionIndex - ScrollBar.PageSize);
1982 end else
1983 if (Key = VK_NEXT) or (Key = VK_NUMPAD3) then begin
1984 SetSelectionIndex(GetSelectionIndex + ScrollBar.PageSize);
1985 end else
1986 if Key = VK_RETURN then begin
1987 PaintBox1MouseDown(Self, TMouseButton.mbLeft, [ssLeft], 0, 0);
1988 end else
1989 if (Key = VK_F2) and (Kind in [kModels, kEnemyModels]) then // my key
1990 // !!! toggle
1991 else if (Key = VK_F3) and (Kind in [kCities, kCityEvents]) then // my key
1992 ToggleBtnClick(nil)
1993 else if ((Key = VK_ESCAPE) or (Key = VK_RETURN)) and not CloseBtn.Visible then
1994 // prevent closing
1995 else
1996 inherited;
1997end;
1998
1999procedure TListDlg.EcoChange;
2000begin
2001 if Visible and (Kind = kCities) then
2002 SmartUpdateContent;
2003end;
2004
2005procedure TListDlg.TechChange;
2006begin
2007 if Visible and (Kind = kScience) then
2008 begin
2009 FormShow(nil);
2010 Invalidate;
2011 end;
2012end;
2013
2014procedure TListDlg.AddCity;
2015begin
2016 if Visible and (Kind = kCities) then
2017 begin
2018 FormShow(nil);
2019 Invalidate;
2020 end;
2021end;
2022
2023procedure TListDlg.RemoveUnit;
2024begin
2025 if Visible and (Kind = kModels) then
2026 SmartUpdateContent;
2027end;
2028
2029procedure TListDlg.ScrollBarUpdate(Sender: TObject);
2030begin
2031 Selected := -2;
2032 SmartUpdateContent(True);
2033end;
2034
2035end.
Note: See TracBrowser for help on using the repository browser.