- Fixed TfrmToolWindow.FormDeactivate to check CanClose first
- Fixed TfrmDrawSettings and TfrmHueSettings to be shown non-modal (fixes #49)
This commit is contained in:
parent
e502321f35
commit
5d7c40d579
|
@ -1,120 +1,123 @@
|
|||
inherited frmDrawSettings: TfrmDrawSettings
|
||||
Left = 268
|
||||
Height = 180
|
||||
Top = 165
|
||||
Width = 242
|
||||
ActiveControl = rbTileList
|
||||
Caption = 'Draw settings'
|
||||
ClientHeight = 180
|
||||
ClientWidth = 242
|
||||
object rbTileList: TRadioButton[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 125
|
||||
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 = 19
|
||||
Top = 31
|
||||
Width = 184
|
||||
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 = 123
|
||||
Width = 226
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 8
|
||||
Caption = 'Hue (Statics only)'
|
||||
ClientHeight = 31
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object pbHue: TPaintBox
|
||||
Cursor = crHandPoint
|
||||
Left = 4
|
||||
Height = 27
|
||||
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 = 19
|
||||
Top = 93
|
||||
Width = 135
|
||||
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 = 25
|
||||
Top = 90
|
||||
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 = 19
|
||||
Top = 62
|
||||
Width = 95
|
||||
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 = 25
|
||||
Top = 59
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
MaxValue = 127
|
||||
MinValue = -128
|
||||
TabOrder = 6
|
||||
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
|
||||
|
|
|
@ -1,109 +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 pbHueClick(Sender: TObject);
|
||||
procedure pbHuePaint(Sender: TObject);
|
||||
procedure seForceAltitudeChange(Sender: TObject);
|
||||
procedure seRandomHeightChange(Sender: TObject);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmDrawSettings: TfrmDrawSettings;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UGameResources, UHue, UfrmHueSettings;
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
|
||||
var
|
||||
msg: TLMessage;
|
||||
begin
|
||||
frmHueSettings.Left := Mouse.CursorPos.x - 8;
|
||||
frmHueSettings.Top := Mouse.CursorPos.y - 8;
|
||||
frmHueSettings.ShowModal;
|
||||
pbHue.Repaint;
|
||||
MouseLeave(msg);
|
||||
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;
|
||||
|
||||
//TODO : canclose ---> hue settings
|
||||
|
||||
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.
|
||||
|
||||
|
|
|
@ -1,103 +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
|
||||
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.
|
||||
|
||||
|
|
|
@ -1084,7 +1084,7 @@ begin
|
|||
acDraw.Checked := True;
|
||||
tbDrawTile.Down := True;
|
||||
mnuDraw.Checked := True;
|
||||
frmDrawSettings.ShowModal;
|
||||
frmDrawSettings.Show;
|
||||
ProcessToolState;
|
||||
end;
|
||||
|
||||
|
|
Loading…
Reference in New Issue