diff options
-rw-r--r-- | src/corelib/fpgfx.pas | 48 | ||||
-rw-r--r-- | src/corelib/gfx_widget.pas | 45 | ||||
-rw-r--r-- | src/corelib/gfxbase.pas | 1 | ||||
-rw-r--r-- | src/gui/gui_edit.pas | 5 |
4 files changed, 70 insertions, 29 deletions
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas index 11bf88d7..c1c77b2a 100644 --- a/src/corelib/fpgfx.pas +++ b/src/corelib/fpgfx.pas @@ -110,6 +110,7 @@ type // forward declaration TfpgCanvas = class; + TfpgTimer = class; TfpgWindow = class(TfpgWindowImpl) @@ -203,10 +204,15 @@ type FOnException: TExceptionEvent; FStopOnException: Boolean; FHintWindow: TfpgWindow; + FHintTimer: TfpgTimer; + FHintWidget: TfpgWindow; + FHintPos: TPoint; procedure SetHintPause(const AValue: Integer); procedure SetupLocalizationStrings; procedure InternalMsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; + procedure InternalMsgHintTimer(var msg: TfpgMessageRec); message FPGM_HINTTIMER; procedure CreateHintWindow; + procedure HintTimerFired(Sender: TObject); protected FDisplayParams: string; FScreenWidth: integer; @@ -361,6 +367,7 @@ uses gfx_translations, gfx_constants, gfx_UTF8utils, + gfx_widget, gui_dialogs, gui_hint; @@ -789,10 +796,11 @@ begin FScreenHeight := -1; FMessageHookList := TFPList.Create; FStopOnException := False; - FHintWindow := nil; + FHintWindow := nil; // popup window with Hint text FHintPause := 1500; // 1.5 seconds + FHintWidget := nil; // widget the mouse is over and whos hint text we need. FShowHint := True; - + try inherited Create(AParams); @@ -999,6 +1007,28 @@ begin end; end; +procedure TfpgApplication.InternalMsgHintTimer(var msg: TfpgMessageRec); +begin +// writeln('InternalMsgHintTimer msg'); + if (msg.Params.user.Param1 < 2) then + begin + { MouseEnter occured } + FHintTimer.Enabled := Boolean(msg.Params.user.Param1); + FHintWidget := TfpgWindow(msg.Sender); + end + else + begin + { Handle mouse move information } + FHintPos.X := msg.Params.user.Param2; + FHintPos.Y := msg.Params.user.Param3; + FHintWidget := TfpgWindow(msg.Sender); + if FHintTimer.Enabled then + FHintTimer.Reset // keep reseting to prevent hint from showing + else + HideHint; + end; +end; + procedure TfpgApplication.CreateHintWindow; begin if not Assigned(FHintWindow) then @@ -1008,6 +1038,16 @@ begin end; end; +procedure TfpgApplication.HintTimerFired(Sender: TObject); +var + w: TfpgWidget; +begin +// writeln('HintTimerFired...'); + w := TfpgWidget(FHintWidget); + ActivateHint(w.WindowToScreen(w, FHintPos), w.Hint); + FHintTimer.Enabled := False; +end; + procedure TfpgApplication.FreeFontRes(afontres: TfpgFontResource); var n: integer; @@ -1034,6 +1074,9 @@ begin TranslateResourceStrings(ApplicationName, ExtractFilePath(ParamStr(0)), ''); SetupLocalizationStrings; CreateHintWindow; + + FHintTimer := TfpgTimer.Create(HintPause); + FHintTimer.OnTimer := @HintTimerFired; end; procedure TfpgApplication.Flush; @@ -1109,6 +1152,7 @@ begin {$IFDEF DEBUG} writeln('HideHint'); {$ENDIF} + FHintTimer.Enabled := False; if Assigned(FHintWindow) and TfpgHintWindow(FHintWindow).Visible then TfpgHintWindow(FHintWindow).Hide; end; diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas index 76ee98a1..c16265ec 100644 --- a/src/corelib/gfx_widget.pas +++ b/src/corelib/gfx_widget.pas @@ -62,11 +62,9 @@ type FHint: string; FShowHint: boolean; FParentShowHint: boolean; - FHintTimer: TfpgTimer; FBackgroundColor: TfpgColor; FTextColor: TfpgColor; FIsContainer: Boolean; - FMousePoint: TPoint; procedure SetBackgroundColor(const AValue: TfpgColor); virtual; procedure SetTextColor(const AValue: TfpgColor); virtual; function GetParent: TfpgWidget; reintroduce; @@ -100,7 +98,6 @@ type procedure HandleHide; virtual; procedure MoveAndResize(ALeft, ATop, AWidth, AHeight: TfpgCoord); procedure RePaint; - procedure HintTimerFired(Sender: TObject); { property events } property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnDoubleClick: TMouseButtonEvent read FOnDoubleClick write FOnDoubleClick; @@ -324,9 +321,6 @@ begin FBackgroundColor := clWindowBackground; FTextColor := clText1; - FHintTimer := TfpgTimer.Create(fpgApplication.HintPause); - FHintTimer.OnTimer := @HintTimerFired; - if (AOwner <> nil) and (AOwner is TfpgWidget) then begin Parent := TfpgWidget(AOwner); @@ -666,12 +660,6 @@ begin fpgSendMessage(self, self, FPGM_PAINT); end; -procedure TfpgWidget.HintTimerFired(Sender: TObject); -begin - fpgApplication.ActivateHint(WindowToScreen(Self, FMousePoint), FHint); - FHintTimer.Enabled := False; -end; - procedure TfpgWidget.SetFocus; begin HandleSetFocus; @@ -853,22 +841,24 @@ begin end; procedure TfpgWidget.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); +var + msgp: TfpgMessageParams; begin - FMousePoint := Point(x+2, y+2); + fillchar(msgp, sizeof(msgp), 0); + msgp.user.Param1 := 2; + msgp.user.Param2 := x+10; + msgp.user.Param3 := y+2; + if Assigned(Parent) then begin if fpgApplication.ShowHint and (FShowHint or (FParentShowHint and Parent.ShowHint)) and (FHint <> '') then - if FHintTimer.Enabled then - FHintTimer.Reset // keep reseting to prevent hint from showing - else - fpgApplication.HideHint; + fpgPostMessage(Self, fpgApplication, FPGM_HINTTIMER, msgp); end else + begin if fpgApplication.ShowHint and FShowHint and (FHint <> '') then - if FHintTimer.Enabled then - FHintTimer.Reset // keep reseting to prevent hint from showing - else - fpgApplication.HideHint; + fpgPostMessage(Self, fpgApplication, FPGM_HINTTIMER, msgp); + end; end; procedure TfpgWidget.HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); @@ -877,14 +867,22 @@ begin end; procedure TfpgWidget.HandleMouseEnter; +var + msgp: TfpgMessageParams; + b: boolean; begin {$IFDEF DEBUG} writeln('TfpgWidget.HandleMouseEnter: ' + ClassName); {$ENDIF} + fillchar(msgp, sizeof(msgp), 0); + if Assigned(Parent) then - FHintTimer.Enabled := Enabled and fpgApplication.ShowHint and (FShowHint or (FParentShowHint and Parent.ShowHint)) and (FHint <> '') + b := Enabled and fpgApplication.ShowHint and (FShowHint or (FParentShowHint and Parent.ShowHint)) and (FHint <> '') else - FHintTimer.Enabled := Enabled and fpgApplication.ShowHint and FShowHint and (FHint <> ''); + b := Enabled and fpgApplication.ShowHint and FShowHint and (FHint <> ''); + + msgp.user.Param1 := Ord(b); + fpgPostMessage(Self, fpgApplication, FPGM_HINTTIMER, msgp); end; procedure TfpgWidget.HandleMouseExit; @@ -892,7 +890,6 @@ begin {$IFDEF DEBUG} writeln('TfpgWidget.HandleMouseExit: ' + ClassName); {$ENDIF} - FHintTimer.Enabled := False; if FShowHint then fpgApplication.HideHint; end; diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index fa01996c..a346b2e1 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -77,6 +77,7 @@ const FPGM_RESIZE = 15; FPGM_MOVE = 16; FPGM_POPUPCLOSE = 17; + FPGM_HINTTIMER = 18; FPGM_KILLME = High(Integer); // The special keys, based on the well-known keyboard scan codes diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas index 09820955..dd789a32 100644 --- a/src/gui/gui_edit.pas +++ b/src/gui/gui_edit.pas @@ -710,7 +710,7 @@ var begin hasChanged := False; - FHintTimer.Enabled := False; + fpgApplication.HideHint; Consumed := True; @@ -844,7 +844,7 @@ end; procedure TfpgBaseEdit.HandleLMouseDown(x, y: integer; shiftstate: TShiftState); begin - FHintTimer.Enabled := False; + fpgApplication.HideHint; inherited HandleLMouseDown(x, y, shiftstate); FCursorPx := x; @@ -968,7 +968,6 @@ end; destructor TfpgBaseEdit.Destroy; begin - FHintTimer.Free; if Assigned(FDefaultPopupMenu) then FDefaultPopupMenu.Free; FFont.Free; |