diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-08-31 17:24:54 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2008-08-31 17:24:54 +0000 |
commit | 1405e1ecfd53e424c3e96edccdf2e5b0b707257b (patch) | |
tree | e2acb5e89e78a1f229f35d74966577ba0fcb7887 | |
parent | 052d28c91a70678b264fb7772096da6fb6803dc3 (diff) | |
download | fpGUI-1405e1ecfd53e424c3e96edccdf2e5b0b707257b.tar.xz |
* Renamed the hint window to TfpgHintWindow
* Moved F_Hint variable to fpgApplication.HintWindow property. TfpgApplication
now manages the life of HintWindow.
* Moved DisplayHint (now called ActivateHint) and HideHint into TfpgApplication.
* Introduced a new TfpgApplication.HintPause property that will managed the
default delay before a help hint is displayed. Default is 1.5 seconds.
* gui_edit unit has been updated to handle the new changes.
* hintwindow example project has been updated to handle the new changes.
* TfpgHintWindow class now manages the Shadow Window (lifetime, size and
position).
* The Hint Shadow class is now moved to the Implementation section so it's not
accessible to the world, but only via the standard Hint Window class.
* Introduced a HintWindowClass which is a global variable. It defaults to
TfpgHintWindow, but allows the user to change it so a custom hint window
can be used instead.
* TfpgLabel.Text is now of type TfpgString
-rw-r--r-- | examples/gui/hintwindow/edittest.lpr | 75 | ||||
-rw-r--r-- | src/corelib/fpgfx.pas | 73 | ||||
-rw-r--r-- | src/corelib/gfx_widget.pas | 2 | ||||
-rw-r--r-- | src/gui/gui_edit.pas | 7 | ||||
-rw-r--r-- | src/gui/gui_hint.pas | 140 | ||||
-rw-r--r-- | src/gui/gui_label.pas | 8 |
6 files changed, 201 insertions, 104 deletions
diff --git a/examples/gui/hintwindow/edittest.lpr b/examples/gui/hintwindow/edittest.lpr index 33682a65..b0309792 100644 --- a/examples/gui/hintwindow/edittest.lpr +++ b/examples/gui/hintwindow/edittest.lpr @@ -15,6 +15,7 @@ type TMainForm = class(TfpgForm) private + function GetHintWnd: TfpgHintWindow; procedure btnQuitClicked(Sender: TObject); procedure rbClicked(Sender: TObject); procedure lbChange(Sender: TObject); @@ -106,6 +107,11 @@ type {@VFD_NEWFORM_IMPL} +function TMainForm.GetHintWnd: TfpgHintWindow; +begin + Result := TfpgHintWindow(fpgApplication.HintWindow); +end; + procedure TMainForm.btnQuitClicked(Sender: TObject); begin Close; @@ -222,133 +228,133 @@ end; procedure TMainForm.rb_border_1Change(Sender: TObject); begin if rb_border_1.Checked then - F_Hint.Border := 1; + GetHintWnd.Border := 1; end; procedure TMainForm.rb_border_2Change(Sender: TObject); begin if rb_border_2.Checked then - F_Hint.Border := 2; + GetHintWnd.Border := 2; end; procedure TMainForm.rb_border_3Change(Sender: TObject); begin if rb_border_3.Checked then - F_Hint.Border := 3; + GetHintWnd.Border := 3; end; procedure TMainForm.rb_border_5Change(Sender: TObject); begin if rb_border_5.Checked then - F_Hint.Border := 5; + GetHintWnd.Border := 5; end; procedure TMainForm.rb_margin_1Change(Sender: TObject); begin if rb_margin_1.Checked then - F_Hint.Margin := 1; + GetHintWnd.Margin := 1; end; procedure TMainForm.rb_margin_2Change(Sender: TObject); begin if rb_margin_2.Checked then - F_Hint.Margin := 2; + GetHintWnd.Margin := 2; end; procedure TMainForm.rb_margin_3Change(Sender: TObject); begin if rb_margin_3.Checked then - F_Hint.Margin := 3; + GetHintWnd.Margin := 3; end; procedure TMainForm.rb_margin_5Change(Sender: TObject); begin if rb_margin_5.Checked then - F_Hint.Margin := 5; + GetHintWnd.Margin := 5; end; procedure TMainForm.rb_time_1Change(Sender: TObject); begin if rb_time_1.Checked then - F_Hint.Time := 1000; + GetHintWnd.Time := 1000; end; procedure TMainForm.rb_time_2Change(Sender: TObject); begin if rb_time_2.Checked then - F_Hint.Time := 2000; + GetHintWnd.Time := 2000; end; procedure TMainForm.rb_time_3Change(Sender: TObject); begin if rb_time_3.Checked then - F_Hint.Time := 3000; + GetHintWnd.Time := 3000; end; procedure TMainForm.rb_time_5Change(Sender: TObject); begin if rb_time_5.Checked then - F_Hint.Time := 5000; + GetHintWnd.Time := 5000; end; procedure TMainForm.rb_color_blackChange(Sender: TObject); begin if rb_color_black.Checked then - F_Hint.LTextColor := clBlack; + GetHintWnd.LTextColor := clBlack; end; procedure TMainForm.rb_color_redChange(Sender: TObject); begin if rb_color_red.Checked then - F_Hint.LTextColor := clRed; + GetHintWnd.LTextColor := clRed; end; procedure TMainForm.rb_color_greenChange(Sender: TObject); begin if rb_color_green.Checked then - F_Hint.LTextColor := clGreen; + GetHintWnd.LTextColor := clGreen; end; procedure TMainForm.rb_color_blueChange(Sender: TObject); begin if rb_color_blue.Checked then - F_Hint.LTextColor := clBlue; + GetHintWnd.LTextColor := clBlue; end; procedure TMainForm.rb_bgcolor_yellowChange(Sender: TObject); begin if rb_bgcolor_yellow.Checked then - F_Hint.LBackgroundColor := TfpgColor($ffffbf); //clYellow; + GetHintWnd.LBackgroundColor := TfpgColor($ffffbf); //clYellow; end; procedure TMainForm.rb_bgcolor_whiteChange(Sender: TObject); begin if rb_bgcolor_white.Checked then - F_Hint.LBackgroundColor := clWhite; + GetHintWnd.LBackgroundColor := clWhite; end; procedure TMainForm.rb_bgcolor_greenChange(Sender: TObject); begin if rb_bgcolor_green.Checked then - F_Hint.LBackgroundColor := clPaleGreen; + GetHintWnd.LBackgroundColor := clPaleGreen; end; procedure TMainForm.rb_bgcolor_blueChange(Sender: TObject); begin if rb_bgcolor_blue.Checked then - F_Hint.LBackgroundColor := clLightBlue; + GetHintWnd.LBackgroundColor := clLightBlue; end; procedure TMainForm.rb_shadowcolor_grayChange(Sender: TObject); begin if rb_shadowcolor_gray.Checked then - F_Hint.ShadowColor := clGray; + GetHintWnd.ShadowColor := clGray; end; procedure TMainForm.rb_shadowcolor_blackChange(Sender: TObject); begin if rb_shadowcolor_black.Checked then - F_Hint.ShadowColor := clBlack; + GetHintWnd.ShadowColor := clBlack; end; procedure TMainForm.AfterCreate; @@ -692,8 +698,6 @@ begin chbShowHint := CreateCheckBox(Self,200,500,'Show hint'); chbShowhint.OnChange:= @chbShowHintChange; - F_Hint := TF_Hint.Create(nil); - F_Hint.Visible := False; {@VFD_BODY_END: MainForm} @@ -703,10 +707,32 @@ begin rbComma.Checked := True; end; + +type + { A very simple custom hint window. } + TMyHintWindow = class(TfpgHintWindow) + public + constructor Create(AOwner: TComponent); override; + end; + +{ TMyHintWindow } + +constructor TMyHintWindow.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + MinWidth := 400; + MinHeight := 200; +end; + + procedure MainProc; var frm: TMainForm; begin + // To apply custom hint window, uncomment the two lines below +// fpgApplication; +// HintWindowClass := TMyHintWindow; + fpgApplication.Initialize; frm := TMainForm.Create(nil); try @@ -717,6 +743,7 @@ begin end; end; + begin MainProc; end. diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index 7b777a4a..67f10d2d 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -148,8 +148,6 @@ type end; - { TfpgCanvas } - TfpgCanvas = class(TfpgCanvasImpl) private function AddLineBreaks(const s: TfpgString; aMaxLineWidth: integer): string; @@ -198,14 +196,16 @@ type end; - { TfpgApplication } - TfpgApplication = class(TfpgApplicationImpl) private + FHintPause: Integer; FOnException: TExceptionEvent; FStopOnException: Boolean; + FHintWindow: TfpgWindow; + procedure SetHintPause(const AValue: Integer); procedure SetupLocalizationStrings; procedure InternalMsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; + procedure CreateHintWindow; protected FDisplayParams: string; FScreenWidth: integer; @@ -221,15 +221,19 @@ type constructor Create(const AParams: string = ''); override; destructor Destroy; override; function GetFont(const afontdesc: string): TfpgFont; - procedure Initialize; - procedure Run; + procedure ActivateHint(APos: TPoint; AHint: TfpgString); procedure Flush; + procedure HandleException(Sender: TObject); + procedure HideHint; + procedure Initialize; procedure ProcessMessages; + procedure Run; procedure SetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject); - procedure UnsetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject); - procedure HandleException(Sender: TObject); procedure ShowException(E: Exception); + procedure UnsetMessageHook(AWidget: TObject; const AMsgCode: integer; AListener: TObject); property DefaultFont: TfpgFont read FDefaultFont; + property HintPause: Integer read FHintPause write SetHintPause; + property HintWindow: TfpgWindow read FHintWindow; property ScreenWidth: integer read FScreenWidth; property ScreenHeight: integer read FScreenHeight; property StopOnException: Boolean read FStopOnException write FStopOnException; @@ -355,7 +359,8 @@ uses gfx_translations, gfx_constants, gfx_UTF8utils, - gui_dialogs; + gui_dialogs, + gui_hint; var fpgTimers: TList; @@ -781,6 +786,8 @@ begin FScreenHeight := -1; FMessageHookList := TFPList.Create; FStopOnException := False; + FHintWindow := nil; + FHintPause := 1500; // 1.5 seconds try inherited Create(AParams); @@ -803,6 +810,12 @@ var i: integer; frm: TfpgWindowBase; begin + if Assigned(FHintWindow) then + begin + HideHint; + FHintWindow.Free; + end; + DestroyComponents; // while message queue is still active for i := 0 to (fpgNamedFonts.Count - 1) do @@ -881,6 +894,23 @@ begin end; end; +procedure TfpgApplication.ActivateHint(APos: TPoint; AHint: TfpgString); +var + wnd: TfpgHintWindow; + w: Integer; + h: Integer; +begin + wnd := TfpgHintWindow(FHintWindow); + if Assigned(wnd) and wnd.Visible then + Exit; //==> Nothing to do + + wnd.Text := AHint; + w := wnd.Font.TextWidth(AHint) + (wnd.Border * 2) + (wnd.Margin * 2); + h := wnd.Font.Height + (wnd.Border * 2) + (wnd.Margin * 2); + wnd.SetPosition(APos.X, APos.Y, w, h); + wnd.Show; +end; + procedure TfpgApplication.Initialize; begin { TODO : Remember to process parameters!! } @@ -949,6 +979,11 @@ begin end; +procedure TfpgApplication.SetHintPause(const AValue: Integer); +begin + FHintPause := AValue; +end; + procedure TfpgApplication.InternalMsgClose(var msg: TfpgMessageRec); begin // writeln('InternalMsgClose received'); @@ -961,6 +996,16 @@ begin end; end; +procedure TfpgApplication.CreateHintWindow; +begin + if not Assigned(FHintWindow) then + begin + FHintWindow := HintWindowClass.Create(nil); + writeln('HintWindow.Classname=', FHintWindow.ClassName); + TfpgHintWindow(FHintWindow).Visible := False; + end; +end; + procedure TfpgApplication.FreeFontRes(afontres: TfpgFontResource); var n: integer; @@ -986,6 +1031,7 @@ begin // This will process Application and fpGUI Toolkit translation (*.po) files TranslateResourceStrings(ApplicationName, ExtractFilePath(ParamStr(0)), ''); SetupLocalizationStrings; + CreateHintWindow; end; procedure TfpgApplication.Flush; @@ -1056,6 +1102,15 @@ begin Terminated := True; end; +procedure TfpgApplication.HideHint; +begin + {$IFDEF DEBUG} + writeln('HideHint'); + {$ENDIF} + if Assigned(FHintWindow) and TfpgHintWindow(FHintWindow).Visible then + TfpgHintWindow(FHintWindow).Hide; +end; + procedure TfpgApplication.ShowException(E: Exception); begin TfpgMessageDialog.Critical('An unexpected error occurred.', E.Message); diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas index dd2df625..a31815de 100644 --- a/src/corelib/gfx_widget.pas +++ b/src/corelib/gfx_widget.pas @@ -841,7 +841,7 @@ begin writeln('TfpgWidget.HandleMouseExit: ' + ClassName); {$ENDIF} if FShowHint then - HideHint; + fpgApplication.HideHint; end; procedure TfpgWidget.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas index 71565fdc..a00e06f0 100644 --- a/src/gui/gui_edit.pas +++ b/src/gui/gui_edit.pas @@ -885,7 +885,7 @@ begin if FHintTimer.Enabled then FHintTimer.Reset // keep reseting to prevent hint from showing else - HideHint; + fpgApplication.HideHint; end; Exit; //==> end; @@ -976,7 +976,7 @@ begin FDefaultPopupMenu := nil; FOnChange := nil; - FHintTimer := TfpgTimer.Create(1500); + FHintTimer := TfpgTimer.Create(fpgApplication.HintPause); FHintTimer.OnTimer := @HintTimerFired; end; @@ -1105,7 +1105,8 @@ end; procedure TfpgBaseEdit.HintTimerFired(Sender: TObject); begin - DisplayHint(WindowToScreen(Self, FMousePoint), FHint); +// Writeln('TfpgBaseEdit.HintTimerFired'); + fpgApplication.ActivateHint(WindowToScreen(Self, FMousePoint), FHint); FHintTimer.Enabled := False; end; diff --git a/src/gui/gui_hint.pas b/src/gui/gui_hint.pas index e106f7f3..09db8db5 100644 --- a/src/gui/gui_hint.pas +++ b/src/gui/gui_hint.pas @@ -1,3 +1,20 @@ +{ + fpGUI - Free Pascal GUI Toolkit + + Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + Description: + Defines a window that gets used to display help hints (aka a HintWindow) +} + unit gui_hint; {$mode objfpc}{$H+} @@ -7,14 +24,16 @@ unit gui_hint; interface uses - Classes, SysUtils, - fpgfx, gfxbase, - gui_form, gui_label; + Classes, + SysUtils, + fpgfx, + gfxbase, + gui_form, + gui_label; type - TF_Hint = class(TfpgForm) + TfpgHintWindow = class(TfpgForm) private - FText: string; FFont: TfpgFont; FTime: Integer; FShadow: Integer; @@ -24,6 +43,8 @@ type T_Chrono: TfpgTimer; procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); + function GetText: TfpgString; + procedure SetText(const AValue: TfpgString); procedure T_ChronoFini(Sender: TObject); procedure SetShadow(AValue: Integer); procedure SetBorder(AValue: Integer); @@ -32,10 +53,12 @@ type procedure SetLBackgroundColor(AValue: Tfpgcolor); procedure SetShadowColor(AValue: TfpgColor); protected - property Font: TfpgFont read FFont; + procedure HandleShow; override; public constructor Create(AOwner: TComponent); override; - property Text: string read FText write FText; + procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord); override; + property Font: TfpgFont read FFont; + property Text: TfpgString read GetText write SetText; property Shadow: Integer read FShadow write SetShadow default 5; property Border: Integer read FBorder write SetBorder default 1; property Margin: Integer read FMargin write FMargin default 3; @@ -46,73 +69,50 @@ type end; + TfpgHintWindowClass = class of TfpgHintWindow; + +var + HintWindowClass: TfpgHintWindowClass = TfpgHintWindow; + + +implementation + +type TF_Shadow = class(TfpgForm) public constructor Create(AOwner: TComponent); override; end; - - + + var - F_Hint: TF_Hint; F_Shadow: TF_Shadow; -procedure DisplayHint(Pt: TPoint; AHint: string); -procedure HideHint; +{ TfpgHintWindow } - -implementation - - -procedure DisplayHint(Pt: TPoint; AHint: string); +procedure TfpgHintWindow.FormShow(Sender: TObject); begin - {$IFDEF DEBUG} - writeln('DisplayHint'); - {$ENDIF} - if Assigned(F_Hint) and F_Hint.Visible then - Exit; //==> Nothing to do - - with F_Hint do - begin - L_Hint.Text := AHint; - Width := FFont.TextWidth(AHint) + (Border * 2) + (Margin * 2); - Height := FFont.Height + (Border * 2) + (Margin * 2); - if Shadow > 0 then - begin - F_Shadow.SetPosition(Pt.X+Shadow, Pt.Y+Shadow, Width, Height); - F_Shadow.Show; - end; - L_Hint.SetPosition(Border, Border, Width - (Border * 2), Height - (Border * 2)); - SetPosition(Pt.X, Pt.Y, Width, Height); - Show; - end; + T_Chrono.Enabled:= True; end; -procedure HideHint; +procedure TfpgHintWindow.FormHide(Sender: TObject); begin - {$IFDEF DEBUG} - writeln('HideHint'); - {$ENDIF} - if Assigned(F_Hint) and F_Hint.Visible then - F_Hint.Hide; + T_Chrono.Enabled := False; + if Assigned(F_Shadow) then + F_Shadow.Hide; end; - -{ TF_Hint } - -procedure TF_Hint.FormShow(Sender: TObject); +function TfpgHintWindow.GetText: TfpgString; begin - T_Chrono.Enabled:= True; + Result := L_Hint.Text; end; -procedure TF_Hint.FormHide(Sender: TObject); +procedure TfpgHintWindow.SetText(const AValue: TfpgString); begin - T_Chrono.Enabled := False; - if Assigned(F_Shadow) then - F_Shadow.Hide; + L_Hint.Text := AValue; end; -procedure TF_Hint.T_ChronoFini(Sender: TObject); +procedure TfpgHintWindow.T_ChronoFini(Sender: TObject); begin {$IFDEF DEBUG} writeln('TF_Hint.T_ChronoFini timer fired'); @@ -120,19 +120,19 @@ begin Hide; end; -procedure TF_Hint.SetShadow(AValue: Integer); +procedure TfpgHintWindow.SetShadow(AValue: Integer); begin if FShadow <> AValue then FShadow := AValue; end; -procedure TF_Hint.SetBorder(AValue: Integer); +procedure TfpgHintWindow.SetBorder(AValue: Integer); begin if FBorder <> AValue then FBorder := AValue; end; -procedure TF_Hint.SetTime(AValue: Integer); +procedure TfpgHintWindow.SetTime(AValue: Integer); begin if FTime <> AValue then begin @@ -141,32 +141,41 @@ begin end; end; -procedure TF_Hint.SetLTextColor(AValue: Tfpgcolor); +procedure TfpgHintWindow.SetLTextColor(AValue: Tfpgcolor); begin if L_Hint.TextColor <> AValue then L_Hint.TextColor := AValue end; -procedure TF_Hint.SetLBackgroundColor(AValue: Tfpgcolor); +procedure TfpgHintWindow.SetLBackgroundColor(AValue: Tfpgcolor); begin if L_Hint.BackgroundColor <> AValue then L_Hint.BackgroundColor := AValue end; -procedure TF_Hint.SetShadowColor(AValue: Tfpgcolor); +procedure TfpgHintWindow.SetShadowColor(AValue: Tfpgcolor); begin if F_Shadow.BackgroundColor <> AValue then F_Shadow.BackgroundColor := AValue; end; -constructor TF_Hint.Create(AOwner: TComponent); +procedure TfpgHintWindow.HandleShow; +begin + // This is so the Shadow Window is below the Hint Window. + if Shadow > 0 then + begin + F_Shadow.SetPosition(Left+Shadow, Top+Shadow, Width, Height); + F_Shadow.Show; + end; + inherited HandleShow; +end; + +constructor TfpgHintWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); Name := 'F_Hint'; WindowPosition := wpUser; WindowType := wtPopup; -// WindowAttributes := [waBorderless]; -// BorderLess := True; Sizeable := False; BackgroundColor:= clBlack; FFont := fpgGetFont('#Label1'); @@ -184,13 +193,18 @@ begin OnHide := @FormHide; end; +procedure TfpgHintWindow.SetPosition(aleft, atop, awidth, aheight: TfpgCoord); +begin + inherited SetPosition(aleft, atop, awidth, aheight); + L_Hint.SetPosition(Border, Border, Width - (Border * 2), Height - (Border * 2)); +end; + constructor TF_Shadow.Create(AOwner: TComponent); begin inherited Create(AOwner); Name := 'F_Shadow'; WindowPosition := wpUser; WindowType := wtPopup; -// BorderLess := True; Sizeable := False; BackgroundColor := clGray; end; diff --git a/src/gui/gui_label.pas b/src/gui/gui_label.pas index 22c00fa8..20f5cfb3 100644 --- a/src/gui/gui_label.pas +++ b/src/gui/gui_label.pas @@ -45,10 +45,10 @@ type function GetFontDesc: string; procedure SetAutoSize(const AValue: boolean); procedure SetFontDesc(const AValue: string); - procedure SetText(const AValue: string); + procedure SetText(const AValue: TfpgString); procedure ResizeLabel; protected - FText: string; + FText: TfpgString; FFont: TfpgFont; FTextHeight: integer; procedure HandlePaint; override; @@ -57,7 +57,7 @@ type property AutoSize: boolean read FAutoSize write SetAutoSize default False; property Layout: TLayout read FLayout write SetLayout default tlTop; property FontDesc: string read GetFontDesc write SetFontDesc; - property Text: string read FText write SetText; + property Text: TfpgString read FText write SetText; property LineSpace: integer read FLineSpace write FLineSpace default 2; public constructor Create(AOwner: TComponent); override; @@ -169,7 +169,7 @@ begin ResizeLabel; end; -procedure TfpgCustomLabel.SetText(const AValue: string); +procedure TfpgCustomLabel.SetText(const AValue: TfpgString); begin if FText <> AValue then begin |