From 39ed58f021a2106bcdcc953b0666692273dd5dee Mon Sep 17 00:00:00 2001 From: juha Date: Fri, 11 Jul 2014 16:31:06 +0000 Subject: [PATCH] IdeIntf: new THintWindowManager to encapsulate hint stuff. Fix THintWindow when it has a sub-control. Make code browser use the new feature. git-svn-id: trunk@45827 - --- components/ideintf/idehelpintf.pas | 124 ++++++++++++++++++++--- ide/codebrowser.pas | 43 +++----- ide/idehelpmanager.pas | 16 ++- lcl/forms.pp | 15 ++- lcl/include/hintwindow.inc | 154 +++++++++++++++++++---------- 5 files changed, 243 insertions(+), 109 deletions(-) diff --git a/components/ideintf/idehelpintf.pas b/components/ideintf/idehelpintf.pas index d5998eaf12..994f690554 100644 --- a/components/ideintf/idehelpintf.pas +++ b/components/ideintf/idehelpintf.pas @@ -66,17 +66,14 @@ type {$ENDIF} procedure ShowHelpForObjectInspector(Sender: TObject); virtual; abstract; procedure ShowHelpForIDEControl(Sender: TControl); virtual; abstract; - function GetHintForSourcePosition(const ExpandedFilename: string; - const CodePos: TPoint; - out BaseURL, HTMLHint: string; - Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; virtual; abstract; function CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint; - const BaseURL: string; var TheHint: string; - out HintWinRect: TRect): boolean; virtual; abstract; - + const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean; + virtual; abstract; deprecated 'Use THintWindowManager class instead'; + function GetHintForSourcePosition(const ExpandedFilename: string; + const CodePos: TPoint; out BaseURL, HTMLHint: string; + Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; virtual; abstract; function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint; - const Filename: string): TPascalHelpContextList; virtual; abstract; - + const Filename: string): TPascalHelpContextList; virtual; abstract; // fpdoc function GetFPDocFilenameForSource(SrcFilename: string; ResolveIncludeFiles: Boolean; @@ -137,7 +134,6 @@ type ihcScrollable, ihcWithClipboardMenu ); - TIDEHTMLControlFlags = set of TIDEHTMLControlFlag; TCreateIDEHTMLControlEvent = @@ -146,19 +142,38 @@ type TCreateIDEHTMLProviderEvent = function(Owner: TComponent): TAbstractIDEHTMLProvider; + { THintWindowManager } + + THintWindowManager = class + FHintWindowClass: THintWindowClass; + FHintWindow: THintWindow; + FHtmlHelpProvider: TAbstractIDEHTMLProvider; + FBaseURL: string; + FFlags: TIDEHTMLControlFlags; + private + function HtmlHelpProvider: TAbstractIDEHTMLProvider; + public + constructor Create; overload; + constructor Create(AHintWindowClass: THintWindowClass); overload; + destructor Destroy; override; + function ShowHint(ScreenPos: TPoint; TheHint: string): boolean; + procedure HideHint; + public + property BaseURL: string read FBaseURL write FBaseURL; + property Flags: TIDEHTMLControlFlags read FFlags write FFlags; + end; + var CreateIDEHTMLControl: TCreateIDEHTMLControlEvent = nil;// will be set by the IDE // and can be overidden by a package like turbopoweriprodsgn.lpk CreateIDEHTMLProvider: TCreateIDEHTMLProviderEvent = nil;// will be set by the IDE -var FPCKeyWordHelpPrefix: string = 'FPCKeyword_'; FPCDirectiveHelpPrefix: string = 'FPCDirective_'; IDEDirectiveHelpPrefix: string = 'IDEDirective_'; implementation - { THelpDBIRegExprMessage } constructor THelpDBIRegExprMessage.Create(TheNode: THelpNode; @@ -195,8 +210,7 @@ begin inherited Destroy; end; -function TAbstractIDEHTMLProvider.MakeURLAbsolute(const aBaseURL, aURL: string - ): string; +function TAbstractIDEHTMLProvider.MakeURLAbsolute(const aBaseURL, aURL: string): string; var URLType: string; URLPath: string; @@ -219,5 +233,87 @@ begin end; end; +{ THintWindowManager } + +constructor THintWindowManager.Create; +begin + inherited Create; + FHintWindowClass := THintWindow; + FFlags := [ihcWithClipboardMenu]; +end; + +constructor THintWindowManager.Create(AHintWindowClass: THintWindowClass); +begin + Create; // Constructor above + FHintWindowClass := AHintWindowClass; +end; + +destructor THintWindowManager.Destroy; +begin + FreeAndNil(FHintWindow); + inherited Destroy; +end; + +function THintWindowManager.HtmlHelpProvider: TAbstractIDEHTMLProvider; +var + HelpControl: TControl; +begin + if FHtmlHelpProvider = nil then + begin + //Include(FFlags, ihcScrollable); // Debug (memo control does not work) + HelpControl := CreateIDEHTMLControl(FHintWindow, FHtmlHelpProvider, FFlags); + HelpControl.Parent := FHintWindow; + HelpControl.Align := alClient; + end; + Result := FHtmlHelpProvider; +end; + +function THintWindowManager.ShowHint(ScreenPos: TPoint; TheHint: string): boolean; +var + ms: TMemoryStream; + NewWidth, NewHeight: integer; +begin + Result:=true; + if TheHint = '' then exit; + if FHintWindow <> nil then + FHintWindow.Visible := false; // ??? + if FHintWindow = nil then + FHintWindow := FHintWindowClass.Create(Nil); + if CompareText(copy(TheHint,1,6),'')=0 then // Text is HTML + begin + HtmlHelpProvider.BaseURL:=FBaseURL; + ms:=TMemoryStream.Create; + try + if TheHint<>'' then + ms.Write(TheHint[1],length(TheHint)); + ms.Position:=0; + HtmlHelpProvider.ControlIntf.SetHTMLContent(ms,''); + finally + ms.Free; + end; + HtmlHelpProvider.ControlIntf.GetPreferredControlSize(NewWidth,NewHeight); + if NewWidth <= 0 then + NewWidth := 500; + if NewHeight <= 0 then + NewHeight := 200; + FHintWindow.HintRect := Rect(0, 0, NewWidth, NewHeight); + FHintWindow.OffsetHintRect(ScreenPos); + //DebugLn('--- ShowHint with HTML formatting ---'); + FHintWindow.ActivateHint; + end + else begin // Plain text + FHintWindow.CalcHintRect(Screen.Width, TheHint, nil); + FHintWindow.OffsetHintRect(ScreenPos); + //DebugLn('--- ShowHint plain text ---'); + FHintWindow.ActivateHint(TheHint); + end; +end; + +procedure THintWindowManager.HideHint; +begin + if Assigned(FHintWindow) then + FHintWindow.Visible := False; +end; + end. diff --git a/ide/codebrowser.pas b/ide/codebrowser.pas index 1550077e92..82df7e63b7 100644 --- a/ide/codebrowser.pas +++ b/ide/codebrowser.pas @@ -255,7 +255,7 @@ type procedure ShowPrivateCheckBoxChange(Sender: TObject); procedure ShowUnitsCheckBoxChange(Sender: TObject); private - FHintWindow: THintWindow; + FHintManager: THintWindowManager; FIDEDescription: string; FIdleConnected: boolean; FOptions: TCodeBrowserViewOptions; @@ -470,14 +470,14 @@ end; procedure TCodeBrowserView.FormCreate(Sender: TObject); begin - FHintWindow := nil; + FHintManager:=THintWindowManager.Create; FOptions:=TCodeBrowserViewOptions.Create; FIDEDescription:=lisLazarusIDE; FProjectDescription:=dlgProject; Name:=NonModalIDEWindowNames[nmiwCodeBrowser]; - Caption := lisCodeBrowser; + Caption:=lisCodeBrowser; ScopeGroupBox.Caption:=dlgScope; ScopeWithRequiredPackagesCheckBox.Caption:=lisWithRequiredPackages; @@ -534,6 +534,7 @@ begin FreeAndNil(FParserRoot); FreeAndNil(FWorkingParserRoot); FreeAndNil(FOptions); + FreeAndNil(FHintManager); IdleConnected:=false; end; @@ -2501,7 +2502,7 @@ begin if Line>0 then Result:=Result+' ('+IntToStr(Line)+','+IntToStr(Column)+')'; if GetCodeHelp(TVNode, BaseURL, HTMLHint) then - Result := HTMLHint; + Result := HTMLHint; end; end; end; @@ -2903,43 +2904,26 @@ begin InvalidateStage(cbwsGetViewOptions); end; -procedure TCodeBrowserView.BrowseTreeViewShowHint(Sender: TObject; - HintInfo: PHintInfo); +procedure TCodeBrowserView.BrowseTreeViewShowHint(Sender: TObject; HintInfo: PHintInfo); var TVNode: TTreeNode; HintStr: String; - MousePos: TPoint; HintWinRect : TRect; begin //DebugLn(['TCodeBrowserView.BrowseTreeViewShowHint ',dbgs(HintInfo^.CursorPos)]); HintStr:=''; - MousePos:=HintInfo^.CursorPos; - TVNode:=BrowseTreeView.GetNodeAt(MousePos.X,MousePos.Y); - if TVNode<>nil then begin + TVNode:=BrowseTreeView.GetNodeAt(HintInfo^.CursorPos.X, HintInfo^.CursorPos.Y); + if TVNode<>nil then HintStr:=GetTVNodeHint(TVNode); - //DebugLn(['TCodeBrowserView.BrowseTreeViewShowHint HintStr="',HintStr,'"']); - end; - - HintInfo^.HintStr:=''; // do not use the normal mechanism - - // open a THintWindow with LazarusHelp instead - if hintstr = '' then - exit; + HintInfo^.HintStr:=''; // do not use the normal mechanism, + // ... open a THintWindow with LazarusHelp instead if csDestroying in ComponentState then exit; - if FHintWindow <> nil then - FHintWindow.Visible := false; - if FHintWindow = nil then - FHintWindow := THintWindow.Create(Self); - if LazarusHelp.CreateHint(FHintWindow, HintInfo^.HintPos, '', HintStr, HintWinRect) then - FHintWindow.ActivateHint(HintWinRect, HintStr); + FHintManager.ShowHint(HintInfo^.HintPos, HintStr); end; procedure TCodeBrowserView.CloseHintWindow; begin - if FHintWindow <> nil then begin - FHintWindow.Close; - FHintWindow := nil; - end; + FHintManager.HideHint; end; procedure TCodeBrowserView.CollapseAllPackagesMenuItemClick(Sender: TObject); @@ -3178,8 +3162,7 @@ var SubPath: String; begin Clear; - WithRequiredPackages:= - ConfigStore.GetValue(Path+'WithRequiredPackages/Value',false); + WithRequiredPackages:=ConfigStore.GetValue(Path+'WithRequiredPackages/Value',false); Scope:=ConfigStore.GetValue(Path+'Scope/Value','Project'); ShowPrivate:=ConfigStore.GetValue(Path+'ShowPrivate/Value',false); ShowProtected:=ConfigStore.GetValue(Path+'ShowProtected/Value',true); diff --git a/ide/idehelpmanager.pas b/ide/idehelpmanager.pas index f822157c14..320fa8d92b 100644 --- a/ide/idehelpmanager.pas +++ b/ide/idehelpmanager.pas @@ -187,14 +187,15 @@ type FFCLHelpDB: THelpDatabase; FFCLHelpDBPath: THelpBaseURLObject; FHTMLProviders: TLIHProviders; - FHtmlHelpProvider: TAbstractIDEHTMLProvider; - FHintWindow: THintWindow; FLCLHelpDB: THelpDatabase; FLCLHelpDBPath: THelpBaseURLObject; FMainHelpDB: THelpDatabase; FMainHelpDBPath: THelpBasePathObject; FRTLHelpDB: THelpDatabase; FRTLHelpDBPath: THelpBaseURLObject; + // Used by CreateHint + FHtmlHelpProvider: TAbstractIDEHTMLProvider; + FHintWindow: THintWindow; function HtmlHelpProvider: TAbstractIDEHTMLProvider; procedure RegisterIDEHelpDatabases; procedure RegisterDefaultIDEHelpViewers; @@ -221,15 +222,12 @@ type {$ENDIF} procedure ShowHelpForObjectInspector(Sender: TObject); override; procedure ShowHelpForIDEControl(Sender: TControl); override; - function CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint; - const BaseURL: string; var TheHint: string; - out HintWinRect: TRect): boolean; override; + const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean; + override; deprecated; function GetHintForSourcePosition(const ExpandedFilename: string; - const CodePos: TPoint; - out BaseURL, HTMLHint: string; - Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; override; - + const CodePos: TPoint; out BaseURL, HTMLHint: string; + Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; override; function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint; const Filename: string): TPascalHelpContextList; override; function ConvertCodePosToPascalHelpContext( diff --git a/lcl/forms.pp b/lcl/forms.pp index 507bbfb0ba..865019d905 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -837,13 +837,17 @@ type private FActivating: Boolean; FAlignment: TAlignment; + FHintRect: TRect; + FHintData: Pointer; FAutoHide: Boolean; FAutoHideTimer: TCustomTimer; FHideInterval: Integer; + procedure AdjustBoundsForMonitor; function GetDrawTextFlags: Cardinal; procedure SetAutoHide(Value : Boolean); procedure AutoHideHint(Sender : TObject); procedure SetHideInterval(Value : Integer); + procedure SetHintRect(AValue: TRect); protected class procedure WSRegisterClass; override; procedure WMNCHitTest(var Message: TLMessage); message LM_NCHITTEST; @@ -854,11 +858,14 @@ type public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure ActivateHint(ARect: TRect; const AHint: String); virtual; - procedure ActivateHintData(ARect: TRect; const AHint: String; - AData: pointer); virtual; + procedure ActivateHint; virtual; + procedure ActivateHint(const AHint: String); virtual; + procedure ActivateHint(ARect: TRect; const AHint: String); + procedure ActivateHintData(ARect: TRect; const AHint: String; AData: pointer); + deprecated 'Set HintData explicitly'; function CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect; virtual; + function OffsetHintRect(NewPos: TPoint; dy: Integer = 30): Boolean; procedure InitializeWnd; override; procedure ReleaseHandle; procedure Paint; override; @@ -866,6 +873,8 @@ type class function GetControlClassDefaultSize: TSize; override; public property Alignment: TAlignment read FAlignment write FAlignment; + property HintRect: TRect read FHintRect write SetHintRect; + property HintData: Pointer read FHintData write FHintData; property AutoHide: Boolean read FAutoHide write SetAutoHide; property BiDiMode; property HideInterval: Integer read FHideInterval write SetHideInterval; diff --git a/lcl/include/hintwindow.inc b/lcl/include/hintwindow.inc index fb29a6cb5c..9bfc71fcfd 100644 --- a/lcl/include/hintwindow.inc +++ b/lcl/include/hintwindow.inc @@ -31,7 +31,7 @@ begin Canvas.Brush.Style := bsClear; FAlignment := taLeftJustify; BorderStyle := bsNone; - Caption := 'THintWindow'; + Caption := ''; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); FHideInterval := 3000; @@ -55,6 +55,14 @@ Begin FAutoHideTimer.Interval := FHideInterval; end; +procedure THintWindow.SetHintRect(AValue: TRect); +begin + FHintRect := AValue; + // Add border + inc(FHintRect.Right, 4 * HintBorderWidth); + inc(FHintRect.Bottom, 4 * HintBorderWidth); +end; + class procedure THintWindow.WSRegisterClass; begin inherited WSRegisterClass; @@ -145,17 +153,14 @@ procedure THintWindow.AutoHideHint(Sender : TObject); begin if Assigned(FAutoHideTimer) then FAutoHideTimer.Enabled := False; - if Visible then - Visible := False; + Visible := False; end; procedure THintWindow.Paint; -var - ARect: TRect; - Details: TThemedElementDetails; -begin - ARect := ClientRect; - if UseThemes then + + procedure DrawWithThemes(ARect: TRect); + var + Details: TThemedElementDetails; begin // draw using themes Details := ThemeServices.GetElementDetails(tttStandardNormal); @@ -163,8 +168,9 @@ begin // ARect := ThemeServices.ContentRect(Canvas.Handle, Details, ARect); InflateRect(ARect, -2 * HintBorderWidth, -2 * HintBorderWidth); ThemeServices.DrawText(Canvas, Details, Caption, ARect, GetDrawTextFlags, 0); - end - else + end; + + procedure DrawNormal(ARect: TRect); begin Canvas.Brush.Color := Color; Canvas.Pen.Width := 1; @@ -174,6 +180,14 @@ begin DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(Caption), Length(Caption), ARect, GetDrawTextFlags); end; + +begin + if ControlCount > 0 then + inherited Paint // The window has a custom control. + else if UseThemes then + DrawWithThemes(ClientRect) + else + DrawNormal(ClientRect); end; procedure THintWindow.SetBounds(ALeft, ATop, AWidth, AHeight: integer); @@ -188,46 +202,39 @@ begin Result.CY := 25; end; -procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String); -var - InvalidateNeeded: Boolean; - AMonitor: TMonitor; - ABounds: TRect; +procedure THintWindow.ActivateHint; begin if FActivating then exit; FActivating := True; try - //debugln('THintWindow.ActivateHint OldHint="',DbgStr(Caption),'" NewHint="',DbgStr(AHint),'"'); - InvalidateNeeded := Visible and (Caption <> AHint); - Caption := AHint; - AMonitor := Screen.MonitorFromPoint(ARect.TopLeft); - ABounds := AMonitor.BoundsRect; + SetBounds(FHintRect.Left, FHintRect.Top, + FHintRect.Right - FHintRect.Left, FHintRect.Bottom - FHintRect.Top); + Visible := True; + FAutoHideTimer.Enabled := False; + FAutoHideTimer.Enabled := FAutoHide; + Invalidate; + finally + FActivating := False; + end; +end; - // offset hint to fit into monitor - if ARect.Bottom > ABounds.Bottom then - begin - ARect.Top := ABounds.Bottom - (ARect.Bottom - ARect.Top); - ARect.Bottom := ABounds.Bottom; +procedure THintWindow.ActivateHint(const AHint: String); +var + InvalidateNeeded: Boolean; +begin + if FActivating then exit; + FActivating := True; + try + if ControlCount > 0 then begin + InvalidateNeeded := Visible and (Controls[0].Caption <> AHint); + Controls[0].Caption := AHint; + end + else begin + InvalidateNeeded := Visible and (Caption <> AHint); + Caption := AHint; end; - if ARect.Top < ABounds.Top then - begin - ARect.Bottom := Min(ABounds.Top + (ARect.Bottom - ARect.Top), ABounds.Bottom); - ARect.Top := ABounds.Top; - end; - - if ARect.Right > ABounds.Right then - begin - ARect.Left := ABounds.Right - (ARect.Right - ARect.Left); - ARect.Right := ABounds.Right; - end; - if ARect.Left < ABounds.Left then - begin - ARect.Right:= Min(ABounds.Left + (ARect.Right - ARect.Left), ABounds.Right); - ARect.Left := ABounds.Left; - end; - - SetBounds(ARect.Left, ARect.Top, - ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); + SetBounds(FHintRect.Left, FHintRect.Top, + FHintRect.Right - FHintRect.Left, FHintRect.Bottom - FHintRect.Top); Visible := True; FAutoHideTimer.Enabled := False; FAutoHideTimer.Enabled := FAutoHide; @@ -237,9 +244,16 @@ begin end; end; +procedure THintWindow.ActivateHint(ARect: TRect; const AHint: String); +begin + HintRect := ARect; + AdjustBoundsForMonitor; + ActivateHint(AHint); +end; + procedure THintWindow.ActivateHintData(ARect: TRect; const AHint: String; AData: pointer); begin - ActivateHint(ARect, AHint); + ActivateHint(ARect, AHint); // AData is not used now. end; function THintWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; @@ -248,10 +262,7 @@ var Flags: Cardinal; begin if AHint = '' then - begin - Result := Rect(0, 0, 0, 0); - Exit; - end; + Exit(Rect(0, 0, 0, 0)); if MaxWidth <= 0 then MaxWidth := Screen.Width - 4 * HintBorderWidth; Result := Rect(0, 0, MaxWidth, Screen.Height - 4 * HintBorderWidth); @@ -262,12 +273,49 @@ begin ThemeServices.GetElementDetails(tttStandardNormal), AHint, Flags, @Result) else DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(AHint), Length(AHint), - Result, Flags); - inc(Result.Right, 4 * HintBorderWidth); - inc(Result.Bottom, 4 * HintBorderWidth); + Result, Flags); + HintRect := Result; // Adds borders. //debugln('THintWindow.CalcHintRect Result=',dbgs(Result)); end; +procedure THintWindow.AdjustBoundsForMonitor; +var + AMonitor: TMonitor; + ABounds: TRect; +begin + AMonitor := Screen.MonitorFromPoint(FHintRect.TopLeft); + ABounds := AMonitor.BoundsRect; + + // offset hint to fit into monitor + if FHintRect.Bottom > ABounds.Bottom then + begin + FHintRect.Top := ABounds.Bottom - (FHintRect.Bottom - FHintRect.Top); + FHintRect.Bottom := ABounds.Bottom; + end; + if FHintRect.Top < ABounds.Top then + begin + FHintRect.Bottom := Min(ABounds.Top + (FHintRect.Bottom - FHintRect.Top), ABounds.Bottom); + FHintRect.Top := ABounds.Top; + end; + + if FHintRect.Right > ABounds.Right then + begin + FHintRect.Left := ABounds.Right - (FHintRect.Right - FHintRect.Left); + FHintRect.Right := ABounds.Right; + end; + if FHintRect.Left < ABounds.Left then + begin + FHintRect.Right:= Min(ABounds.Left + (FHintRect.Right - FHintRect.Left), ABounds.Right); + FHintRect.Left := ABounds.Left; + end; +end; + +function THintWindow.OffsetHintRect(NewPos: TPoint; dy: Integer): Boolean; +begin + OffsetRect(FHintRect, NewPos.X, NewPos.Y + dy); + AdjustBoundsForMonitor; +end; + procedure THintWindow.InitializeWnd; begin inherited InitializeWnd;