source: tags/1.3.6/LocalPlayer/Nego.pas

Last change on this file was 622, checked in by chronos, 2 months ago
  • Modified: Show windows by default on primary screen if multiple monitors present.
File size: 30.8 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 inherited;
488
489 if (DipCommand >= 0) and (Page = History[Me].N) then
490 History[Me].Text[History[Me].N] :=
491 Copy(DipCommandToString(Me, DipMem[Me].pContact,
492 MyRO.Treaty[DipMem[Me].pContact], ClientMode, DipCommand, ReceivedOffer,
493 CurrentOffer), 1, 255);
494
495 FwdBtn.Visible := Page < History[Me].N;
496 BwdBtn.Visible := Page >= 2;
497 if Page < History[Me].N then
498 OkEnabled := False
499 else if DipCommand = scDipOffer then
500 OkEnabled := Server(scDipOffer - sExecute, Me, 0, CurrentOffer) >= rExecuted
501 else
502 OkEnabled := DipCommand >= 0;
503 OkBtn.Visible := OkEnabled;
504
505 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6,
506 (Maintexture.Width - ClientWidth) div 2, (Maintexture.Height - ClientHeight) div 2);
507 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
508 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
509 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
510 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3,
511 MainTexture.ColorBevelLight, MainTexture.ColorBevelShade);
512 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture);
513 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture);
514 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture);
515 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture);
516
517 BtnFrame(Offscreen.Canvas, OkBtn.BoundsRect, MainTexture);
518 BtnFrame(Offscreen.Canvas, BwdBtn.BoundsRect, MainTexture);
519 BtnFrame(Offscreen.Canvas, FwdBtn.BoundsRect, MainTexture);
520 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture);
521
522 RFrame(Offscreen.Canvas, xPadC - 2, yPadC - 2, xPadC + 41 + 42 * 3,
523 yPadC + 41, $FFFFFF, $B0B0B0);
524 RFrame(Offscreen.Canvas, xPad0 - 2, yPad0 - 2, xPad0 + 41 + 42 * 3,
525 yPad0 + 41 + 42 * 2, $FFFFFF, $B0B0B0);
526 RFrame(Offscreen.Canvas, xPad1 - 2, yPad1 - 2, xPad1 + 41 + 42 * 3,
527 yPad1 + 41 + 42 * 2, $FFFFFF, $B0B0B0);
528
529 PaintNationPicture(xNationPicture0, yNationPicture, DipMem[Me].pContact);
530 PaintNationPicture(xNationPicture1, yNationPicture, Me);
531
532 if History[Me].Text[Page - 1] <> '' then
533 begin
534 FillSeamless(Offscreen.Canvas, xText0, yText0, wText, hText, 0, 0, Paper);
535 I := Page - 1;
536 if History[Me].Text[0] = '' then
537 Dec(I);
538 if I < 16 then
539 begin
540 Offscreen.Canvas.Font.Assign(RomanFont);
541 Offscreen.Canvas.TextOut
542 (xText0 + (wText - Offscreen.Canvas.TextWidth(RomanNo[I])) div 2,
543 yText0 + (hText - Offscreen.Canvas.TextHeight(RomanNo[I])) div 2,
544 RomanNo[I]);
545 end
546 end;
547 FillSeamless(Offscreen.Canvas, xText1, yText1, wText, hText, 0, 0, Paper);
548 I := Page;
549 if History[Me].Text[0] = '' then
550 Dec(I);
551 if I < 16 then
552 begin
553 Offscreen.Canvas.Font.Assign(RomanFont);
554 Offscreen.Canvas.TextOut
555 (xText1 + (wText - Offscreen.Canvas.TextWidth(RomanNo[I])) div 2,
556 yText1 + (hText - Offscreen.Canvas.TextHeight(RomanNo[I])) div 2,
557 RomanNo[I]);
558 end;
559 with Offscreen.Canvas do
560 begin
561 Brush.Color := MainTexture.ColorBevelShade;
562 if History[Me].Text[Page - 1] <> '' then
563 begin
564 FillRect(Rect(xText0 + wText, yText0 + PaperShade,
565 xText0 + wText + PaperShade, yText0 + hText + PaperShade));
566 FillRect(Rect(xText0 + PaperShade, yText0 + hText,
567 xText0 + wText + PaperShade, yText0 + hText + PaperShade));
568 end;
569 FillRect(Rect(xText1 + wText, yText1 + PaperShade,
570 xText1 + wText + PaperShade, yText1 + hText + PaperShade));
571 FillRect(Rect(xText1 + PaperShade, yText1 + hText,
572 xText1 + wText + PaperShade, yText1 + hText + PaperShade));
573 Brush.Style := TBrushStyle.bsClear;
574 end;
575
576 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);
577
578 { if Page=History[me].n then
579 begin // show attitude
580 S:=Phrases.Lookup('ATTITUDE',MyRO.EnemyReport[DipMem[Me].pContact].Attitude);
581 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,
582 RisedTextOut(Offscreen.Canvas,xText0+wText div 2-
583 BiColorTextWidth(Offscreen.Canvas,S) div 2,yAttitude,S);
584 S:=Phrases.Lookup('ATTITUDE',MyRO.Attitude[DipMem[Me].pContact]);
585 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,
586 RisedTextOut(Offscreen.Canvas,xText1+wText div 2-
587 BiColorTextWidth(Offscreen.Canvas,S) div 2,yAttitude,S);
588 end; }
589
590 if History[Me].Text[Page - 1] <> '' then
591 SplitText(History[Me].Text[Page - 1], Rect(xText0, yText0, xText0 + wText,
592 yText0 + hText));
593 if (Page < History[Me].N) or OkEnabled then
594 SplitText(History[Me].Text[Page], Rect(xText1, yText1, xText1 + wText,
595 yText1 + hText));
596
597 // show credibility
598 Offscreen.Canvas.Font.Assign(UniFont[ftTiny]);
599 Cred := MyRO.EnemyReport[DipMem[Me].pContact].Credibility;
600 case Cred of
601 0 .. 49:
602 I := 3;
603 50 .. 90:
604 I := 0;
605 91 .. 100:
606 I := 1;
607 end;
608 PaintProgressBar(Offscreen.Canvas, I, xCred0, yCred0 + 17, (Cred + 2) div 5,
609 0, 20, MainTexture);
610 S := IntToStr(Cred);
611 RisedTextOut(Offscreen.Canvas, xCred0 + 10 -
612 (BiColorTextWidth(Offscreen.Canvas, S) + 1) div 2, yCred0, S);
613 case MyRO.Credibility of
614 0 .. 49:
615 I := 3;
616 50 .. 90:
617 I := 0;
618 91 .. 100:
619 I := 1;
620 end;
621 PaintProgressBar(Offscreen.Canvas, I, xCred1, yCred1 + 17,
622 (MyRO.Credibility + 2) div 5, 0, 20, MainTexture);
623 S := IntToStr(MyRO.Credibility);
624 RisedTextOut(Offscreen.Canvas, xCred1 + 10 -
625 (BiColorTextWidth(Offscreen.Canvas, S) + 1) div 2, yCred1, S);
626
627 MarkUsedOffscreen(ClientWidth, ClientHeight);
628end;
629
630procedure TNegoDlg.Initiate;
631begin
632 History[Me].N := 1;
633 History[Me].Text[0] := '';
634end;
635
636procedure TNegoDlg.Respond;
637begin
638 History[Me].N := 0;
639end;
640
641procedure TNegoDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
642 Shift: TShiftState; X, Y: Integer);
643begin
644 if (X >= xNationPicture0) and (X < xNationPicture0 + 64) and
645 (Y >= yNationPicture) and (Y < yNationPicture + 48) then
646 MainScreen.NatStatDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), DipMem[Me].pContact)
647 else if (X >= xNationPicture1) and (X < xNationPicture1 + 64) and
648 (Y >= yNationPicture) and (Y < yNationPicture + 48) then
649 MainScreen.NatStatDlg.ShowNewContent(WindowModeMakePersistent(FWindowMode), Me)
650end;
651
652procedure TNegoDlg.BwdBtnClick(Sender: TObject);
653begin
654 Dec(Page, 2);
655 SetButtonStates;
656 SmartUpdateContent;
657end;
658
659procedure TNegoDlg.FwdBtnClick(Sender: TObject);
660begin
661 Inc(Page, 2);
662 SetButtonStates;
663 SmartUpdateContent;
664end;
665
666procedure TNegoDlg.OkBtnClick(Sender: TObject);
667begin
668 Inc(History[Me].N);
669 if DipCommand = scDipOffer then
670 MainScreen.OfferCall(CurrentOffer)
671 else
672 MainScreen.DipCall(DipCommand);
673end;
674
675procedure TNegoDlg.CloseBtnClick(Sender: TObject);
676begin
677 Close;
678end;
679
680procedure TNegoDlg.FormKeyDown(Sender: TObject; var Key: Word;
681 Shift: TShiftState);
682begin
683 if Key = VK_RETURN then
684 begin
685 if OkBtn.Visible then
686 OkBtnClick(nil);
687 end
688 else
689 inherited;
690end;
691
692procedure TNegoDlg.BuildCurrentOffer;
693var
694 I: Integer;
695begin
696 CurrentOffer.nDeliver := 0;
697 CurrentOffer.nCost := 0;
698 for I := 0 to 11 do
699 if Delivers[I] <> $FFFFFFFF then
700 begin
701 CurrentOffer.Price[CurrentOffer.nDeliver] := Delivers[I];
702 Inc(CurrentOffer.nDeliver);
703 end;
704 for I := 0 to 11 do
705 if Costs[I] <> $FFFFFFFF then
706 begin
707 CurrentOffer.Price[CurrentOffer.nDeliver + CurrentOffer.nCost] :=
708 Costs[I];
709 Inc(CurrentOffer.nCost);
710 end;
711end;
712
713procedure TNegoDlg.WantClick(Sender: TObject);
714var
715 A, I, Max: Integer;
716 Price: Cardinal;
717begin
718 if (Page <> History[Me].N) or (ClientMode = scDipCancelTreaty) or
719 (ClientMode = scDipBreak) then
720 Exit;
721 if Costs[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then
722 Price := $FFFFFFFF // toggle off
723 else
724 begin
725 if CurrentOffer.nCost >= 2 then
726 begin
727 SimpleMessage(Phrases.Lookup('MAX2WANTS'));
728 Exit;
729 end;
730 Price := ButtonPrice[TButtonN(Sender).Tag and $FF];
731 if not (Price shr 24 in OppoAllowed) then
732 Exit;
733 case Price of
734 opCivilReport, opMilReport:
735 Inc(Price, DipMem[Me].pContact shl 16 + MyRO.Turn);
736 // !!! choose player and year!
737 opMoney:
738 begin // choose amount
739 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT');
740 InputDlg.EditInput.Text := '';
741 InputDlg.CenterToRect(BoundsRect);
742 InputDlg.ShowModal;
743 if InputDlg.ModalResult <> mrOK then
744 Exit;
745 Val(InputDlg.EditInput.Text, A, I);
746 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then
747 Exit;
748 Inc(Price, A);
749 end;
750 opShipParts:
751 begin // choose type and number
752 if MyRO.NatBuilt[imSpacePort] = 0 then
753 with MainScreen.MessgExDlg do
754 begin
755 OpenSound := 'WARNING_LOWSUPPORT';
756 MessgText := Phrases.Lookup('NOSPACEPORT');
757 Kind := mkYesNo;
758 IconKind := mikImp;
759 IconIndex := imSpacePort;
760 ShowModal;
761 if ModalResult <> mrOK then
762 Exit;
763 end;
764 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kEShipPart);
765 if MainScreen.ModalSelectDlg.Result < 0 then
766 Exit;
767 Inc(Price, MainScreen.ModalSelectDlg.Result shl 16);
768 Max := MyRO.Ship[DipMem[Me].pContact].Parts[MainScreen.ModalSelectDlg.Result];
769 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER');
770 InputDlg.EditInput.Text := '';
771 InputDlg.CenterToRect(BoundsRect);
772 InputDlg.ShowModal;
773 if InputDlg.ModalResult <> mrOK then
774 Exit;
775 Val(InputDlg.EditInput.Text, A, I);
776 if (I <> 0) or (A <= 0) then
777 Exit;
778 if A > Max then
779 A := Max;
780 if A > MaxShipPartPrice then
781 A := MaxShipPartPrice;
782 Inc(Price, A);
783 end;
784 opAllTech:
785 begin // choose technology
786 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseETech);
787 if MainScreen.ModalSelectDlg.Result < 0 then
788 Exit;
789 if MainScreen.ModalSelectDlg.Result = adAll then
790 Price := opAllTech
791 else
792 Price := OpTech + MainScreen.ModalSelectDlg.Result;
793 end;
794 opAllModel:
795 begin // choose model
796 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseEModel);
797 if MainScreen.ModalSelectDlg.Result < 0 then
798 Exit;
799 if MainScreen.ModalSelectDlg.Result = mixAll then
800 Price := opAllModel
801 else
802 Price := OpModel + MyRO.EnemyModel[MainScreen.ModalSelectDlg.Result].mix;
803 end;
804 opTreaty:
805 begin
806 if MyRO.Treaty[DipMem[Me].pContact] < trPeace then
807 Price := opTreaty + trPeace
808 else
809 Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1;
810 end;
811 { opLowTreaty:
812 begin
813 if MyRO.Treaty[DipMem[Me].pContact]=trNone then Price:=opTreaty+trCeaseFire
814 else Price:=opTreaty+MyRO.Treaty[DipMem[Me].pContact]-1;
815 end }
816 end;
817 end;
818
819 Costs[TButtonN(Sender).Tag and $FF] := Price;
820 BuildCurrentOffer;
821 DipCommand := scDipOffer;
822 SetButtonStates;
823 SmartUpdateContent;
824end;
825
826procedure TNegoDlg.OfferClick(Sender: TObject);
827var
828 A, I, Max: Integer;
829 Price: Cardinal;
830begin
831 if (Page <> History[Me].N) or (ClientMode = scDipCancelTreaty) or
832 (ClientMode = scDipBreak) then
833 Exit;
834 if Delivers[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then
835 Price := $FFFFFFFF // toggle off
836 else
837 begin
838 if CurrentOffer.nDeliver >= 2 then
839 begin
840 SimpleMessage(Phrases.Lookup('MAX2OFFERS'));
841 Exit;
842 end;
843 Price := ButtonPrice[TButtonN(Sender).Tag and $FF];
844 if not (Price shr 24 in MyAllowed) then
845 Exit;
846 case Price of
847 opCivilReport, opMilReport:
848 Inc(Price, Me shl 16 + MyRO.Turn); // !!! choose player and year!
849 opMoney:
850 begin // choose amount
851 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT');
852 InputDlg.EditInput.Text := '';
853 InputDlg.CenterToRect(BoundsRect);
854 InputDlg.ShowModal;
855 if InputDlg.ModalResult <> mrOK then
856 Exit;
857 Val(InputDlg.EditInput.Text, A, I);
858 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then
859 Exit;
860 if (Price = opMoney) and (A > MyRO.Money) then
861 A := MyRO.Money;
862 Inc(Price, A);
863 end;
864 opShipParts:
865 begin // choose type and number
866 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kShipPart);
867 if MainScreen.ModalSelectDlg.Result < 0 then
868 Exit;
869 Inc(Price, MainScreen.ModalSelectDlg.Result shl 16);
870 Max := MyRO.Ship[Me].Parts[MainScreen.ModalSelectDlg.Result];
871 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER');
872 InputDlg.EditInput.Text := '';
873 InputDlg.CenterToRect(BoundsRect);
874 Gtk2Fix;
875 InputDlg.ShowModal;
876 if InputDlg.ModalResult <> mrOK then
877 Exit;
878 Val(InputDlg.EditInput.Text, A, I);
879 if (I <> 0) or (A <= 0) then
880 Exit;
881 if A > Max then
882 A := Max;
883 if A > MaxShipPartPrice then
884 A := MaxShipPartPrice;
885 Inc(Price, A);
886 end;
887 opAllTech:
888 begin // choose technology
889 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseTech);
890 if MainScreen.ModalSelectDlg.Result < 0 then
891 Exit;
892 if MainScreen.ModalSelectDlg.Result = adAll then
893 Price := opAllTech
894 else
895 Price := OpTech + MainScreen.ModalSelectDlg.Result;
896 end;
897 opAllModel:
898 begin // choose model
899 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseModel);
900 if MainScreen.ModalSelectDlg.Result < 0 then
901 Exit;
902 if MainScreen.ModalSelectDlg.Result = mixAll then
903 Price := opAllModel
904 else
905 Price := OpModel + MainScreen.ModalSelectDlg.Result;
906 end;
907 opTreaty:
908 begin
909 if MyRO.Treaty[DipMem[Me].pContact] < trPeace then
910 Price := opTreaty + trPeace
911 else
912 Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1;
913 end;
914 { opLowTreaty:
915 begin
916 if MyRO.Treaty[DipMem[Me].pContact] = trNone then Price := opTreaty + trCeaseFire
917 else Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact]- 1;
918 end }
919 end;
920 end;
921
922 Delivers[TButtonN(Sender).Tag and $FF] := Price;
923 BuildCurrentOffer;
924 DipCommand := scDipOffer;
925 SetButtonStates;
926 SmartUpdateContent;
927end;
928
929procedure TNegoDlg.FastBtnClick(Sender: TObject);
930var
931 NewCommand: Cardinal;
932begin
933 if Page <> History[Me].N then
934 Exit;
935 NewCommand := TButtonN(Sender).Tag and $FF + scDipStart;
936 if not (NewCommand - scDipStart in CommandAllowed) then
937 Exit;
938 if (NewCommand = scDipCancelTreaty) and
939 (MyRO.Turn < MyRO.LastCancelTreaty[DipMem[Me].pContact] + CancelTreatyTurns)
940 then
941 begin
942 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH'));
943 Exit;
944 end;
945 if (NewCommand = scDipOffer) and ((ClientMode = scDipCancelTreaty) or
946 (ClientMode = scDipBreak)) then
947 DipCommand := scDipNotice
948 else
949 DipCommand := NewCommand;
950 ResetCurrentOffer;
951 SetButtonStates;
952 SmartUpdateContent;
953end;
954
955end.
Note: See TracBrowser for help on using the repository browser.