From 5d7c40d579892e8b5b03fb28ae066bbdba9814bc Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Fri, 18 Dec 2009 18:43:55 +0100 Subject: [PATCH] - Fixed TfrmToolWindow.FormDeactivate to check CanClose first - Fixed TfrmDrawSettings and TfrmHueSettings to be shown non-modal (fixes #49) --- Client/Tools/UfrmDrawSettings.lfm | 243 +++++++++++++++--------------- Client/Tools/UfrmDrawSettings.pas | 238 +++++++++++++++-------------- Client/Tools/UfrmToolWindow.pas | 207 ++++++++++++------------- Client/UfrmMain.pas | 2 +- 4 files changed, 357 insertions(+), 333 deletions(-) diff --git a/Client/Tools/UfrmDrawSettings.lfm b/Client/Tools/UfrmDrawSettings.lfm index cd31057..fe3840a 100644 --- a/Client/Tools/UfrmDrawSettings.lfm +++ b/Client/Tools/UfrmDrawSettings.lfm @@ -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 diff --git a/Client/Tools/UfrmDrawSettings.pas b/Client/Tools/UfrmDrawSettings.pas index 388966c..96d32ae 100644 --- a/Client/Tools/UfrmDrawSettings.pas +++ b/Client/Tools/UfrmDrawSettings.pas @@ -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. + diff --git a/Client/Tools/UfrmToolWindow.pas b/Client/Tools/UfrmToolWindow.pas index c818b3a..dc7f43d 100644 --- a/Client/Tools/UfrmToolWindow.pas +++ b/Client/Tools/UfrmToolWindow.pas @@ -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. + diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index 9be703c..27009b9 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -1084,7 +1084,7 @@ begin acDraw.Checked := True; tbDrawTile.Down := True; mnuDraw.Checked := True; - frmDrawSettings.ShowModal; + frmDrawSettings.Show; ProcessToolState; end;