- Added selection listener to TfrmMain

- Added "grab coordinates" using the new selection listener to TfrmLargeScaleCommand (fixes #54)
This commit is contained in:
Andreas Schneider 2009-12-19 13:57:29 +01:00
parent ff87bdea15
commit 387d5fb28d
4 changed files with 2871 additions and 2703 deletions

View File

@ -3,6 +3,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Height = 390 Height = 390
Top = 171 Top = 171
Width = 620 Width = 620
ActiveControl = vstActions
Caption = 'Large Scale Commands' Caption = 'Large Scale Commands'
ClientHeight = 390 ClientHeight = 390
ClientWidth = 620 ClientWidth = 620
@ -57,7 +58,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgCopyMove: TPage object pgCopyMove: TPage
Caption = 'Copy/Move' Caption = 'Copy/Move'
ClientWidth = 462 ClientWidth = 462
ClientHeight = 343 ClientHeight = 316
object rgCMAction: TRadioGroup object rgCMAction: TRadioGroup
AnchorSideLeft.Control = pgCopyMove AnchorSideLeft.Control = pgCopyMove
AnchorSideTop.Control = pgCopyMove AnchorSideTop.Control = pgCopyMove
@ -130,7 +131,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 27 Left = 27
Height = 19 Height = 19
Top = 8 Top = 8
Width = 84 Width = 82
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 8 BorderSpacing.Around = 8
TabOrder = 0 TabOrder = 0
@ -144,7 +145,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 27 Left = 27
Height = 19 Height = 19
Top = 35 Top = 35
Width = 84 Width = 82
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
TabOrder = 1 TabOrder = 1
end end
@ -165,7 +166,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgModifyAltitude: TPage object pgModifyAltitude: TPage
Caption = 'Modify altitude' Caption = 'Modify altitude'
ClientWidth = 462 ClientWidth = 462
ClientHeight = 343 ClientHeight = 316
object Label2: TLabel object Label2: TLabel
AnchorSideLeft.Control = rbSetTerrainAltitude AnchorSideLeft.Control = rbSetTerrainAltitude
AnchorSideTop.Control = rbSetTerrainAltitude AnchorSideTop.Control = rbSetTerrainAltitude
@ -272,20 +273,20 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgDrawTerrain: TPage object pgDrawTerrain: TPage
Caption = 'Draw Terrain' Caption = 'Draw Terrain'
ClientWidth = 462 ClientWidth = 462
ClientHeight = 343 ClientHeight = 316
object gbDrawTerrainTiles: TGroupBox object gbDrawTerrainTiles: TGroupBox
AnchorSideLeft.Control = pgDrawTerrain AnchorSideLeft.Control = pgDrawTerrain
AnchorSideTop.Control = pgDrawTerrain AnchorSideTop.Control = pgDrawTerrain
AnchorSideBottom.Control = pgDrawTerrain AnchorSideBottom.Control = pgDrawTerrain
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 327 Height = 300
Top = 8 Top = 8
Width = 225 Width = 225
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 313 ClientHeight = 286
ClientWidth = 223 ClientWidth = 223
TabOrder = 0 TabOrder = 0
object lblDrawTerrainTilesDesc: TLabel object lblDrawTerrainTilesDesc: TLabel
@ -312,7 +313,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideBottom.Control = btnDeleteTerrain AnchorSideBottom.Control = btnDeleteTerrain
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 217 Height = 200
Top = 66 Top = 66
Width = 215 Width = 215
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
@ -358,7 +359,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 30 Left = 30
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Clear'
Top = 287 Top = 270
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Color = clBtnFace Color = clBtnFace
@ -410,7 +411,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Delete'
Top = 287 Top = 270
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -461,20 +462,20 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgDeleteStatics: TPage object pgDeleteStatics: TPage
Caption = 'Delete statics' Caption = 'Delete statics'
ClientWidth = 462 ClientWidth = 462
ClientHeight = 343 ClientHeight = 316
object gbDeleteStaticsTiles: TGroupBox object gbDeleteStaticsTiles: TGroupBox
AnchorSideLeft.Control = pgDeleteStatics AnchorSideLeft.Control = pgDeleteStatics
AnchorSideTop.Control = pgDeleteStatics AnchorSideTop.Control = pgDeleteStatics
AnchorSideBottom.Control = pgDeleteStatics AnchorSideBottom.Control = pgDeleteStatics
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 327 Height = 300
Top = 8 Top = 8
Width = 225 Width = 225
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 313 ClientHeight = 286
ClientWidth = 223 ClientWidth = 223
TabOrder = 0 TabOrder = 0
object lblDeleteStaticsTilesDesc: TLabel object lblDeleteStaticsTilesDesc: TLabel
@ -485,7 +486,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 78 Height = 78
Top = 0 Top = 0
Width = 215 Width = 213
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -504,9 +505,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideBottom.Control = btnDeleteDStaticsTiles AnchorSideBottom.Control = btnDeleteDStaticsTiles
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 201 Height = 184
Top = 82 Top = 82
Width = 215 Width = 213
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -550,7 +551,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 30 Left = 30
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Clear'
Top = 287 Top = 270
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Color = clBtnFace Color = clBtnFace
@ -602,7 +603,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Delete'
Top = 287 Top = 270
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -670,7 +671,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 30 Height = 30
Top = 0 Top = 0
Width = 166 Width = 164
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -723,20 +724,20 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object pgInsertStatics: TPage object pgInsertStatics: TPage
Caption = 'Insert statics' Caption = 'Insert statics'
ClientWidth = 462 ClientWidth = 462
ClientHeight = 343 ClientHeight = 316
object gbInserStaticsTiles: TGroupBox object gbInserStaticsTiles: TGroupBox
AnchorSideLeft.Control = pgInsertStatics AnchorSideLeft.Control = pgInsertStatics
AnchorSideTop.Control = pgInsertStatics AnchorSideTop.Control = pgInsertStatics
AnchorSideBottom.Control = pgInsertStatics AnchorSideBottom.Control = pgInsertStatics
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 327 Height = 300
Top = 8 Top = 8
Width = 225 Width = 225
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 313 ClientHeight = 286
ClientWidth = 223 ClientWidth = 223
TabOrder = 0 TabOrder = 0
object lblInsertStaticsTiles: TLabel object lblInsertStaticsTiles: TLabel
@ -747,7 +748,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 62 Height = 62
Top = 0 Top = 0
Width = 215 Width = 213
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -765,9 +766,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDeleteIStaticsTiles AnchorSideBottom.Control = btnDeleteIStaticsTiles
Left = 4 Left = 4
Height = 217 Height = 200
Top = 66 Top = 66
Width = 215 Width = 213
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -810,7 +811,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 30 Left = 30
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Clear'
Top = 287 Top = 270
Width = 22 Width = 22
Color = clBtnFace Color = clBtnFace
Glyph.Data = { Glyph.Data = {
@ -861,7 +862,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Delete'
Top = 287 Top = 270
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
@ -929,7 +930,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 30 Height = 30
Top = 0 Top = 0
Width = 175 Width = 173
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -990,7 +991,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 22 Height = 22
Top = 4 Top = 4
Width = 175 Width = 173
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -1009,7 +1010,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 22 Height = 22
Top = 26 Top = 26
Width = 175 Width = 173
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
Caption = 'Place tiles on top' Caption = 'Place tiles on top'
TabOrder = 1 TabOrder = 1
@ -1024,7 +1025,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 4 Left = 4
Height = 22 Height = 22
Top = 48 Top = 48
Width = 175 Width = 173
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
Caption = 'Place tiles on:' Caption = 'Place tiles on:'
TabOrder = 2 TabOrder = 2
@ -1083,7 +1084,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDeleteArea AnchorSideBottom.Control = btnDeleteArea
Left = 4 Left = 4
Height = 144 Height = 118
Top = 154 Top = 154
Width = 144 Width = 144
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -1152,7 +1153,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 39 Left = 39
Height = 22 Height = 22
Hint = 'Add area' Hint = 'Add area'
Top = 306 Top = 280
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Color = clBtnFace Color = clBtnFace
@ -1205,7 +1206,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 65 Left = 65
Height = 22 Height = 22
Hint = 'Delete area' Hint = 'Delete area'
Top = 306 Top = 280
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
@ -1261,7 +1262,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 91 Left = 91
Height = 22 Height = 22
Hint = 'Delete all areas' Hint = 'Delete all areas'
Top = 306 Top = 280
Width = 22 Width = 22
Color = clBtnFace Color = clBtnFace
Glyph.Data = { Glyph.Data = {
@ -1311,7 +1312,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 14 Height = 14
Top = 338 Top = 312
Width = 8 Width = 8
Caption = 'X' Caption = 'X'
Enabled = False Enabled = False
@ -1322,7 +1323,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideBottom.Control = seY1 AnchorSideBottom.Control = seY1
Left = 20 Left = 20
Height = 19 Height = 19
Top = 336 Top = 310
Width = 50 Width = 50
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
@ -1337,7 +1338,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideTop.Control = seX1 AnchorSideTop.Control = seX1
Left = 78 Left = 78
Height = 19 Height = 19
Top = 336 Top = 310
Width = 50 Width = 50
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Enabled = False Enabled = False
@ -1351,7 +1352,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 14 Height = 14
Top = 365 Top = 339
Width = 8 Width = 8
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'Y' Caption = 'Y'
@ -1361,15 +1362,14 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object seY1: TSpinEdit object seY1: TSpinEdit
AnchorSideLeft.Control = lblY AnchorSideLeft.Control = lblY
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = btnGrab1
AnchorSideBottom.Side = asrBottom
Left = 20 Left = 20
Height = 19 Height = 19
Top = 363 Top = 337
Width = 50 Width = 50
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 4
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
TabOrder = 7 TabOrder = 7
@ -1380,11 +1380,114 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideTop.Control = seY1 AnchorSideTop.Control = seY1
Left = 78 Left = 78
Height = 19 Height = 19
Top = 363 Top = 337
Width = 50 Width = 50
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
TabOrder = 8 TabOrder = 8
Value = 1 Value = 1
end end
object btnGrab1: TSpeedButton
AnchorSideLeft.Control = seY1
AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 34
Height = 22
Top = 360
Width = 22
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 8
Color = clBtnFace
Enabled = False
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C
7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA
AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB
DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2
F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1
C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191
91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595
95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7
E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7
E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6
C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7
A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
NumGlyphs = 0
OnClick = btnGrab1Click
end
object btnGrab2: TSpeedButton
AnchorSideLeft.Control = seY2
AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = btnGrab1
AnchorSideBottom.Side = asrBottom
Left = 92
Height = 22
Top = 360
Width = 22
Anchors = [akLeft, akBottom]
Color = clBtnFace
Enabled = False
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7F067C7C
7CE6787878CC75757581FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008383835DAAAA
AAFFDBDBDBFF797979F275757506FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF0097979709FFFFFF00FFFFFF00FFFFFF00888888E7DBDB
DBFFB7B7B7FF7D7D7D80FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF009C9C9CC99898981EFFFFFF0090909050ADADADFFF2F2
F2FF848484FD8181810FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A0A0A0FF9C9C9CE798989836949494DFD9D9D9FFC1C1
C1FF898989A0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A4A4A4FFD7D7D7FF9D9D9DF8D0D0D0FFEEEEEEFF9191
91FE8D8D8D18FFFFFF00FFFFFF00818181097E7E7E09FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00A9A9A9FFF2F2F2FFE5E5E5FFE2E2E2FFE3E3E3FF9595
95F4919191CC8D8D8DF9898989FF86868693FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00ADADADFFEEEEEEFFE1E1E1FFDFDFDFFFE0E0E0FFE7E7
E7FFE4E4E4FFBBBBBBFF8E8E8E93FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00B1B1B1FFF0F0F0FFE4E4E4FFE2E2E2FFE2E2E2FFE7E7
E7FFC1C1C1FF96969690FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00B5B5B5FFF2F2F2FFE8E8E8FFE7E7E7FFEAEAEAFFC6C6
C6FF9E9E9E8DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00B9B9B9FFF4F4F4FFECECECFFEDEDEDFFCBCBCBFFA7A7
A78AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00BDBDBDFFF7F7F7FFEFEFEFFFD0D0D0FFAFAFAF8AFFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00C1C1C1FFF7F7F7FFD5D5D5FFB6B6B687FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00C4C4C4FFD9D9D9FFBEBEBE84FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00C8C8C8FFC5C5C581FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
NumGlyphs = 0
OnClick = btnGrab1Click
end
end end

View File

@ -32,7 +32,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
UPlatformTypes, UEnhancedMemoryStream; UPlatformTypes, UEnhancedMemoryStream, UWorldItem;
type type
@ -104,11 +104,14 @@ type
seX2: TSpinEdit; seX2: TSpinEdit;
seY1: TSpinEdit; seY1: TSpinEdit;
seY2: TSpinEdit; seY2: TSpinEdit;
btnGrab1: TSpeedButton;
btnGrab2: TSpeedButton;
vdtTerrainTiles: TVirtualDrawTree; vdtTerrainTiles: TVirtualDrawTree;
vdtInsertStaticsTiles: TVirtualDrawTree; vdtInsertStaticsTiles: TVirtualDrawTree;
vdtDeleteStaticsTiles: TVirtualDrawTree; vdtDeleteStaticsTiles: TVirtualDrawTree;
vstActions: TVirtualStringTree; vstActions: TVirtualStringTree;
vstArea: TVirtualStringTree; vstArea: TVirtualStringTree;
procedure btnGrab1Click(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject); procedure btnAddAreaClick(Sender: TObject);
procedure btnClearDStaticsTilesClick(Sender: TObject); procedure btnClearDStaticsTilesClick(Sender: TObject);
@ -123,8 +126,8 @@ type
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton; procedure pbAreaMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer procedure pbAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
); Y: Integer);
procedure pbAreaPaint(Sender: TObject); procedure pbAreaPaint(Sender: TObject);
procedure btnDeleteAreaClick(Sender: TObject); procedure btnDeleteAreaClick(Sender: TObject);
procedure btnClearAreaClick(Sender: TObject); procedure btnClearAreaClick(Sender: TObject);
@ -158,8 +161,11 @@ type
FDrawTerrainNode: PVirtualNode; FDrawTerrainNode: PVirtualNode;
FDelStaticsNode: PVirtualNode; FDelStaticsNode: PVirtualNode;
FAddStaticsNode: PVirtualNode; FAddStaticsNode: PVirtualNode;
FSelectFirst: Boolean;
FOldWindowState: TWindowState;
function AddNode(AActionID: Integer; ACaption: String): PVirtualNode; function AddNode(AActionID: Integer; ACaption: String): PVirtualNode;
function FindNode(AActionID: Integer): PVirtualNode; function FindNode(AActionID: Integer): PVirtualNode;
procedure TileSelection(AWorldItem: TWorldItem);
procedure SerializeTiles(ATileList: TVirtualDrawTree; procedure SerializeTiles(ATileList: TVirtualDrawTree;
AStream: TEnhancedMemoryStream); AStream: TEnhancedMemoryStream);
public public
@ -308,6 +314,15 @@ begin
SetWindowParent(Handle, frmMain.Handle); SetWindowParent(Handle, frmMain.Handle);
end; end;
procedure TfrmLargeScaleCommand.btnGrab1Click(Sender: TObject);
begin
FSelectFirst := (Sender = btnGrab1);
frmMain.RegisterSelectionListener(@TileSelection);
FOldWindowState := WindowState;
WindowState := wsMinimized;
frmMain.SwitchToSelection;
end;
procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject);
begin begin
vdtDeleteStaticsTiles.Clear; vdtDeleteStaticsTiles.Clear;
@ -621,6 +636,8 @@ begin
seX2.Enabled := selected; seX2.Enabled := selected;
seY1.Enabled := selected; seY1.Enabled := selected;
seY2.Enabled := selected; seY2.Enabled := selected;
btnGrab1.Enabled := selected;
btnGrab2.Enabled := selected;
if selected then if selected then
begin begin
nodeInfo := Sender.GetNodeData(Node); nodeInfo := Sender.GetNodeData(Node);
@ -675,6 +692,22 @@ begin
end; end;
end; end;
procedure TfrmLargeScaleCommand.TileSelection(AWorldItem: TWorldItem);
begin
if FSelectFirst then
begin
seX1.Value := AWorldItem.X;
seY1.Value := AWorldItem.Y;
end else
begin
seX2.Value := AWorldItem.X;
seY2.Value := AWorldItem.Y;
end;
seX1Change(nil);
frmMain.UnregisterSelectionListener(@TileSelection);
WindowState := FOldWindowState;
end;
procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualDrawTree; procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualDrawTree;
AStream: TEnhancedMemoryStream); AStream: TEnhancedMemoryStream);
var var

View File

@ -618,11 +618,11 @@ object frmMain: TfrmMain
end end
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 495 ClientHeight = 468
ClientWidth = 218 ClientWidth = 218
object lbClients: TListBox object lbClients: TListBox
Left = 0 Left = 0
Height = 495 Height = 468
Top = 0 Top = 0
Width = 218 Width = 218
Align = alClient Align = alClient
@ -636,7 +636,7 @@ object frmMain: TfrmMain
end end
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 495 ClientHeight = 468
ClientWidth = 218 ClientWidth = 218
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation AnchorSideLeft.Control = btnDeleteLocation
@ -645,7 +645,7 @@ object frmMain: TfrmMain
Left = 125 Left = 125
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Clear'
Top = 469 Top = 442
Width = 23 Width = 23
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Color = clBtnFace Color = clBtnFace
@ -698,7 +698,7 @@ object frmMain: TfrmMain
Left = 98 Left = 98
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Delete'
Top = 469 Top = 442
Width = 23 Width = 23
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
@ -750,7 +750,7 @@ object frmMain: TfrmMain
Left = 71 Left = 71
Height = 22 Height = 22
Hint = 'Add' Hint = 'Add'
Top = 469 Top = 442
Width = 23 Width = 23
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -804,7 +804,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 461 Height = 434
Top = 4 Top = 4
Width = 210 Width = 210
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]

View File

@ -39,11 +39,13 @@ uses
type type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object; TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
TSelectionListener = procedure(AWorldItem: TWorldItem) of object;
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered); TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
TScreenBufferStates = set of TScreenBufferState; TScreenBufferStates = set of TScreenBufferState;
TGhostTile = class(TStaticItem); TGhostTile = class(TStaticItem);
TPacketList = specialize TFPGObjectList<TPacket>; TPacketList = specialize TFPGObjectList<TPacket>;
TSelectionListeners = specialize TFPGList<TSelectionListener>;
{ TfrmMain } { TfrmMain }
@ -312,6 +314,7 @@ type
FSelection: TRect; FSelection: TRect;
FUndoList: TPacketList; FUndoList: TPacketList;
FGLFont: TGLFont; FGLFont: TGLFont;
FSelectionListeners: TSelectionListeners;
{ Methods } { Methods }
procedure BuildTileList; procedure BuildTileList;
function ConfirmAction: Boolean; function ConfirmAction: Boolean;
@ -366,8 +369,11 @@ type
procedure InvalidateFilter; procedure InvalidateFilter;
procedure InvalidateScreenBuffer; procedure InvalidateScreenBuffer;
procedure RegisterAccessChangedListener(AListener: TAccessChangedListener); procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
procedure RegisterSelectionListener(AListener: TSelectionListener);
procedure SetPos(AX, AY: Word); procedure SetPos(AX, AY: Word);
procedure SwitchToSelection;
procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener); procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
procedure UnregisterSelectionListener(AListener: TSelectionListener);
end; end;
var var
@ -636,10 +642,16 @@ begin
targetTile := CurrentTile; targetTile := CurrentTile;
if acSelect.Checked and tmGrabTileInfo.Enabled then if acSelect.Checked then
begin begin
tmGrabTileInfo.Enabled := False; if tmGrabTileInfo.Enabled then
mnuGrabTileIDClick(nil); begin
tmGrabTileInfo.Enabled := False;
mnuGrabTileIDClick(nil);
end;
for i := FSelectionListeners.Count - 1 downto 0 do
FSelectionListeners[i](CurrentTile);
end; end;
if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then
@ -904,6 +916,8 @@ begin
DoubleBuffered := True; DoubleBuffered := True;
pnlBottom.DoubleBuffered := True; pnlBottom.DoubleBuffered := True;
FSelectionListeners := TSelectionListeners.Create;
FLastDraw := Now; FLastDraw := Now;
end; end;
@ -1230,6 +1244,7 @@ begin
FreeAndNil(FUndoList); FreeAndNil(FUndoList);
FreeAndNil(FGLFont); FreeAndNil(FGLFont);
FreeAndNil(FRandomPresetsDoc); FreeAndNil(FRandomPresetsDoc);
FreeAndNil(FSelectionListeners);
RegisterPacketHandler($0C, nil); RegisterPacketHandler($0C, nil);
end; end;
@ -1792,6 +1807,12 @@ begin
end; end;
end; end;
procedure TfrmMain.SwitchToSelection;
begin
acSelect.Checked := True;
BringToFront;
end;
procedure TfrmMain.RegisterAccessChangedListener( procedure TfrmMain.RegisterAccessChangedListener(
AListener: TAccessChangedListener); AListener: TAccessChangedListener);
var var
@ -1804,6 +1825,12 @@ begin
FAccessChangedListeners[High(FAccessChangedListeners)] := AListener; FAccessChangedListeners[High(FAccessChangedListeners)] := AListener;
end; end;
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin
if FSelectionListeners.IndexOf(AListener) < 0 then
FSelectionListeners.Add(AListener);
end;
procedure TfrmMain.UnregisterAccessChangedListener( procedure TfrmMain.UnregisterAccessChangedListener(
AListener: TAccessChangedListener); AListener: TAccessChangedListener);
var var
@ -1827,6 +1854,11 @@ begin
end; end;
end; end;
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
begin
FSelectionListeners.Remove(AListener);
end;
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem); procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
begin begin
Logger.EnterMethod([lcClient, lcDebug], 'SetCurrentTile'); Logger.EnterMethod([lcClient, lcDebug], 'SetCurrentTile');