source: branches/delphi/LocalPlayer/Nego.pas

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