- Removed custom tile info window
- Updated VirtualTreeView - Added tile info as owner drawn hint to vdtTiles (fixes #55)
This commit is contained in:
parent
9ab8e5901b
commit
158403e41a
|
|
@ -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>
|
||||
|
|
|
|||
|
|
@ -1,61 +1,61 @@
|
|||
(*
|
||||
* 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
|
||||
*)
|
||||
program CentrED;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
SysUtils,
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, LResources, lnetvisual, LazOpenGLContext, UdmNetwork, UfrmMain,
|
||||
UfrmLogin, UfrmInitialize, UfrmAccountControl, virtualtreeview_package,
|
||||
multiloglaz, UfrmEditAccount, UfrmDrawSettings, UfrmBoundaries,
|
||||
UfrmElevateSettings, UOverlayUI, UResourceManager, UfrmConfirmation,
|
||||
UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
|
||||
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
|
||||
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
|
||||
UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
|
||||
Logging, UTileDataProvider, UMap, UWorldItem, UStatics, UTiledata, UAnimData,
|
||||
UGLFont, UAnimDataProvider, UMulManager, UArtProvider, UTexmapProvider;
|
||||
|
||||
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
|
||||
|
||||
function GetApplicationName: String;
|
||||
begin
|
||||
Result := 'CentrED';
|
||||
end;
|
||||
|
||||
begin
|
||||
{$I CentrED.lrs}
|
||||
OnGetApplicationName := @GetApplicationName;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TdmNetwork, dmNetwork);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
program CentrED;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
SysUtils,
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, LResources, lnetvisual, LazOpenGLContext, UdmNetwork, UfrmMain,
|
||||
UfrmLogin, UfrmInitialize, UfrmAccountControl, virtualtreeview_package,
|
||||
multiloglaz, UfrmEditAccount, UfrmDrawSettings, UfrmBoundaries,
|
||||
UfrmElevateSettings, UOverlayUI, UResourceManager, UfrmConfirmation,
|
||||
UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
|
||||
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter,
|
||||
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
|
||||
UPacketHandlers, UAdminHandling, UGameResources, ULandscape, UfrmToolWindow,
|
||||
Logging, UTileDataProvider, UMap, UWorldItem, UStatics, UTiledata, UAnimData,
|
||||
UGLFont, UAnimDataProvider, UMulManager, UArtProvider, UTexmapProvider;
|
||||
|
||||
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
|
||||
|
||||
function GetApplicationName: String;
|
||||
begin
|
||||
Result := 'CentrED';
|
||||
end;
|
||||
|
||||
begin
|
||||
{$I CentrED.lrs}
|
||||
OnGetApplicationName := @GetApplicationName;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TdmNetwork, dmNetwork);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -1,371 +1,369 @@
|
|||
(*
|
||||
* 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 UdmNetwork;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
|
||||
UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;
|
||||
|
||||
type
|
||||
|
||||
{ TdmNetwork }
|
||||
|
||||
TdmNetwork = class(TDataModule)
|
||||
TCPClient: TLTCPComponent;
|
||||
tmNoOp: TTimer;
|
||||
procedure DataModuleCreate(Sender: TObject);
|
||||
procedure DataModuleDestroy(Sender: TObject);
|
||||
procedure TCPClientConnect(aSocket: TLSocket);
|
||||
procedure TCPClientDisconnect(aSocket: TLSocket);
|
||||
procedure TCPClientError(const msg: string; aSocket: TLSocket);
|
||||
procedure TCPClientReceive(aSocket: TLSocket);
|
||||
procedure tmNoOpStartTimer(Sender: TObject);
|
||||
procedure tmNoOpTimer(Sender: TObject);
|
||||
protected
|
||||
FSendQueue: TEnhancedMemoryStream;
|
||||
FReceiveQueue: TEnhancedMemoryStream;
|
||||
FUsername: string;
|
||||
FPassword: string;
|
||||
FAccessLevel: TAccessLevel;
|
||||
FDataDir: string;
|
||||
FLastPacket: TDateTime;
|
||||
procedure OnCanSend(ASocket: TLSocket);
|
||||
procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||
procedure ProcessQueue;
|
||||
procedure DoLogin;
|
||||
public
|
||||
property Username: string read FUsername;
|
||||
property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
|
||||
procedure Send(APacket: TPacket);
|
||||
procedure Disconnect;
|
||||
procedure CheckClose(ASender: TForm);
|
||||
end;
|
||||
|
||||
var
|
||||
dmNetwork: TdmNetwork;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
|
||||
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
|
||||
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
|
||||
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
|
||||
UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmRegionControl;
|
||||
|
||||
{$I version.inc}
|
||||
|
||||
{ TdmNetwork }
|
||||
|
||||
procedure TdmNetwork.DataModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FSendQueue := TEnhancedMemoryStream.Create;
|
||||
FReceiveQueue := TEnhancedMemoryStream.Create;
|
||||
TCPClient.OnCanSend := @OnCanSend;
|
||||
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
|
||||
DoLogin;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(FSendQueue);
|
||||
FreeAndNil(FReceiveQueue);
|
||||
FreeAndNil(PacketHandlers[$02]);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
|
||||
begin
|
||||
FSendQueue.Clear;
|
||||
FReceiveQueue.Clear;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
|
||||
begin
|
||||
FSendQueue.Clear;
|
||||
FReceiveQueue.Clear;
|
||||
DoLogin;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
|
||||
begin
|
||||
MessageDlg('Connection error', msg, mtError, [mbOK], 0);
|
||||
if not TCPClient.Connected then
|
||||
TCPClientDisconnect(aSocket);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
|
||||
var
|
||||
buffer: array[0..4095] of byte;
|
||||
size: Integer;
|
||||
begin
|
||||
repeat
|
||||
size := TCPClient.Get(buffer, 4096);
|
||||
if size > 0 then
|
||||
FReceiveQueue.Enqueue(buffer, size);
|
||||
until size <= 0;
|
||||
ProcessQueue;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
|
||||
begin
|
||||
FLastPacket := Now;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
|
||||
begin
|
||||
if SecondsBetween(FLastPacket, Now) > 25 then
|
||||
Send(TNoOpPacket.Create);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
|
||||
var
|
||||
size: Integer;
|
||||
begin
|
||||
while FSendQueue.Size > 0 do
|
||||
begin
|
||||
FLastPacket := Now;
|
||||
size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
|
||||
if size > 0 then
|
||||
FSendQueue.Dequeue(size)
|
||||
else
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
subID: Byte;
|
||||
loginState: TLoginState;
|
||||
width, height: Word;
|
||||
serverState: TServerState;
|
||||
begin
|
||||
subID := ABuffer.ReadByte;
|
||||
case subID of
|
||||
$01:
|
||||
begin
|
||||
if ABuffer.ReadCardinal = ProtocolVersion then
|
||||
begin
|
||||
frmInitialize.lblStatus.Caption := 'Authenticating';
|
||||
Send(TLoginRequestPacket.Create(FUsername, FPassword));
|
||||
end else
|
||||
begin
|
||||
MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
|
||||
Disconnect;
|
||||
end;
|
||||
end;
|
||||
$03:
|
||||
begin
|
||||
loginState := TLoginState(ABuffer.ReadByte);
|
||||
if loginState = lsOK then
|
||||
begin
|
||||
frmInitialize.lblStatus.Caption := 'Initializing';
|
||||
frmInitialize.Repaint;
|
||||
frmInitialize.lblStatus.Repaint;
|
||||
Application.ProcessMessages;
|
||||
FAccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
InitGameResourceManager(FDataDir);
|
||||
width := ABuffer.ReadWord;
|
||||
height := ABuffer.ReadWord;
|
||||
ResMan.InitLandscape(width, height);
|
||||
ResMan.Landscape.UpdateWriteMap(ABuffer);
|
||||
|
||||
frmMain := TfrmMain.Create(dmNetwork);
|
||||
frmRadarMap := TfrmRadarMap.Create(frmMain);
|
||||
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
|
||||
frmRegionControl := TfrmRegionControl.Create(frmMain);
|
||||
frmAccountControl := TfrmAccountControl.Create(frmMain);
|
||||
frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
|
||||
frmConfirmation := TfrmConfirmation.Create(frmMain);
|
||||
frmDrawSettings := TfrmDrawSettings.Create(frmMain);
|
||||
frmMoveSettings := TfrmMoveSettings.Create(frmMain);
|
||||
frmElevateSettings := TfrmElevateSettings.Create(frmMain);
|
||||
frmHueSettings := TfrmHueSettings.Create(frmMain);
|
||||
frmBoundaries := TfrmBoundaries.Create(frmMain);
|
||||
frmFilter := TfrmFilter.Create(frmMain);
|
||||
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
|
||||
frmAbout := TfrmAbout.Create(frmMain);
|
||||
frmTileInfo := TfrmTileInfo.Create(frmMain);
|
||||
frmMain.Show;
|
||||
frmInitialize.Hide;
|
||||
tmNoOp.Enabled := True;
|
||||
end else
|
||||
begin
|
||||
if loginState = lsInvalidUser then
|
||||
MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
|
||||
else if loginState = lsInvalidPassword then
|
||||
MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
|
||||
else if loginState = lsAlreadyLoggedIn then
|
||||
MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
|
||||
else if loginState = lsNoAccess then
|
||||
MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
$04: //Server state
|
||||
begin
|
||||
serverState := TServerState(ABuffer.ReadByte);
|
||||
if serverState = ssRunning then
|
||||
begin
|
||||
frmInitialize.UnsetModal;
|
||||
frmInitialize.Hide;
|
||||
tmNoOp.Enabled := True;
|
||||
end else
|
||||
begin
|
||||
case serverState of
|
||||
ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
|
||||
ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
|
||||
end;
|
||||
tmNoOp.Enabled := False;
|
||||
frmInitialize.Show;
|
||||
frmInitialize.SetModal;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.ProcessQueue;
|
||||
var
|
||||
packetHandler: TPacketHandler;
|
||||
size: Cardinal;
|
||||
begin
|
||||
FReceiveQueue.Position := 0;
|
||||
while FReceiveQueue.Size >= 1 do
|
||||
begin
|
||||
packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
|
||||
if packetHandler <> nil then
|
||||
begin
|
||||
size := packetHandler.PacketLength;
|
||||
if size = 0 then
|
||||
begin
|
||||
if FReceiveQueue.Size > 5 then
|
||||
size := FReceiveQueue.ReadCardinal
|
||||
else
|
||||
Break; //wait for more data
|
||||
end;
|
||||
|
||||
if FReceiveQueue.Size >= size then
|
||||
begin
|
||||
FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
|
||||
packetHandler.Process(FReceiveQueue);
|
||||
FReceiveQueue.Unlock;
|
||||
FReceiveQueue.Dequeue(size);
|
||||
end else
|
||||
Break; //wait for more data
|
||||
end else
|
||||
begin
|
||||
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
|
||||
Disconnect;
|
||||
FReceiveQueue.Clear;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.DoLogin;
|
||||
begin
|
||||
tmNoOp.Enabled := False;
|
||||
frmLogin := TfrmLogin.Create(dmNetwork);
|
||||
if frmInitialize = nil then
|
||||
frmInitialize := TfrmInitialize.Create(dmNetwork);
|
||||
|
||||
FreeAndNil(frmTileInfo);
|
||||
FreeAndNil(frmEditAccount);
|
||||
FreeAndNil(frmAccountControl);
|
||||
FreeAndNil(frmConfirmation);
|
||||
FreeAndNil(frmDrawSettings);
|
||||
FreeAndNil(frmMoveSettings);
|
||||
FreeAndNil(frmElevateSettings);
|
||||
FreeAndNil(frmHueSettings);
|
||||
FreeAndNil(frmBoundaries);
|
||||
FreeAndNil(frmFilter);
|
||||
FreeAndNil(frmVirtualLayer);
|
||||
FreeAndNil(frmAbout);
|
||||
FreeAndNil(frmRegionControl);
|
||||
FreeAndNil(frmLargeScaleCommand);
|
||||
FreeAndNil(frmRadarMap);
|
||||
|
||||
if frmMain <> nil then
|
||||
begin
|
||||
frmMain.ApplicationProperties1.OnIdle := nil;
|
||||
FreeAndNil(frmMain);
|
||||
end;
|
||||
|
||||
FreeAndNil(GameResourceManager);
|
||||
|
||||
frmInitialize.Hide;
|
||||
while frmLogin.ShowModal = mrOK do
|
||||
begin
|
||||
if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
|
||||
begin
|
||||
FUsername := frmLogin.edUsername.Text;
|
||||
FPassword := frmLogin.edPassword.Text;
|
||||
FDataDir := frmLogin.edData.Text;
|
||||
frmInitialize.lblStatus.Caption := 'Connecting';
|
||||
frmInitialize.Show;
|
||||
Break;
|
||||
end else
|
||||
MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
|
||||
end;
|
||||
frmLogin.Close;
|
||||
FreeAndNil(frmLogin);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.Send(APacket: TPacket);
|
||||
var
|
||||
source: TEnhancedMemoryStream;
|
||||
begin
|
||||
if TCPClient.Connected then
|
||||
begin
|
||||
FSendQueue.Seek(0, soFromEnd);
|
||||
source := APacket.Stream;
|
||||
FSendQueue.CopyFrom(source, 0);
|
||||
OnCanSend(nil);
|
||||
end;
|
||||
APacket.Free;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.Disconnect;
|
||||
begin
|
||||
Send(TQuitPacket.Create);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.CheckClose(ASender: TForm);
|
||||
begin
|
||||
if ((frmLogin = nil) or (ASender = frmLogin)) and
|
||||
((frmMain = nil) or (ASender = frmMain)) and
|
||||
((frmInitialize = nil) or (not frmInitialize.Visible)) then
|
||||
begin
|
||||
Application.Terminate;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UdmNetwork.lrs}
|
||||
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UdmNetwork;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
|
||||
UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;
|
||||
|
||||
type
|
||||
|
||||
{ TdmNetwork }
|
||||
|
||||
TdmNetwork = class(TDataModule)
|
||||
TCPClient: TLTCPComponent;
|
||||
tmNoOp: TTimer;
|
||||
procedure DataModuleCreate(Sender: TObject);
|
||||
procedure DataModuleDestroy(Sender: TObject);
|
||||
procedure TCPClientConnect(aSocket: TLSocket);
|
||||
procedure TCPClientDisconnect(aSocket: TLSocket);
|
||||
procedure TCPClientError(const msg: string; aSocket: TLSocket);
|
||||
procedure TCPClientReceive(aSocket: TLSocket);
|
||||
procedure tmNoOpStartTimer(Sender: TObject);
|
||||
procedure tmNoOpTimer(Sender: TObject);
|
||||
protected
|
||||
FSendQueue: TEnhancedMemoryStream;
|
||||
FReceiveQueue: TEnhancedMemoryStream;
|
||||
FUsername: string;
|
||||
FPassword: string;
|
||||
FAccessLevel: TAccessLevel;
|
||||
FDataDir: string;
|
||||
FLastPacket: TDateTime;
|
||||
procedure OnCanSend(ASocket: TLSocket);
|
||||
procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||
procedure ProcessQueue;
|
||||
procedure DoLogin;
|
||||
public
|
||||
property Username: string read FUsername;
|
||||
property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
|
||||
procedure Send(APacket: TPacket);
|
||||
procedure Disconnect;
|
||||
procedure CheckClose(ASender: TForm);
|
||||
end;
|
||||
|
||||
var
|
||||
dmNetwork: TdmNetwork;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
|
||||
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
|
||||
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
|
||||
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
|
||||
UfrmVirtualLayer, UfrmFilter, UfrmRegionControl;
|
||||
|
||||
{$I version.inc}
|
||||
|
||||
{ TdmNetwork }
|
||||
|
||||
procedure TdmNetwork.DataModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FSendQueue := TEnhancedMemoryStream.Create;
|
||||
FReceiveQueue := TEnhancedMemoryStream.Create;
|
||||
TCPClient.OnCanSend := @OnCanSend;
|
||||
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
|
||||
DoLogin;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(FSendQueue);
|
||||
FreeAndNil(FReceiveQueue);
|
||||
FreeAndNil(PacketHandlers[$02]);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
|
||||
begin
|
||||
FSendQueue.Clear;
|
||||
FReceiveQueue.Clear;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
|
||||
begin
|
||||
FSendQueue.Clear;
|
||||
FReceiveQueue.Clear;
|
||||
DoLogin;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
|
||||
begin
|
||||
MessageDlg('Connection error', msg, mtError, [mbOK], 0);
|
||||
if not TCPClient.Connected then
|
||||
TCPClientDisconnect(aSocket);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
|
||||
var
|
||||
buffer: array[0..4095] of byte;
|
||||
size: Integer;
|
||||
begin
|
||||
repeat
|
||||
size := TCPClient.Get(buffer, 4096);
|
||||
if size > 0 then
|
||||
FReceiveQueue.Enqueue(buffer, size);
|
||||
until size <= 0;
|
||||
ProcessQueue;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
|
||||
begin
|
||||
FLastPacket := Now;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
|
||||
begin
|
||||
if SecondsBetween(FLastPacket, Now) > 25 then
|
||||
Send(TNoOpPacket.Create);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
|
||||
var
|
||||
size: Integer;
|
||||
begin
|
||||
while FSendQueue.Size > 0 do
|
||||
begin
|
||||
FLastPacket := Now;
|
||||
size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
|
||||
if size > 0 then
|
||||
FSendQueue.Dequeue(size)
|
||||
else
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
subID: Byte;
|
||||
loginState: TLoginState;
|
||||
width, height: Word;
|
||||
serverState: TServerState;
|
||||
begin
|
||||
subID := ABuffer.ReadByte;
|
||||
case subID of
|
||||
$01:
|
||||
begin
|
||||
if ABuffer.ReadCardinal = ProtocolVersion then
|
||||
begin
|
||||
frmInitialize.lblStatus.Caption := 'Authenticating';
|
||||
Send(TLoginRequestPacket.Create(FUsername, FPassword));
|
||||
end else
|
||||
begin
|
||||
MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
|
||||
Disconnect;
|
||||
end;
|
||||
end;
|
||||
$03:
|
||||
begin
|
||||
loginState := TLoginState(ABuffer.ReadByte);
|
||||
if loginState = lsOK then
|
||||
begin
|
||||
frmInitialize.lblStatus.Caption := 'Initializing';
|
||||
frmInitialize.Repaint;
|
||||
frmInitialize.lblStatus.Repaint;
|
||||
Application.ProcessMessages;
|
||||
FAccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
InitGameResourceManager(FDataDir);
|
||||
width := ABuffer.ReadWord;
|
||||
height := ABuffer.ReadWord;
|
||||
ResMan.InitLandscape(width, height);
|
||||
ResMan.Landscape.UpdateWriteMap(ABuffer);
|
||||
|
||||
frmMain := TfrmMain.Create(dmNetwork);
|
||||
frmRadarMap := TfrmRadarMap.Create(frmMain);
|
||||
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
|
||||
frmRegionControl := TfrmRegionControl.Create(frmMain);
|
||||
frmAccountControl := TfrmAccountControl.Create(frmMain);
|
||||
frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
|
||||
frmConfirmation := TfrmConfirmation.Create(frmMain);
|
||||
frmDrawSettings := TfrmDrawSettings.Create(frmMain);
|
||||
frmMoveSettings := TfrmMoveSettings.Create(frmMain);
|
||||
frmElevateSettings := TfrmElevateSettings.Create(frmMain);
|
||||
frmHueSettings := TfrmHueSettings.Create(frmMain);
|
||||
frmBoundaries := TfrmBoundaries.Create(frmMain);
|
||||
frmFilter := TfrmFilter.Create(frmMain);
|
||||
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
|
||||
frmAbout := TfrmAbout.Create(frmMain);
|
||||
frmMain.Show;
|
||||
frmInitialize.Hide;
|
||||
tmNoOp.Enabled := True;
|
||||
end else
|
||||
begin
|
||||
if loginState = lsInvalidUser then
|
||||
MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
|
||||
else if loginState = lsInvalidPassword then
|
||||
MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
|
||||
else if loginState = lsAlreadyLoggedIn then
|
||||
MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
|
||||
else if loginState = lsNoAccess then
|
||||
MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
$04: //Server state
|
||||
begin
|
||||
serverState := TServerState(ABuffer.ReadByte);
|
||||
if serverState = ssRunning then
|
||||
begin
|
||||
frmInitialize.UnsetModal;
|
||||
frmInitialize.Hide;
|
||||
tmNoOp.Enabled := True;
|
||||
end else
|
||||
begin
|
||||
case serverState of
|
||||
ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
|
||||
ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
|
||||
end;
|
||||
tmNoOp.Enabled := False;
|
||||
frmInitialize.Show;
|
||||
frmInitialize.SetModal;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.ProcessQueue;
|
||||
var
|
||||
packetHandler: TPacketHandler;
|
||||
size: Cardinal;
|
||||
begin
|
||||
FReceiveQueue.Position := 0;
|
||||
while FReceiveQueue.Size >= 1 do
|
||||
begin
|
||||
packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
|
||||
if packetHandler <> nil then
|
||||
begin
|
||||
size := packetHandler.PacketLength;
|
||||
if size = 0 then
|
||||
begin
|
||||
if FReceiveQueue.Size > 5 then
|
||||
size := FReceiveQueue.ReadCardinal
|
||||
else
|
||||
Break; //wait for more data
|
||||
end;
|
||||
|
||||
if FReceiveQueue.Size >= size then
|
||||
begin
|
||||
FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
|
||||
packetHandler.Process(FReceiveQueue);
|
||||
FReceiveQueue.Unlock;
|
||||
FReceiveQueue.Dequeue(size);
|
||||
end else
|
||||
Break; //wait for more data
|
||||
end else
|
||||
begin
|
||||
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
|
||||
Disconnect;
|
||||
FReceiveQueue.Clear;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.DoLogin;
|
||||
begin
|
||||
tmNoOp.Enabled := False;
|
||||
frmLogin := TfrmLogin.Create(dmNetwork);
|
||||
if frmInitialize = nil then
|
||||
frmInitialize := TfrmInitialize.Create(dmNetwork);
|
||||
|
||||
FreeAndNil(frmEditAccount);
|
||||
FreeAndNil(frmAccountControl);
|
||||
FreeAndNil(frmConfirmation);
|
||||
FreeAndNil(frmDrawSettings);
|
||||
FreeAndNil(frmMoveSettings);
|
||||
FreeAndNil(frmElevateSettings);
|
||||
FreeAndNil(frmHueSettings);
|
||||
FreeAndNil(frmBoundaries);
|
||||
FreeAndNil(frmFilter);
|
||||
FreeAndNil(frmVirtualLayer);
|
||||
FreeAndNil(frmAbout);
|
||||
FreeAndNil(frmRegionControl);
|
||||
FreeAndNil(frmLargeScaleCommand);
|
||||
FreeAndNil(frmRadarMap);
|
||||
|
||||
if frmMain <> nil then
|
||||
begin
|
||||
frmMain.ApplicationProperties1.OnIdle := nil;
|
||||
FreeAndNil(frmMain);
|
||||
end;
|
||||
|
||||
FreeAndNil(GameResourceManager);
|
||||
|
||||
frmInitialize.Hide;
|
||||
while frmLogin.ShowModal = mrOK do
|
||||
begin
|
||||
if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
|
||||
begin
|
||||
FUsername := frmLogin.edUsername.Text;
|
||||
FPassword := frmLogin.edPassword.Text;
|
||||
FDataDir := frmLogin.edData.Text;
|
||||
frmInitialize.lblStatus.Caption := 'Connecting';
|
||||
frmInitialize.Show;
|
||||
Break;
|
||||
end else
|
||||
MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
|
||||
end;
|
||||
frmLogin.Close;
|
||||
FreeAndNil(frmLogin);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.Send(APacket: TPacket);
|
||||
var
|
||||
source: TEnhancedMemoryStream;
|
||||
begin
|
||||
if TCPClient.Connected then
|
||||
begin
|
||||
FSendQueue.Seek(0, soFromEnd);
|
||||
source := APacket.Stream;
|
||||
FSendQueue.CopyFrom(source, 0);
|
||||
OnCanSend(nil);
|
||||
end;
|
||||
APacket.Free;
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.Disconnect;
|
||||
begin
|
||||
Send(TQuitPacket.Create);
|
||||
end;
|
||||
|
||||
procedure TdmNetwork.CheckClose(ASender: TForm);
|
||||
begin
|
||||
if ((frmLogin = nil) or (ASender = frmLogin)) and
|
||||
((frmMain = nil) or (ASender = frmMain)) and
|
||||
((frmInitialize = nil) or (not frmInitialize.Visible)) then
|
||||
begin
|
||||
Application.Terminate;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UdmNetwork.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
5303
Client/UfrmMain.lfm
5303
Client/UfrmMain.lfm
File diff suppressed because it is too large
Load Diff
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 = <>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue