CentrED/Client/UfrmLargeScaleCommand.pas

(*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at
 * http://www.opensource.org/licenses/cddl1.php.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
 * add the following below this CDDL HEADER, with the fields enclosed
 * by brackets "[]" replaced with your own identifying * information:
 *      Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 *
 *
 *      Portions Copyright 2008 Andreas Schneider
 *)
unit UfrmLargeScaleCommand;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math,
  VirtualTrees, VirtualList, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin,
  LCLIntf, Menus, UPlatformTypes, UEnhancedMemoryStream, UWorldItem;

type

  TAreaMoveType = (amLeft, amTop, amRight, amBottom);
  TAreaMove = set of TAreaMoveType;

  { TfrmLargeScaleCommand }

  TfrmLargeScaleCommand = class(TForm)
    btnAddArea: TSpeedButton;
    btnClearArea: TSpeedButton;
    btnClearDStaticsTiles: TSpeedButton;
    btnClearIStaticsTiles: TSpeedButton;
    btnClearTerrain: TSpeedButton;
    btnClose: TButton;
    btnDeleteArea: TSpeedButton;
    btnDeleteDStaticsTiles: TSpeedButton;
    btnDeleteIStaticsTiles: TSpeedButton;
    btnDeleteTerrain: TSpeedButton;
    btnExecute: TButton;
    cbCMEraseTarget: TCheckBox;
    gbDrawTerrainTiles: TGroupBox;
    gbDeleteStaticsTiles: TGroupBox;
    gbInserStaticsTiles: TGroupBox;
    gbStaticsProbability: TGroupBox;
    gbStaticsPlacement: TGroupBox;
    GroupBox1: TGroupBox;
    gbCMOffset: TGroupBox;
    Label1: TLabel;
    Label10: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    lblDrawTerrainTilesDesc: TLabel;
    lblDeleteStaticsTilesDesc: TLabel;
    lblInsertStaticsTiles: TLabel;
    lblX: TLabel;
    lblY: TLabel;
    mnuSelectTopLeft: TMenuItem;
    mnuSelectTopRight: TMenuItem;
    mnuSelectBottomLeft: TMenuItem;
    mnuSelectBottomRight: TMenuItem;
    nbActions: TNotebook;
    pgCopyMove: TPage;
    pgDeleteStatics: TPage;
    pgInsertStatics: TPage;
    pgModifyAltitude: TPage;
    pbArea: TPaintBox;
    pgArea: TPage;
    pgDrawTerrain: TPage;
    pmSelectOffset: TPopupMenu;
    rgCMAction: TRadioGroup;
    rbPlaceStaticsOnTerrain: TRadioButton;
    rbPlaceStaticsOnTop: TRadioButton;
    rbPlaceStaticsOnZ: TRadioButton;
    rbSetTerrainAltitude: TRadioButton;
    rbRelativeAltitudeChange: TRadioButton;
    sbArea: TScrollBox;
    seDeleteStaticsZ1: TSpinEdit;
    seDeleteStaticsZ2: TSpinEdit;
    seTerrainAltitude1: TSpinEdit;
    seTerrainAltitude2: TSpinEdit;
    seRelativeAltitude: TSpinEdit;
    seStaticsProbability: TSpinEdit;
    seInsertStaticsZ: TSpinEdit;
    seCMOffsetX: TSpinEdit;
    seCMOffsetY: TSpinEdit;
    seX1: TSpinEdit;
    seX2: TSpinEdit;
    seY1: TSpinEdit;
    seY2: TSpinEdit;
    btnGrab1: TSpeedButton;
    btnGrab2: TSpeedButton;
    btnGrabOffset: TSpeedButton;
    vdtTerrainTiles: TVirtualDrawTree;
    vdlTerrainTiles: TVirtualList;
    vdtInsertStaticsTiles: TVirtualDrawTree;
    vdlInsertStaticsTiles: TVirtualList;
    vdtDeleteStaticsTiles: TVirtualDrawTree;
    vdlDeleteStaticsTiles: TVirtualList;
    vstActions: TVirtualStringTree;
    vstArea: TVirtualStringTree;
    procedure btnGrab1Click(Sender: TObject);
    procedure btnGrabOffsetClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnAddAreaClick(Sender: TObject);
    procedure btnClearDStaticsTilesClick(Sender: TObject);
    procedure btnClearIStaticsTilesClick(Sender: TObject);
    procedure btnClearTerrainClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnDeleteDStaticsTilesClick(Sender: TObject);
    procedure btnDeleteIStaticsTilesClick(Sender: TObject);
    procedure btnDeleteTerrainClick(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuSelectTopLeftClick(Sender: TObject);
    procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure pbAreaPaint(Sender: TObject);
    procedure btnDeleteAreaClick(Sender: TObject);
    procedure btnClearAreaClick(Sender: TObject);
    procedure seX1Change(Sender: TObject);
    procedure vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree; Source: TObject;
      DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
      Pt: TPoint; var Effect: Integer; Mode: TDropMode);
    procedure vdtTerrainTilesDragOver(Sender: TBaseVirtualTree; Source: TObject;
      Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
      var Effect: Integer; var Accept: Boolean);
    procedure vdtTerrainTilesDrawNode(Sender: TBaseVirtualTree;
      const PaintInfo: TVTPaintInfo);
    procedure vstActionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure vstActionsChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure vstActionsGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: String);
    procedure vstActionsPaintText(Sender: TBaseVirtualTree;
      const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      TextType: TVSTTextType);
    procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
    procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
    procedure RenameNode(AActionID: Integer; ACaption: String);
  protected
    FLastX: Integer;
    FLastY: Integer;
    FAreaMove: TAreaMove;
    FAreaNode: PVirtualNode;
    FCopyMoveNode: PVirtualNode;
    FAltitudeNode: PVirtualNode;
    FDrawTerrainNode: PVirtualNode;
    FDelStaticsNode: PVirtualNode;
    FAddStaticsNode: PVirtualNode;
    FSelectFirst: Boolean;
    FOffsetSelection: TObject;
    FOldWindowState: TWindowState;
    function AddNode(AActionID: Integer; ACaption: String): PVirtualNode;
    function FindNode(AActionID: Integer): PVirtualNode;
    procedure TileSelection(AWorldItem: TWorldItem);
    procedure OffsetSelection(AWorldItem: TWorldItem);
    procedure SerializeTiles(ATileList: TVirtualList;
      AStream: TEnhancedMemoryStream);
  public
    { public declarations }
  end;

var
  frmLargeScaleCommand: TfrmLargeScaleCommand;

implementation

uses
  UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
  UGUIPlatformUtils, Language;

type
  PNodeInfo = ^TNodeInfo;
  TNodeInfo = record
    ActionID: Integer;
    Caption: String;
  end;
  PTileInfo = ^TTileInfo;
  TTileInfo = record
    ID: Word;
    ptr: Pointer;
  end;

{ TfrmLargeScaleCommand }

procedure TfrmLargeScaleCommand.FormCreate(Sender: TObject);
begin
  vdlTerrainTiles := TVirtualList.Create(vdtTerrainTiles);
  vdtTerrainTiles := vdlTerrainTiles;
  vdlInsertStaticsTiles := TVirtualList.Create(vdtInsertStaticsTiles);
  vdtInsertStaticsTiles := vdlInsertStaticsTiles;
  vdlDeleteStaticsTiles := TVirtualList.Create(vdtDeleteStaticsTiles);
  vdtDeleteStaticsTiles := vdlDeleteStaticsTiles;

  LanguageTranslate(Self);

  vstActions.NodeDataSize := SizeOf(TNodeInfo);
  FAreaNode        := AddNode(-1, pgArea.Caption);
  FCopyMoveNode    := AddNode( 0, pgCopyMove.Caption);
  FAltitudeNode    := AddNode( 1, pgModifyAltitude.Caption);
  FDrawTerrainNode := AddNode( 2, pgDrawTerrain.Caption);
  FDelStaticsNode  := AddNode( 3, pgDeleteStatics.Caption);
  FAddStaticsNode  := AddNode( 4, pgInsertStatics.Caption);
  vstActions.Selected[vstActions.GetFirst] := True;

  vstArea.NodeDataSize := SizeOf(TRect);

  pbArea.Width := frmRadarMap.Radar.Width;
  pbArea.Height := frmRadarMap.Radar.Height;
  seX1.MaxValue := ResMan.Landscape.CellWidth;
  seX2.MaxValue := ResMan.Landscape.CellWidth;
  seY1.MaxValue := ResMan.Landscape.CellHeight;
  seY2.MaxValue := ResMan.Landscape.CellHeight;

  vdlTerrainTiles.NodeDataSize := SizeOf(TTileInfo);
  vdlInsertStaticsTiles.NodeDataSize := SizeOf(TTileInfo);
  vdlDeleteStaticsTiles.NodeDataSize := SizeOf(TTileInfo);

  seCMOffsetX.MinValue := -ResMan.Landscape.CellWidth;
  seCMOffsetX.MaxValue := ResMan.Landscape.CellWidth;
  seCMOffsetY.MinValue := -ResMan.Landscape.CellHeight;
  seCMOffsetY.MaxValue := ResMan.Landscape.CellHeight;

  frmRadarMap.Dependencies.Add(pbArea);
end;

procedure TfrmLargeScaleCommand.FormDestroy(Sender: TObject);
begin
  frmRadarMap.Dependencies.Remove(pbArea);
end;

procedure TfrmLargeScaleCommand.mnuSelectTopLeftClick(Sender: TObject);
begin
  FOffsetSelection := Sender;
  frmMain.RegisterSelectionListener(@OffsetSelection);
  FOldWindowState := WindowState;
  WindowState := wsMinimized;
  frmMain.SwitchToSelection;
end;

procedure TfrmLargeScaleCommand.pbAreaMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  node, match: PVirtualNode;
  nodeInfo: ^TRect;
  p: TPoint;
begin
  FAreaMove := [];
  p := Point(X * 8, Y * 8);
  match := nil;
  node := vstArea.GetFirst;
  while node <> nil do
  begin
    nodeInfo := vstArea.GetNodeData(node);
    if PtInRect(nodeInfo^, p) then
      match := node;
    node := vstArea.GetNext(node);
  end;
  if match <> nil then
  begin
    nodeInfo := vstArea.GetNodeData(match);
    if p.x - nodeInfo^.Left <= 64 then Include(FAreaMove, amLeft);
    if p.y - nodeInfo^.Top <= 64 then Include(FAreaMove, amTop);
    if nodeInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
    if nodeInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
    if FAreaMove = [] then
      FAreaMove := [amLeft, amTop, amRight, amBottom];
  end else
  begin
    match := vstArea.AddChild(nil);
    nodeInfo := vstArea.GetNodeData(match);
    nodeInfo^.Left := p.x;
    nodeInfo^.Top := p.y;
    nodeInfo^.Right := p.x;
    nodeInfo^.Bottom := p.y;
    FAreaMove := [amRight, amBottom];
  end;
  vstArea.ClearSelection;
  vstArea.Selected[match] := True;
  FLastX := X;
  FLastY := Y;
end;

procedure TfrmLargeScaleCommand.pbAreaMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  offsetX, offsetY: Integer;
begin
  if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
  begin
    offsetX := (X - FLastX) * 8;
    offsetY := (Y - FLastY) * 8;
    if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
    if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
    if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
    if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
    FLastX := X;
    FLastY := Y;
    seX1Change(nil);
  end;
end;

procedure TfrmLargeScaleCommand.btnAddAreaClick(Sender: TObject);
var
  node: PVirtualNode;
  nodeInfo: ^TRect;
begin
  node := vstArea.AddChild(nil);
  nodeInfo := vstArea.GetNodeData(node);
  nodeInfo^.Left := 0;
  nodeInfo^.Top := 0;
  nodeInfo^.Right := 0;
  nodeInfo^.Bottom := 0;
  vstArea.ClearSelection;
  vstArea.Selected[node] := True;
  vstArea.FocusedNode := node;
end;

procedure TfrmLargeScaleCommand.FormShow(Sender: TObject);
begin
  SetWindowParent(Handle, frmMain.Handle);
end;

procedure TfrmLargeScaleCommand.btnGrab1Click(Sender: TObject);
begin
  FSelectFirst := (Sender = btnGrab1);
  frmMain.RegisterSelectionListener(@TileSelection);
  FOldWindowState := WindowState;
  WindowState := wsMinimized;
  frmMain.SwitchToSelection;
end;

procedure TfrmLargeScaleCommand.btnGrabOffsetClick(Sender: TObject);
begin
  pmSelectOffset.PopUp;
end;

procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject);
begin
  vdlDeleteStaticsTiles.Clear;
end;

procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject);
begin
  vdlInsertStaticsTiles.Clear;
end;

procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject);
begin
  vdlTerrainTiles.Clear;
end;

procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject);
begin
  vdlDeleteStaticsTiles.DeleteSelectedNodes;
end;

procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject);
begin
  vdlInsertStaticsTiles.DeleteSelectedNodes;
end;

procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject);
begin
  vdlTerrainTiles.DeleteSelectedNodes;
end;

procedure TfrmLargeScaleCommand.btnExecuteClick(Sender: TObject);
var
  packet: TPacket;
  stream: TEnhancedMemoryStream;
  areaCount: Byte;
  i: Integer;
  node: PVirtualNode;
  areaInfo: ^TRect;
begin
  packet := TPacket.Create($0E, 0);
  stream := packet.Stream;
  stream.Position := stream.Size;

  //Area
  areaCount := Min(vstArea.RootNodeCount, 255);
  stream.WriteByte(areaCount);
  if areaCount = 0 then Exit;
  i := 0;
  node := vstArea.GetFirst;
  while (node <> nil) and (i < areaCount) do
  begin
    areaInfo := vstArea.GetNodeData(node);
    stream.WriteWord(Min(areaInfo^.Left, areaInfo^.Right));
    stream.WriteWord(Min(areaInfo^.Top, areaInfo^.Bottom));
    stream.WriteWord(Max(areaInfo^.Left, areaInfo^.Right));
    stream.WriteWord(Max(areaInfo^.Top, areaInfo^.Bottom));
    node := vstArea.GetNext(node);
    Inc(i);
  end;

  //Copy/Move
  node := FindNode(0);
  if vstActions.CheckState[node] = csCheckedNormal then
  begin
    stream.WriteBoolean(True);
    stream.WriteByte(rgCMAction.ItemIndex);
    stream.WriteInteger(seCMOffsetX.Value);
    stream.WriteInteger(seCMOffsetY.Value);
    stream.WriteBoolean(cbCMEraseTarget.Checked);
  end else
    stream.WriteBoolean(False);

  //Modify altitude
  node := FindNode(1);
  if vstActions.CheckState[node] = csCheckedNormal then
  begin
    stream.WriteBoolean(True);
    if rbSetTerrainAltitude.Checked then
    begin
      stream.WriteByte(1);
      stream.WriteShortInt(Min(seTerrainAltitude1.Value, seTerrainAltitude2.Value));
      stream.WriteShortInt(Max(seTerrainAltitude1.Value, seTerrainAltitude2.Value));
    end else
    begin
      stream.WriteByte(2);
      stream.WriteShortInt(seRelativeAltitude.Value);
    end;
  end else
    stream.WriteBoolean(False);

  //Draw terrain
  node := FindNode(2);
  if vstActions.CheckState[node] = csCheckedNormal then
  begin
    stream.WriteBoolean(True);
    SerializeTiles(vdlTerrainTiles, stream);
  end else
    stream.WriteBoolean(False);

  //Delete statics
  node := FindNode(3);
  if vstActions.CheckState[node] = csCheckedNormal then
  begin
    stream.WriteBoolean(True);
    SerializeTiles(vdlDeleteStaticsTiles, stream);
    stream.WriteShortInt(Min(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value));
    stream.WriteShortInt(Max(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value));
  end else
    stream.WriteBoolean(False);

  //Insert statics
  node := FindNode(4);
  if vstActions.CheckState[node] = csCheckedNormal then
  begin
    stream.WriteBoolean(True);
    SerializeTiles(vdlInsertStaticsTiles, stream);
    stream.WriteByte(seStaticsProbability.Value);
    if rbPlaceStaticsOnZ.Checked then
    begin
      stream.WriteByte(3);
      stream.WriteShortInt(seInsertStaticsZ.Value);
    end else if rbPlaceStaticsOnTerrain.Checked then
      stream.WriteByte(1)
    else
      stream.WriteByte(2);
  end else
    stream.WriteBoolean(False);

  dmNetwork.Send(TCompressedPacket.Create(packet));
  Close;
end;

procedure TfrmLargeScaleCommand.pbAreaPaint(Sender: TObject);
var
  node: PVirtualNode;
  nodeInfo: ^TRect;
  showMoveTarget: Boolean;
begin
  showMoveTarget := FCopyMoveNode^.CheckState = csCheckedNormal;

  DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
  pbArea.Canvas.Pen.Color := clRed;
  pbArea.Canvas.Brush.Color := clMaroon;
  pbArea.Canvas.Brush.Style := bsFDiagonal;
  node := vstArea.GetFirst;
  while node <> nil do
  begin
    nodeInfo := vstArea.GetNodeData(node);
    if vstArea.Selected[node] then
    begin
      pbArea.Canvas.Pen.Width := 2;
      pbArea.Canvas.Pen.Style := psSolid;
    end else
    begin
      pbArea.Canvas.Pen.Width := 1;
      pbArea.Canvas.Pen.Style := psDot;
    end;

    pbArea.Canvas.Brush.Style := bsFDiagonal;
    pbArea.Canvas.Pen.Color := clRed;
    pbArea.Canvas.Brush.Color := clMaroon;
    pbArea.Canvas.Rectangle(nodeInfo^.Left div 8, nodeInfo^.Top div 8,
      nodeInfo^.Right div 8 + 1, nodeInfo^.Bottom div 8 + 1);

    if showMoveTarget then
    begin
      pbArea.Canvas.Brush.Style := bsBDiagonal;
      pbArea.Canvas.Pen.Color := clBlue;
      pbArea.Canvas.Brush.Color := clNavy;
      pbArea.Canvas.Rectangle((nodeInfo^.Left + seCMOffsetX.Value) div 8,
        (nodeInfo^.Top + seCMOffsetY.Value) div 8,
        (nodeInfo^.Right + seCMOffsetX.Value) div 8 + 1,
        (nodeInfo^.Bottom + seCMOffsetY.Value) div 8 + 1);
    end;

    node := vstArea.GetNext(node);
  end;
end;

procedure TfrmLargeScaleCommand.btnDeleteAreaClick(Sender: TObject);
begin
  vstArea.DeleteSelectedNodes;
  vstAreaChange(vstArea, nil);
end;

procedure TfrmLargeScaleCommand.btnClearAreaClick(Sender: TObject);
begin
  vstArea.Clear;
  vstAreaChange(vstArea, nil);
end;

procedure TfrmLargeScaleCommand.seX1Change(Sender: TObject);
var
  node: PVirtualNode;
  nodeInfo: ^TRect;
begin
  node := vstArea.GetFirstSelected;
  if node <> nil then
  begin
    nodeInfo := vstArea.GetNodeData(node);
    nodeInfo^.Left := seX1.Value;
    nodeInfo^.Right := seX2.Value;
    nodeInfo^.Top := seY1.Value;
    nodeInfo^.Bottom := seY2.Value;
    vstArea.InvalidateNode(node);
    pbArea.Repaint;
  end;
end;

procedure TfrmLargeScaleCommand.vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree;
  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
  SenderTVList: TVirtualList;
  sourceTree: TVirtualList;
  selected: PVirtualItem;
  node: PVirtualItem;
  sourceTileInfo, targetTileInfo: PTileInfo;
begin
  SenderTVList := Sender as TVirtualList;
  sourceTree := Source as TVirtualList;
  if (sourceTree <> Sender) and (sourceTree <> nil) then
  begin
    SenderTVList.BeginUpdate;
    selected := sourceTree.GetFirstSelected;
    while selected <> nil do
    begin
      sourceTileInfo := sourceTree.GetNodeData(selected);
      if ((Sender = vdlTerrainTiles) and (sourceTileInfo^.ID < $4000)) or
         ((Sender = vdlInsertStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) or
         ((Sender = vdlDeleteStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) then
      begin
        node := SenderTVList.AddItem(nil);
        targetTileInfo := SenderTVList.GetNodeData(node);
        targetTileInfo^.ID := sourceTileInfo^.ID;
      end;
      selected := sourceTree.GetNextSelected(selected);
    end;
    SenderTVList.EndUpdate;
  end;
end;

procedure TfrmLargeScaleCommand.vdtTerrainTilesDragOver(Sender: TBaseVirtualTree;
  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
  Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
  if (Source <> Sender) and (Source is TVirtualDrawTree) then
  begin
    Accept := True;
  end;
end;

procedure TfrmLargeScaleCommand.vdtTerrainTilesDrawNode(
  Sender: TBaseVirtualTree; const PaintInfo: TVTPaintInfo);
begin
  frmMain.vdtTilesDrawNode(Sender, PaintInfo);
end;

procedure TfrmLargeScaleCommand.vstActionsChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  nodeInfo: PNodeInfo;
begin
  if Sender.Selected[Node] then
  begin
    nodeInfo := Sender.GetNodeData(Node);
    nbActions.PageIndex := nodeInfo^.ActionID + 1;
  end;
end;

procedure TfrmLargeScaleCommand.vstActionsChecked(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
begin
  if Node = FCopyMoveNode then
    pbArea.Repaint;
end;

procedure TfrmLargeScaleCommand.vstActionsGetText(
  Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType; var CellText: String);
var
  nodeInfo: PNodeInfo;
begin
  nodeInfo := Sender.GetNodeData(Node);
  CellText := nodeInfo^.Caption;
end;

procedure TfrmLargeScaleCommand.vstActionsPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
begin
  if Sender.Selected[Node] then
    TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
end;

procedure TfrmLargeScaleCommand.vstAreaChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  nodeInfo: ^TRect;
  selected: Boolean;
begin
  selected := (Node <> nil) and Sender.Selected[Node];
  btnDeleteArea.Enabled := selected;
  lblX.Enabled := selected;
  lblY.Enabled := selected;
  seX1.Enabled := selected;
  seX2.Enabled := selected;
  seY1.Enabled := selected;
  seY2.Enabled := selected;
  btnGrab1.Enabled := selected;
  btnGrab2.Enabled := selected;
  btnGrabOffset.Enabled := selected;
  if selected then
  begin
    nodeInfo := Sender.GetNodeData(Node);
    seX1.Value := nodeInfo^.Left;
    seX2.Value := nodeInfo^.Right;
    seY1.Value := nodeInfo^.Top;
    seY2.Value := nodeInfo^.Bottom;
  end;
  pbArea.Repaint;
end;

procedure TfrmLargeScaleCommand.vstAreaGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: String);
var
  nodeInfo: ^TRect;
begin
  nodeInfo := Sender.GetNodeData(Node);
  CellText := Format('(%d, %d), (%d, %d)', [nodeInfo^.Left, nodeInfo^.Top,
    nodeInfo^.Right, nodeInfo^.Bottom]);
end;

function TfrmLargeScaleCommand.AddNode(AActionID: Integer;
  ACaption: String): PVirtualNode;
var
  node: PVirtualNode;
  nodeInfo: PNodeInfo;
begin
  node := vstActions.AddChild(nil);
  nodeInfo := vstActions.GetNodeData(node);
  nodeInfo^.ActionID := AActionID;
  nodeInfo^.Caption := ACaption;
  if AActionID > -1 then
    vstActions.CheckType[node] := ctCheckBox;

  Result := node;
end;

function TfrmLargeScaleCommand.FindNode(AActionID: Integer): PVirtualNode;
var
  node: PVirtualNode;
  nodeInfo: PNodeInfo;
begin
  Result := nil;
  node := vstActions.GetFirst;
  while (node <> nil) and (Result = nil) do
  begin
    nodeInfo := vstActions.GetNodeData(node);
    if nodeInfo^.ActionID = AActionID then
      Result := node;
    node := vstActions.GetNext(node);
  end;
end;

procedure TfrmLargeScaleCommand.RenameNode(AActionID: Integer; ACaption: String);
var
  nodeInfo: PNodeInfo;
begin
  nodeInfo := vstActions.GetNodeData(FindNode(AActionID));
  if (nodeInfo = nil) then exit;
  nodeInfo^.Caption := ACaption;
  vstActions.Repaint;
end;

procedure TfrmLargeScaleCommand.TileSelection(AWorldItem: TWorldItem);
begin
  if FSelectFirst then
  begin
    seX1.Value := AWorldItem.X;
    seY1.Value := AWorldItem.Y;
  end else
  begin
    seX2.Value := AWorldItem.X;
    seY2.Value := AWorldItem.Y;
  end;
  seX1Change(nil);
  frmMain.UnregisterSelectionListener(@TileSelection);
  WindowState := FOldWindowState;
end;

procedure TfrmLargeScaleCommand.OffsetSelection(AWorldItem: TWorldItem);
begin
  if FOffsetSelection = mnuSelectTopLeft then
  begin
    seCMOffsetX.Value := AWorldItem.X - Min(seX1.Value, seX2.Value);
    seCMOffsetY.Value := AWorldItem.Y - Min(seY1.Value, seY2.Value);
  end else
  if FOffsetSelection = mnuSelectTopRight then
  begin
    seCMOffsetX.Value := AWorldItem.X - Max(seX1.Value, seX2.Value);
    seCMOffsetY.Value := AWorldItem.Y - Min(seY1.Value,seY2.Value);
  end else
  if FOffsetSelection = mnuSelectBottomLeft then
  begin
    seCMOffsetX.Value := AWorldItem.X - Min(seX1.Value, seX2.Value);
    seCMOffsetY.Value := AWorldItem.Y - Max(seY1.Value, seY2.Value);
  end else
  if FOffsetSelection = mnuSelectBottomRight then
  begin
    seCMOffsetX.Value := AWorldItem.X - Max(seX1.Value, seX2.Value);
    seCMOffsetY.Value := AWorldItem.Y - Max(seY1.Value, seY2.Value);
  end;
  frmMain.UnregisterSelectionListener(@OffsetSelection);
  WindowState := FOldWindowState;
end;

procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualList;
  AStream: TEnhancedMemoryStream);
var
  item: PVirtualItem;
  tileInfo: PTileInfo;
begin
  AStream.WriteWord(ATileList.RootNodeCount);
  item := ATileList.GetFirst;
  while item <> nil do
  begin
    tileInfo := ATileList.GetNodeData(item);
    AStream.WriteWord(tileInfo^.ID);
    item := ATileList.GetNext(item);
  end;
end;

initialization
  {$I UfrmLargeScaleCommand.lrs}

end.