unit UFormClient;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  UGame, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM, Math,
  UGeometry, UGameClient, UGameProtocol, UThreading, UPlayer, UClientGUI, UFormMain;

const
  ZoomFactor = 1.5;
  MinZoom = 0.1;
  MaxZoom = 10;
  MouseMinDiff = 0.1;

type

  { TFormClient }

  TFormClient = class(TForm)
    ASurrender: TAction;
    AGameEndTurn: TAction;
    AStatusBarVisible: TAction;
    AToolBarVisible: TAction;
    AToolBarBigIcons: TAction;
    AZoomIn: TAction;
    AZoomAll: TAction;
    AZoomOut: TAction;
    ActionList1: TActionList;
    MenuItem18: TMenuItem;
    PaintBox1: TPaintBox;
    PopupMenuToolbar: TPopupMenu;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    procedure AGameEndTurnExecute(Sender: TObject);
    procedure AStatusBarVisibleExecute(Sender: TObject);
    procedure AStatusBarVisibleUpdate(Sender: TObject);
    procedure ASurrenderExecute(Sender: TObject);
    procedure AToolBarBigIconsExecute(Sender: TObject);
    procedure AToolBarBigIconsUpdate(Sender: TObject);
    procedure AToolBarVisibleExecute(Sender: TObject);
    procedure AToolBarVisibleUpdate(Sender: TObject);
    procedure AZoomAllExecute(Sender: TObject);
    procedure AZoomInExecute(Sender: TObject);
    procedure AZoomOutExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    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 EraseBackground(DC: HDC); override;
    procedure PaintBox1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FClient: TClientGUI;
    TempBitmap: TBitmap;
    StartMousePoint: TPoint;
    StartViewPoint: TPoint;
    MoveActive: Boolean;
    RedrawPending: Boolean;
    Drawing: Boolean;
    DrawDuration: TDateTime;
    LastTimerTime: TDateTime;
    TimerPeriod: TDateTime;
    TurnActive: Boolean;
    procedure SetClient(AValue: TClientGUI);
    procedure DoClientChange(Sender: TObject);
    procedure DoGameEnd(Sender: TObject);
    procedure DoNextPlayer(Sender: TObject);
    procedure DoTurnStart(Sender: TObject);
    procedure DoMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
      CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
    procedure SetToolbarHints;
    procedure DoClientDestroy(Sender: TObject);
  public
    FormMain: TFormMain;
    procedure LoadConfig(Config: TXmlConfig; Path: string);
    procedure SaveConfig(Config: TXmlConfig; Path: string);
    procedure UpdateInterface;
    procedure Redraw;
    property Client: TClientGUI read FClient write SetClient;
  end;

var
  FormClient: TFormClient;

const
  MapBackgroundColor = $404040;

implementation

uses
  UCore, UFormMove;

resourcestring
  STurn = 'turn';
  SSurrender = 'Surrender';
  SSurrenderQuestion = 'Do you want to surrender current game?';

{$R *.lfm}

{ TFormClient }

procedure TFormClient.SetToolbarHints;
var
  I: Integer;
begin
  for I := 0 to ToolBar1.ButtonCount - 1 do begin
    ToolBar1.Buttons[I].ShowHint := True;
    ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
  end;
end;

procedure TFormClient.DoClientDestroy(Sender: TObject);
begin
  Client := nil;
end;

procedure TFormClient.DoMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
  CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
var
  I: Integer;
  FormMove: TFormMove;
begin
  FormMove := TFormMove.Create(nil);
  try
    // Set controls value maximum before value itself as the controls update their values mutually
    if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce
      else FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower;
    FormMove.TrackBarOnce.Max := FormMove.SpinEditOnce.MaxValue;
    FormMove.SpinEditOnce.Value := CountOnce;
    FormMove.TrackBarOnce.Position := FormMove.SpinEditOnce.Value;
    FormMove.SpinEditRepeat.MaxValue := Client.Game.Map.MaxPower;
    FormMove.TrackBarRepeat.Max := FormMove.SpinEditRepeat.MaxValue;
    FormMove.SpinEditRepeat.Value := CountRepeat;
    FormMove.TrackBarRepeat.Position := FormMove.SpinEditRepeat.Value;

    FormMove.AllowChangeOnce := Client.Game.GameSystem.UnitsSplitMerge;

    if Assigned(CellTo.MapCell.OneUnit) then
      FormMove.DefendCount := CellTo.MapCell.OneUnit.Power
      else FormMove.DefendCount := 0;
    // Attack count from other surrounding cells without current move if already exists
    FormMove.AttackCount := 0;
    for I := 0 to CellTo.MovesTo.Count - 1 do
    if TUnitMove(CellTo.MovesTo[I]).CellFrom <> CellFrom then
      FormMove.AttackCount := FormMove.AttackCount + TUnitMove(CellTo.MovesTo[I]).CountOnce;
    FormMove.ShowWinProbability := CellTo.MapCell.Player <> CellFrom.MapCell.Player;

    if FormMove.ShowModal = mrOk then begin
      CountOnce := FormMove.SpinEditOnce.Value;
      CountRepeat := FormMove.SpinEditRepeat.Value;
      Confirm := True;
    end else Confirm := False;
  finally
    FormMove.Free;
  end;
end;

procedure TFormClient.PaintBox1Paint(Sender: TObject);
var
  DrawStart: TDateTime;
  R: TRect;
  StartP: TPoint;
  CountP: TPoint;
  X, Y: Integer;
  TempView: TView;
begin
  DrawStart := Now;
  if Assigned(Client) then
  with Client do begin
    View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
    if csOpaque in PaintBox1.ControlStyle then begin
      TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
      TempBitmap.Canvas.Brush.Color := MapBackGroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
      TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
      Client.Paint(TempBitmap.Canvas, View);
      PaintBox1.Canvas.Draw(0, 0, TempBitmap);
    end else begin
      {$ifdef WINDOWS}
      PaintBox1.Canvas.Brush.Color := MapBackgroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
      PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
      {$endif}

      if Game.CyclicMap then begin
        TempView := TView.Create;
        TempView.Game := Game;
        //R := View.CellToCanvasRect(TRect.Create(Game.Map.Cells.First.PosPx,
        //  Game.Map.Cells.Last.PosPx));
        R := View.CellToCanvasRect(Game.Map.PixelRect);
        StartP := TPoint.Create(Ceil(R.P1.X / R.Size.X) * R.Size.X,
          Ceil(R.P1.Y / R.Size.Y) * R.Size.Y);
        CountP := TPoint.Create(Ceil(View.DestRect.Size.X / R.Size.X),
          Ceil(View.DestRect.Size.X / R.Size.Y));
        for Y := 0 to CountP.Y do begin
          for X := 0 to CountP.X do begin
            TempView.Assign(View);
            TempView.DestRect := TRect.Create(
              TPoint.Create(
                -StartP.X + R.Size.X * X,
                -StartP.Y + R.Size.Y * Y
              ),
              TPoint.Create(
                -StartP.X + R.Size.X * X + View.DestRect.Size.X,
                -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
              )
            );
            Client.DrawCellLinks(PaintBox1.Canvas, TempView);
          end;
        end;
        for Y := 0 to CountP.Y do begin
          for X := 0 to CountP.X do begin
            TempView.Assign(View);
            TempView.DestRect := TRect.Create(
              TPoint.Create(
                -StartP.X + R.Size.X * X,
                -StartP.Y + R.Size.Y * Y
              ),
              TPoint.Create(
                -StartP.X + R.Size.X * X + View.DestRect.Size.X,
                -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
              )
            );
            Client.DrawCells(PaintBox1.Canvas, TempView);
          end;
        end;
        for Y := 0 to CountP.Y do begin
          for X := 0 to CountP.X do begin
            TempView.Assign(View);
            TempView.DestRect := TRect.Create(
              TPoint.Create(
                -StartP.X + R.Size.X * X,
                -StartP.Y + R.Size.Y * Y
              ),
              TPoint.Create(
                -StartP.X + R.Size.X * X + View.DestRect.Size.X,
                -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
              )
            );
            Client.DrawCities(PaintBox1.Canvas, TempView);
          end;
        end;
        for Y := 0 to CountP.Y do begin
          for X := 0 to CountP.X do begin
            TempView.Assign(View);
            TempView.DestRect := TRect.Create(
              TPoint.Create(
                -StartP.X + R.Size.X * X,
                -StartP.Y + R.Size.Y * Y
              ),
              TPoint.Create(
                -StartP.X + R.Size.X * X + View.DestRect.Size.X,
                -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
              )
            );
            Client.DrawSelection(PaintBox1.Canvas, TempView);
          end;
        end;
        TempView.Free;
        for Y := 0 to CountP.Y do begin
          for X := 0 to CountP.X do begin
            TempView.Assign(View);
            TempView.DestRect := TRect.Create(
              TPoint.Create(
                -StartP.X + R.Size.X * X,
                -StartP.Y + R.Size.Y * Y
              ),
              TPoint.Create(
                -StartP.X + R.Size.X * X + View.DestRect.Size.X,
                -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
              )
            );
            Client.DrawArrows(PaintBox1.Canvas, TempView);
          end;
        end;
      end else begin
        Client.Paint(PaintBox1.Canvas, View);
      end;
    end;
  end;
  DrawDuration := (9 * DrawDuration + (Now - DrawStart)) / 10;
end;

procedure TFormClient.EraseBackground(DC: HDC);
begin
  // Do nothing, all background space covered by controls
end;

procedure TFormClient.PaintBox1Resize(Sender: TObject);
begin
  if Assigned(Client) then
  with Client do
    View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
  Redraw;
end;

procedure TFormClient.Timer1Timer(Sender: TObject);
var
  NewCaption: string;
begin
  if RedrawPending and not Drawing then begin
    Drawing := True;
    if not Core.DevelMode then RedrawPending := False;
    TimerPeriod := (9 * TimerPeriod + (Now - LastTimerTime)) / 10;
    LastTimerTime := Now;
    PaintBox1.Repaint;
    StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' / ' +
      IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms' +
      ' ' + IntToStr(Core.Game.Map.CellLinks.Count);
    NewCaption := 'xTactics';
    if Assigned(Core.Game.CurrentPlayer) then
      NewCaption := Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Game.TurnCounter) + ' - ' + NewCaption;
    Caption := NewCaption;
    Drawing := False;
  end;
end;

procedure TFormClient.SetClient(AValue: TClientGUI);
begin
  if FClient = AValue then Exit;
  if Assigned(FClient) then FClient.Form := nil;
  FClient := AValue;
  if Assigned(FClient) then begin
    FClient.Form := Self;
    FClient.OnChange := DoClientChange;
    FClient.OnMove := DoMove;
    FClient.OnTurnStart := DoTurnStart;
    FClient.OnDestroy := DoClientDestroy;
    FClient.OnGameEnd := DoGameEnd;
    FClient.OnNextPlayer := DoNextPlayer;
    FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
    FClient.CellGridVisible := Core.CellGridVisible;
    FClient.UnitShapeVisible := Core.UnitShapeVisible;
  end;
  Redraw;
end;

procedure TFormClient.DoClientChange(Sender: TObject);
begin
  Redraw;
end;

procedure TFormClient.DoGameEnd(Sender: TObject);
begin
  Redraw;
end;

procedure TFormClient.DoNextPlayer(Sender: TObject);
begin
  Redraw;
end;

procedure TFormClient.DoTurnStart(Sender: TObject);
begin
  TurnActive := True;
  UpdateInterface;
  Redraw;
end;

procedure TFormClient.LoadConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False);
    AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True);
    AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);
  end;
end;

procedure TFormClient.SaveConfig(Config: TXmlConfig; Path: string);
begin
  with Config do begin
    SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked);
    SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked);
    SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);
  end;
end;

procedure TFormClient.UpdateInterface;
begin
  if AToolBarBigIcons.Checked then begin
    ToolBar1.Images := Core.ImageListLarge;
    ToolBar1.ButtonWidth := Core.ImageListLarge.Width + 7;
    ToolBar1.ButtonHeight := Core.ImageListLarge.Height + 6;
    ToolBar1.Width := Core.ImageListLarge.Width + 10;
    ToolBar1.Height := Core.ImageListLarge.Height + 10;
  end else begin
    ToolBar1.Images := Core.ImageListSmall;
    ToolBar1.ButtonWidth := Core.ImageListSmall.Width + 7;
    ToolBar1.ButtonHeight := Core.ImageListSmall.Height + 6;
    ToolBar1.Width := Core.ImageListSmall.Width + 10;
    ToolBar1.Height := Core.ImageListSmall.Height + 10;
  end;
  ToolBar1.Visible := AToolBarVisible.Checked;
  StatusBar1.Visible := AStatusBarVisible.Checked;
  AGameEndTurn.Enabled := Assigned(Client) and Assigned(Client.ControlPlayer) and
    Client.ControlPlayer.IsAlive and TurnActive;
  ASurrender.Enabled := Assigned(Client) and Assigned(Client.ControlPlayer) and
    Client.ControlPlayer.IsAlive;
end;

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

procedure TFormClient.FormCreate(Sender: TObject);
begin
  {$IFDEF Linux}
  //PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
  {$ENDIF}
  //DoubleBuffered := True;
  TempBitmap := TBitmap.Create;
  TimerPeriod := 0;
  LastTimerTime := Now;
  Core.CoolTranslator1.TranslateComponentRecursive(Self);
end;

procedure TFormClient.AZoomAllExecute(Sender: TObject);
begin
  with Core, Game, Client, View do begin
    ZoomAll;
  end;
  Redraw;
end;

procedure TFormClient.AToolBarBigIconsExecute(Sender: TObject);
begin
  AToolBarBigIcons.Checked := not AToolBarBigIcons.Checked;
end;

procedure TFormClient.AToolBarBigIconsUpdate(Sender: TObject);
begin
  UpdateInterface;
end;

procedure TFormClient.AStatusBarVisibleExecute(Sender: TObject);
begin
  AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
  UpdateInterface;
end;

procedure TFormClient.AStatusBarVisibleUpdate(Sender: TObject);
begin
  UpdateInterface;
end;

procedure TFormClient.ASurrenderExecute(Sender: TObject);
begin
  if MessageDlg(SSurrender, SSurrenderQuestion, mtConfirmation, mbYesNo, 0) =
    mrYes then begin
      Client.Protocol.Surrender;
      UpdateInterface;
    end;
end;

procedure TFormClient.AGameEndTurnExecute(Sender: TObject);
begin
  TurnActive := False;
  Client.Protocol.TurnEnd;
  UpdateInterface;
end;

procedure TFormClient.AToolBarVisibleExecute(Sender: TObject);
begin
  AToolBarVisible.Checked := not AToolBarVisible.Checked;
  UpdateInterface;
end;

procedure TFormClient.AToolBarVisibleUpdate(Sender: TObject);
begin
  UpdateInterface;
end;

procedure TFormClient.AZoomInExecute(Sender: TObject);
begin
  with Client do begin
    if View.Zoom * ZoomFactor < MaxZoom then
      View.Zoom := View.Zoom * ZoomFactor;
  end;
  Redraw;
end;

procedure TFormClient.AZoomOutExecute(Sender: TObject);
begin
  with Client do begin
    if View.Zoom / ZoomFactor > MinZoom then
      View.Zoom := View.Zoom / ZoomFactor;
  end;
  Redraw;
end;

procedure TFormClient.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  SaveConfig(Core.XMLConfig1, 'FormClient');
  Core.PersistentForm.Save(Self);
end;

procedure TFormClient.FormDestroy(Sender: TObject);
begin
  Client := nil;
  TempBitmap.Free;
end;

procedure TFormClient.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
  );
const
  ControlKey = 17;
  EscapeKey = 27;
begin
  if (Key = EscapeKey) or (Key = ControlKey) then
  if Assigned(Core.Game.CurrentPlayer) then begin
    Client.View.SelectedCell := nil;
    Redraw;
  end;
end;

procedure TFormClient.FormShow(Sender: TObject);
begin
  SetToolbarHints;
  LoadConfig(Core.XMLConfig1, 'FormClient');
  Core.PersistentForm.Load(Self);
  Core.ThemeManager1.UseTheme(Self);
  UpdateInterface;
  Redraw;
end;

procedure TFormClient.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    if Assigned(Client) then begin
      StartMousePoint := TPoint.Create(X, Y);
      StartViewPoint := Client.View.SourceRect.P1;
      MoveActive := True;
    end;
  end;
end;

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

procedure TFormClient.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Cell: TPlayerCell;
  OldCell: TPlayerCell;
  CellPos: TPoint;
  P: TPoint;
  R: TRect;
begin
  if Assigned(Client) then begin
    P := TPoint.Create(X, Y);
    if MoveActive then
    if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
    (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
    with Client do begin
      View.SourceRect := TRect.CreateBounds(TPoint.Create(
        Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
        Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom)),
        View.SourceRect.Size);
      Redraw;
    end;
    Cell := nil;
    OldCell := Client.View.FocusedCell;
    with Core.Game do
      if Assigned(Client.ControlPlayer) then begin
        if Map.Cyclic then begin
          R := Client.View.CellToCanvasRect(Map.PixelRect);
          CellPos := TPoint.Create(
            ModNeg(P.X - R.P1.X, R.Size.X) + R.P1.X,
            ModNeg(P.Y - R.P1.Y, R.Size.Y) + R.P1.Y
          );
          Cell := Client.ControlPlayer.PlayerMap.PosToCell(
          Client.View.CanvasToCellPos(CellPos));
        end else begin
          Cell := Client.ControlPlayer.PlayerMap.PosToCell(
            Client.View.CanvasToCellPos(P));
        end;
      end;
    if Assigned(Cell) then begin
      Client.View.FocusedCell := Cell;
      StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.MapCell.PosPx.X) + ', ' + IntToStr(Cell.MapCell.PosPx.Y) +
        '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ') ' + IntToStr(Cell.MapCell.Id);
    end else begin
      Client.View.FocusedCell := nil;
      StatusBar1.Panels[0].Text := '';
    end;
    CellPos := Client.View.CanvasToCellPos(TPoint.Create(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 TFormClient.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Abs(StartMousePoint.X - X) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) and
  (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
    if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) and
    (Core.Game.CurrentPlayer = Client.ControlPlayer) then begin
      Client.View.SelectCell(TPoint.Create(X, Y), Client.ControlPlayer, Shift);
      Redraw;
    end;
  end;
  MoveActive := False;
end;

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

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

end.

