- Added hgeol
- Fixed repository side eol to be LF
This commit is contained in:
@@ -1,37 +1,37 @@
|
||||
object frmConfirmation: TfrmConfirmation
|
||||
Left = 290
|
||||
Height = 43
|
||||
Top = 171
|
||||
Width = 108
|
||||
BorderIcons = []
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Apply?'
|
||||
ClientHeight = 43
|
||||
ClientWidth = 108
|
||||
Font.Height = -11
|
||||
LCLVersion = '0.9.25'
|
||||
object btnYes: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Yes'
|
||||
Default = True
|
||||
ModalResult = 6
|
||||
ParentFont = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnNo: TButton
|
||||
Left = 56
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'No'
|
||||
ModalResult = 7
|
||||
ParentFont = True
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object frmConfirmation: TfrmConfirmation
|
||||
Left = 290
|
||||
Height = 43
|
||||
Top = 171
|
||||
Width = 108
|
||||
BorderIcons = []
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Apply?'
|
||||
ClientHeight = 43
|
||||
ClientWidth = 108
|
||||
Font.Height = -11
|
||||
LCLVersion = '0.9.25'
|
||||
object btnYes: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Yes'
|
||||
Default = True
|
||||
ModalResult = 6
|
||||
ParentFont = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnNo: TButton
|
||||
Left = 56
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'No'
|
||||
ModalResult = 7
|
||||
ParentFont = True
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
|
||||
@@ -1,57 +1,57 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UfrmConfirmation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmConfirmation }
|
||||
|
||||
TfrmConfirmation = class(TForm)
|
||||
btnYes: TButton;
|
||||
btnNo: TButton;
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmConfirmation: TfrmConfirmation;
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
{$I UfrmConfirmation.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 2007 Andreas Schneider
|
||||
*)
|
||||
unit UfrmConfirmation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmConfirmation }
|
||||
|
||||
TfrmConfirmation = class(TForm)
|
||||
btnYes: TButton;
|
||||
btnNo: TButton;
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmConfirmation: TfrmConfirmation;
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
{$I UfrmConfirmation.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+123
-123
@@ -1,123 +1,123 @@
|
||||
inherited frmDrawSettings: TfrmDrawSettings
|
||||
Left = 268
|
||||
Height = 180
|
||||
Top = 165
|
||||
Width = 242
|
||||
ActiveControl = rbTileList
|
||||
Caption = 'Draw settings'
|
||||
ClientHeight = 180
|
||||
ClientWidth = 242
|
||||
OnCreate = FormCreate
|
||||
object rbTileList: TRadioButton[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 8
|
||||
Width = 146
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Use tile from the list'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 0
|
||||
end
|
||||
object rbRandom: TRadioButton[1]
|
||||
AnchorSideLeft.Control = rbTileList
|
||||
AnchorSideTop.Control = rbTileList
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 34
|
||||
Width = 213
|
||||
BorderSpacing.Top = 4
|
||||
Caption = 'Use tiles from the random pool'
|
||||
TabOrder = 1
|
||||
TabStop = False
|
||||
end
|
||||
object gbHue: TGroupBox[2]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = seRandomHeight
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 49
|
||||
Top = 132
|
||||
Width = 226
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 8
|
||||
Caption = 'Hue (Statics only)'
|
||||
ClientHeight = 45
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object pbHue: TPaintBox
|
||||
Cursor = crHandPoint
|
||||
Left = 4
|
||||
Height = 41
|
||||
Top = 0
|
||||
Width = 214
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
OnClick = pbHueClick
|
||||
OnPaint = pbHuePaint
|
||||
end
|
||||
end
|
||||
object cbRandomHeight: TCheckBox[3]
|
||||
AnchorSideLeft.Control = cbForceAltitude
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 102
|
||||
Width = 149
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Add Random Altitude'
|
||||
TabOrder = 3
|
||||
end
|
||||
object seRandomHeight: TSpinEdit[4]
|
||||
AnchorSideTop.Control = cbRandomHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 21
|
||||
Top = 103
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
TabOrder = 4
|
||||
end
|
||||
object cbForceAltitude: TCheckBox[5]
|
||||
AnchorSideLeft.Control = rbRandom
|
||||
AnchorSideTop.Control = rbRandom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 68
|
||||
Width = 111
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Force altitude:'
|
||||
TabOrder = 5
|
||||
end
|
||||
object seForceAltitude: TSpinEdit[6]
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 21
|
||||
Top = 69
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
MaxValue = 127
|
||||
MinValue = -128
|
||||
TabOrder = 6
|
||||
end
|
||||
inherited tmClose: TTimer[7]
|
||||
end
|
||||
end
|
||||
inherited frmDrawSettings: TfrmDrawSettings
|
||||
Left = 268
|
||||
Height = 180
|
||||
Top = 165
|
||||
Width = 242
|
||||
ActiveControl = rbTileList
|
||||
Caption = 'Draw settings'
|
||||
ClientHeight = 180
|
||||
ClientWidth = 242
|
||||
OnCreate = FormCreate
|
||||
object rbTileList: TRadioButton[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 8
|
||||
Width = 146
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Use tile from the list'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 0
|
||||
end
|
||||
object rbRandom: TRadioButton[1]
|
||||
AnchorSideLeft.Control = rbTileList
|
||||
AnchorSideTop.Control = rbTileList
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 34
|
||||
Width = 213
|
||||
BorderSpacing.Top = 4
|
||||
Caption = 'Use tiles from the random pool'
|
||||
TabOrder = 1
|
||||
TabStop = False
|
||||
end
|
||||
object gbHue: TGroupBox[2]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = seRandomHeight
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 49
|
||||
Top = 132
|
||||
Width = 226
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 8
|
||||
Caption = 'Hue (Statics only)'
|
||||
ClientHeight = 45
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object pbHue: TPaintBox
|
||||
Cursor = crHandPoint
|
||||
Left = 4
|
||||
Height = 41
|
||||
Top = 0
|
||||
Width = 214
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
OnClick = pbHueClick
|
||||
OnPaint = pbHuePaint
|
||||
end
|
||||
end
|
||||
object cbRandomHeight: TCheckBox[3]
|
||||
AnchorSideLeft.Control = cbForceAltitude
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 102
|
||||
Width = 149
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Add Random Altitude'
|
||||
TabOrder = 3
|
||||
end
|
||||
object seRandomHeight: TSpinEdit[4]
|
||||
AnchorSideTop.Control = cbRandomHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 21
|
||||
Top = 103
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
TabOrder = 4
|
||||
end
|
||||
object cbForceAltitude: TCheckBox[5]
|
||||
AnchorSideLeft.Control = rbRandom
|
||||
AnchorSideTop.Control = rbRandom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 68
|
||||
Width = 111
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Force altitude:'
|
||||
TabOrder = 5
|
||||
end
|
||||
object seForceAltitude: TSpinEdit[6]
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 21
|
||||
Top = 69
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
MaxValue = 127
|
||||
MinValue = -128
|
||||
TabOrder = 6
|
||||
end
|
||||
inherited tmClose: TTimer[7]
|
||||
end
|
||||
end
|
||||
|
||||
+129
-129
@@ -1,129 +1,129 @@
|
||||
(*
|
||||
* 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 UfrmDrawSettings;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
Spin, ExtCtrls, LMessages, UfrmToolWindow;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
TfrmDrawSettings = class(TfrmToolWindow)
|
||||
cbForceAltitude: TCheckBox;
|
||||
cbRandomHeight: TCheckBox;
|
||||
gbHue: TGroupBox;
|
||||
pbHue: TPaintBox;
|
||||
rbRandom: TRadioButton;
|
||||
rbTileList: TRadioButton;
|
||||
seForceAltitude: TSpinEdit;
|
||||
seRandomHeight: TSpinEdit;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure pbHueClick(Sender: TObject);
|
||||
procedure pbHuePaint(Sender: TObject);
|
||||
procedure seForceAltitudeChange(Sender: TObject);
|
||||
procedure seRandomHeightChange(Sender: TObject);
|
||||
private
|
||||
FCanClose: Boolean;
|
||||
function CanClose: Boolean; override;
|
||||
procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
|
||||
end;
|
||||
|
||||
var
|
||||
frmDrawSettings: TfrmDrawSettings;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UGameResources, UHue, UfrmHueSettings;
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
|
||||
begin
|
||||
frmHueSettings.Left := Mouse.CursorPos.x - 8;
|
||||
frmHueSettings.Top := Mouse.CursorPos.y - 8;
|
||||
frmHueSettings.OnClose := @OnHueClose;
|
||||
frmHueSettings.Show;
|
||||
FCanClose := False;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FCanClose := True;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
|
||||
var
|
||||
hue: THue;
|
||||
begin
|
||||
if frmHueSettings <> nil then
|
||||
begin
|
||||
if frmHueSettings.lbHue.ItemIndex > 0 then
|
||||
hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
|
||||
else
|
||||
hue := nil;
|
||||
TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
|
||||
frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
|
||||
begin
|
||||
cbForceAltitude.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
|
||||
begin
|
||||
cbRandomHeight.Checked := True;
|
||||
end;
|
||||
|
||||
function TfrmDrawSettings.CanClose: Boolean;
|
||||
begin
|
||||
Result := FCanClose and inherited CanClose;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.OnHueClose(Sender: TObject;
|
||||
var ACloseAction: TCloseAction);
|
||||
var
|
||||
msg: TLMessage;
|
||||
begin
|
||||
FCanClose := True;
|
||||
frmHueSettings.OnClose := nil;
|
||||
pbHue.Repaint;
|
||||
MouseLeave(msg);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmDrawSettings.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 UfrmDrawSettings;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
Spin, ExtCtrls, LMessages, UfrmToolWindow;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
TfrmDrawSettings = class(TfrmToolWindow)
|
||||
cbForceAltitude: TCheckBox;
|
||||
cbRandomHeight: TCheckBox;
|
||||
gbHue: TGroupBox;
|
||||
pbHue: TPaintBox;
|
||||
rbRandom: TRadioButton;
|
||||
rbTileList: TRadioButton;
|
||||
seForceAltitude: TSpinEdit;
|
||||
seRandomHeight: TSpinEdit;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure pbHueClick(Sender: TObject);
|
||||
procedure pbHuePaint(Sender: TObject);
|
||||
procedure seForceAltitudeChange(Sender: TObject);
|
||||
procedure seRandomHeightChange(Sender: TObject);
|
||||
private
|
||||
FCanClose: Boolean;
|
||||
function CanClose: Boolean; override;
|
||||
procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
|
||||
end;
|
||||
|
||||
var
|
||||
frmDrawSettings: TfrmDrawSettings;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UGameResources, UHue, UfrmHueSettings;
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
|
||||
begin
|
||||
frmHueSettings.Left := Mouse.CursorPos.x - 8;
|
||||
frmHueSettings.Top := Mouse.CursorPos.y - 8;
|
||||
frmHueSettings.OnClose := @OnHueClose;
|
||||
frmHueSettings.Show;
|
||||
FCanClose := False;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FCanClose := True;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
|
||||
var
|
||||
hue: THue;
|
||||
begin
|
||||
if frmHueSettings <> nil then
|
||||
begin
|
||||
if frmHueSettings.lbHue.ItemIndex > 0 then
|
||||
hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
|
||||
else
|
||||
hue := nil;
|
||||
TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
|
||||
frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
|
||||
begin
|
||||
cbForceAltitude.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
|
||||
begin
|
||||
cbRandomHeight.Checked := True;
|
||||
end;
|
||||
|
||||
function TfrmDrawSettings.CanClose: Boolean;
|
||||
begin
|
||||
Result := FCanClose and inherited CanClose;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.OnHueClose(Sender: TObject;
|
||||
var ACloseAction: TCloseAction);
|
||||
var
|
||||
msg: TLMessage;
|
||||
begin
|
||||
FCanClose := True;
|
||||
frmHueSettings.OnClose := nil;
|
||||
pbHue.Repaint;
|
||||
MouseLeave(msg);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmDrawSettings.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+317
-317
@@ -1,317 +1,317 @@
|
||||
object frmFilter: TfrmFilter
|
||||
Left = 290
|
||||
Height = 492
|
||||
Top = 171
|
||||
Width = 232
|
||||
ActiveControl = rgFilterType.RadioButton0
|
||||
BorderIcons = [biSystemMenu, biMinimize]
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Filter'
|
||||
ClientHeight = 492
|
||||
ClientWidth = 232
|
||||
Font.Height = -11
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
LCLVersion = '0.9.29'
|
||||
object rgFilterType: TRadioGroup
|
||||
Left = 4
|
||||
Height = 40
|
||||
Top = 4
|
||||
Width = 224
|
||||
Align = alTop
|
||||
AutoFill = True
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Filter rule'
|
||||
ChildSizing.LeftRightSpacing = 6
|
||||
ChildSizing.TopBottomSpacing = 6
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 2
|
||||
ClientHeight = 26
|
||||
ClientWidth = 222
|
||||
Columns = 2
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Exclusive'
|
||||
'Inclusive'
|
||||
)
|
||||
OnClick = rgFilterTypeClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 4
|
||||
Height = 259
|
||||
Top = 48
|
||||
Width = 224
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Tile filter'
|
||||
ClientHeight = 245
|
||||
ClientWidth = 222
|
||||
TabOrder = 1
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideTop.Control = cbTileFilter
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 4
|
||||
Height = 30
|
||||
Top = 30
|
||||
Width = 214
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
|
||||
ParentColor = False
|
||||
WordWrap = True
|
||||
end
|
||||
object btnClear: TSpeedButton
|
||||
AnchorSideLeft.Control = btnDelete
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrCenter
|
||||
AnchorSideBottom.Control = btnDelete
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 30
|
||||
Height = 22
|
||||
Hint = 'Clear'
|
||||
Top = 219
|
||||
Width = 22
|
||||
Anchors = [akLeft, akBottom]
|
||||
Color = clBtnFace
|
||||
Glyph.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
20000000000000040000640000006400000000000000000000003ADCFE004800
|
||||
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
|
||||
9B000000000000000000000000000000000000000000000000000EECFF00B2FC
|
||||
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
|
||||
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
|
||||
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
|
||||
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
|
||||
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
|
||||
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
|
||||
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
|
||||
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
|
||||
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
|
||||
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
|
||||
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
|
||||
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
|
||||
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
|
||||
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
|
||||
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
|
||||
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
|
||||
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
|
||||
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
|
||||
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
|
||||
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
|
||||
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
|
||||
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
|
||||
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
|
||||
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
|
||||
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
|
||||
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
|
||||
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
|
||||
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
|
||||
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
|
||||
DF000000000000000000000000002070DF000000000000000000
|
||||
}
|
||||
NumGlyphs = 0
|
||||
OnClick = btnClearClick
|
||||
ShowHint = True
|
||||
ParentShowHint = False
|
||||
end
|
||||
object btnDelete: TSpeedButton
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideBottom.Control = GroupBox1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 4
|
||||
Height = 22
|
||||
Hint = 'Delete'
|
||||
Top = 219
|
||||
Width = 22
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Around = 4
|
||||
Color = clBtnFace
|
||||
Glyph.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
20000000000000040000640000006400000000000000000000004F91AB005588
|
||||
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
|
||||
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
|
||||
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
|
||||
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
|
||||
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
|
||||
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
|
||||
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
|
||||
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
|
||||
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
|
||||
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
|
||||
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
|
||||
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
|
||||
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
|
||||
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
|
||||
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
|
||||
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
|
||||
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
|
||||
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
|
||||
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
|
||||
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
|
||||
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
|
||||
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
|
||||
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
|
||||
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
|
||||
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
|
||||
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
|
||||
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
|
||||
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
|
||||
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
|
||||
0200F2000200080104000E040200F8040400F200040009010500
|
||||
}
|
||||
NumGlyphs = 0
|
||||
OnClick = btnDeleteClick
|
||||
ShowHint = True
|
||||
ParentShowHint = False
|
||||
end
|
||||
object vdtFilter: TVirtualDrawTree
|
||||
Tag = 1
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideTop.Control = Label1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = btnDelete
|
||||
Cursor = 63
|
||||
Left = 4
|
||||
Height = 151
|
||||
Top = 64
|
||||
Width = 214
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Around = 4
|
||||
DefaultNodeHeight = 44
|
||||
DragType = dtVCL
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.Columns = <
|
||||
item
|
||||
Position = 0
|
||||
Text = 'ID'
|
||||
end
|
||||
item
|
||||
Position = 1
|
||||
Text = 'Tile'
|
||||
Width = 44
|
||||
end
|
||||
item
|
||||
Position = 2
|
||||
Text = 'Name'
|
||||
Width = 100
|
||||
end>
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoColumnResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.Style = hsFlatButtons
|
||||
TabOrder = 0
|
||||
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
|
||||
OnDragOver = vdtFilterDragOver
|
||||
OnDragDrop = vdtFilterDragDrop
|
||||
OnDrawNode = vdtFilterDrawNode
|
||||
end
|
||||
object cbTileFilter: TCheckBox
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideTop.Control = GroupBox1
|
||||
Left = 4
|
||||
Height = 22
|
||||
Top = 4
|
||||
Width = 85
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Filter active'
|
||||
OnChange = cbTileFilterChange
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 4
|
||||
Height = 168
|
||||
Top = 320
|
||||
Width = 224
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Hue filter'
|
||||
ClientHeight = 154
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object cbHueFilter: TCheckBox
|
||||
Left = 4
|
||||
Height = 22
|
||||
Top = 4
|
||||
Width = 214
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Filter active'
|
||||
OnChange = cbHueFilterChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object vdtHues: TVirtualDrawTree
|
||||
Cursor = 63
|
||||
Left = 4
|
||||
Height = 120
|
||||
Top = 30
|
||||
Width = 214
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
Header.AutoSizeIndex = 2
|
||||
Header.Columns = <
|
||||
item
|
||||
Position = 0
|
||||
Width = 20
|
||||
end
|
||||
item
|
||||
Position = 1
|
||||
Text = 'Hue'
|
||||
Width = 38
|
||||
end
|
||||
item
|
||||
Position = 2
|
||||
Text = 'Name'
|
||||
Width = 154
|
||||
end>
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.Style = hsFlatButtons
|
||||
PopupMenu = pmHues
|
||||
TabOrder = 1
|
||||
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||
TreeOptions.SelectionOptions = [toFullRowSelect]
|
||||
OnChecked = vdtHuesChecked
|
||||
OnDrawNode = vdtHuesDrawNode
|
||||
end
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 311
|
||||
Width = 232
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
object pmHues: TPopupMenu
|
||||
left = 148
|
||||
top = 404
|
||||
object mnuCheckHues: TMenuItem
|
||||
Caption = 'Check all hues'
|
||||
OnClick = mnuCheckHuesClick
|
||||
end
|
||||
object mnuUncheckHues: TMenuItem
|
||||
Caption = 'Uncheck all hues'
|
||||
OnClick = mnuUncheckHuesClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object frmFilter: TfrmFilter
|
||||
Left = 290
|
||||
Height = 492
|
||||
Top = 171
|
||||
Width = 232
|
||||
ActiveControl = rgFilterType.RadioButton0
|
||||
BorderIcons = [biSystemMenu, biMinimize]
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Filter'
|
||||
ClientHeight = 492
|
||||
ClientWidth = 232
|
||||
Font.Height = -11
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
LCLVersion = '0.9.29'
|
||||
object rgFilterType: TRadioGroup
|
||||
Left = 4
|
||||
Height = 40
|
||||
Top = 4
|
||||
Width = 224
|
||||
Align = alTop
|
||||
AutoFill = True
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Filter rule'
|
||||
ChildSizing.LeftRightSpacing = 6
|
||||
ChildSizing.TopBottomSpacing = 6
|
||||
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
|
||||
ChildSizing.EnlargeVertical = crsHomogenousChildResize
|
||||
ChildSizing.ShrinkHorizontal = crsScaleChilds
|
||||
ChildSizing.ShrinkVertical = crsScaleChilds
|
||||
ChildSizing.Layout = cclLeftToRightThenTopToBottom
|
||||
ChildSizing.ControlsPerLine = 2
|
||||
ClientHeight = 26
|
||||
ClientWidth = 222
|
||||
Columns = 2
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'Exclusive'
|
||||
'Inclusive'
|
||||
)
|
||||
OnClick = rgFilterTypeClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 4
|
||||
Height = 259
|
||||
Top = 48
|
||||
Width = 224
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Tile filter'
|
||||
ClientHeight = 245
|
||||
ClientWidth = 222
|
||||
TabOrder = 1
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideTop.Control = cbTileFilter
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 4
|
||||
Height = 30
|
||||
Top = 30
|
||||
Width = 214
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
|
||||
ParentColor = False
|
||||
WordWrap = True
|
||||
end
|
||||
object btnClear: TSpeedButton
|
||||
AnchorSideLeft.Control = btnDelete
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrCenter
|
||||
AnchorSideBottom.Control = btnDelete
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 30
|
||||
Height = 22
|
||||
Hint = 'Clear'
|
||||
Top = 219
|
||||
Width = 22
|
||||
Anchors = [akLeft, akBottom]
|
||||
Color = clBtnFace
|
||||
Glyph.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
20000000000000040000640000006400000000000000000000003ADCFE004800
|
||||
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
|
||||
9B000000000000000000000000000000000000000000000000000EECFF00B2FC
|
||||
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
|
||||
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
|
||||
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
|
||||
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
|
||||
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
|
||||
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
|
||||
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
|
||||
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
|
||||
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
|
||||
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
|
||||
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
|
||||
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
|
||||
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
|
||||
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
|
||||
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
|
||||
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
|
||||
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
|
||||
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
|
||||
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
|
||||
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
|
||||
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
|
||||
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
|
||||
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
|
||||
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
|
||||
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
|
||||
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
|
||||
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
|
||||
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
|
||||
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
|
||||
DF000000000000000000000000002070DF000000000000000000
|
||||
}
|
||||
NumGlyphs = 0
|
||||
OnClick = btnClearClick
|
||||
ShowHint = True
|
||||
ParentShowHint = False
|
||||
end
|
||||
object btnDelete: TSpeedButton
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideBottom.Control = GroupBox1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 4
|
||||
Height = 22
|
||||
Hint = 'Delete'
|
||||
Top = 219
|
||||
Width = 22
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Around = 4
|
||||
Color = clBtnFace
|
||||
Glyph.Data = {
|
||||
36040000424D3604000000000000360000002800000010000000100000000100
|
||||
20000000000000040000640000006400000000000000000000004F91AB005588
|
||||
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
|
||||
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
|
||||
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
|
||||
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
|
||||
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
|
||||
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
|
||||
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
|
||||
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
|
||||
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
|
||||
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
|
||||
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
|
||||
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
|
||||
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
|
||||
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
|
||||
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
|
||||
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
|
||||
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
|
||||
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
|
||||
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
|
||||
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
|
||||
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
|
||||
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
|
||||
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
|
||||
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
|
||||
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
|
||||
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
|
||||
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
|
||||
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
|
||||
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
|
||||
0200F2000200080104000E040200F8040400F200040009010500
|
||||
}
|
||||
NumGlyphs = 0
|
||||
OnClick = btnDeleteClick
|
||||
ShowHint = True
|
||||
ParentShowHint = False
|
||||
end
|
||||
object vdtFilter: TVirtualDrawTree
|
||||
Tag = 1
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideTop.Control = Label1
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = btnDelete
|
||||
Cursor = 63
|
||||
Left = 4
|
||||
Height = 151
|
||||
Top = 64
|
||||
Width = 214
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Around = 4
|
||||
DefaultNodeHeight = 44
|
||||
DragType = dtVCL
|
||||
Header.AutoSizeIndex = 0
|
||||
Header.Columns = <
|
||||
item
|
||||
Position = 0
|
||||
Text = 'ID'
|
||||
end
|
||||
item
|
||||
Position = 1
|
||||
Text = 'Tile'
|
||||
Width = 44
|
||||
end
|
||||
item
|
||||
Position = 2
|
||||
Text = 'Name'
|
||||
Width = 100
|
||||
end>
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoColumnResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.Style = hsFlatButtons
|
||||
TabOrder = 0
|
||||
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
|
||||
OnDragOver = vdtFilterDragOver
|
||||
OnDragDrop = vdtFilterDragDrop
|
||||
OnDrawNode = vdtFilterDrawNode
|
||||
end
|
||||
object cbTileFilter: TCheckBox
|
||||
AnchorSideLeft.Control = GroupBox1
|
||||
AnchorSideTop.Control = GroupBox1
|
||||
Left = 4
|
||||
Height = 22
|
||||
Top = 4
|
||||
Width = 85
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Filter active'
|
||||
OnChange = cbTileFilterChange
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 4
|
||||
Height = 168
|
||||
Top = 320
|
||||
Width = 224
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Hue filter'
|
||||
ClientHeight = 154
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object cbHueFilter: TCheckBox
|
||||
Left = 4
|
||||
Height = 22
|
||||
Top = 4
|
||||
Width = 214
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Filter active'
|
||||
OnChange = cbHueFilterChange
|
||||
TabOrder = 0
|
||||
end
|
||||
object vdtHues: TVirtualDrawTree
|
||||
Cursor = 63
|
||||
Left = 4
|
||||
Height = 120
|
||||
Top = 30
|
||||
Width = 214
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
Header.AutoSizeIndex = 2
|
||||
Header.Columns = <
|
||||
item
|
||||
Position = 0
|
||||
Width = 20
|
||||
end
|
||||
item
|
||||
Position = 1
|
||||
Text = 'Hue'
|
||||
Width = 38
|
||||
end
|
||||
item
|
||||
Position = 2
|
||||
Text = 'Name'
|
||||
Width = 154
|
||||
end>
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.Style = hsFlatButtons
|
||||
PopupMenu = pmHues
|
||||
TabOrder = 1
|
||||
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||
TreeOptions.SelectionOptions = [toFullRowSelect]
|
||||
OnChecked = vdtHuesChecked
|
||||
OnDrawNode = vdtHuesDrawNode
|
||||
end
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Cursor = crVSplit
|
||||
Left = 0
|
||||
Height = 5
|
||||
Top = 311
|
||||
Width = 232
|
||||
Align = alBottom
|
||||
ResizeAnchor = akBottom
|
||||
end
|
||||
object pmHues: TPopupMenu
|
||||
left = 148
|
||||
top = 404
|
||||
object mnuCheckHues: TMenuItem
|
||||
Caption = 'Check all hues'
|
||||
OnClick = mnuCheckHuesClick
|
||||
end
|
||||
object mnuUncheckHues: TMenuItem
|
||||
Caption = 'Uncheck all hues'
|
||||
OnClick = mnuUncheckHuesClick
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@@ -1,22 +1,22 @@
|
||||
inherited frmLightlevel: TfrmLightlevel
|
||||
Height = 171
|
||||
Width = 40
|
||||
ActiveControl = tbLightlevel
|
||||
Caption = 'Lightlevel'
|
||||
ClientHeight = 171
|
||||
ClientWidth = 40
|
||||
object tbLightlevel: TTrackBar[0]
|
||||
Left = 0
|
||||
Height = 171
|
||||
Top = 0
|
||||
Width = 40
|
||||
Max = 32
|
||||
OnChange = tbLightlevelChange
|
||||
Orientation = trVertical
|
||||
Position = 0
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
end
|
||||
inherited tmClose: TTimer[1]
|
||||
end
|
||||
end
|
||||
inherited frmLightlevel: TfrmLightlevel
|
||||
Height = 171
|
||||
Width = 40
|
||||
ActiveControl = tbLightlevel
|
||||
Caption = 'Lightlevel'
|
||||
ClientHeight = 171
|
||||
ClientWidth = 40
|
||||
object tbLightlevel: TTrackBar[0]
|
||||
Left = 0
|
||||
Height = 171
|
||||
Top = 0
|
||||
Width = 40
|
||||
Max = 32
|
||||
OnChange = tbLightlevelChange
|
||||
Orientation = trVertical
|
||||
Position = 0
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
end
|
||||
inherited tmClose: TTimer[1]
|
||||
end
|
||||
end
|
||||
|
||||
+104
-104
@@ -1,104 +1,104 @@
|
||||
(*
|
||||
* 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 UfrmToolWindow;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
LCLIntf, LMessages, ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmToolWindow }
|
||||
|
||||
TfrmToolWindow = class(TForm)
|
||||
tmClose: TTimer;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormDeactivate(Sender: TObject); virtual;
|
||||
procedure FormShow(Sender: TObject); virtual;
|
||||
procedure tmCloseTimer(Sender: TObject);
|
||||
protected
|
||||
function CanClose: Boolean; virtual;
|
||||
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmToolWindow: TfrmToolWindow;
|
||||
|
||||
implementation
|
||||
|
||||
{ TfrmToolWindow }
|
||||
|
||||
procedure TfrmToolWindow.FormDeactivate(Sender: TObject);
|
||||
begin
|
||||
if CanClose then
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caHide;
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.FormShow(Sender: TObject);
|
||||
begin
|
||||
Top := Mouse.CursorPos.y - 8;
|
||||
Left := Mouse.CursorPos.x - 8;
|
||||
|
||||
OnDeactivate := nil;
|
||||
tmClose.Enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.tmCloseTimer(Sender: TObject);
|
||||
begin
|
||||
tmClose.Enabled := False;
|
||||
OnDeactivate := @FormDeactivate;
|
||||
if CanClose then
|
||||
Close;
|
||||
end;
|
||||
|
||||
function TfrmToolWindow.CanClose: Boolean;
|
||||
begin
|
||||
Result := not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos));
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.MouseLeave(var msg: TLMessage);
|
||||
begin
|
||||
if CanClose then
|
||||
Close;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmToolWindow.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 UfrmToolWindow;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
LCLIntf, LMessages, ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmToolWindow }
|
||||
|
||||
TfrmToolWindow = class(TForm)
|
||||
tmClose: TTimer;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormDeactivate(Sender: TObject); virtual;
|
||||
procedure FormShow(Sender: TObject); virtual;
|
||||
procedure tmCloseTimer(Sender: TObject);
|
||||
protected
|
||||
function CanClose: Boolean; virtual;
|
||||
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmToolWindow: TfrmToolWindow;
|
||||
|
||||
implementation
|
||||
|
||||
{ TfrmToolWindow }
|
||||
|
||||
procedure TfrmToolWindow.FormDeactivate(Sender: TObject);
|
||||
begin
|
||||
if CanClose then
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caHide;
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.FormShow(Sender: TObject);
|
||||
begin
|
||||
Top := Mouse.CursorPos.y - 8;
|
||||
Left := Mouse.CursorPos.x - 8;
|
||||
|
||||
OnDeactivate := nil;
|
||||
tmClose.Enabled := True;
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.tmCloseTimer(Sender: TObject);
|
||||
begin
|
||||
tmClose.Enabled := False;
|
||||
OnDeactivate := @FormDeactivate;
|
||||
if CanClose then
|
||||
Close;
|
||||
end;
|
||||
|
||||
function TfrmToolWindow.CanClose: Boolean;
|
||||
begin
|
||||
Result := not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos));
|
||||
end;
|
||||
|
||||
procedure TfrmToolWindow.MouseLeave(var msg: TLMessage);
|
||||
begin
|
||||
if CanClose then
|
||||
Close;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmToolWindow.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+125
-125
@@ -1,125 +1,125 @@
|
||||
(*
|
||||
* 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 UGameResources;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider,
|
||||
ULandscape, UHueProvider, UAnimDataProvider, ULightProvider;
|
||||
|
||||
type
|
||||
|
||||
{ TGameResourceManager }
|
||||
|
||||
TGameResourceManager = class
|
||||
constructor Create(ADataDir: String);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
{ Members }
|
||||
FDataDir: String;
|
||||
FArtProvider: TArtProvider;
|
||||
FTiledataProvider: TTiledataProvider;
|
||||
FAnimdataProvider: TAnimdataProvider;
|
||||
FTexmapProvider: TTexmapProvider;
|
||||
FHueProvider: THueProvider;
|
||||
FLightProvider: TLightProvider;
|
||||
FLandscape: TLandscape;
|
||||
public
|
||||
{ Fields }
|
||||
property Art: TArtProvider read FArtProvider;
|
||||
property Hue: THueProvider read FHueProvider;
|
||||
property Landscape: TLandscape read FLandscape;
|
||||
property Tiledata: TTiledataProvider read FTiledataProvider;
|
||||
property Animdata: TAnimDataProvider read FAnimdataProvider;
|
||||
property Texmaps: TTexmapProvider read FTexmapProvider;
|
||||
property Lights: TLightProvider read FLightProvider;
|
||||
|
||||
{ Methods }
|
||||
function GetFile(AFileName: String): String;
|
||||
procedure InitLandscape(AWidth, AHeight: Word);
|
||||
end;
|
||||
|
||||
var
|
||||
GameResourceManager: TGameResourceManager;
|
||||
ResMan: TGameResourceManager absolute GameResourceManager;
|
||||
|
||||
procedure InitGameResourceManager(ADataDir: String);
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitGameResourceManager(ADataDir: String);
|
||||
begin
|
||||
FreeAndNil(GameResourceManager);
|
||||
GameResourceManager := TGameResourceManager.Create(ADataDir);
|
||||
end;
|
||||
|
||||
{ TGameResourceManager }
|
||||
|
||||
constructor TGameResourceManager.Create(ADataDir: String);
|
||||
begin
|
||||
inherited Create;
|
||||
FDataDir := IncludeTrailingPathDelimiter(ADataDir);
|
||||
|
||||
FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True);
|
||||
FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True);
|
||||
FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True);
|
||||
FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'),
|
||||
GetFile('texidx.mul'), True);
|
||||
FHueProvider := THueProvider.Create(GetFile('hues.mul'), True);
|
||||
FLightProvider := TLightProvider.Create(GetFile('light.mul'),
|
||||
GetFile('lightidx.mul'), True);
|
||||
end;
|
||||
|
||||
destructor TGameResourceManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FArtProvider);
|
||||
FreeAndNil(FTiledataProvider);
|
||||
FreeAndNil(FAnimdataProvider);
|
||||
FreeAndNil(FTexmapProvider);
|
||||
FreeAndNil(FHueProvider);
|
||||
FreeAndNil(FLightProvider);
|
||||
FreeAndNil(FLandscape);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TGameResourceManager.GetFile(AFileName: String): String;
|
||||
begin
|
||||
Result := FDataDir + AFileName;
|
||||
end;
|
||||
|
||||
procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word);
|
||||
begin
|
||||
FreeAndNil(FLandscape);
|
||||
FLandscape := TLandscape.Create(AWidth, AHeight);
|
||||
end;
|
||||
|
||||
finalization
|
||||
FreeAndNil(GameResourceManager);
|
||||
|
||||
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 UGameResources;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider,
|
||||
ULandscape, UHueProvider, UAnimDataProvider, ULightProvider;
|
||||
|
||||
type
|
||||
|
||||
{ TGameResourceManager }
|
||||
|
||||
TGameResourceManager = class
|
||||
constructor Create(ADataDir: String);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
{ Members }
|
||||
FDataDir: String;
|
||||
FArtProvider: TArtProvider;
|
||||
FTiledataProvider: TTiledataProvider;
|
||||
FAnimdataProvider: TAnimdataProvider;
|
||||
FTexmapProvider: TTexmapProvider;
|
||||
FHueProvider: THueProvider;
|
||||
FLightProvider: TLightProvider;
|
||||
FLandscape: TLandscape;
|
||||
public
|
||||
{ Fields }
|
||||
property Art: TArtProvider read FArtProvider;
|
||||
property Hue: THueProvider read FHueProvider;
|
||||
property Landscape: TLandscape read FLandscape;
|
||||
property Tiledata: TTiledataProvider read FTiledataProvider;
|
||||
property Animdata: TAnimDataProvider read FAnimdataProvider;
|
||||
property Texmaps: TTexmapProvider read FTexmapProvider;
|
||||
property Lights: TLightProvider read FLightProvider;
|
||||
|
||||
{ Methods }
|
||||
function GetFile(AFileName: String): String;
|
||||
procedure InitLandscape(AWidth, AHeight: Word);
|
||||
end;
|
||||
|
||||
var
|
||||
GameResourceManager: TGameResourceManager;
|
||||
ResMan: TGameResourceManager absolute GameResourceManager;
|
||||
|
||||
procedure InitGameResourceManager(ADataDir: String);
|
||||
|
||||
implementation
|
||||
|
||||
procedure InitGameResourceManager(ADataDir: String);
|
||||
begin
|
||||
FreeAndNil(GameResourceManager);
|
||||
GameResourceManager := TGameResourceManager.Create(ADataDir);
|
||||
end;
|
||||
|
||||
{ TGameResourceManager }
|
||||
|
||||
constructor TGameResourceManager.Create(ADataDir: String);
|
||||
begin
|
||||
inherited Create;
|
||||
FDataDir := IncludeTrailingPathDelimiter(ADataDir);
|
||||
|
||||
FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True);
|
||||
FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True);
|
||||
FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True);
|
||||
FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'),
|
||||
GetFile('texidx.mul'), True);
|
||||
FHueProvider := THueProvider.Create(GetFile('hues.mul'), True);
|
||||
FLightProvider := TLightProvider.Create(GetFile('light.mul'),
|
||||
GetFile('lightidx.mul'), True);
|
||||
end;
|
||||
|
||||
destructor TGameResourceManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FArtProvider);
|
||||
FreeAndNil(FTiledataProvider);
|
||||
FreeAndNil(FAnimdataProvider);
|
||||
FreeAndNil(FTexmapProvider);
|
||||
FreeAndNil(FHueProvider);
|
||||
FreeAndNil(FLightProvider);
|
||||
FreeAndNil(FLandscape);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TGameResourceManager.GetFile(AFileName: String): String;
|
||||
begin
|
||||
Result := FDataDir + AFileName;
|
||||
end;
|
||||
|
||||
procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word);
|
||||
begin
|
||||
FreeAndNil(FLandscape);
|
||||
FLandscape := TLandscape.Create(AWidth, AHeight);
|
||||
end;
|
||||
|
||||
finalization
|
||||
FreeAndNil(GameResourceManager);
|
||||
|
||||
end.
|
||||
|
||||
+255
-255
@@ -1,255 +1,255 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UOverlayUI;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Gl, GLU, Imaging, ImagingTypes, ImagingClasses,
|
||||
ImagingOpenGL, OpenGLContext, ImagingUtility;
|
||||
|
||||
type
|
||||
|
||||
{ TGLArrow }
|
||||
|
||||
TGLArrow = class(TObject)
|
||||
constructor Create(AGraphic: TSingleImage);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FGraphic: TSingleImage;
|
||||
FTexture: GLuint;
|
||||
FRealWidth: Integer;
|
||||
FRealHeight: Integer;
|
||||
FWidth: Integer;
|
||||
FHeight: Integer;
|
||||
FCurrentX: Integer;
|
||||
FCurrentY: Integer;
|
||||
procedure UpdateTexture;
|
||||
public
|
||||
property Width: Integer read FWidth;
|
||||
property Height: Integer read FHeight;
|
||||
property CurrentX: Integer read FCurrentX;
|
||||
property CurrentY: Integer read FCurrentY;
|
||||
|
||||
function HitTest(AX, AY: Integer): Boolean;
|
||||
procedure DrawGL(AX, AY: Integer; AActive: Boolean = False);
|
||||
end;
|
||||
|
||||
{ TOverlayUI }
|
||||
|
||||
TOverlayUI = class(TObject)
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FArrows: array[0..7] of TGLArrow;
|
||||
FActiveArrow: Integer;
|
||||
FVisible: Boolean;
|
||||
public
|
||||
property ActiveArrow: Integer read FActiveArrow write FActiveArrow;
|
||||
property Visible: Boolean read FVisible write FVisible;
|
||||
function HitTest(AX, AY: Integer): Integer;
|
||||
procedure Draw(AContext: TOpenGLControl);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UResourceManager;
|
||||
|
||||
{ TGLArrow }
|
||||
|
||||
constructor TGLArrow.Create(AGraphic: TSingleImage);
|
||||
var
|
||||
caps: TGLTextureCaps;
|
||||
begin
|
||||
inherited Create;
|
||||
FRealWidth := AGraphic.Width;
|
||||
FRealHeight := AGraphic.Height;
|
||||
GetGLTextureCaps(caps);
|
||||
if caps.NonPowerOfTwo then
|
||||
begin
|
||||
FWidth := FRealWidth;
|
||||
FHeight := FRealHeight;
|
||||
end else
|
||||
begin
|
||||
if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth);
|
||||
if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight);
|
||||
end;
|
||||
FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8);
|
||||
AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0);
|
||||
FTexture := 0;
|
||||
end;
|
||||
|
||||
destructor TGLArrow.Destroy;
|
||||
begin
|
||||
if FGraphic <> nil then FreeAndNil(FGraphic);
|
||||
if FTexture <> 0 then glDeleteTextures(1, @FTexture);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGLArrow.UpdateTexture;
|
||||
begin
|
||||
if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then
|
||||
begin
|
||||
FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False);
|
||||
|
||||
glBindTexture(GL_TEXTURE_2D, FTexture);
|
||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
|
||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
|
||||
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
|
||||
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGLArrow.HitTest(AX, AY: Integer): Boolean;
|
||||
var
|
||||
pixel: TColor32Rec;
|
||||
begin
|
||||
if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then
|
||||
begin
|
||||
pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY);
|
||||
Result := pixel.A > 0;
|
||||
end else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False);
|
||||
begin
|
||||
FCurrentX := AX;
|
||||
FCurrentY := AY;
|
||||
|
||||
if FTexture = 0 then UpdateTexture;
|
||||
|
||||
if FTexture <> 0 then
|
||||
begin
|
||||
if AActive then
|
||||
begin
|
||||
glEnable(GL_COLOR_LOGIC_OP);
|
||||
glLogicOp(GL_COPY_INVERTED);
|
||||
end;
|
||||
|
||||
glBindTexture(GL_TEXTURE_2D, FTexture);
|
||||
glBegin(GL_QUADS);
|
||||
glTexCoord2f(0, 0); glVertex2d(AX, AY);
|
||||
glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY);
|
||||
glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight);
|
||||
glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight);
|
||||
glEnd;
|
||||
|
||||
if AActive then
|
||||
glDisable(GL_COLOR_LOGIC_OP);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TOverlayUI }
|
||||
|
||||
constructor TOverlayUI.Create;
|
||||
var
|
||||
i: Integer;
|
||||
arrow: TSingleImage;
|
||||
begin
|
||||
inherited Create;
|
||||
FActiveArrow := -1;
|
||||
FVisible := False;
|
||||
|
||||
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0));
|
||||
for i := 0 to 3 do
|
||||
begin
|
||||
FArrows[2*i] := TGLArrow.Create(arrow);
|
||||
if i < 3 then
|
||||
arrow.Rotate(-90);
|
||||
end;
|
||||
arrow.Free;
|
||||
|
||||
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1));
|
||||
for i := 0 to 3 do
|
||||
begin
|
||||
FArrows[2*i+1] := TGLArrow.Create(arrow);
|
||||
if i < 3 then
|
||||
arrow.Rotate(-90);
|
||||
end;
|
||||
arrow.Free;
|
||||
end;
|
||||
|
||||
destructor TOverlayUI.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to 7 do
|
||||
if FArrows[i] <> nil then FreeAndNil(FArrows[i]);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TOverlayUI.HitTest(AX, AY: Integer): Integer;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
i := 0;
|
||||
while (i <= 7) and (Result = -1) do
|
||||
begin
|
||||
if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then
|
||||
Result := i;
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOverlayUI.Draw(AContext: TOpenGLControl);
|
||||
begin
|
||||
if FVisible then
|
||||
begin
|
||||
glColor4f(1.0, 1.0, 1.0, 1.0);
|
||||
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
|
||||
|
||||
FArrows[0].DrawGL(10, 10, FActiveArrow = 0);
|
||||
FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10,
|
||||
FActiveArrow = 1);
|
||||
FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10,
|
||||
FActiveArrow = 2);
|
||||
|
||||
FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width,
|
||||
AContext.Height div 2 - FArrows[3].Height div 2,
|
||||
FActiveArrow = 3);
|
||||
|
||||
FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width,
|
||||
AContext.Height - 10 - FArrows[4].Height,
|
||||
FActiveArrow = 4);
|
||||
FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2,
|
||||
AContext.Height - 10 - FArrows[5].Height,
|
||||
FActiveArrow = 5);
|
||||
FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height,
|
||||
FActiveArrow = 6);
|
||||
|
||||
FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2,
|
||||
FActiveArrow = 7);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UOverlayUI;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Gl, GLU, Imaging, ImagingTypes, ImagingClasses,
|
||||
ImagingOpenGL, OpenGLContext, ImagingUtility;
|
||||
|
||||
type
|
||||
|
||||
{ TGLArrow }
|
||||
|
||||
TGLArrow = class(TObject)
|
||||
constructor Create(AGraphic: TSingleImage);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FGraphic: TSingleImage;
|
||||
FTexture: GLuint;
|
||||
FRealWidth: Integer;
|
||||
FRealHeight: Integer;
|
||||
FWidth: Integer;
|
||||
FHeight: Integer;
|
||||
FCurrentX: Integer;
|
||||
FCurrentY: Integer;
|
||||
procedure UpdateTexture;
|
||||
public
|
||||
property Width: Integer read FWidth;
|
||||
property Height: Integer read FHeight;
|
||||
property CurrentX: Integer read FCurrentX;
|
||||
property CurrentY: Integer read FCurrentY;
|
||||
|
||||
function HitTest(AX, AY: Integer): Boolean;
|
||||
procedure DrawGL(AX, AY: Integer; AActive: Boolean = False);
|
||||
end;
|
||||
|
||||
{ TOverlayUI }
|
||||
|
||||
TOverlayUI = class(TObject)
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FArrows: array[0..7] of TGLArrow;
|
||||
FActiveArrow: Integer;
|
||||
FVisible: Boolean;
|
||||
public
|
||||
property ActiveArrow: Integer read FActiveArrow write FActiveArrow;
|
||||
property Visible: Boolean read FVisible write FVisible;
|
||||
function HitTest(AX, AY: Integer): Integer;
|
||||
procedure Draw(AContext: TOpenGLControl);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UResourceManager;
|
||||
|
||||
{ TGLArrow }
|
||||
|
||||
constructor TGLArrow.Create(AGraphic: TSingleImage);
|
||||
var
|
||||
caps: TGLTextureCaps;
|
||||
begin
|
||||
inherited Create;
|
||||
FRealWidth := AGraphic.Width;
|
||||
FRealHeight := AGraphic.Height;
|
||||
GetGLTextureCaps(caps);
|
||||
if caps.NonPowerOfTwo then
|
||||
begin
|
||||
FWidth := FRealWidth;
|
||||
FHeight := FRealHeight;
|
||||
end else
|
||||
begin
|
||||
if IsPow2(FRealWidth) then FWidth := FRealWidth else FWidth := NextPow2(FRealWidth);
|
||||
if IsPow2(FRealHeight) then FHeight := FRealHeight else FHeight := NextPow2(FRealHeight);
|
||||
end;
|
||||
FGraphic := TSingleImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8);
|
||||
AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0);
|
||||
FTexture := 0;
|
||||
end;
|
||||
|
||||
destructor TGLArrow.Destroy;
|
||||
begin
|
||||
if FGraphic <> nil then FreeAndNil(FGraphic);
|
||||
if FTexture <> 0 then glDeleteTextures(1, @FTexture);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TGLArrow.UpdateTexture;
|
||||
begin
|
||||
if (FGraphic <> nil) and (FRealWidth > 0) and (FRealWidth > 0) then
|
||||
begin
|
||||
FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False);
|
||||
|
||||
glBindTexture(GL_TEXTURE_2D, FTexture);
|
||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
|
||||
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
|
||||
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
|
||||
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGLArrow.HitTest(AX, AY: Integer): Boolean;
|
||||
var
|
||||
pixel: TColor32Rec;
|
||||
begin
|
||||
if (AX > -1) and (AX < FRealWidth) and (AY > -1) and (AY < FRealHeight) then
|
||||
begin
|
||||
pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY);
|
||||
Result := pixel.A > 0;
|
||||
end else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TGLArrow.DrawGL(AX, AY: Integer; AActive: Boolean = False);
|
||||
begin
|
||||
FCurrentX := AX;
|
||||
FCurrentY := AY;
|
||||
|
||||
if FTexture = 0 then UpdateTexture;
|
||||
|
||||
if FTexture <> 0 then
|
||||
begin
|
||||
if AActive then
|
||||
begin
|
||||
glEnable(GL_COLOR_LOGIC_OP);
|
||||
glLogicOp(GL_COPY_INVERTED);
|
||||
end;
|
||||
|
||||
glBindTexture(GL_TEXTURE_2D, FTexture);
|
||||
glBegin(GL_QUADS);
|
||||
glTexCoord2f(0, 0); glVertex2d(AX, AY);
|
||||
glTexCoord2f(1, 0); glVertex2d(AX + FWidth, AY);
|
||||
glTexCoord2f(1, 1); glVertex2d(AX + FWidth, AY + FHeight);
|
||||
glTexCoord2f(0, 1); glVertex2d(AX, AY + FHeight);
|
||||
glEnd;
|
||||
|
||||
if AActive then
|
||||
glDisable(GL_COLOR_LOGIC_OP);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TOverlayUI }
|
||||
|
||||
constructor TOverlayUI.Create;
|
||||
var
|
||||
i: Integer;
|
||||
arrow: TSingleImage;
|
||||
begin
|
||||
inherited Create;
|
||||
FActiveArrow := -1;
|
||||
FVisible := False;
|
||||
|
||||
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0));
|
||||
for i := 0 to 3 do
|
||||
begin
|
||||
FArrows[2*i] := TGLArrow.Create(arrow);
|
||||
if i < 3 then
|
||||
arrow.Rotate(-90);
|
||||
end;
|
||||
arrow.Free;
|
||||
|
||||
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1));
|
||||
for i := 0 to 3 do
|
||||
begin
|
||||
FArrows[2*i+1] := TGLArrow.Create(arrow);
|
||||
if i < 3 then
|
||||
arrow.Rotate(-90);
|
||||
end;
|
||||
arrow.Free;
|
||||
end;
|
||||
|
||||
destructor TOverlayUI.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to 7 do
|
||||
if FArrows[i] <> nil then FreeAndNil(FArrows[i]);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TOverlayUI.HitTest(AX, AY: Integer): Integer;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
i := 0;
|
||||
while (i <= 7) and (Result = -1) do
|
||||
begin
|
||||
if FArrows[i].HitTest(AX - FArrows[i].CurrentX, AY - FArrows[i].CurrentY) then
|
||||
Result := i;
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOverlayUI.Draw(AContext: TOpenGLControl);
|
||||
begin
|
||||
if FVisible then
|
||||
begin
|
||||
glColor4f(1.0, 1.0, 1.0, 1.0);
|
||||
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
|
||||
|
||||
FArrows[0].DrawGL(10, 10, FActiveArrow = 0);
|
||||
FArrows[1].DrawGL(AContext.Width div 2 - FArrows[1].Width div 2, 10,
|
||||
FActiveArrow = 1);
|
||||
FArrows[2].DrawGL(AContext.Width - 10 - FArrows[2].Width, 10,
|
||||
FActiveArrow = 2);
|
||||
|
||||
FArrows[3].DrawGL(AContext.Width - 10 - FArrows[3].Width,
|
||||
AContext.Height div 2 - FArrows[3].Height div 2,
|
||||
FActiveArrow = 3);
|
||||
|
||||
FArrows[4].DrawGL(AContext.Width - 10 - FArrows[4].Width,
|
||||
AContext.Height - 10 - FArrows[4].Height,
|
||||
FActiveArrow = 4);
|
||||
FArrows[5].DrawGL(AContext.Width div 2 - FArrows[5].Width div 2,
|
||||
AContext.Height - 10 - FArrows[5].Height,
|
||||
FActiveArrow = 5);
|
||||
FArrows[6].DrawGL(10, AContext.Height - 10 - FArrows[6].Height,
|
||||
FActiveArrow = 6);
|
||||
|
||||
FArrows[7].DrawGL(10, AContext.Height div 2 - FArrows[7].Height div 2,
|
||||
FActiveArrow = 7);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+150
-150
@@ -1,150 +1,150 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UPacketHandlers;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, dzlib, UEnhancedMemoryStream;
|
||||
|
||||
type
|
||||
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream);
|
||||
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object;
|
||||
|
||||
{ TPacketHandler }
|
||||
|
||||
TPacketHandler = class(TObject)
|
||||
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
|
||||
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
|
||||
procedure Process(ABuffer: TEnhancedMemoryStream);
|
||||
protected
|
||||
FLength: Cardinal;
|
||||
FPacketProcessor: TPacketProcessor;
|
||||
FPacketProcessorMethod: TPacketProcessorMethod;
|
||||
published
|
||||
property PacketLength: Cardinal read FLength;
|
||||
end;
|
||||
|
||||
var
|
||||
PacketHandlers: array[0..$FF] of TPacketHandler;
|
||||
|
||||
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UAdminHandling;
|
||||
|
||||
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
|
||||
begin
|
||||
FreeAndNil(PacketHandlers[AID]);
|
||||
PacketHandlers[AID] := APacketHandler;
|
||||
end;
|
||||
|
||||
{ TPacketHandler }
|
||||
|
||||
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
|
||||
begin
|
||||
inherited Create;
|
||||
FLength := ALength;
|
||||
FPacketProcessor := APacketProcessor;
|
||||
FPacketProcessorMethod := nil;
|
||||
end;
|
||||
|
||||
constructor TPacketHandler.Create(ALength: Cardinal;
|
||||
APacketProcessorMethod: TPacketProcessorMethod);
|
||||
begin
|
||||
inherited Create;
|
||||
FLength := ALength;
|
||||
FPacketProcessor := nil;
|
||||
FPacketProcessorMethod := APacketProcessorMethod;
|
||||
end;
|
||||
|
||||
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream);
|
||||
begin
|
||||
if Assigned(FPacketProcessor) then
|
||||
FPacketProcessor(ABuffer)
|
||||
else if Assigned(FPacketProcessorMethod) then
|
||||
FPacketProcessorMethod(ABuffer);
|
||||
end;
|
||||
|
||||
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
uncompStream: TEnhancedMemoryStream;
|
||||
uncompBuffer: TDecompressionStream;
|
||||
targetSize: Cardinal;
|
||||
packetID: Byte;
|
||||
begin
|
||||
//writeln('compressed size: ', ABuffer.Size);
|
||||
targetSize := ABuffer.ReadCardinal;
|
||||
//writeln('uncompressed size: ', targetSize);
|
||||
uncompBuffer := TDecompressionStream.Create(ABuffer);
|
||||
uncompStream := TEnhancedMemoryStream.Create;
|
||||
try
|
||||
uncompStream.CopyFrom(uncompBuffer, targetSize);
|
||||
uncompStream.Position := 0;
|
||||
packetID := uncompStream.ReadByte;
|
||||
if PacketHandlers[packetID] <> nil then
|
||||
begin
|
||||
if PacketHandlers[PacketID].PacketLength = 0 then
|
||||
uncompStream.Position := uncompStream.Position + 4;
|
||||
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
|
||||
PacketHandlers[PacketID].Process(uncompStream);
|
||||
uncompStream.Unlock;
|
||||
end else
|
||||
begin
|
||||
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
|
||||
ANetState.Socket.Disconnect;
|
||||
ANetState.ReceiveQueue.Clear;}
|
||||
end;
|
||||
finally
|
||||
if uncompBuffer <> nil then uncompBuffer.Free;
|
||||
if uncompStream <> nil then uncompStream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$WARNINGS OFF}
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
initialization
|
||||
for i := 0 to $FF do
|
||||
PacketHandlers[i] := nil;
|
||||
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
|
||||
//$02 --> ConnectionHandling, done by TdmNetwork
|
||||
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);;
|
||||
//$04 --> handled by TLandscape
|
||||
//$06-$0B --> handled by TLandscape
|
||||
//$0C --> ClientHandling, done by TfrmMain
|
||||
//$0D --> RadarMapHandling, done by TfrmRadarMap
|
||||
finalization
|
||||
for i := 0 to $FF do
|
||||
if PacketHandlers[i] <> nil then
|
||||
PacketHandlers[i].Free;
|
||||
{$WARNINGS ON}
|
||||
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 2007 Andreas Schneider
|
||||
*)
|
||||
unit UPacketHandlers;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, dzlib, UEnhancedMemoryStream;
|
||||
|
||||
type
|
||||
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream);
|
||||
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream) of object;
|
||||
|
||||
{ TPacketHandler }
|
||||
|
||||
TPacketHandler = class(TObject)
|
||||
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
|
||||
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
|
||||
procedure Process(ABuffer: TEnhancedMemoryStream);
|
||||
protected
|
||||
FLength: Cardinal;
|
||||
FPacketProcessor: TPacketProcessor;
|
||||
FPacketProcessorMethod: TPacketProcessorMethod;
|
||||
published
|
||||
property PacketLength: Cardinal read FLength;
|
||||
end;
|
||||
|
||||
var
|
||||
PacketHandlers: array[0..$FF] of TPacketHandler;
|
||||
|
||||
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UAdminHandling;
|
||||
|
||||
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
|
||||
begin
|
||||
FreeAndNil(PacketHandlers[AID]);
|
||||
PacketHandlers[AID] := APacketHandler;
|
||||
end;
|
||||
|
||||
{ TPacketHandler }
|
||||
|
||||
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
|
||||
begin
|
||||
inherited Create;
|
||||
FLength := ALength;
|
||||
FPacketProcessor := APacketProcessor;
|
||||
FPacketProcessorMethod := nil;
|
||||
end;
|
||||
|
||||
constructor TPacketHandler.Create(ALength: Cardinal;
|
||||
APacketProcessorMethod: TPacketProcessorMethod);
|
||||
begin
|
||||
inherited Create;
|
||||
FLength := ALength;
|
||||
FPacketProcessor := nil;
|
||||
FPacketProcessorMethod := APacketProcessorMethod;
|
||||
end;
|
||||
|
||||
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream);
|
||||
begin
|
||||
if Assigned(FPacketProcessor) then
|
||||
FPacketProcessor(ABuffer)
|
||||
else if Assigned(FPacketProcessorMethod) then
|
||||
FPacketProcessorMethod(ABuffer);
|
||||
end;
|
||||
|
||||
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
uncompStream: TEnhancedMemoryStream;
|
||||
uncompBuffer: TDecompressionStream;
|
||||
targetSize: Cardinal;
|
||||
packetID: Byte;
|
||||
begin
|
||||
//writeln('compressed size: ', ABuffer.Size);
|
||||
targetSize := ABuffer.ReadCardinal;
|
||||
//writeln('uncompressed size: ', targetSize);
|
||||
uncompBuffer := TDecompressionStream.Create(ABuffer);
|
||||
uncompStream := TEnhancedMemoryStream.Create;
|
||||
try
|
||||
uncompStream.CopyFrom(uncompBuffer, targetSize);
|
||||
uncompStream.Position := 0;
|
||||
packetID := uncompStream.ReadByte;
|
||||
if PacketHandlers[packetID] <> nil then
|
||||
begin
|
||||
if PacketHandlers[PacketID].PacketLength = 0 then
|
||||
uncompStream.Position := uncompStream.Position + 4;
|
||||
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
|
||||
PacketHandlers[PacketID].Process(uncompStream);
|
||||
uncompStream.Unlock;
|
||||
end else
|
||||
begin
|
||||
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
|
||||
ANetState.Socket.Disconnect;
|
||||
ANetState.ReceiveQueue.Clear;}
|
||||
end;
|
||||
finally
|
||||
if uncompBuffer <> nil then uncompBuffer.Free;
|
||||
if uncompStream <> nil then uncompStream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$WARNINGS OFF}
|
||||
var
|
||||
i: Integer;
|
||||
|
||||
initialization
|
||||
for i := 0 to $FF do
|
||||
PacketHandlers[i] := nil;
|
||||
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
|
||||
//$02 --> ConnectionHandling, done by TdmNetwork
|
||||
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);;
|
||||
//$04 --> handled by TLandscape
|
||||
//$06-$0B --> handled by TLandscape
|
||||
//$0C --> ClientHandling, done by TfrmMain
|
||||
//$0D --> RadarMapHandling, done by TfrmRadarMap
|
||||
finalization
|
||||
for i := 0 to $FF do
|
||||
if PacketHandlers[i] <> nil then
|
||||
PacketHandlers[i].Free;
|
||||
{$WARNINGS ON}
|
||||
end.
|
||||
|
||||
|
||||
+373
-373
@@ -1,373 +1,373 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UPackets;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics;
|
||||
|
||||
type
|
||||
TBlockCoords = packed record
|
||||
X: Word;
|
||||
Y: Word;
|
||||
end;
|
||||
TBlockCoordsArray = array of TBlockCoords;
|
||||
|
||||
{ TCompressedPacket }
|
||||
|
||||
TCompressedPacket = class(TPacket)
|
||||
constructor Create(APacket: TPacket);
|
||||
end;
|
||||
|
||||
{ TLoginRequestPacket }
|
||||
|
||||
TLoginRequestPacket = class(TPacket)
|
||||
constructor Create(AUsername, APassword: string);
|
||||
end;
|
||||
|
||||
{ TQuitPacket }
|
||||
|
||||
TQuitPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TRequestBlocksPacket }
|
||||
|
||||
TRequestBlocksPacket = class(TPacket)
|
||||
constructor Create(ACoords: TBlockCoordsArray);
|
||||
end;
|
||||
|
||||
{ TFreeBlockPacket }
|
||||
|
||||
TFreeBlockPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word);
|
||||
end;
|
||||
|
||||
{ TDrawMapPacket }
|
||||
|
||||
TDrawMapPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
|
||||
end;
|
||||
|
||||
{ TStaticPacket }
|
||||
|
||||
TStaticPacket = class(TPacket)
|
||||
protected
|
||||
procedure WriteStaticItem(AStaticItem: TStaticItem);
|
||||
end;
|
||||
|
||||
{ TInsertStaticPacket }
|
||||
|
||||
TInsertStaticPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
|
||||
end;
|
||||
|
||||
{ TDeleteStaticPacket }
|
||||
|
||||
TDeleteStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem);
|
||||
end;
|
||||
|
||||
{ TElevateStaticPacket }
|
||||
|
||||
TElevateStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
|
||||
ANewZ: Word);
|
||||
end;
|
||||
|
||||
{ TMoveStaticPacket }
|
||||
|
||||
TMoveStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
|
||||
ANewX, ANewY: Word);
|
||||
end;
|
||||
|
||||
{ THueStaticPacket }
|
||||
|
||||
THueStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
|
||||
ANewHue: Word);
|
||||
end;
|
||||
|
||||
{ TUpdateClientPosPacket }
|
||||
|
||||
TUpdateClientPosPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word);
|
||||
end;
|
||||
|
||||
{ TChatMessagePacket }
|
||||
|
||||
TChatMessagePacket = class(TPacket)
|
||||
constructor Create(AMessage: string);
|
||||
end;
|
||||
|
||||
{ TGotoClientPosPacket }
|
||||
|
||||
TGotoClientPosPacket = class(TPacket)
|
||||
constructor Create(AUsername: string);
|
||||
end;
|
||||
|
||||
{ TRequestRadarChecksumPacket }
|
||||
|
||||
TRequestRadarChecksumPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TRequestRadarMapPacket }
|
||||
|
||||
TRequestRadarMapPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TNoOpPacket }
|
||||
|
||||
TNoOpPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCompressedPacket }
|
||||
|
||||
constructor TCompressedPacket.Create(APacket: TPacket);
|
||||
var
|
||||
compBuffer: TEnhancedMemoryStream;
|
||||
compStream: TCompressionStream;
|
||||
sourceStream: TStream;
|
||||
begin
|
||||
inherited Create($01, 0);
|
||||
compBuffer := TEnhancedMemoryStream.Create;
|
||||
compStream := TCompressionStream.Create(clMax, compBuffer);
|
||||
sourceStream := APacket.Stream;
|
||||
compStream.CopyFrom(sourceStream, 0);
|
||||
compStream.Free;
|
||||
FStream.WriteCardinal(sourceStream.Size);
|
||||
FStream.CopyFrom(compBuffer, 0);
|
||||
compBuffer.Free;
|
||||
APacket.Free;
|
||||
end;
|
||||
|
||||
{ TLoginRequestPacket }
|
||||
|
||||
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
|
||||
begin
|
||||
inherited Create($02, 0);
|
||||
FStream.WriteByte($03);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
FStream.WriteStringNull(APassword);
|
||||
end;
|
||||
|
||||
{ TQuitPacket }
|
||||
|
||||
constructor TQuitPacket.Create;
|
||||
begin
|
||||
inherited Create($02, 0);
|
||||
FStream.WriteByte($05);
|
||||
end;
|
||||
|
||||
{ TRequestBlocksPacket }
|
||||
|
||||
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
|
||||
begin
|
||||
inherited Create($04, 0);
|
||||
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
|
||||
end;
|
||||
|
||||
{ TFreeBlockPacket }
|
||||
|
||||
constructor TFreeBlockPacket.Create(AX, AY: Word);
|
||||
begin
|
||||
inherited Create($05, 5);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
end;
|
||||
|
||||
{ TDrawMapPacket }
|
||||
|
||||
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
|
||||
begin
|
||||
inherited Create($06, 8);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
end;
|
||||
|
||||
{ TStaticPacket }
|
||||
|
||||
procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
|
||||
begin
|
||||
FStream.WriteWord(AStaticItem.X);
|
||||
FStream.WriteWord(AStaticItem.Y);
|
||||
FStream.WriteShortInt(AStaticItem.Z);
|
||||
FStream.WriteWord(AStaticItem.TileID);
|
||||
FStream.WriteWord(AStaticItem.Hue);
|
||||
end;
|
||||
|
||||
{ TInsertStaticPacket }
|
||||
|
||||
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
|
||||
ATileID: Word; AHue: Word);
|
||||
begin
|
||||
inherited Create($07, 10);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
end;
|
||||
|
||||
{ TDeleteStaticPacket }
|
||||
|
||||
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
|
||||
begin
|
||||
inherited Create($08, 10);
|
||||
WriteStaticItem(AStaticItem);
|
||||
end;
|
||||
|
||||
{ TElevateStaticPacket }
|
||||
|
||||
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
|
||||
begin
|
||||
inherited Create($09, 11);
|
||||
WriteStaticItem(AStaticItem);
|
||||
FStream.WriteShortInt(ANewZ);
|
||||
end;
|
||||
|
||||
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
|
||||
ATileID: Word; AHue: Word; ANewZ: Word);
|
||||
begin
|
||||
inherited Create($09, 11);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
FStream.WriteShortInt(ANewZ);
|
||||
end;
|
||||
|
||||
{ TMoveStaticPacket }
|
||||
|
||||
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
|
||||
ANewY: Word);
|
||||
begin
|
||||
inherited Create($0A, 14);
|
||||
WriteStaticItem(AStaticItem);
|
||||
FStream.WriteWord(ANewX);
|
||||
FStream.WriteWord(ANewY);
|
||||
end;
|
||||
|
||||
constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
|
||||
AHue: Word; ANewX, ANewY: Word);
|
||||
begin
|
||||
inherited Create($0A, 14);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
FStream.WriteWord(ANewX);
|
||||
FStream.WriteWord(ANewY);
|
||||
end;
|
||||
|
||||
{ THueStaticPacket }
|
||||
|
||||
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
|
||||
begin
|
||||
inherited Create($0B, 12);
|
||||
WriteStaticItem(AStaticItem);
|
||||
FStream.WriteWord(ANewHue);
|
||||
end;
|
||||
|
||||
constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
|
||||
AHue: Word; ANewHue: Word);
|
||||
begin
|
||||
inherited Create($0B, 12);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
FStream.WriteWord(ANewHue);
|
||||
end;
|
||||
|
||||
{ TUpdateClientPosPacket }
|
||||
|
||||
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
|
||||
begin
|
||||
inherited Create($0C, 0);
|
||||
FStream.WriteByte($04);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
end;
|
||||
|
||||
{ TChatMessagePacket }
|
||||
|
||||
constructor TChatMessagePacket.Create(AMessage: string);
|
||||
begin
|
||||
inherited Create($0C, 0);
|
||||
FStream.WriteByte($05);
|
||||
FStream.WriteStringNull(AMessage);
|
||||
end;
|
||||
|
||||
{ TGotoClientPosPacket }
|
||||
|
||||
constructor TGotoClientPosPacket.Create(AUsername: string);
|
||||
begin
|
||||
inherited Create($0C, 0);
|
||||
FStream.WriteByte($06);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
end;
|
||||
|
||||
{ TRequestRadarChecksumPacket }
|
||||
|
||||
constructor TRequestRadarChecksumPacket.Create;
|
||||
begin
|
||||
inherited Create($0D, 2);
|
||||
FStream.WriteByte($01);
|
||||
end;
|
||||
|
||||
{ TRequestRadarMapPacket }
|
||||
|
||||
constructor TRequestRadarMapPacket.Create;
|
||||
begin
|
||||
inherited Create($0D, 2);
|
||||
FStream.WriteByte($02);
|
||||
end;
|
||||
|
||||
{ TNoOpPacket }
|
||||
|
||||
constructor TNoOpPacket.Create;
|
||||
begin
|
||||
inherited Create($FF, 1);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UPackets;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics;
|
||||
|
||||
type
|
||||
TBlockCoords = packed record
|
||||
X: Word;
|
||||
Y: Word;
|
||||
end;
|
||||
TBlockCoordsArray = array of TBlockCoords;
|
||||
|
||||
{ TCompressedPacket }
|
||||
|
||||
TCompressedPacket = class(TPacket)
|
||||
constructor Create(APacket: TPacket);
|
||||
end;
|
||||
|
||||
{ TLoginRequestPacket }
|
||||
|
||||
TLoginRequestPacket = class(TPacket)
|
||||
constructor Create(AUsername, APassword: string);
|
||||
end;
|
||||
|
||||
{ TQuitPacket }
|
||||
|
||||
TQuitPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TRequestBlocksPacket }
|
||||
|
||||
TRequestBlocksPacket = class(TPacket)
|
||||
constructor Create(ACoords: TBlockCoordsArray);
|
||||
end;
|
||||
|
||||
{ TFreeBlockPacket }
|
||||
|
||||
TFreeBlockPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word);
|
||||
end;
|
||||
|
||||
{ TDrawMapPacket }
|
||||
|
||||
TDrawMapPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
|
||||
end;
|
||||
|
||||
{ TStaticPacket }
|
||||
|
||||
TStaticPacket = class(TPacket)
|
||||
protected
|
||||
procedure WriteStaticItem(AStaticItem: TStaticItem);
|
||||
end;
|
||||
|
||||
{ TInsertStaticPacket }
|
||||
|
||||
TInsertStaticPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
|
||||
end;
|
||||
|
||||
{ TDeleteStaticPacket }
|
||||
|
||||
TDeleteStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem);
|
||||
end;
|
||||
|
||||
{ TElevateStaticPacket }
|
||||
|
||||
TElevateStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
|
||||
ANewZ: Word);
|
||||
end;
|
||||
|
||||
{ TMoveStaticPacket }
|
||||
|
||||
TMoveStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
|
||||
ANewX, ANewY: Word);
|
||||
end;
|
||||
|
||||
{ THueStaticPacket }
|
||||
|
||||
THueStaticPacket = class(TStaticPacket)
|
||||
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
|
||||
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
|
||||
ANewHue: Word);
|
||||
end;
|
||||
|
||||
{ TUpdateClientPosPacket }
|
||||
|
||||
TUpdateClientPosPacket = class(TPacket)
|
||||
constructor Create(AX, AY: Word);
|
||||
end;
|
||||
|
||||
{ TChatMessagePacket }
|
||||
|
||||
TChatMessagePacket = class(TPacket)
|
||||
constructor Create(AMessage: string);
|
||||
end;
|
||||
|
||||
{ TGotoClientPosPacket }
|
||||
|
||||
TGotoClientPosPacket = class(TPacket)
|
||||
constructor Create(AUsername: string);
|
||||
end;
|
||||
|
||||
{ TRequestRadarChecksumPacket }
|
||||
|
||||
TRequestRadarChecksumPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TRequestRadarMapPacket }
|
||||
|
||||
TRequestRadarMapPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TNoOpPacket }
|
||||
|
||||
TNoOpPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCompressedPacket }
|
||||
|
||||
constructor TCompressedPacket.Create(APacket: TPacket);
|
||||
var
|
||||
compBuffer: TEnhancedMemoryStream;
|
||||
compStream: TCompressionStream;
|
||||
sourceStream: TStream;
|
||||
begin
|
||||
inherited Create($01, 0);
|
||||
compBuffer := TEnhancedMemoryStream.Create;
|
||||
compStream := TCompressionStream.Create(clMax, compBuffer);
|
||||
sourceStream := APacket.Stream;
|
||||
compStream.CopyFrom(sourceStream, 0);
|
||||
compStream.Free;
|
||||
FStream.WriteCardinal(sourceStream.Size);
|
||||
FStream.CopyFrom(compBuffer, 0);
|
||||
compBuffer.Free;
|
||||
APacket.Free;
|
||||
end;
|
||||
|
||||
{ TLoginRequestPacket }
|
||||
|
||||
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
|
||||
begin
|
||||
inherited Create($02, 0);
|
||||
FStream.WriteByte($03);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
FStream.WriteStringNull(APassword);
|
||||
end;
|
||||
|
||||
{ TQuitPacket }
|
||||
|
||||
constructor TQuitPacket.Create;
|
||||
begin
|
||||
inherited Create($02, 0);
|
||||
FStream.WriteByte($05);
|
||||
end;
|
||||
|
||||
{ TRequestBlocksPacket }
|
||||
|
||||
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
|
||||
begin
|
||||
inherited Create($04, 0);
|
||||
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
|
||||
end;
|
||||
|
||||
{ TFreeBlockPacket }
|
||||
|
||||
constructor TFreeBlockPacket.Create(AX, AY: Word);
|
||||
begin
|
||||
inherited Create($05, 5);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
end;
|
||||
|
||||
{ TDrawMapPacket }
|
||||
|
||||
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
|
||||
begin
|
||||
inherited Create($06, 8);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
end;
|
||||
|
||||
{ TStaticPacket }
|
||||
|
||||
procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
|
||||
begin
|
||||
FStream.WriteWord(AStaticItem.X);
|
||||
FStream.WriteWord(AStaticItem.Y);
|
||||
FStream.WriteShortInt(AStaticItem.Z);
|
||||
FStream.WriteWord(AStaticItem.TileID);
|
||||
FStream.WriteWord(AStaticItem.Hue);
|
||||
end;
|
||||
|
||||
{ TInsertStaticPacket }
|
||||
|
||||
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
|
||||
ATileID: Word; AHue: Word);
|
||||
begin
|
||||
inherited Create($07, 10);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
end;
|
||||
|
||||
{ TDeleteStaticPacket }
|
||||
|
||||
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
|
||||
begin
|
||||
inherited Create($08, 10);
|
||||
WriteStaticItem(AStaticItem);
|
||||
end;
|
||||
|
||||
{ TElevateStaticPacket }
|
||||
|
||||
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
|
||||
begin
|
||||
inherited Create($09, 11);
|
||||
WriteStaticItem(AStaticItem);
|
||||
FStream.WriteShortInt(ANewZ);
|
||||
end;
|
||||
|
||||
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
|
||||
ATileID: Word; AHue: Word; ANewZ: Word);
|
||||
begin
|
||||
inherited Create($09, 11);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
FStream.WriteShortInt(ANewZ);
|
||||
end;
|
||||
|
||||
{ TMoveStaticPacket }
|
||||
|
||||
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
|
||||
ANewY: Word);
|
||||
begin
|
||||
inherited Create($0A, 14);
|
||||
WriteStaticItem(AStaticItem);
|
||||
FStream.WriteWord(ANewX);
|
||||
FStream.WriteWord(ANewY);
|
||||
end;
|
||||
|
||||
constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
|
||||
AHue: Word; ANewX, ANewY: Word);
|
||||
begin
|
||||
inherited Create($0A, 14);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
FStream.WriteWord(ANewX);
|
||||
FStream.WriteWord(ANewY);
|
||||
end;
|
||||
|
||||
{ THueStaticPacket }
|
||||
|
||||
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
|
||||
begin
|
||||
inherited Create($0B, 12);
|
||||
WriteStaticItem(AStaticItem);
|
||||
FStream.WriteWord(ANewHue);
|
||||
end;
|
||||
|
||||
constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
|
||||
AHue: Word; ANewHue: Word);
|
||||
begin
|
||||
inherited Create($0B, 12);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
FStream.WriteShortInt(AZ);
|
||||
FStream.WriteWord(ATileID);
|
||||
FStream.WriteWord(AHue);
|
||||
FStream.WriteWord(ANewHue);
|
||||
end;
|
||||
|
||||
{ TUpdateClientPosPacket }
|
||||
|
||||
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
|
||||
begin
|
||||
inherited Create($0C, 0);
|
||||
FStream.WriteByte($04);
|
||||
FStream.WriteWord(AX);
|
||||
FStream.WriteWord(AY);
|
||||
end;
|
||||
|
||||
{ TChatMessagePacket }
|
||||
|
||||
constructor TChatMessagePacket.Create(AMessage: string);
|
||||
begin
|
||||
inherited Create($0C, 0);
|
||||
FStream.WriteByte($05);
|
||||
FStream.WriteStringNull(AMessage);
|
||||
end;
|
||||
|
||||
{ TGotoClientPosPacket }
|
||||
|
||||
constructor TGotoClientPosPacket.Create(AUsername: string);
|
||||
begin
|
||||
inherited Create($0C, 0);
|
||||
FStream.WriteByte($06);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
end;
|
||||
|
||||
{ TRequestRadarChecksumPacket }
|
||||
|
||||
constructor TRequestRadarChecksumPacket.Create;
|
||||
begin
|
||||
inherited Create($0D, 2);
|
||||
FStream.WriteByte($01);
|
||||
end;
|
||||
|
||||
{ TRequestRadarMapPacket }
|
||||
|
||||
constructor TRequestRadarMapPacket.Create;
|
||||
begin
|
||||
inherited Create($0D, 2);
|
||||
FStream.WriteByte($02);
|
||||
end;
|
||||
|
||||
{ TNoOpPacket }
|
||||
|
||||
constructor TNoOpPacket.Create;
|
||||
begin
|
||||
inherited Create($FF, 1);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+105
-105
@@ -1,105 +1,105 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UResourceManager;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TResourceManager }
|
||||
|
||||
TResourceManager = class
|
||||
constructor Create(AFileName: string);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FFileStream: TFileStream;
|
||||
FCount: Integer;
|
||||
FLookupTable: array of Cardinal;
|
||||
FCurrentResource: Integer;
|
||||
FResourceStream: TMemoryStream;
|
||||
public
|
||||
function GetResource(AIndex: Integer): TStream;
|
||||
end;
|
||||
|
||||
var
|
||||
ResourceManager: TResourceManager;
|
||||
|
||||
implementation
|
||||
|
||||
{ TResourceManager }
|
||||
|
||||
constructor TResourceManager.Create(AFileName: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
|
||||
FFileStream.Position := 0;
|
||||
FFileStream.Read(FCount, SizeOf(Integer));
|
||||
SetLength(FLookupTable, FCount);
|
||||
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
|
||||
FCurrentResource := -1;
|
||||
end;
|
||||
|
||||
destructor TResourceManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FFileStream);
|
||||
FreeAndNil(FResourceStream);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TResourceManager.GetResource(AIndex: Integer): TStream;
|
||||
var
|
||||
size: Cardinal;
|
||||
begin
|
||||
if AIndex <> FCurrentResource then
|
||||
begin
|
||||
FFileStream.Position := FLookupTable[AIndex];
|
||||
FResourceStream.Free;
|
||||
FResourceStream := TMemoryStream.Create;
|
||||
FFileStream.Read(size, SizeOf(Cardinal));
|
||||
FResourceStream.CopyFrom(FFileStream, size);
|
||||
FCurrentResource := AIndex;
|
||||
end;
|
||||
FResourceStream.Position := 0;
|
||||
Result := FResourceStream;
|
||||
end;
|
||||
|
||||
initialization
|
||||
begin
|
||||
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
|
||||
end;
|
||||
|
||||
finalization
|
||||
begin
|
||||
if ResourceManager <> nil then FreeAndNil(ResourceManager);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UResourceManager;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TResourceManager }
|
||||
|
||||
TResourceManager = class
|
||||
constructor Create(AFileName: string);
|
||||
destructor Destroy; override;
|
||||
protected
|
||||
FFileStream: TFileStream;
|
||||
FCount: Integer;
|
||||
FLookupTable: array of Cardinal;
|
||||
FCurrentResource: Integer;
|
||||
FResourceStream: TMemoryStream;
|
||||
public
|
||||
function GetResource(AIndex: Integer): TStream;
|
||||
end;
|
||||
|
||||
var
|
||||
ResourceManager: TResourceManager;
|
||||
|
||||
implementation
|
||||
|
||||
{ TResourceManager }
|
||||
|
||||
constructor TResourceManager.Create(AFileName: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
|
||||
FFileStream.Position := 0;
|
||||
FFileStream.Read(FCount, SizeOf(Integer));
|
||||
SetLength(FLookupTable, FCount);
|
||||
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
|
||||
FCurrentResource := -1;
|
||||
end;
|
||||
|
||||
destructor TResourceManager.Destroy;
|
||||
begin
|
||||
FreeAndNil(FFileStream);
|
||||
FreeAndNil(FResourceStream);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TResourceManager.GetResource(AIndex: Integer): TStream;
|
||||
var
|
||||
size: Cardinal;
|
||||
begin
|
||||
if AIndex <> FCurrentResource then
|
||||
begin
|
||||
FFileStream.Position := FLookupTable[AIndex];
|
||||
FResourceStream.Free;
|
||||
FResourceStream := TMemoryStream.Create;
|
||||
FFileStream.Read(size, SizeOf(Cardinal));
|
||||
FResourceStream.CopyFrom(FFileStream, size);
|
||||
FCurrentResource := AIndex;
|
||||
end;
|
||||
FResourceStream.Position := 0;
|
||||
Result := FResourceStream;
|
||||
end;
|
||||
|
||||
initialization
|
||||
begin
|
||||
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
|
||||
end;
|
||||
|
||||
finalization
|
||||
begin
|
||||
if ResourceManager <> nil then FreeAndNil(ResourceManager);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+371
-371
@@ -1,371 +1,371 @@
|
||||
(*
|
||||
* 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, UfrmLightlevel;
|
||||
|
||||
{$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);
|
||||
frmLightlevel := TfrmLightlevel.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);
|
||||
FreeAndNil(frmLightlevel);
|
||||
|
||||
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, UfrmLightlevel;
|
||||
|
||||
{$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);
|
||||
frmLightlevel := TfrmLightlevel.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);
|
||||
FreeAndNil(frmLightlevel);
|
||||
|
||||
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.
|
||||
|
||||
|
||||
+381
-381
@@ -1,381 +1,381 @@
|
||||
object frmAccountControl: TfrmAccountControl
|
||||
Left = 290
|
||||
Height = 378
|
||||
Top = 171
|
||||
Width = 369
|
||||
ActiveControl = vstAccounts
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Account Management'
|
||||
ClientHeight = 378
|
||||
ClientWidth = 369
|
||||
Font.Height = -11
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
Position = poOwnerFormCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object tbMain: TToolBar
|
||||
Left = 0
|
||||
Height = 26
|
||||
Top = 0
|
||||
Width = 369
|
||||
Caption = 'tbMain'
|
||||
Images = ilToolbar
|
||||
TabOrder = 0
|
||||
object tbRefresh: TToolButton
|
||||
Left = 1
|
||||
Hint = 'Refresh'
|
||||
Top = 2
|
||||
Caption = 'Refresh'
|
||||
ImageIndex = 0
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbRefreshClick
|
||||
end
|
||||
object tbAddUser: TToolButton
|
||||
Left = 32
|
||||
Hint = 'Add User'
|
||||
Top = 2
|
||||
Caption = 'Add User'
|
||||
ImageIndex = 1
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbAddUserClick
|
||||
end
|
||||
object tbEditUser: TToolButton
|
||||
Left = 55
|
||||
Hint = 'Edit User'
|
||||
Top = 2
|
||||
Caption = 'Edit User'
|
||||
ImageIndex = 2
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbEditUserClick
|
||||
end
|
||||
object tbDeleteUser: TToolButton
|
||||
Left = 78
|
||||
Hint = 'Delete User'
|
||||
Top = 2
|
||||
Caption = 'Delete User'
|
||||
ImageIndex = 3
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbDeleteUserClick
|
||||
end
|
||||
object tbSeparator1: TToolButton
|
||||
Left = 24
|
||||
Top = 2
|
||||
Width = 8
|
||||
Caption = 'tbSeparator1'
|
||||
Style = tbsDivider
|
||||
end
|
||||
end
|
||||
object vstAccounts: TVirtualStringTree
|
||||
Left = 0
|
||||
Height = 352
|
||||
Top = 26
|
||||
Width = 369
|
||||
Align = alClient
|
||||
DefaultText = 'Node'
|
||||
Header.AutoSizeIndex = 1
|
||||
Header.Columns = <
|
||||
item
|
||||
Position = 0
|
||||
Width = 30
|
||||
end
|
||||
item
|
||||
Position = 1
|
||||
Text = 'Username'
|
||||
Width = 200
|
||||
end
|
||||
item
|
||||
Position = 2
|
||||
Text = 'Accesslevel'
|
||||
Width = 100
|
||||
end>
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoColumnResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.Style = hsFlatButtons
|
||||
Images = ilAccesslevel
|
||||
TabOrder = 1
|
||||
TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
|
||||
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||
TreeOptions.SelectionOptions = [toFullRowSelect]
|
||||
OnDblClick = vstAccountsDblClick
|
||||
OnFreeNode = vstAccountsFreeNode
|
||||
OnGetText = vstAccountsGetText
|
||||
OnGetImageIndex = vstAccountsGetImageIndex
|
||||
end
|
||||
object ilToolbar: TImageList
|
||||
left = 144
|
||||
Bitmap = {
|
||||
4C69040000001000000010000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000047994FFF419149FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000005BB4
|
||||
65FF56AD5FFF50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3AFF0000
|
||||
000000000000000000000000000000000000000000005EB968FF79C383FF89CA
|
||||
92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D
|
||||
2CFF000000000000000000000000000000005CB667FF85C98EFF9BD4A4FF8FCE
|
||||
98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265
|
||||
25FF0000000000000000000000000000000075BF7EFF98D2A1FF94CF9CFF86C7
|
||||
8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF206324FF0000
|
||||
000000000000000000000000000054AB5EFF80C389FF8DCC95FF83C48AFF3D8B
|
||||
44FF37833EFF000000000000000000000000236627FF1F6123FF000000000000
|
||||
00000000000000000000000000004DA155FF47994FFF419149FF3B8842FF3580
|
||||
3CFF000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000000000004DA155FF4799
|
||||
4FFF419149FF3B8842FF35803CFF000000000000000000000000000000000000
|
||||
000063C06EFF5FBB6AFF0000000000000000000000004B9E53FF45964DFF86C6
|
||||
8EFF88C98FFF6FB376FF2E7633FF0000000000000000000000000000000062BE
|
||||
6DFF7BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9
|
||||
8FFF82C689FF509756FF0000000000000000000000000000000060BC6CFF79C4
|
||||
83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4
|
||||
85FF5DA463FF266B2AFF000000000000000000000000000000005BB465FF73BD
|
||||
7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92
|
||||
51FF246829FF0000000000000000000000000000000000000000000000004EA3
|
||||
57FF66B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432FF276D2CFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000419149FF3B8842FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000F4B
|
||||
97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000C3E
|
||||
87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001F5E
|
||||
9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000002A5B
|
||||
92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000006A3C
|
||||
25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000
|
||||
000000000000000000000000000000000000000000000000000000000000BC48
|
||||
1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000
|
||||
0000000000000000000000000000000000000000000000000000C44C1FFFF6E4
|
||||
D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFFAEAB78FF609772FF4F8E
|
||||
66FF428357FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1
|
||||
98FFFEC76DFFFEBF68FFFEB964FFFEB15EFFA79B61FF61AB81FF95D4B4FFBAE6
|
||||
D0FF6ABB8FFF2D8F57FF196B37FF00000000287CCEFF78B3EAFFB39E94FFFFB7
|
||||
60FFFFB663FFFEB261FFFEAC5DFFFEA559FF4A885DFF90D3B1FF92D6B1FFFFFF
|
||||
FFFF65BC8CFF67BC8FFF196B37FF00000000297DD1FF82BAEEFF9F6658FFF5BB
|
||||
84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF317B4CFF9CD4B6FFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF95D2B2FF196B37FF00000000000000002579CDFF866161FFBF60
|
||||
35FFFEB961FFFEB962FFFEB962FFFEB962FF226E3AFF62BA8BFF60BA87FFFFFF
|
||||
FFFF60B987FF67BC8FFF196B37FF00000000000000000000000000000000B350
|
||||
20FFA0401FFFAA4522FFAC4622FFAB4422FF5C572DFF288C53FF64BA8DFF95D2
|
||||
B2FF64BA8DFF288C53FF196B37FF000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000196B37FF196B37FF196B
|
||||
37FF196B37FF196B37FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000012488DFF104B90FF0F488AFF11427DFF15335BFF00000000000000000000
|
||||
000000000000000000000000000000000000000000000000000000000000114E
|
||||
96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF000000000000
|
||||
00000000000000000000000000000000000000000000000000000F4B97FF1258
|
||||
9FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF000000000000
|
||||
00000000000000000000000000000000000000000000000000000C3E87FF7C97
|
||||
B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF000000000000
|
||||
00000000000000000000000000000000000000000000000000001F5E9BFFD9E8
|
||||
F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000000058A5
|
||||
D8FF85B1DBFF469DD0FF000000000000000000000000000000002A5B92FFA6CA
|
||||
EEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2884B7FF77BEE7FFB4D2
|
||||
F0FFE5F3FFFFACD2EFFF488CC7FF0000000000000000000000006A3C25FF346D
|
||||
A7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF2E8ABFFF7ED3EBFFB2E3F9FF8BC0
|
||||
E7FFAED3F6FFC4E0FCFF669FD3FF000000000000000000000000BC481CFFF4E2
|
||||
D4FF4E7BA9FF4D7BA8FF4D7BA8FF428CBAFF7DD4EEFFC4F6FDFF6CDDF6FF6DCA
|
||||
EDFF63A3D7FF5D9BD2FF000000000000000000000000C44C1FFFF6E4D6FFFFE4
|
||||
A4FFFFD472FFFFC969FFBFBB86FF79D3EEFFC7F7FDFF5FDCF5FF5BE2F7FF7AD6
|
||||
F2FF4099DFFF0000000000000000000000008A5444FFFCC8ABFFFFD198FFFEC7
|
||||
6DFFFEBF68FFB0A780FF77CBE7FFC7F7FDFF5EDCF5FF5AE1F7FF7BD4F1FF4691
|
||||
D4FF686672FF0000000000000000287CCEFF78B3EAFFB39E94FFFFB760FFFFB6
|
||||
63FFB3A37DFF76B8D3FFC2F6FDFF63DFF7FF5DE2F8FF79D3F0FF4795D8FF75B2
|
||||
EAFF2974C7FF0000000000000000297DD1FF82BAEEFF9F6658FFF5BB84FFA792
|
||||
74FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0EDFF5196D2FF96645DFF83BC
|
||||
EFFF2A77CAFF0000000000000000000000002579CDFF866161FFBF6035FF4389
|
||||
AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF4988B7FF9C5442FF7A646DFF2E7E
|
||||
CEFF6DA2D3FF0000000000000000000000000000000000000000B35020FF2D64
|
||||
81FF94C7F9FF91C9F9FF4185C9FF2362A4FF89493DFFB24F24FF000000000000
|
||||
000000000000000000000000000000000000000000000000000000000000113D
|
||||
55FF285F87FF4988BDFF428DBCFF000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000F4B
|
||||
97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000C3E
|
||||
87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001F5E
|
||||
9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000002A5B
|
||||
92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000006A3C
|
||||
25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000
|
||||
000000000000000000000000000000000000000000000000000000000000BC48
|
||||
1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000
|
||||
0000000000000000000000000000000000000000000000000000C44C1FFFF6E4
|
||||
D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFF9590A0FF295DC1FF0542
|
||||
BBFF0B45B0FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1
|
||||
98FFFEC76DFFFEBF68FFFEB964FFFEB15EFF95828BFF3D74CEFF8DB5F7FFB8D6
|
||||
FEFF72A8F5FF2D6BCAFF0000000000000000287CCEFF78B3EAFFB39E94FFFFB7
|
||||
60FFFFB663FFFEB261FFFEAC5DFFFEA559FF2450ABFF8DB5F6FF4D92FFFF1177
|
||||
FFFF2186FFFF408AEBFF0344B9FF00000000297DD1FF82BAEEFF9F6658FFF5BB
|
||||
84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF0542BCFFAECDFEFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF187FEFFF0442BCFF00000000000000002579CDFF866161FFBF60
|
||||
35FFFEB961FFFEB962FFFEB962FFFEB962FF1F52AFFF639DF4FF187FFFFF0076
|
||||
F8FF0076EEFF0368E1FF0345B9FF00000000000000000000000000000000B350
|
||||
20FFA0401FFFAA4522FFAC4622FFAB4422FF5F4C74FF2763C6FF2177E6FF0579
|
||||
EAFF0164DDFF044DBDFF00000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000000000000345B9FF0442
|
||||
BCFF0345B9FF0000000000000000
|
||||
}
|
||||
end
|
||||
object ilAccesslevel: TImageList
|
||||
left = 176
|
||||
Bitmap = {
|
||||
4C69040000001000000010000000000000000000000000000000000000000000
|
||||
0000A3A3A3FFA0A0A0FF9D9D9DFF9A9A9AFF979797FF949494FF000000000000
|
||||
000000000000000000000000000000000000000000000000000000000000A2A2
|
||||
A2FFBCBCBCFFCACACAFFCCCCCCFFCACACAFFC2C2C2FFADADADFF8C8C8CFF0000
|
||||
0000000000000000000000000000000000000000000000000000A1A1A1FFC4C4
|
||||
C4FFBEBEBEFFA1A1A1FF969696FF939393FF979797FFAEAEAEFFAEAEAEFF8484
|
||||
84FF000000000000000000000000000000000000000000000000BABABAFFBFBF
|
||||
BFFF989898FF00000000000000000000000000000000878787FFA8A8A8FF9E9E
|
||||
9EFF00000000000000000000000000000000000000009D9D9DFFC4C4C4FFA1A1
|
||||
A1FF000000000000000000000000000000000000000000000000898989FFA9A9
|
||||
A9FF797979FF00000000000000000000000000000000999999FFC6C6C6FF9494
|
||||
94FF0000000000000000000000000000000000000000000000007D7D7DFFABAB
|
||||
ABFF767676FF00000000000000000000000061C3E1FF88A0A8FF919191FF8E8E
|
||||
8EFF5AB9DCFF55B8DFFF51B5DEFF4DB1DDFF49ADDCFF46A8D7FF787878FF7676
|
||||
76FF657E8DFF3199D8FF000000000000000060C2E1FFC9F3FCFFCBF3FDFFD4F6
|
||||
FEFFD7F6FFFFD8F4FFFFE0F8FFFFDFF8FFFFDAF5FFFFCDF1FCFFC2EDFAFFBDEB
|
||||
FAFFBDEBFAFF2B93D6FF00000000000000005CBFE0FFC8F3FCFF75DFF9FF89E6
|
||||
FDFF95E7FFFF9AE5FFFFAAEEFFFFA8EDFFFF99E3FFFF74D5F9FF59CCF3FF4FC8
|
||||
F1FFBBE9FAFF248DD5FF000000000000000058BBDFFFC7F1FCFF6FDCF9FF56BB
|
||||
EDFF61BDEFFF9BE7FFFF35A6E2FF4BA4E1FF90E2FFFF49ADE9FF38A4E3FF49C4
|
||||
F0FFB8E8F9FF1E88D4FF000000000000000053B7DEFFC6F0FCFF6AD9F8FF7CE2
|
||||
FDFF90E8FFFF99E9FFFF329FDFFF548BB2FF8AE2FFFF6AD0F9FF50C5F1FF46C1
|
||||
F0FFB6E7F9FF1883D3FF00000000000000004EB2DDFFC3EFFBFF65D6F8FF4CB6
|
||||
ECFF5ABDEFFF95EBFFFF3097DDFF4D82ABFF84E1FFFF41A9E9FF329FE1FF42BE
|
||||
EFFFB4E5F9FF137ED2FF000000000000000049ADDCFFC1EEFBFF5FD3F7FF6CDB
|
||||
FCFF7FE5FFFF8FEDFFFF97F2FFFF93EDFFFF7CDFFFFF5BCCF8FF46BEEFFF3CBA
|
||||
EEFFB3E3F9FF0E79D1FF000000000000000043A8DBFFBFECFBFF59CFF5FF41B0
|
||||
ECFF4EBAEFFF5AC2EFFF60C6EFFF5CC4EFFF4CB6EFFF37A5E6FF2A9AE1FF38B8
|
||||
EEFFB1E3F8FF0975D0FF00000000000000003DA3DAFFBCEBFAFFBCEBFCFFBFEE
|
||||
FEFFC6F4FFFFCEF8FFFFD3FAFFFFD0F8FFFFC7F2FFFFBAE9FCFFB3E4F9FFB0E2
|
||||
F8FFB0E2F8FF0571CFFF0000000000000000369DD9FF3199D8FF2C94D7FF2890
|
||||
D6FF238CD5FF1E88D4FF1A84D3FF1580D2FF117CD1FF0E79D1FF0A76D0FF0773
|
||||
CFFF0470CFFF016ECEFF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000005F63
|
||||
69FF284D7DFF2D6196FF0F4988FF2C6093FF0C3E73FF1B3D60FF595E63FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000003752
|
||||
79FF255A93FF0C3E76FF245485FF0E3E73FF265584FF163E69FF143050FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001136
|
||||
67FF2A4B71FF4C759EFF3B638EFF11355BFF28527BFF1C3959FF103255FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001848
|
||||
78FF9BB7D1FFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFF96B3CEFF1A4C7EFF0000
|
||||
000000000000000000000000000000000000000000000000000000000000305D
|
||||
8FFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2E629AFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000003D3D
|
||||
3DFF416F9EFF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF4176A6FF373737FF0000
|
||||
0000000000000000000000000000000000000000000000000000494949FF4B4B
|
||||
4BFF989898FF5C5C5CFF557CA3FF557CA3FF4C4C4CFF989898FF4E4E4EFF4C4C
|
||||
4CFF0000000000000000000000000000000000000000777777FF4C4C4CFF4E4E
|
||||
4EFF979797FF595959FFABABABFFA5A5A5FF545454FF868686FF626262FF4A4A
|
||||
4AFF0000000000000000000000000000000000000000636363FFA4A4A4FF5050
|
||||
50FF525252FF5B5B5BFFB8B8B8FFC1C1C1FF575757FF4D4D4DFF5A5A5AFF7E7E
|
||||
7EFF606060FF000000000000000000000000287CCEFF78B3EAFF7A7A7AFF8383
|
||||
83FF7E7E7EFF5D5D5DFF494949FF4C4C4CFF555555FF646464FF5F5F5FFF6D6D
|
||||
6DFF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF5F5F5FFF8F8F
|
||||
8FFF7A7A7AFF777777FF6D6D6DFF4E4E4EFF727272FF6F6F6FFF848484FF5555
|
||||
55FF83BCEFFF2A77CAFF0000000000000000000000002579CDFF5E5E5EFF4F4F
|
||||
4FFF848484FF848484FF808080FF545454FF838383FF848484FF4A4A4AFF4545
|
||||
45FF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000003D3D
|
||||
3DFF4D4D4DFF494949FF474747FF474747FF454545FF474747FF383838FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000027B2E5FF1BA7F3FF1CACF4FF1CA8F4FF1BA1F1FF27ACDEFF000000000000
|
||||
00000000000000000000000000000000000000000000000000000000000028B5
|
||||
E5FF1BB6F5FF1CB6F5FF1CB6F5FF1CB2F5FF1CABF4FF1DAAF0FF28B0E0FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001DBA
|
||||
F5FF1CB6F5FF1CAAF4FF1CACF4FF1CACF4FF1CACF3FF1CA1F0FF1C93E4FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001B9E
|
||||
F3FF62ABCEFF8AB7E4FF3EC6EBFF1C9FEDFF1DA4EEFF1EA5EBFF1C9AE9FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001E6D
|
||||
ADFFBDD7EFFFA3C9EDFF9DC5E8FF44CEEFFF5BCDEFFFA8DCF1FF207CBDFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000002C61
|
||||
8EFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D6299FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000004C72
|
||||
49FF347499FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF357AA1FF4A6A46FF0000
|
||||
000000000000000000000000000000000000000000000000000079935DFF2785
|
||||
4EFFB3F5C8FF49898FFF4B7FA0FF4B7FA0FF49898FFFA9E8BAFF26844DFF738C
|
||||
59FF0000000000000000000000000000000000000000AFE0ACFF37945DFF9FFD
|
||||
C6FF91EFB8FF78D69FFF6FCD96FF69C68FFF62BF88FF73CF98FF94F0B9FF3088
|
||||
51FF788754FF000000000000000000000000849D6CFF45A26BFF82E0A9FF82E0
|
||||
A9FF6FCD96FF69C790FF64C28BFF5EBC85FF57B57EFF50AE77FF6BC891FF67C0
|
||||
8AFF4F9A66FF769264FF0000000000000000287CCEFF78B3EAFF5AB881FF62C0
|
||||
89FF62C089FF5FBD86FF5AB881FF55B37CFF4FAD76FF49A770FF419E67FF4DAB
|
||||
74FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF409E67FF6ECC
|
||||
95FF5BB881FF58B57EFF53B17AFF4FAC75FF54B17AFF51AD76FF67C18AFF3B92
|
||||
5CFF83BCEFFF2A77CAFF0000000000000000000000002579CDFF429D67FF318F
|
||||
58FF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF2D8A53FF2F88
|
||||
53FF2E7ECEFF6DA2D3FF0000000000000000000000000000000000000000668C
|
||||
57FF428B55FF338952FF2E8851FF2D8750FF2E854EFF39854EFF4F824EFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000005F63
|
||||
69FF284D7DFF0F498AFF0F4988FF0E4581FF0C3E73FF1B3D60FF595E63FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000003752
|
||||
79FF0F498FFF0C3E76FF0C3E73FF0E3E73FF113F70FF0F3661FF143050FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001037
|
||||
73FF7893B5FF8AB7E4FF6793C3FF11355BFF15395FFF1C3959FF103255FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001F5C
|
||||
99FFBDD7EFFFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFFB7D3EBFF2365A4FF0000
|
||||
000000000000000000000000000000000000000000000000000000000000395F
|
||||
89FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2F6299FF0000
|
||||
000000000000000000000000000000000000000000000000000000000000966B
|
||||
3EFF537291FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF51799AFF8C643CFF0000
|
||||
0000000000000000000000000000000000000000000000000000A57645FFB17D
|
||||
3FFFD8BEA0FF968271FF5572A4FF435EB5FFA2795FFFD9BEA0FFB48042FFA875
|
||||
46FF0000000000000000000000000000000000000000C29A70FFB27D41FFB480
|
||||
42FFDCBF9EFFBE8A4CFFC4B6BCFF5E67C8FFB3814DFFD3B088FFC29159FFAF7A
|
||||
3EFF9F6F41FF000000000000000000000000A5774AFFC3925BFFE2CAB0FFB682
|
||||
44FFB78345FFB88855FF4A5BD0FF5060D2FFBA874CFFB37F41FFBF8A4EFFD0A9
|
||||
7DFFBE8D57FF9C6F46FF0000000000000000287CCEFF78B3EAFFCEA679FFD2AE
|
||||
83FFD0A97DFFB78859FF4D4EA6FF77627CFFB6844BFFC4935CFFC18E55FFC79A
|
||||
67FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFFC18F55FFD8B9
|
||||
94FFCEA678FFCCA375FFBA9370FFB27F44FFCA9F6EFFC89C69FFD3AE85FFB884
|
||||
49FF83BCEFFF2A77CAFF0000000000000000000000002579CDFFC08E54FFB581
|
||||
43FFD3AF85FFD3AF85FFD1AB7FFFB98547FFD2AE83FFD3AF85FFB07B3FFFA976
|
||||
3CFF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000009966
|
||||
34FFAF7A41FFAE793DFFAD783CFFAD783CFFAA7539FFAA753CFF936131FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000
|
||||
}
|
||||
end
|
||||
end
|
||||
object frmAccountControl: TfrmAccountControl
|
||||
Left = 290
|
||||
Height = 378
|
||||
Top = 171
|
||||
Width = 369
|
||||
ActiveControl = vstAccounts
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Account Management'
|
||||
ClientHeight = 378
|
||||
ClientWidth = 369
|
||||
Font.Height = -11
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
Position = poOwnerFormCenter
|
||||
LCLVersion = '0.9.29'
|
||||
object tbMain: TToolBar
|
||||
Left = 0
|
||||
Height = 26
|
||||
Top = 0
|
||||
Width = 369
|
||||
Caption = 'tbMain'
|
||||
Images = ilToolbar
|
||||
TabOrder = 0
|
||||
object tbRefresh: TToolButton
|
||||
Left = 1
|
||||
Hint = 'Refresh'
|
||||
Top = 2
|
||||
Caption = 'Refresh'
|
||||
ImageIndex = 0
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbRefreshClick
|
||||
end
|
||||
object tbAddUser: TToolButton
|
||||
Left = 32
|
||||
Hint = 'Add User'
|
||||
Top = 2
|
||||
Caption = 'Add User'
|
||||
ImageIndex = 1
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbAddUserClick
|
||||
end
|
||||
object tbEditUser: TToolButton
|
||||
Left = 55
|
||||
Hint = 'Edit User'
|
||||
Top = 2
|
||||
Caption = 'Edit User'
|
||||
ImageIndex = 2
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbEditUserClick
|
||||
end
|
||||
object tbDeleteUser: TToolButton
|
||||
Left = 78
|
||||
Hint = 'Delete User'
|
||||
Top = 2
|
||||
Caption = 'Delete User'
|
||||
ImageIndex = 3
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
OnClick = tbDeleteUserClick
|
||||
end
|
||||
object tbSeparator1: TToolButton
|
||||
Left = 24
|
||||
Top = 2
|
||||
Width = 8
|
||||
Caption = 'tbSeparator1'
|
||||
Style = tbsDivider
|
||||
end
|
||||
end
|
||||
object vstAccounts: TVirtualStringTree
|
||||
Left = 0
|
||||
Height = 352
|
||||
Top = 26
|
||||
Width = 369
|
||||
Align = alClient
|
||||
DefaultText = 'Node'
|
||||
Header.AutoSizeIndex = 1
|
||||
Header.Columns = <
|
||||
item
|
||||
Position = 0
|
||||
Width = 30
|
||||
end
|
||||
item
|
||||
Position = 1
|
||||
Text = 'Username'
|
||||
Width = 200
|
||||
end
|
||||
item
|
||||
Position = 2
|
||||
Text = 'Accesslevel'
|
||||
Width = 100
|
||||
end>
|
||||
Header.DefaultHeight = 17
|
||||
Header.Options = [hoColumnResize, hoDrag, hoVisible]
|
||||
Header.ParentFont = True
|
||||
Header.Style = hsFlatButtons
|
||||
Images = ilAccesslevel
|
||||
TabOrder = 1
|
||||
TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
|
||||
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
|
||||
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
|
||||
TreeOptions.SelectionOptions = [toFullRowSelect]
|
||||
OnDblClick = vstAccountsDblClick
|
||||
OnFreeNode = vstAccountsFreeNode
|
||||
OnGetText = vstAccountsGetText
|
||||
OnGetImageIndex = vstAccountsGetImageIndex
|
||||
end
|
||||
object ilToolbar: TImageList
|
||||
left = 144
|
||||
Bitmap = {
|
||||
4C69040000001000000010000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000047994FFF419149FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000005BB4
|
||||
65FF56AD5FFF50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3AFF0000
|
||||
000000000000000000000000000000000000000000005EB968FF79C383FF89CA
|
||||
92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D
|
||||
2CFF000000000000000000000000000000005CB667FF85C98EFF9BD4A4FF8FCE
|
||||
98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265
|
||||
25FF0000000000000000000000000000000075BF7EFF98D2A1FF94CF9CFF86C7
|
||||
8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF206324FF0000
|
||||
000000000000000000000000000054AB5EFF80C389FF8DCC95FF83C48AFF3D8B
|
||||
44FF37833EFF000000000000000000000000236627FF1F6123FF000000000000
|
||||
00000000000000000000000000004DA155FF47994FFF419149FF3B8842FF3580
|
||||
3CFF000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000000000004DA155FF4799
|
||||
4FFF419149FF3B8842FF35803CFF000000000000000000000000000000000000
|
||||
000063C06EFF5FBB6AFF0000000000000000000000004B9E53FF45964DFF86C6
|
||||
8EFF88C98FFF6FB376FF2E7633FF0000000000000000000000000000000062BE
|
||||
6DFF7BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9
|
||||
8FFF82C689FF509756FF0000000000000000000000000000000060BC6CFF79C4
|
||||
83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4
|
||||
85FF5DA463FF266B2AFF000000000000000000000000000000005BB465FF73BD
|
||||
7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92
|
||||
51FF246829FF0000000000000000000000000000000000000000000000004EA3
|
||||
57FF66B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432FF276D2CFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000419149FF3B8842FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000F4B
|
||||
97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000C3E
|
||||
87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001F5E
|
||||
9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000002A5B
|
||||
92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000006A3C
|
||||
25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000
|
||||
000000000000000000000000000000000000000000000000000000000000BC48
|
||||
1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000
|
||||
0000000000000000000000000000000000000000000000000000C44C1FFFF6E4
|
||||
D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFFAEAB78FF609772FF4F8E
|
||||
66FF428357FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1
|
||||
98FFFEC76DFFFEBF68FFFEB964FFFEB15EFFA79B61FF61AB81FF95D4B4FFBAE6
|
||||
D0FF6ABB8FFF2D8F57FF196B37FF00000000287CCEFF78B3EAFFB39E94FFFFB7
|
||||
60FFFFB663FFFEB261FFFEAC5DFFFEA559FF4A885DFF90D3B1FF92D6B1FFFFFF
|
||||
FFFF65BC8CFF67BC8FFF196B37FF00000000297DD1FF82BAEEFF9F6658FFF5BB
|
||||
84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF317B4CFF9CD4B6FFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF95D2B2FF196B37FF00000000000000002579CDFF866161FFBF60
|
||||
35FFFEB961FFFEB962FFFEB962FFFEB962FF226E3AFF62BA8BFF60BA87FFFFFF
|
||||
FFFF60B987FF67BC8FFF196B37FF00000000000000000000000000000000B350
|
||||
20FFA0401FFFAA4522FFAC4622FFAB4422FF5C572DFF288C53FF64BA8DFF95D2
|
||||
B2FF64BA8DFF288C53FF196B37FF000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000196B37FF196B37FF196B
|
||||
37FF196B37FF196B37FF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000012488DFF104B90FF0F488AFF11427DFF15335BFF00000000000000000000
|
||||
000000000000000000000000000000000000000000000000000000000000114E
|
||||
96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF000000000000
|
||||
00000000000000000000000000000000000000000000000000000F4B97FF1258
|
||||
9FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF000000000000
|
||||
00000000000000000000000000000000000000000000000000000C3E87FF7C97
|
||||
B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF000000000000
|
||||
00000000000000000000000000000000000000000000000000001F5E9BFFD9E8
|
||||
F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000000058A5
|
||||
D8FF85B1DBFF469DD0FF000000000000000000000000000000002A5B92FFA6CA
|
||||
EEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2884B7FF77BEE7FFB4D2
|
||||
F0FFE5F3FFFFACD2EFFF488CC7FF0000000000000000000000006A3C25FF346D
|
||||
A7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF2E8ABFFF7ED3EBFFB2E3F9FF8BC0
|
||||
E7FFAED3F6FFC4E0FCFF669FD3FF000000000000000000000000BC481CFFF4E2
|
||||
D4FF4E7BA9FF4D7BA8FF4D7BA8FF428CBAFF7DD4EEFFC4F6FDFF6CDDF6FF6DCA
|
||||
EDFF63A3D7FF5D9BD2FF000000000000000000000000C44C1FFFF6E4D6FFFFE4
|
||||
A4FFFFD472FFFFC969FFBFBB86FF79D3EEFFC7F7FDFF5FDCF5FF5BE2F7FF7AD6
|
||||
F2FF4099DFFF0000000000000000000000008A5444FFFCC8ABFFFFD198FFFEC7
|
||||
6DFFFEBF68FFB0A780FF77CBE7FFC7F7FDFF5EDCF5FF5AE1F7FF7BD4F1FF4691
|
||||
D4FF686672FF0000000000000000287CCEFF78B3EAFFB39E94FFFFB760FFFFB6
|
||||
63FFB3A37DFF76B8D3FFC2F6FDFF63DFF7FF5DE2F8FF79D3F0FF4795D8FF75B2
|
||||
EAFF2974C7FF0000000000000000297DD1FF82BAEEFF9F6658FFF5BB84FFA792
|
||||
74FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0EDFF5196D2FF96645DFF83BC
|
||||
EFFF2A77CAFF0000000000000000000000002579CDFF866161FFBF6035FF4389
|
||||
AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF4988B7FF9C5442FF7A646DFF2E7E
|
||||
CEFF6DA2D3FF0000000000000000000000000000000000000000B35020FF2D64
|
||||
81FF94C7F9FF91C9F9FF4185C9FF2362A4FF89493DFFB24F24FF000000000000
|
||||
000000000000000000000000000000000000000000000000000000000000113D
|
||||
55FF285F87FF4988BDFF428DBCFF000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000F4B
|
||||
97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000C3E
|
||||
87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001F5E
|
||||
9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000002A5B
|
||||
92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000006A3C
|
||||
25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000
|
||||
000000000000000000000000000000000000000000000000000000000000BC48
|
||||
1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000
|
||||
0000000000000000000000000000000000000000000000000000C44C1FFFF6E4
|
||||
D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFF9590A0FF295DC1FF0542
|
||||
BBFF0B45B0FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1
|
||||
98FFFEC76DFFFEBF68FFFEB964FFFEB15EFF95828BFF3D74CEFF8DB5F7FFB8D6
|
||||
FEFF72A8F5FF2D6BCAFF0000000000000000287CCEFF78B3EAFFB39E94FFFFB7
|
||||
60FFFFB663FFFEB261FFFEAC5DFFFEA559FF2450ABFF8DB5F6FF4D92FFFF1177
|
||||
FFFF2186FFFF408AEBFF0344B9FF00000000297DD1FF82BAEEFF9F6658FFF5BB
|
||||
84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF0542BCFFAECDFEFFFFFFFFFFFFFF
|
||||
FFFFFFFFFFFF187FEFFF0442BCFF00000000000000002579CDFF866161FFBF60
|
||||
35FFFEB961FFFEB962FFFEB962FFFEB962FF1F52AFFF639DF4FF187FFFFF0076
|
||||
F8FF0076EEFF0368E1FF0345B9FF00000000000000000000000000000000B350
|
||||
20FFA0401FFFAA4522FFAC4622FFAB4422FF5F4C74FF2763C6FF2177E6FF0579
|
||||
EAFF0164DDFF044DBDFF00000000000000000000000000000000000000000000
|
||||
00000000000000000000000000000000000000000000000000000345B9FF0442
|
||||
BCFF0345B9FF0000000000000000
|
||||
}
|
||||
end
|
||||
object ilAccesslevel: TImageList
|
||||
left = 176
|
||||
Bitmap = {
|
||||
4C69040000001000000010000000000000000000000000000000000000000000
|
||||
0000A3A3A3FFA0A0A0FF9D9D9DFF9A9A9AFF979797FF949494FF000000000000
|
||||
000000000000000000000000000000000000000000000000000000000000A2A2
|
||||
A2FFBCBCBCFFCACACAFFCCCCCCFFCACACAFFC2C2C2FFADADADFF8C8C8CFF0000
|
||||
0000000000000000000000000000000000000000000000000000A1A1A1FFC4C4
|
||||
C4FFBEBEBEFFA1A1A1FF969696FF939393FF979797FFAEAEAEFFAEAEAEFF8484
|
||||
84FF000000000000000000000000000000000000000000000000BABABAFFBFBF
|
||||
BFFF989898FF00000000000000000000000000000000878787FFA8A8A8FF9E9E
|
||||
9EFF00000000000000000000000000000000000000009D9D9DFFC4C4C4FFA1A1
|
||||
A1FF000000000000000000000000000000000000000000000000898989FFA9A9
|
||||
A9FF797979FF00000000000000000000000000000000999999FFC6C6C6FF9494
|
||||
94FF0000000000000000000000000000000000000000000000007D7D7DFFABAB
|
||||
ABFF767676FF00000000000000000000000061C3E1FF88A0A8FF919191FF8E8E
|
||||
8EFF5AB9DCFF55B8DFFF51B5DEFF4DB1DDFF49ADDCFF46A8D7FF787878FF7676
|
||||
76FF657E8DFF3199D8FF000000000000000060C2E1FFC9F3FCFFCBF3FDFFD4F6
|
||||
FEFFD7F6FFFFD8F4FFFFE0F8FFFFDFF8FFFFDAF5FFFFCDF1FCFFC2EDFAFFBDEB
|
||||
FAFFBDEBFAFF2B93D6FF00000000000000005CBFE0FFC8F3FCFF75DFF9FF89E6
|
||||
FDFF95E7FFFF9AE5FFFFAAEEFFFFA8EDFFFF99E3FFFF74D5F9FF59CCF3FF4FC8
|
||||
F1FFBBE9FAFF248DD5FF000000000000000058BBDFFFC7F1FCFF6FDCF9FF56BB
|
||||
EDFF61BDEFFF9BE7FFFF35A6E2FF4BA4E1FF90E2FFFF49ADE9FF38A4E3FF49C4
|
||||
F0FFB8E8F9FF1E88D4FF000000000000000053B7DEFFC6F0FCFF6AD9F8FF7CE2
|
||||
FDFF90E8FFFF99E9FFFF329FDFFF548BB2FF8AE2FFFF6AD0F9FF50C5F1FF46C1
|
||||
F0FFB6E7F9FF1883D3FF00000000000000004EB2DDFFC3EFFBFF65D6F8FF4CB6
|
||||
ECFF5ABDEFFF95EBFFFF3097DDFF4D82ABFF84E1FFFF41A9E9FF329FE1FF42BE
|
||||
EFFFB4E5F9FF137ED2FF000000000000000049ADDCFFC1EEFBFF5FD3F7FF6CDB
|
||||
FCFF7FE5FFFF8FEDFFFF97F2FFFF93EDFFFF7CDFFFFF5BCCF8FF46BEEFFF3CBA
|
||||
EEFFB3E3F9FF0E79D1FF000000000000000043A8DBFFBFECFBFF59CFF5FF41B0
|
||||
ECFF4EBAEFFF5AC2EFFF60C6EFFF5CC4EFFF4CB6EFFF37A5E6FF2A9AE1FF38B8
|
||||
EEFFB1E3F8FF0975D0FF00000000000000003DA3DAFFBCEBFAFFBCEBFCFFBFEE
|
||||
FEFFC6F4FFFFCEF8FFFFD3FAFFFFD0F8FFFFC7F2FFFFBAE9FCFFB3E4F9FFB0E2
|
||||
F8FFB0E2F8FF0571CFFF0000000000000000369DD9FF3199D8FF2C94D7FF2890
|
||||
D6FF238CD5FF1E88D4FF1A84D3FF1580D2FF117CD1FF0E79D1FF0A76D0FF0773
|
||||
CFFF0470CFFF016ECEFF00000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000005F63
|
||||
69FF284D7DFF2D6196FF0F4988FF2C6093FF0C3E73FF1B3D60FF595E63FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000003752
|
||||
79FF255A93FF0C3E76FF245485FF0E3E73FF265584FF163E69FF143050FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001136
|
||||
67FF2A4B71FF4C759EFF3B638EFF11355BFF28527BFF1C3959FF103255FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001848
|
||||
78FF9BB7D1FFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFF96B3CEFF1A4C7EFF0000
|
||||
000000000000000000000000000000000000000000000000000000000000305D
|
||||
8FFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2E629AFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000003D3D
|
||||
3DFF416F9EFF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF4176A6FF373737FF0000
|
||||
0000000000000000000000000000000000000000000000000000494949FF4B4B
|
||||
4BFF989898FF5C5C5CFF557CA3FF557CA3FF4C4C4CFF989898FF4E4E4EFF4C4C
|
||||
4CFF0000000000000000000000000000000000000000777777FF4C4C4CFF4E4E
|
||||
4EFF979797FF595959FFABABABFFA5A5A5FF545454FF868686FF626262FF4A4A
|
||||
4AFF0000000000000000000000000000000000000000636363FFA4A4A4FF5050
|
||||
50FF525252FF5B5B5BFFB8B8B8FFC1C1C1FF575757FF4D4D4DFF5A5A5AFF7E7E
|
||||
7EFF606060FF000000000000000000000000287CCEFF78B3EAFF7A7A7AFF8383
|
||||
83FF7E7E7EFF5D5D5DFF494949FF4C4C4CFF555555FF646464FF5F5F5FFF6D6D
|
||||
6DFF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF5F5F5FFF8F8F
|
||||
8FFF7A7A7AFF777777FF6D6D6DFF4E4E4EFF727272FF6F6F6FFF848484FF5555
|
||||
55FF83BCEFFF2A77CAFF0000000000000000000000002579CDFF5E5E5EFF4F4F
|
||||
4FFF848484FF848484FF808080FF545454FF838383FF848484FF4A4A4AFF4545
|
||||
45FF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000003D3D
|
||||
3DFF4D4D4DFF494949FF474747FF474747FF454545FF474747FF383838FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
000027B2E5FF1BA7F3FF1CACF4FF1CA8F4FF1BA1F1FF27ACDEFF000000000000
|
||||
00000000000000000000000000000000000000000000000000000000000028B5
|
||||
E5FF1BB6F5FF1CB6F5FF1CB6F5FF1CB2F5FF1CABF4FF1DAAF0FF28B0E0FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001DBA
|
||||
F5FF1CB6F5FF1CAAF4FF1CACF4FF1CACF4FF1CACF3FF1CA1F0FF1C93E4FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001B9E
|
||||
F3FF62ABCEFF8AB7E4FF3EC6EBFF1C9FEDFF1DA4EEFF1EA5EBFF1C9AE9FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001E6D
|
||||
ADFFBDD7EFFFA3C9EDFF9DC5E8FF44CEEFFF5BCDEFFFA8DCF1FF207CBDFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000002C61
|
||||
8EFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D6299FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000004C72
|
||||
49FF347499FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF357AA1FF4A6A46FF0000
|
||||
000000000000000000000000000000000000000000000000000079935DFF2785
|
||||
4EFFB3F5C8FF49898FFF4B7FA0FF4B7FA0FF49898FFFA9E8BAFF26844DFF738C
|
||||
59FF0000000000000000000000000000000000000000AFE0ACFF37945DFF9FFD
|
||||
C6FF91EFB8FF78D69FFF6FCD96FF69C68FFF62BF88FF73CF98FF94F0B9FF3088
|
||||
51FF788754FF000000000000000000000000849D6CFF45A26BFF82E0A9FF82E0
|
||||
A9FF6FCD96FF69C790FF64C28BFF5EBC85FF57B57EFF50AE77FF6BC891FF67C0
|
||||
8AFF4F9A66FF769264FF0000000000000000287CCEFF78B3EAFF5AB881FF62C0
|
||||
89FF62C089FF5FBD86FF5AB881FF55B37CFF4FAD76FF49A770FF419E67FF4DAB
|
||||
74FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF409E67FF6ECC
|
||||
95FF5BB881FF58B57EFF53B17AFF4FAC75FF54B17AFF51AD76FF67C18AFF3B92
|
||||
5CFF83BCEFFF2A77CAFF0000000000000000000000002579CDFF429D67FF318F
|
||||
58FF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF2D8A53FF2F88
|
||||
53FF2E7ECEFF6DA2D3FF0000000000000000000000000000000000000000668C
|
||||
57FF428B55FF338952FF2E8851FF2D8750FF2E854EFF39854EFF4F824EFF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000005F63
|
||||
69FF284D7DFF0F498AFF0F4988FF0E4581FF0C3E73FF1B3D60FF595E63FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000003752
|
||||
79FF0F498FFF0C3E76FF0C3E73FF0E3E73FF113F70FF0F3661FF143050FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001037
|
||||
73FF7893B5FF8AB7E4FF6793C3FF11355BFF15395FFF1C3959FF103255FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000001F5C
|
||||
99FFBDD7EFFFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFFB7D3EBFF2365A4FF0000
|
||||
000000000000000000000000000000000000000000000000000000000000395F
|
||||
89FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2F6299FF0000
|
||||
000000000000000000000000000000000000000000000000000000000000966B
|
||||
3EFF537291FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF51799AFF8C643CFF0000
|
||||
0000000000000000000000000000000000000000000000000000A57645FFB17D
|
||||
3FFFD8BEA0FF968271FF5572A4FF435EB5FFA2795FFFD9BEA0FFB48042FFA875
|
||||
46FF0000000000000000000000000000000000000000C29A70FFB27D41FFB480
|
||||
42FFDCBF9EFFBE8A4CFFC4B6BCFF5E67C8FFB3814DFFD3B088FFC29159FFAF7A
|
||||
3EFF9F6F41FF000000000000000000000000A5774AFFC3925BFFE2CAB0FFB682
|
||||
44FFB78345FFB88855FF4A5BD0FF5060D2FFBA874CFFB37F41FFBF8A4EFFD0A9
|
||||
7DFFBE8D57FF9C6F46FF0000000000000000287CCEFF78B3EAFFCEA679FFD2AE
|
||||
83FFD0A97DFFB78859FF4D4EA6FF77627CFFB6844BFFC4935CFFC18E55FFC79A
|
||||
67FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFFC18F55FFD8B9
|
||||
94FFCEA678FFCCA375FFBA9370FFB27F44FFCA9F6EFFC89C69FFD3AE85FFB884
|
||||
49FF83BCEFFF2A77CAFF0000000000000000000000002579CDFFC08E54FFB581
|
||||
43FFD3AF85FFD3AF85FFD1AB7FFFB98547FFD2AE83FFD3AF85FFB07B3FFFA976
|
||||
3CFF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000009966
|
||||
34FFAF7A41FFAE793DFFAD783CFFAD783CFFAA7539FFAA753CFF936131FF0000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
+411
-411
@@ -1,411 +1,411 @@
|
||||
(*
|
||||
* 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 2008 Andreas Schneider
|
||||
*)
|
||||
unit UfrmAccountControl;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
||||
VirtualTrees, Math, UEnhancedMemoryStream, UEnums;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmAccountControl }
|
||||
|
||||
TfrmAccountControl = class(TForm)
|
||||
ilToolbar: TImageList;
|
||||
ilAccesslevel: TImageList;
|
||||
tbMain: TToolBar;
|
||||
tbRefresh: TToolButton;
|
||||
tbAddUser: TToolButton;
|
||||
tbEditUser: TToolButton;
|
||||
tbDeleteUser: TToolButton;
|
||||
tbSeparator1: TToolButton;
|
||||
vstAccounts: TVirtualStringTree;
|
||||
procedure tbEditUserClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure tbAddUserClick(Sender: TObject);
|
||||
procedure tbDeleteUserClick(Sender: TObject);
|
||||
procedure tbRefreshClick(Sender: TObject);
|
||||
procedure vstAccountsDblClick(Sender: TObject);
|
||||
procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||
procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||
procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
|
||||
protected
|
||||
procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
|
||||
function FindNode(AUsername: string): PVirtualNode;
|
||||
end;
|
||||
|
||||
var
|
||||
frmAccountControl: TfrmAccountControl;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount;
|
||||
|
||||
type
|
||||
PAccountInfo = ^TAccountInfo;
|
||||
TAccountInfo = record
|
||||
Username: string;
|
||||
AccessLevel: TAccessLevel;
|
||||
Regions: TStringList;
|
||||
end;
|
||||
|
||||
{ TModifyUserPacket }
|
||||
|
||||
TModifyUserPacket = class(TPacket)
|
||||
constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel;
|
||||
ARegions: TStrings);
|
||||
end;
|
||||
|
||||
{ TDeleteUserPacket }
|
||||
|
||||
TDeleteUserPacket = class(TPacket)
|
||||
constructor Create(AUsername: string);
|
||||
end;
|
||||
|
||||
{ TRequestUserListPacket }
|
||||
|
||||
TRequestUserListPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TModifyUserPacket }
|
||||
|
||||
constructor TModifyUserPacket.Create(AUsername, APassword: string;
|
||||
AAccessLevel: TAccessLevel; ARegions: TStrings);
|
||||
var
|
||||
regionCount: Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create($03, 0);
|
||||
FStream.WriteByte($05);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
FStream.WriteStringNull(APassword);
|
||||
FStream.WriteByte(Byte(AAccessLevel));
|
||||
|
||||
regionCount := Min(ARegions.Count, 256);
|
||||
FStream.WriteByte(regionCount);
|
||||
|
||||
for i := 0 to regionCount - 1 do
|
||||
FStream.WriteStringNull(ARegions.Strings[i]);
|
||||
end;
|
||||
|
||||
{ TDeleteUserPacket }
|
||||
|
||||
constructor TDeleteUserPacket.Create(AUsername: string);
|
||||
begin
|
||||
inherited Create($03, 0);
|
||||
FStream.WriteByte($06);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
end;
|
||||
|
||||
{ TRequestUserListPacket }
|
||||
|
||||
constructor TRequestUserListPacket.Create;
|
||||
begin
|
||||
inherited Create($03, 0);
|
||||
FStream.WriteByte($07);
|
||||
end;
|
||||
|
||||
{ TfrmAccountControl }
|
||||
|
||||
procedure TfrmAccountControl.FormCreate(Sender: TObject);
|
||||
begin
|
||||
vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
|
||||
|
||||
AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
|
||||
AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
|
||||
AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caHide;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
|
||||
var
|
||||
selected: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
regions: TStrings;
|
||||
begin
|
||||
selected := vstAccounts.GetFirstSelected;
|
||||
if selected <> nil then
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(selected);
|
||||
with frmEditAccount do
|
||||
begin
|
||||
edUsername.Text := accountInfo^.Username;
|
||||
edUsername.Color := clBtnFace;
|
||||
edUsername.ReadOnly := True;
|
||||
edPassword.Text := '';
|
||||
lblPasswordHint.Visible := True;
|
||||
SetAccessLevel(accountInfo^.AccessLevel);
|
||||
SetRegions(accountInfo^.Regions);
|
||||
if ShowModal = mrOK then
|
||||
begin
|
||||
regions := GetRegions;
|
||||
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text,
|
||||
edPassword.Text, GetAccessLevel, regions));
|
||||
regions.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]);
|
||||
if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]);
|
||||
if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.FormShow(Sender: TObject);
|
||||
begin
|
||||
tbRefreshClick(Sender);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
|
||||
var
|
||||
regions: TStrings;
|
||||
begin
|
||||
with frmEditAccount do
|
||||
begin
|
||||
edUsername.Text := '';
|
||||
edUsername.Color := clWindow;
|
||||
edUsername.ReadOnly := False;
|
||||
edPassword.Text := '';
|
||||
lblPasswordHint.Visible := False;
|
||||
cbAccessLevel.ItemIndex := 2;
|
||||
SetRegions(nil);
|
||||
if ShowModal = mrOK then
|
||||
begin
|
||||
regions := GetRegions;
|
||||
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text,
|
||||
GetAccessLevel, regions));
|
||||
regions.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject);
|
||||
var
|
||||
selected: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
selected := vstAccounts.GetFirstSelected;
|
||||
if selected <> nil then
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(selected);
|
||||
if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?',
|
||||
[accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
|
||||
dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbRefreshClick(Sender: TObject);
|
||||
begin
|
||||
dmNetwork.Send(TRequestUserListPacket.Create);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
|
||||
begin
|
||||
tbEditUserClick(Sender);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode);
|
||||
var
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(Node);
|
||||
accountInfo^.Username := '';
|
||||
if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||
var
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
if Column = 0 then
|
||||
begin
|
||||
accountInfo := Sender.GetNodeData(Node);
|
||||
case accountInfo^.AccessLevel of
|
||||
alNone: ImageIndex := 0;
|
||||
alView: ImageIndex := 1;
|
||||
alNormal: ImageIndex := 2;
|
||||
alAdministrator: ImageIndex := 3;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var CellText: String);
|
||||
var
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
accountInfo := Sender.GetNodeData(Node);
|
||||
case Column of
|
||||
1: CellText := accountInfo^.Username;
|
||||
2: CellText := GetAccessLevelString(accountInfo^.AccessLevel);
|
||||
else
|
||||
CellText := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
node: PVirtualNode;
|
||||
modifyStatus: TModifyUserStatus;
|
||||
username: string;
|
||||
accountInfo: PAccountInfo;
|
||||
i, regions: Integer;
|
||||
begin
|
||||
modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
|
||||
username := ABuffer.ReadStringNull;
|
||||
case modifyStatus of
|
||||
muAdded:
|
||||
begin
|
||||
node := vstAccounts.AddChild(nil);
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
accountInfo^.Username := username;
|
||||
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
accountInfo^.Regions := TStringList.Create;
|
||||
regions := ABuffer.ReadByte;
|
||||
for i := 0 to regions - 1 do
|
||||
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
|
||||
|
||||
Messagedlg('Success', Format('The user "%s" has been added.', [username]),
|
||||
mtInformation, [mbOK], 0);
|
||||
end;
|
||||
muModified:
|
||||
begin
|
||||
node := FindNode(username);
|
||||
if node <> nil then
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
accountInfo^.Regions.Clear;
|
||||
regions := ABuffer.ReadByte;
|
||||
for i := 0 to regions - 1 do
|
||||
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
|
||||
|
||||
Messagedlg('Success', Format('The user "%s" has been modified.', [username]),
|
||||
mtInformation, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
muInvalidUsername:
|
||||
MessageDlg('Error', Format('The username "%s" is not valid.', [username]),
|
||||
mtError, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
node: PVirtualNode;
|
||||
deleteStatus: TDeleteUserStatus;
|
||||
username: string;
|
||||
begin
|
||||
deleteStatus := TDeleteUserStatus(ABuffer.ReadByte);
|
||||
username := ABuffer.ReadStringNull;
|
||||
case deleteStatus of
|
||||
duDeleted:
|
||||
begin
|
||||
node := FindNode(username);
|
||||
if node <> nil then
|
||||
begin
|
||||
vstAccounts.DeleteNode(node);
|
||||
Messagedlg('Success', Format('The user "%s" has been deleted.', [username]),
|
||||
mtInformation, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
duNotFound:
|
||||
MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' +
|
||||
'your list is out of date or you tried to delete yourself.', [username]),
|
||||
mtError, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
node: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
i, j, count, regions: Integer;
|
||||
begin
|
||||
vstAccounts.BeginUpdate;
|
||||
vstAccounts.Clear;
|
||||
count := ABuffer.ReadWord;
|
||||
for i := 1 to count do
|
||||
begin
|
||||
node := vstAccounts.AddChild(nil);
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
accountInfo^.Username := ABuffer.ReadStringNull;
|
||||
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
accountInfo^.Regions := TStringList.Create;
|
||||
regions := ABuffer.ReadByte;
|
||||
for j := 0 to regions - 1 do
|
||||
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
|
||||
end;
|
||||
vstAccounts.EndUpdate;
|
||||
end;
|
||||
|
||||
function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
|
||||
var
|
||||
node: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
Result := nil;
|
||||
node := vstAccounts.GetFirst;
|
||||
while (node <> nil) and (Result = nil) do
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
if accountInfo^.Username = AUsername then
|
||||
Result := node;
|
||||
node := vstAccounts.GetNext(node);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmAccountControl.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 2008 Andreas Schneider
|
||||
*)
|
||||
unit UfrmAccountControl;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
||||
VirtualTrees, Math, UEnhancedMemoryStream, UEnums;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmAccountControl }
|
||||
|
||||
TfrmAccountControl = class(TForm)
|
||||
ilToolbar: TImageList;
|
||||
ilAccesslevel: TImageList;
|
||||
tbMain: TToolBar;
|
||||
tbRefresh: TToolButton;
|
||||
tbAddUser: TToolButton;
|
||||
tbEditUser: TToolButton;
|
||||
tbDeleteUser: TToolButton;
|
||||
tbSeparator1: TToolButton;
|
||||
vstAccounts: TVirtualStringTree;
|
||||
procedure tbEditUserClick(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure tbAddUserClick(Sender: TObject);
|
||||
procedure tbDeleteUserClick(Sender: TObject);
|
||||
procedure tbRefreshClick(Sender: TObject);
|
||||
procedure vstAccountsDblClick(Sender: TObject);
|
||||
procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
|
||||
procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||
procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
|
||||
protected
|
||||
procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
|
||||
function FindNode(AUsername: string): PVirtualNode;
|
||||
end;
|
||||
|
||||
var
|
||||
frmAccountControl: TfrmAccountControl;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount;
|
||||
|
||||
type
|
||||
PAccountInfo = ^TAccountInfo;
|
||||
TAccountInfo = record
|
||||
Username: string;
|
||||
AccessLevel: TAccessLevel;
|
||||
Regions: TStringList;
|
||||
end;
|
||||
|
||||
{ TModifyUserPacket }
|
||||
|
||||
TModifyUserPacket = class(TPacket)
|
||||
constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel;
|
||||
ARegions: TStrings);
|
||||
end;
|
||||
|
||||
{ TDeleteUserPacket }
|
||||
|
||||
TDeleteUserPacket = class(TPacket)
|
||||
constructor Create(AUsername: string);
|
||||
end;
|
||||
|
||||
{ TRequestUserListPacket }
|
||||
|
||||
TRequestUserListPacket = class(TPacket)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ TModifyUserPacket }
|
||||
|
||||
constructor TModifyUserPacket.Create(AUsername, APassword: string;
|
||||
AAccessLevel: TAccessLevel; ARegions: TStrings);
|
||||
var
|
||||
regionCount: Byte;
|
||||
i: Integer;
|
||||
begin
|
||||
inherited Create($03, 0);
|
||||
FStream.WriteByte($05);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
FStream.WriteStringNull(APassword);
|
||||
FStream.WriteByte(Byte(AAccessLevel));
|
||||
|
||||
regionCount := Min(ARegions.Count, 256);
|
||||
FStream.WriteByte(regionCount);
|
||||
|
||||
for i := 0 to regionCount - 1 do
|
||||
FStream.WriteStringNull(ARegions.Strings[i]);
|
||||
end;
|
||||
|
||||
{ TDeleteUserPacket }
|
||||
|
||||
constructor TDeleteUserPacket.Create(AUsername: string);
|
||||
begin
|
||||
inherited Create($03, 0);
|
||||
FStream.WriteByte($06);
|
||||
FStream.WriteStringNull(AUsername);
|
||||
end;
|
||||
|
||||
{ TRequestUserListPacket }
|
||||
|
||||
constructor TRequestUserListPacket.Create;
|
||||
begin
|
||||
inherited Create($03, 0);
|
||||
FStream.WriteByte($07);
|
||||
end;
|
||||
|
||||
{ TfrmAccountControl }
|
||||
|
||||
procedure TfrmAccountControl.FormCreate(Sender: TObject);
|
||||
begin
|
||||
vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
|
||||
|
||||
AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
|
||||
AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
|
||||
AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caHide;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
|
||||
var
|
||||
selected: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
regions: TStrings;
|
||||
begin
|
||||
selected := vstAccounts.GetFirstSelected;
|
||||
if selected <> nil then
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(selected);
|
||||
with frmEditAccount do
|
||||
begin
|
||||
edUsername.Text := accountInfo^.Username;
|
||||
edUsername.Color := clBtnFace;
|
||||
edUsername.ReadOnly := True;
|
||||
edPassword.Text := '';
|
||||
lblPasswordHint.Visible := True;
|
||||
SetAccessLevel(accountInfo^.AccessLevel);
|
||||
SetRegions(accountInfo^.Regions);
|
||||
if ShowModal = mrOK then
|
||||
begin
|
||||
regions := GetRegions;
|
||||
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text,
|
||||
edPassword.Text, GetAccessLevel, regions));
|
||||
regions.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
if AdminPacketHandlers[$05] <> nil then FreeAndNil(AdminPacketHandlers[$05]);
|
||||
if AdminPacketHandlers[$06] <> nil then FreeAndNil(AdminPacketHandlers[$06]);
|
||||
if AdminPacketHandlers[$07] <> nil then FreeAndNil(AdminPacketHandlers[$07]);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.FormShow(Sender: TObject);
|
||||
begin
|
||||
tbRefreshClick(Sender);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
|
||||
var
|
||||
regions: TStrings;
|
||||
begin
|
||||
with frmEditAccount do
|
||||
begin
|
||||
edUsername.Text := '';
|
||||
edUsername.Color := clWindow;
|
||||
edUsername.ReadOnly := False;
|
||||
edPassword.Text := '';
|
||||
lblPasswordHint.Visible := False;
|
||||
cbAccessLevel.ItemIndex := 2;
|
||||
SetRegions(nil);
|
||||
if ShowModal = mrOK then
|
||||
begin
|
||||
regions := GetRegions;
|
||||
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text,
|
||||
GetAccessLevel, regions));
|
||||
regions.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbDeleteUserClick(Sender: TObject);
|
||||
var
|
||||
selected: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
selected := vstAccounts.GetFirstSelected;
|
||||
if selected <> nil then
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(selected);
|
||||
if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?',
|
||||
[accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
|
||||
dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.tbRefreshClick(Sender: TObject);
|
||||
begin
|
||||
dmNetwork.Send(TRequestUserListPacket.Create);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
|
||||
begin
|
||||
tbEditUserClick(Sender);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsFreeNode(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode);
|
||||
var
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(Node);
|
||||
accountInfo^.Username := '';
|
||||
if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions);
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
|
||||
var Ghosted: Boolean; var ImageIndex: Integer);
|
||||
var
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
if Column = 0 then
|
||||
begin
|
||||
accountInfo := Sender.GetNodeData(Node);
|
||||
case accountInfo^.AccessLevel of
|
||||
alNone: ImageIndex := 0;
|
||||
alView: ImageIndex := 1;
|
||||
alNormal: ImageIndex := 2;
|
||||
alAdministrator: ImageIndex := 3;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.vstAccountsGetText(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var CellText: String);
|
||||
var
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
accountInfo := Sender.GetNodeData(Node);
|
||||
case Column of
|
||||
1: CellText := accountInfo^.Username;
|
||||
2: CellText := GetAccessLevelString(accountInfo^.AccessLevel);
|
||||
else
|
||||
CellText := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
node: PVirtualNode;
|
||||
modifyStatus: TModifyUserStatus;
|
||||
username: string;
|
||||
accountInfo: PAccountInfo;
|
||||
i, regions: Integer;
|
||||
begin
|
||||
modifyStatus := TModifyUserStatus(ABuffer.ReadByte);
|
||||
username := ABuffer.ReadStringNull;
|
||||
case modifyStatus of
|
||||
muAdded:
|
||||
begin
|
||||
node := vstAccounts.AddChild(nil);
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
accountInfo^.Username := username;
|
||||
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
accountInfo^.Regions := TStringList.Create;
|
||||
regions := ABuffer.ReadByte;
|
||||
for i := 0 to regions - 1 do
|
||||
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
|
||||
|
||||
Messagedlg('Success', Format('The user "%s" has been added.', [username]),
|
||||
mtInformation, [mbOK], 0);
|
||||
end;
|
||||
muModified:
|
||||
begin
|
||||
node := FindNode(username);
|
||||
if node <> nil then
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
accountInfo^.Regions.Clear;
|
||||
regions := ABuffer.ReadByte;
|
||||
for i := 0 to regions - 1 do
|
||||
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
|
||||
|
||||
Messagedlg('Success', Format('The user "%s" has been modified.', [username]),
|
||||
mtInformation, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
muInvalidUsername:
|
||||
MessageDlg('Error', Format('The username "%s" is not valid.', [username]),
|
||||
mtError, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
node: PVirtualNode;
|
||||
deleteStatus: TDeleteUserStatus;
|
||||
username: string;
|
||||
begin
|
||||
deleteStatus := TDeleteUserStatus(ABuffer.ReadByte);
|
||||
username := ABuffer.ReadStringNull;
|
||||
case deleteStatus of
|
||||
duDeleted:
|
||||
begin
|
||||
node := FindNode(username);
|
||||
if node <> nil then
|
||||
begin
|
||||
vstAccounts.DeleteNode(node);
|
||||
Messagedlg('Success', Format('The user "%s" has been deleted.', [username]),
|
||||
mtInformation, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
duNotFound:
|
||||
MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' +
|
||||
'your list is out of date or you tried to delete yourself.', [username]),
|
||||
mtError, [mbOK], 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
|
||||
var
|
||||
node: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
i, j, count, regions: Integer;
|
||||
begin
|
||||
vstAccounts.BeginUpdate;
|
||||
vstAccounts.Clear;
|
||||
count := ABuffer.ReadWord;
|
||||
for i := 1 to count do
|
||||
begin
|
||||
node := vstAccounts.AddChild(nil);
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
accountInfo^.Username := ABuffer.ReadStringNull;
|
||||
accountInfo^.AccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||||
accountInfo^.Regions := TStringList.Create;
|
||||
regions := ABuffer.ReadByte;
|
||||
for j := 0 to regions - 1 do
|
||||
accountInfo^.Regions.Add(ABuffer.ReadStringNull);
|
||||
end;
|
||||
vstAccounts.EndUpdate;
|
||||
end;
|
||||
|
||||
function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
|
||||
var
|
||||
node: PVirtualNode;
|
||||
accountInfo: PAccountInfo;
|
||||
begin
|
||||
Result := nil;
|
||||
node := vstAccounts.GetFirst;
|
||||
while (node <> nil) and (Result = nil) do
|
||||
begin
|
||||
accountInfo := vstAccounts.GetNodeData(node);
|
||||
if accountInfo^.Username = AUsername then
|
||||
Result := node;
|
||||
node := vstAccounts.GetNext(node);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmAccountControl.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+167
-167
@@ -1,167 +1,167 @@
|
||||
object frmEditAccount: TfrmEditAccount
|
||||
Left = 290
|
||||
Height = 214
|
||||
Top = 171
|
||||
Width = 261
|
||||
ActiveControl = PageControl1
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Edit Account'
|
||||
ClientHeight = 214
|
||||
ClientWidth = 261
|
||||
Font.Height = -11
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
ParentFont = False
|
||||
Position = poOwnerFormCenter
|
||||
LCLVersion = '0.9.27'
|
||||
object PageControl1: TPageControl
|
||||
Height = 173
|
||||
Width = 261
|
||||
ActivePage = tsGeneral
|
||||
Align = alClient
|
||||
TabIndex = 0
|
||||
TabOrder = 0
|
||||
object tsGeneral: TTabSheet
|
||||
Caption = 'General'
|
||||
ClientHeight = 148
|
||||
ClientWidth = 259
|
||||
object lblPasswordHint: TLabel
|
||||
Left = 86
|
||||
Height = 28
|
||||
Top = 64
|
||||
Width = 160
|
||||
AutoSize = False
|
||||
Caption = 'Leave empty to leave the password unchanged.'
|
||||
Enabled = False
|
||||
ParentColor = False
|
||||
WordWrap = True
|
||||
end
|
||||
object lblUsername: TLabel
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 12
|
||||
Width = 58
|
||||
Caption = 'Username:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblPassword: TLabel
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 44
|
||||
Width = 54
|
||||
Caption = 'Password:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblAccessLevel: TLabel
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 108
|
||||
Width = 63
|
||||
Caption = 'Accesslevel:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edUsername: TEdit
|
||||
Left = 86
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 160
|
||||
Color = clBtnFace
|
||||
ReadOnly = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object edPassword: TEdit
|
||||
Left = 86
|
||||
Height = 23
|
||||
Top = 40
|
||||
Width = 160
|
||||
EchoMode = emPassword
|
||||
PasswordChar = '*'
|
||||
TabOrder = 1
|
||||
end
|
||||
object cbAccessLevel: TComboBox
|
||||
Left = 86
|
||||
Height = 25
|
||||
Top = 104
|
||||
Width = 160
|
||||
Items.Strings = (
|
||||
'None'
|
||||
'Viewer'
|
||||
'Normal'
|
||||
'Administrator'
|
||||
)
|
||||
Style = csDropDownList
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object tsRegions: TTabSheet
|
||||
Caption = 'Regions'
|
||||
ClientHeight = 148
|
||||
ClientWidth = 259
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 14
|
||||
Top = 8
|
||||
Width = 243
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Allowed Regions:'
|
||||
ParentColor = False
|
||||
end
|
||||
object cbRegions: TCheckListBox
|
||||
Left = 8
|
||||
Height = 114
|
||||
Top = 26
|
||||
Width = 243
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 4
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
ItemHeight = 13
|
||||
TabOrder = 0
|
||||
TopIndex = -1
|
||||
end
|
||||
end
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 181
|
||||
Width = 245
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 8
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 25
|
||||
ClientWidth = 245
|
||||
TabOrder = 1
|
||||
object btnCancel: TButton
|
||||
Left = 170
|
||||
Height = 25
|
||||
Width = 75
|
||||
Align = alRight
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnOK: TButton
|
||||
Left = 91
|
||||
Height = 25
|
||||
Width = 75
|
||||
Align = alRight
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'OK'
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
object frmEditAccount: TfrmEditAccount
|
||||
Left = 290
|
||||
Height = 214
|
||||
Top = 171
|
||||
Width = 261
|
||||
ActiveControl = PageControl1
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Edit Account'
|
||||
ClientHeight = 214
|
||||
ClientWidth = 261
|
||||
Font.Height = -11
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnShow = FormShow
|
||||
ParentFont = False
|
||||
Position = poOwnerFormCenter
|
||||
LCLVersion = '0.9.27'
|
||||
object PageControl1: TPageControl
|
||||
Height = 173
|
||||
Width = 261
|
||||
ActivePage = tsGeneral
|
||||
Align = alClient
|
||||
TabIndex = 0
|
||||
TabOrder = 0
|
||||
object tsGeneral: TTabSheet
|
||||
Caption = 'General'
|
||||
ClientHeight = 148
|
||||
ClientWidth = 259
|
||||
object lblPasswordHint: TLabel
|
||||
Left = 86
|
||||
Height = 28
|
||||
Top = 64
|
||||
Width = 160
|
||||
AutoSize = False
|
||||
Caption = 'Leave empty to leave the password unchanged.'
|
||||
Enabled = False
|
||||
ParentColor = False
|
||||
WordWrap = True
|
||||
end
|
||||
object lblUsername: TLabel
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 12
|
||||
Width = 58
|
||||
Caption = 'Username:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblPassword: TLabel
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 44
|
||||
Width = 54
|
||||
Caption = 'Password:'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblAccessLevel: TLabel
|
||||
Left = 6
|
||||
Height = 14
|
||||
Top = 108
|
||||
Width = 63
|
||||
Caption = 'Accesslevel:'
|
||||
ParentColor = False
|
||||
end
|
||||
object edUsername: TEdit
|
||||
Left = 86
|
||||
Height = 23
|
||||
Top = 8
|
||||
Width = 160
|
||||
Color = clBtnFace
|
||||
ReadOnly = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object edPassword: TEdit
|
||||
Left = 86
|
||||
Height = 23
|
||||
Top = 40
|
||||
Width = 160
|
||||
EchoMode = emPassword
|
||||
PasswordChar = '*'
|
||||
TabOrder = 1
|
||||
end
|
||||
object cbAccessLevel: TComboBox
|
||||
Left = 86
|
||||
Height = 25
|
||||
Top = 104
|
||||
Width = 160
|
||||
Items.Strings = (
|
||||
'None'
|
||||
'Viewer'
|
||||
'Normal'
|
||||
'Administrator'
|
||||
)
|
||||
Style = csDropDownList
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object tsRegions: TTabSheet
|
||||
Caption = 'Regions'
|
||||
ClientHeight = 148
|
||||
ClientWidth = 259
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 14
|
||||
Top = 8
|
||||
Width = 243
|
||||
Align = alTop
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Allowed Regions:'
|
||||
ParentColor = False
|
||||
end
|
||||
object cbRegions: TCheckListBox
|
||||
Left = 8
|
||||
Height = 114
|
||||
Top = 26
|
||||
Width = 243
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 4
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
ItemHeight = 13
|
||||
TabOrder = 0
|
||||
TopIndex = -1
|
||||
end
|
||||
end
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 181
|
||||
Width = 245
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 8
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 25
|
||||
ClientWidth = 245
|
||||
TabOrder = 1
|
||||
object btnCancel: TButton
|
||||
Left = 170
|
||||
Height = 25
|
||||
Width = 75
|
||||
Align = alRight
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnOK: TButton
|
||||
Left = 91
|
||||
Height = 25
|
||||
Width = 75
|
||||
Align = alRight
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'OK'
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
+40
-40
@@ -1,40 +1,40 @@
|
||||
object frmInitialize: TfrmInitialize
|
||||
Left = 290
|
||||
Height = 65
|
||||
Top = 171
|
||||
Width = 241
|
||||
BorderIcons = []
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Please wait ...'
|
||||
ClientHeight = 65
|
||||
ClientWidth = 241
|
||||
Font.Height = -11
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.25'
|
||||
object pnlMain: TPanel
|
||||
Left = 8
|
||||
Height = 50
|
||||
Top = 8
|
||||
Width = 226
|
||||
BevelInner = bvRaised
|
||||
BevelOuter = bvLowered
|
||||
ClientHeight = 50
|
||||
ClientWidth = 226
|
||||
ParentFont = True
|
||||
TabOrder = 0
|
||||
object lblStatus: TLabel
|
||||
Left = 8
|
||||
Height = 32
|
||||
Top = 8
|
||||
Width = 208
|
||||
Alignment = taCenter
|
||||
AutoSize = False
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
ParentFont = True
|
||||
WordWrap = True
|
||||
end
|
||||
end
|
||||
end
|
||||
object frmInitialize: TfrmInitialize
|
||||
Left = 290
|
||||
Height = 65
|
||||
Top = 171
|
||||
Width = 241
|
||||
BorderIcons = []
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Please wait ...'
|
||||
ClientHeight = 65
|
||||
ClientWidth = 241
|
||||
Font.Height = -11
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '0.9.25'
|
||||
object pnlMain: TPanel
|
||||
Left = 8
|
||||
Height = 50
|
||||
Top = 8
|
||||
Width = 226
|
||||
BevelInner = bvRaised
|
||||
BevelOuter = bvLowered
|
||||
ClientHeight = 50
|
||||
ClientWidth = 226
|
||||
ParentFont = True
|
||||
TabOrder = 0
|
||||
object lblStatus: TLabel
|
||||
Left = 8
|
||||
Height = 32
|
||||
Top = 8
|
||||
Width = 208
|
||||
Alignment = taCenter
|
||||
AutoSize = False
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
ParentFont = True
|
||||
WordWrap = True
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
+96
-96
@@ -1,96 +1,96 @@
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UfrmInitialize;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, LCLIntf, LCLType, WSForms;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmInitialize }
|
||||
|
||||
TfrmInitialize = class(TForm)
|
||||
lblStatus: TLabel;
|
||||
pnlMain: TPanel;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
protected
|
||||
FActiveWindow: HWND;
|
||||
FModal: Boolean;
|
||||
public
|
||||
procedure SetModal;
|
||||
procedure UnsetModal;
|
||||
end;
|
||||
|
||||
var
|
||||
frmInitialize: TfrmInitialize;
|
||||
|
||||
implementation
|
||||
|
||||
{ TfrmInitialize }
|
||||
|
||||
procedure TfrmInitialize.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caNone;
|
||||
end;
|
||||
|
||||
procedure TfrmInitialize.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FModal := False;
|
||||
end;
|
||||
|
||||
procedure TfrmInitialize.SetModal;
|
||||
begin
|
||||
if FModal then Exit;
|
||||
FActiveWindow := GetActiveWindow;
|
||||
TWSCustomFormClass(WidgetSetClass).ShowModal(Self);
|
||||
{FormStyle := fsStayOnTop;
|
||||
Screen.MoveFormToFocusFront(Self);
|
||||
Screen.MoveFormToZFront(Self);}
|
||||
FModal := True;
|
||||
end;
|
||||
|
||||
procedure TfrmInitialize.UnsetModal;
|
||||
begin
|
||||
if not FModal then Exit;
|
||||
TWSCustomFormClass(WidgetSetClass).CloseModal(Self);
|
||||
if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow);
|
||||
FActiveWindow := 0;
|
||||
//FormStyle := fsNormal;
|
||||
FModal := False;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmInitialize.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 2007 Andreas Schneider
|
||||
*)
|
||||
unit UfrmInitialize;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
||||
StdCtrls, LCLIntf, LCLType, WSForms;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmInitialize }
|
||||
|
||||
TfrmInitialize = class(TForm)
|
||||
lblStatus: TLabel;
|
||||
pnlMain: TPanel;
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
protected
|
||||
FActiveWindow: HWND;
|
||||
FModal: Boolean;
|
||||
public
|
||||
procedure SetModal;
|
||||
procedure UnsetModal;
|
||||
end;
|
||||
|
||||
var
|
||||
frmInitialize: TfrmInitialize;
|
||||
|
||||
implementation
|
||||
|
||||
{ TfrmInitialize }
|
||||
|
||||
procedure TfrmInitialize.FormClose(Sender: TObject;
|
||||
var CloseAction: TCloseAction);
|
||||
begin
|
||||
CloseAction := caNone;
|
||||
end;
|
||||
|
||||
procedure TfrmInitialize.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FModal := False;
|
||||
end;
|
||||
|
||||
procedure TfrmInitialize.SetModal;
|
||||
begin
|
||||
if FModal then Exit;
|
||||
FActiveWindow := GetActiveWindow;
|
||||
TWSCustomFormClass(WidgetSetClass).ShowModal(Self);
|
||||
{FormStyle := fsStayOnTop;
|
||||
Screen.MoveFormToFocusFront(Self);
|
||||
Screen.MoveFormToZFront(Self);}
|
||||
FModal := True;
|
||||
end;
|
||||
|
||||
procedure TfrmInitialize.UnsetModal;
|
||||
begin
|
||||
if not FModal then Exit;
|
||||
TWSCustomFormClass(WidgetSetClass).CloseModal(Self);
|
||||
if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow);
|
||||
FActiveWindow := 0;
|
||||
//FormStyle := fsNormal;
|
||||
FModal := False;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmInitialize.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+1573
-1573
File diff suppressed because it is too large
Load Diff
+782
-782
File diff suppressed because it is too large
Load Diff
+684
-684
File diff suppressed because it is too large
Load Diff
+192
-192
@@ -1,192 +1,192 @@
|
||||
(*
|
||||
* 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 UfrmLogin;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ExtCtrls, Spin, EditBtn, Buttons, IniFiles;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmLogin }
|
||||
|
||||
TfrmLogin = class(TForm)
|
||||
btnOK: TButton;
|
||||
btnCancel: TButton;
|
||||
cbProfile: TComboBox;
|
||||
edData: TDirectoryEdit;
|
||||
edHost: TEdit;
|
||||
edUsername: TEdit;
|
||||
edPassword: TEdit;
|
||||
gbConnection: TGroupBox;
|
||||
gbData: TGroupBox;
|
||||
gbActions: TGroupBox;
|
||||
gbProfiles: TGroupBox;
|
||||
imgHost: TImage;
|
||||
imgUsername: TImage;
|
||||
imgPassword: TImage;
|
||||
lblCopyright: TLabel;
|
||||
lblHost: TLabel;
|
||||
lblUsername: TLabel;
|
||||
lblPassword: TLabel;
|
||||
edPort: TSpinEdit;
|
||||
lblData: TLabel;
|
||||
btnSaveProfile: TSpeedButton;
|
||||
btnDeleteProfile: TSpeedButton;
|
||||
procedure btnCancelClick(Sender: TObject);
|
||||
procedure btnDeleteProfileClick(Sender: TObject);
|
||||
procedure btnOKClick(Sender: TObject);
|
||||
procedure btnSaveProfileClick(Sender: TObject);
|
||||
procedure cbProfileChange(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
protected
|
||||
FProfilePath: string;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmLogin: TfrmLogin;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UdmNetwork;
|
||||
|
||||
{$I version.inc}
|
||||
|
||||
{ TfrmLogin }
|
||||
|
||||
procedure TfrmLogin.btnCancelClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
|
||||
begin
|
||||
if cbProfile.ItemIndex > -1 then
|
||||
begin
|
||||
DeleteFile(FProfilePath + cbProfile.Text + '.ini');
|
||||
cbProfile.Items.Delete(cbProfile.ItemIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.btnOKClick(Sender: TObject);
|
||||
var
|
||||
path: string;
|
||||
begin
|
||||
path := IncludeTrailingPathDelimiter(edData.Text);
|
||||
if (not FileExists(path + 'art.mul')) or
|
||||
(not FileExists(path + 'artidx.mul')) or
|
||||
(not FileExists(path + 'hues.mul')) or
|
||||
(not FileExists(path + 'tiledata.mul')) or
|
||||
(not FileExists(path + 'animdata.mul')) or
|
||||
(not FileExists(path + 'texmaps.mul')) or
|
||||
(not FileExists(path + 'texidx.mul')) or
|
||||
(not FileExists(path + 'light.mul')) or
|
||||
(not FileExists(path + 'lightidx.mul')) then
|
||||
begin
|
||||
MessageDlg('Incorrect directory', 'The data path you specified does not '
|
||||
+ 'seem to be correct.', mtWarning, [mbOK], 0);
|
||||
edData.SetFocus;
|
||||
end else
|
||||
ModalResult := mrOK;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
|
||||
var
|
||||
profileName: string;
|
||||
profile: TIniFile;
|
||||
begin
|
||||
profileName := cbProfile.Text;
|
||||
if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then
|
||||
begin
|
||||
profile := TIniFile.Create(FProfilePath + profileName + '.ini');
|
||||
profile.WriteString('Connection', 'Host', edHost.Text);
|
||||
profile.WriteInteger('Connection', 'Port', edPort.Value);
|
||||
profile.WriteString('Connection', 'Username', edUsername.Text);
|
||||
profile.WriteString('Data', 'Path', edData.Text);
|
||||
profile.Free;
|
||||
cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
|
||||
if cbProfile.ItemIndex = -1 then
|
||||
begin
|
||||
cbProfile.Items.Add(profileName);
|
||||
cbProfile.ItemIndex := cbProfile.Items.Count - 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.cbProfileChange(Sender: TObject);
|
||||
var
|
||||
profile: TIniFile;
|
||||
begin
|
||||
if cbProfile.ItemIndex > -1 then
|
||||
begin
|
||||
profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini');
|
||||
edHost.Text := profile.ReadString('Connection', 'Host', '');
|
||||
edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
|
||||
edUsername.Text := profile.ReadString('Connection', 'Username', '');
|
||||
edPassword.Text := '';
|
||||
edData.Text := profile.ReadString('Data', 'Path', '');
|
||||
edPassword.SetFocus;
|
||||
profile.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
if ModalResult <> mrOK then
|
||||
dmNetwork.CheckClose(Self);
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.FormCreate(Sender: TObject);
|
||||
var
|
||||
searchRec: TSearchRec;
|
||||
begin
|
||||
lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s',
|
||||
[ProductVersion, Copyright]);
|
||||
|
||||
FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim;
|
||||
ForceDirectories(FProfilePath);
|
||||
if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then
|
||||
begin
|
||||
repeat
|
||||
cbProfile.Items.Add(ChangeFileExt(searchRec.Name, ''));
|
||||
until FindNext(searchRec) <> 0;
|
||||
end;
|
||||
FindClose(searchRec);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmLogin.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 UfrmLogin;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ExtCtrls, Spin, EditBtn, Buttons, IniFiles;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmLogin }
|
||||
|
||||
TfrmLogin = class(TForm)
|
||||
btnOK: TButton;
|
||||
btnCancel: TButton;
|
||||
cbProfile: TComboBox;
|
||||
edData: TDirectoryEdit;
|
||||
edHost: TEdit;
|
||||
edUsername: TEdit;
|
||||
edPassword: TEdit;
|
||||
gbConnection: TGroupBox;
|
||||
gbData: TGroupBox;
|
||||
gbActions: TGroupBox;
|
||||
gbProfiles: TGroupBox;
|
||||
imgHost: TImage;
|
||||
imgUsername: TImage;
|
||||
imgPassword: TImage;
|
||||
lblCopyright: TLabel;
|
||||
lblHost: TLabel;
|
||||
lblUsername: TLabel;
|
||||
lblPassword: TLabel;
|
||||
edPort: TSpinEdit;
|
||||
lblData: TLabel;
|
||||
btnSaveProfile: TSpeedButton;
|
||||
btnDeleteProfile: TSpeedButton;
|
||||
procedure btnCancelClick(Sender: TObject);
|
||||
procedure btnDeleteProfileClick(Sender: TObject);
|
||||
procedure btnOKClick(Sender: TObject);
|
||||
procedure btnSaveProfileClick(Sender: TObject);
|
||||
procedure cbProfileChange(Sender: TObject);
|
||||
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
protected
|
||||
FProfilePath: string;
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmLogin: TfrmLogin;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UdmNetwork;
|
||||
|
||||
{$I version.inc}
|
||||
|
||||
{ TfrmLogin }
|
||||
|
||||
procedure TfrmLogin.btnCancelClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
|
||||
begin
|
||||
if cbProfile.ItemIndex > -1 then
|
||||
begin
|
||||
DeleteFile(FProfilePath + cbProfile.Text + '.ini');
|
||||
cbProfile.Items.Delete(cbProfile.ItemIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.btnOKClick(Sender: TObject);
|
||||
var
|
||||
path: string;
|
||||
begin
|
||||
path := IncludeTrailingPathDelimiter(edData.Text);
|
||||
if (not FileExists(path + 'art.mul')) or
|
||||
(not FileExists(path + 'artidx.mul')) or
|
||||
(not FileExists(path + 'hues.mul')) or
|
||||
(not FileExists(path + 'tiledata.mul')) or
|
||||
(not FileExists(path + 'animdata.mul')) or
|
||||
(not FileExists(path + 'texmaps.mul')) or
|
||||
(not FileExists(path + 'texidx.mul')) or
|
||||
(not FileExists(path + 'light.mul')) or
|
||||
(not FileExists(path + 'lightidx.mul')) then
|
||||
begin
|
||||
MessageDlg('Incorrect directory', 'The data path you specified does not '
|
||||
+ 'seem to be correct.', mtWarning, [mbOK], 0);
|
||||
edData.SetFocus;
|
||||
end else
|
||||
ModalResult := mrOK;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
|
||||
var
|
||||
profileName: string;
|
||||
profile: TIniFile;
|
||||
begin
|
||||
profileName := cbProfile.Text;
|
||||
if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then
|
||||
begin
|
||||
profile := TIniFile.Create(FProfilePath + profileName + '.ini');
|
||||
profile.WriteString('Connection', 'Host', edHost.Text);
|
||||
profile.WriteInteger('Connection', 'Port', edPort.Value);
|
||||
profile.WriteString('Connection', 'Username', edUsername.Text);
|
||||
profile.WriteString('Data', 'Path', edData.Text);
|
||||
profile.Free;
|
||||
cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
|
||||
if cbProfile.ItemIndex = -1 then
|
||||
begin
|
||||
cbProfile.Items.Add(profileName);
|
||||
cbProfile.ItemIndex := cbProfile.Items.Count - 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.cbProfileChange(Sender: TObject);
|
||||
var
|
||||
profile: TIniFile;
|
||||
begin
|
||||
if cbProfile.ItemIndex > -1 then
|
||||
begin
|
||||
profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini');
|
||||
edHost.Text := profile.ReadString('Connection', 'Host', '');
|
||||
edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
|
||||
edUsername.Text := profile.ReadString('Connection', 'Username', '');
|
||||
edPassword.Text := '';
|
||||
edData.Text := profile.ReadString('Data', 'Path', '');
|
||||
edPassword.SetFocus;
|
||||
profile.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||
begin
|
||||
if ModalResult <> mrOK then
|
||||
dmNetwork.CheckClose(Self);
|
||||
end;
|
||||
|
||||
procedure TfrmLogin.FormCreate(Sender: TObject);
|
||||
var
|
||||
searchRec: TSearchRec;
|
||||
begin
|
||||
lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s',
|
||||
[ProductVersion, Copyright]);
|
||||
|
||||
FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim;
|
||||
ForceDirectories(FProfilePath);
|
||||
if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then
|
||||
begin
|
||||
repeat
|
||||
cbProfile.Items.Add(ChangeFileExt(searchRec.Name, ''));
|
||||
until FindNext(searchRec) <> 0;
|
||||
end;
|
||||
FindClose(searchRec);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmLogin.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
+635
-635
File diff suppressed because it is too large
Load Diff
+740
-740
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user