source: tags/1.3.5/LocalPlayer/TechTree.pas

{$INCLUDE Switches.inc}
unit TechTree;

interface

uses
  ScreenTools, LCLIntf, LCLType, SysUtils, Classes, ButtonB, DrawDlg,
  {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.ExtCtrls{$ELSE}
  Graphics, Controls, Forms, ExtCtrls{$ENDIF};

type

  { TTechTreeDlg }

  TTechTreeDlg = class(TDrawDlg)
    CloseBtn: TButtonB;
    TimerKeyPressed: TTimer;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure CloseBtnClick(Sender: TObject);
    procedure TimerKeyPressedTimer(Sender: TObject);
  private
    Offset: TPoint;
    Down: TPoint;
    Image: TBitmap;
    Dragging: Boolean;
    LeftPressed: Boolean;
    RightPressed: Boolean;
    UpPressed: Boolean;
    DownPressed: Boolean;
    procedure Move(Diff: TPoint);
  end;


implementation

uses
  Directories;

{$R *.lfm}

const
  BlackBorder = 4;
  LeftBorder = 72;
  RightBorder = 45;
  TopBorder = 16;
  BottomBorder = 48;
  xStart = 0;
  yStart = 40;
  xPitch = 160;
  yPitch = 90;
  xLegend = 44;
  yLegend = 79;
  yLegendPitch = 32;

function Min(A, B: Integer): Integer;
begin
  if A < B then Result := A
    else Result := B;
end;

function Max(A, B: Integer): Integer;
begin
  if A > B then Result := A
    else Result := B;
end;

procedure TTechTreeDlg.FormCreate(Sender: TObject);
begin
  InitButtons;
  Image := nil;
end;

procedure TTechTreeDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction
  );
begin
  TimerKeyPressed.Enabled := False;
  RightPressed := False;
  DownPressed := False;
  LeftPressed := False;
  UpPressed := False;
end;

procedure TTechTreeDlg.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Image);
end;

procedure TTechTreeDlg.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    37: RightPressed := True;
    38: DownPressed := True;
    39: LeftPressed := True;
    40: UpPressed := True;
  end;
  TimerKeyPressedTimer(nil);
  TimerKeyPressed.Enabled := RightPressed or DownPressed or LeftPressed or UpPressed;
end;

procedure TTechTreeDlg.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    37: RightPressed := False;
    38: DownPressed := False;
    39: LeftPressed := False;
    40: UpPressed := False;
  end;
  TimerKeyPressed.Enabled := RightPressed or DownPressed or LeftPressed or UpPressed;
end;

procedure TTechTreeDlg.FormPaint(Sender: TObject);
var
  X, W: Integer;
begin
  with Canvas do begin
    // black border
    Brush.Color := $000000;
    FillRect(rect(0, 0, BlackBorder, ClientHeight));
    FillRect(rect(BlackBorder, 0, ClientWidth - BlackBorder, BlackBorder));
    FillRect(rect(ClientWidth - BlackBorder, 0, ClientWidth, ClientHeight));
    FillRect(rect(BlackBorder, ClientHeight - BlackBorder,
      ClientWidth - BlackBorder, ClientHeight));

    // texturize empty space
    Brush.Color := $FFFFFF;
    if Offset.X > 0 then
      FillRectSeamless(Canvas, BlackBorder, BlackBorder, BlackBorder + Offset.X,
        ClientHeight - BlackBorder, -BlackBorder - Offset.X,
        -BlackBorder - Offset.Y, Paper);
    if Offset.X + Image.Width < ClientWidth - 2 * BlackBorder then
      FillRectSeamless(Canvas, BlackBorder + Offset.X + Image.Width, BlackBorder,
        ClientWidth - BlackBorder, ClientHeight - BlackBorder,
        -BlackBorder - Offset.X, -BlackBorder - Offset.Y, Paper);
    X := Max(BlackBorder, BlackBorder + Offset.X);
    W := Min(BlackBorder + Offset.X + Image.Width, ClientWidth - BlackBorder);
    if Offset.Y > 0 then
      FillRectSeamless(Canvas, X, BlackBorder, W, BlackBorder + Offset.Y,
        -BlackBorder - Offset.X, -BlackBorder - Offset.Y, Paper);
    if Offset.Y + Image.Height < ClientHeight - 2 * BlackBorder then
      FillRectSeamless(Canvas, X, BlackBorder + Offset.Y + Image.Height, W,
        ClientHeight - BlackBorder, -BlackBorder - Offset.X,
        -BlackBorder - Offset.Y, Paper);
  end;
  BitBltCanvas(Canvas, Max(BlackBorder, BlackBorder + Offset.X),
    Max(BlackBorder, BlackBorder + Offset.Y),
    Min(Image.Width, Min(Image.Width + Offset.X,
    Min(ClientWidth - 2 * BlackBorder, ClientWidth - 2 * BlackBorder - Offset.X))
    ), Min(Image.Height, Min(Image.Height + Offset.Y,
    Min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder -
    Offset.Y))), Image.Canvas, Max(0, -Offset.X),
    Max(0, -Offset.Y));
end;

procedure TTechTreeDlg.FormShow(Sender: TObject);
var
  X, Y, ad: Integer;
  S: string;
  NewWidth: Integer;
  NewHeight: Integer;
begin
  Caption := Phrases2.Lookup('MENU_ADVTREE');
  if Image = nil then begin
    Image := TBitmap.Create;
    Image.PixelFormat := TPixelFormat.pf24bit;
    LoadGraphicFile(Image, HomeDir + 'Help' + DirectorySeparator + 'AdvTree.png',
      [gfNoGamma]);

    with Image.Canvas do begin
      // Write advance names
      Font.Assign(UniFont[ftSmall]);
      Font.Color := clBlack;
      Brush.Style := TBrushStyle.bsClear;
      for X := 0 to (Image.Width - xStart) div xPitch do
        for Y := 0 to (Image.Height - yStart) div yPitch do
        begin
          ad := Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1];
          if ad and $FFFF00 = 0 then
          begin
            S := Phrases.Lookup('ADVANCES', ad);
            while TextWidth(S) > 112 do
              Delete(S, Length(S), 1);
            TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, S);
            Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1]
              := TransparentColor2;
          end;
        end;

      // Write legend
      TextOut(xLegend, yLegend, Phrases2.Lookup('ADVTREE_UP0'));
      TextOut(xLegend, yLegend + yLegendPitch, Phrases2.Lookup('ADVTREE_UP1'));
      TextOut(xLegend, yLegend + 2 * yLegendPitch,
        Phrases2.Lookup('ADVTREE_UP2'));
      TextOut(xLegend, yLegend + 3 * yLegendPitch,
        Phrases2.Lookup('ADVTREE_GOV'));
      TextOut(xLegend, yLegend + 4 * yLegendPitch,
        Phrases2.Lookup('ADVTREE_OTHER'));
    end;

    Texturize(Image, Paper, TransparentColor2);
  end;

  // Fit window to image, center image in window, center window to screen
  NewWidth := Min(Screen.Width - 40, Image.Width + LeftBorder + RightBorder +
    2 * BlackBorder);
  NewHeight := Min(Screen.Height - 40, Image.Height + TopBorder + BottomBorder +
    2 * BlackBorder);
  BoundsRect := Bounds((Screen.Width - NewWidth) div 2,
    (Screen.Height - NewHeight) div 2, NewWidth, NewHeight);
  CloseBtn.Left := Width - CloseBtn.Width - BlackBorder - 8;
  CloseBtn.Top := BlackBorder + 8;
  Offset.X := (ClientWidth - Image.Width + LeftBorder - RightBorder) div 2 -
    BlackBorder;
  Offset.Y := ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder;
end;

procedure TTechTreeDlg.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = TMouseButton.mbLeft then
  begin
    Dragging := True;
    Down := Point(X, Y);
  end;
end;

procedure TTechTreeDlg.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Dragging := False;
end;

procedure TTechTreeDlg.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if Dragging then
  begin
    Move(Point(X - Down.X, Y - Down.Y));
    Down := Point(X, Y);
  end;
end;

procedure TTechTreeDlg.CloseBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TTechTreeDlg.TimerKeyPressedTimer(Sender: TObject);
const
  Diff = 50;
var
  Change: TPoint;
begin
  Change := Point(0, 0);
  if RightPressed then Change.X := Change.X + Diff;
  if LeftPressed then Change.X := Change.X - Diff;
  if DownPressed then Change.Y := Change.Y + Diff;
  if UpPressed then Change.Y := Change.Y - Diff;

  if (Change.X <> 0) or (Change.Y <> 0) then Move(Change);
end;

procedure TTechTreeDlg.Move(Diff: TPoint);
begin
  Offset := Offset + Diff;

  if Offset.X > LeftBorder then
    Offset.X := LeftBorder;
  if Offset.X < ClientWidth - 2 * BlackBorder - Image.Width - RightBorder then
    Offset.X := ClientWidth - 2 * BlackBorder - Image.Width - RightBorder;
  if Offset.Y > TopBorder then
    Offset.Y := TopBorder;
  if Offset.Y < ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder then
    Offset.Y := ClientHeight - 2 * BlackBorder - Image.Height - BottomBorder;

  SmartInvalidate;
end;

end.