CentrED/Client/UfrmLargeScaleCommand.pas

808 lines
24 KiB
Plaintext
Raw Permalink Normal View History

2015-05-01 12:14:15 +02:00
(*
* 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,
2023-01-15 16:37:33 +01:00
laz.VirtualTrees, VirtualList, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin,
LCLIntf, Menus, UPlatformTypes, UEnhancedMemoryStream, UWorldItem;
2015-05-01 12:14:15 +02:00
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;
2023-01-15 16:37:33 +01:00
vdtTerrainTiles: TLazVirtualDrawTree;
vdlTerrainTiles: TVirtualList;
2023-01-15 16:37:33 +01:00
vdtInsertStaticsTiles: TLazVirtualDrawTree;
vdlInsertStaticsTiles: TVirtualList;
2023-01-15 16:37:33 +01:00
vdtDeleteStaticsTiles: TLazVirtualDrawTree;
vdlDeleteStaticsTiles: TVirtualList;
2023-01-15 16:37:33 +01:00
vstActions: TLazVirtualStringTree;
vstArea: TLazVirtualStringTree;
2015-05-01 12:14:15 +02:00
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);
2015-05-01 12:14:15 +02:00
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;
2015-05-01 12:14:15 +02:00
AStream: TEnhancedMemoryStream);
public
{ public declarations }
end;
var
frmLargeScaleCommand: TfrmLargeScaleCommand;
implementation
uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
UGUIPlatformUtils, Language;
2015-05-01 12:14:15 +02:00
type
PNodeInfo = ^TNodeInfo;
TNodeInfo = record
ActionID: Integer;
Caption: String;
end;
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: Word;
ptr: Pointer;
2015-05-01 12:14:15 +02:00
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);
2015-05-01 12:14:15 +02:00
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);
2015-05-01 12:14:15 +02:00
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);
2015-05-01 12:14:15 +02:00
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;
2015-05-01 12:14:15 +02:00
end;
procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject);
begin
vdlInsertStaticsTiles.Clear;
2015-05-01 12:14:15 +02:00
end;
procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject);
begin
vdlTerrainTiles.Clear;
2015-05-01 12:14:15 +02:00
end;
procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject);
begin
vdlDeleteStaticsTiles.DeleteSelectedNodes;
2015-05-01 12:14:15 +02:00
end;
procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject);
begin
vdlInsertStaticsTiles.DeleteSelectedNodes;
2015-05-01 12:14:15 +02:00
end;
procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject);
begin
vdlTerrainTiles.DeleteSelectedNodes;
2015-05-01 12:14:15 +02:00
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);
2015-05-01 12:14:15 +02:00
end else
stream.WriteBoolean(False);
//Delete statics
node := FindNode(3);
if vstActions.CheckState[node] = csCheckedNormal then
begin
stream.WriteBoolean(True);
SerializeTiles(vdlDeleteStaticsTiles, stream);
2015-05-01 12:14:15 +02:00
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);
2015-05-01 12:14:15 +02:00
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;
2015-05-01 12:14:15 +02:00
sourceTileInfo, targetTileInfo: PTileInfo;
begin
SenderTVList := Sender as TVirtualList;
sourceTree := Source as TVirtualList;
if (sourceTree <> Sender) and (sourceTree <> nil) then
2015-05-01 12:14:15 +02:00
begin
SenderTVList.BeginUpdate;
2015-05-01 12:14:15 +02:00
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
2015-05-01 12:14:15 +02:00
begin
node := SenderTVList.AddItem(nil);
targetTileInfo := SenderTVList.GetNodeData(node);
2015-05-01 12:14:15 +02:00
targetTileInfo^.ID := sourceTileInfo^.ID;
end;
selected := sourceTree.GetNextSelected(selected);
end;
SenderTVList.EndUpdate;
2015-05-01 12:14:15 +02:00
end;
end;
procedure TfrmLargeScaleCommand.vdtTerrainTilesDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
2023-01-15 16:37:33 +01:00
if (Source <> Sender) and (Source is TLazVirtualDrawTree) then
2015-05-01 12:14:15 +02:00
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;
2015-05-01 12:14:15 +02:00
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;
2015-05-01 12:14:15 +02:00
AStream: TEnhancedMemoryStream);
var
item: PVirtualItem;
2015-05-01 12:14:15 +02:00
tileInfo: PTileInfo;
begin
AStream.WriteWord(ATileList.RootNodeCount);
item := ATileList.GetFirst;
while item <> nil do
2015-05-01 12:14:15 +02:00
begin
tileInfo := ATileList.GetNodeData(item);
2015-05-01 12:14:15 +02:00
AStream.WriteWord(tileInfo^.ID);
item := ATileList.GetNext(item);
2015-05-01 12:14:15 +02:00
end;
end;
initialization
{$I UfrmLargeScaleCommand.lrs}
end.