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

- Several code cleanups

Browse Source 
- Fixed TArt.RefreshBuffer using the wrong variable (j <> i)
- Suppressed some hints
This commit is contained in:
Andreas Schneider
2009-12-17 15:41:54 +01:00
parent 13264d3251
commit c41fd3be95
17 changed files with 4091 additions and 4105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

638
Client/Tools/UfrmFilter.lfm
View File

@@ -1,319 +1,319 @@
object frmFilter: TfrmFilter
Left = 290
Height = 492
Top = 171
Width = 232
ActiveControl = rgFilterType.RadioButton0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow
Caption = 'Filter'
ClientHeight = 492
ClientWidth = 232
Font.Height = -11
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
LCLVersion = '0.9.27'
object rgFilterType: TRadioGroup
Left = 4
Height = 40
Top = 4
Width = 224
Align = alTop
AutoFill = True
BorderSpacing.Around = 4
Caption = 'Filter rule'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 26
ClientWidth = 222
Columns = 2
ItemIndex = 0
Items.Strings = (
'Exclusive'
'Inclusive'
)
OnClick = rgFilterTypeClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 4
Height = 259
Top = 48
Width = 224
Align = alClient
BorderSpacing.Around = 4
Caption = 'Tile filter'
ClientHeight = 245
ClientWidth = 222
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = cbTileFilter
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 4
Height = 30
Top = 30
Width = 214
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 4
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
ParentColor = False
WordWrap = True
end
object btnClear: TSpeedButton
AnchorSideLeft.Control = btnDelete
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrCenter
AnchorSideBottom.Control = btnDelete
AnchorSideBottom.Side = asrBottom
Left = 30
Height = 22
Hint = 'Clear'
Top = 219
Width = 22
Anchors = [akLeft, akBottom]
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000003ADCFE004800
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
9B000000000000000000000000000000000000000000000000000EECFF00B2FC
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
DF000000000000000000000000002070DF000000000000000000
}
NumGlyphs = 0
OnClick = btnClearClick
ShowHint = True
ParentShowHint = False
end
object btnDelete: TSpeedButton
AnchorSideLeft.Control = GroupBox1
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 22
Hint = 'Delete'
Top = 219
Width = 22
Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000004F91AB005588
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
0200F2000200080104000E040200F8040400F200040009010500
}
NumGlyphs = 0
OnClick = btnDeleteClick
ShowHint = True
ParentShowHint = False
end
object vdtFilter: TVirtualDrawTree
Tag = 1
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDelete
Cursor = 63
Left = 4
Height = 151
Top = 64
Width = 214
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
DefaultNodeHeight = 44
DragType = dtVCL
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 0
Text = 'ID'
end
item
Position = 1
Text = 'Tile'
Width = 44
end
item
Position = 2
Text = 'Name'
Width = 100
end>
Header.DefaultHeight = 17
Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
OnDragOver = vdtFilterDragOver
OnDragDrop = vdtFilterDragDrop
OnDrawNode = vdtFilterDrawNode
end
object cbTileFilter: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
Left = 4
Height = 22
Top = 4
Width = 85
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbTileFilterChange
TabOrder = 1
end
end
object GroupBox2: TGroupBox
Left = 4
Height = 168
Top = 320
Width = 224
Align = alBottom
BorderSpacing.Around = 4
Caption = 'Hue filter'
ClientHeight = 154
ClientWidth = 222
TabOrder = 2
object cbHueFilter: TCheckBox
Left = 4
Height = 22
Top = 4
Width = 214
Align = alTop
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbHueFilterChange
TabOrder = 0
end
object vdtHues: TVirtualDrawTree
Cursor = 63
Left = 4
Height = 120
Top = 30
Width = 214
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsSingle
Header.AutoSizeIndex = 2
Header.Columns = <
item
Position = 0
Width = 20
end
item
Position = 1
Text = 'Hue'
Width = 38
end
item
Position = 2
Text = 'Name'
Width = 154
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
PopupMenu = pmHues
TabOrder = 1
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChecked = vdtHuesChecked
OnDrawNode = vdtHuesDrawNode
end
end
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 311
Width = 232
Align = alBottom
ResizeAnchor = akBottom
end
object pmHues: TPopupMenu
left = 148
top = 404
object mnuCheckHues: TMenuItem
Caption = 'Check all hues'
OnClick = mnuCheckHuesClick
end
object mnuUncheckHues: TMenuItem
Caption = 'Uncheck all hues'
OnClick = mnuUncheckHuesClick
end
end
end
object frmFilter: TfrmFilter
Left = 290
Height = 492
Top = 171
Width = 232
ActiveControl = rgFilterType.RadioButton0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow
Caption = 'Filter'
ClientHeight = 492
ClientWidth = 232
Font.Height = -11
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
LCLVersion = '0.9.29'
object rgFilterType: TRadioGroup
Left = 4
Height = 40
Top = 4
Width = 224
Align = alTop
AutoFill = True
BorderSpacing.Around = 4
Caption = 'Filter rule'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 22
ClientWidth = 220
Columns = 2
ItemIndex = 0
Items.Strings = (
'Exclusive'
'Inclusive'
)
OnClick = rgFilterTypeClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 4
Height = 259
Top = 48
Width = 224
Align = alClient
BorderSpacing.Around = 4
Caption = 'Tile filter'
ClientHeight = 241
ClientWidth = 220
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = cbTileFilter
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 4
Height = 27
Top = 27
Width = 212
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 4
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
ParentColor = False
WordWrap = True
end
object btnClear: TSpeedButton
AnchorSideLeft.Control = btnDelete
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrCenter
AnchorSideBottom.Control = btnDelete
AnchorSideBottom.Side = asrBottom
Left = 30
Height = 22
Hint = 'Clear'
Top = 215
Width = 22
Anchors = [akLeft, akBottom]
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000003ADCFE004800
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
9B000000000000000000000000000000000000000000000000000EECFF00B2FC
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
DF000000000000000000000000002070DF000000000000000000
}
NumGlyphs = 0
OnClick = btnClearClick
ShowHint = True
ParentShowHint = False
end
object btnDelete: TSpeedButton
AnchorSideLeft.Control = GroupBox1
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 22
Hint = 'Delete'
Top = 215
Width = 22
Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000004F91AB005588
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
0200F2000200080104000E040200F8040400F200040009010500
}
NumGlyphs = 0
OnClick = btnDeleteClick
ShowHint = True
ParentShowHint = False
end
object vdtFilter: TVirtualDrawTree
Tag = 1
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDelete
Cursor = 63
Left = 4
Height = 153
Top = 58
Width = 212
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
DefaultNodeHeight = 44
DragType = dtVCL
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 0
Text = 'ID'
end
item
Position = 1
Text = 'Tile'
Width = 44
end
item
Position = 2
Text = 'Name'
Width = 100
end>
Header.DefaultHeight = 17
Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
OnDragOver = vdtFilterDragOver
OnDragDrop = vdtFilterDragDrop
OnDrawNode = vdtFilterDrawNode
end
object cbTileFilter: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
Left = 4
Height = 19
Top = 4
Width = 78
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbTileFilterChange
TabOrder = 1
end
end
object GroupBox2: TGroupBox
Left = 4
Height = 168
Top = 320
Width = 224
Align = alBottom
BorderSpacing.Around = 4
Caption = 'Hue filter'
ClientHeight = 150
ClientWidth = 220
TabOrder = 2
object cbHueFilter: TCheckBox
Left = 4
Height = 19
Top = 4
Width = 212
Align = alTop
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbHueFilterChange
TabOrder = 0
end
object vdtHues: TVirtualDrawTree
Cursor = 63
Left = 4
Height = 119
Top = 27
Width = 212
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsSingle
Header.AutoSizeIndex = 2
Header.Columns = <
item
Position = 0
Width = 20
end
item
Position = 1
Text = 'Hue'
Width = 38
end
item
Position = 2
Text = 'Name'
Width = 150
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
PopupMenu = pmHues
TabOrder = 1
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChecked = vdtHuesChecked
OnDrawNode = vdtHuesDrawNode
end
end
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 311
Width = 232
Align = alBottom
ResizeAnchor = akBottom
end
object pmHues: TPopupMenu
left = 148
top = 404
object mnuCheckHues: TMenuItem
Caption = 'Check all hues'
OnClick = mnuCheckHuesClick
end
object mnuUncheckHues: TMenuItem
Caption = 'Uncheck all hues'
OnClick = mnuUncheckHuesClick
end
end
end

706
Client/Tools/UfrmFilter.pas
View File

@@ -1,353 +1,353 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmFilter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
PairSplitter, Menus;
type
{ TfrmFilter }
TfrmFilter = class(TForm)
btnClear: TSpeedButton;
btnDelete: TSpeedButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
cbRandomPreset: TComboBox;
cbTileFilter: TCheckBox;
cbHueFilter: TCheckBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
mnuUncheckHues: TMenuItem;
mnuCheckHues: TMenuItem;
pnlRandomPreset: TPanel;
pmHues: TPopupMenu;
rgFilterType: TRadioGroup;
Splitter1: TSplitter;
vdtFilter: TVirtualDrawTree;
vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure cbHueFilterChange(Sender: TObject);
procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
protected
FLocked: Boolean;
FCheckedHues: TBits;
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
property Locked: Boolean read FLocked write FLocked;
function Filter(AStatic: TStaticItem): Boolean;
procedure JumpToHue(AHueID: Word);
end;
var
frmFilter: TfrmFilter;
implementation
uses
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
type
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: Word;
end;
PHueInfo = ^THueInfo;
THueInfo = record
ID: Word;
Hue: THue;
end;
{ TfrmFilter }
procedure TfrmFilter.FormShow(Sender: TObject);
var
upperLeft, lowerLeft: TPoint;
begin
upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
frmMain.pcLeft.Height));
Left := upperLeft.x - 4;
Top := upperLeft.y - 4;
Height := lowerLeft.y - upperLeft.y;
SetWindowParent(Handle, frmMain.Handle);
end;
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
begin
vdtHues.ClearChecked;
end;
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
var
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
vdtHues.CheckState[node] := csCheckedNormal;
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
sourceTree: TVirtualDrawTree;
selected, node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo;
begin
sourceTree := Source as TVirtualDrawTree;
if (sourceTree <> Sender) and (sourceTree <> nil) and
(sourceTree.Tag = 1) then
begin
Sender.BeginUpdate;
selected := sourceTree.GetFirstSelected;
while selected <> nil do
begin
sourceTileInfo := sourceTree.GetNodeData(selected);
if sourceTileInfo^.ID > $3FFF then
begin
node := Sender.AddChild(nil);
targetTileInfo := Sender.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID;
cbTileFilter.Checked := True;
frmMain.InvalidateFilter;
end;
selected := sourceTree.GetNextSelected(selected);
end;
Sender.EndUpdate;
end;
end;
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
if (Source <> Sender) and (Source is TVirtualDrawTree) and
(TVirtualDrawTree(Source).Tag = 1) then
begin
Accept := True;
end;
end;
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
begin
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
end;
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
hueInfo: PHueInfo;
begin
hueInfo := Sender.GetNodeData(Node);
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
cbHueFilter.Checked := True;
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
hueInfo: PHueInfo;
hueColor: TColor;
i: Integer;
textStyle: TTextStyle;
begin
hueInfo := Sender.GetNodeData(PaintInfo.Node);
textStyle := PaintInfo.Canvas.TextStyle;
textStyle.Alignment := taLeftJustify;
textStyle.Layout := tlCenter;
textStyle.Wordbreak := True;
case PaintInfo.Column of
1:
begin
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
PaintInfo.Canvas.Pen.Color := hueColor;
PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
end;
end;
2:
begin
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
end;
end;
end;
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
begin
{if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
Close;}
end;
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
var
found: Boolean;
tileInfo: PTileInfo;
node: PVirtualNode;
id: Word;
begin
if cbTileFilter.Checked then
begin
id := AStatic.TileID + $4000;
found := False;
node := vdtFilter.GetFirst;
while (node <> nil) and (not found) do
begin
tileInfo := vdtFilter.GetNodeData(node);
if tileInfo^.ID = id then
found := True
else
node := vdtFilter.GetNext(node);
end;
Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
((rgFilterType.ItemIndex = 1) and found);
end else
Result := True;
if cbHueFilter.Checked then
begin
Result := Result and (
((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
);
end;
end;
procedure TfrmFilter.JumpToHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.FormCreate(Sender: TObject);
var
i: Integer;
hueInfo: PHueInfo;
node: PVirtualNode;
begin
FLocked := False;
vdtFilter.NodeDataSize := SizeOf(TTileInfo);
vdtHues.NodeDataSize := SizeOf(THueInfo);
vdtHues.BeginUpdate;
vdtHues.Clear;
for i := 0 to ResMan.Hue.Count - 1 do
begin
node := vdtHues.AddChild(nil);
hueInfo := vdtHues.GetNodeData(node);
hueInfo^.ID := i + 1;
hueInfo^.Hue := ResMan.Hue.Hues[i];
vdtHues.CheckType[node] := ctCheckBox;
end;
vdtHues.EndUpdate;
FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
//FCheckedHues.Bits[0] := True;
end;
procedure TfrmFilter.FormDestroy(Sender: TObject);
begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin
vdtFilter.DeleteSelectedNodes;
end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.btnClearClick(Sender: TObject);
begin
vdtFilter.Clear;
end;
initialization
{$I UfrmFilter.lrs}
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmFilter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
Menus;
type
{ TfrmFilter }
TfrmFilter = class(TForm)
btnClear: TSpeedButton;
btnDelete: TSpeedButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
cbRandomPreset: TComboBox;
cbTileFilter: TCheckBox;
cbHueFilter: TCheckBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
mnuUncheckHues: TMenuItem;
mnuCheckHues: TMenuItem;
pnlRandomPreset: TPanel;
pmHues: TPopupMenu;
rgFilterType: TRadioGroup;
Splitter1: TSplitter;
vdtFilter: TVirtualDrawTree;
vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure cbHueFilterChange(Sender: TObject);
procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
protected
FLocked: Boolean;
FCheckedHues: TBits;
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
property Locked: Boolean read FLocked write FLocked;
function Filter(AStatic: TStaticItem): Boolean;
procedure JumpToHue(AHueID: Word);
end;
var
frmFilter: TfrmFilter;
implementation
uses
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
type
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: Word;
end;
PHueInfo = ^THueInfo;
THueInfo = record
ID: Word;
Hue: THue;
end;
{ TfrmFilter }
procedure TfrmFilter.FormShow(Sender: TObject);
var
upperLeft, lowerLeft: TPoint;
begin
upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
frmMain.pcLeft.Height));
Left := upperLeft.x - 4;
Top := upperLeft.y - 4;
Height := lowerLeft.y - upperLeft.y;
SetWindowParent(Handle, frmMain.Handle);
end;
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
begin
vdtHues.ClearChecked;
end;
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
var
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
vdtHues.CheckState[node] := csCheckedNormal;
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
sourceTree: TVirtualDrawTree;
selected, node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo;
begin
sourceTree := Source as TVirtualDrawTree;
if (sourceTree <> Sender) and (sourceTree <> nil) and
(sourceTree.Tag = 1) then
begin
Sender.BeginUpdate;
selected := sourceTree.GetFirstSelected;
while selected <> nil do
begin
sourceTileInfo := sourceTree.GetNodeData(selected);
if sourceTileInfo^.ID > $3FFF then
begin
node := Sender.AddChild(nil);
targetTileInfo := Sender.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID;
cbTileFilter.Checked := True;
frmMain.InvalidateFilter;
end;
selected := sourceTree.GetNextSelected(selected);
end;
Sender.EndUpdate;
end;
end;
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
if (Source <> Sender) and (Source is TVirtualDrawTree) and
(TVirtualDrawTree(Source).Tag = 1) then
begin
Accept := True;
end;
end;
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
begin
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
end;
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
hueInfo: PHueInfo;
begin
hueInfo := Sender.GetNodeData(Node);
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
cbHueFilter.Checked := True;
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
hueInfo: PHueInfo;
hueColor: TColor;
i: Integer;
textStyle: TTextStyle;
begin
hueInfo := Sender.GetNodeData(PaintInfo.Node);
textStyle := PaintInfo.Canvas.TextStyle;
textStyle.Alignment := taLeftJustify;
textStyle.Layout := tlCenter;
textStyle.Wordbreak := True;
case PaintInfo.Column of
1:
begin
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
PaintInfo.Canvas.Pen.Color := hueColor;
PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
end;
end;
2:
begin
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
end;
end;
end;
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
begin
{if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
Close;}
end;
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
var
found: Boolean;
tileInfo: PTileInfo;
node: PVirtualNode;
id: Word;
begin
if cbTileFilter.Checked then
begin
id := AStatic.TileID + $4000;
found := False;
node := vdtFilter.GetFirst;
while (node <> nil) and (not found) do
begin
tileInfo := vdtFilter.GetNodeData(node);
if tileInfo^.ID = id then
found := True
else
node := vdtFilter.GetNext(node);
end;
Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
((rgFilterType.ItemIndex = 1) and found);
end else
Result := True;
if cbHueFilter.Checked then
begin
Result := Result and (
((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
);
end;
end;
procedure TfrmFilter.JumpToHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.FormCreate(Sender: TObject);
var
i: Integer;
hueInfo: PHueInfo;
node: PVirtualNode;
begin
FLocked := False;
vdtFilter.NodeDataSize := SizeOf(TTileInfo);
vdtHues.NodeDataSize := SizeOf(THueInfo);
vdtHues.BeginUpdate;
vdtHues.Clear;
for i := 0 to ResMan.Hue.Count - 1 do
begin
node := vdtHues.AddChild(nil);
hueInfo := vdtHues.GetNodeData(node);
hueInfo^.ID := i + 1;
hueInfo^.Hue := ResMan.Hue.Hues[i];
vdtHues.CheckType[node] := ctCheckBox;
end;
vdtHues.EndUpdate;
FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
//FCheckedHues.Bits[0] := True;
end;
procedure TfrmFilter.FormDestroy(Sender: TObject);
begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin
vdtFilter.DeleteSelectedNodes;
end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.btnClearClick(Sender: TObject);
begin
vdtFilter.Clear;
end;
initialization
{$I UfrmFilter.lrs}
end.

3413
Client/ULandscape.pas
View File

File diff suppressed because it is too large Load Diff

4
Client/UPacketHandlers.pas
View File

@@ -56,11 +56,11 @@ procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UPackets, UAdminHandling;
UAdminHandling;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;

748
Client/UPackets.pas
View File

@@ -1,375 +1,373 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UPackets;
interface
uses
Classes, dzlib, UEnhancedMemoryStream, UPacket, UMap, UStatics;
type
TBlockCoords = packed record
X: Word;
Y: Word;
end;
TBlockCoordsArray = array of TBlockCoords;
{ TCompressedPacket }
TCompressedPacket = class(TPacket)
constructor Create(APacket: TPacket);
end;
{ TLoginRequestPacket }
TLoginRequestPacket = class(TPacket)
constructor Create(AUsername, APassword: string);
end;
{ TQuitPacket }
TQuitPacket = class(TPacket)
constructor Create;
end;
{ TRequestBlocksPacket }
TRequestBlocksPacket = class(TPacket)
constructor Create(ACoords: TBlockCoordsArray);
end;
{ TFreeBlockPacket }
TFreeBlockPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TDrawMapPacket }
TDrawMapPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
end;
{ TStaticPacket }
TStaticPacket = class(TPacket)
protected
procedure WriteStaticItem(AStaticItem: TStaticItem);
end;
{ TInsertStaticPacket }
TInsertStaticPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
end;
{ TDeleteStaticPacket }
TDeleteStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem);
end;
{ TElevateStaticPacket }
TElevateStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewZ: Word);
end;
{ TMoveStaticPacket }
TMoveStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewX, ANewY: Word);
end;
{ THueStaticPacket }
THueStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewHue: Word);
end;
{ TUpdateClientPosPacket }
TUpdateClientPosPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(AMessage: string);
end;
{ TGotoClientPosPacket }
TGotoClientPosPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TRequestRadarChecksumPacket }
TRequestRadarChecksumPacket = class(TPacket)
constructor Create;
end;
{ TRequestRadarMapPacket }
TRequestRadarMapPacket = class(TPacket)
constructor Create;
end;
{ TNoOpPacket }
TNoOpPacket = class(TPacket)
constructor Create;
end;
implementation
{ TCompressedPacket }
constructor TCompressedPacket.Create(APacket: TPacket);
var
compBuffer: TEnhancedMemoryStream;
compStream: TCompressionStream;
sourceStream: TStream;
begin
inherited Create($01, 0);
compBuffer := TEnhancedMemoryStream.Create;
compStream := TCompressionStream.Create(clMax, compBuffer);
sourceStream := APacket.Stream;
compStream.CopyFrom(sourceStream, 0);
compStream.Free;
FStream.WriteCardinal(sourceStream.Size);
FStream.CopyFrom(compBuffer, 0);
compBuffer.Free;
APacket.Free;
end;
{ TLoginRequestPacket }
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(APassword);
end;
{ TQuitPacket }
constructor TQuitPacket.Create;
begin
inherited Create($02, 0);
FStream.WriteByte($05);
end;
{ TRequestBlocksPacket }
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
var
i: Integer;
begin
inherited Create($04, 0);
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
end;
{ TFreeBlockPacket }
constructor TFreeBlockPacket.Create(AX, AY: Word);
begin
inherited Create($05, 5);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TDrawMapPacket }
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
begin
inherited Create($06, 8);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
end;
{ TStaticPacket }
procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
begin
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
end;
{ TInsertStaticPacket }
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word);
begin
inherited Create($07, 10);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
end;
{ TDeleteStaticPacket }
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
begin
inherited Create($08, 10);
WriteStaticItem(AStaticItem);
end;
{ TElevateStaticPacket }
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
begin
inherited Create($09, 11);
WriteStaticItem(AStaticItem);
FStream.WriteShortInt(ANewZ);
end;
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word; ANewZ: Word);
begin
inherited Create($09, 11);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteShortInt(ANewZ);
end;
{ TMoveStaticPacket }
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
ANewY: Word);
begin
inherited Create($0A, 14);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewX, ANewY: Word);
begin
inherited Create($0A, 14);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
{ THueStaticPacket }
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
begin
inherited Create($0B, 12);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewHue);
end;
constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewHue: Word);
begin
inherited Create($0B, 12);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewHue);
end;
{ TUpdateClientPosPacket }
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(AMessage);
end;
{ TGotoClientPosPacket }
constructor TGotoClientPosPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($06);
FStream.WriteStringNull(AUsername);
end;
{ TRequestRadarChecksumPacket }
constructor TRequestRadarChecksumPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($01);
end;
{ TRequestRadarMapPacket }
constructor TRequestRadarMapPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($02);
end;
{ TNoOpPacket }
constructor TNoOpPacket.Create;
begin
inherited Create($FF, 1);
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UPackets;
interface
uses
Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics;
type
TBlockCoords = packed record
X: Word;
Y: Word;
end;
TBlockCoordsArray = array of TBlockCoords;
{ TCompressedPacket }
TCompressedPacket = class(TPacket)
constructor Create(APacket: TPacket);
end;
{ TLoginRequestPacket }
TLoginRequestPacket = class(TPacket)
constructor Create(AUsername, APassword: string);
end;
{ TQuitPacket }
TQuitPacket = class(TPacket)
constructor Create;
end;
{ TRequestBlocksPacket }
TRequestBlocksPacket = class(TPacket)
constructor Create(ACoords: TBlockCoordsArray);
end;
{ TFreeBlockPacket }
TFreeBlockPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TDrawMapPacket }
TDrawMapPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
end;
{ TStaticPacket }
TStaticPacket = class(TPacket)
protected
procedure WriteStaticItem(AStaticItem: TStaticItem);
end;
{ TInsertStaticPacket }
TInsertStaticPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
end;
{ TDeleteStaticPacket }
TDeleteStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem);
end;
{ TElevateStaticPacket }
TElevateStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewZ: Word);
end;
{ TMoveStaticPacket }
TMoveStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewX, ANewY: Word);
end;
{ THueStaticPacket }
THueStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewHue: Word);
end;
{ TUpdateClientPosPacket }
TUpdateClientPosPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(AMessage: string);
end;
{ TGotoClientPosPacket }
TGotoClientPosPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TRequestRadarChecksumPacket }
TRequestRadarChecksumPacket = class(TPacket)
constructor Create;
end;
{ TRequestRadarMapPacket }
TRequestRadarMapPacket = class(TPacket)
constructor Create;
end;
{ TNoOpPacket }
TNoOpPacket = class(TPacket)
constructor Create;
end;
implementation
{ TCompressedPacket }
constructor TCompressedPacket.Create(APacket: TPacket);
var
compBuffer: TEnhancedMemoryStream;
compStream: TCompressionStream;
sourceStream: TStream;
begin
inherited Create($01, 0);
compBuffer := TEnhancedMemoryStream.Create;
compStream := TCompressionStream.Create(clMax, compBuffer);
sourceStream := APacket.Stream;
compStream.CopyFrom(sourceStream, 0);
compStream.Free;
FStream.WriteCardinal(sourceStream.Size);
FStream.CopyFrom(compBuffer, 0);
compBuffer.Free;
APacket.Free;
end;
{ TLoginRequestPacket }
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(APassword);
end;
{ TQuitPacket }
constructor TQuitPacket.Create;
begin
inherited Create($02, 0);
FStream.WriteByte($05);
end;
{ TRequestBlocksPacket }
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
begin
inherited Create($04, 0);
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
end;
{ TFreeBlockPacket }
constructor TFreeBlockPacket.Create(AX, AY: Word);
begin
inherited Create($05, 5);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TDrawMapPacket }
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
begin
inherited Create($06, 8);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
end;
{ TStaticPacket }
procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
begin
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
end;
{ TInsertStaticPacket }
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word);
begin
inherited Create($07, 10);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
end;
{ TDeleteStaticPacket }
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
begin
inherited Create($08, 10);
WriteStaticItem(AStaticItem);
end;
{ TElevateStaticPacket }
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
begin
inherited Create($09, 11);
WriteStaticItem(AStaticItem);
FStream.WriteShortInt(ANewZ);
end;
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word; ANewZ: Word);
begin
inherited Create($09, 11);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteShortInt(ANewZ);
end;
{ TMoveStaticPacket }
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
ANewY: Word);
begin
inherited Create($0A, 14);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewX, ANewY: Word);
begin
inherited Create($0A, 14);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
{ THueStaticPacket }
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
begin
inherited Create($0B, 12);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewHue);
end;
constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewHue: Word);
begin
inherited Create($0B, 12);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewHue);
end;
{ TUpdateClientPosPacket }
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(AMessage);
end;
{ TGotoClientPosPacket }
constructor TGotoClientPosPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($06);
FStream.WriteStringNull(AUsername);
end;
{ TRequestRadarChecksumPacket }
constructor TRequestRadarChecksumPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($01);
end;
{ TRequestRadarMapPacket }
constructor TRequestRadarMapPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($02);
end;
{ TNoOpPacket }
constructor TNoOpPacket.Create;
begin
inherited Create($FF, 1);
end;
end.

210
Client/UResourceManager.pas
View File

@@ -1,105 +1,105 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UResourceManager;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TResourceManager }
TResourceManager = class(TObject)
constructor Create(AFileName: string);
destructor Destroy; override;
protected
FFileStream: TFileStream;
FCount: Integer;
FLookupTable: array of Cardinal;
FCurrentResource: Integer;
FResourceStream: TMemoryStream;
public
function GetResource(AIndex: Integer): TStream;
end;
var
ResourceManager: TResourceManager;
implementation
{ TResourceManager }
constructor TResourceManager.Create(AFileName: string);
begin
inherited Create;
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
FFileStream.Position := 0;
FFileStream.Read(FCount, SizeOf(Integer));
SetLength(FLookupTable, FCount);
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
FCurrentResource := -1;
end;
destructor TResourceManager.Destroy;
begin
FreeAndNil(FFileStream);
FreeAndNil(FResourceStream);
inherited Destroy;
end;
function TResourceManager.GetResource(AIndex: Integer): TStream;
var
size: Cardinal;
begin
if AIndex <> FCurrentResource then
begin
FFileStream.Position := FLookupTable[AIndex];
FResourceStream.Free;
FResourceStream := TMemoryStream.Create;
FFileStream.Read(size, SizeOf(Cardinal));
FResourceStream.CopyFrom(FFileStream, size);
FCurrentResource := AIndex;
end;
FResourceStream.Position := 0;
Result := FResourceStream;
end;
initialization
begin
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
end;
finalization
begin
if ResourceManager <> nil then FreeAndNil(ResourceManager);
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UResourceManager;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TResourceManager }
TResourceManager = class
constructor Create(AFileName: string);
destructor Destroy; override;
protected
FFileStream: TFileStream;
FCount: Integer;
FLookupTable: array of Cardinal;
FCurrentResource: Integer;
FResourceStream: TMemoryStream;
public
function GetResource(AIndex: Integer): TStream;
end;
var
ResourceManager: TResourceManager;
implementation
{ TResourceManager }
constructor TResourceManager.Create(AFileName: string);
begin
inherited Create;
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
FFileStream.Position := 0;
FFileStream.Read(FCount, SizeOf(Integer));
SetLength(FLookupTable, FCount);
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
FCurrentResource := -1;
end;
destructor TResourceManager.Destroy;
begin
FreeAndNil(FFileStream);
FreeAndNil(FResourceStream);
inherited Destroy;
end;
function TResourceManager.GetResource(AIndex: Integer): TStream;
var
size: Cardinal;
begin
if AIndex <> FCurrentResource then
begin
FFileStream.Position := FLookupTable[AIndex];
FResourceStream.Free;
FResourceStream := TMemoryStream.Create;
FFileStream.Read(size, SizeOf(Cardinal));
FResourceStream.CopyFrom(FFileStream, size);
FCurrentResource := AIndex;
end;
FResourceStream.Position := 0;
Result := FResourceStream;
end;
initialization
begin
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
end;
finalization
begin
if ResourceManager <> nil then FreeAndNil(ResourceManager);
end;
end.

131
Client/UfrmMain.lfm
View File

@@ -5,7 +5,7 @@ object frmMain: TfrmMain
Width = 766
ActiveControl = oglGameWindow
Caption = 'UO CentrED'
ClientHeight = 580
ClientHeight = 583
ClientWidth = 766
Constraints.MinHeight = 603
Constraints.MinWidth = 766
@@ -23,7 +23,7 @@ object frmMain: TfrmMain
object pnlBottom: TPanel
Left = 0
Height = 31
Top = 549
Top = 552
Width = 766
Align = alBottom
BevelOuter = bvNone
@@ -34,7 +34,7 @@ object frmMain: TfrmMain
Left = 11
Height = 14
Top = 7
Width = 11
Width = 10
Caption = 'X:'
ParentColor = False
end
@@ -42,7 +42,7 @@ object frmMain: TfrmMain
Left = 88
Height = 14
Top = 7
Width = 10
Width = 9
Caption = 'Y:'
ParentColor = False
end
@@ -55,10 +55,10 @@ object frmMain: TfrmMain
ParentColor = False
end
object lblTip: TLabel
Left = 528
Left = 534
Height = 31
Top = 0
Width = 230
Width = 224
Align = alRight
Alignment = taRightJustify
BorderSpacing.Right = 8
@@ -67,10 +67,10 @@ object frmMain: TfrmMain
ParentColor = False
end
object lblTipC: TLabel
Left = 498
Left = 511
Height = 31
Top = 0
Width = 30
Width = 23
Align = alRight
Caption = 'Tip: '
Font.Height = -11
@@ -81,7 +81,7 @@ object frmMain: TfrmMain
end
object edX: TSpinEdit
Left = 24
Height = 19
Height = 21
Top = 3
Width = 55
MaxValue = 100000
@@ -89,7 +89,7 @@ object frmMain: TfrmMain
end
object edY: TSpinEdit
Left = 104
Height = 19
Height = 21
Top = 3
Width = 52
MaxValue = 100000
@@ -108,7 +108,7 @@ object frmMain: TfrmMain
end
object pcLeft: TPageControl
Left = 0
Height = 525
Height = 528
Top = 24
Width = 224
ActivePage = tsTiles
@@ -117,13 +117,13 @@ object frmMain: TfrmMain
TabOrder = 1
object tsTiles: TTabSheet
Caption = 'Tiles'
ClientHeight = 492
ClientWidth = 218
ClientHeight = 502
ClientWidth = 216
object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain
Left = 81
Left = 75
Height = 14
Top = 8
Width = 30
@@ -140,9 +140,9 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList
Left = 4
Height = 242
Top = 56
Width = 210
Height = 258
Top = 50
Width = 208
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 4
@@ -194,13 +194,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 189
Top = 303
Width = 218
Top = 313
Width = 216
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool'
ClientHeight = 175
ClientWidth = 216
ClientHeight = 171
ClientWidth = 212
TabOrder = 1
object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom
@@ -360,10 +360,10 @@ object frmMain: TfrmMain
object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete
Left = 164
Left = 160
Height = 22
Hint = 'Save Preset'
Top = 142
Top = 146
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@@ -414,10 +414,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom
Left = 190
Left = 186
Height = 22
Hint = 'Delete Preset'
Top = 142
Top = 146
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@@ -474,9 +474,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset
Cursor = 63
Left = 4
Height = 114
Height = 118
Top = 24
Width = 208
Width = 204
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 2
@@ -522,14 +522,14 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 29
Top = 142
Width = 156
Height = 21
Top = 146
Width = 152
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
ItemHeight = 0
ItemHeight = 13
OnChange = cbRandomPresetChange
Sorted = True
Style = csDropDownList
@@ -543,8 +543,8 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 0
Height = 5
Top = 298
Width = 218
Top = 308
Width = 216
Align = alNone
Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom
@@ -554,10 +554,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom
Left = 110
Height = 19
Left = 108
Height = 21
Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 271
Top = 279
Width = 96
Anchors = [akRight, akBottom]
BorderSpacing.Right = 8
@@ -576,10 +576,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom
Left = 81
Height = 19
Left = 75
Height = 21
Top = 22
Width = 121
Width = 125
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone
@@ -590,10 +590,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom
Left = 4
Height = 22
Top = 30
Width = 60
Left = 5
Height = 19
Top = 27
Width = 53
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
@@ -604,9 +604,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles
Left = 4
Height = 22
Height = 19
Top = 8
Width = 61
Width = 55
BorderSpacing.Left = 4
BorderSpacing.Top = 8
Caption = 'Terrain'
@@ -618,26 +618,25 @@ object frmMain: TfrmMain
end
object tsClients: TTabSheet
Caption = 'Clients'
ClientHeight = 492
ClientWidth = 218
ClientHeight = 499
ClientWidth = 216
object lbClients: TListBox
Left = 0
Height = 492
Height = 499
Top = 0
Width = 218
Width = 216
Align = alClient
ItemHeight = 0
OnDblClick = mnuGoToClientClick
PopupMenu = pmClients
Sorted = True
TabOrder = 0
TopIndex = -1
end
end
object tsLocations: TTabSheet
Caption = 'Locations'
ClientHeight = 492
ClientWidth = 218
ClientHeight = 499
ClientWidth = 216
object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation
AnchorSideLeft.Side = asrBottom
@@ -645,7 +644,7 @@ object frmMain: TfrmMain
Left = 125
Height = 22
Hint = 'Clear'
Top = 466
Top = 473
Width = 23
BorderSpacing.Left = 4
Color = clBtnFace
@@ -698,7 +697,7 @@ object frmMain: TfrmMain
Left = 98
Height = 22
Hint = 'Delete'
Top = 466
Top = 473
Width = 23
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4
@@ -750,7 +749,7 @@ object frmMain: TfrmMain
Left = 71
Height = 22
Hint = 'Add'
Top = 466
Top = 473
Width = 23
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@@ -804,9 +803,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63
Left = 4
Height = 458
Height = 465
Top = 4
Width = 210
Width = 208
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
@@ -821,7 +820,7 @@ object frmMain: TfrmMain
item
Position = 1
Text = 'Name'
Width = 131
Width = 129
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
@@ -1029,7 +1028,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spChat
Left = 224
Height = 22
Top = 413
Top = 416
Width = 542
Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised
@@ -1042,7 +1041,7 @@ object frmMain: TfrmMain
Left = 10
Height = 18
Top = 2
Width = 104
Width = 101
Align = alLeft
BorderSpacing.Left = 8
Caption = 'Chat and Messages'
@@ -1063,7 +1062,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = pnlBottom
Left = 224
Height = 109
Top = 440
Top = 443
Width = 542
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
@@ -1074,7 +1073,7 @@ object frmMain: TfrmMain
object vstChat: TVirtualStringTree
Cursor = 63
Left = 0
Height = 90
Height = 88
Top = 0
Width = 542
Align = alClient
@@ -1112,8 +1111,8 @@ object frmMain: TfrmMain
end
object edChat: TEdit
Left = 0
Height = 19
Top = 90
Height = 21
Top = 88
Width = 542
Align = alBottom
OnKeyPress = edChatKeyPress
@@ -1128,7 +1127,7 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 224
Height = 5
Top = 435
Top = 438
Width = 542
Align = alNone
Anchors = [akLeft, akRight, akBottom]
@@ -1145,7 +1144,7 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader
Left = 224
Height = 389
Height = 392
Top = 24
Width = 542
Anchors = [akTop, akLeft, akRight, akBottom]

8
Client/UfrmMain.pas
View File

@@ -607,8 +607,6 @@ end;
procedure TfrmMain.oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
node: PVirtualNode;
tileInfo: PTileInfo;
map: TMapCell;
i: Integer;
z: ShortInt;
@@ -923,7 +921,7 @@ end;
procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
var
presetName: string;
i, index: Integer;
i: Integer;
preset, tile: TDOMElement;
children: TDOMNodeList;
tileNode: PVirtualNode;
@@ -2047,7 +2045,7 @@ end;
procedure TfrmMain.PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure GetLandAlt(const AX, AY: Integer; const ADefaultZ,
ADefaultRaw: SmallInt; var Z, RawZ: SmallInt);
ADefaultRaw: SmallInt; out Z, RawZ: SmallInt);
var
cell: TMapCell;
begin
@@ -2547,7 +2545,7 @@ begin
virtualTile.Y := tileY;
virtualTile.Z := frmVirtualLayer.seZ.Value;
virtualTile.Priority := virtualTile.Z;
virtualTile.PriorityBonus := MaxInt;
virtualTile.PriorityBonus := High(ShortInt);
Inc(i);
end;

356
Client/UfrmTileInfo.pas
View File

@@ -1,186 +1,170 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UfrmTileInfo;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, LCLIntf, LCLType, LMessages, strutils;
type
{ TfrmTileInfo }
TfrmTileInfo = class(TForm)
lblName: TLabel;
lblFlags: TLabel;
lblTileID: TLabel;
tmHide: TTimer;
procedure FormShow(Sender: TObject);
procedure tmHideTimer(Sender: TObject);
private
{ private declarations }
public
procedure Update(ATileID: Word);
//procedure Show; overload; reintroduce;
procedure Show(ATileID: Word); overload;
end;
var
frmTileInfo: TfrmTileInfo;
implementation
uses
UGameResources, UTiledata;
{ TfrmTileInfo }
procedure TfrmTileInfo.tmHideTimer(Sender: TObject);
begin
tmHide.Enabled := False;
Hide;
end;
procedure TfrmTileInfo.FormShow(Sender: TObject);
begin
tmHide.Enabled := True;
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
procedure TfrmTileInfo.Update(ATileID: Word);
var
tileData: TTiledata;
prefix, flags: string;
procedure UpdateFlags(AFlag: TTileDataFlag; AName: string);
begin
if AFlag in tileData.Flags then
begin
if flags <> '' then
flags := flags + ', ' + AName
else
flags := AName;
end;
end;
begin
if Visible then
begin
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
flags := '';
if ATileID < $4000 then
begin
tileData := ResMan.Tiledata.LandTiles[ATileID];
if TLandTiledata(tileData).TextureID > 0 then
flags := 'Stretchable';
end else
begin
Dec(ATileID, $4000);
tileData := ResMan.Tiledata.StaticTiles[ATileID];
end;
if tdfArticleA in tileData.Flags then
prefix := 'a '
else if tdfArticleAn in tileData.Flags then
prefix := 'an '
else
prefix := '';
lblName.Caption := AnsiProperCase(Format('%s%s', [prefix, tileData.TileName]), [' ']);
lblTileID.Caption := Format('Tile ID: $%x (%0:d)', [ATileID]);
UpdateFlags(tdfBackground, 'Background');
UpdateFlags(tdfWeapon, 'Weapon');
UpdateFlags(tdfTransparent, 'Transparent');
UpdateFlags(tdfTranslucent, 'Translucent');
UpdateFlags(tdfWall, 'Wall');
UpdateFlags(tdfDamaging, 'Damaging');
UpdateFlags(tdfImpassable, 'Impassable');
UpdateFlags(tdfWet, 'Wet');
UpdateFlags(tdfSurface, 'Surface');
UpdateFlags(tdfBridge, 'Bridge');
UpdateFlags(tdfGeneric, 'Generic');
UpdateFlags(tdfWindow, 'Window');
UpdateFlags(tdfNoShoot, 'NoShoot');
UpdateFlags(tdfInternal, 'Internal');
UpdateFlags(tdfFoliage, 'Foliage');
UpdateFlags(tdfPartialHue, 'PartialHue');
UpdateFlags(tdfMap, 'Map');
UpdateFlags(tdfContainer, 'Container');
UpdateFlags(tdfWearable, 'Wearable');
UpdateFlags(tdfLightSource, 'Lightsource');
UpdateFlags(tdfAnimation, 'Animation');
UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
UpdateFlags(tdfArmor, 'Armor');
UpdateFlags(tdfRoof, 'Roof');
UpdateFlags(tdfDoor, 'Door');
UpdateFlags(tdfStairBack, 'StairBack');
UpdateFlags(tdfStairRight, 'StairRight');
lblFlags.Caption := Format('Flags = [%s]', [flags]);
if tmHide.Enabled then
begin
tmHide.Enabled := False;
tmHide.Enabled := True; //Refresh timer
end;
end;
{procedure TfrmTileInfo.Show;
begin
ShowWindow(Handle, SW_SHOWNOACTIVATE);
Include(FormState, fsVisible);
VisibleChanging;
try
Perform(CM_VISIBLECHANGED, WParam(Ord(True)), 0);
AdjustSize;
RequestAlign;
finally
VisibleChanged;
end;
//FormShow(Self);
end;}
procedure TfrmTileInfo.Show(ATileID: Word);
begin
Update(ATileID);
Show;
end;
initialization
{$I UfrmTileInfo.lrs}
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmTileInfo;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, LCLIntf, LCLType, strutils;
type
{ TfrmTileInfo }
TfrmTileInfo = class(TForm)
lblName: TLabel;
lblFlags: TLabel;
lblTileID: TLabel;
tmHide: TTimer;
procedure FormShow(Sender: TObject);
procedure tmHideTimer(Sender: TObject);
private
{ private declarations }
public
procedure Update(ATileID: Word);
procedure Show(ATileID: Word); overload;
end;
var
frmTileInfo: TfrmTileInfo;
implementation
uses
UGameResources, UTiledata;
{ TfrmTileInfo }
procedure TfrmTileInfo.tmHideTimer(Sender: TObject);
begin
tmHide.Enabled := False;
Hide;
end;
procedure TfrmTileInfo.FormShow(Sender: TObject);
begin
tmHide.Enabled := True;
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
procedure TfrmTileInfo.Update(ATileID: Word);
var
tileData: TTiledata;
prefix, flags: string;
procedure UpdateFlags(AFlag: TTileDataFlag; AName: string);
begin
if AFlag in tileData.Flags then
begin
if flags <> '' then
flags := flags + ', ' + AName
else
flags := AName;
end;
end;
begin
if Visible then
begin
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
flags := '';
if ATileID < $4000 then
begin
tileData := ResMan.Tiledata.LandTiles[ATileID];
if TLandTiledata(tileData).TextureID > 0 then
flags := 'Stretchable';
end else
begin
Dec(ATileID, $4000);
tileData := ResMan.Tiledata.StaticTiles[ATileID];
end;
if tdfArticleA in tileData.Flags then
prefix := 'a '
else if tdfArticleAn in tileData.Flags then
prefix := 'an '
else
prefix := '';
lblName.Caption := AnsiProperCase(Format('%s%s', [prefix, tileData.TileName]), [' ']);
lblTileID.Caption := Format('Tile ID: $%x (%0:d)', [ATileID]);
UpdateFlags(tdfBackground, 'Background');
UpdateFlags(tdfWeapon, 'Weapon');
UpdateFlags(tdfTransparent, 'Transparent');
UpdateFlags(tdfTranslucent, 'Translucent');
UpdateFlags(tdfWall, 'Wall');
UpdateFlags(tdfDamaging, 'Damaging');
UpdateFlags(tdfImpassable, 'Impassable');
UpdateFlags(tdfWet, 'Wet');
UpdateFlags(tdfSurface, 'Surface');
UpdateFlags(tdfBridge, 'Bridge');
UpdateFlags(tdfGeneric, 'Generic');
UpdateFlags(tdfWindow, 'Window');
UpdateFlags(tdfNoShoot, 'NoShoot');
UpdateFlags(tdfInternal, 'Internal');
UpdateFlags(tdfFoliage, 'Foliage');
UpdateFlags(tdfPartialHue, 'PartialHue');
UpdateFlags(tdfMap, 'Map');
UpdateFlags(tdfContainer, 'Container');
UpdateFlags(tdfWearable, 'Wearable');
UpdateFlags(tdfLightSource, 'Lightsource');
UpdateFlags(tdfAnimation, 'Animation');
UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
UpdateFlags(tdfArmor, 'Armor');
UpdateFlags(tdfRoof, 'Roof');
UpdateFlags(tdfDoor, 'Door');
UpdateFlags(tdfStairBack, 'StairBack');
UpdateFlags(tdfStairRight, 'StairRight');
lblFlags.Caption := Format('Flags = [%s]', [flags]);
if tmHide.Enabled then
begin
tmHide.Enabled := False;
tmHide.Enabled := True; //Refresh timer
end;
end;
procedure TfrmTileInfo.Show(ATileID: Word);
begin
Update(ATileID);
Show;
end;
initialization
{$I UfrmTileInfo.lrs}
end.