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

IdeIntf: use 2 hint windows in THintWindowManager, one for text and one for rendered HTML.

Browse Source 
git-svn-id: trunk@45938 -
This commit is contained in:
juha 2014-07-20 18:27:21 +00:00
parent 24ce977ee8
commit ba96b04000
8 changed files with 139 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

132
components/ideintf/idehelpintf.pas
View File

@ -142,11 +142,17 @@ type
TCreateIDEHTMLProviderEvent =
function(Owner: TComponent): TAbstractIDEHTMLProvider;
{ THintWindowManager }
THintWindowManager = class
private
FHintWindowClass: THintWindowClass;
// 2 HintWindows, one for simple text and one for rendered hint with child control.
// Only one is visible at a time.
FHintTextW: THintWindow;
FHintRenderW: THintWindowRendered;
FCurrentHintW: THintWindow; // One of the windows or Nil.
// Provider for the rendered hint.
FHtmlHelpProvider: TAbstractIDEHTMLProvider;
FBaseURL: string;
FFlags: TIDEHTMLControlFlags;
@ -154,27 +160,30 @@ type
// These will be passed to HintWindow.
FAutoHide: Boolean;
FHideInterval: Integer;
FOnMouseDown: TMouseEvent;
FWindowName: string;
function HtmlHelpProvider: TAbstractIDEHTMLProvider;
function HintTextWindow: THintWindow;
function HintRenderWindow: THintWindowRendered;
procedure SetAutoHide(AValue: Boolean);
procedure SetHideInterval(AValue: Integer);
procedure SetOnMouseDown(AValue: TMouseEvent);
procedure SetWindowName(AValue: string);
protected
FHintWindow: THintWindow;
public
constructor Create; overload;
constructor Create(AHintWindowClass: THintWindowClass); overload;
destructor Destroy; override;
function HintWindow: THintWindow;
function HintIsVisible: boolean;
function ShowHint(ScreenPos: TPoint; TheHint: string): boolean;
procedure HideHint;
procedure HideIfVisible;
public
property CurHintWindow: THintWindow read FCurrentHintW;
property BaseURL: string read FBaseURL write FBaseURL;
property Flags: TIDEHTMLControlFlags read FFlags write FFlags;
property AutoHide: Boolean read FAutoHide write SetAutoHide;
property HideInterval: Integer read FHideInterval write SetHideInterval;
property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
property WindowName: string read FWindowName write SetWindowName;
end;
@ -253,39 +262,50 @@ end;
constructor THintWindowManager.Create;
begin
inherited Create;
FHintWindowClass := THintWindow;
FFlags := [ihcWithClipboardMenu];
FHideInterval := 3000;
end;
constructor THintWindowManager.Create(AHintWindowClass: THintWindowClass);
begin
Create; // Constructor above
FHintWindowClass := AHintWindowClass;
end;
destructor THintWindowManager.Destroy;
begin
FreeAndNil(FHintWindow);
FreeAndNil(FHintRenderW);
FreeAndNil(FHintTextW);
inherited Destroy;
end;
function THintWindowManager.HintWindow: THintWindow;
function THintWindowManager.HintTextWindow: THintWindow;
begin
if FHintWindow = nil then
if FHintTextW = nil then
begin
FHintWindow := FHintWindowClass.Create(Nil);
FHintWindow.AutoHide := FAutoHide;
FHintWindow.HideInterval := FHideInterval;
FHintTextW := THintWindow.Create(Nil);
FHintTextW.AutoHide := FAutoHide;
FHintTextW.HideInterval := FHideInterval;
FHintTextW.OnMouseDown := FOnMouseDown;
if FWindowName <> '' then
FHintWindow.Name := FWindowName;
FHintTextW.Name := FWindowName;
end;
Result := FHintWindow;
FCurrentHintW := FHintTextW;
Result := FHintTextW;
end;
function THintWindowManager.HintRenderWindow: THintWindowRendered;
begin
if FHintRenderW = nil then
begin
FHintRenderW := THintWindowRendered.Create(Nil);
FHintRenderW.AutoHide := FAutoHide;
FHintRenderW.HideInterval := FHideInterval;
FHintRenderW.OnMouseDown := FOnMouseDown;
if FWindowName <> '' then
FHintRenderW.Name := FWindowName;
end;
FCurrentHintW := FHintRenderW;
Result := FHintRenderW;
end;
function THintWindowManager.HintIsVisible: boolean;
begin
Result := Assigned(FHintWindow) and FHintWindow.Visible;
Result := Assigned(FCurrentHintW) and FCurrentHintW.Visible;
end;
function THintWindowManager.HtmlHelpProvider: TAbstractIDEHTMLProvider;
@ -295,8 +315,8 @@ begin
if FHtmlHelpProvider = nil then
begin
//Include(FFlags, ihcScrollable); // Debug (memo hint control does not work)
HelpControl := CreateIDEHTMLControl(HintWindow, FHtmlHelpProvider, FFlags);
HelpControl.Parent := HintWindow;
HelpControl := CreateIDEHTMLControl(HintRenderWindow, FHtmlHelpProvider, FFlags);
HelpControl.Parent := HintRenderWindow;
HelpControl.Align := alClient;
end;
Result := FHtmlHelpProvider;
@ -306,12 +326,15 @@ function THintWindowManager.ShowHint(ScreenPos: TPoint; TheHint: string): boolea
var
ms: TMemoryStream;
NewWidth, NewHeight: integer;
begin
if TheHint = '' then Exit(False);
FOrigMousePos := Mouse.CursorPos;
if FHintWindow <> nil then
FHintWindow.Visible := false; // ???
if CompareText(copy(TheHint,1,6),'<HTML>')=0 then // Text is HTML
procedure DoText;
begin
HintTextWindow.CalcHintRect(Screen.Width, TheHint);
HintTextWindow.OffsetHintRect(ScreenPos);
HintTextWindow.ActivateText(TheHint);
end;
procedure DoHtml;
begin
HtmlHelpProvider.BaseURL:=FBaseURL;
ms:=TMemoryStream.Create;
@ -328,56 +351,65 @@ begin
NewWidth := 500;
if NewHeight <= 0 then
NewHeight := 200;
HintWindow.HintRectAdjust := Rect(0, 0, NewWidth, NewHeight);
HintWindow.OffsetHintRect(ScreenPos);
//DebugLn('--- ShowHint with HTML formatting ---');
HintWindow.ActivateRendered;
end
else begin // Plain text
HintWindow.CalcHintRect(Screen.Width, TheHint);
HintWindow.OffsetHintRect(ScreenPos);
//DebugLn('--- ShowHint plain text ---');
HintWindow.ActivateText(TheHint);
HintRenderWindow.HintRectAdjust := Rect(0, 0, NewWidth, NewHeight);
HintRenderWindow.OffsetHintRect(ScreenPos);
HintRenderWindow.ActivateRendered;
end;
begin
if TheHint = '' then Exit(False);
FOrigMousePos := Mouse.CursorPos;
if FHintTextW <> nil then
FHintTextW.Visible := false;
if FHintRenderW <> nil then
FHintRenderW.Visible := false;
if CompareText(copy(TheHint,1,6),'<HTML>')=0 then // Text is HTML
DoHtml
else // Plain text
DoText;
Result:=True;
end;
procedure THintWindowManager.HideHint;
begin
if Assigned(FHintWindow) then
FHintWindow.Visible := False;
if Assigned(FCurrentHintW) then
FCurrentHintW.Visible := False;
end;
procedure THintWindowManager.HideIfVisible;
begin
if HintIsVisible then
FHintWindow.Visible := False;
FCurrentHintW.Visible := False;
end;
// Setters
procedure THintWindowManager.SetAutoHide(AValue: Boolean);
begin
if FAutoHide = AValue then Exit;
FAutoHide := AValue;
if Assigned(FHintWindow) then
FHintWindow.AutoHide := FAutoHide;
if Assigned(FHintTextW) then FHintTextW.AutoHide := FAutoHide;
if Assigned(FHintRenderW) then FHintRenderW.AutoHide := FAutoHide;
end;
procedure THintWindowManager.SetHideInterval(AValue: Integer);
begin
if FHideInterval = AValue then Exit;
FHideInterval := AValue;
if Assigned(FHintWindow) then
FHintWindow.HideInterval := FHideInterval;
if Assigned(FHintTextW) then FHintTextW.HideInterval := FHideInterval;
if Assigned(FHintRenderW) then FHintRenderW.HideInterval := FHideInterval;
end;
procedure THintWindowManager.SetOnMouseDown(AValue: TMouseEvent);
begin
FOnMouseDown:=AValue;
if Assigned(FHintTextW) then FHintTextW.OnMouseDown := FOnMouseDown;
if Assigned(FHintRenderW) then FHintRenderW.OnMouseDown := FOnMouseDown;
end;
procedure THintWindowManager.SetWindowName(AValue: string);
begin
if FWindowName = AValue then Exit;
FWindowName := AValue;
if Assigned(FHintWindow) then
FHintWindow.Name := FWindowName;
if Assigned(FHintTextW) then FHintTextW.Name := FWindowName;
if Assigned(FHintRenderW) then FHintRenderW.Name := FWindowName;
end;
end.

2
components/ideintf/objectinspector.lfm
View File

@ -8,7 +8,7 @@ object ObjectInspectorDlg: TObjectInspectorDlg
ClientHeight = 669
ClientWidth = 300
KeyPreview = True
LCLVersion = '1.1'
LCLVersion = '1.3'
object StatusBar: TStatusBar
Left = 0
Height = 22

12
components/ideintf/objectinspector.pp
View File

@ -805,12 +805,6 @@ implementation
uses
math;
type
TOIHintWindow = class(THintWindow)
//public - For some reason the protected THintWindow.OnMouseDown is available, too.
// property OnMouseDown;
end;
const
DefaultOIPageNames: array[TObjectInspectorPage] of shortstring = (
'PropertyPage',
@ -984,7 +978,7 @@ begin
Parent:=Self;
end;
FHintManager := THintWindowManager.Create(TOIHintWindow);
FHintManager := THintWindowManager.Create;
FActiveRowBmp := CreateBitmapFromResourceName(HInstance, 'pg_active_row');
if DefItemHeight<3 then
@ -1039,7 +1033,7 @@ begin
FHintTimer.Enabled := False;
FHintTimer.OnTimer := @HintTimer;
TOIHintWindow(FHintManager.HintWindow).OnMouseDown := @HintMouseDown;
FHintManager.OnMouseDown := @HintMouseDown;
FHintManager.WindowName := 'This_is_a_hint_window';
FHintManager.HideInterval := 4000;
FHintManager.AutoHide := True;
@ -2418,7 +2412,7 @@ var
pos: TPoint;
begin
if FHintManager.HintIsVisible then begin
pos := ScreenToClient(FHintManager.HintWindow.ClientToScreen(Point(X, Y)));
pos := ScreenToClient(FHintManager.CurHintWindow.ClientToScreen(Point(X, Y)));
MouseDown(Button, Shift, pos.X, pos.Y);
end;
end;

15
ide/idehelpmanager.pas
View File

@ -1768,14 +1768,13 @@ end;
function TIDEHintWindowManager.HintIsComplex: boolean;
begin
Result := Assigned(FHintWindow) and FHintWindow.Visible
and (FHintWindow.ControlCount > 0)
and not (FHintWindow.Controls[0] is TSimpleHTMLControl);
Result := HintIsVisible and (CurHintWindow.ControlCount > 0)
and not (CurHintWindow.Controls[0] is TSimpleHTMLControl);
end;
function TIDEHintWindowManager.PtIsOnHint(Pt: TPoint): boolean;
begin
Result := PtInRect(FHintWindow.BoundsRect, Pt);
Result := PtInRect(CurHintWindow.BoundsRect, Pt);
end;
function TIDEHintWindowManager.SenderIsHintControl(Sender: TObject): Boolean;
@ -1805,10 +1804,10 @@ function TIDEHintWindowManager.SenderIsHintControl(Sender: TObject): Boolean;
end;
begin
if Assigned(FHintWindow) then
Assert(FHintWindow.ControlCount < 2,
'SenderIsHintControl: ControlCount = ' + IntToStr(FHintWindow.ControlCount));
Result := Assigned(Sender) and Assigned(FHintWindow) and IsHintControl(FHintWindow);
if Assigned(CurHintWindow) then
Assert(CurHintWindow.ControlCount < 2,
'SenderIsHintControl: ControlCount = ' + IntToStr(CurHintWindow.ControlCount));
Result := Assigned(Sender) and Assigned(CurHintWindow) and IsHintControl(CurHintWindow);
end;

2
ide/sourceeditor.lfm
View File

@ -8,7 +8,7 @@ object SourceNotebook: TSourceNotebook
ClientHeight = 300
ClientWidth = 400
OnMouseUp = FormMouseUp
LCLVersion = '1.1'
LCLVersion = '1.3'
object StatusBar: TStatusBar
Left = 0
Height = 21

4
ide/sourceeditor.pp
View File

@ -9902,7 +9902,7 @@ begin
begin
// TODO: introduce property, to indicate if hint is interactive
if FHints.PtIsOnHint(Mouse.CursorPos) then begin // ignore any action over Hint
if FHints.HintWindow.Active then
if FHints.CurHintWindow.Active then
exit;
if (Msg = WM_MOUSEMOVE) {$IFDEF WINDOWS} or (Msg = WM_NCMOUSEMOVE)or
((Msg >= WM_MOUSEFIRST) and (Msg <= WM_MOUSELAST)) {$ENDIF}
@ -10063,7 +10063,7 @@ var
begin
FMouseHideHintTimer.Enabled := False;
if FHints.HintIsVisible then begin
hw := FHints.HintWindow;
hw := FHints.CurHintWindow;
Cur := Mouse.CursorPos; // Desktop coordinates
OkX := ( (FHintMousePos.x <= hw.Left) and
(Cur.x > FHintMousePos.x) and (Cur.x <= hw.Left + hw.Width)

16
lcl/forms.pp
View File

@ -834,6 +834,7 @@ type
{ THintWindow }
THintWindow = class(TCustomForm)
// For simple text hint without child controls.
private
FActivating: Boolean;
FAlignment: TAlignment;
@ -842,7 +843,6 @@ type
FAutoHide: Boolean;
FAutoHideTimer: TCustomTimer;
FHideInterval: Integer;
procedure ActivateSub(InvalidateNeeded: Boolean);
procedure AdjustBoundsForMonitor;
function GetDrawTextFlags: Cardinal;
procedure SetAutoHide(Value : Boolean);
@ -852,6 +852,7 @@ type
protected
class procedure WSRegisterClass; override;
procedure WMNCHitTest(var Message: TLMessage); message LM_NCHITTEST;
procedure ActivateSub(InvalidateNeeded: Boolean);
procedure DoShowWindow; override;
procedure UpdateRegion;
procedure SetColor(Value: TColor); override;
@ -859,7 +860,6 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ActivateRendered;
procedure ActivateText(const AHint: String);
procedure ActivateWithBounds(ARect: TRect; const AHint: String);
procedure ActivateWithData(ARect: TRect; const AHint: String; AData: pointer);
@ -872,6 +872,7 @@ type
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
class function GetControlClassDefaultSize: TSize; override;
public
property OnMouseDown; // Public access may be needed.
property Alignment: TAlignment read FAlignment write FAlignment;
property HintRect: TRect read FHintRect write FHintRect;
property HintRectAdjust: TRect read FHintRect write SetHintRectAdjust;
@ -883,6 +884,17 @@ type
THintWindowClass = class of THintWindow;
{ THintWindowRendered }
THintWindowRendered = class(THintWindow)
// For rendered hint with a child control added by an external provider.
private
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ActivateRendered;
end;
{ TMonitor }
TMonitor = class(TObject)

53
lcl/include/hintwindow.inc
View File

@ -213,36 +213,15 @@ begin
Invalidate;
end;
procedure THintWindow.ActivateRendered;
// Shows hint contents which are rendered to Controls[0] added by a rendering provider
begin
if FActivating then exit;
FActivating := True;
try
Assert(ControlCount > 0, 'THintWindow.ActivateRendered: ControlCount = 0');
ActivateSub(True);
finally
FActivating := False;
end;
end;
procedure THintWindow.ActivateText(const AHint: String);
// Shows simple text hint.
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;
ActivateSub(InvalidateNeeded);
Assert(ControlCount = 0, 'THintWindow.ActivateRendered: ControlCount > 0');
Caption := AHint;
ActivateSub(Visible and (Caption <> AHint));
finally
FActivating := False;
end;
@ -332,4 +311,30 @@ begin
DestroyHandle;
end;
{ THintWindowRendered }
constructor THintWindowRendered.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
destructor THintWindowRendered.Destroy;
begin
inherited Destroy;
end;
procedure THintWindowRendered.ActivateRendered;
// Shows hint contents which are rendered to Controls[0] by a rendering provider
begin
if FActivating then exit;
FActivating := True;
try
Assert(ControlCount > 0, 'THintWindowRendered.ActivateRendered: ControlCount = 0');
ActivateSub(True);
finally
FActivating := False;
end;
end;
// included by forms.pp