(* * 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.