source: branches/delphi/Forms/UFormMain.pas

unit UFormMain;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  UGame, Menus, ActnList, ComCtrls, types, dateutils, System.Actions,
  Vcl.ToolWin;

const
  ZoomFactor = 1.5;

type

  { TFormMain }

  TFormMain = class(TForm)
    AZoomIn: TAction;
    AZoomAll: TAction;
    AZoomOut: TAction;
    ActionList1: TActionList;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem10: TMenuItem;
    MenuItem11: TMenuItem;
    MenuItem12: TMenuItem;
    MenuItem13: TMenuItem;
    MenuItem14: TMenuItem;
    MenuItem15: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    MenuItem9: TMenuItem;
    PaintBox1: TPaintBox;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    procedure AZoomAllExecute(Sender: TObject);
    procedure AZoomInExecute(Sender: TObject);
    procedure AZoomOutExecute(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseLeave(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    StartMousePoint: TPoint;
    StartViewPoint: TPoint;
    MoveActive: Boolean;
    RedrawPending: Boolean;
  public
    procedure Redraw;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses
  UFormNew, UFormMove, UCore;

resourcestring
  STurn = 'turn';

{ TFormMain }

procedure TFormMain.PaintBox1Paint(Sender: TObject);
begin
  //if Core.Game.Running then
  if Assigned(Core.Game.CurrentPlayer) then
  with Core.Game.CurrentPlayer do begin
    View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
    Paint(PaintBox1);
  end;
end;

procedure TFormMain.PaintBox1Resize(Sender: TObject);
begin
  if Assigned(Core.Game.CurrentPlayer) then
  with Core.Game.CurrentPlayer do
    View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
  Redraw;
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
var
  NewCaption: string;
  DrawStart: TDateTime;
begin
  if RedrawPending then begin
    RedrawPending := False;
    DrawStart := Now;
    PaintBox1.Repaint;
    StatusBar1.Panels[1].Text := IntToStr(Trunc((Now - DrawStart) / OneMillisecond)) + ' ms';

    NewCaption := 'xTactics';
    if Assigned(Core.Game.CurrentPlayer) then
      NewCaption := Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Game.TurnCounter) + ' - ' + NewCaption;
    Caption := NewCaption;
  end;
end;

procedure TFormMain.Redraw;
begin
  RedrawPending := True;
end;

procedure TFormMain.FormActivate(Sender: TObject);
begin
  if not Core.Initialized then begin
    Core.Init;
  end;
end;

procedure TFormMain.AZoomAllExecute(Sender: TObject);
var
  Factor: TFloatPoint;
  MapRect: TRect;
begin
  with Core.Game, CurrentPlayer, View do begin
    MapRect := Map.GetPixelRect;
    if ((MapRect.Right - MapRect.Left) <> 0) and
    ((MapRect.Bottom - MapRect.Top) <> 0) then begin
      Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
        (DestRect.Bottom - DestRect.Top) / (MapRect.Bottom - MapRect.Top));
      if Factor.X < Factor.Y then Zoom := Factor.X
        else Zoom := Factor.Y;
    end else Zoom := 1;
    CenterMap;
  end;
  Redraw;
end;

procedure TFormMain.AZoomInExecute(Sender: TObject);
begin
  with Core.Game.CurrentPlayer do begin
    View.Zoom := View.Zoom * ZoomFactor;
  end;
  Redraw;
end;

procedure TFormMain.AZoomOutExecute(Sender: TObject);
var
  D: TPoint;
begin
  with Core.Game.CurrentPlayer do begin
    //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
    //  Trunc(MousePos.Y - View.Top / ViewZoom));
    View.Zoom := View.Zoom / ZoomFactor;
    //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
    //  Trunc((D.Y - MousePos.Y) * ViewZoom),
    //  View.Right - View.Left,
    //  View.Bottom - View.Top);
  end;
  Redraw;
end;

procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Core.Game.Running := False;
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  Redraw;
end;

procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    if Core.Game.CurrentPlayer.Mode = pmHuman then begin
      StartMousePoint := Point(X, Y);
      StartViewPoint := Core.Game.CurrentPlayer.View.SourceRect.TopLeft;
      MoveActive := True;
    end;
  end;
end;

procedure TFormMain.PaintBox1MouseLeave(Sender: TObject);
begin
  MoveActive := False;
end;

procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Cell: TCell;
  OldCell: TCell;
  CellPos: TPoint;
begin
  if Assigned(Core.Game.CurrentPlayer) then begin
    if MoveActive then
    with Core.Game.CurrentPlayer do begin
      if Mode = pmHuman then begin
        View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
          Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
          View.SourceRect.Right - View.SourceRect.Left,
          View.SourceRect.Bottom - View.SourceRect.Top);
        Redraw;
      end;
    end;
    Cell := nil;
    OldCell := Core.Game.CurrentPlayer.View.FocusedCell;
    with Core.Game do
      Cell := Map.PosToCell(CurrentPlayer.View.CanvasToCellPos(Point(X, Y)), CurrentPlayer.View );
    if Assigned(Cell) then begin
      Core.Game.CurrentPlayer.View.FocusedCell := Cell;
      StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) +
        '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
    end else begin
      Core.Game.CurrentPlayer.View.FocusedCell := nil;
      StatusBar1.Panels[0].Text := '';
    end;
    CellPos := Core.Game.CurrentPlayer.View.CanvasToCellPos(Point(X, Y));
    StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
    if Cell <> OldCell then Redraw;
  end else StatusBar1.Panels[0].Text := '';
end;

procedure TFormMain.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Abs(StartMousePoint.X - X) < 5) and (Abs(StartMousePoint.Y - Y) < 5) then begin
    if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin
      Core.Game.CurrentPlayer.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer);
      Redraw;
    end;
  end;
  MoveActive := False;
end;

procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  AZoomOut.Execute;
end;

procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  AZoomIn.Execute;
end;

end.