source: tags/1.3.9/LocalPlayer/Nego.pas

Last change on this file was 725, checked in by chronos, 3 weeks ago
File size: 31.3 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(kChooseEnemyModel) <> 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;
717 InputDlg: TInputDlg;
718begin
719 if (Page <> History[Me].N) or (ClientMode = scDipCancelTreaty) or
720 (ClientMode = scDipBreak) then
721 Exit;
722 if Costs[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then
723 Price := $FFFFFFFF // toggle off
724 else
725 begin
726 if CurrentOffer.nCost >= 2 then
727 begin
728 SimpleMessage(Phrases.Lookup('MAX2WANTS'));
729 Exit;
730 end;
731 Price := ButtonPrice[TButtonN(Sender).Tag and $FF];
732 if not (Price shr 24 in OppoAllowed) then
733 Exit;
734 case Price of
735 opCivilReport, opMilReport:
736 Inc(Price, DipMem[Me].pContact shl 16 + MyRO.Turn);
737 // !!! choose player and year!
738 opMoney:
739 begin // choose amount
740 InputDlg := TInputDlg.Create(nil);
741 try
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 finally
753 InputDlg.Free;
754 end;
755 end;
756 opShipParts:
757 begin // choose type and number
758 if MyRO.NatBuilt[imSpacePort] = 0 then
759 with MainScreen.MessgExDlg do
760 begin
761 OpenSound := 'WARNING_LOWSUPPORT';
762 MessgText := Phrases.Lookup('NOSPACEPORT');
763 Kind := mkYesNo;
764 IconKind := mikImp;
765 IconIndex := imSpacePort;
766 ShowModal;
767 if ModalResult <> mrOK then
768 Exit;
769 end;
770 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kEnemyShipPart);
771 if MainScreen.ModalSelectDlg.Result < 0 then
772 Exit;
773 Inc(Price, MainScreen.ModalSelectDlg.Result shl 16);
774 Max := MyRO.Ship[DipMem[Me].pContact].Parts[MainScreen.ModalSelectDlg.Result];
775 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER');
776 InputDlg.EditInput.Text := '';
777 InputDlg.CenterToRect(BoundsRect);
778 InputDlg.ShowModal;
779 if InputDlg.ModalResult <> mrOK then
780 Exit;
781 Val(InputDlg.EditInput.Text, A, I);
782 if (I <> 0) or (A <= 0) then
783 Exit;
784 if A > Max then
785 A := Max;
786 if A > MaxShipPartPrice then
787 A := MaxShipPartPrice;
788 Inc(Price, A);
789 end;
790 opAllTech:
791 begin // choose technology
792 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseEnemyTech);
793 if MainScreen.ModalSelectDlg.Result < 0 then
794 Exit;
795 if MainScreen.ModalSelectDlg.Result = adAll then
796 Price := opAllTech
797 else
798 Price := OpTech + MainScreen.ModalSelectDlg.Result;
799 end;
800 opAllModel:
801 begin // choose model
802 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseEnemyModel);
803 if MainScreen.ModalSelectDlg.Result < 0 then
804 Exit;
805 if MainScreen.ModalSelectDlg.Result = mixAll then
806 Price := opAllModel
807 else
808 Price := OpModel + MyRO.EnemyModel[MainScreen.ModalSelectDlg.Result].mix;
809 end;
810 opTreaty:
811 begin
812 if MyRO.Treaty[DipMem[Me].pContact] < trPeace then
813 Price := opTreaty + trPeace
814 else
815 Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1;
816 end;
817 { opLowTreaty:
818 begin
819 if MyRO.Treaty[DipMem[Me].pContact]=trNone then Price:=opTreaty+trCeaseFire
820 else Price:=opTreaty+MyRO.Treaty[DipMem[Me].pContact]-1;
821 end }
822 end;
823 end;
824
825 Costs[TButtonN(Sender).Tag and $FF] := Price;
826 BuildCurrentOffer;
827 DipCommand := scDipOffer;
828 SetButtonStates;
829 SmartUpdateContent;
830end;
831
832procedure TNegoDlg.OfferClick(Sender: TObject);
833var
834 A, I, Max: Integer;
835 Price: Cardinal;
836 InputDlg: TInputDlg;
837begin
838 if (Page <> History[Me].N) or (ClientMode = scDipCancelTreaty) or
839 (ClientMode = scDipBreak) then
840 Exit;
841 if Delivers[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then
842 Price := $FFFFFFFF // toggle off
843 else
844 begin
845 if CurrentOffer.nDeliver >= 2 then
846 begin
847 SimpleMessage(Phrases.Lookup('MAX2OFFERS'));
848 Exit;
849 end;
850 Price := ButtonPrice[TButtonN(Sender).Tag and $FF];
851 if not (Price shr 24 in MyAllowed) then
852 Exit;
853 case Price of
854 opCivilReport, opMilReport:
855 Inc(Price, Me shl 16 + MyRO.Turn); // !!! choose player and year!
856 opMoney:
857 begin // choose amount
858 InputDlg := TInputDlg.Create(nil);
859 try
860 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT');
861 InputDlg.EditInput.Text := '';
862 InputDlg.CenterToRect(BoundsRect);
863 InputDlg.ShowModal;
864 if InputDlg.ModalResult <> mrOK then
865 Exit;
866 Val(InputDlg.EditInput.Text, A, I);
867 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then
868 Exit;
869 if (Price = opMoney) and (A > MyRO.Money) then
870 A := MyRO.Money;
871 Inc(Price, A);
872 finally
873 InputDlg.Free;
874 end;
875 end;
876 opShipParts:
877 begin // choose type and number
878 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kShipPart);
879 if MainScreen.ModalSelectDlg.Result < 0 then
880 Exit;
881 Inc(Price, MainScreen.ModalSelectDlg.Result shl 16);
882 Max := MyRO.Ship[Me].Parts[MainScreen.ModalSelectDlg.Result];
883 InputDlg := TInputDlg.Create(nil);
884 try
885 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER');
886 InputDlg.EditInput.Text := '';
887 InputDlg.CenterToRect(BoundsRect);
888 Gtk2Fix;
889 InputDlg.ShowModal;
890 if InputDlg.ModalResult <> mrOK then
891 Exit;
892 Val(InputDlg.EditInput.Text, A, I);
893 if (I <> 0) or (A <= 0) then
894 Exit;
895 if A > Max then
896 A := Max;
897 if A > MaxShipPartPrice then
898 A := MaxShipPartPrice;
899 Inc(Price, A);
900 finally
901 InputDlg.Free;
902 end;
903 end;
904 opAllTech:
905 begin // choose technology
906 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseTech);
907 if MainScreen.ModalSelectDlg.Result < 0 then
908 Exit;
909 if MainScreen.ModalSelectDlg.Result = adAll then
910 Price := opAllTech
911 else
912 Price := OpTech + MainScreen.ModalSelectDlg.Result;
913 end;
914 opAllModel:
915 begin // choose model
916 MainScreen.ModalSelectDlg.ShowNewContent(wmModal, kChooseModel);
917 if MainScreen.ModalSelectDlg.Result < 0 then
918 Exit;
919 if MainScreen.ModalSelectDlg.Result = mixAll then
920 Price := opAllModel
921 else
922 Price := OpModel + MainScreen.ModalSelectDlg.Result;
923 end;
924 opTreaty:
925 begin
926 if MyRO.Treaty[DipMem[Me].pContact] < trPeace then
927 Price := opTreaty + trPeace
928 else
929 Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact] + 1;
930 end;
931 { opLowTreaty:
932 begin
933 if MyRO.Treaty[DipMem[Me].pContact] = trNone then Price := opTreaty + trCeaseFire
934 else Price := opTreaty + MyRO.Treaty[DipMem[Me].pContact]- 1;
935 end }
936 end;
937 end;
938
939 Delivers[TButtonN(Sender).Tag and $FF] := Price;
940 BuildCurrentOffer;
941 DipCommand := scDipOffer;
942 SetButtonStates;
943 SmartUpdateContent;
944end;
945
946procedure TNegoDlg.FastBtnClick(Sender: TObject);
947var
948 NewCommand: Cardinal;
949begin
950 if Page <> History[Me].N then
951 Exit;
952 NewCommand := TButtonN(Sender).Tag and $FF + scDipStart;
953 if not (NewCommand - scDipStart in CommandAllowed) then
954 Exit;
955 if (NewCommand = scDipCancelTreaty) and
956 (MyRO.Turn < MyRO.LastCancelTreaty[DipMem[Me].pContact] + CancelTreatyTurns)
957 then
958 begin
959 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH'));
960 Exit;
961 end;
962 if (NewCommand = scDipOffer) and ((ClientMode = scDipCancelTreaty) or
963 (ClientMode = scDipBreak)) then
964 DipCommand := scDipNotice
965 else
966 DipCommand := NewCommand;
967 ResetCurrentOffer;
968 SetButtonStates;
969 SmartUpdateContent;
970end;
971
972end.
Note: See TracBrowser for help on using the repository browser.