source: tags/1.3.5/LocalPlayer/Nego.pas

Last change on this file was 592, checked in by chronos, 4 months ago
  • Fixed: Avoided more GTK2 chrashes.
  • Fixed: Build StdAI with O1 optimization level to avoid crash.
  • Modified: Code cleanup.
File size: 30.9 KB
Line 
1{$INCLUDE Switches.inc}
2unit Nego;
3
4interface
5
6uses
7 ScreenTools, BaseWin, Protocol, LCLType, SysUtils, Classes, ButtonA, ButtonB,
8 ButtonN,
9 {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, System.UITypes{$ELSE}
10 Graphics, Controls, Forms{$ENDIF};
11
12const
13 MaxHistory = 62;
14 scDipNoticeStart = scDipNotice - scDipStart;
15 scDipBreakStart = scDipBreak - scDipStart;
16
17type
18 THistory = record
19 N: Integer;
20 Text: array[0 .. MaxHistory - 1] of ansistring;
21 end;
22
23 TCommandAllowedEnum = scDipNoticeStart..scDipBreakStart;
24 TPriceSet = set of $00..$FF;
25
26 { TNegoDlg }
27
28 TNegoDlg = class(TBufferedDrawDlg)
29 OkBtn: TButtonA;
30 BwdBtn: TButtonB;
31 FwdBtn: TButtonB;
32 CloseBtn: TButtonB;
33 WantStateReportBtn: TButtonN;
34 WantMilReportBtn: TButtonN;
35 WantMapBtn: TButtonN;
36 WantTech2Btn: TButtonN;
37 WantTech1Btn: TButtonN;
38 WantModelBtn: TButtonN;
39 WantMoneyBtn: TButtonN;
40 WantShipPart2Btn: TButtonN;
41 WantHiTreatyBtn: TButtonN;
42 WantLoTreatyBtn: TButtonN;
43 WantShipPart1Btn: TButtonN;
44 WantAnythingBtn: TButtonN;
45 OfferStateReportBtn: TButtonN;
46 OfferMilReportBtn: TButtonN;
47 OfferMapBtn: TButtonN;
48 OfferTech2Btn: TButtonN;
49 OfferTech1Btn: TButtonN;
50 OfferModelBtn: TButtonN;
51 OfferMoneyBtn: TButtonN;
52 OfferShipPart2Btn: TButtonN;
53 OfferHiTreatyBtn: TButtonN;
54 OfferLoTreatyBtn: TButtonN;
55 OfferShipPart1Btn: TButtonN;
56 OfferAnythingBtn: TButtonN;
57 AcceptBtn: TButtonN;
58 PassBtn: TButtonN;
59 ExitBtn: TButtonN;
60 CancelTreatyBtn: TButtonN;
61 procedure FormCreate(Sender: TObject);
62 procedure FormDestroy(Sender: TObject);
63 procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
64 Shift: TShiftState; X, Y: Integer);
65 procedure OkBtnClick(Sender: TObject);
66 procedure BwdBtnClick(Sender: TObject);
67 procedure FwdBtnClick(Sender: TObject);
68 procedure CloseBtnClick(Sender: TObject);
69 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
70 procedure FormShow(Sender: TObject);
71 procedure WantClick(Sender: TObject);
72 procedure OfferClick(Sender: TObject);
73 procedure FastBtnClick(Sender: TObject);
74 public
75 procedure Initiate; // first turn of negotiation, initiate
76 procedure Respond; // first turn of negotiation, respond
77 procedure Start; // next turn of negotiation
78 procedure OffscreenPaint; override;
79 procedure ShowNewContent(NewMode: TWindowMode);
80 private
81 Page, DipCommand: Integer;
82 CurrentOffer: TOffer;
83 MyAllowed, OppoAllowed: TPriceSet;
84 CommandAllowed: set of TCommandAllowedEnum;
85 History: array [0 .. nPl - 1] of THistory;
86 RomanFont: TFont;
87 Costs, Delivers: array [0 .. 11] of Cardinal;
88 procedure ResetCurrentOffer;
89 procedure BuildCurrentOffer;
90 procedure FindAllowed;
91 procedure SplitText(Text: string; Bounds: TRect);
92 procedure PaintNationPicture(X, Y, P: Integer);
93 procedure SetButtonStates;
94 end;
95
96
97implementation
98
99uses
100 Messg, ClientTools, Diplomacy, Inp, Select, NatStat, Tribes, MessgEx, Term;
101
102{$R *.lfm}
103
104const
105 xPadC = 140;
106 yPadC = 427;
107 xPad0 = 140;
108 yPad0 = 13;
109 xPad1 = 334;
110 yPad1 = 13;
111 wIcon = 40;
112 hIcon = 40;
113 wText = 300;
114 hText = 256;
115 xText0 = 14;
116 yText0 = 154;
117 xText1 = 326;
118 yText1 = 154;
119 xNationPicture0 = 20;
120 xNationPicture1 = 556;
121 yNationPicture = 40;
122 yAttitude = 148;
123 xCred0 = 42;
124 yCred0 = 92;
125 xCred1 = 578;
126 yCred1 = 92;
127 PaperShade = 3;
128 PaperBorder_Left = 12;
129 PaperBorder_Right = 8;
130 ListIndent = 24;
131
132 opLowTreaty = $FE000000;
133
134 RomanNo: array [0 .. 15] of string = ('I', 'II', 'III', 'IV', 'V', 'VI',
135 'VII', 'VIII', 'IX', 'X', 'XI', 'XII', 'XIII', 'XIV', 'XV', 'XVI');
136
137 ButtonPrice: array [0 .. 11] of Cardinal = (opChoose, opCivilReport,
138 opMilReport, opMap, opAllTech, opAllTech, opAllModel, opMoney, opTreaty,
139 opLowTreaty, opShipParts, opShipParts);
140
141procedure TNegoDlg.FormCreate(Sender: TObject);
142var
143 cix: Integer;
144begin
145 InitButtons;
146 for cix := 0 to ComponentCount - 1 do
147 if Components[cix] is TButtonN then
148 with TButtonN(Components[cix]) do
149 begin
150 Graphic := HGrSystem.Data;
151 Mask := HGrSystem.Mask;
152 BackGraphic := HGrSystem2.Data;
153 case Tag shr 8 of
154 1: SmartHint := Phrases.Lookup('WANT', ButtonIndex - 6);
155 2: SmartHint := Phrases.Lookup('OFFER', ButtonIndex - 6);
156 end;
157 end;
158
159 FillChar(History, SizeOf(History), 0);
160 RomanFont := TFont.Create;
161 RomanFont.Name := 'Times New Roman';
162 RomanFont.Size := Round(144 * 72 / RomanFont.PixelsPerInch);
163 RomanFont.Color := Colors.Canvas.Pixels[clkMisc, cliPaper];
164 HelpContext := 'DIPLOMACY';
165 OkBtn.Caption := Phrases.Lookup('BTN_OK');
166 AcceptBtn.SmartHint := Phrases.Lookup('BTN_ACCEPT');
167 ExitBtn.SmartHint := Phrases.Lookup('BTN_BREAK');
168 CancelTreatyBtn.SmartHint := Phrases.Lookup('BTN_CNTREATY');
169end;
170
171procedure TNegoDlg.FormDestroy(Sender: TObject);
172begin
173 FreeAndNil(RomanFont);
174end;
175
176procedure TNegoDlg.FormShow(Sender: TObject);
177begin
178 OffscreenPaint;
179end;
180
181procedure TNegoDlg.ResetCurrentOffer;
182var
183 I: Integer;
184begin
185 CurrentOffer.nDeliver := 0;
186 CurrentOffer.nCost := 0;
187 for I := 0 to 11 do
188 Costs[I] := $FFFFFFFF;
189 for I := 0 to 11 do
190 Delivers[I] := $FFFFFFFF;
191end;
192
193procedure TNegoDlg.ShowNewContent(NewMode: TWindowMode);
194begin
195 inherited ShowNewContent(NewMode);
196 SetButtonStates;
197 if (ClientMode = scDipCancelTreaty) or (ClientMode = scDipBreak) then
198 PassBtn.SmartHint := Phrases.Lookup('BTN_NOTICE')
199 else
200 PassBtn.SmartHint := Phrases.Lookup('BTN_PASS');
201 case MyRO.Treaty[DipMem[Me].pContact] of
202 trNone:
203 begin
204 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTPEACE');
205 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERPEACE');
206 // WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTCEASEFIRE');
207 // OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERCEASEFIRE');
208 end;
209 { trCeasefire:
210 begin
211 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE');
212 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE');
213 end; }
214 trPeace:
215 begin
216 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTFRIENDLY');
217 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERFRIENDLY');
218 // WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDPEACE');
219 // OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDPEACE');
220 end;
221 trFriendlyContact:
222 begin
223 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTALLIANCE');
224 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERALLIANCE');
225 end;
226 { trAlliance:
227 begin
228 WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDALLIANCE');
229 OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDALLIANCE');
230 end; }
231 end;
232end;
233
234procedure TNegoDlg.Start;
235begin
236 if ClientMode <> scDipStart then
237 with History[Me] do
238 begin
239 if N = MaxHistory then
240 begin
241 Move(Text[2], Text[0], (MaxHistory - 2) * SizeOf(Integer));
242 Dec(N, 2);
243 end;
244 Text[N] := Copy(DipCommandToString(DipMem[Me].pContact, Me,
245 DipMem[Me].FormerTreaty, DipMem[Me].SentCommand, ClientMode,
246 DipMem[Me].SentOffer, ReceivedOffer), 1, 255);
247 Inc(N);
248 end;
249 Assert(History[Me].N mod 2 = 1);
250
251 Page := History[Me].N;
252 FindAllowed;
253 ResetCurrentOffer;
254
255 (* if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver=1)
256 and (ReceivedOffer.nCost=0) and (ReceivedOffer.Price[0] and opMask=opTreaty) then
257 begin // prepare to demand price for treaty
258 CurrentOffer.nDeliver:=1;
259 CurrentOffer.Price[0]:=ReceivedOffer.Price[0];
260 CurrentOffer.nCost:=0;
261 end
262 else
263 begin
264 if (ClientMode=scDipOffer) and (ReceivedOffer.nCost>0) then
265 begin
266 CurrentOffer.nDeliver:=1;
267 CurrentOffer.Price[0]:=ReceivedOffer.Price[ReceivedOffer.nDeliver]
268 end
269 else CurrentOffer.nDeliver:=0;
270 if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver>0) then
271 begin
272 CurrentOffer.nCost:=1;
273 CurrentOffer.Price[CurrentOffer.nDeliver]:=ReceivedOffer.Price[0]
274 end
275 else CurrentOffer.nCost:=0
276 end; *)
277 DipCommand := -1;
278 ShowNewContent(wmPersistent);
279end;
280
281procedure TNegoDlg.SplitText(Text: string; Bounds: TRect);
282var
283 nLines, Line, Start, Stop, OrdinaryStop, Indent, Y: Integer;
284 S: string;
285 preview, Dot: Boolean;
286begin
287 nLines := 0;
288 for preview := True downto False do
289 begin
290 Start := 1;
291 Line := 0;
292 Indent := 0;
293 while Start < Length(Text) do
294 begin
295 Dot := False;
296 if (Start = 1) or (Text[Start - 1] = '\') then
297 if Text[Start] = '-' then
298 begin
299 Indent := ListIndent;
300 Inc(Start);
301 if Start = Length(Text) then
302 Break;
303 Dot := True;
304 end
305 else
306 Indent := 0;
307 Stop := Start;
308 while (Stop < Length(Text)) and (Text[Stop] <> '\') do
309 begin
310 Inc(Stop);
311 if BiColorTextWidth(Offscreen.Canvas,
312 Copy(Text, Start, Stop - Start + 1)) > Bounds.Right - Bounds.Left -
313 PaperBorder_Left - PaperBorder_Right - Indent then
314 begin
315 Dec(Stop);
316 Break
317 end;
318 end;
319 if Stop <> Length(Text) then
320 begin
321 OrdinaryStop := Stop;
322 while (Text[OrdinaryStop + 1] <> ' ') and
323 (Text[OrdinaryStop + 1] <> '\') do
324 Dec(OrdinaryStop);
325 if (OrdinaryStop + 1 - Start) * 2 >= Stop - Start then
326 Stop := OrdinaryStop
327 end;
328 if not preview then
329 begin
330 Y := (Bounds.Top + Bounds.Bottom) div 2 - 10 * nLines + 20 * Line - 1;
331 if Dot then
332 Sprite(Offscreen, HGrSystem, Bounds.Left + PaperBorder_Left +
333 (ListIndent - 14), Y + 7, 8, 8, 90, 16);
334 S := Copy(Text, Start, Stop - Start + 1);
335 BiColorTextOut(Offscreen.Canvas, Colors.Canvas.Pixels[clkMisc,
336 cliPaperText], $7F007F, Bounds.Left + PaperBorder_Left +
337 Indent, Y, S);
338 end;
339 Inc(Line);
340 Start := Stop + 2;
341 end;
342 nLines := Line;
343 end
344end;
345
346procedure TNegoDlg.FindAllowed;
347var
348 I: Integer;
349begin
350 CommandAllowed := [scDipOffer - scDipStart];
351 if ClientMode <> scDipBreak then
352 Include(CommandAllowed, scDipBreak - scDipStart);
353 if MyRO.Treaty[DipMem[Me].pContact] >= trPeace then
354 Include(CommandAllowed, scDipCancelTreaty - scDipStart);
355 if (ClientMode = scDipOffer) and (Server(scDipAccept - sExecute, Me, 0, nil^)
356 >= rExecuted) then
357 Include(CommandAllowed, scDipAccept - scDipStart);
358
359 MyAllowed := [opChoose shr 24, opMoney shr 24];
360 OppoAllowed := [opChoose shr 24, opMoney shr 24];
361 if not IsCivilReportNew(DipMem[Me].pContact) then
362 begin // no up-to-date civil report
363 MyAllowed := MyAllowed + [opCivilReport shr 24];
364 for I := 0 to nAdv - 1 do
365 if MyRO.Tech[I] >= tsApplicable then
366 begin
367 MyAllowed := MyAllowed + [opAllTech shr 24];
368 Break;
369 end;
370 OppoAllowed := OppoAllowed + [opCivilReport shr 24, opAllTech shr 24];
371 end
372 else
373 begin // check techs
374 for I := 0 to nAdv - 1 do
375 if not (I in FutureTech) then
376 if (MyRO.Tech[I] < tsSeen) and
377 (MyRO.EnemyReport[DipMem[Me].pContact].Tech[I] >= tsApplicable) then
378 OppoAllowed := OppoAllowed + [opAllTech shr 24]
379 else if (MyRO.EnemyReport[DipMem[Me].pContact].Tech[I] < tsSeen) and
380 (MyRO.Tech[I] >= tsApplicable) then
381 MyAllowed := MyAllowed + [opAllTech shr 24];
382 end;
383 if not IsMilReportNew(DipMem[Me].pContact) then
384 begin // no up-to-date military report
385 MyAllowed := MyAllowed + [opMilReport shr 24];
386 if MyRO.nModel > 3 then
387 MyAllowed := MyAllowed + [opAllModel shr 24];
388 OppoAllowed := OppoAllowed + [opMilReport shr 24, opAllModel shr 24];
389 end
390 else
391 begin
392 if MainScreen.ModalSelectDlg.OnlyChoice(kChooseModel) <> mixAll then
393 MyAllowed := MyAllowed + [opAllModel shr 24];
394 if MainScreen.ModalSelectDlg.OnlyChoice(kChooseEModel) <> mixAll then
395 OppoAllowed := OppoAllowed + [opAllModel shr 24];
396 end;
397 if MyRO.Treaty[DipMem[Me].pContact] < trAlliance then
398 begin
399 MyAllowed := MyAllowed + [opTreaty shr 24, opMap shr 24];
400 OppoAllowed := OppoAllowed + [opTreaty shr 24, opMap shr 24];
401 end;
402 { if MyRO.Treaty[DipMem[me].pContact] in [trNone,trPeace,trAlliance] then
403 begin
404 MyAllowed:=MyAllowed+[opLowTreaty shr 24];
405 OppoAllowed:=OppoAllowed+[opLowTreaty shr 24];
406 end; }
407 for I := 0 to nShipPart - 1 do
408 begin
409 if MyRO.Ship[Me].Parts[I] > 0 then
410 Include(MyAllowed, opShipParts shr 24);
411 if MyRO.Ship[DipMem[Me].pContact].Parts[I] > 0 then
412 Include(OppoAllowed, opShipParts shr 24);
413 end;
414 MyAllowed := MyAllowed - DipMem[Me].DeliveredPrices *
415 [opAllTech shr 24, opAllModel shr 24, opCivilReport shr 24,
416 opMilReport shr 24, opMap shr 24];
417 OppoAllowed := OppoAllowed - DipMem[Me].ReceivedPrices *
418 [opAllTech shr 24, opAllModel shr 24, opCivilReport shr 24,
419 opMilReport shr 24, opMap shr 24];
420end;
421
422procedure TNegoDlg.PaintNationPicture(X, Y, P: Integer);
423begin
424 with Offscreen.Canvas do
425 begin
426 Pen.Color := $000000;
427 Brush.Color := Tribe[P].Color;
428 Rectangle(X - 6, Y - 1, X + 70, Y + 49);
429 Brush.Color := $000000;
430 Tribe[P].InitAge(GetAge(P));
431 if Assigned(Tribe[P].faceHGr) then
432 Dump(Offscreen, Tribe[P].faceHGr, X, Y, 64, 48,
433 1 + Tribe[P].facepix mod 10 * 65, 1 + Tribe[P].facepix div 10 * 49)
434 else
435 FillRect(Rect(X, Y, X + 64, Y + 48));
436 Brush.Style := TBrushStyle.bsClear;
437 ScreenTools.Frame(Offscreen.Canvas, X - 1, Y - 1, X + 64, Y + 48, $000000, $000000);
438 end
439end;
440
441procedure TNegoDlg.SetButtonStates;
442var
443 cix: Integer;
444 IsActionPage: Boolean;
445begin
446 IsActionPage := Page = History[Me].N;
447
448 AcceptBtn.Possible := IsActionPage and
449 (scDipAccept - scDipStart in CommandAllowed);
450 AcceptBtn.Lit := DipCommand = scDipAccept;
451 PassBtn.Possible := IsActionPage and
452 (scDipOffer - scDipStart in CommandAllowed);
453 PassBtn.Lit := (DipCommand = scDipNotice) or (DipCommand = scDipOffer) and
454 (CurrentOffer.nDeliver = 0) and (CurrentOffer.nCost = 0);
455 ExitBtn.Possible := IsActionPage and
456 (scDipBreak - scDipStart in CommandAllowed);
457 ExitBtn.Lit := DipCommand = scDipBreak;
458 CancelTreatyBtn.Possible := IsActionPage and
459 (scDipCancelTreaty - scDipStart in CommandAllowed);
460 CancelTreatyBtn.Lit := DipCommand = scDipCancelTreaty;
461
462 for cix := 0 to ComponentCount - 1 do
463 if Components[cix] is TButtonN then
464 with TButtonN(Components[cix]) do
465 case Tag shr 8 of
466 1: // Costs
467 begin
468 Possible := IsActionPage and
469 (ButtonPrice[Tag and $FF] shr 24 in OppoAllowed);
470 Lit := Costs[Tag and $FF] <> $FFFFFFFF;
471 end;
472 2: // Delivers
473 begin
474 Possible := IsActionPage and
475 (ButtonPrice[Tag and $FF] shr 24 in MyAllowed);
476 Lit := Delivers[Tag and $FF] <> $FFFFFFFF;
477 end;
478 end;
479end;
480
481procedure TNegoDlg.OffscreenPaint;
482var
483 I, Cred: Integer;
484 S: string;
485 OkEnabled: Boolean;
486begin
487 if (OffscreenUser <> nil) and (OffscreenUser <> Self) then
488 OffscreenUser.Update;
489 // complete working with old owner to prevent rebound
490 OffscreenUser := Self;
491
492 if (DipCommand >= 0) and (Page = History[Me].N) then
493 History[Me].Text[History[Me].N] :=
494 Copy(DipCommandToString(Me, DipMem[Me].pContact,
495 MyRO.Treaty[DipMem[Me].pContact], ClientMode, DipCommand, ReceivedOffer,
496 CurrentOffer), 1, 255);
497
498 FwdBtn.Visible := Page < History[Me].N;
499 BwdBtn.Visible := Page >= 2;
500 if Page < History[Me].N then
501 OkEnabled := False
502 else if DipCommand = scDipOffer then
503 OkEnabled := Server(scDipOffer - sExecute, Me, 0, CurrentOffer) >= rExecuted
504 else
505 OkEnabled := DipCommand >= 0;
506 OkBtn.Visible := OkEnabled;
507
508 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
509 (Maintexture.Width - ClientWidth) div 2, (Maintexture.Height - ClientHeight) div 2);
510 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
511 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
512 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
513 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
514 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
515 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
516 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
517 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
518 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
519
520 BtnFrame(Offscreen.Canvas, OkBtn.BoundsRect, MainTexture);
521 BtnFrame(Offscreen.Canvas, BwdBtn.BoundsRect, MainTexture);
522 BtnFrame(Offscreen.Canvas, FwdBtn.BoundsRect, MainTexture);
523 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
524
525 RFrame(Offscreen.Canvas, xPadC - 2, yPadC - 2, xPadC + 41 + 42 * 3,
526 yPadC + 41, $FFFFFF, $B0B0B0);
527 RFrame(Offscreen.Canvas, xPad0 - 2, yPad0 - 2, xPad0 + 41 + 42 * 3,
528 yPad0 + 41 + 42 * 2, $FFFFFF, $B0B0B0);
529 RFrame(Offscreen.Canvas, xPad1 - 2, yPad1 - 2, xPad1 + 41 + 42 * 3,
530 yPad1 + 41 + 42 * 2, $FFFFFF, $B0B0B0);
531
532 PaintNationPicture(xNationPicture0, yNationPicture, DipMem[Me].pContact);
533 PaintNationPicture(xNationPicture1, yNationPicture, Me);
534
535 if History[Me].Text[Page - 1] <> '' then
536 begin
537 FillSeamless(Offscreen.Canvas, xText0, yText0, wText, hText, 0, 0, Paper);
538 I := Page - 1;
539 if History[Me].Text[0] = '' then
540 Dec(I);
541 if I < 16 then
542 begin
543 Offscreen.Canvas.Font.Assign(RomanFont);
544 Offscreen.Canvas.TextOut
545 (xText0 + (wText - Offscreen.Canvas.TextWidth(RomanNo[I])) div 2,
546 yText0 + (hText - Offscreen.Canvas.TextHeight(RomanNo[I])) div 2,
547 RomanNo[I]);
548 end
549 end;
550 FillSeamless(Offscreen.Canvas, xText1, yText1, wText, hText, 0, 0, Paper);
551 I := Page;
552 if History[Me].Text[0] = '' then
553 Dec(I);
554 if I < 16 then
555 begin
556 Offscreen.Canvas.Font.Assign(RomanFont);
557 Offscreen.Canvas.TextOut
558 (xText1 + (wText - Offscreen.Canvas.TextWidth(RomanNo[I])) div 2,
559 yText1 + (hText - Offscreen.Canvas.TextHeight(RomanNo[I])) div 2,
560 RomanNo[I]);
561 end;
562 with Offscreen.Canvas do
563 begin
564 Brush.Color := MainTexture.ColorBevelShade;
565 if History[Me].Text[Page - 1] <> '' then
566 begin
567 FillRect(Rect(xText0 + wText, yText0 + PaperShade,
568 xText0 + wText + PaperShade, yText0 + hText + PaperShade));
569 FillRect(Rect(xText0 + PaperShade, yText0 + hText,
570 xText0 + wText + PaperShade, yText0 + hText + PaperShade));
571 end;
572 FillRect(Rect(xText1 + wText, yText1 + PaperShade,
573 xText1 + wText + PaperShade, yText1 + hText + PaperShade));
574 FillRect(Rect(xText1 + PaperShade, yText1 + hText,
575 xText1 + wText + PaperShade, yText1 + hText + PaperShade));
576 Brush.Style := TBrushStyle.bsClear;
577 end;
578
579 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
580
581 { if Page=History[me].n then
582 begin // show attitude
583 S:=Phrases.Lookup('ATTITUDE',MyRO.EnemyReport[DipMem[Me].pContact].Attitude);
584 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,
585 RisedTextOut(Offscreen.Canvas,xText0+wText div 2-
586 BiColorTextWidth(Offscreen.Canvas,S) div 2,yAttitude,S);
587 S:=Phrases.Lookup('ATTITUDE',MyRO.Attitude[DipMem[Me].pContact]);
588 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,
589 RisedTextOut(Offscreen.Canvas,xText1+wText div 2-
590 BiColorTextWidth(Offscreen.Canvas,S) div 2,yAttitude,S);
591 end; }
592
593 if History[Me].Text[Page - 1] <> '' then
594 SplitText(History[Me].Text[Page - 1], Rect(xText0, yText0, xText0 + wText,
595 yText0 + hText));
596 if (Page < History[Me].N) or OkEnabled then
597 SplitText(History[Me].Text[Page], Rect(xText1, yText1, xText1 + wText,
598 yText1 + hText));
599
600 // show credibility
601 Offscreen.Canvas.Font.Assign(UniFont[ftTiny]);
602 Cred := MyRO.EnemyReport[DipMem[Me].pContact].Credibility;
603 case Cred of
604 0 .. 49:
605 I := 3;
606 50 .. 90:
607 I := 0;
608 91 .. 100:
609 I := 1;
610 end;
611 PaintProgressBar(Offscreen.Canvas, I, xCred0, yCred0 + 17, (Cred + 2) div 5,
612 0, 20, MainTexture);
613 S := IntToStr(Cred);
614 RisedTextOut(Offscreen.Canvas, xCred0 + 10 -
615 (BiColorTextWidth(Offscreen.Canvas, S) + 1) div 2, yCred0, S);
616 case MyRO.Credibility of
617 0 .. 49:
618 I := 3;
619 50 .. 90:
620 I := 0;
621 91 .. 100:
622 I := 1;
623 end;
624 PaintProgressBar(Offscreen.Canvas, I, xCred1, yCred1 + 17,
625 (MyRO.Credibility + 2) div 5, 0, 20, MainTexture);
626 S := IntToStr(MyRO.Credibility);
627 RisedTextOut(Offscreen.Canvas, xCred1 + 10 -
628 (BiColorTextWidth(Offscreen.Canvas, S) + 1) div 2, yCred1, S);
629
630 MarkUsedOffscreen(ClientWidth, ClientHeight);
631end;
632
633procedure TNegoDlg.Initiate;
634begin
635 History[Me].N := 1;
636 History[Me].Text[0] := '';
637end;
638
639procedure TNegoDlg.Respond;
640begin
641 History[Me].N := 0;
642end;
643
644procedure TNegoDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
645 Shift: TShiftState; X, Y: Integer);
646begin
647 if (X >= xNationPicture0) and (X < xNationPicture0 + 64) and
648 (Y >= yNationPicture) and (Y < yNationPicture + 48) then
649 MainScreen.NatStatDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), DipMem[Me].pContact)
650 else if (X >= xNationPicture1) and (X < xNationPicture1 + 64) and
651 (Y >= yNationPicture) and (Y < yNationPicture + 48) then
652 MainScreen.NatStatDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), Me)
653end;
654
655procedure TNegoDlg.BwdBtnClick(Sender: TObject);
656begin
657 Dec(Page, 2);
658 SetButtonStates;
659 SmartUpdateContent;
660end;
661
662procedure TNegoDlg.FwdBtnClick(Sender: TObject);
663begin
664 Inc(Page, 2);
665 SetButtonStates;
666 SmartUpdateContent;
667end;
668
669procedure TNegoDlg.OkBtnClick(Sender: TObject);
670begin
671 Inc(History[Me].N);
672 if DipCommand = scDipOffer then
673 MainScreen.OfferCall(CurrentOffer)
674 else
675 MainScreen.DipCall(DipCommand);
676end;
677
678procedure TNegoDlg.CloseBtnClick(Sender: TObject);
679begin
680 Close;
681end;
682
683procedure TNegoDlg.FormKeyDown(Sender: TObject; var Key: Word;
684 Shift: TShiftState);
685begin
686 if Key = VK_RETURN then
687 begin
688 if OkBtn.Visible then
689 OkBtnClick(nil);
690 end
691 else
692 inherited;
693end;
694
695procedure TNegoDlg.BuildCurrentOffer;
696var
697 I: Integer;
698begin
699 CurrentOffer.nDeliver := 0;
700 CurrentOffer.nCost := 0;
701 for I := 0 to 11 do
702 if Delivers[I] <> $FFFFFFFF then
703 begin
704 CurrentOffer.Price[CurrentOffer.nDeliver] := Delivers[I];
705 Inc(CurrentOffer.nDeliver);
706 end;
707 for I := 0 to 11 do
708 if Costs[I] <> $FFFFFFFF then
709 begin
710 CurrentOffer.Price[CurrentOffer.nDeliver + CurrentOffer.nCost] :=
711 Costs[I];
712 Inc(CurrentOffer.nCost);
713 end;
714end;
715
716procedure TNegoDlg.WantClick(Sender: TObject);
717var
718 A, I, Max: Integer;
719 Price: Cardinal;
720begin
721 if (Page <> History[Me].N) or (ClientMode = scDipCancelTreaty) or
722 (ClientMode = scDipBreak) then
723 Exit;
724 if Costs[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then
725 Price := $FFFFFFFF // toggle off
726 else
727 begin
728 if CurrentOffer.nCost >= 2 then
729 begin
730 SimpleMessage(Phrases.Lookup('MAX2WANTS'));
731 Exit;
732 end;
733 Price := ButtonPrice[TButtonN(Sender).Tag and $FF];
734 if not (Price shr 24 in OppoAllowed) then
735 Exit;
736 case Price of
737 opCivilReport, opMilReport:
738 Inc(Price, DipMem[Me].pContact shl 16 + MyRO.Turn);
739 // !!! choose player and year!
740 opMoney:
741 begin // choose amount
742 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT');
743 InputDlg.EditInput.Text := '';
744 InputDlg.CenterToRect(BoundsRect);
745 InputDlg.ShowModal;
746 if InputDlg.ModalResult <> mrOK then
747 Exit;
748 Val(InputDlg.EditInput.Text, A, I);
749 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then
750 Exit;
751 Inc(Price, A);
752 end;
753 opShipParts:
754 begin // choose type and number
755 if MyRO.NatBuilt[imSpacePort] = 0 then
756 with MainScreen.MessgExDlg do
757 begin
758 OpenSound := 'WARNING_LOWSUPPORT';
759 MessgText := Phrases.Lookup('NOSPACEPORT');
760 Kind := mkYesNo;
761 IconKind := mikImp;
762 IconIndex := imSpacePort;
763 ShowModal;
764 if ModalResult <> mrOK then
765 Exit;
766 end;
767 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kEShipPart);
768 if MainScreen.ModalSelectDlg.Result < 0 then
769 Exit;
770 Inc(Price, MainScreen.ModalSelectDlg.Result shl 16);
771 Max := MyRO.Ship[DipMem[Me].pContact].Parts[MainScreen.ModalSelectDlg.Result];
772 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER');
773 InputDlg.EditInput.Text := '';
774 InputDlg.CenterToRect(BoundsRect);
775 InputDlg.ShowModal;
776 if InputDlg.ModalResult <> mrOK then
777 Exit;
778 Val(InputDlg.EditInput.Text, A, I);
779 if (I <> 0) or (A <= 0) then
780 Exit;
781 if A > Max then
782 A := Max;
783 if A > MaxShipPartPrice then
784 A := MaxShipPartPrice;
785 Inc(Price, A);
786 end;
787 opAllTech:
788 begin // choose technology
789 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseETech);
790 if MainScreen.ModalSelectDlg.Result < 0 then
791 Exit;
792 if MainScreen.ModalSelectDlg.Result = adAll then
793 Price := opAllTech
794 else
795 Price := OpTech + MainScreen.ModalSelectDlg.Result;
796 end;
797 opAllModel:
798 begin // choose model
799 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseEModel);
800 if MainScreen.ModalSelectDlg.Result < 0 then
801 Exit;
802 if MainScreen.ModalSelectDlg.Result = mixAll then
803 Price := opAllModel
804 else
805 Price := OpModel + MyRO.EnemyModel[MainScreen.ModalSelectDlg.Result].mix;
806 end;
807 opTreaty:
808 begin
809 if MyRO.Treaty[DipMem[Me].pContact] < trPeace then
810 Price := opTreaty + trPeace
811 else
812 Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1;
813 end;
814 { opLowTreaty:
815 begin
816 if MyRO.Treaty[DipMem[Me].pContact]=trNone then Price:=opTreaty+trCeaseFire
817 else Price:=opTreaty+MyRO.Treaty[DipMem[Me].pContact]-1;
818 end }
819 end;
820 end;
821
822 Costs[TButtonN(Sender).Tag and $FF] := Price;
823 BuildCurrentOffer;
824 DipCommand := scDipOffer;
825 SetButtonStates;
826 SmartUpdateContent;
827end;
828
829procedure TNegoDlg.OfferClick(Sender: TObject);
830var
831 A, I, Max: Integer;
832 Price: Cardinal;
833begin
834 if (Page <> History[Me].N) or (ClientMode = scDipCancelTreaty) or
835 (ClientMode = scDipBreak) then
836 Exit;
837 if Delivers[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then
838 Price := $FFFFFFFF // toggle off
839 else
840 begin
841 if CurrentOffer.nDeliver >= 2 then
842 begin
843 SimpleMessage(Phrases.Lookup('MAX2OFFERS'));
844 Exit;
845 end;
846 Price := ButtonPrice[TButtonN(Sender).Tag and $FF];
847 if not (Price shr 24 in MyAllowed) then
848 Exit;
849 case Price of
850 opCivilReport, opMilReport:
851 Inc(Price, Me shl 16 + MyRO.Turn); // !!! choose player and year!
852 opMoney:
853 begin // choose amount
854 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT');
855 InputDlg.EditInput.Text := '';
856 InputDlg.CenterToRect(BoundsRect);
857 InputDlg.ShowModal;
858 if InputDlg.ModalResult <> mrOK then
859 Exit;
860 Val(InputDlg.EditInput.Text, A, I);
861 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then
862 Exit;
863 if (Price = opMoney) and (A > MyRO.Money) then
864 A := MyRO.Money;
865 Inc(Price, A);
866 end;
867 opShipParts:
868 begin // choose type and number
869 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kShipPart);
870 if MainScreen.ModalSelectDlg.Result < 0 then
871 Exit;
872 Inc(Price, MainScreen.ModalSelectDlg.Result shl 16);
873 Max := MyRO.Ship[Me].Parts[MainScreen.ModalSelectDlg.Result];
874 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER');
875 InputDlg.EditInput.Text := '';
876 InputDlg.CenterToRect(BoundsRect);
877 Gtk2Fix;
878 InputDlg.ShowModal;
879 if InputDlg.ModalResult <> mrOK then
880 Exit;
881 Val(InputDlg.EditInput.Text, A, I);
882 if (I <> 0) or (A <= 0) then
883 Exit;
884 if A > Max then
885 A := Max;
886 if A > MaxShipPartPrice then
887 A := MaxShipPartPrice;
888 Inc(Price, A);
889 end;
890 opAllTech:
891 begin // choose technology
892 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseTech);
893 if MainScreen.ModalSelectDlg.Result < 0 then
894 Exit;
895 if MainScreen.ModalSelectDlg.Result = adAll then
896 Price := opAllTech
897 else
898 Price := OpTech + MainScreen.ModalSelectDlg.Result;
899 end;
900 opAllModel:
901 begin // choose model
902 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseModel);
903 if MainScreen.ModalSelectDlg.Result < 0 then
904 Exit;
905 if MainScreen.ModalSelectDlg.Result = mixAll then
906 Price := opAllModel
907 else
908 Price := OpModel + MainScreen.ModalSelectDlg.Result;
909 end;
910 opTreaty:
911 begin
912 if MyRO.Treaty[DipMem[Me].pContact] < trPeace then
913 Price := opTreaty + trPeace
914 else
915 Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1;
916 end;
917 { opLowTreaty:
918 begin
919 if MyRO.Treaty[DipMem[Me].pContact]=trNone then Price:=opTreaty+trCeaseFire
920 else Price:=opTreaty+MyRO.Treaty[DipMem[Me].pContact]-1;
921 end }
922 end;
923 end;
924
925 Delivers[TButtonN(Sender).Tag and $FF] := Price;
926 BuildCurrentOffer;
927 DipCommand := scDipOffer;
928 SetButtonStates;
929 SmartUpdateContent;
930end;
931
932procedure TNegoDlg.FastBtnClick(Sender: TObject);
933var
934 NewCommand: Cardinal;
935begin
936 if Page <> History[Me].N then
937 Exit;
938 NewCommand := TButtonN(Sender).Tag and $FF + scDipStart;
939 if not (NewCommand - scDipStart in CommandAllowed) then
940 Exit;
941 if (NewCommand = scDipCancelTreaty) and
942 (MyRO.Turn < MyRO.LastCancelTreaty[DipMem[Me].pContact] + CancelTreatyTurns)
943 then
944 begin
945 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH'));
946 Exit;
947 end;
948 if (NewCommand = scDipOffer) and ((ClientMode = scDipCancelTreaty) or
949 (ClientMode = scDipBreak)) then
950 DipCommand := scDipNotice
951 else
952 DipCommand := NewCommand;
953 ResetCurrentOffer;
954 SetButtonStates;
955 SmartUpdateContent;
956end;
957
958end.
Note: See TracBrowser for help on using the repository browser.