- Fixed TfrmEditAccount.RegionDeleted to check, if the region is known (to prevent index out of bounds errors)

- Fixed UfrmMain to be compatible with newer versions of FPC
- Added a slider to frmRegionControl
- Added buttons to add and delete regions to frmRegionControl
- Fixed unsaved regions not being removed in TfrmRegionControl
- Extracted TfrmRegionControl.CheckUnsaved
This commit is contained in:
Andreas Schneider 2008-09-28 22:00:32 +02:00
parent 01f5b2ca58
commit e727aadcf2
6 changed files with 287 additions and 152 deletions

View File

@ -13,21 +13,20 @@ object frmEditAccount: TfrmEditAccount
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
ParentFont = False
Position = poOwnerFormCenter
LCLVersion = '0.9.25'
LCLVersion = '0.9.27'
object PageControl1: TPageControl
Height = 173
Width = 261
ActivePage = tsGeneral
Align = alClient
ParentFont = True
TabIndex = 0
TabOrder = 0
object tsGeneral: TTabSheet
Caption = 'General'
ClientHeight = 144
ClientWidth = 257
ParentFont = True
ClientHeight = 148
ClientWidth = 259
object lblPasswordHint: TLabel
Left = 86
Height = 28
@ -37,7 +36,6 @@ object frmEditAccount: TfrmEditAccount
Caption = 'Leave empty to leave the password unchanged.'
Enabled = False
ParentColor = False
ParentFont = True
WordWrap = True
end
object lblUsername: TLabel
@ -47,7 +45,6 @@ object frmEditAccount: TfrmEditAccount
Width = 58
Caption = 'Username:'
ParentColor = False
ParentFont = True
end
object lblPassword: TLabel
Left = 6
@ -56,7 +53,6 @@ object frmEditAccount: TfrmEditAccount
Width = 54
Caption = 'Password:'
ParentColor = False
ParentFont = True
end
object lblAccessLevel: TLabel
Left = 6
@ -65,7 +61,6 @@ object frmEditAccount: TfrmEditAccount
Width = 63
Caption = 'Accesslevel:'
ParentColor = False
ParentFont = True
end
object edUsername: TEdit
Left = 86
@ -73,7 +68,6 @@ object frmEditAccount: TfrmEditAccount
Top = 8
Width = 160
Color = clBtnFace
ParentFont = True
ReadOnly = True
TabOrder = 0
end
@ -83,38 +77,33 @@ object frmEditAccount: TfrmEditAccount
Top = 40
Width = 160
EchoMode = emPassword
ParentFont = True
PasswordChar = '*'
TabOrder = 1
end
object cbAccessLevel: TComboBox
Left = 86
Height = 29
Height = 25
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 = 144
ClientWidth = 257
ParentFont = True
ClientHeight = 148
ClientWidth = 259
object Label1: TLabel
Left = 8
Height = 14
Top = 8
Width = 241
Width = 243
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Top = 8
@ -122,20 +111,18 @@ object frmEditAccount: TfrmEditAccount
BorderSpacing.Bottom = 4
Caption = 'Allowed Regions:'
ParentColor = False
ParentFont = True
end
object cbRegions: TCheckListBox
Left = 8
Height = 110
Height = 114
Top = 26
Width = 241
Width = 243
Align = alClient
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
ItemHeight = 13
ParentFont = True
TabOrder = 0
TopIndex = -1
end
@ -151,7 +138,6 @@ object frmEditAccount: TfrmEditAccount
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 245
ParentFont = True
TabOrder = 1
object btnCancel: TButton
Left = 170
@ -163,7 +149,6 @@ object frmEditAccount: TfrmEditAccount
Cancel = True
Caption = 'Cancel'
ModalResult = 2
ParentFont = True
TabOrder = 0
end
object btnOK: TButton
@ -176,7 +161,6 @@ object frmEditAccount: TfrmEditAccount
Caption = 'OK'
Default = True
ModalResult = 1
ParentFont = True
TabOrder = 1
end
end

View File

@ -143,8 +143,12 @@ begin
end;
procedure TfrmEditAccount.RegionDeleted(ARegionName: string);
var
index: Integer;
begin
cbRegions.Items.Delete(cbRegions.Items.IndexOf(ARegionName));
index := cbRegions.Items.IndexOf(ARegionName);
if index > -1 then
cbRegions.Items.Delete(index);
end;
procedure TfrmEditAccount.RegionList;

View File

@ -15,9 +15,10 @@ object frmMain: TfrmMain
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
ParentFont = False
Position = poScreenCenter
ShowInTaskBar = stAlways
LCLVersion = '0.9.25'
LCLVersion = '0.9.27'
WindowState = wsMaximized
object pnlBottom: TPanel
Height = 31
@ -27,57 +28,53 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 31
ClientWidth = 766
ParentFont = True
TabOrder = 0
object lblX: TLabel
Left = 11
Height = 13
Height = 14
Top = 7
Width = 12
Width = 11
Caption = 'X:'
ParentColor = False
ParentFont = True
end
object lblY: TLabel
Left = 88
Height = 13
Height = 14
Top = 7
Width = 12
Width = 11
Caption = 'Y:'
ParentColor = False
ParentFont = True
end
object lblTileInfo: TLabel
Left = 240
Height = 13
Height = 14
Top = 7
Width = 4
Caption = ' '
ParentColor = False
ParentFont = True
end
object lblTip: TLabel
Left = 519
Left = 554
Height = 31
Width = 239
Width = 204
Align = alRight
Alignment = taRightJustify
BorderSpacing.Right = 8
Caption = 'Right click shows a menu with all the tools.'
Layout = tlCenter
ParentColor = False
ParentFont = True
end
object lblTipC: TLabel
Left = 490
Left = 530
Height = 31
Width = 29
Width = 24
Align = alRight
Caption = 'Tip: '
Font.Height = -11
Font.Style = [fsBold]
Layout = tlCenter
ParentColor = False
ParentFont = False
end
object edX: TSpinEdit
Left = 24
@ -85,7 +82,6 @@ object frmMain: TfrmMain
Top = 3
Width = 55
MaxValue = 100000
ParentFont = True
TabOrder = 0
end
object edY: TSpinEdit
@ -94,7 +90,6 @@ object frmMain: TfrmMain
Top = 3
Width = 52
MaxValue = 100000
ParentFont = True
TabOrder = 1
end
object btnGoTo: TButton
@ -105,7 +100,6 @@ object frmMain: TfrmMain
BorderSpacing.InnerBorder = 4
Caption = 'GoTo'
OnClick = btnGoToClick
ParentFont = True
TabOrder = 2
end
end
@ -115,14 +109,12 @@ object frmMain: TfrmMain
Width = 224
ActivePage = tsTiles
Align = alLeft
ParentFont = True
TabIndex = 0
TabOrder = 1
object tsTiles: TTabSheet
Caption = 'Tiles'
ClientHeight = 500
ClientWidth = 222
ParentFont = True
object pnlTileListSettings: TPanel
Height = 56
Width = 222
@ -130,7 +122,6 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 56
ClientWidth = 222
ParentFont = True
TabOrder = 0
object lblFilter: TLabel
Left = 84
@ -139,7 +130,6 @@ object frmMain: TfrmMain
Width = 30
Caption = 'Filter:'
ParentColor = False
ParentFont = True
end
object cbTerrain: TCheckBox
Left = 4
@ -149,7 +139,6 @@ object frmMain: TfrmMain
Caption = 'Terrain'
Checked = True
OnChange = cbTerrainChange
ParentFont = True
State = cbChecked
TabOrder = 0
end
@ -161,7 +150,6 @@ object frmMain: TfrmMain
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
ParentFont = True
State = cbChecked
TabOrder = 1
end
@ -171,7 +159,6 @@ object frmMain: TfrmMain
Top = 24
Width = 112
OnEditingDone = edFilterEditingDone
ParentFont = True
TabOrder = 2
end
end
@ -189,12 +176,11 @@ object frmMain: TfrmMain
Header.Options = [hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
ParentFont = True
PopupMenu = pmTileList
TabOrder = 1
TreeOptions.AutoOptions = [toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect, toCenterScrollIntoView]
OnClick = vdtTilesClick
OnDrawNode = vdtTilesDrawNode
@ -227,7 +213,6 @@ object frmMain: TfrmMain
Caption = 'Random pool'
ClientHeight = 179
ClientWidth = 220
ParentFont = True
TabOrder = 2
object vdtRandom: TVirtualDrawTree
Tag = 1
@ -241,7 +226,6 @@ object frmMain: TfrmMain
Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
ParentFont = True
TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
@ -273,7 +257,6 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 22
ClientWidth = 220
ParentFont = True
TabOrder = 1
object btnAddRandom: TSpeedButton
Left = 2
@ -427,7 +410,6 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 22
ClientWidth = 212
ParentFont = True
TabOrder = 2
object btnRandomPresetSave: TSpeedButton
Left = 158
@ -530,7 +512,6 @@ object frmMain: TfrmMain
Width = 152
MaxLength = -1
OnChange = cbRandomPresetChange
ParentFont = True
Style = csDropDownList
TabOrder = 0
end
@ -553,7 +534,6 @@ object frmMain: TfrmMain
CharCase = ecUppercase
OnExit = edSearchIDExit
OnKeyPress = edSearchIDKeyPress
ParentFont = True
ParentShowHint = False
ShowHint = True
TabOrder = 3
@ -564,13 +544,11 @@ object frmMain: TfrmMain
Caption = 'Clients'
ClientHeight = 500
ClientWidth = 222
ParentFont = True
object lbClients: TListBox
Height = 500
Width = 222
Align = alClient
OnDblClick = mnuGoToClientClick
ParentFont = True
PopupMenu = pmClients
Sorted = True
TabOrder = 0
@ -581,7 +559,6 @@ object frmMain: TfrmMain
Caption = 'Locations'
ClientHeight = 500
ClientWidth = 222
ParentFont = True
object vstLocations: TVirtualStringTree
Cursor = 63
Left = 4
@ -595,7 +572,6 @@ object frmMain: TfrmMain
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
ParentFont = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
@ -613,7 +589,7 @@ object frmMain: TfrmMain
end
item
Position = 1
Width = 135
Width = 139
WideText = 'Name'
end>
end
@ -627,7 +603,6 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 24
ClientWidth = 214
ParentFont = True
TabOrder = 1
object btnClearLocations: TSpeedButton
Left = 112
@ -957,7 +932,6 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 525
ClientWidth = 542
ParentFont = True
TabOrder = 3
object oglGameWindow: TOpenGLControl
Height = 374
@ -981,20 +955,18 @@ object frmMain: TfrmMain
BevelOuter = bvLowered
ClientHeight = 24
ClientWidth = 542
ParentFont = True
TabOrder = 0
object lblChatHeaderCaption: TLabel
Cursor = crHandPoint
Left = 10
Height = 20
Top = 2
Width = 104
Width = 95
Align = alLeft
BorderSpacing.Left = 8
Caption = 'Chat and Messages'
Layout = tlCenter
ParentColor = False
ParentFont = True
OnClick = lblChatHeaderCaptionClick
OnMouseEnter = lblChatHeaderCaptionMouseEnter
OnMouseLeave = lblChatHeaderCaptionMouseLeave
@ -1008,7 +980,6 @@ object frmMain: TfrmMain
BevelOuter = bvNone
ClientHeight = 122
ClientWidth = 542
ParentFont = True
TabOrder = 1
Visible = False
object vstChat: TVirtualStringTree
@ -1021,7 +992,6 @@ object frmMain: TfrmMain
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
ParentFont = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
@ -1052,7 +1022,6 @@ object frmMain: TfrmMain
Width = 542
Align = alBottom
OnKeyPress = edChatKeyPress
ParentFont = True
TabOrder = 1
end
end
@ -1253,6 +1222,42 @@ object frmMain: TfrmMain
end
object mnuRegionControl: TMenuItem
Caption = '&Region Management'
Bitmap.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000454D47FF5F6A
61FF636F64FF646F64FF143F56FF295F86FF4988BCFF4A86A7FF5D7070FF646F
66FF646F66FF646F67FF646F67FF647067FF616C63FF474E48FF5F6A60FFEBF5
ECFFD4EDD7FFD4EED7FF2E6784FF94C7F9FF91C9F9FF4185C9FF256BACFFB7D9
D4FFD4E2ECFFCFE5D6FFD5EDD9FFD8EFDCFFD5EDD9FF616C63FF626E64FFEEF8
EFFFA4DBBCFF8CCAA6FF4389AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF3B86
BFFF6074E7FF81C5A3FF8CD0A6FF85CAA0FFD2E9D7FF646F67FF616E64FFECF7
EEFF96DBAFFF7FC99AFF63ADA5FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0
EDFF4696D9FF76C1A1FF87D0A0FF80CA9AFFD6EEDAFF646F66FF616E63FFF7FB
F8FF9BDEC4FF73C393FF80CF9FFF53AD9CFF73B9D5FFC2F6FDFF63DFF7FF5DE2
F8FF79D3F0FF4395DAFF6CB8A4FF74C38FFFD7EFDAFF646F66FF616E63FFF8FC
F9FFBCFBFBFF9DE7DFFF93E1BBFF77C997FF63BDAEFF77CBE7FFC7F7FDFF5EDC
F5FF5AE1F7FF7BD4F1FF4395DDFF589BC3FFD0E9DBFF646F66FF606D63FFF8FC
F8FFA4EBEDFF8DDFDFFF97EBEBFF72CFB7FF74CA99FF4790BDFF79D3EEFFC7F7
FDFF5FDCF5FF5BE2F7FF7AD6F2FF4399DFFFB1D4D9FF646F66FF606D62FFF8FC
F8FFAFFAFAFF94EBEBFFA2F9FAFF8AEAEBFF95EDF3FF595FEBFF6BCFE5FF7CD4
EEFFC4F6FDFF6CDDF6FF6DCAEDFF63A3D7FF66A1D3FF617474FF606D61FFF8FC
F8FF9FF1F1FF81DDDFFF8AEAEBFF75DEDEFF6591EEFF557EE2FF68DCDDFF5BBC
C5FF80D5EDFFB2E3F9FF8BC0E7FFAED3F6FFC4E0FCFF669DD0FF5F6D61FFF8FC
F8FFA6F9F9FF8BE9EAFF99F8FAFF78D3EBFF656BFFFF77DCEAFF70DFDEFFC1C5
B5FFA8C8C8FF77BEE7FFB4D2F0FFE5F3FFFFACD2EFFF4A89BEFF5F6D61FFF8FC
F8FF90EAEAFF78DDDEFF81E9EAFF4E6BE2FF639DEEFF5ED7D7FF5BCBC9FFD4B0
97FFE2BA9FFFA1ADA9FF58A5D8FF85B1DBFF469DD0FF4E7C8CFF5F6D61FFF7FC
F8FF9FF9F9FF85E9EAFF84D3FAFF525AF0FF87F2F7FF60DAD7FF98D5CAFFE0B7
9CFFEDC7A9FFE0B394FFE6B898FFDEAE8CFFD7ECD6FF636E64FF5F6D60FFF7FC
F8FF8AEAEAFF72DDDEFF5665F0FF569FDFFF73E8E8FF46C1C1FFBBBBA5FFD0A4
83FFDEB08EFFD19E7AFFD6A27AFFCF9871FFD7EBD5FF626E64FF5F6D60FFF7FC
F8FF9DF9F9FF6CB4EDFF6271FEFF80E7E9FF8CF4F4FF52CDCDFFECC2A4FFDDAD
8AFFEBBA97FFDDA780FFE2AB83FFDAA075FFD9EAD4FF616E64FF5C6A5DFFFBFC
FBFFFCFEFCFFF7FCF8FFF7FCF8FFF7FCF8FFF8FCF8FFF7FCF9FFF8FCF8FFF8FC
F8FFECF7EEFFEDF7EEFFEFF6EDFFEEF4ECFFEBF4EBFF5E6A5FFF536876FF5C6A
5DFF5F6D60FF5F6D60FF5F6D60FF5F6D60FF5F6D61FF5F6D61FF5F6D61FF5F6D
61FF606D61FF606D62FF606D62FF606D63FF5E6A5FFF454E46FF
}
ImageIndex = 19
OnClick = mnuRegionControlClick
end

View File

@ -559,7 +559,7 @@ begin
if frmDrawSettings.cbForceAltitude.Checked then
map.Altitude := frmDrawSettings.seForceAltitude.Value;
if frmDrawSettings.cbRandomHeight.Checked then
Inc(map.Altitude, Random(frmDrawSettings.seRandomHeight.Value));
map.Altitude := map.Altitude + Random(frmDrawSettings.seRandomHeight.Value);
dmNetwork.Send(TDrawMapPacket.Create(map.X, map.Y, map.Z, tileInfo^.ID));
end else
begin
@ -2047,7 +2047,7 @@ begin
begin
FGhostTile.Z := CurrentTile.Z;
if CurrentTile is TStaticItem then
Inc(FGhostTile.Z, ResMan.Tiledata.StaticTiles[CurrentTile.TileID].Height);
FGhostTile.Z := FGhostTile.Z + ResMan.Tiledata.StaticTiles[CurrentTile.TileID].Height;
end else
FGhostTile.Z := frmDrawSettings.seForceAltitude.Value;
end;

View File

@ -1,51 +1,48 @@
object frmRegionControl: TfrmRegionControl
Left = 247
Height = 392
Height = 413
Top = 139
Width = 620
ActiveControl = vstRegions
Caption = 'Region Control'
ClientHeight = 392
ClientHeight = 413
ClientWidth = 620
Font.Height = -11
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
ParentFont = False
Position = poOwnerFormCenter
ShowInTaskBar = stAlways
LCLVersion = '0.9.25'
LCLVersion = '0.9.27'
object Panel1: TPanel
Height = 359
Height = 380
Width = 160
Align = alLeft
Caption = 'Panel1'
ClientHeight = 359
ClientHeight = 380
ClientWidth = 160
ParentFont = True
TabOrder = 0
object Label1: TLabel
Left = 5
Height = 13
Top = 137
Height = 14
Top = 176
Width = 150
Align = alTop
BorderSpacing.Left = 4
BorderSpacing.Right = 4
Caption = 'Area:'
ParentColor = False
ParentFont = True
end
object pnlAreaControls: TPanel
Left = 5
Height = 82
Top = 272
Top = 293
Width = 150
Align = alBottom
BorderSpacing.Around = 4
BevelOuter = bvNone
ClientHeight = 82
ClientWidth = 150
ParentFont = True
TabOrder = 0
object lblX: TLabel
Left = 4
@ -55,7 +52,6 @@ object frmRegionControl: TfrmRegionControl
Caption = 'X'
Enabled = False
ParentColor = False
ParentFont = True
end
object lblY: TLabel
Left = 4
@ -65,7 +61,6 @@ object frmRegionControl: TfrmRegionControl
Caption = 'Y'
Enabled = False
ParentColor = False
ParentFont = True
end
object btnAddArea: TSpeedButton
Left = 30
@ -218,7 +213,6 @@ object frmRegionControl: TfrmRegionControl
Width = 50
Enabled = False
OnChange = seX1Change
ParentFont = True
TabOrder = 0
end
object seX2: TSpinEdit
@ -228,7 +222,6 @@ object frmRegionControl: TfrmRegionControl
Width = 50
Enabled = False
OnChange = seX1Change
ParentFont = True
TabOrder = 1
end
object seY1: TSpinEdit
@ -238,7 +231,6 @@ object frmRegionControl: TfrmRegionControl
Width = 50
Enabled = False
OnChange = seX1Change
ParentFont = True
TabOrder = 2
end
object seY2: TSpinEdit
@ -248,14 +240,13 @@ object frmRegionControl: TfrmRegionControl
Width = 50
Enabled = False
OnChange = seX1Change
ParentFont = True
TabOrder = 3
end
end
object vstArea: TVirtualStringTree
Left = 5
Height = 118
Top = 150
Height = 99
Top = 190
Width = 150
Align = alClient
BorderSpacing.Left = 4
@ -264,7 +255,6 @@ object frmRegionControl: TfrmRegionControl
BorderStyle = bsSingle
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
ParentFont = True
TabOrder = 1
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
@ -272,48 +262,172 @@ object frmRegionControl: TfrmRegionControl
OnGetText = vstAreaGetText
Columns = <>
end
object vstRegions: TVirtualStringTree
object spRegionsArea: TSplitter
Cursor = crVSplit
Left = 1
Height = 136
Height = 5
Top = 171
Width = 158
Align = alTop
AutoSnap = False
ResizeAnchor = akTop
end
object Panel4: TPanel
Left = 1
Height = 170
Top = 1
Width = 158
Align = alTop
Header.Options = [hoAutoResize, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
ParentFont = True
PopupMenu = pmRegions
TabOrder = 2
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChange = vstRegionsChange
OnFreeNode = vstRegionsFreeNode
OnGetText = vstRegionsGetText
Columns = <
item
Width = 158
WideText = 'Regions'
end>
Anchors = [akLeft, akRight]
BevelOuter = bvNone
ClientHeight = 170
ClientWidth = 158
TabOrder = 3
object vstRegions: TVirtualStringTree
Height = 144
Width = 158
Align = alClient
Header.Options = [hoAutoResize, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
PopupMenu = pmRegions
TabOrder = 0
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChange = vstRegionsChange
OnFreeNode = vstRegionsFreeNode
OnGetText = vstRegionsGetText
Columns = <
item
Width = 158
WideText = 'Regions'
end>
end
object Panel5: TPanel
Height = 26
Top = 144
Width = 158
Align = alBottom
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 158
TabOrder = 1
object btnAddRegion: TSpeedButton
Left = 54
Height = 22
Hint = 'Add region'
Top = 3
Width = 23
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84
37FF000000000000000000000000000000000000000000000000000000000000
00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE
89FF368D42FF2C8134FF00000000000000000000000000000000000000000000
0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB
98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000
000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5
6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000
000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8
70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC
75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8
70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF
7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2
7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5
83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC
6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000
000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD
85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000
000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4
95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000
00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF
AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000
0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD
B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000
0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE
77FF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000
}
NumGlyphs = 0
OnClick = mnuAddRegionClick
ShowHint = True
ParentShowHint = False
end
object btnDeleteRegion: TSpeedButton
Left = 82
Height = 22
Hint = 'Delete region'
Top = 3
Width = 23
Color = clBtnFace
Enabled = False
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E
B8FF000000000000000000000000000000000000000000000000000000000000
000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000
0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000
00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000
00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000
00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000
00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000
0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000
000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000
000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63
D9FF000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000
}
NumGlyphs = 0
OnClick = mnuDeleteRegionClick
ShowHint = True
ParentShowHint = False
end
end
end
end
object Panel2: TPanel
Left = 160
Height = 359
Height = 380
Width = 460
Align = alClient
Caption = 'Panel2'
ClientHeight = 359
ClientHeight = 380
ClientWidth = 460
ParentFont = True
TabOrder = 1
object sbArea: TScrollBox
Left = 1
Height = 357
Height = 378
Top = 1
Width = 458
Align = alClient
ParentFont = True
TabOrder = 0
object pbArea: TPaintBox
Height = 105
@ -327,14 +441,13 @@ object frmRegionControl: TfrmRegionControl
object Panel3: TPanel
Left = 4
Height = 25
Top = 363
Top = 384
Width = 612
Align = alBottom
BorderSpacing.Around = 4
BevelOuter = bvNone
ClientHeight = 25
ClientWidth = 612
ParentFont = True
TabOrder = 2
object btnClose: TButton
Left = 548
@ -345,7 +458,6 @@ object frmRegionControl: TfrmRegionControl
BorderSpacing.Left = 4
Caption = 'Close'
OnClick = btnCloseClick
ParentFont = True
TabOrder = 0
end
object btnSave: TButton
@ -358,7 +470,6 @@ object frmRegionControl: TfrmRegionControl
Caption = 'Save'
Enabled = False
OnClick = btnSaveClick
ParentFont = True
TabOrder = 1
end
end
@ -369,10 +480,10 @@ object frmRegionControl: TfrmRegionControl
Caption = 'Add'
OnClick = mnuAddRegionClick
end
object mnuRemoveRegion: TMenuItem
Caption = 'Remove'
object mnuDeleteRegion: TMenuItem
Caption = 'Delete'
Enabled = False
OnClick = mnuRemoveRegionClick
OnClick = mnuDeleteRegionClick
end
end
end

View File

@ -52,18 +52,23 @@ type
TfrmRegionControl = class(TForm)
btnAddArea: TSpeedButton;
btnAddRegion: TSpeedButton;
btnClearArea: TSpeedButton;
btnDeleteArea: TSpeedButton;
btnClose: TButton;
btnDeleteRegion: TSpeedButton;
btnSave: TButton;
Label1: TLabel;
lblX: TLabel;
lblY: TLabel;
mnuAddRegion: TMenuItem;
mnuRemoveRegion: TMenuItem;
mnuDeleteRegion: TMenuItem;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
pbArea: TPaintBox;
pnlAreaControls: TPanel;
pmRegions: TPopupMenu;
@ -72,10 +77,12 @@ type
seX2: TSpinEdit;
seY1: TSpinEdit;
seY2: TSpinEdit;
vstRegions: TVirtualStringTree;
spRegionsArea: TSplitter;
vstArea: TVirtualStringTree;
vstRegions: TVirtualStringTree;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure mnuAddRegionClick(Sender: TObject);
procedure mnuRemoveRegionClick(Sender: TObject);
procedure mnuDeleteRegionClick(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject);
procedure btnClearAreaClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
@ -101,10 +108,12 @@ type
FLastX: Integer;
FLastY: Integer;
FAreaMove: TAreaMove;
FTempRegionNode: PVirtualNode;
FOnRegionModified: TRegionModifiedEvent;
FOnRegionDeleted: TRegionDeletedEvent;
FOnRegionList: TRegionListEvent;
function FindRegion(AName: string): PVirtualNode;
procedure CheckUnsaved;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
@ -197,6 +206,8 @@ begin
vstArea.NodeDataSize := SizeOf(TRect);
vstRegions.NodeDataSize := SizeOf(TRegionInfo);
FTempRegionNode := nil;
frmRadarMap.Dependencies.Add(pbArea);
frmMain.RegisterAccessChangedListener(@OnAccessChanged);
@ -231,7 +242,10 @@ begin
btnSave.Enabled := False;
//Refresh the current region
regionNode := vstRegions.GetFirstSelected;
if FTempRegionNode <> nil then
regionNode := FTempRegionNode
else
regionNode := vstRegions.GetFirstSelected;
if regionNode <> nil then
begin
regionInfo := vstRegions.GetNodeData(regionNode);
@ -251,25 +265,28 @@ begin
//Clear the selection
vstRegions.ClearSelection;
FTempRegionNode := nil;
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
CheckUnsaved;
if FindRegion(regionName) = nil then
begin
node := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(node);
FTempRegionNode := vstRegions.AddChild(nil);
regionInfo := vstRegions.GetNodeData(FTempRegionNode);
regionInfo^.Name := regionName;
regionInfo^.Areas := TRectList.Create;
vstRegions.ClearSelection;
vstRegions.Selected[node] := True;
vstRegions.Selected[FTempRegionNode] := True;
btnSave.Enabled := True;
end else
begin
@ -279,7 +296,13 @@ begin
end;
end;
procedure TfrmRegionControl.mnuRemoveRegionClick(Sender: TObject);
procedure TfrmRegionControl.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
CheckUnsaved;
end;
procedure TfrmRegionControl.mnuDeleteRegionClick(Sender: TObject);
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
@ -320,13 +343,6 @@ 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;
@ -495,12 +511,7 @@ var
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;
CheckUnsaved;
vstArea.BeginUpdate;
vstArea.Clear;
@ -509,7 +520,8 @@ begin
begin
btnAddArea.Enabled := True;
btnClearArea.Enabled := True;
mnuRemoveRegion.Enabled := True;
mnuDeleteRegion.Enabled := (selected <> FTempRegionNode);
btnDeleteRegion.Enabled := (selected <> FTempRegionNode);
regionInfo := Sender.GetNodeData(selected);
for i := 0 to regionInfo^.Areas.Count - 1 do
@ -529,7 +541,8 @@ begin
btnAddArea.Enabled := False;
btnDeleteArea.Enabled := False;
btnClearArea.Enabled := False;
mnuRemoveRegion.Enabled := False;
mnuDeleteRegion.Enabled := False;
btnDeleteRegion.Enabled := False;
end;
vstArea.EndUpdate;
pbArea.Repaint;
@ -574,6 +587,24 @@ begin
end;
end;
procedure TfrmRegionControl.CheckUnsaved;
begin
if btnSave.Enabled then
begin
if 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(nil);
end else if FTempRegionNode <> nil then
begin
btnSave.Enabled := False;
vstRegions.DeleteNode(FTempRegionNode);
FTempRegionNode := nil;
end;
end;
end;
procedure TfrmRegionControl.OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
var
regionName: string;