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

- Several code cleanups 

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

706
Client/Tools/UfrmFilter.pas
View File

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

748
Client/UPackets.pas
View File

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

210
Client/UResourceManager.pas
View File

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

131
Client/UfrmMain.lfm
View File

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

8
Client/UfrmMain.pas
View File

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

356
Client/UfrmTileInfo.pas
View File

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

78
Logging.pas
View File

@ -1,39 +1,39 @@
unit Logging; unit Logging;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
MultiLog, IPCChannel; MultiLog{$IFNDEF NoLogging}, IPCChannel{$ENDIF};
const const
lcAll = [0..31]; //all logging classes lcAll = [0..31]; //all logging classes
lcDebug = 0; lcDebug = 0;
lcError = 1; lcError = 1;
lcInfo = 2; lcInfo = 2;
lcWarning = 3; lcWarning = 3;
lcEvents = 4; lcEvents = 4;
lcServer = 10; lcServer = 10;
lcClient = 11; lcClient = 11;
lcLandscape = 12; lcLandscape = 12;
var var
Logger: TLogger; Logger: TLogger;
implementation implementation
initialization initialization
Logger := TLogger.Create; Logger := TLogger.Create;
{$IFNDEF NoLogging} {$IFNDEF NoLogging}
Logger.Channels.Add(TIPCChannel.Create); Logger.Channels.Add(TIPCChannel.Create);
Logger.ActiveClasses := lcAll; Logger.ActiveClasses := lcAll;
{$ENDIF} {$ENDIF}
finalization finalization
Logger.Free; Logger.Free;
end. end.

258
MulProvider/UMulManager.pas
View File

@ -1,129 +1,129 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UMulManager; unit UMulManager;
interface interface
uses uses
SysUtils, UMulProvider, UTileDataProvider, UArtProvider, UGumpProvider, SysUtils, UTileDataProvider, UArtProvider, UGumpProvider, UTexmapProvider,
UTexmapProvider, UHueProvider, URadarProvider, UAnimDataProvider; UHueProvider, URadarProvider, UAnimDataProvider;
type type
{ TMulManager } { TMulManager }
TMulManager = class TMulManager = class
destructor Destroy; override; destructor Destroy; override;
protected protected
FArtProvider: TArtProvider; FArtProvider: TArtProvider;
FGumpProvider: TGumpProvider; FGumpProvider: TGumpProvider;
FTexmapProvider: TTexmapProvider; FTexmapProvider: TTexmapProvider;
FTileDataProvider: TTileDataProvider; FTileDataProvider: TTileDataProvider;
FAnimDataProvider: TAnimDataProvider; FAnimDataProvider: TAnimDataProvider;
FHueProvider: THueProvider; FHueProvider: THueProvider;
FRadarProvider: TRadarProvider; FRadarProvider: TRadarProvider;
public public
procedure RegisterArtProvider(AArtProvider: TArtProvider); procedure RegisterArtProvider(AArtProvider: TArtProvider);
procedure RegisterGumpProvider(AGumpProvider: TGumpProvider); procedure RegisterGumpProvider(AGumpProvider: TGumpProvider);
procedure RegisterTexmapProvider(ATexmapProvider: TTexmapProvider); procedure RegisterTexmapProvider(ATexmapProvider: TTexmapProvider);
procedure RegisterTileDataProvider(ATileDataProvider: TTileDataProvider); procedure RegisterTileDataProvider(ATileDataProvider: TTileDataProvider);
procedure RegisterAnimDataProvider(AAnimDataProvider: TAnimDataProvider); procedure RegisterAnimDataProvider(AAnimDataProvider: TAnimDataProvider);
procedure RegisterHueProvider(AHueProvider: THueProvider); procedure RegisterHueProvider(AHueProvider: THueProvider);
procedure RegisterRadarProvider(ARadarProvider: TRadarProvider); procedure RegisterRadarProvider(ARadarProvider: TRadarProvider);
property ArtProvider: TArtProvider read FArtProvider; property ArtProvider: TArtProvider read FArtProvider;
property GumpProvider: TGumpProvider read FGumpProvider; property GumpProvider: TGumpProvider read FGumpProvider;
property TexmapProvider: TTexmapProvider read FTexmapProvider; property TexmapProvider: TTexmapProvider read FTexmapProvider;
property TileDataProvider: TTileDataProvider read FTileDataProvider; property TileDataProvider: TTileDataProvider read FTileDataProvider;
property AnimDataProvider: TAnimDataProvider read FAnimDataProvider; property AnimDataProvider: TAnimDataProvider read FAnimDataProvider;
property HueProvider: THueProvider read FHueProvider; property HueProvider: THueProvider read FHueProvider;
property RadarProvider: TRadarPRovider read FRadarProvider; property RadarProvider: TRadarPRovider read FRadarProvider;
end; end;
implementation implementation
{ TMulManager } { TMulManager }
destructor TMulManager.Destroy; destructor TMulManager.Destroy;
begin begin
RegisterArtProvider(nil); RegisterArtProvider(nil);
RegisterGumpProvider(nil); RegisterGumpProvider(nil);
RegisterTexmapProvider(nil); RegisterTexmapProvider(nil);
RegisterTileDataProvider(nil); RegisterTileDataProvider(nil);
RegisterHueProvider(nil); RegisterHueProvider(nil);
RegisterRadarProvider(nil); RegisterRadarProvider(nil);
inherited Destroy; inherited Destroy;
end; end;
procedure TMulManager.RegisterArtProvider( procedure TMulManager.RegisterArtProvider(
AArtProvider: TArtProvider); AArtProvider: TArtProvider);
begin begin
FreeAndNil(FArtProvider); FreeAndNil(FArtProvider);
FArtProvider := AArtProvider; FArtProvider := AArtProvider;
end; end;
procedure TMulManager.RegisterGumpProvider( procedure TMulManager.RegisterGumpProvider(
AGumpProvider: TGumpProvider); AGumpProvider: TGumpProvider);
begin begin
FreeAndNil(FGumpProvider); FreeAndNil(FGumpProvider);
FGumpProvider := AGumpProvider; FGumpProvider := AGumpProvider;
end; end;
procedure TMulManager.RegisterHueProvider( procedure TMulManager.RegisterHueProvider(
AHueProvider: THueProvider); AHueProvider: THueProvider);
begin begin
FreeAndNil(FHueProvider); FreeAndNil(FHueProvider);
FHueProvider := AHueProvider; FHueProvider := AHueProvider;
end; end;
procedure TMulManager.RegisterRadarProvider( procedure TMulManager.RegisterRadarProvider(
ARadarProvider: TRadarProvider); ARadarProvider: TRadarProvider);
begin begin
FreeAndNil(FRadarProvider); FreeAndNil(FRadarProvider);
FRadarProvider := ARadarProvider; FRadarProvider := ARadarProvider;
end; end;
procedure TMulManager.RegisterTexmapProvider( procedure TMulManager.RegisterTexmapProvider(
ATexmapProvider: TTexmapProvider); ATexmapProvider: TTexmapProvider);
begin begin
FreeAndNil(FTexmapProvider); FreeAndNil(FTexmapProvider);
FTexmapProvider := ATexmapProvider; FTexmapProvider := ATexmapProvider;
end; end;
procedure TMulManager.RegisterTileDataProvider( procedure TMulManager.RegisterTileDataProvider(
ATileDataProvider: TTileDataProvider); ATileDataProvider: TTileDataProvider);
begin begin
FreeAndNil(FTileDataProvider); FreeAndNil(FTileDataProvider);
FTileDataProvider := ATileDataProvider; FTileDataProvider := ATileDataProvider;
end; end;
procedure TMulManager.RegisterAnimDataProvider( procedure TMulManager.RegisterAnimDataProvider(
AAnimDataProvider: TAnimDataProvider); AAnimDataProvider: TAnimDataProvider);
begin begin
FreeAndNil(FAnimDataProvider); FreeAndNil(FAnimDataProvider);
FAnimDataProvider := AAnimDataProvider; FAnimDataProvider := AAnimDataProvider;
end; end;
end. end.

13
MulProvider/URadarProvider.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit URadarProvider; unit URadarProvider;
@ -33,7 +33,10 @@ uses
SysUtils, Classes, UBufferedStreams; SysUtils, Classes, UBufferedStreams;
type type
TRadarProvider = class(TObject)
{ TRadarProvider }
TRadarProvider = class
constructor Create; overload; virtual; constructor Create; overload; virtual;
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual; constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual; constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual;
@ -77,18 +80,18 @@ end;
destructor TRadarProvider.Destroy; destructor TRadarProvider.Destroy;
begin begin
if Assigned(FData) then FreeAndNil(FData); FreeAndNil(FData);
inherited Destroy; inherited Destroy;
end; end;
function TRadarProvider.GetColor(AID: Integer): Word; function TRadarProvider.GetColor(AID: Integer): Word;
begin begin
Result := 0;
if (AID >= 0) and (AID < $10000) then if (AID >= 0) and (AID < $10000) then
begin begin
FData.Position := SizeOf(Word) * AID; FData.Position := SizeOf(Word) * AID;
FData.Read(Result, SizeOf(Word)); FData.Read(Result, SizeOf(Word));
end else end;
Result := 0;
end; end;
procedure TRadarProvider.SetColor(AID: Integer; AColor: Word); procedure TRadarProvider.SetColor(AID: Integer; AColor: Word);

648
UOLib/UArt.pas
View File

@ -1,323 +1,325 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UArt; unit UArt;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses, Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses,
UMulBlock, UGenericIndex, UHue; UMulBlock, UGenericIndex, UHue;
type type
TArtType = (atLand, atStatic, atLandFlat); TArtType = (atLand, atStatic, atLandFlat);
TArt = class(TMulBlock) TArt = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload;
destructor Destroy; override; destructor Destroy; override;
function Clone: TArt; override; function Clone: TArt; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
procedure RefreshBuffer; procedure RefreshBuffer;
protected protected
FArtType: TArtType; FArtType: TArtType;
FHeader: LongInt; FHeader: LongInt;
FGraphic: TSingleImage; FGraphic: TSingleImage;
FBuffer: TStream; FBuffer: TStream;
public public
property ArtType: TArtType read FArtType write FArtType; property ArtType: TArtType read FArtType write FArtType;
property Header: LongInt read FHeader write FHeader; property Header: LongInt read FHeader write FHeader;
property Graphic: TSingleImage read FGraphic; property Graphic: TSingleImage read FGraphic;
property Buffer: TStream read FBuffer; property Buffer: TStream read FBuffer;
end; end;
implementation implementation
type type
PWordArray = ^TWordArray; PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word; TWordArray = array[0..16383] of Word;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType);
begin begin
Create(AData, AIndex, AArtType, 0, nil, False); Create(AData, AIndex, AArtType, 0, nil, False);
end; end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean);
begin begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue); Create(AData, AIndex, AArtType, 0, AHue, APartialHue);
end; end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean);
var var
i, x, y, start: Integer; i, x, y, start: Integer;
iCurrentHeight, iCurrentWidth: Integer; iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt; width, height: SmallInt;
lookup: array of integer; lookup: array of integer;
color, run, offset: Word; color, run, offset: Word;
block: TMemoryStream; block: TMemoryStream;
P: PWordArray; P: PWordArray;
r, g, b: Byte; r, g, b: Byte;
begin begin
FBuffer := TMemoryStream.Create; FBuffer := TMemoryStream.Create;
FArtType := AArtType; FArtType := AArtType;
AArtColor := AArtColor or $8000; //set alpha bit on background AArtColor := AArtColor or $8000; //set alpha bit on background
if Assigned(AData) and (AIndex.Lookup > -1) then if Assigned(AData) and (AIndex.Lookup > -1) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size); block.CopyFrom(AData, AIndex.Size);
block.Position := 0; block.Position := 0;
if AArtType = atLand then if AArtType = atLand then
begin begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
FillWord(FGraphic.Bits^, 44 * 44, AArtColor); FillWord(FGraphic.Bits^, 44 * 44, AArtColor);
for y := 0 to 21 do for y := 0 to 21 do
begin begin
P := FGraphic.Bits + y * 44 * 2; P := FGraphic.Bits + y * 44 * 2;
block.Read(P^[22 - (y + 1)], (y + 1) * 4); block.Read(P^[22 - (y + 1)], (y + 1) * 4);
end; end;
for y := 0 to 21 do for y := 0 to 21 do
begin begin
P := FGraphic.Bits + (22 + y) * 44 * 2; P := FGraphic.Bits + (22 + y) * 44 * 2;
block.Read(P^[y], (22 - y) * 4); block.Read(P^[y], (22 - y) * 4);
end; end;
for i := 0 to 44 * 44 - 1 do for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atLandFlat then end else if AArtType = atLandFlat then
begin begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
for i := 1 to 22 do for i := 1 to 22 do
begin begin
for x := 0 to i * 2 - 1 do for x := 0 to i * 2 - 1 do
begin begin
y := i * 2 - x - 1; y := i * 2 - x - 1;
block.Read(color, SizeOf(Word)); block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color;
if y > 0 then if y > 0 then
PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color;
end; end;
end; end;
for i := 22 to 43 do for i := 22 to 43 do
begin begin
for y := 0 to (44 - i) * 2 - 1 do for y := 0 to (44 - i) * 2 - 1 do
begin begin
x := 42 - (43 - i) * 2 + y; x := 42 - (43 - i) * 2 + y;
block.Read(color, SizeOf(Word)); block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color;
if y > 0 then if y > 0 then
PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color;
end; end;
end; end;
for i := 0 to 44 * 44 - 1 do for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atStatic then end else if AArtType = atStatic then
begin begin
block.Read(FHeader, SizeOf(LongInt)); block.Read(FHeader, SizeOf(LongInt));
block.Read(width, SizeOf(SmallInt)); block.Read(width, SizeOf(SmallInt));
block.Read(height, SizeOf(SmallInt)); block.Read(height, SizeOf(SmallInt));
FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5);
FillWord(FGraphic.Bits^, width * height, AArtColor); FillWord(FGraphic.Bits^, width * height, AArtColor);
SetLength(lookup, height); SetLength(lookup, height);
start := block.Position + (height * 2); start := block.Position + (height * 2);
for i := 0 to height - 1 do for i := 0 to height - 1 do
begin begin
block.Read(offset, SizeOf(Word)); block.Read(offset, SizeOf(Word));
lookup[i] := start + (offset * 2); lookup[i] := start + (offset * 2);
end; end;
for iCurrentHeight := 0 to height - 1 do for iCurrentHeight := 0 to height - 1 do
begin begin
block.Position := lookup[iCurrentHeight]; block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0; iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2; P := FGraphic.Bits + iCurrentHeight * width * 2;
while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and (offset + run <> 0) do while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and
begin (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and
inc(iCurrentWidth, offset); (offset + run <> 0) do
for i := 0 to run - 1 do begin
begin inc(iCurrentWidth, offset);
block.Read(color, SizeOf(Word)); for i := 0 to run - 1 do
P^[iCurrentWidth + i] := color; begin
end; block.Read(color, SizeOf(Word));
inc(iCurrentWidth, run); P^[iCurrentWidth + i] := color;
end; end;
end; inc(iCurrentWidth, run);
end;
if AHue <> nil then end;
begin
for i := 0 to width * height - 1 do if AHue <> nil then
begin begin
color := PWordArray(FGraphic.Bits)^[i]; for i := 0 to width * height - 1 do
if color <> AArtColor then begin
begin color := PWordArray(FGraphic.Bits)^[i];
r := (color and $7C00) shr 10; if color <> AArtColor then
if APartialHue then begin
begin r := (color and $7C00) shr 10;
g := (color and $3E0) shr 5; if APartialHue then
b := color and $1F; begin
if (r = g) and (g = b) then g := (color and $3E0) shr 5;
color := AHue.ColorTable[r]; b := color and $1F;
end else if (r = g) and (g = b) then
color := AHue.ColorTable[r]; color := AHue.ColorTable[r];
end; end else
PWordArray(FGraphic.Bits)^[i] := color; color := AHue.ColorTable[r];
end; end;
end; PWordArray(FGraphic.Bits)^[i] := color;
end;
for i := 0 to width * height - 1 do end;
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else for i := 0 to width * height - 1 do
FGraphic:= TSingleImage.Create; PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
if Assigned(block) then block.Free; end else
end else FGraphic:= TSingleImage.Create;
begin if Assigned(block) then block.Free;
FHeader := 1; end else
FGraphic := TSingleImage.Create; begin
end; FHeader := 1;
FGraphic.Format := ifA8R8G8B8; FGraphic := TSingleImage.Create;
end; end;
FGraphic.Format := ifA8R8G8B8;
destructor TArt.Destroy; end;
begin
if assigned(FGraphic) then FGraphic.Free; destructor TArt.Destroy;
if assigned(FBuffer) then FBuffer.Free; begin
inherited; if assigned(FGraphic) then FGraphic.Free;
end; if assigned(FBuffer) then FBuffer.Free;
inherited;
function TArt.Clone: TArt; end;
begin
Result := TArt.Create(nil, nil, FArtType); function TArt.Clone: TArt;
Result.FHeader := FHeader; begin
Result.FGraphic.Assign(FGraphic); Result := TArt.Create(nil, nil, FArtType);
end; Result.FHeader := FHeader;
Result.FGraphic.Assign(FGraphic);
procedure TArt.Write(AData: TStream); end;
begin
FBuffer.Position := 0; procedure TArt.Write(AData: TStream);
AData.CopyFrom(FBuffer, FBuffer.Size); begin
end; FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size);
function TArt.GetSize: Integer; end;
begin
RefreshBuffer; function TArt.GetSize: Integer;
Result := FBuffer.Size begin
end; RefreshBuffer;
Result := FBuffer.Size
procedure TArt.RefreshBuffer; end;
var
argbGraphic: TSingleImage; procedure TArt.RefreshBuffer;
i, j, x, y, lineWidth, start: Integer; var
iCurrentHeight, iCurrentWidth: Integer; argbGraphic: TSingleImage;
width, height: SmallInt; i, x, y, lineWidth, start: Integer;
color, run, offset: Word; iCurrentHeight, iCurrentWidth: Integer;
lookup: array of SmallInt; width, height: SmallInt;
begin color, run, offset: Word;
argbGraphic := TSingleImage.CreateFromImage(FGraphic); lookup: array of SmallInt;
argbGraphic.Format := ifA1R5G5B5; begin
for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do argbGraphic := TSingleImage.CreateFromImage(FGraphic);
PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit argbGraphic.Format := ifA1R5G5B5;
FBuffer.Size := 0; for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do
if FArtType = atLand then PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit
begin FBuffer.Size := 0;
if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit; if FArtType = atLand then
x := 21; begin
y := 0; if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit;
lineWidth := 2; x := 21;
for i := 1 to 22 do y := 0;
begin lineWidth := 2;
Dec(x); for i := 1 to 22 do
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth); begin
Inc(y); Dec(x);
Inc(lineWidth, 2); FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth);
end; Inc(y);
for i := 1 to 22 do Inc(lineWidth, 2);
begin end;
Dec(lineWidth, 2); for i := 1 to 22 do
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth); begin
Inc(x); Dec(lineWidth, 2);
Inc(y); FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth);
end; Inc(x);
end else if FArtType = atStatic then Inc(y);
begin end;
if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit; end else if FArtType = atStatic then
width := argbGraphic.Width; begin
height := argbGraphic.Height; if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit;
FBuffer.Write(FHeader, SizeOf(LongInt)); width := argbGraphic.Width;
FBuffer.Write(width, SizeOf(SmallInt)); height := argbGraphic.Height;
FBuffer.Write(height, SizeOf(SmallInt)); FBuffer.Write(FHeader, SizeOf(LongInt));
SetLength(lookup, height); FBuffer.Write(width, SizeOf(SmallInt));
for i := 0 to height - 1 do FBuffer.Write(height, SizeOf(SmallInt));
FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table SetLength(lookup, height);
start := FBuffer.Position; for i := 0 to height - 1 do
for iCurrentHeight := 0 to height - 1 do FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table
begin start := FBuffer.Position;
lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line for iCurrentHeight := 0 to height - 1 do
offset := 0; begin
run := 0; lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line
for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line offset := 0;
begin run := 0;
color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth]; for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line
if (color and $8000 = 0) and (run = 0) then //new visible pixel found begin
begin color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth];
FBuffer.Write(offset, SizeOf(Word)); if (color and $8000 = 0) and (run = 0) then //new visible pixel found
FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length" begin
run := 1; FBuffer.Write(offset, SizeOf(Word));
FBuffer.Write(color, SizeOf(Word)); FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length"
end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found run := 1;
begin FBuffer.Write(color, SizeOf(Word));
inc(run); end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found
FBuffer.Write(color, SizeOf(Word)); begin
end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run inc(run);
begin FBuffer.Write(color, SizeOf(Word));
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ... end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run
FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ... begin
FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ...
run := 0; FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ...
offset := 1; FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed
end else run := 0;
inc(offset); offset := 1;
end; end else
if run > 0 then //no more pixels but the "run" didn't end yet ;-) inc(offset);
begin end;
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); if run > 0 then //no more pixels but the "run" didn't end yet ;-)
FBuffer.Write(run, SizeOf(Word)); begin
FBuffer.Seek(Integer(run * 2), soFromCurrent); FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent);
run := 0; FBuffer.Write(run, SizeOf(Word));
end; FBuffer.Seek(Integer(run * 2), soFromCurrent);
FBuffer.Write(run, SizeOf(Word)); //just write "0" run := 0;
FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line end;
end; FBuffer.Write(run, SizeOf(Word)); //just write "0"
FBuffer.Position := start - (height * 2); //now update the lookup table with our new values FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line
for i := 0 to height - 1 do end;
FBuffer.Write(lookup[i], SizeOf(SmallInt)); FBuffer.Position := start - (height * 2); //now update the lookup table with our new values
end; for i := 0 to height - 1 do
argbGraphic.Free; FBuffer.Write(lookup[i], SizeOf(SmallInt));
end; end;
argbGraphic.Free;
end. end;
end.

25
UOLib/UHue.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UHue; unit UHue;
@ -30,10 +30,14 @@ unit UHue;
interface interface
uses uses
SysUtils, Classes, Graphics, UMulBlock, UGraphicHelper; SysUtils, Classes, Graphics, UMulBlock;
type type
TColorTable = array[0..31] of Word; TColorTable = array[0..31] of Word;
{ THue }
THue = class(TMulBlock) THue = class(TMulBlock)
constructor Create(AData: TStream); constructor Create(AData: TStream);
function Clone: THue; override; function Clone: THue; override;
@ -52,7 +56,11 @@ type
property TableEnd: Word read FTableEnd write FTableEnd; property TableEnd: Word read FTableEnd write FTableEnd;
property Name: string read GetName write SetName; property Name: string read GetName write SetName;
end; end;
THueEntries = array[0..7] of THue; THueEntries = array[0..7] of THue;
{ THueGroup }
THueGroup = class(TMulBlock) THueGroup = class(TMulBlock)
constructor Create(AData: TStream); constructor Create(AData: TStream);
destructor Destroy; override; destructor Destroy; override;
@ -92,7 +100,7 @@ var
color: Word; color: Word;
begin begin
SetLength(FName, 20); SetLength(FName, 20);
if Assigned(AData) then if AData <> nil then
begin begin
buffer := TMemoryStream.Create; buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 88); buffer.CopyFrom(AData, 88);
@ -158,7 +166,7 @@ var
i: Integer; i: Integer;
buffer: TMemoryStream; buffer: TMemoryStream;
begin begin
if Assigned(AData) then if AData <> nil then
begin begin
buffer := TMemoryStream.Create; buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 708); buffer.CopyFrom(AData, 708);
@ -170,7 +178,7 @@ begin
for i := 0 to 7 do for i := 0 to 7 do
FHueEntries[i] := THue.Create(buffer); FHueEntries[i] := THue.Create(buffer);
if Assigned(buffer) then FreeAndNil(buffer); buffer.Free;
end; end;
destructor THueGroup.Destroy; destructor THueGroup.Destroy;
@ -178,9 +186,8 @@ var
i: Integer; i: Integer;
begin begin
for i := 0 to 7 do for i := 0 to 7 do
if Assigned(FHueEntries[i]) then FreeAndNil(FHueEntries[i]);
FreeAndNil(FHueEntries[i]); inherited Destroy;
inherited;
end; end;
function THueGroup.GetHueEntry(AIndex: Integer): THue; function THueGroup.GetHueEntry(AIndex: Integer): THue;
@ -195,7 +202,7 @@ end;
procedure THueGroup.SetHueEntry(AIndex: Integer; AValue: THue); procedure THueGroup.SetHueEntry(AIndex: Integer; AValue: THue);
begin begin
if Assigned(FHueEntries[AIndex]) then FreeAndNil(FHueEntries[AIndex]); FreeAndNil(FHueEntries[AIndex]);
FHueEntries[AIndex] := AValue; FHueEntries[AIndex] := AValue;
end; end;

444
UOLib/UMap.pas
View File

@ -1,222 +1,222 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UMap; unit UMap;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
SysUtils, Classes, fgl, UMulBlock, UWorldItem; SysUtils, Classes, fgl, UWorldItem;
const const
MapCellSize = 3; MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize); MapBlockSize = 4 + (64 * MapCellSize);
type type
{ TMapCell } { TMapCell }
TMapCell = class(TWorldItem) TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload; constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload; constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected protected
FIsGhost: Boolean; FIsGhost: Boolean;
FGhostZ: ShortInt; FGhostZ: ShortInt;
FGhostID: Word; FGhostID: Word;
function GetTileID: Word; override; function GetTileID: Word; override;
function GetZ: ShortInt; override; function GetZ: ShortInt; override;
public public
property Altitude: ShortInt read GetZ write SetZ; property Altitude: ShortInt read GetZ write SetZ;
property IsGhost: Boolean read FIsGhost write FIsGhost; property IsGhost: Boolean read FIsGhost write FIsGhost;
property GhostZ: ShortInt read FGhostZ write FGhostZ; property GhostZ: ShortInt read FGhostZ write FGhostZ;
property GhostID: Word write FGhostID; property GhostID: Word write FGhostID;
function Clone: TMapCell; override; function Clone: TMapCell; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
TMapCellList = specialize TFPGObjectList<TMapCell>; TMapCellList = specialize TFPGObjectList<TMapCell>;
{ TMapBlock } { TMapBlock }
TMapBlock = class(TWorldBlock) TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload; constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload; constructor Create(AData: TStream); overload;
destructor Destroy; override; destructor Destroy; override;
protected protected
FHeader: LongInt; FHeader: LongInt;
public public
Cells: array[0..63] of TMapCell; Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader; property Header: LongInt read FHeader write FHeader;
function Clone: TMapBlock; override; function Clone: TMapBlock; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
function GetMapCellOffset(ABlock: Integer): Integer; function GetMapCellOffset(ABlock: Integer): Integer;
implementation implementation
function GetMapCellOffset(ABlock: Integer): Integer; function GetMapCellOffset(ABlock: Integer): Integer;
var var
group, tile: Integer; group, tile: Integer;
begin begin
group := ABlock div 64; group := ABlock div 64;
tile := ABlock mod 64; tile := ABlock mod 64;
Result := group * MapBlockSize + 4 + tile * MapCellSize; Result := group * MapBlockSize + 4 + tile * MapCellSize;
end; end;
{ TMapCell } { TMapCell }
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FX := AX; FX := AX;
FY := AY; FY := AY;
if AData <> nil then if AData <> nil then
begin begin
AData.Read(FTileID, SizeOf(Word)); AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt)); AData.Read(FZ, SizeOf(ShortInt));
end; end;
FIsGhost := False; FIsGhost := False;
InitOriginalState; InitOriginalState;
end; end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream); constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin begin
Create(AOwner, AData, 0, 0); Create(AOwner, AData, 0, 0);
end; end;
function TMapCell.GetTileID: Word; function TMapCell.GetTileID: Word;
begin begin
if FIsGhost then if FIsGhost then
Result := FGhostID Result := FGhostID
else else
Result := FTileID; Result := FTileID;
end; end;
function TMapCell.GetZ: ShortInt; function TMapCell.GetZ: ShortInt;
begin begin
if FIsGhost then if FIsGhost then
Result := FGhostZ Result := FGhostZ
else else
Result := FZ; Result := FZ;
end; end;
function TMapCell.Clone: TMapCell; function TMapCell.Clone: TMapCell;
begin begin
Result := TMapCell.Create(nil, nil); Result := TMapCell.Create(nil, nil);
Result.FX := FX; Result.FX := FX;
Result.FY := FY; Result.FY := FY;
Result.FZ := FZ; Result.FZ := FZ;
Result.FTileID := FTileID; Result.FTileID := FTileID;
end; end;
procedure TMapCell.Write(AData: TStream); procedure TMapCell.Write(AData: TStream);
begin begin
AData.Write(FTileID, SizeOf(Word)); AData.Write(FTileID, SizeOf(Word));
AData.Write(FZ, SizeOf(ShortInt)); AData.Write(FZ, SizeOf(ShortInt));
end; end;
function TMapCell.GetSize: Integer; function TMapCell.GetSize: Integer;
begin begin
Result := MapCellSize; Result := MapCellSize;
end; end;
{ TMapBlock } { TMapBlock }
constructor TMapBlock.Create(AData: TStream; AX, AY: Word); constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
var var
iX, iY: Integer; iX, iY: Integer;
buffer: TMemoryStream; buffer: TMemoryStream;
begin begin
inherited Create; inherited Create;
FX := AX; FX := AX;
FY := AY; FY := AY;
try try
buffer := nil; buffer := nil;
if Assigned(AData) then if Assigned(AData) then
begin begin
buffer := TMemoryStream.Create; buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 196); buffer.CopyFrom(AData, 196);
buffer.Position := 0; buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongInt)); buffer.Read(FHeader, SizeOf(LongInt));
end; end;
for iY := 0 to 7 do for iY := 0 to 7 do
for iX := 0 to 7 do for iX := 0 to 7 do
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY); Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
finally finally
if Assigned(buffer) then FreeAndNil(buffer); if Assigned(buffer) then FreeAndNil(buffer);
end; end;
end; end;
constructor TMapBlock.Create(AData: TStream); constructor TMapBlock.Create(AData: TStream);
begin begin
Create(AData, 0, 0); Create(AData, 0, 0);
end; end;
destructor TMapBlock.Destroy; destructor TMapBlock.Destroy;
var var
i: Integer; i: Integer;
begin begin
for i := 0 to 63 do for i := 0 to 63 do
Cells[i].Free; Cells[i].Free;
inherited; inherited;
end; end;
function TMapBlock.Clone: TMapBlock; function TMapBlock.Clone: TMapBlock;
var var
i: Integer; i: Integer;
begin begin
Result := TMapBlock.Create(nil); Result := TMapBlock.Create(nil);
Result.FX := FX; Result.FX := FX;
Result.FY := FY; Result.FY := FY;
for i := 0 to 63 do for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone; Result.Cells[i] := Cells[i].Clone;
end; end;
procedure TMapBlock.Write(AData: TStream); procedure TMapBlock.Write(AData: TStream);
var var
i: Integer; i: Integer;
begin begin
AData.Write(FHeader, SizeOf(LongInt)); AData.Write(FHeader, SizeOf(LongInt));
for i := 0 to 63 do for i := 0 to 63 do
Cells[i].Write(AData); Cells[i].Write(AData);
end; end;
function TMapBlock.GetSize: Integer; function TMapBlock.GetSize: Integer;
begin begin
Result := MapBlockSize; Result := MapBlockSize;
end; end;
end. end.

6
UOLib/UMulBlock.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UMulBlock; unit UMulBlock;
@ -38,7 +38,7 @@ type
{ TMulBlockEventHandler } { TMulBlockEventHandler }
TMulBlockEventHandler = class(TObject) TMulBlockEventHandler = class
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
protected protected
@ -51,7 +51,7 @@ type
{ TMulBlock } { TMulBlock }
TMulBlock = class(TObject) TMulBlock = class
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
protected protected

510
UOLib/UStatics.pas
View File

@ -1,256 +1,254 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UStatics; unit UStatics;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata; SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
type type
{ TStaticItem } { TStaticItem }
TStaticItem = class(TWorldItem) TStaticItem = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX, constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word); overload; ABlockY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload; constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected protected
{ Members } { Members }
FHue: Word; FHue: Word;
FOrgHue: Word; FOrgHue: Word;
{ Methods } { Methods }
function HasChanged: Boolean; override; function HasChanged: Boolean; override;
procedure SetHue(AHue: Word); procedure SetHue(AHue: Word);
public public
{ Fields } { Fields }
property Hue: Word read FHue write SetHue; property Hue: Word read FHue write SetHue;
{ Methods } { Methods }
function Clone: TStaticItem; override; function Clone: TStaticItem; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure InitOriginalState; override; procedure InitOriginalState; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer); procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>; TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock} { TStaticBlock}
TStaticBlock = class(TWorldBlock) TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
overload; overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload; constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override; destructor Destroy; override;
protected protected
{ Members } { Members }
FItems: TStaticItemList; FItems: TStaticItemList;
public public
{ Fields } { Fields }
property Items: TStaticItemList read FItems write FItems; property Items: TStaticItemList read FItems write FItems;
{ Methods } { Methods }
function Clone: TStaticBlock; override; function Clone: TStaticBlock; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure ReverseWrite(AData: TStream); procedure ReverseWrite(AData: TStream);
procedure Sort; procedure Sort;
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer; function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
implementation implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer; function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
begin begin
Result := CompareWorldItems(AStatic1, AStatic2); Result := CompareWorldItems(AStatic1, AStatic2);
end; end;
{ TStaticItem } { TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word); ABlockY: Word);
var var
iX, iY: Byte; iX, iY: Byte;
begin begin
inherited Create(AOwner); inherited Create(AOwner);
if AData <> nil then if AData <> nil then
begin begin
AData.Read(FTileID, SizeOf(SmallInt)); AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte)); AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte)); AData.Read(iY, SizeOf(Byte));
AData.Read(FZ, SizeOf(ShortInt)); AData.Read(FZ, SizeOf(ShortInt));
AData.Read(FHue, SizeOf(SmallInt)); AData.Read(FHue, SizeOf(SmallInt));
FX := ABlockX * 8 + iX; FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY; FY := ABlockY * 8 + iY;
end; end;
InitOriginalState; InitOriginalState;
end; end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream); constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
begin begin
Create(AOwner, AData, 0, 0); Create(AOwner, AData, 0, 0);
end; end;
function TStaticItem.HasChanged: Boolean; function TStaticItem.HasChanged: Boolean;
begin begin
Result := (FHue <> FOrgHue) or inherited HasChanged; Result := (FHue <> FOrgHue) or inherited HasChanged;
end; end;
procedure TStaticItem.SetHue(AHue: Word); procedure TStaticItem.SetHue(AHue: Word);
begin begin
FHue := AHue; FHue := AHue;
DoChanged; DoChanged;
end; end;
function TStaticItem.Clone: TStaticItem; function TStaticItem.Clone: TStaticItem;
begin begin
Result := TStaticItem.Create(nil, nil); Result := TStaticItem.Create(nil, nil);
Result.FTileID := FTileID; Result.FTileID := FTileID;
Result.FX := FX; Result.FX := FX;
Result.FY := FY; Result.FY := FY;
Result.FZ := FZ; Result.FZ := FZ;
Result.FHue := FHue; Result.FHue := FHue;
end; end;
function TStaticItem.GetSize: Integer; function TStaticItem.GetSize: Integer;
begin begin
Result := 7; Result := 7;
end; end;
procedure TStaticItem.InitOriginalState; procedure TStaticItem.InitOriginalState;
begin begin
FOrgHue := FHue; FOrgHue := FHue;
inherited InitOriginalState; inherited InitOriginalState;
end; end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata; procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
ASolver: Integer); ASolver: Integer);
begin begin
FPriorityBonus := 0; FPriorityBonus := 0;
if not (tdfBackground in ATileData.Flags) then if not (tdfBackground in ATileData.Flags) then
Inc(FPriorityBonus); Inc(FPriorityBonus);
if ATileData.Height > 0 then if ATileData.Height > 0 then
Inc(FPriorityBonus); Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus; FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver; FPrioritySolver := ASolver;
end; end;
procedure TStaticItem.Write(AData: TStream); procedure TStaticItem.Write(AData: TStream);
var var
iX, iY: Byte; iX, iY: Byte;
begin begin
iX := FX mod 8; iX := FX mod 8;
iY := FY mod 8; iY := FY mod 8;
AData.Write(FTileID, SizeOf(SmallInt)); AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte)); AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte)); AData.Write(iY, SizeOf(Byte));
AData.Write(FZ, SizeOf(ShortInt)); AData.Write(FZ, SizeOf(ShortInt));
AData.Write(FHue, SizeOf(SmallInt)); AData.Write(FHue, SizeOf(SmallInt));
end; end;
{ TStaticBlock } { TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word); AX, AY: Word);
var var
i: Integer; i: Integer;
block: TMemoryStream; block: TMemoryStream;
begin begin
inherited Create; inherited Create;
FX := AX; FX := AX;
FY := AY; FY := AY;
FItems := TStaticItemList.Create(True); FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size); block.CopyFrom(AData, AIndex.Size);
block.Position := 0; block.Position := 0;
for i := 1 to (AIndex.Size div 7) do for i := 1 to (AIndex.Size div 7) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY)); FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free; block.Free;
end; end;
end; end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex); constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin begin
Create(AData, AIndex, 0, 0); Create(AData, AIndex, 0, 0);
end; end;
destructor TStaticBlock.Destroy; destructor TStaticBlock.Destroy;
var begin
i: Integer; FreeAndNil(FItems);
begin inherited;
FreeAndNil(FItems); end;
inherited;
end; function TStaticBlock.Clone: TStaticBlock;
var
function TStaticBlock.Clone: TStaticBlock; i: Integer;
var begin
i: Integer; Result := TStaticBlock.Create(nil, nil, FX, FY);
begin for i := 0 to FItems.Count - 1 do
Result := TStaticBlock.Create(nil, nil, FX, FY); Result.FItems.Add(FItems.Items[i].Clone);
for i := 0 to FItems.Count - 1 do end;
Result.FItems.Add(FItems.Items[i].Clone);
end; function TStaticBlock.GetSize: Integer;
begin
function TStaticBlock.GetSize: Integer; Result := FItems.Count * 7;
begin end;
Result := FItems.Count * 7;
end; procedure TStaticBlock.ReverseWrite(AData: TStream);
var
procedure TStaticBlock.ReverseWrite(AData: TStream); i: Integer;
var begin
i: Integer; for i := FItems.Count - 1 downto 0 do
begin FItems[i].Write(AData);
for i := FItems.Count - 1 downto 0 do end;
FItems[i].Write(AData);
end; procedure TStaticBlock.Sort;
begin
procedure TStaticBlock.Sort; FItems.Sort(@CompareStaticItems);
begin end;
FItems.Sort(@CompareStaticItems);
end; procedure TStaticBlock.Write(AData: TStream);
var
procedure TStaticBlock.Write(AData: TStream); i: Integer;
var begin
i: Integer; for i := 0 to FItems.Count - 1 do
begin FItems[i].Write(AData);
for i := 0 to FItems.Count - 1 do end;
FItems[i].Write(AData);
end; end.
end.