paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 10:18:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

IdeIntf: new THintWindowManager to encapsulate hint stuff. Fix THintWindow when it has a sub-control. Make code browser use the new feature.

Browse Source 
git-svn-id: trunk@45827 -
This commit is contained in:
juha 2014-07-11 16:31:06 +00:00
parent 7e4684a637
commit 39ed58f021
5 changed files with 243 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
components/ideintf/idehelpintf.pas
View File

@ -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),'<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.

43
ide/codebrowser.pas
View File

@ -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);

16
ide/idehelpmanager.pas
View File

@ -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(

15
lcl/forms.pp
View File

@ -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;

154
lcl/include/hintwindow.inc
View File

@ -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;