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

@@ -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;
+      const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean;
-                    out HintWinRect: TRect): boolean; virtual; abstract;
+      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
+function TAbstractIDEHTMLProvider.MakeURLAbsolute(const aBaseURL, aURL: string): 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),'<HTML>')=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.
 

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;
+procedure TCodeBrowserView.BrowseTreeViewShowHint(Sender: TObject; HintInfo: PHintInfo);
-  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(HintInfo^.CursorPos.X, HintInfo^.CursorPos.Y);
-  TVNode:=BrowseTreeView.GetNodeAt(MousePos.X,MousePos.Y);
+  if TVNode<>nil then
-  if TVNode<>nil then begin
     HintStr:=GetTVNodeHint(TVNode);
-    //DebugLn(['TCodeBrowserView.BrowseTreeViewShowHint HintStr="',HintStr,'"']);
+  HintInfo^.HintStr:=''; // do not use the normal mechanism,
-  end;
+  // ... open a THintWindow with LazarusHelp instead
-
-  HintInfo^.HintStr:=''; // do not use the normal mechanism
-
-  // open a THintWindow with LazarusHelp instead
-  if hintstr = '' then
-     exit;
   if csDestroying in ComponentState then exit;
-  if FHintWindow <> nil then
+  FHintManager.ShowHint(HintInfo^.HintPos, HintStr);
-    FHintWindow.Visible := false;
-  if FHintWindow = nil then
-    FHintWindow := THintWindow.Create(Self);
-  if LazarusHelp.CreateHint(FHintWindow, HintInfo^.HintPos, '', HintStr, HintWinRect) then
-      FHintWindow.ActivateHint(HintWinRect, HintStr);
 end;
 
 procedure TCodeBrowserView.CloseHintWindow;
 begin
-  if FHintWindow <> nil then begin
+  FHintManager.HideHint;
-    FHintWindow.Close;
-    FHintWindow := nil;
-  end;
 end;
 
 procedure TCodeBrowserView.CollapseAllPackagesMenuItemClick(Sender: TObject);
@@ -3178,8 +3162,7 @@ var
   SubPath: String;
 begin
   Clear;
-  WithRequiredPackages:=
+  WithRequiredPackages:=ConfigStore.GetValue(Path+'WithRequiredPackages/Value',false);
-                  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);

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;
+      const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean;
-                    out HintWinRect: TRect): boolean; override;
+      override; deprecated;
     function GetHintForSourcePosition(const ExpandedFilename: string;
-                  const CodePos: TPoint;
+      const CodePos: TPoint; out BaseURL, HTMLHint: string;
-                  out BaseURL, HTMLHint: string;
+      Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; override;
-                  Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; override;
-
     function ConvertSourcePosToPascalHelpContext(const CaretPos: TPoint;
                const Filename: string): TPascalHelpContextList; override;
     function ConvertCodePosToPascalHelpContext(

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 ActivateHint; virtual;
-    procedure ActivateHintData(ARect: TRect; const AHint: String;
+    procedure ActivateHint(const AHint: String); virtual;
-                               AData: pointer); 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;

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;
+  procedure DrawWithThemes(ARect: TRect);
-  Details: TThemedElementDetails;
+  var
-begin
+    Details: TThemedElementDetails;
-  ARect := ClientRect;
-  if UseThemes then
   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
+  end;
-  else
+
+  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);
+procedure THintWindow.ActivateHint;
-var
-  InvalidateNeeded: Boolean;
-  AMonitor: TMonitor;
-  ABounds: TRect;
 begin
   if FActivating then exit;
   FActivating := True;
   try
-    //debugln('THintWindow.ActivateHint OldHint="',DbgStr(Caption),'" NewHint="',DbgStr(AHint),'"');
+    SetBounds(FHintRect.Left, FHintRect.Top,
-    InvalidateNeeded := Visible and (Caption <> AHint);
+              FHintRect.Right - FHintRect.Left, FHintRect.Bottom - FHintRect.Top);
-    Caption := AHint;
+    Visible := True;
-    AMonitor := Screen.MonitorFromPoint(ARect.TopLeft);
+    FAutoHideTimer.Enabled := False;
-    ABounds := AMonitor.BoundsRect;
+    FAutoHideTimer.Enabled := FAutoHide;
+    Invalidate;
+  finally
+    FActivating := False;
+  end;
+end;
 
-    // offset hint to fit into monitor
+procedure THintWindow.ActivateHint(const AHint: String);
-    if ARect.Bottom > ABounds.Bottom then
+var
-    begin
+  InvalidateNeeded: Boolean;
-      ARect.Top := ABounds.Bottom - (ARect.Bottom - ARect.Top);
+begin
-      ARect.Bottom := ABounds.Bottom;
+  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
+    SetBounds(FHintRect.Left, FHintRect.Top,
-    begin
+              FHintRect.Right - FHintRect.Left, FHintRect.Bottom - FHintRect.Top);
-      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);
     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
+    Exit(Rect(0, 0, 0, 0));
-    Result := Rect(0, 0, 0, 0);
-    Exit;
-  end;
   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);
+             Result, Flags);
-  inc(Result.Right, 4 * HintBorderWidth);
+  HintRect := Result;      // Adds borders.
-  inc(Result.Bottom, 4 * HintBorderWidth);
   //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;