aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Fixed memory leak in TfrmFilter (not freeing FCheckedHues) 

- Fixed memory leak in TfrmMain (not freeing the strings in the location info nodes)
- Rearranged frmEditAccount to allow region handling
- Added region handling to the client side account specific network packets
- Fixed some more code style inconsistencies in UfrmRegionControl.pas
- Fixed redrawing in TfrmRegionControl
- Fixed memory leak in TAccount (not freeing FRegions)
- Fixed the TModifyRegionResponsePacket ID
- Fixed the content of the TUserListPacket to not contain the list of all regions
This commit is contained in:
Andreas Schneider 2008-08-17 20:12:36 +02:00
parent c7d845997e
commit d5069bbb50
17 changed files with 570 additions and 419 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Client/CentrED.lpi
View File

@ -40,7 +40,7 @@
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/> <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item4> </Item4>
</RequiredPackages> </RequiredPackages>
<Units Count="24"> <Units Count="26">
<Unit0> <Unit0>
<Filename Value="CentrED.lpr"/> <Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -164,6 +164,7 @@
<Filename Value="UfrmRadar.pas"/> <Filename Value="UfrmRadar.pas"/>
<ComponentName Value="frmRadarMap"/> <ComponentName Value="frmRadarMap"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="UfrmRadar.lrs"/> <ResourceFilename Value="UfrmRadar.lrs"/>
<UnitName Value="UfrmRadar"/> <UnitName Value="UfrmRadar"/>
</Unit16> </Unit16>
@ -218,6 +219,16 @@
<ResourceFilename Value="UfrmRegionControl.lrs"/> <ResourceFilename Value="UfrmRegionControl.lrs"/>
<UnitName Value="UfrmRegionControl"/> <UnitName Value="UfrmRegionControl"/>
</Unit23> </Unit23>
<Unit24>
<Filename Value="UPacketHandlers.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPacketHandlers"/>
</Unit24>
<Unit25>
<Filename Value="UPackets.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPackets"/>
</Unit25>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

3
Client/CentrED.lpr
View File

@ -38,7 +38,8 @@ uses
UfrmElevateSettings, UOverlayUI, UResourceManager, UfrmConfirmation, UfrmElevateSettings, UOverlayUI, UResourceManager, UfrmConfirmation,
UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl; UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
UPacketHandlers;
{$IFDEF Windows} {$IFDEF Windows}
{$R *.res} {$R *.res}

17
Client/Tools/UfrmFilter.lfm
View File

@ -11,6 +11,7 @@ object frmFilter: TfrmFilter
ClientWidth = 236 ClientWidth = 236
Font.Height = -11 Font.Height = -11
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow OnShow = FormShow
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object rgFilterType: TRadioGroup object rgFilterType: TRadioGroup
@ -56,7 +57,7 @@ object frmFilter: TfrmFilter
object Label1: TLabel object Label1: TLabel
Left = 4 Left = 4
Height = 28 Height = 28
Top = 29 Top = 28
Width = 216 Width = 216
Align = alTop Align = alTop
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -69,15 +70,14 @@ object frmFilter: TfrmFilter
Tag = 1 Tag = 1
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 151 Height = 152
Top = 61 Top = 60
Width = 216 Width = 216
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BorderStyle = bsSingle BorderStyle = bsSingle
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragType = dtVCL DragType = dtVCL
Header.Font.Height = -11
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -214,7 +214,7 @@ object frmFilter: TfrmFilter
end end
object cbTileFilter: TCheckBox object cbTileFilter: TCheckBox
Left = 4 Left = 4
Height = 21 Height = 20
Top = 4 Top = 4
Width = 216 Width = 216
Align = alTop Align = alTop
@ -240,7 +240,7 @@ object frmFilter: TfrmFilter
TabOrder = 2 TabOrder = 2
object cbHueFilter: TCheckBox object cbHueFilter: TCheckBox
Left = 4 Left = 4
Height = 21 Height = 20
Top = 4 Top = 4
Width = 216 Width = 216
Align = alTop Align = alTop
@ -252,14 +252,13 @@ object frmFilter: TfrmFilter
object vdtHues: TVirtualDrawTree object vdtHues: TVirtualDrawTree
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 118 Height = 119
Top = 29 Top = 28
Width = 216 Width = 216
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BorderStyle = bsSingle BorderStyle = bsSingle
Header.AutoSizeIndex = 2 Header.AutoSizeIndex = 2
Header.Font.Height = -11
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons

6
Client/Tools/UfrmFilter.pas
View File

@ -61,6 +61,7 @@ type
procedure btnClearClick(Sender: TObject); procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject); procedure btnDeleteClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure mnuUncheckHuesClick(Sender: TObject); procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject); procedure mnuCheckHuesClick(Sender: TObject);
@ -308,6 +309,11 @@ begin
//FCheckedHues.Bits[0] := True; //FCheckedHues.Bits[0] := True;
end; end;
procedure TfrmFilter.FormDestroy(Sender: TObject);
begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject); procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin begin
vdtFilter.DeleteSelectedNodes; vdtFilter.DeleteSelectedNodes;

2
Client/UfrmAccountControl.lfm
View File

@ -77,7 +77,6 @@ object frmAccountControl: TfrmAccountControl
Width = 369 Width = 369
Align = alClient Align = alClient
Header.AutoSizeIndex = 1 Header.AutoSizeIndex = 1
Header.Font.Height = -11
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsPlates Header.Style = hsPlates
@ -89,6 +88,7 @@ object frmAccountControl: TfrmAccountControl
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnDblClick = vstAccountsDblClick OnDblClick = vstAccountsDblClick
OnFreeNode = vstAccountsFreeNode
OnGetText = vstAccountsGetText OnGetText = vstAccountsGetText
OnGetImageIndex = vstAccountsGetImageIndex OnGetImageIndex = vstAccountsGetImageIndex
Columns = < Columns = <

29
Client/UfrmAccountControl.pas
View File

@ -56,6 +56,7 @@ type
procedure tbDeleteUserClick(Sender: TObject); procedure tbDeleteUserClick(Sender: TObject);
procedure tbRefreshClick(Sender: TObject); procedure tbRefreshClick(Sender: TObject);
procedure vstAccountsDblClick(Sender: TObject); procedure vstAccountsDblClick(Sender: TObject);
procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree; procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer); var Ghosted: Boolean; var ImageIndex: Integer);
@ -83,6 +84,7 @@ type
TAccountInfo = record TAccountInfo = record
Username: string; Username: string;
AccessLevel: TAccessLevel; AccessLevel: TAccessLevel;
Regions: TStringList;
end; end;
{ TModifyUserPacket } { TModifyUserPacket }
@ -226,6 +228,16 @@ begin
tbEditUserClick(Sender); tbEditUserClick(Sender);
end; end;
procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
accountInfo: PAccountInfo;
begin
accountInfo := vstAccounts.GetNodeData(Node);
accountInfo^.Username := '';
if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions);
end;
procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree; procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer); var Ghosted: Boolean; var ImageIndex: Integer);
@ -265,6 +277,7 @@ var
modifyStatus: TModifyUserStatus; modifyStatus: TModifyUserStatus;
username: string; username: string;
accountInfo: PAccountInfo; accountInfo: PAccountInfo;
i, regions: Integer;
begin begin
modifyStatus := TModifyUserStatus(ABuffer.ReadByte); modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
username := ABuffer.ReadStringNull; username := ABuffer.ReadStringNull;
@ -275,6 +288,11 @@ begin
accountInfo := vstAccounts.GetNodeData(node); accountInfo := vstAccounts.GetNodeData(node);
accountInfo^.Username := username; accountInfo^.Username := username;
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
accountInfo^.Regions := TStringList.Create;
regions := ABuffer.ReadByte;
for i := 0 to regions - 1 do
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
Messagedlg('Success', Format('The user "%s" has been added.', [username]), Messagedlg('Success', Format('The user "%s" has been added.', [username]),
mtInformation, [mbOK], 0); mtInformation, [mbOK], 0);
end; end;
@ -285,6 +303,11 @@ begin
begin begin
accountInfo := vstAccounts.GetNodeData(node); accountInfo := vstAccounts.GetNodeData(node);
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
accountInfo^.Regions.Clear;
regions := ABuffer.ReadByte;
for i := 0 to regions - 1 do
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
Messagedlg('Success', Format('The user "%s" has been modified.', [username]), Messagedlg('Success', Format('The user "%s" has been modified.', [username]),
mtInformation, [mbOK], 0); mtInformation, [mbOK], 0);
end; end;
@ -325,7 +348,7 @@ procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
var var
node: PVirtualNode; node: PVirtualNode;
accountInfo: PAccountInfo; accountInfo: PAccountInfo;
i, count: Word; i, j, count, regions: Word;
begin begin
vstAccounts.BeginUpdate; vstAccounts.BeginUpdate;
vstAccounts.Clear; vstAccounts.Clear;
@ -336,6 +359,10 @@ begin
accountInfo := vstAccounts.GetNodeData(node); accountInfo := vstAccounts.GetNodeData(node);
accountInfo^.Username := ABuffer.ReadStringNull; accountInfo^.Username := ABuffer.ReadStringNull;
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte); accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
accountInfo^.Regions := TStringList.Create;
regions := ABuffer.ReadByte;
for j := 0 to regions - 1 do
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
end; end;
vstAccounts.EndUpdate; vstAccounts.EndUpdate;
end; end;

261
Client/UfrmEditAccount.lfm
View File

@ -1,115 +1,180 @@
object frmEditAccount: TfrmEditAccount object frmEditAccount: TfrmEditAccount
Left = 290 Left = 290
Height = 186 Height = 214
Top = 171 Top = 171
Width = 266 Width = 261
ActiveControl = edUsername ActiveControl = PageControl1
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Edit Account' Caption = 'Edit Account'
ClientHeight = 186 ClientHeight = 214
ClientWidth = 266 ClientWidth = 261
Font.Height = -11 Font.Height = -11
Position = poOwnerFormCenter Position = poOwnerFormCenter
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object lblPasswordHint: TLabel object PageControl1: TPageControl
Left = 96 Height = 173
Height = 28 Width = 261
Top = 72 ActivePage = tsGeneral
Width = 160 Align = alClient
AutoSize = False
Caption = 'Leave empty to leave the password unchanged.'
Enabled = False
ParentColor = False
ParentFont = True
WordWrap = True
end
object lblUsername: TLabel
Left = 16
Height = 14
Top = 20
Width = 58
Caption = 'Username:'
ParentColor = False
ParentFont = True
end
object lblPassword: TLabel
Left = 16
Height = 14
Top = 52
Width = 54
Caption = 'Password:'
ParentColor = False
ParentFont = True
end
object lblAccessLevel: TLabel
Left = 16
Height = 14
Top = 116
Width = 63
Caption = 'Accesslevel:'
ParentColor = False
ParentFont = True
end
object btnOK: TButton
Left = 93
Height = 25
Top = 152
Width = 75
BorderSpacing.InnerBorder = 4
Caption = 'OK'
Default = True
ModalResult = 1
ParentFont = True ParentFont = True
TabIndex = 0
TabOrder = 0 TabOrder = 0
object tsGeneral: TTabSheet
Caption = 'General'
ClientHeight = 142
ClientWidth = 257
ParentFont = True
object lblPasswordHint: TLabel
Left = 86
Height = 28
Top = 64
Width = 160
AutoSize = False
Caption = 'Leave empty to leave the password unchanged.'
Enabled = False
ParentColor = False
ParentFont = True
WordWrap = True
end
object lblUsername: TLabel
Left = 6
Height = 13
Top = 12
Width = 64
Caption = 'Username:'
ParentColor = False
ParentFont = True
end
object lblPassword: TLabel
Left = 6
Height = 13
Top = 44
Width = 61
Caption = 'Password:'
ParentColor = False
ParentFont = True
end
object lblAccessLevel: TLabel
Left = 6
Height = 13
Top = 108
Width = 71
Caption = 'Accesslevel:'
ParentColor = False
ParentFont = True
end
object edUsername: TEdit
Left = 86
Height = 23
Top = 8
Width = 160
Color = clBtnFace
ParentFont = True
ReadOnly = True
TabOrder = 0
end
object edPassword: TEdit
Left = 86
Height = 23
Top = 40
Width = 160
EchoMode = emPassword
ParentFont = True
PasswordChar = '*'
TabOrder = 1
end
object cbAccessLevel: TComboBox
Left = 86
Height = 23
Top = 104
Width = 160
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Items.Strings = (
'None'
'Viewer'
'Normal'
'Administrator'
)
MaxLength = 0
ParentFont = True
Style = csDropDownList
TabOrder = 2
end
end
object tsRegions: TTabSheet
Caption = 'Regions'
ClientHeight = 142
ClientWidth = 257
ParentFont = True
object Label1: TLabel
Left = 8
Height = 13
Top = 8
Width = 241
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 4
Caption = 'Allowed Regions:'
ParentColor = False
ParentFont = True
end
object CheckListBox1: TCheckListBox
Left = 8
Height = 109
Top = 25
Width = 241
Align = alClient
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
ItemHeight = 10
ParentFont = True
TabOrder = 0
TopIndex = -1
end
end
end end
object btnCancel: TButton object Panel1: TPanel
Left = 181 Left = 8
Height = 25 Height = 25
Top = 152 Top = 181
Width = 75 Width = 245
BorderSpacing.InnerBorder = 4 Align = alBottom
Cancel = True BorderSpacing.Around = 8
Caption = 'Cancel' BevelOuter = bvNone
ModalResult = 2 ClientHeight = 25
ClientWidth = 245
ParentFont = True ParentFont = True
TabOrder = 1 TabOrder = 1
end object btnCancel: TButton
object edUsername: TEdit Left = 170
Left = 96 Height = 25
Height = 23 Width = 75
Top = 16 Align = alRight
Width = 160 BorderSpacing.Left = 4
Color = clBtnFace BorderSpacing.InnerBorder = 4
ParentFont = True Cancel = True
ReadOnly = True Caption = 'Cancel'
TabOrder = 2 ModalResult = 2
end ParentFont = True
object edPassword: TEdit TabOrder = 0
Left = 96 end
Height = 23 object btnOK: TButton
Top = 48 Left = 91
Width = 160 Height = 25
EchoMode = emPassword Width = 75
ParentFont = True Align = alRight
PasswordChar = '*' BorderSpacing.Right = 4
TabOrder = 3 BorderSpacing.InnerBorder = 4
end Caption = 'OK'
object cbAccessLevel: TComboBox Default = True
Left = 96 ModalResult = 1
Height = 29 ParentFont = True
Top = 112 TabOrder = 1
Width = 160 end
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
Items.Strings = (
'None'
'Viewer'
'Normal'
'Administrator'
)
MaxLength = 0
ParentFont = True
Style = csDropDownList
TabOrder = 4
end end
end end

16
Client/UfrmEditAccount.pas
View File

@ -31,22 +31,28 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
UEnums; UEnums, ComCtrls, ExtCtrls, CheckLst;
type type
{ TfrmEditAccount } { TfrmEditAccount }
TfrmEditAccount = class(TForm) TfrmEditAccount = class(TForm)
btnOK: TButton;
btnCancel: TButton; btnCancel: TButton;
btnOK: TButton;
cbAccessLevel: TComboBox; cbAccessLevel: TComboBox;
edUsername: TEdit; CheckListBox1: TCheckListBox;
edPassword: TEdit; edPassword: TEdit;
lblUsername: TLabel; edUsername: TEdit;
lblPassword: TLabel; Label1: TLabel;
lblAccessLevel: TLabel; lblAccessLevel: TLabel;
lblPassword: TLabel;
lblPasswordHint: TLabel; lblPasswordHint: TLabel;
lblUsername: TLabel;
PageControl1: TPageControl;
Panel1: TPanel;
tsGeneral: TTabSheet;
tsRegions: TTabSheet;
public public
function GetAccessLevel: TAccessLevel; function GetAccessLevel: TAccessLevel;
procedure SetAccessLevel(AAccessLevel: TAccessLevel); procedure SetAccessLevel(AAccessLevel: TAccessLevel);

106
Client/UfrmLargeScaleCommand.lfm
View File

@ -1,11 +1,11 @@
object frmLargeScaleCommand: TfrmLargeScaleCommand object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 290 Left = 290
Height = 390 Height = 397
Top = 171 Top = 171
Width = 620 Width = 620
ActiveControl = vstActions ActiveControl = vdtDeleteStaticsTiles
Caption = 'Large Scale Commands' Caption = 'Large Scale Commands'
ClientHeight = 390 ClientHeight = 397
ClientWidth = 620 ClientWidth = 620
Constraints.MinHeight = 390 Constraints.MinHeight = 390
Constraints.MinWidth = 620 Constraints.MinWidth = 620
@ -18,21 +18,21 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object nbActions: TNotebook object nbActions: TNotebook
Left = 152 Left = 152
Height = 360 Height = 364
Width = 468 Width = 468
Align = alClient Align = alClient
PageIndex = 5 PageIndex = 4
ParentFont = True ParentFont = True
ShowTabs = False ShowTabs = False
TabOrder = 0 TabOrder = 0
object pgArea: TPage object pgArea: TPage
Caption = 'pgArea' Caption = 'pgArea'
ClientWidth = 464 ClientWidth = 468
ClientHeight = 356 ClientHeight = 360
ParentFont = True ParentFont = True
object sbArea: TScrollBox object sbArea: TScrollBox
Height = 356 Height = 360
Width = 464 Width = 468
Align = alClient Align = alClient
TabOrder = 0 TabOrder = 0
object pbArea: TPaintBox object pbArea: TPaintBox
@ -46,8 +46,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object pgCopyMove: TPage object pgCopyMove: TPage
Caption = 'Copy/Move' Caption = 'Copy/Move'
ClientWidth = 464 ClientWidth = 468
ClientHeight = 356 ClientHeight = 360
ParentFont = True ParentFont = True
object rgCMAction: TRadioGroup object rgCMAction: TRadioGroup
Left = 12 Left = 12
@ -64,8 +64,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2 ChildSizing.ControlsPerLine = 2
ClientHeight = 23 ClientHeight = 40
ClientWidth = 180 ClientWidth = 184
Columns = 2 Columns = 2
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
@ -132,8 +132,8 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object pgModifyAltitude: TPage object pgModifyAltitude: TPage
Caption = 'Modify altitude' Caption = 'Modify altitude'
ClientWidth = 464 ClientWidth = 468
ClientHeight = 356 ClientHeight = 360
ParentFont = True ParentFont = True
object Label2: TLabel object Label2: TLabel
Left = 28 Left = 28
@ -218,18 +218,18 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object pgDrawTerrain: TPage object pgDrawTerrain: TPage
Caption = 'Draw Terrain' Caption = 'Draw Terrain'
ClientWidth = 464 ClientWidth = 468
ClientHeight = 356 ClientHeight = 360
ParentFont = True ParentFont = True
object gbDrawTerrainTiles: TGroupBox object gbDrawTerrainTiles: TGroupBox
Left = 8 Left = 8
Height = 340 Height = 344
Top = 8 Top = 8
Width = 225 Width = 225
Align = alLeft Align = alLeft
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 323 ClientHeight = 328
ClientWidth = 221 ClientWidth = 221
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
@ -250,7 +250,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Tag = 1 Tag = 1
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 231 Height = 236
Top = 62 Top = 62
Width = 213 Width = 213
Align = alClient Align = alClient
@ -260,7 +260,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragMode = dmAutomatic DragMode = dmAutomatic
DragType = dtVCL DragType = dtVCL
Header.Font.Height = -11
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -289,7 +288,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object pnlDrawTerrainTilesControls: TPanel object pnlDrawTerrainTilesControls: TPanel
Height = 26 Height = 26
Top = 297 Top = 302
Width = 221 Width = 221
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -399,23 +398,23 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgDeleteStatics: TPage object pgDeleteStatics: TPage
Caption = 'Delete statics' Caption = 'Delete statics'
ClientWidth = 464 ClientWidth = 464
ClientHeight = 356 ClientHeight = 360
ParentFont = True ParentFont = True
object gbDeleteStaticsTiles: TGroupBox object gbDeleteStaticsTiles: TGroupBox
Left = 8 Left = 8
Height = 340 Height = 344
Top = 8 Top = 8
Width = 225 Width = 225
Align = alLeft Align = alLeft
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 323 ClientHeight = 327
ClientWidth = 221 ClientWidth = 221
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
object lblDeleteStaticsTilesDesc: TLabel object lblDeleteStaticsTilesDesc: TLabel
Left = 4 Left = 4
Height = 64 Height = 73
Width = 213 Width = 213
Align = alTop Align = alTop
BorderSpacing.Left = 4 BorderSpacing.Left = 4
@ -423,13 +422,15 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
Caption = 'Drag statics tiles from the main window and drop them on the list. Only statics matching these tiles will be deleted. If the list is empty, every static will be deleted.' Caption = 'Drag statics tiles from the main window and drop them on the list. Only statics matching these tiles will be deleted. If the list is empty, every static will be deleted.'
ParentColor = False ParentColor = False
ParentFont = True
WordWrap = True WordWrap = True
end end
object vdtDeleteStaticsTiles: TVirtualDrawTree object vdtDeleteStaticsTiles: TVirtualDrawTree
Tag = 1 Tag = 1
Cursor = 63
Left = 4 Left = 4
Height = 225 Height = 220
Top = 68 Top = 77
Width = 213 Width = 213
Align = alClient Align = alClient
BorderSpacing.Left = 4 BorderSpacing.Left = 4
@ -438,7 +439,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragMode = dmAutomatic DragMode = dmAutomatic
DragType = dtVCL DragType = dtVCL
Header.Font.Height = -11
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -467,7 +467,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object pnlDrawTerrainTilesControls2: TPanel object pnlDrawTerrainTilesControls2: TPanel
Height = 26 Height = 26
Top = 297 Top = 301
Width = 221 Width = 221
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -632,17 +632,17 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgInsertStatics: TPage object pgInsertStatics: TPage
Caption = 'Insert statics' Caption = 'Insert statics'
ClientWidth = 464 ClientWidth = 464
ClientHeight = 356 ClientHeight = 360
ParentFont = True ParentFont = True
object gbInserStaticsTiles: TGroupBox object gbInserStaticsTiles: TGroupBox
Left = 8 Left = 8
Height = 340 Height = 344
Top = 8 Top = 8
Width = 225 Width = 225
Align = alLeft Align = alLeft
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 323 ClientHeight = 327
ClientWidth = 221 ClientWidth = 221
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
@ -662,7 +662,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object vdtInsertStaticsTiles: TVirtualDrawTree object vdtInsertStaticsTiles: TVirtualDrawTree
Tag = 1 Tag = 1
Left = 4 Left = 4
Height = 231 Height = 235
Top = 62 Top = 62
Width = 213 Width = 213
Align = alClient Align = alClient
@ -672,7 +672,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragMode = dmAutomatic DragMode = dmAutomatic
DragType = dtVCL DragType = dtVCL
Header.Font.Height = -11
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -701,7 +700,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object pnlDrawTerrainTilesControls1: TPanel object pnlDrawTerrainTilesControls1: TPanel
Height = 26 Height = 26
Top = 297 Top = 301
Width = 221 Width = 221
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -900,11 +899,11 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pnlLeft: TPanel object pnlLeft: TPanel
Height = 360 Height = 364
Width = 152 Width = 152
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 360 ClientHeight = 364
ClientWidth = 152 ClientWidth = 152
ParentFont = True ParentFont = True
TabOrder = 1 TabOrder = 1
@ -924,7 +923,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Height = 136 Height = 136
Width = 152 Width = 152
Align = alTop Align = alTop
Header.Font.Height = -11
Header.Options = [hoAutoResize, hoVisible] Header.Options = [hoAutoResize, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -945,7 +943,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pnlAreaControls: TPanel object pnlAreaControls: TPanel
Left = 4 Left = 4
Height = 82 Height = 82
Top = 274 Top = 278
Width = 144 Width = 144
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -1161,7 +1159,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
object vstArea: TVirtualStringTree object vstArea: TVirtualStringTree
Left = 4 Left = 4
Height = 121 Height = 125
Top = 149 Top = 149
Width = 144 Width = 144
Align = alClient Align = alClient
@ -1180,22 +1178,23 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pnlControls: TPanel object pnlControls: TPanel
Height = 30 Left = 4
Top = 360 Height = 25
Width = 620 Top = 368
Width = 612
Align = alBottom Align = alBottom
BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 30 ClientHeight = 25
ClientWidth = 620 ClientWidth = 612
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
object btnExecute: TButton object btnExecute: TButton
Left = 484 Left = 480
Height = 22 Height = 25
Top = 4
Width = 64 Width = 64
Align = alRight Align = alRight
BorderSpacing.Around = 4 BorderSpacing.Right = 4
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
Caption = 'Execute' Caption = 'Execute'
OnClick = btnExecuteClick OnClick = btnExecuteClick
@ -1203,12 +1202,11 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
TabOrder = 0 TabOrder = 0
end end
object btnClose: TButton object btnClose: TButton
Left = 552 Left = 548
Height = 22 Height = 25
Top = 4
Width = 64 Width = 64
Align = alRight Align = alRight
BorderSpacing.Around = 4 BorderSpacing.Left = 4
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
Caption = 'Close' Caption = 'Close'
OnClick = btnCloseClick OnClick = btnCloseClick

2
Client/UfrmLargeScaleCommand.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UfrmLargeScaleCommand; unit UfrmLargeScaleCommand;

5
Client/UfrmLogin.lfm
View File

@ -16,8 +16,8 @@ object frmLogin: TfrmLogin
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object lblCopyright: TLabel object lblCopyright: TLabel
Height = 23 Height = 24
Top = 242 Top = 241
Width = 489 Width = 489
Align = alBottom Align = alBottom
Alignment = taCenter Alignment = taCenter
@ -427,7 +427,6 @@ object frmLogin: TfrmLogin
NumGlyphs = 1 NumGlyphs = 1
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
ReadOnly = True
TabOrder = 0 TabOrder = 0
end end
end end

101
Client/UfrmMain.lfm
View File

@ -3,9 +3,9 @@ object frmMain: TfrmMain
Height = 603 Height = 603
Top = 144 Top = 144
Width = 766 Width = 766
ActiveControl = cbTerrain ActiveControl = pcLeft
Caption = 'UO CentrED' Caption = 'UO CentrED'
ClientHeight = 578 ClientHeight = 574
ClientWidth = 766 ClientWidth = 766
Constraints.MinHeight = 603 Constraints.MinHeight = 603
Constraints.MinWidth = 766 Constraints.MinWidth = 766
@ -21,7 +21,7 @@ object frmMain: TfrmMain
WindowState = wsMaximized WindowState = wsMaximized
object pnlBottom: TPanel object pnlBottom: TPanel
Height = 31 Height = 31
Top = 547 Top = 543
Width = 766 Width = 766
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -31,25 +31,25 @@ object frmMain: TfrmMain
TabOrder = 0 TabOrder = 0
object lblX: TLabel object lblX: TLabel
Left = 11 Left = 11
Height = 14 Height = 13
Top = 7 Top = 7
Width = 11 Width = 12
Caption = 'X:' Caption = 'X:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object lblY: TLabel object lblY: TLabel
Left = 88 Left = 88
Height = 14 Height = 13
Top = 7 Top = 7
Width = 10 Width = 12
Caption = 'Y:' Caption = 'Y:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object lblTileInfo: TLabel object lblTileInfo: TLabel
Left = 240 Left = 240
Height = 14 Height = 13
Top = 7 Top = 7
Width = 4 Width = 4
Caption = ' ' Caption = ' '
@ -57,9 +57,9 @@ object frmMain: TfrmMain
ParentFont = True ParentFont = True
end end
object lblTip: TLabel object lblTip: TLabel
Left = 528 Left = 519
Height = 31 Height = 31
Width = 230 Width = 239
Align = alRight Align = alRight
Alignment = taRightJustify Alignment = taRightJustify
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -69,14 +69,15 @@ object frmMain: TfrmMain
ParentFont = True ParentFont = True
end end
object lblTipC: TLabel object lblTipC: TLabel
Left = 505 Left = 490
Height = 31 Height = 31
Width = 23 Width = 29
Align = alRight Align = alRight
Caption = 'Tip: ' Caption = 'Tip: '
Font.Height = -11
Font.Style = [fsBold]
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
ParentFont = True
end end
object edX: TSpinEdit object edX: TSpinEdit
Left = 24 Left = 24
@ -109,7 +110,7 @@ object frmMain: TfrmMain
end end
end end
object pcLeft: TPageControl object pcLeft: TPageControl
Height = 523 Height = 519
Top = 24 Top = 24
Width = 224 Width = 224
ActivePage = tsTiles ActivePage = tsTiles
@ -119,7 +120,7 @@ object frmMain: TfrmMain
TabOrder = 1 TabOrder = 1
object tsTiles: TTabSheet object tsTiles: TTabSheet
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 494 ClientHeight = 488
ClientWidth = 220 ClientWidth = 220
ParentFont = True ParentFont = True
object pnlTileListSettings: TPanel object pnlTileListSettings: TPanel
@ -133,18 +134,18 @@ object frmMain: TfrmMain
TabOrder = 0 TabOrder = 0
object lblFilter: TLabel object lblFilter: TLabel
Left = 84 Left = 84
Height = 14 Height = 13
Top = 8 Top = 8
Width = 30 Width = 33
Caption = 'Filter:' Caption = 'Filter:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object cbTerrain: TCheckBox object cbTerrain: TCheckBox
Left = 4 Left = 4
Height = 21 Height = 20
Top = 8 Top = 8
Width = 64 Width = 66
Caption = 'Terrain' Caption = 'Terrain'
Checked = True Checked = True
OnChange = cbTerrainChange OnChange = cbTerrainChange
@ -154,9 +155,9 @@ object frmMain: TfrmMain
end end
object cbStatics: TCheckBox object cbStatics: TCheckBox
Left = 4 Left = 4
Height = 21 Height = 20
Top = 32 Top = 32
Width = 63 Width = 64
Caption = 'Statics' Caption = 'Statics'
Checked = True Checked = True
OnChange = cbStaticsChange OnChange = cbStaticsChange
@ -176,7 +177,7 @@ object frmMain: TfrmMain
end end
object vdtTiles: TVirtualDrawTree object vdtTiles: TVirtualDrawTree
Tag = 1 Tag = 1
Height = 240 Height = 234
Top = 56 Top = 56
Width = 220 Width = 220
Align = alClient Align = alClient
@ -184,7 +185,6 @@ object frmMain: TfrmMain
DragMode = dmAutomatic DragMode = dmAutomatic
DragType = dtVCL DragType = dtVCL
Header.AutoSizeIndex = 2 Header.AutoSizeIndex = 2
Header.Font.Height = -11
Header.MainColumn = 2 Header.MainColumn = 2
Header.Options = [hoVisible] Header.Options = [hoVisible]
Header.ParentFont = True Header.ParentFont = True
@ -221,24 +221,23 @@ object frmMain: TfrmMain
end end
object gbRandom: TGroupBox object gbRandom: TGroupBox
Height = 193 Height = 193
Top = 301 Top = 295
Width = 220 Width = 220
Align = alBottom Align = alBottom
Caption = 'Random pool' Caption = 'Random pool'
ClientHeight = 178 ClientHeight = 176
ClientWidth = 216 ClientWidth = 216
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
object vdtRandom: TVirtualDrawTree object vdtRandom: TVirtualDrawTree
Tag = 1 Tag = 1
Cursor = 63 Cursor = 63
Height = 126 Height = 124
Top = 22 Top = 22
Width = 216 Width = 216
Align = alClient Align = alClient
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragType = dtVCL DragType = dtVCL
Header.Font.Height = -11
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -421,7 +420,7 @@ object frmMain: TfrmMain
object pnlRandomPreset: TPanel object pnlRandomPreset: TPanel
Left = 4 Left = 4
Height = 22 Height = 22
Top = 152 Top = 150
Width = 208 Width = 208
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -541,7 +540,7 @@ object frmMain: TfrmMain
object spTileList: TSplitter object spTileList: TSplitter
Cursor = crVSplit Cursor = crVSplit
Height = 5 Height = 5
Top = 296 Top = 290
Width = 220 Width = 220
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
@ -564,12 +563,12 @@ object frmMain: TfrmMain
end end
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 494 ClientHeight = 519
ClientWidth = 220 ClientWidth = 224
ParentFont = True ParentFont = True
object lbClients: TListBox object lbClients: TListBox
Height = 494 Height = 519
Width = 220 Width = 224
Align = alClient Align = alClient
OnDblClick = mnuGoToClientClick OnDblClick = mnuGoToClientClick
ParentFont = True ParentFont = True
@ -581,20 +580,19 @@ object frmMain: TfrmMain
end end
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 494 ClientHeight = 519
ClientWidth = 220 ClientWidth = 224
ParentFont = True ParentFont = True
object vstLocations: TVirtualStringTree object vstLocations: TVirtualStringTree
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 458 Height = 483
Top = 4 Top = 4
Width = 212 Width = 216
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BorderStyle = bsSingle BorderStyle = bsSingle
Header.AutoSizeIndex = 1 Header.AutoSizeIndex = 1
Header.Font.Height = -11
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
@ -604,6 +602,7 @@ object frmMain: TfrmMain
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnDblClick = vstLocationsDblClick OnDblClick = vstLocationsDblClick
OnFreeNode = vstLocationsFreeNode
OnGetText = vstLocationsGetText OnGetText = vstLocationsGetText
OnLoadNode = vstLocationsLoadNode OnLoadNode = vstLocationsLoadNode
OnNewText = vstLocationsNewText OnNewText = vstLocationsNewText
@ -615,20 +614,20 @@ object frmMain: TfrmMain
end end
item item
Position = 1 Position = 1
Width = 133 Width = 141
WideText = 'Name' WideText = 'Name'
end> end>
end end
object pnlLocationControls: TPanel object pnlLocationControls: TPanel
Left = 4 Left = 4
Height = 24 Height = 24
Top = 466 Top = 491
Width = 212 Width = 216
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 24 ClientHeight = 24
ClientWidth = 212 ClientWidth = 216
ParentFont = True ParentFont = True
TabOrder = 1 TabOrder = 1
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
@ -952,17 +951,17 @@ object frmMain: TfrmMain
end end
object pnlMain: TPanel object pnlMain: TPanel
Left = 224 Left = 224
Height = 523 Height = 519
Top = 24 Top = 24
Width = 542 Width = 542
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 523 ClientHeight = 519
ClientWidth = 542 ClientWidth = 542
ParentFont = True ParentFont = True
TabOrder = 3 TabOrder = 3
object oglGameWindow: TOpenGLControl object oglGameWindow: TOpenGLControl
Height = 372 Height = 368
Width = 542 Width = 542
Align = alClient Align = alClient
OnDblClick = oglGameWindowDblClick OnDblClick = oglGameWindowDblClick
@ -976,7 +975,7 @@ object frmMain: TfrmMain
end end
object pnlChatHeader: TPanel object pnlChatHeader: TPanel
Height = 24 Height = 24
Top = 372 Top = 368
Width = 542 Width = 542
Align = alBottom Align = alBottom
BevelInner = bvRaised BevelInner = bvRaised
@ -1004,7 +1003,7 @@ object frmMain: TfrmMain
end end
object pnlChat: TPanel object pnlChat: TPanel
Height = 122 Height = 122
Top = 401 Top = 397
Width = 542 Width = 542
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -1014,11 +1013,11 @@ object frmMain: TfrmMain
TabOrder = 1 TabOrder = 1
Visible = False Visible = False
object vstChat: TVirtualStringTree object vstChat: TVirtualStringTree
Cursor = 63
Height = 99 Height = 99
Width = 542 Width = 542
Align = alClient Align = alClient
Header.AutoSizeIndex = 2 Header.AutoSizeIndex = 2
Header.Font.Height = -11
Header.MainColumn = 2 Header.MainColumn = 2
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
@ -1060,7 +1059,7 @@ object frmMain: TfrmMain
object spChat: TSplitter object spChat: TSplitter
Cursor = crVSplit Cursor = crVSplit
Height = 5 Height = 5
Top = 396 Top = 392
Width = 542 Width = 542
Align = alBottom Align = alBottom
AutoSnap = False AutoSnap = False
@ -1252,6 +1251,10 @@ object frmMain: TfrmMain
ImageIndex = 3 ImageIndex = 3
OnClick = mnuAccountControlClick OnClick = mnuAccountControlClick
end end
object mnuRegionControl: TMenuItem
Caption = '&Region Management'
OnClick = mnuRegionControlClick
end
object mnuLargeScaleCommands: TMenuItem object mnuLargeScaleCommands: TMenuItem
Caption = 'Large Scale Commands' Caption = 'Large Scale Commands'
Bitmap.Data = { Bitmap.Data = {

11
Client/UfrmMain.pas
View File

@ -252,6 +252,8 @@ type
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType); TextType: TVSTTextType);
procedure vstLocationsDblClick(Sender: TObject); procedure vstLocationsDblClick(Sender: TObject);
procedure vstLocationsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode
);
procedure vstLocationsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstLocationsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstLocationsLoadNode(Sender: TBaseVirtualTree; procedure vstLocationsLoadNode(Sender: TBaseVirtualTree;
@ -1406,6 +1408,15 @@ begin
end; end;
end; end;
procedure TfrmMain.vstLocationsFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
locationInfo: PLocationInfo;
begin
locationInfo := Sender.GetNodeData(Node);
locationInfo^.Name := '';
end;
procedure TfrmMain.vstLocationsGetText(Sender: TBaseVirtualTree; procedure TfrmMain.vstLocationsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString); var CellText: WideString);

80
Client/UfrmRegionControl.lfm
View File

@ -1,11 +1,11 @@
object frmRegionControl: TfrmRegionControl object frmRegionControl: TfrmRegionControl
Left = 367 Left = 247
Height = 390 Height = 392
Top = 268 Top = 139
Width = 620 Width = 620
ActiveControl = vstGroups ActiveControl = vstRegions
Caption = 'Region Control' Caption = 'Region Control'
ClientHeight = 390 ClientHeight = 392
ClientWidth = 620 ClientWidth = 620
Font.Height = -11 Font.Height = -11
OnCreate = FormCreate OnCreate = FormCreate
@ -14,11 +14,11 @@ object frmRegionControl: TfrmRegionControl
Position = poOwnerFormCenter Position = poOwnerFormCenter
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object Panel1: TPanel object Panel1: TPanel
Height = 360 Height = 359
Width = 160 Width = 160
Anchors = [akTop, akLeft, akBottom] Align = alLeft
Caption = 'Panel1' Caption = 'Panel1'
ClientHeight = 360 ClientHeight = 359
ClientWidth = 160 ClientWidth = 160
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
@ -37,7 +37,7 @@ object frmRegionControl: TfrmRegionControl
object pnlAreaControls: TPanel object pnlAreaControls: TPanel
Left = 5 Left = 5
Height = 82 Height = 82
Top = 273 Top = 272
Width = 150 Width = 150
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -72,6 +72,7 @@ object frmRegionControl: TfrmRegionControl
Hint = 'Add area' Hint = 'Add area'
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -119,6 +120,7 @@ object frmRegionControl: TfrmRegionControl
Hint = 'Delete area' Hint = 'Delete area'
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -166,6 +168,7 @@ object frmRegionControl: TfrmRegionControl
Hint = 'Delete all areas' Hint = 'Delete all areas'
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -250,7 +253,7 @@ object frmRegionControl: TfrmRegionControl
end end
object vstArea: TVirtualStringTree object vstArea: TVirtualStringTree
Left = 5 Left = 5
Height = 119 Height = 118
Top = 150 Top = 150
Width = 150 Width = 150
Align = alClient Align = alClient
@ -268,46 +271,46 @@ object frmRegionControl: TfrmRegionControl
OnGetText = vstAreaGetText OnGetText = vstAreaGetText
Columns = <> Columns = <>
end end
object vstGroups: TVirtualStringTree object vstRegions: TVirtualStringTree
Left = 1 Left = 1
Height = 136 Height = 136
Top = 1 Top = 1
Width = 158 Width = 158
Align = alTop Align = alTop
Header.Font.Height = -11
Header.Options = [hoAutoResize, hoVisible] Header.Options = [hoAutoResize, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
ParentFont = True ParentFont = True
PopupMenu = pmGroup PopupMenu = pmRegions
TabOrder = 2 TabOrder = 2
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnChange = vstGroupsChange OnChange = vstRegionsChange
OnEditing = vstGroupsOnEditing OnEditing = vstRegionsOnEditing
OnGetText = vstGroupsGetText OnFreeNode = vstRegionsFreeNode
OnNewText = vstGroupsNewText OnGetText = vstRegionsGetText
OnNewText = vstRegionsNewText
Columns = < Columns = <
item item
Width = 158 Width = 158
WideText = 'Groups' WideText = 'Regions'
end> end>
end end
end end
object Panel2: TPanel object Panel2: TPanel
Left = 160 Left = 160
Height = 361 Height = 359
Width = 460 Width = 460
Anchors = [akTop, akLeft, akRight, akBottom] Align = alClient
Caption = 'Panel2' Caption = 'Panel2'
ClientHeight = 361 ClientHeight = 359
ClientWidth = 460 ClientWidth = 460
ParentFont = True ParentFont = True
TabOrder = 1 TabOrder = 1
object sbArea: TScrollBox object sbArea: TScrollBox
Left = 1 Left = 1
Height = 359 Height = 357
Top = 1 Top = 1
Width = 458 Width = 458
Align = alClient Align = alClient
@ -323,20 +326,24 @@ object frmRegionControl: TfrmRegionControl
end end
end end
object Panel3: TPanel object Panel3: TPanel
Height = 30 Left = 4
Top = 360 Height = 25
Width = 620 Top = 363
Anchors = [akLeft, akRight, akBottom] Width = 612
ClientHeight = 30 Align = alBottom
ClientWidth = 620 BorderSpacing.Around = 4
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 612
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
object btnExit: TButton object btnExit: TButton
Left = 551 Left = 548
Height = 22 Height = 25
Top = 4
Width = 64 Width = 64
Align = alRight
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Left = 4
Caption = 'Exit' Caption = 'Exit'
OnClick = btnCloseClick OnClick = btnCloseClick
ParentFont = True ParentFont = True
@ -344,10 +351,11 @@ object frmRegionControl: TfrmRegionControl
end end
object btnSave: TButton object btnSave: TButton
Left = 480 Left = 480
Height = 22 Height = 25
Top = 4
Width = 64 Width = 64
Align = alRight
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4
Caption = 'Save' Caption = 'Save'
Enabled = False Enabled = False
OnClick = btnSaveClick OnClick = btnSaveClick
@ -355,14 +363,14 @@ object frmRegionControl: TfrmRegionControl
TabOrder = 1 TabOrder = 1
end end
end end
object pmGroup: TPopupMenu object pmRegions: TPopupMenu
left = 48 left = 48
top = 43 top = 43
object mnuAddGroup: TMenuItem object mnuAddRegion: TMenuItem
Caption = 'Add' Caption = 'Add'
OnClick = acAddGroup OnClick = acAddGroup
end end
object mnuRemoveGroup: TMenuItem object mnuRemoveRegion: TMenuItem
Caption = 'Remove' Caption = 'Remove'
OnClick = accRemoveGroup OnClick = accRemoveGroup
end end

265
Client/UfrmRegionControl.pas
View File

@ -32,8 +32,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
math, UPlatformTypes, UEnhancedMemoryStream, Menus,contnrs, UInterfaces, math, UPlatformTypes, UEnhancedMemoryStream, Menus, contnrs, URectList;
URectList;
type type
TAreaMoveType = (amLeft, amTop, amRight, amBottom); TAreaMoveType = (amLeft, amTop, amRight, amBottom);
@ -50,20 +49,20 @@ type
Label1: TLabel; Label1: TLabel;
lblX: TLabel; lblX: TLabel;
lblY: TLabel; lblY: TLabel;
mnuAddGroup: TMenuItem; mnuAddRegion: TMenuItem;
mnuRemoveGroup: TMenuItem; mnuRemoveRegion: TMenuItem;
Panel1: TPanel; Panel1: TPanel;
Panel2: TPanel; Panel2: TPanel;
Panel3: TPanel; Panel3: TPanel;
pbArea: TPaintBox; pbArea: TPaintBox;
pnlAreaControls: TPanel; pnlAreaControls: TPanel;
pmGroup: TPopupMenu; pmRegions: TPopupMenu;
sbArea: TScrollBox; sbArea: TScrollBox;
seX1: TSpinEdit; seX1: TSpinEdit;
seX2: TSpinEdit; seX2: TSpinEdit;
seY1: TSpinEdit; seY1: TSpinEdit;
seY2: TSpinEdit; seY2: TSpinEdit;
vstGroups: TVirtualStringTree; vstRegions: TVirtualStringTree;
vstArea: TVirtualStringTree; vstArea: TVirtualStringTree;
procedure acAddGroup(Sender: TObject); procedure acAddGroup(Sender: TObject);
procedure accRemoveGroup(Sender: TObject); procedure accRemoveGroup(Sender: TObject);
@ -84,12 +83,13 @@ type
procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstGroupsChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstRegionsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstGroupsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
procedure vstGroupsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstRegionsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; const NewText: WideString); Column: TColumnIndex; const NewText: WideString);
procedure vstGroupsOnEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstRegionsOnEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean); Column: TColumnIndex; var Allowed: Boolean);
protected protected
FLastX: Integer; FLastX: Integer;
@ -142,13 +142,13 @@ var
node: PVirtualNode; node: PVirtualNode;
regionInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
vstGroups.BeginUpdate; vstRegions.BeginUpdate;
vstGroups.Clear; vstRegions.Clear;
regionCount := ABuffer.ReadByte; regionCount := ABuffer.ReadByte;
for i := 0 to regionCount - 1 do for i := 0 to regionCount - 1 do
begin begin
node := vstGroups.AddChild(nil); node := vstRegions.AddChild(nil);
regionInfo := vstGroups.GetNodeData(node); regionInfo := vstRegions.GetNodeData(node);
regionInfo^.Name := ABuffer.ReadStringNull; regionInfo^.Name := ABuffer.ReadStringNull;
regionInfo^.Areas := TRectList.Create; regionInfo^.Areas := TRectList.Create;
areaCount := ABuffer.ReadByte; areaCount := ABuffer.ReadByte;
@ -161,7 +161,7 @@ begin
regionInfo^.Areas.Add(x1, y1, x2, y2); regionInfo^.Areas.Add(x1, y1, x2, y2);
end; end;
end; end;
vstGroups.EndUpdate; vstRegions.EndUpdate;
end; end;
@ -175,11 +175,11 @@ begin
seY2.MaxValue := ResMan.Landscape.CellHeight; seY2.MaxValue := ResMan.Landscape.CellHeight;
vstArea.NodeDataSize := SizeOf(TRect); vstArea.NodeDataSize := SizeOf(TRect);
vstGroups.NodeDataSize := SizeOf(TRegionInfo); vstRegions.NodeDataSize := SizeOf(TRegionInfo);
frmRadarMap.Dependencies.Add(pbArea); frmRadarMap.Dependencies.Add(pbArea);
AdminPacketHandlers[$09] := TPacketHandler.Create(0, @OnListRegionsPacket); AdminPacketHandlers[$0A] := TPacketHandler.Create(0, @OnListRegionsPacket);
end; end;
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject); procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
@ -187,11 +187,11 @@ var
infoGroup: PRegionInfo; infoGroup: PRegionInfo;
i: Integer; i: Integer;
begin begin
if vstGroups.GetFirstSelected <> nil then if vstRegions.GetFirstSelected <> nil then
begin begin
infoGroup := vstGroups.GetNodeData(vstGroups.GetFirstSelected); infoGroup := vstRegions.GetNodeData(vstRegions.GetFirstSelected);
infoGroup^.Areas.Delete(vstArea.AbsoluteIndex(vstArea.GetFirstSelected)); infoGroup^.Areas.Delete(vstArea.AbsoluteIndex(vstArea.GetFirstSelected));
vstGroupsChange(vstGroups, vstGroups.GetFirstSelected); vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
end; end;
end; end;
@ -209,15 +209,15 @@ begin
stream.Position := stream.Size; stream.Position := stream.Size;
stream.WriteByte($09); stream.WriteByte($09);
groupCount := Min(vstGroups.RootNodeCount, 255); groupCount := Min(vstRegions.RootNodeCount, 255);
stream.WriteByte(groupCount); stream.WriteByte(groupCount);
if groupCount = 0 then Exit; if groupCount = 0 then Exit;
i := 0; i := 0;
node := vstGroups.GetFirst; node := vstRegions.GetFirst;
while (node <> nil) and (i < groupCount) do while (node <> nil) and (i < groupCount) do
begin begin
groupInfo := vstGroups.GetNodeData(node); groupInfo := vstRegions.GetNodeData(node);
stream.WriteStringNull(groupInfo^.Name); stream.WriteStringNull(groupInfo^.Name);
areaCount:=Min(groupInfo^.Areas.Count,255); areaCount:=Min(groupInfo^.Areas.Count,255);
stream.WriteByte(areaCount); stream.WriteByte(areaCount);
@ -229,7 +229,7 @@ begin
stream.WriteWord(Max(Left, Right)); stream.WriteWord(Max(Left, Right));
stream.WriteWord(Max(Top, Bottom)); stream.WriteWord(Max(Top, Bottom));
end; end;
node := vstGroups.GetNext(node); node := vstRegions.GetNext(node);
Inc(i); Inc(i);
end; end;
dmNetwork.Send(TCompressedPacket.Create(packet)); dmNetwork.Send(TCompressedPacket.Create(packet));
@ -241,48 +241,53 @@ var
node : PVirtualNode; node : PVirtualNode;
infoGroup : PRegionInfo; infoGroup : PRegionInfo;
begin begin
node := vstGroups.AddChild(nil); node := vstRegions.AddChild(nil);
infoGroup := vstGroups.GetNodeData(node); infoGroup := vstRegions.GetNodeData(node);
infoGroup^.Name := 'Unnamed'; infoGroup^.Name := 'Unnamed';
infoGroup^.Areas := TRectList.Create; infoGroup^.Areas := TRectList.Create;
end; end;
procedure TfrmRegionControl.accRemoveGroup(Sender: TObject); procedure TfrmRegionControl.accRemoveGroup(Sender: TObject);
begin begin
vstGroups.DeleteSelectedNodes; vstRegions.DeleteSelectedNodes;
vstGroupsChange(vstGroups, nil); vstRegionsChange(vstRegions, nil);
end; end;
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject); procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
var var
node: PVirtualNode; node, selected: PVirtualNode;
nodeInfo: ^TRect; areaInfo: ^TRect;
infoGroup : PRegionInfo; regionInfo: PRegionInfo;
begin begin
infoGroup:=vstGroups.GetNodeData(vstGroups.GetFirstSelected); selected := vstRegions.GetFirstSelected;
node := vstArea.AddChild(nil); if selected <> nil then
nodeInfo := vstArea.GetNodeData(node); begin
nodeInfo^.Left := 0; regionInfo := vstRegions.GetNodeData(selected);
nodeInfo^.Top := 0; node := vstArea.AddChild(nil);
nodeInfo^.Right := 0; areaInfo := vstArea.GetNodeData(node);
nodeInfo^.Bottom := 0; areaInfo^.Left := 0;
infoGroup^.Areas.Add(0, 0, 0, 0); areaInfo^.Top := 0;
vstArea.ClearSelection; areaInfo^.Right := 0;
vstArea.Selected[node] := True; areaInfo^.Bottom := 0;
vstArea.FocusedNode := node; regionInfo^.Areas.Add(0, 0, 0, 0);
vstArea.ClearSelection;
vstArea.Selected[node] := True;
vstArea.FocusedNode := node;
end;
end; end;
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject); procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
var var
infoGroup: PRegionInfo; regionNode: PVirtualNode;
infoArea : TRect; regionInfo: PRegionInfo;
i: Integer; i: Integer;
begin begin
if vstGroups.GetFirstSelected <> nil then regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin begin
infoGroup := vstGroups.GetNodeData(vstGroups.GetFirstSelected); regionInfo := vstRegions.GetNodeData(regionNode);
infoGroup^.Areas.Clear; regionInfo^.Areas.Clear;
vstGroupsChange(vstGroups, vstGroups.GetFirstSelected); vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
end; end;
end; end;
@ -294,7 +299,7 @@ end;
procedure TfrmRegionControl.FormDestroy(Sender: TObject); procedure TfrmRegionControl.FormDestroy(Sender: TObject);
begin begin
frmRadarMap.Dependencies.Remove(pbArea); frmRadarMap.Dependencies.Remove(pbArea);
if AdminPacketHandlers[$09] <> nil then FreeAndNil(AdminPacketHandlers[$09]); if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
end; end;
procedure TfrmRegionControl.FormShow(Sender: TObject); procedure TfrmRegionControl.FormShow(Sender: TObject);
@ -306,50 +311,50 @@ end;
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject; procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var var
node, match: PVirtualNode; areaNode, regionNode, match: PVirtualNode;
nodeInfo: ^TRect; areaInfo: ^TRect;
p: TPoint; p: TPoint;
i: Integer; i: Integer;
infoArea: TRect; regionInfo: PRegionInfo;
infoGroup: PRegionInfo;
begin begin
FAreaMove := []; FAreaMove := [];
p := Point(X * 8, Y * 8); p := Point(X * 8, Y * 8);
match := nil; match := nil;
node := vstArea.GetFirst; areaNode := vstArea.GetFirst;
while node <> nil do while areaNode <> nil do //find the last matching area
begin begin
nodeInfo := vstArea.GetNodeData(node); areaInfo := vstArea.GetNodeData(areaNode);
if PtInRect(nodeInfo^, p) then if PtInRect(areaInfo^, p) then
match := node; match := areaNode;
node := vstArea.GetNext(node); areaNode := vstArea.GetNext(areaNode);
end; end;
if match <> nil then if match <> nil then
begin begin
nodeInfo := vstArea.GetNodeData(match); areaInfo := vstArea.GetNodeData(match);
if p.x - nodeInfo^.Left <= 64 then Include(FAreaMove, amLeft); if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
if p.y - nodeInfo^.Top <= 64 then Include(FAreaMove, amTop); if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
if nodeInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight); if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
if nodeInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom); if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
if FAreaMove = [] then if FAreaMove = [] then
FAreaMove := [amLeft, amTop, amRight, amBottom]; FAreaMove := [amLeft, amTop, amRight, amBottom];
end else end else
begin begin
if vstGroups.GetFirstSelected <> nil then regionNode := vstRegions.GetFirstSelected;
begin if regionNode <> nil then
infoGroup:=vstGroups.GetNodeData(vstGroups.GetFirstSelected); begin
match := vstArea.AddChild(nil); regionInfo := vstRegions.GetNodeData(regionNode);
nodeInfo:=vstArea.GetNodeData(match); match := vstArea.AddChild(nil);
nodeInfo^.Left := p.x; areaInfo := vstArea.GetNodeData(match);
nodeInfo^.Top := p.y; areaInfo^.Left := p.x;
nodeInfo^.Right := p.x; areaInfo^.Top := p.y;
nodeInfo^.Bottom := p.y; areaInfo^.Right := p.x;
infoGroup^.Areas.Add(p.x, p.y, p.x, p.y); areaInfo^.Bottom := p.y;
regionInfo^.Areas.Add(p.x, p.y, p.x, p.y);
pbArea.Repaint; pbArea.Repaint;
FAreaMove := [amRight, amBottom]; FAreaMove := [amRight, amBottom];
end; end;
end; end;
vstArea.ClearSelection; vstArea.ClearSelection;
vstArea.Selected[match] := True; vstArea.Selected[match] := True;
@ -380,7 +385,7 @@ procedure TfrmRegionControl.pbAreaPaint(Sender: TObject);
var var
i: Integer; i: Integer;
node: PVirtualNode; node: PVirtualNode;
nodeInfo: ^TRect; areaInfo: ^TRect;
begin begin
DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar); DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
pbArea.Canvas.Pen.Color := clRed; pbArea.Canvas.Pen.Color := clRed;
@ -398,9 +403,9 @@ begin
pbArea.Canvas.Pen.Width := 1; pbArea.Canvas.Pen.Width := 1;
pbArea.Canvas.Pen.Style := psDot; pbArea.Canvas.Pen.Style := psDot;
end; end;
nodeInfo := vstArea.GetNodeData(node); areaInfo := vstArea.GetNodeData(node);
pbArea.Canvas.Rectangle(nodeInfo^.Left div 8, nodeInfo^.Top div 8, pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
nodeInfo^.Right div 8 + 1, nodeInfo^.Bottom div 8 + 1); areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
node := vstArea.GetNext(node); node := vstArea.GetNext(node);
end; end;
end; end;
@ -408,19 +413,19 @@ end;
procedure TfrmRegionControl.seX1Change(Sender: TObject); procedure TfrmRegionControl.seX1Change(Sender: TObject);
var var
node: PVirtualNode; node: PVirtualNode;
nodeInfo: ^TRect; areaInfo: ^TRect;
infoGroup: PRegionInfo; regionInfo: PRegionInfo;
begin begin
node := vstArea.GetFirstSelected; node := vstArea.GetFirstSelected;
if node <> nil then if node <> nil then
begin begin
nodeInfo := vstArea.GetNodeData(node); areaInfo := vstArea.GetNodeData(node);
nodeInfo^.Left := seX1.Value; areaInfo^.Left := seX1.Value;
nodeInfo^.Right := seX2.Value; areaInfo^.Right := seX2.Value;
nodeInfo^.Top := seY1.Value; areaInfo^.Top := seY1.Value;
nodeInfo^.Bottom := seY2.Value; areaInfo^.Bottom := seY2.Value;
infoGroup:= vstGroups.GetNodeData(vstGroups.GetFirstSelected); regionInfo:= vstRegions.GetNodeData(vstRegions.GetFirstSelected);
infoGroup^.Areas.Rects[vstArea.AbsoluteIndex(node)] := nodeinfo^; regionInfo^.Areas.Rects[vstArea.AbsoluteIndex(node)] := areaInfo^;
vstArea.InvalidateNode(node); vstArea.InvalidateNode(node);
pbArea.Repaint; pbArea.Repaint;
end; end;
@ -429,7 +434,7 @@ end;
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree; procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
Node: PVirtualNode); Node: PVirtualNode);
var var
nodeInfo: ^TRect; areaInfo: ^TRect;
selected: Boolean; selected: Boolean;
begin begin
selected := (Node <> nil) and Sender.Selected[Node]; selected := (Node <> nil) and Sender.Selected[Node];
@ -442,82 +447,92 @@ begin
seY2.Enabled := selected; seY2.Enabled := selected;
if selected then if selected then
begin begin
nodeInfo := Sender.GetNodeData(Node); areaInfo := Sender.GetNodeData(Node);
seX1.Value := nodeInfo^.Left; seX1.Value := areaInfo^.Left;
seX2.Value := nodeInfo^.Right; seX2.Value := areaInfo^.Right;
seY1.Value := nodeInfo^.Top; seY1.Value := areaInfo^.Top;
seY2.Value := nodeInfo^.Bottom; seY2.Value := areaInfo^.Bottom;
end; end;
pbArea.Repaint;
end; end;
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree; procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString); var CellText: WideString);
var var
nodeInfo: ^TRect; areaInfo: ^TRect;
begin begin
nodeInfo := Sender.GetNodeData(Node); areaInfo := Sender.GetNodeData(Node);
CellText := Format('(%d, %d), (%d, %d)', [nodeInfo^.Left, nodeInfo^.Top, CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
nodeInfo^.Right, nodeInfo^.Bottom]); areaInfo^.Right, areaInfo^.Bottom]);
end; end;
procedure TfrmRegionControl.vstGroupsChange(Sender: TBaseVirtualTree; procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
Node: PVirtualNode); Node: PVirtualNode);
var var
i: Integer; i: Integer;
nodeArea: PVirtualNode; areaNode: PVirtualNode;
infoGroup: PRegionInfo; regionInfo: PRegionInfo;
infoArea: ^TRect; areaInfo: ^TRect;
Area: ^TRect;
begin begin
vstArea.BeginUpdate; vstArea.BeginUpdate;
vstArea.Clear; vstArea.Clear;
if Node <> nil then if Node <> nil then
begin {TODO : code style!!!!} begin
infoGroup:=Sender.GetNodeData(Node); regionInfo := Sender.GetNodeData(Node);
for i:=0 to infoGroup^.Areas.Count-1 do for i := 0 to regionInfo^.Areas.Count - 1 do
begin begin
nodeArea := vstArea.AddChild(nil); areaNode := vstArea.AddChild(nil);
infoArea := vstArea.GetNodeData(nodeArea); areaInfo := vstArea.GetNodeData(areaNode);
Area := infoGroup^.Areas[i]; with regionInfo^.Areas.Rects[i] do
infoArea^.Left := Area^.Left; begin
infoArea^.Top := Area^.Top; areaInfo^.Left := Left;
infoArea^.Right := Area^.Right; areaInfo^.Top := Top;
infoArea^.Bottom := Area^.Bottom; areaInfo^.Right := Right;
areaInfo^.Bottom := Bottom;
end;
end; end;
end; end;
vstArea.EndUpdate; vstArea.EndUpdate;
pbArea.Repaint; pbArea.Repaint;
end; end;
procedure TfrmRegionControl.vstGroupsGetText(Sender: TBaseVirtualTree; 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; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString); var CellText: WideString);
var var
nodeInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
nodeInfo := Sender.GetNodeData(Node); regionInfo := Sender.GetNodeData(Node);
CellText := nodeInfo^.Name; CellText := regionInfo^.Name;
end; end;
procedure TfrmRegionControl.vstGroupsNewText(Sender: TBaseVirtualTree; procedure TfrmRegionControl.vstRegionsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString); Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString);
var var
nodeInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
if (Node <> nil) then begin if (Node <> nil) then begin
nodeInfo := Sender.GetNodeData(Node); regionInfo := Sender.GetNodeData(Node);
nodeInfo^.Name := NewText; regionInfo^.Name := NewText;
end; end;
end; end;
procedure TfrmRegionControl.vstGroupsOnEditing(Sender: TBaseVirtualTree; procedure TfrmRegionControl.vstRegionsOnEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin begin
Allowed := True; Allowed := True;
end; end;
initialization initialization
{$I UfrmRegionControl.lrs} {$I UfrmRegionControl.lrs}

11
Server/UAccount.pas
View File

@ -41,6 +41,7 @@ type
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string; constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel; ARegions: TStringList); AAccessLevel: TAccessLevel; ARegions: TStringList);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement); constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
destructor Destroy; override;
procedure Serialize(AElement: TDOMElement); procedure Serialize(AElement: TDOMElement);
protected protected
FOwner: IInvalidate; FOwner: IInvalidate;
@ -131,6 +132,12 @@ begin
end; end;
end; end;
destructor TAccount.Destroy;
begin
if FRegions <> nil then FreeAndNil(FRegions);
inherited Destroy;
end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel); procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
begin begin
FAccessLevel := AValue; FAccessLevel := AValue;
@ -157,8 +164,8 @@ end;
procedure TAccount.Serialize(AElement: TDOMElement); procedure TAccount.Serialize(AElement: TDOMElement);
var var
i : Integer; i: Integer;
child : TDOMElement; child: TDOMElement;
begin begin
TXmlHelper.WriteString(AElement, 'Name', FName); TXmlHelper.WriteString(AElement, 'Name', FName);
TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash); TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash);

11
Server/UAdminHandling.pas
View File

@ -302,10 +302,8 @@ begin
begin begin
FStream.WriteByte(Byte(AAccount.AccessLevel)); FStream.WriteByte(Byte(AAccount.AccessLevel));
FStream.WriteByte(AAccount.Regions.Count); FStream.WriteByte(AAccount.Regions.Count);
if AAccount.Regions.Count > 0 then begin for i := 0 to AAccount.Regions.Count - 1 do
for i := 0 to AAccount.Regions.Count - 1 do FStream.WriteStringNull(AAccount.Regions[i]);
FStream.WriteStringNull(AAccount.Regions[i]);
end;
end; end;
{TODO : check for client side modifications!} {TODO : check for client side modifications!}
end; end;
@ -339,9 +337,6 @@ begin
for j := 0 to account.Regions.Count - 1 do for j := 0 to account.Regions.Count - 1 do
FStream.WriteStringNull(account.Regions[j]); FStream.WriteStringNull(account.Regions[j]);
end; end;
FStream.WriteWord(Config.Regions.Count);
for i := 0 to Config.Regions.Count - 1 do
FStream.WriteStringNull(TRegion(Config.Regions.Items[i]).Name);
end; end;
{ TModifyRegionResponsePacket } { TModifyRegionResponsePacket }
@ -389,7 +384,7 @@ var
region: TRegion; region: TRegion;
begin begin
inherited Create($03, 0); inherited Create($03, 0);
FStream.WriteByte($08); FStream.WriteByte($0A);
FStream.WriteByte(Config.Regions.Count); FStream.WriteByte(Config.Regions.Count);
for i := 0 to Config.Regions.Count - 1 do for i := 0 to Config.Regions.Count - 1 do
begin begin