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

- Removed custom tile info window 

- Updated VirtualTreeView
- Added tile info as owner drawn hint to vdtTiles (fixes #55)
This commit is contained in:
Andreas Schneider 2009-12-19 19:01:48 +01:00
parent 9ab8e5901b
commit 158403e41a
10 changed files with 3267 additions and 3460 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
Client/CentrED.lpi
View File

@ -55,7 +55,7 @@
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item5>
</RequiredPackages>
<Units Count="43">
<Units Count="42">
<Unit0>
<Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/>
@ -191,126 +191,119 @@
<UnitName Value="UfrmFilter"/>
</Unit19>
<Unit20>
<Filename Value="UfrmTileInfo.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmTileInfo"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmTileInfo"/>
</Unit20>
<Unit21>
<Filename Value="UGUIPlatformUtils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UGUIPlatformUtils"/>
</Unit21>
<Unit22>
</Unit20>
<Unit21>
<Filename Value="UPlatformTypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPlatformTypes"/>
</Unit22>
<Unit23>
</Unit21>
<Unit22>
<Filename Value="UfrmRegionControl.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmRegionControl"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmRegionControl"/>
</Unit23>
<Unit24>
</Unit22>
<Unit23>
<Filename Value="UPacketHandlers.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPacketHandlers"/>
</Unit24>
<Unit25>
</Unit23>
<Unit24>
<Filename Value="UPackets.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPackets"/>
</Unit25>
<Unit26>
</Unit24>
<Unit25>
<Filename Value="ULandscape.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULandscape"/>
</Unit26>
<Unit27>
</Unit25>
<Unit26>
<Filename Value="UGameResources.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UGameResources"/>
</Unit27>
<Unit28>
</Unit26>
<Unit27>
<Filename Value="UAdminHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAdminHandling"/>
</Unit28>
<Unit29>
</Unit27>
<Unit28>
<Filename Value="Tools/UfrmToolWindow.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmToolWindow"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmToolWindow"/>
</Unit29>
<Unit30>
</Unit28>
<Unit29>
<Filename Value="../Logging.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Logging"/>
</Unit30>
<Unit31>
</Unit29>
<Unit30>
<Filename Value="../UOLib/UStatics.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UStatics"/>
</Unit31>
<Unit32>
</Unit30>
<Unit31>
<Filename Value="../UOLib/UWorldItem.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UWorldItem"/>
</Unit32>
<Unit33>
</Unit31>
<Unit32>
<Filename Value="../UOLib/UMap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UMap"/>
</Unit33>
<Unit34>
</Unit32>
<Unit33>
<Filename Value="../UOLib/UTiledata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UTiledata"/>
</Unit34>
<Unit35>
</Unit33>
<Unit34>
<Filename Value="UGLFont.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UGLFont"/>
</Unit35>
<Unit36>
</Unit34>
<Unit35>
<Filename Value="../UOLib/UAnimData.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAnimData"/>
</Unit36>
<Unit37>
</Unit35>
<Unit36>
<Filename Value="../MulProvider/UTileDataProvider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UTileDataProvider"/>
</Unit37>
<Unit38>
</Unit36>
<Unit37>
<Filename Value="../MulProvider/UAnimDataProvider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAnimDataProvider"/>
</Unit38>
<Unit39>
</Unit37>
<Unit38>
<Filename Value="../MulProvider/UMulManager.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UMulManager"/>
</Unit39>
<Unit40>
</Unit38>
<Unit39>
<Filename Value="../MulProvider/UArtProvider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UArtProvider"/>
</Unit40>
<Unit41>
</Unit39>
<Unit40>
<Filename Value="../MulProvider/UTexmapProvider.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UTexmapProvider"/>
</Unit41>
<Unit42>
</Unit40>
<Unit41>
<Filename Value="../version.inc"/>
<IsPartOfProject Value="True"/>
</Unit42>
</Unit41>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -353,7 +346,7 @@
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/
-dNoLogging"/>
#-dNoLogging"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>

2
Client/CentrED.lpr
View File

@ -38,7 +38,7 @@ uses
multiloglaz, UfrmEditAccount, UfrmDrawSettings, UfrmBoundaries,
UfrmElevateSettings, UOverlayUI, UResourceManager, UfrmConfirmation,
UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter,
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
Logging, UTileDataProvider, UMap, UWorldItem, UStatics, UTiledata, UAnimData,

46
Client/Tools/UfrmFilter.lfm
View File

@ -31,8 +31,8 @@ object frmFilter: TfrmFilter
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 22
ClientWidth = 220
ClientHeight = 26
ClientWidth = 222
Columns = 2
ItemIndex = 0
Items.Strings = (
@ -50,8 +50,8 @@ object frmFilter: TfrmFilter
Align = alClient
BorderSpacing.Around = 4
Caption = 'Tile filter'
ClientHeight = 241
ClientWidth = 220
ClientHeight = 245
ClientWidth = 222
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = GroupBox1
@ -60,9 +60,9 @@ object frmFilter: TfrmFilter
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 4
Height = 27
Top = 27
Width = 212
Height = 30
Top = 30
Width = 214
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 4
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
@ -79,7 +79,7 @@ object frmFilter: TfrmFilter
Left = 30
Height = 22
Hint = 'Clear'
Top = 215
Top = 219
Width = 22
Anchors = [akLeft, akBottom]
Color = clBtnFace
@ -131,7 +131,7 @@ object frmFilter: TfrmFilter
Left = 4
Height = 22
Hint = 'Delete'
Top = 215
Top = 219
Width = 22
Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
@ -187,12 +187,11 @@ object frmFilter: TfrmFilter
AnchorSideBottom.Control = btnDelete
Cursor = 63
Left = 4
Height = 153
Top = 58
Width = 212
Height = 151
Top = 64
Width = 214
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
DefaultNodeHeight = 44
DragType = dtVCL
Header.AutoSizeIndex = 0
@ -226,9 +225,9 @@ object frmFilter: TfrmFilter
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
Left = 4
Height = 19
Height = 22
Top = 4
Width = 78
Width = 85
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbTileFilterChange
@ -243,14 +242,14 @@ object frmFilter: TfrmFilter
Align = alBottom
BorderSpacing.Around = 4
Caption = 'Hue filter'
ClientHeight = 150
ClientWidth = 220
ClientHeight = 154
ClientWidth = 222
TabOrder = 2
object cbHueFilter: TCheckBox
Left = 4
Height = 19
Height = 22
Top = 4
Width = 212
Width = 214
Align = alTop
BorderSpacing.Around = 4
Caption = 'Filter active'
@ -260,12 +259,11 @@ object frmFilter: TfrmFilter
object vdtHues: TVirtualDrawTree
Cursor = 63
Left = 4
Height = 119
Top = 27
Width = 212
Height = 120
Top = 30
Width = 214
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsSingle
Header.AutoSizeIndex = 2
Header.Columns = <
item
@ -280,7 +278,7 @@ object frmFilter: TfrmFilter
item
Position = 2
Text = 'Name'
Width = 150
Width = 154
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]

4
Client/UdmNetwork.pas
View File

@ -78,7 +78,7 @@ uses
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmRegionControl;
UfrmVirtualLayer, UfrmFilter, UfrmRegionControl;
{$I version.inc}
@ -211,7 +211,6 @@ begin
frmFilter := TfrmFilter.Create(frmMain);
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
frmAbout := TfrmAbout.Create(frmMain);
frmTileInfo := TfrmTileInfo.Create(frmMain);
frmMain.Show;
frmInitialize.Hide;
tmNoOp.Enabled := True;
@ -293,7 +292,6 @@ begin
if frmInitialize = nil then
frmInitialize := TfrmInitialize.Create(dmNetwork);
FreeAndNil(frmTileInfo);
FreeAndNil(frmEditAccount);
FreeAndNil(frmAccountControl);
FreeAndNil(frmConfirmation);

3
Client/UfrmLargeScaleCommand.lfm
View File

@ -1089,7 +1089,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Width = 144
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 4
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <>
@ -1132,7 +1131,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
item
Position = 0
Text = 'Actions'
Width = 152
Width = 148
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoVisible]

21
Client/UfrmMain.lfm
View File

@ -141,6 +141,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spTileList
Left = 4
Height = 218
Hint = '-'
Top = 56
Width = 210
Anchors = [akTop, akLeft, akRight, akBottom]
@ -169,22 +170,24 @@ object frmMain: TfrmMain
end>
Header.DefaultHeight = 17
Header.MainColumn = 2
Header.Options = [hoVisible]
Header.Options = [hoShowHint, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
HintMode = hmHint
ParentShowHint = False
PopupMenu = pmTileList
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
OnClick = vdtTilesClick
OnDrawHint = vdtTilesDrawHint
OnDrawNode = vdtTilesDrawNode
OnEnter = vdtTilesEnter
OnExit = vdtTilesExit
OnHotChange = vdtTilesHotChange
OnGetHintSize = vdtTilesGetHintSize
OnKeyPress = vdtTilesKeyPress
OnMouseMove = vdtTilesMouseMove
OnScroll = vdtTilesScroll
end
object gbRandom: TGroupBox
@ -809,7 +812,6 @@ object frmMain: TfrmMain
Width = 210
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 1
Header.Columns = <
@ -1094,7 +1096,7 @@ object frmMain: TfrmMain
item
Position = 2
Text = 'Message'
Width = 381
Width = 379
end>
Header.DefaultHeight = 17
Header.MainColumn = 2
@ -2139,6 +2141,7 @@ object frmMain: TfrmMain
end
object ApplicationProperties1: TApplicationProperties
OnIdle = ApplicationProperties1Idle
OnShowHint = ApplicationProperties1ShowHint
left = 295
top = 33
end
@ -2614,12 +2617,6 @@ object frmMain: TfrmMain
left = 368
top = 80
end
object tmTileHint: TTimer
Enabled = False
OnTimer = tmTileHintTimer
left = 184
top = 224
end
object pmGrabTileInfo: TPopupMenu
OnPopup = pmGrabTileInfoPopup
left = 368

174
Client/UfrmMain.pas
View File

@ -35,7 +35,7 @@ uses
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
XMLPropStorage, fgl, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
UGLFont, DOM, XMLRead, XMLWrite;
UGLFont, DOM, XMLRead, XMLWrite, strutils;
type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@ -48,6 +48,13 @@ type
TAccessChangedListeners = specialize TFPGList<TAccessChangedListener>;
TSelectionListeners = specialize TFPGList<TSelectionListener>;
TTileHintInfo = record
Name: String;
Flags: String;
NameRect: TRect;
FlagsRect: TRect;
end;
{ TfrmMain }
TfrmMain = class(TForm)
@ -138,7 +145,6 @@ type
tbFilter: TToolButton;
tbFlat: TToolButton;
tbNoDraw: TToolButton;
tmTileHint: TTimer;
tbSeparator2: TToolButton;
tbUndo: TToolButton;
tsLocations: TTabSheet;
@ -181,6 +187,8 @@ type
procedure acUndoExecute(Sender: TObject);
procedure acVirtualLayerExecute(Sender: TObject);
procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
procedure ApplicationProperties1ShowHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
procedure btnAddLocationClick(Sender: TObject);
procedure btnAddRandomClick(Sender: TObject);
procedure btnClearLocationsClick(Sender: TObject);
@ -240,7 +248,6 @@ type
procedure tbTerrainClick(Sender: TObject);
procedure tmGrabTileInfoTimer(Sender: TObject);
procedure tmMovementTimer(Sender: TObject);
procedure tmTileHintTimer(Sender: TObject);
procedure vdtRandomClick(Sender: TObject);
procedure vdtRandomDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
@ -254,15 +261,14 @@ type
Stream: TStream);
procedure vdtRandomUpdating(Sender: TBaseVirtualTree; State: TVTUpdateState);
procedure vdtTilesClick(Sender: TObject);
procedure vdtTilesDrawHint(Sender: TBaseVirtualTree; HintCanvas: TCanvas;
Node: PVirtualNode; const R: TRect; Column: TColumnIndex);
procedure vdtTilesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtTilesEnter(Sender: TObject);
procedure vdtTilesExit(Sender: TObject);
procedure vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode);
procedure vdtTilesGetHintSize(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var R: TRect);
procedure vdtTilesKeyPress(Sender: TObject; var Key: char);
procedure vdtTilesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer);
procedure vstChatClick(Sender: TObject);
procedure vstChatFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
@ -316,6 +322,7 @@ type
FUndoList: TPacketList;
FGLFont: TGLFont;
FSelectionListeners: TSelectionListeners;
FTileHint: TTileHintInfo;
{ Methods }
procedure BuildTileList;
function ConfirmAction: Boolean;
@ -387,8 +394,8 @@ uses
UfrmAccountControl, UGraphicHelper, ImagingComponents, UfrmDrawSettings,
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UPacketHandlers, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UfrmRegionControl, Logging, LConvEncoding, LCLType;
UfrmLogin, UResourceManager, UfrmVirtualLayer, UfrmFilter, UfrmRegionControl,
Logging, LConvEncoding, LCLType;
type
TGLArrayf4 = array[0..3] of GLfloat;
@ -1053,6 +1060,17 @@ begin
Done := False;
end;
procedure TfrmMain.ApplicationProperties1ShowHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo);
begin
//that check is a bit dirty, but serves its purpose
//(i.e. to set the timeout for the tile info hints)
if HintStr = '-' then
HintInfo.HideTimeout := Application.HintHidePause +
Application.HintHidePausePerChar * (Length(FTileHint.Name) +
Length(FTileHint.Flags));
end;
procedure TfrmMain.btnAddLocationClick(Sender: TObject);
var
locationName: string;
@ -1446,12 +1464,6 @@ begin
end;
end;
procedure TfrmMain.tmTileHintTimer(Sender: TObject);
begin
frmTileInfo.Show;
tmTileHint.Enabled := False;
end;
procedure TfrmMain.vdtRandomClick(Sender: TObject);
var
node: PVirtualNode;
@ -1538,6 +1550,18 @@ begin
ProcessToolState;
end;
procedure TfrmMain.vdtTilesDrawHint(Sender: TBaseVirtualTree;
HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex
);
begin
HintCanvas.Font.Style := [fsBold];
DrawText(HintCanvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name),
FTileHint.NameRect, 0);
HintCanvas.Font.Style := [fsItalic];
DrawText(HintCanvas.Handle, PChar(FTileHint.Flags), Length(FTileHint.Flags),
FTileHint.FlagsRect, DT_WORDBREAK);
end;
procedure TfrmMain.vdtTilesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
@ -1594,34 +1618,88 @@ begin
end;
end;
procedure TfrmMain.vdtTilesExit(Sender: TObject);
begin
{TODO : Fix mouse over on !Windows platforms}
{$IFDEF Windows}
tmTileHint.Enabled := False;
{$ENDIF Windows}
end;
procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode);
{$IFDEF Windows}
procedure TfrmMain.vdtTilesGetHintSize(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
var
tileInfo: PTileInfo;
{$ENDIF Windows}
begin
{TODO : Fix mouse over on !Windows platforms}
{$IFDEF Windows}
if NewNode <> nil then
tileData: TTiledata;
prefix, flags: string;
procedure UpdateFlags(AFlag: TTileDataFlag; AName: string);
begin
tileInfo := vdtTiles.GetNodeData(NewNode);
frmTileInfo.Update(tileInfo^.ID);
tmTileHint.Enabled := True;
end else
begin
frmTileInfo.Hide;
tmTileHint.Enabled := False;
if AFlag in tileData.Flags then
begin
if flags <> '' then
flags := flags + ', ' + AName
else
flags := AName;
end;
end;
{$ENDIF Windows}
begin
tileInfo := Sender.GetNodeData(Node);
flags := '';
tileData := ResMan.Tiledata.TileData[tileInfo^.ID];
if tileInfo^.ID < $4000 then
begin
if TLandTiledata(tileData).TextureID > 0 then
flags := 'Stretchable';
end;
if tdfArticleA in tileData.Flags then
prefix := 'a '
else if tdfArticleAn in tileData.Flags then
prefix := 'an '
else
prefix := '';
FTileHint.Name := AnsiProperCase(Format('%s%s',
[prefix, tileData.TileName]), [' ']);
FTileHint.NameRect.Left := 5;
FTileHint.NameRect.Top := 5;
Sender.Canvas.Font.Style := [fsBold];
DrawText(Sender.Canvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name),
FTileHint.NameRect, DT_CALCRECT);
UpdateFlags(tdfBackground, 'Background');
UpdateFlags(tdfWeapon, 'Weapon');
UpdateFlags(tdfTransparent, 'Transparent');
UpdateFlags(tdfTranslucent, 'Translucent');
UpdateFlags(tdfWall, 'Wall');
UpdateFlags(tdfDamaging, 'Damaging');
UpdateFlags(tdfImpassable, 'Impassable');
UpdateFlags(tdfWet, 'Wet');
UpdateFlags(tdfSurface, 'Surface');
UpdateFlags(tdfBridge, 'Bridge');
UpdateFlags(tdfGeneric, 'Generic');
UpdateFlags(tdfWindow, 'Window');
UpdateFlags(tdfNoShoot, 'NoShoot');
UpdateFlags(tdfInternal, 'Internal');
UpdateFlags(tdfFoliage, 'Foliage');
UpdateFlags(tdfPartialHue, 'PartialHue');
UpdateFlags(tdfMap, 'Map');
UpdateFlags(tdfContainer, 'Container');
UpdateFlags(tdfWearable, 'Wearable');
UpdateFlags(tdfLightSource, 'Lightsource');
UpdateFlags(tdfAnimation, 'Animation');
UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
UpdateFlags(tdfArmor, 'Armor');
UpdateFlags(tdfRoof, 'Roof');
UpdateFlags(tdfDoor, 'Door');
UpdateFlags(tdfStairBack, 'StairBack');
UpdateFlags(tdfStairRight, 'StairRight');
FTileHint.Flags := Format('Flags = [%s]', [flags]);
FTileHint.FlagsRect.Left := 5;
FTileHint.FlagsRect.Top := FTileHint.NameRect.Bottom + 5;
FTileHint.FlagsRect.Right := 145;
Sender.Canvas.Font.Style := [fsItalic];
DrawText(Sender.Canvas.Handle, PChar(FTileHint.Flags), Length(FTileHint.Flags),
FTileHint.FlagsRect, DT_CALCRECT or DT_WORDBREAK);
R := Rect(0, 0, Max(FTileHint.NameRect.Right, FTileHint.FlagsRect.Right) + 5,
FTileHint.FlagsRect.Bottom + 5);
end;
procedure TfrmMain.vdtTilesKeyPress(Sender: TObject; var Key: char);
@ -1636,22 +1714,6 @@ begin
end;
end;
procedure TfrmMain.vdtTilesMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if tmTileHint.Enabled then
begin
tmTileHint.Enabled := False;
tmTileHint.Enabled := True; //Restart timer
end;
if frmTileInfo.Visible then
begin
frmTileInfo.Hide;
tmTileHint.Enabled := True;
end;
end;
procedure TfrmMain.vdtTilesScroll(Sender: TBaseVirtualTree; DeltaX,
DeltaY: Integer);
begin

3
Client/UfrmRegionControl.lfm
View File

@ -85,7 +85,7 @@ object frmRegionControl: TfrmRegionControl
item
Position = 0
Text = 'Regions'
Width = 160
Width = 156
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoVisible]
@ -222,7 +222,6 @@ object frmRegionControl: TfrmRegionControl
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <>

69
Client/UfrmTileInfo.lfm
View File

@ -1,69 +0,0 @@
object frmTileInfo: TfrmTileInfo
Left = 290
Height = 59
Top = 171
Width = 250
HorzScrollBar.Page = 249
VertScrollBar.Page = 106
AutoSize = True
BorderIcons = []
BorderStyle = bsNone
Caption = 'Tile info'
ClientHeight = 59
ClientWidth = 250
Color = clInfoBk
Constraints.MinWidth = 250
Font.Color = clInfoText
FormStyle = fsStayOnTop
OnShow = FormShow
ShowInTaskBar = stNever
LCLVersion = '0.9.29'
object lblTileID: TLabel
Left = 8
Height = 16
Top = 26
Width = 234
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Font.Color = clInfoText
Font.Style = [fsItalic]
ParentColor = False
ParentFont = False
end
object lblFlags: TLabel
Left = 8
Height = 1
Top = 50
Width = 234
Align = alTop
BorderSpacing.Around = 8
Font.Color = clInfoText
ParentColor = False
ParentFont = False
WordWrap = True
end
object lblName: TLabel
Left = 8
Height = 16
Top = 8
Width = 234
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 2
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object tmHide: TTimer
Enabled = False
Interval = 5000
OnTimer = tmHideTimer
left = 216
top = 8
end
end

170
Client/UfrmTileInfo.pas
View File

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