| 1 | {$INCLUDE Switches.inc}
|
|---|
| 2 | unit Diagram;
|
|---|
| 3 |
|
|---|
| 4 | interface
|
|---|
| 5 |
|
|---|
| 6 | uses
|
|---|
| 7 | BaseWin, LCLIntf, LCLType, SysUtils, Classes, ButtonB,
|
|---|
| 8 | {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.Menus{$ELSE}
|
|---|
| 9 | Graphics, Controls, Forms, Menus{$ENDIF};
|
|---|
| 10 |
|
|---|
| 11 | type
|
|---|
| 12 | TDiagramKind = (dkChart, dkShip);
|
|---|
| 13 |
|
|---|
| 14 | TDiaDlg = class(TFramedDlg)
|
|---|
| 15 | CloseBtn: TButtonB;
|
|---|
| 16 | ToggleBtn: TButtonB;
|
|---|
| 17 | Popup: TPopupMenu;
|
|---|
| 18 | procedure CloseBtnClick(Sender: TObject);
|
|---|
| 19 | procedure FormPaint(Sender: TObject);
|
|---|
| 20 | procedure FormShow(Sender: TObject);
|
|---|
| 21 | procedure FormCreate(Sender: TObject);
|
|---|
| 22 | procedure ToggleBtnClick(Sender: TObject);
|
|---|
| 23 | procedure PlayerClick(Sender: TObject);
|
|---|
| 24 | procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|---|
| 25 | public
|
|---|
| 26 | procedure OffscreenPaint; override;
|
|---|
| 27 | procedure ShowNewContent_Charts(NewMode: TWindowMode);
|
|---|
| 28 | procedure ShowNewContent_Ship(NewMode: TWindowMode; P: Integer = -1);
|
|---|
| 29 | private
|
|---|
| 30 | Kind: TDiagramKind;
|
|---|
| 31 | Player: Integer;
|
|---|
| 32 | Mode: Integer;
|
|---|
| 33 | end;
|
|---|
| 34 |
|
|---|
| 35 | procedure PaintColonyShip(Canvas: TCanvas; Player, Left, Width, Top: Integer);
|
|---|
| 36 |
|
|---|
| 37 |
|
|---|
| 38 | implementation
|
|---|
| 39 |
|
|---|
| 40 | uses
|
|---|
| 41 | Protocol, ScreenTools, ClientTools, Tribes;
|
|---|
| 42 |
|
|---|
| 43 | {$R *.lfm}
|
|---|
| 44 |
|
|---|
| 45 | const
|
|---|
| 46 | Border = 24;
|
|---|
| 47 | RoundPixels: array [0 .. nStat - 1] of Integer = (0, 0, 0, 5, 5, 5);
|
|---|
| 48 |
|
|---|
| 49 | yArea = 48;
|
|---|
| 50 | xComp: array [0 .. 5] of Integer = (-60, -28, 4, 4, 36, 68);
|
|---|
| 51 | yComp: array [0 .. 5] of Integer = (-40, -40, -79, -1, -40, -40);
|
|---|
| 52 | xPow: array [0 .. 3] of Integer = (-116, -116, -116, -116);
|
|---|
| 53 | yPow: array [0 .. 3] of Integer = (-28, 0, -44, 16);
|
|---|
| 54 | xHab: array [0 .. 1] of Integer = (23, 23);
|
|---|
| 55 | yHab: array [0 .. 1] of Integer = (-81, 1);
|
|---|
| 56 |
|
|---|
| 57 | procedure PaintColonyShip(Canvas: TCanvas; Player, Left, Width, Top: Integer);
|
|---|
| 58 | var
|
|---|
| 59 | I, X, R, nComp, nPow, nHab: Integer;
|
|---|
| 60 | begin
|
|---|
| 61 | Canvas.Brush.Color := $000000;
|
|---|
| 62 | Canvas.FillRect(Rect(Left, Top, Left + Width, Top + 200));
|
|---|
| 63 | Canvas.Brush.Style := TBrushStyle.bsClear;
|
|---|
| 64 | ScreenTools.Frame(Canvas, Left - 1, Top - 1, Left + Width, Top + 200,
|
|---|
| 65 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
|---|
| 66 | RFrame(Canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1,
|
|---|
| 67 | MainTexture.ColorBevelShade, MainTexture.ColorBevelLight);
|
|---|
| 68 |
|
|---|
| 69 | // stars
|
|---|
| 70 | DelphiRandSeed := Player * 11111;
|
|---|
| 71 | for I := 1 to Width - 16 do
|
|---|
| 72 | begin
|
|---|
| 73 | X := DelphiRandom((Width - 16) * 200);
|
|---|
| 74 | R := DelphiRandom(13) + 28;
|
|---|
| 75 | Canvas.Pixels[X div 200 + 8, X mod 200 + Top] :=
|
|---|
| 76 | (R * R * R * R div 10001) * $10101;
|
|---|
| 77 | end;
|
|---|
| 78 |
|
|---|
| 79 | nComp := MyRO.Ship[Player].Parts[spComp];
|
|---|
| 80 | nPow := MyRO.Ship[Player].Parts[spPow];
|
|---|
| 81 | nHab := MyRO.Ship[Player].Parts[spHab];
|
|---|
| 82 | if nComp > 6 then
|
|---|
| 83 | nComp := 6;
|
|---|
| 84 | if nPow > 4 then
|
|---|
| 85 | nPow := 4;
|
|---|
| 86 | if nHab > 2 then
|
|---|
| 87 | nHab := 2;
|
|---|
| 88 | for I := 0 to nHab - 1 do
|
|---|
| 89 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xHab[I],
|
|---|
| 90 | Top + 100 + yHab[I], 80, 80, 34, 1);
|
|---|
| 91 | for I := 0 to nComp - 1 do
|
|---|
| 92 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[I],
|
|---|
| 93 | Top + 100 + yComp[I], 32, 80, 1, 1);
|
|---|
| 94 | if nComp > 0 then
|
|---|
| 95 | for I := 3 downto nPow do
|
|---|
| 96 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xPow[I] + 40,
|
|---|
| 97 | Top + 100 + yPow[I], 16, 27, 1, 82);
|
|---|
| 98 | for I := nPow - 1 downto 0 do
|
|---|
| 99 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xPow[I],
|
|---|
| 100 | Top + 100 + yPow[I], 56, 28, 58, 82);
|
|---|
| 101 | if (nComp < 3) and (nHab >= 1) then
|
|---|
| 102 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16,
|
|---|
| 103 | Top + 100 + 7 + yComp[2], 16, 27, 1, 82);
|
|---|
| 104 | if (nComp >= 3) and (nHab < 1) then
|
|---|
| 105 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32,
|
|---|
| 106 | Top + 100 + 7 + yComp[2], 16, 27, 18, 82);
|
|---|
| 107 | if (nComp < 4) and (nHab >= 2) then
|
|---|
| 108 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16,
|
|---|
| 109 | Top + 100 + 46 + yComp[3], 16, 27, 1, 82);
|
|---|
| 110 | if (nComp >= 4) and (nHab < 2) then
|
|---|
| 111 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32,
|
|---|
| 112 | Top + 100 + 46 + yComp[3], 16, 27, 18, 82);
|
|---|
| 113 | if (nComp <> 6) and (nComp <> 2) and not ((nComp = 0) and (nPow < 1)) then
|
|---|
| 114 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
|
|---|
| 115 | Top + 100 + 7 + yComp[nComp], 16, 27, 18, 82);
|
|---|
| 116 | if (nComp <> 6) and (nComp <> 3) and not ((nComp = 0) and (nPow < 2)) then
|
|---|
| 117 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[nComp],
|
|---|
| 118 | Top + 100 + 46 + yComp[nComp], 16, 27, 18, 82);
|
|---|
| 119 | if nComp = 2 then
|
|---|
| 120 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[3],
|
|---|
| 121 | Top + 100 + 7 + yComp[3], 16, 27, 18, 82);
|
|---|
| 122 | if nComp = 3 then
|
|---|
| 123 | Sprite(Canvas, HGrSystem2, Left + Width div 2 + xComp[4],
|
|---|
| 124 | Top + 100 + 7 + yComp[4], 16, 27, 18, 82);
|
|---|
| 125 | end;
|
|---|
| 126 |
|
|---|
| 127 | procedure TDiaDlg.FormCreate(Sender: TObject);
|
|---|
| 128 | begin
|
|---|
| 129 | inherited;
|
|---|
| 130 | TitleHeight := WideFrame + 20;
|
|---|
| 131 | InnerHeight := Height - TitleHeight - NarrowFrame;
|
|---|
| 132 | CaptionRight := CloseBtn.Left;
|
|---|
| 133 | CaptionLeft := ToggleBtn.Left + ToggleBtn.Width;
|
|---|
| 134 | InitButtons;
|
|---|
| 135 | end;
|
|---|
| 136 |
|
|---|
| 137 | procedure TDiaDlg.CloseBtnClick(Sender: TObject);
|
|---|
| 138 | begin
|
|---|
| 139 | Close;
|
|---|
| 140 | end;
|
|---|
| 141 |
|
|---|
| 142 | procedure TDiaDlg.OffscreenPaint;
|
|---|
| 143 | var
|
|---|
| 144 | P, T, Max, X, Y, y0, Stop, R, RoundRange, LineStep: Integer;
|
|---|
| 145 | S: string;
|
|---|
| 146 | List: ^TChart;
|
|---|
| 147 |
|
|---|
| 148 | function Round(T: Integer): Integer;
|
|---|
| 149 | var
|
|---|
| 150 | N, I: Integer;
|
|---|
| 151 | begin
|
|---|
| 152 | if T < RoundRange then
|
|---|
| 153 | N := T
|
|---|
| 154 | else
|
|---|
| 155 | N := RoundRange;
|
|---|
| 156 | Result := 0;
|
|---|
| 157 | for I := T - N to T do
|
|---|
| 158 | Inc(Result, List[I]);
|
|---|
| 159 | Result := Result div (N + 1);
|
|---|
| 160 | end;
|
|---|
| 161 |
|
|---|
| 162 | procedure ShareBar(X, Y: Integer; Cap: string; val0, val1: Integer);
|
|---|
| 163 | begin
|
|---|
| 164 | LoweredTextOut(Offscreen.Canvas, -1, MainTexture, X - 2, Y, Cap);
|
|---|
| 165 | DLine(Offscreen.Canvas, X - 2, X + 169, Y + 16, MainTexture.ColorTextShade,
|
|---|
| 166 | MainTexture.ColorTextLight);
|
|---|
| 167 | if val0 > 0 then
|
|---|
| 168 | S := Format(Phrases.Lookup('SHARE'), [val0, val1])
|
|---|
| 169 | else
|
|---|
| 170 | S := '0';
|
|---|
| 171 | RisedTextOut(Offscreen.Canvas,
|
|---|
| 172 | X + 170 - BiColorTextWidth(Offscreen.Canvas, S), Y, S);
|
|---|
| 173 | end;
|
|---|
| 174 |
|
|---|
| 175 | begin
|
|---|
| 176 | inherited;
|
|---|
| 177 | if Kind = dkChart then
|
|---|
| 178 | with Offscreen.Canvas do
|
|---|
| 179 | begin
|
|---|
| 180 | Font.Assign(UniFont[ftTiny]);
|
|---|
| 181 | Font.Color := $808080;
|
|---|
| 182 |
|
|---|
| 183 | RoundRange := RoundPixels[Mode] * (MyRO.Turn - 1)
|
|---|
| 184 | div (InnerWidth - 2 * Border);
|
|---|
| 185 |
|
|---|
| 186 | GetMem(List, 4 * (MyRO.Turn + 2));
|
|---|
| 187 | if Mode = stExplore then
|
|---|
| 188 | Max := G.lx * G.ly
|
|---|
| 189 | else
|
|---|
| 190 | begin
|
|---|
| 191 | Max := -1;
|
|---|
| 192 | for P := 0 to nPl - 1 do
|
|---|
| 193 | if (G.Difficulty[P] > 0) and
|
|---|
| 194 | (Server(sGetChart + Mode shl 4, Me, P, List^) >= rExecuted) then
|
|---|
| 195 | for T := 0 to MyRO.Turn - 1 do
|
|---|
| 196 | begin
|
|---|
| 197 | R := Round(T);
|
|---|
| 198 | if R > Max then
|
|---|
| 199 | Max := R;
|
|---|
| 200 | end;
|
|---|
| 201 | end;
|
|---|
| 202 |
|
|---|
| 203 | Brush.Color := $000000;
|
|---|
| 204 | FillRect(Rect(0, 0, InnerWidth, InnerHeight));
|
|---|
| 205 | Brush.Style := TBrushStyle.bsClear;
|
|---|
| 206 | Pen.Color := $606060;
|
|---|
| 207 | MoveTo(Border, InnerHeight - Border);
|
|---|
| 208 | LineTo(InnerWidth - Border, InnerHeight - Border);
|
|---|
| 209 | if MyRO.Turn >= 800 then
|
|---|
| 210 | LineStep := 200
|
|---|
| 211 | else if MyRO.Turn >= 400 then
|
|---|
| 212 | LineStep := 100
|
|---|
| 213 | else
|
|---|
| 214 | LineStep := 50;
|
|---|
| 215 | for T := 0 to (MyRO.Turn - 1) div LineStep do
|
|---|
| 216 | begin
|
|---|
| 217 | X := Border + (InnerWidth - 2 * Border) * T *
|
|---|
| 218 | LineStep div (MyRO.Turn - 1);
|
|---|
| 219 | MoveTo(X, Border);
|
|---|
| 220 | LineTo(X, InnerHeight - Border);
|
|---|
| 221 | S := IntToStr(Abs(TurnToYear(T * LineStep)));
|
|---|
| 222 | TextOut(X - TextWidth(S) div 2, Border - 16, S);
|
|---|
| 223 | end;
|
|---|
| 224 |
|
|---|
| 225 | y0 := 0;
|
|---|
| 226 | if Max > 0 then
|
|---|
| 227 | begin
|
|---|
| 228 | for P := 0 to nPl - 1 do
|
|---|
| 229 | if (G.Difficulty[P] > 0) and
|
|---|
| 230 | (Server(sGetChart + Mode shl 4, Me, P, List^) >= rExecuted) then
|
|---|
| 231 | begin
|
|---|
| 232 | Pen.Color := Tribe[P].Color;
|
|---|
| 233 | Stop := MyRO.Turn - 1;
|
|---|
| 234 | while (Stop > 0) and (List[Stop] = 0) do
|
|---|
| 235 | Dec(Stop);
|
|---|
| 236 | for T := 0 to Stop do
|
|---|
| 237 | begin
|
|---|
| 238 | R := Round(T);
|
|---|
| 239 | X := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1);
|
|---|
| 240 | Y := InnerHeight - Border - (InnerHeight - 2 * Border) *
|
|---|
| 241 | R div Max;
|
|---|
| 242 | if T = 0 then
|
|---|
| 243 | MoveTo(X, Y)
|
|---|
| 244 | // else if Mode=stTerritory then
|
|---|
| 245 | // begin LineTo(x,y0); LineTo(x,y) end
|
|---|
| 246 | else if RoundPixels[Mode] = 0 then
|
|---|
| 247 | begin
|
|---|
| 248 | if (Y <> y0) or (T = Stop) then
|
|---|
| 249 | LineTo(X, Y)
|
|---|
| 250 | end
|
|---|
| 251 | else
|
|---|
| 252 | LineTo(X, Y);
|
|---|
| 253 | y0 := Y;
|
|---|
| 254 | end;
|
|---|
| 255 | end;
|
|---|
| 256 | end;
|
|---|
| 257 | FreeMem(List);
|
|---|
| 258 | end
|
|---|
| 259 | else
|
|---|
| 260 | with Offscreen.Canvas do
|
|---|
| 261 | begin
|
|---|
| 262 | Font.Assign(UniFont[ftSmall]);
|
|---|
| 263 | FillOffscreen(0, 0, InnerWidth, InnerHeight);
|
|---|
| 264 |
|
|---|
| 265 | PaintColonyShip(Offscreen.Canvas, Player, 8, InnerWidth - 16, yArea);
|
|---|
| 266 |
|
|---|
| 267 | ShareBar(InnerWidth div 2 - 85, InnerHeight - 62,
|
|---|
| 268 | Phrases.Lookup('SHIPHAB'), MyRO.Ship[Player].Parts[spHab], 2);
|
|---|
| 269 | ShareBar(InnerWidth div 2 - 85, InnerHeight - 43,
|
|---|
| 270 | Phrases.Lookup('SHIPPOW'), MyRO.Ship[Player].Parts[spPow], 4);
|
|---|
| 271 | ShareBar(InnerWidth div 2 - 85, InnerHeight - 24,
|
|---|
| 272 | Phrases.Lookup('SHIPCOMP'), MyRO.Ship[Player].Parts[spComp], 6);
|
|---|
| 273 | end;
|
|---|
| 274 | MarkUsedOffscreen(InnerWidth, InnerHeight);
|
|---|
| 275 | end;
|
|---|
| 276 |
|
|---|
| 277 | procedure TDiaDlg.FormPaint(Sender: TObject);
|
|---|
| 278 | var
|
|---|
| 279 | S: string;
|
|---|
| 280 | begin
|
|---|
| 281 | inherited;
|
|---|
| 282 | Canvas.Font.Assign(UniFont[ftNormal]);
|
|---|
| 283 | if Kind = dkChart then
|
|---|
| 284 | S := Phrases.Lookup('DIAGRAM', Mode)
|
|---|
| 285 | else
|
|---|
| 286 | S := Tribe[Player].TPhrase('SHORTNAME');
|
|---|
| 287 | LoweredTextOut(Canvas, -1, MainTexture,
|
|---|
| 288 | (ClientWidth - BiColorTextWidth(Canvas, S)) div 2, 31, S);
|
|---|
| 289 | end;
|
|---|
| 290 |
|
|---|
| 291 | procedure TDiaDlg.FormShow(Sender: TObject);
|
|---|
| 292 | begin
|
|---|
| 293 | if WindowMode = wmModal then
|
|---|
| 294 | begin { center on screen }
|
|---|
| 295 | Left := (Screen.Width - Width) div 2;
|
|---|
| 296 | Top := (Screen.Height - Height) div 2;
|
|---|
| 297 | end;
|
|---|
| 298 | OffscreenPaint;
|
|---|
| 299 | end;
|
|---|
| 300 |
|
|---|
| 301 | procedure TDiaDlg.ShowNewContent_Charts(NewMode: TWindowMode);
|
|---|
| 302 | begin
|
|---|
| 303 | Kind := dkChart;
|
|---|
| 304 | Mode := stPop;
|
|---|
| 305 | ToggleBtn.ButtonIndex := 15;
|
|---|
| 306 | ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE');
|
|---|
| 307 | Caption := Phrases.Lookup('TITLE_DIAGRAMS');
|
|---|
| 308 | inherited ShowNewContent(NewMode);
|
|---|
| 309 | end;
|
|---|
| 310 |
|
|---|
| 311 | procedure TDiaDlg.ShowNewContent_Ship(NewMode: TWindowMode; P: Integer);
|
|---|
| 312 | begin
|
|---|
| 313 | Kind := dkShip;
|
|---|
| 314 | if P < 0 then
|
|---|
| 315 | begin
|
|---|
| 316 | Player := Me;
|
|---|
| 317 | while MyRO.Ship[Player].Parts[spComp] + MyRO.Ship[Player].Parts[spPow] +
|
|---|
| 318 | MyRO.Ship[Player].Parts[spHab] = 0 do
|
|---|
| 319 | Player := (Player + 1) mod nPl;
|
|---|
| 320 | end
|
|---|
| 321 | else
|
|---|
| 322 | Player := P;
|
|---|
| 323 | ToggleBtn.ButtonIndex := 28;
|
|---|
| 324 | ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT');
|
|---|
| 325 | Caption := Phrases.Lookup('TITLE_SHIPS');
|
|---|
| 326 | inherited ShowNewContent(NewMode);
|
|---|
| 327 | end;
|
|---|
| 328 |
|
|---|
| 329 | procedure TDiaDlg.ToggleBtnClick(Sender: TObject);
|
|---|
| 330 | var
|
|---|
| 331 | p1: Integer;
|
|---|
| 332 | M: TMenuItem;
|
|---|
| 333 | begin
|
|---|
| 334 | if Kind = dkChart then
|
|---|
| 335 | begin
|
|---|
| 336 | Mode := (Mode + 1) mod nStat;
|
|---|
| 337 | OffscreenPaint;
|
|---|
| 338 | Invalidate;
|
|---|
| 339 | end
|
|---|
| 340 | else
|
|---|
| 341 | begin
|
|---|
| 342 | EmptyMenu(Popup.Items);
|
|---|
| 343 | for p1 := 0 to nPl - 1 do
|
|---|
| 344 | if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] +
|
|---|
| 345 | MyRO.Ship[p1].Parts[spHab] > 0 then
|
|---|
| 346 | begin
|
|---|
| 347 | M := TMenuItem.Create(Popup);
|
|---|
| 348 | M.RadioItem := True;
|
|---|
| 349 | M.Caption := Tribe[p1].TPhrase('SHORTNAME');
|
|---|
| 350 | M.Tag := p1;
|
|---|
| 351 | M.OnClick := PlayerClick;
|
|---|
| 352 | if p1 = Player then
|
|---|
| 353 | M.Checked := True;
|
|---|
| 354 | Popup.Items.Add(M);
|
|---|
| 355 | end;
|
|---|
| 356 | Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height);
|
|---|
| 357 | end;
|
|---|
| 358 | end;
|
|---|
| 359 |
|
|---|
| 360 | procedure TDiaDlg.PlayerClick(Sender: TObject);
|
|---|
| 361 | begin
|
|---|
| 362 | ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag);
|
|---|
| 363 | end;
|
|---|
| 364 |
|
|---|
| 365 | procedure TDiaDlg.FormKeyDown(Sender: TObject; var Key: Word;
|
|---|
| 366 | Shift: TShiftState);
|
|---|
| 367 | begin
|
|---|
| 368 | if (Key = VK_F6) and (Kind = dkChart) then // my key
|
|---|
| 369 | ToggleBtnClick(nil)
|
|---|
| 370 | else if (Key = VK_F8) and (Kind = dkShip) then // my other key
|
|---|
| 371 | else
|
|---|
| 372 | inherited;
|
|---|
| 373 | end;
|
|---|
| 374 |
|
|---|
| 375 | end.
|
|---|
