source: tags/1.3.1/LocalPlayer/Nego.pas

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