source: tags/1.2.0/LocalPlayer/Nego.pas

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