- Fixed/Removed some compiler warnings and hints

- Some more syntactic changes to UfrmRegionControl.pas
- Implemented region modification and deletion
- Changed the server side region handling to broadcast the changes
- Added safer admin packet registration
- Added some more units to the project files
This commit is contained in:
2008-08-23 23:09:20 +02:00
parent 49e095a83f
commit 85cc0c0066
20 changed files with 1394 additions and 1237 deletions

View File

@@ -30,9 +30,9 @@ unit UfrmRegionControl;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst,
Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
math, UPlatformTypes, UEnhancedMemoryStream, Menus, contnrs, URectList;
UEnhancedMemoryStream, Menus, URectList;
type
TAreaMoveType = (amLeft, amTop, amRight, amBottom);
@@ -44,7 +44,7 @@ type
btnAddArea: TSpeedButton;
btnClearArea: TSpeedButton;
btnDeleteArea: TSpeedButton;
btnExit: TButton;
btnClose: TButton;
btnSave: TButton;
Label1: TLabel;
lblX: TLabel;
@@ -64,8 +64,8 @@ type
seY2: TSpinEdit;
vstRegions: TVirtualStringTree;
vstArea: TVirtualStringTree;
procedure acAddGroup(Sender: TObject);
procedure accRemoveGroup(Sender: TObject);
procedure mnuAddRegionClick(Sender: TObject);
procedure mnuRemoveRegionClick(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject);
procedure btnClearAreaClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
@@ -87,14 +87,13 @@ type
procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstRegionsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; const NewText: WideString);
procedure vstRegionsOnEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
protected
FLastX: Integer;
FLastY: Integer;
FAreaMove: TAreaMove;
function FindRegion(AName: string): PVirtualNode;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
private
{ private declarations }
@@ -108,33 +107,520 @@ var
implementation
uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
UGUIPlatformUtils, UAdminHandling, UPacketHandlers;
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
UAdminHandling, UPacketHandlers;
type
{ TRequestRegionListPacket }
TRequestRegionListPacket = class(TPacket)
constructor Create;
end;
PRegionInfo = ^TRegionInfo;
TRegionInfo = record
Name: string;
Areas: TRectList;
end;
{ TModifyRegionPacket }
TModifyRegionPacket = class(TPacket)
constructor Create(ARegionInfo: TRegionInfo);
end;
{ TDeleteRegionPacket }
TDeleteRegionPacket = class(TPacket)
constructor Create(AName: string);
end;
{ TRequestRegionListPacket }
TRequestRegionListPacket = class(TPacket)
constructor Create;
end;
{ TModifyRegionPacket }
constructor TModifyRegionPacket.Create(ARegionInfo: TRegionInfo);
var
i: Integer;
count: Byte;
area: TRect;
begin
inherited Create($03, 0); //Admin Packet
FStream.WriteByte($08); //Admin PacketID
FStream.WriteStringNull(ARegionInfo.Name);
count := Min(ARegionInfo.Areas.Count, 256);
FStream.WriteByte(count);
for i := 0 to count - 1 do
begin
area := ARegionInfo.Areas.Rects[i];
FStream.WriteWord(area.Left);
FStream.WriteWord(area.Top);
FStream.WriteWord(area.Right);
FStream.WriteWord(area.Bottom);
end;
end;
{ TDeleteRegionPacket }
constructor TDeleteRegionPacket.Create(AName: string);
begin
inherited Create($03, 0); //Admin Packet
FStream.WriteByte($09); //Admin PacketID
FStream.WriteStringNull(AName);
end;
{ TRequestRegionListPacket }
constructor TRequestRegionListPacket.Create;
begin
inherited Create($03, 0);
FStream.WriteByte($0A);
inherited Create($03, 0); //Admin Packet
FStream.WriteByte($0A); //Admin PacketID
end;
{ TfrmRegionControl }
procedure TfrmRegionControl.FormCreate(Sender: TObject);
begin
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;
vstArea.NodeDataSize := SizeOf(TRect);
vstRegions.NodeDataSize := SizeOf(TRegionInfo);
frmRadarMap.Dependencies.Add(pbArea);
AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket));
AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket));
AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket));
end;
procedure TfrmRegionControl.FormDestroy(Sender: TObject);
begin
frmRadarMap.Dependencies.Remove(pbArea);
if AdminPacketHandlers[$08] <> nil then FreeAndNil(AdminPacketHandlers[$08]);
if AdminPacketHandlers[$09] <> nil then FreeAndNil(AdminPacketHandlers[$09]);
if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
end;
procedure TfrmRegionControl.FormShow(Sender: TObject);
begin
SetWindowParent(Handle, frmMain.Handle);
btnSave.Enabled := False; //no changes yet
dmNetwork.Send(TRequestRegionListPacket.Create);
end;
procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
areaNode: PVirtualNode;
areaInfo: PRect;
begin
btnSave.Enabled := False;
//Refresh the current region
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Areas.Clear;
areaNode := vstArea.GetFirst;
while areaNode <> nil do
begin
areaInfo := vstArea.GetNodeData(areaNode);
regionInfo^.Areas.Add(areaInfo^.Left, areaInfo^.Top, areaInfo^.Right,
areaInfo^.Bottom);
areaNode := vstArea.GetNext(areaNode);
end;
//Send the modified values
dmNetwork.Send(TModifyRegionPacket.Create(regionInfo^));
end;
//Clear the selection
vstRegions.ClearSelection;
end;
procedure TfrmRegionControl.mnuAddRegionClick(Sender: TObject);
var
regionName: string;
node: PVirtualNode;
regionInfo: PRegionInfo;
begin
regionName := '';
if InputQuery('New Region', 'Enter the name for the new region:', regionName) then
begin
if FindRegion(regionName) = nil then
begin
node := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(node);
regionInfo^.Name := regionName;
regionInfo^.Areas := TRectList.Create;
vstRegions.ClearSelection;
vstRegions.Selected[node] := True;
btnSave.Enabled := True;
end else
begin
MessageDlg('New Region', 'The region could not be added. A region with ' +
'that name already exists.', mtError, [mbOK], 0);
end;
end;
end;
procedure TfrmRegionControl.mnuRemoveRegionClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
begin
regionNode := vstRegions.GetFirstSelected;
if (regionNode <> nil) and (MessageDlg('Delete Region', 'Are you sure, you ' +
'want to delete the selected region?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name));
vstRegions.Selected[regionNode] := False;
end;
end;
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
var
node: PVirtualNode;
areaInfo: PRect;
begin
node := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := 0;
areaInfo^.Top := 0;
areaInfo^.Right := 0;
areaInfo^.Bottom := 0;
vstArea.ClearSelection;
vstArea.Selected[node] := True;
vstArea.FocusedNode := node;
btnSave.Enabled := True; //possible change to be saved
end;
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
begin
vstArea.Clear;
vstAreaChange(vstArea, nil);
end;
procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
begin
if btnSave.Enabled and (MessageDlg('Unsaved changes', 'There are unsaved ' +
'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
btnSaveClick(Sender);
end;
Close;
end;
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
begin
vstArea.DeleteSelectedNodes;
vstAreaChange(vstArea, nil);
btnSave.Enabled := True; //possible change to be saved
end;
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
areaNode, match: PVirtualNode;
areaInfo: PRect;
p: TPoint;
begin
FAreaMove := [];
p := Point(X * 8, Y * 8);
match := nil;
areaNode := vstArea.GetFirst;
while areaNode <> nil do //find the last matching area
begin
areaInfo := vstArea.GetNodeData(areaNode);
if PtInRect(areaInfo^, p) then
match := areaNode;
areaNode := vstArea.GetNext(areaNode);
end;
if match <> nil then
begin
areaInfo := vstArea.GetNodeData(match);
if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
if FAreaMove = [] then
FAreaMove := [amLeft, amTop, amRight, amBottom];
end else
begin
match := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(match);
areaInfo^.Left := p.x;
areaInfo^.Top := p.y;
areaInfo^.Right := p.x;
areaInfo^.Bottom := p.y;
pbArea.Repaint;
FAreaMove := [amRight, amBottom];
end;
vstArea.ClearSelection;
vstArea.Selected[match] := True;
FLastX := X;
FLastY := Y;
end;
procedure TfrmRegionControl.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 TfrmRegionControl.pbAreaPaint(Sender: TObject);
var
node: PVirtualNode;
areaInfo: PRect;
begin
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
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;
areaInfo := vstArea.GetNodeData(node);
pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
node := vstArea.GetNext(node);
end;
end;
procedure TfrmRegionControl.seX1Change(Sender: TObject);
var
node: PVirtualNode;
areaInfo: PRect;
begin
node := vstArea.GetFirstSelected;
if node <> nil then
begin
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := seX1.Value;
areaInfo^.Right := seX2.Value;
areaInfo^.Top := seY1.Value;
areaInfo^.Bottom := seY2.Value;
vstArea.InvalidateNode(node);
pbArea.Repaint;
btnSave.Enabled := True; //possible change to be saved
end;
end;
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
areaInfo: PRect;
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;
if selected then
begin
areaInfo := Sender.GetNodeData(Node);
seX1.Value := areaInfo^.Left;
seX2.Value := areaInfo^.Right;
seY1.Value := areaInfo^.Top;
seY2.Value := areaInfo^.Bottom;
end;
pbArea.Repaint;
end;
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
areaInfo: PRect;
begin
areaInfo := Sender.GetNodeData(Node);
CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
areaInfo^.Right, areaInfo^.Bottom]);
end;
procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
i: Integer;
selected, areaNode: PVirtualNode;
regionInfo: PRegionInfo;
areaInfo: PRect;
begin
if btnSave.Enabled and (MessageDlg('Unsaved changes', 'There are unsaved ' +
'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin
btnSaveClick(Sender);
end;
vstArea.BeginUpdate;
vstArea.Clear;
selected := Sender.GetFirstSelected;
if selected <> nil then
begin
btnAddArea.Enabled := True;
btnClearArea.Enabled := True;
mnuRemoveRegion.Enabled := True;
regionInfo := Sender.GetNodeData(selected);
for i := 0 to regionInfo^.Areas.Count - 1 do
begin
areaNode := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(areaNode);
with regionInfo^.Areas.Rects[i] do
begin
areaInfo^.Left := Left;
areaInfo^.Top := Top;
areaInfo^.Right := Right;
areaInfo^.Bottom := Bottom;
end;
end;
end else
begin
btnAddArea.Enabled := False;
btnDeleteArea.Enabled := False;
btnClearArea.Enabled := False;
mnuRemoveRegion.Enabled := False;
end;
vstArea.EndUpdate;
pbArea.Repaint;
btnSave.Enabled := False; //no changes to be saved
end;
procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
end;
procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
CellText := regionInfo^.Name;
end;
function TfrmRegionControl.FindRegion(AName: string): PVirtualNode;
var
regionInfo: PRegionInfo;
found: Boolean;
begin
found := False;
Result := vstRegions.GetFirst;
while (Result <> nil) and (not found) do
begin
regionInfo := vstRegions.GetNodeData(Result);
if regionInfo^.Name = AName then
found := True
else
Result := vstRegions.GetNext(Result);
end;
end;
procedure TfrmRegionControl.OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
var
regionName: string;
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
areaCount: Byte;
i: Integer;
x1, y1, x2, y2: Word;
begin
ABuffer.ReadByte; //status, not used yet
//TODO : Ask user how to proceed, if the added/modified packet conflicts with the currently edited region
regionName := ABuffer.ReadStringNull;
regionNode := FindRegion(regionName);
if regionNode = nil then
begin
regionNode := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Name := regionName;
regionInfo^.Areas := TRectList.Create;
end else
begin
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Areas.Clear;
end;
areaCount := ABuffer.ReadByte;
for i := 0 to areaCount - 1 do
begin
x1 := ABuffer.ReadWord;
y1 := ABuffer.ReadWord;
x2 := ABuffer.ReadWord;
y2 := ABuffer.ReadWord;
regionInfo^.Areas.Add(x1, y1, x2, y2);
end;
if vstRegions.Selected[regionNode] then
begin
btnSave.Enabled := False;
vstRegionsChange(vstRegions, regionNode);
end;
end;
procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
var
regionName: string;
regionNode: PVirtualNode;
begin
ABuffer.ReadByte; //status, not used yet
regionName := ABuffer.ReadStringNull;
regionNode := FindRegion(regionName);
//TODO : Ask user how to proceed, if the deleted packet conflicts with the currently edited region
if regionNode <> nil then
vstRegions.DeleteNode(regionNode);
end;
procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
var
regionCount, areaCount: Byte;
@@ -164,375 +650,6 @@ begin
vstRegions.EndUpdate;
end;
procedure TfrmRegionControl.FormCreate(Sender: TObject);
begin
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;
vstArea.NodeDataSize := SizeOf(TRect);
vstRegions.NodeDataSize := SizeOf(TRegionInfo);
frmRadarMap.Dependencies.Add(pbArea);
AdminPacketHandlers[$0A] := TPacketHandler.Create(0, @OnListRegionsPacket);
end;
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
var
infoGroup: PRegionInfo;
i: Integer;
begin
if vstRegions.GetFirstSelected <> nil then
begin
infoGroup := vstRegions.GetNodeData(vstRegions.GetFirstSelected);
infoGroup^.Areas.Delete(vstArea.AbsoluteIndex(vstArea.GetFirstSelected));
vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
end;
end;
procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
var
packet: TPacket;
stream: TEnhancedMemoryStream;
groupCount,areaCount: Byte;
i, j: Integer;
node: PVirtualNode;
groupInfo: PRegionInfo;
begin
packet := TPacket.Create($03, 0);
stream := packet.Stream;
stream.Position := stream.Size;
stream.WriteByte($09);
groupCount := Min(vstRegions.RootNodeCount, 255);
stream.WriteByte(groupCount);
if groupCount = 0 then Exit;
i := 0;
node := vstRegions.GetFirst;
while (node <> nil) and (i < groupCount) do
begin
groupInfo := vstRegions.GetNodeData(node);
stream.WriteStringNull(groupInfo^.Name);
areaCount:=Min(groupInfo^.Areas.Count,255);
stream.WriteByte(areaCount);
for j := 0 to areaCount-1 do
with groupInfo^.Areas.Rects[j] do
begin
stream.WriteWord(Min(Left, Right));
stream.WriteWord(Min(Top, Bottom));
stream.WriteWord(Max(Left, Right));
stream.WriteWord(Max(Top, Bottom));
end;
node := vstRegions.GetNext(node);
Inc(i);
end;
dmNetwork.Send(TCompressedPacket.Create(packet));
Close;
end;
procedure TfrmRegionControl.acAddGroup(Sender: TObject);
var
node : PVirtualNode;
infoGroup : PRegionInfo;
begin
node := vstRegions.AddChild(nil);
infoGroup := vstRegions.GetNodeData(node);
infoGroup^.Name := 'Unnamed';
infoGroup^.Areas := TRectList.Create;
end;
procedure TfrmRegionControl.accRemoveGroup(Sender: TObject);
begin
vstRegions.DeleteSelectedNodes;
vstRegionsChange(vstRegions, nil);
end;
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
var
node, selected: PVirtualNode;
areaInfo: ^TRect;
regionInfo: PRegionInfo;
begin
selected := vstRegions.GetFirstSelected;
if selected <> nil then
begin
regionInfo := vstRegions.GetNodeData(selected);
node := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := 0;
areaInfo^.Top := 0;
areaInfo^.Right := 0;
areaInfo^.Bottom := 0;
regionInfo^.Areas.Add(0, 0, 0, 0);
vstArea.ClearSelection;
vstArea.Selected[node] := True;
vstArea.FocusedNode := node;
end;
end;
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
i: Integer;
begin
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
regionInfo^.Areas.Clear;
vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
end;
end;
procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmRegionControl.FormDestroy(Sender: TObject);
begin
frmRadarMap.Dependencies.Remove(pbArea);
if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
end;
procedure TfrmRegionControl.FormShow(Sender: TObject);
begin
SetWindowParent(Handle, frmMain.Handle);
dmNetwork.Send(TRequestRegionListPacket.Create);
end;
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
areaNode, regionNode, match: PVirtualNode;
areaInfo: ^TRect;
p: TPoint;
i: Integer;
regionInfo: PRegionInfo;
begin
FAreaMove := [];
p := Point(X * 8, Y * 8);
match := nil;
areaNode := vstArea.GetFirst;
while areaNode <> nil do //find the last matching area
begin
areaInfo := vstArea.GetNodeData(areaNode);
if PtInRect(areaInfo^, p) then
match := areaNode;
areaNode := vstArea.GetNext(areaNode);
end;
if match <> nil then
begin
areaInfo := vstArea.GetNodeData(match);
if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
if FAreaMove = [] then
FAreaMove := [amLeft, amTop, amRight, amBottom];
end else
begin
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
match := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(match);
areaInfo^.Left := p.x;
areaInfo^.Top := p.y;
areaInfo^.Right := p.x;
areaInfo^.Bottom := p.y;
regionInfo^.Areas.Add(p.x, p.y, p.x, p.y);
pbArea.Repaint;
FAreaMove := [amRight, amBottom];
end;
end;
vstArea.ClearSelection;
vstArea.Selected[match] := True;
FLastX := X;
FLastY := Y;
end;
procedure TfrmRegionControl.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 TfrmRegionControl.pbAreaPaint(Sender: TObject);
var
i: Integer;
node: PVirtualNode;
areaInfo: ^TRect;
begin
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
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;
areaInfo := vstArea.GetNodeData(node);
pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
node := vstArea.GetNext(node);
end;
end;
procedure TfrmRegionControl.seX1Change(Sender: TObject);
var
node: PVirtualNode;
areaInfo: ^TRect;
regionInfo: PRegionInfo;
begin
node := vstArea.GetFirstSelected;
if node <> nil then
begin
areaInfo := vstArea.GetNodeData(node);
areaInfo^.Left := seX1.Value;
areaInfo^.Right := seX2.Value;
areaInfo^.Top := seY1.Value;
areaInfo^.Bottom := seY2.Value;
regionInfo:= vstRegions.GetNodeData(vstRegions.GetFirstSelected);
regionInfo^.Areas.Rects[vstArea.AbsoluteIndex(node)] := areaInfo^;
vstArea.InvalidateNode(node);
pbArea.Repaint;
end;
end;
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
areaInfo: ^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;
if selected then
begin
areaInfo := Sender.GetNodeData(Node);
seX1.Value := areaInfo^.Left;
seX2.Value := areaInfo^.Right;
seY1.Value := areaInfo^.Top;
seY2.Value := areaInfo^.Bottom;
end;
pbArea.Repaint;
end;
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
areaInfo: ^TRect;
begin
areaInfo := Sender.GetNodeData(Node);
CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
areaInfo^.Right, areaInfo^.Bottom]);
end;
procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
i: Integer;
areaNode: PVirtualNode;
regionInfo: PRegionInfo;
areaInfo: ^TRect;
begin
vstArea.BeginUpdate;
vstArea.Clear;
if Node <> nil then
begin
regionInfo := Sender.GetNodeData(Node);
for i := 0 to regionInfo^.Areas.Count - 1 do
begin
areaNode := vstArea.AddChild(nil);
areaInfo := vstArea.GetNodeData(areaNode);
with regionInfo^.Areas.Rects[i] do
begin
areaInfo^.Left := Left;
areaInfo^.Top := Top;
areaInfo^.Right := Right;
areaInfo^.Bottom := Bottom;
end;
end;
end;
vstArea.EndUpdate;
pbArea.Repaint;
end;
procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
end;
procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
regionInfo: PRegionInfo;
begin
regionInfo := Sender.GetNodeData(Node);
CellText := regionInfo^.Name;
end;
procedure TfrmRegionControl.vstRegionsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString);
var
regionInfo: PRegionInfo;
begin
if (Node <> nil) then begin
regionInfo := Sender.GetNodeData(Node);
regionInfo^.Name := NewText;
end;
end;
procedure TfrmRegionControl.vstRegionsOnEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := True;
end;
initialization
{$I UfrmRegionControl.lrs}