source: trunk/LocalPlayer/Select.pas

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