CentrED/Client/UfrmRegionControl.pas

657 lines
18 KiB
Plaintext

(*
* 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 UfrmRegionControl;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
UEnhancedMemoryStream, Menus, URectList;
type
TAreaMoveType = (amLeft, amTop, amRight, amBottom);
TAreaMove = set of TAreaMoveType;
{ TfrmRegionControl }
TfrmRegionControl = class(TForm)
btnAddArea: TSpeedButton;
btnClearArea: TSpeedButton;
btnDeleteArea: TSpeedButton;
btnClose: TButton;
btnSave: TButton;
Label1: TLabel;
lblX: TLabel;
lblY: TLabel;
mnuAddRegion: TMenuItem;
mnuRemoveRegion: TMenuItem;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
pbArea: TPaintBox;
pnlAreaControls: TPanel;
pmRegions: TPopupMenu;
sbArea: TScrollBox;
seX1: TSpinEdit;
seX2: TSpinEdit;
seY1: TSpinEdit;
seY2: TSpinEdit;
vstRegions: TVirtualStringTree;
vstArea: TVirtualStringTree;
procedure mnuAddRegionClick(Sender: TObject);
procedure mnuRemoveRegionClick(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject);
procedure btnClearAreaClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnDeleteAreaClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(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 seX1Change(Sender: TObject);
procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstRegionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
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 }
public
{ public declarations }
end;
var
frmRegionControl: TfrmRegionControl;
implementation
uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
UAdminHandling, UPacketHandlers;
type
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); //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;
i, j, x1, x2, y1, y2: Integer;
node: PVirtualNode;
regionInfo: PRegionInfo;
begin
vstRegions.BeginUpdate;
vstRegions.Clear;
regionCount := ABuffer.ReadByte;
for i := 0 to regionCount - 1 do
begin
node := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(node);
regionInfo^.Name := ABuffer.ReadStringNull;
regionInfo^.Areas := TRectList.Create;
areaCount := ABuffer.ReadByte;
for j := 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;
end;
vstRegions.EndUpdate;
end;
initialization
{$I UfrmRegionControl.lrs}
end.