pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Fix painting of TJvHTHintWindow (issue #34981, slightly modified patch by Michal Gawrycki).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6812 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-01-31 21:54:55 +00:00
parent d7f5b5f9c5
commit 1ff344aab4
1 changed files with 26 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
components/jvcllaz/run/JvCtrls/jvhint.pas
View File

@ -35,7 +35,7 @@ interface
uses uses
SysUtils, Classes, SysUtils, Classes,
Controls, Forms, ExtCtrls, Controls, Forms, ExtCtrls,
JvHtControls, JvTypes; JvTypes;
type type
TJvHintWindow = class(THintWindow) TJvHintWindow = class(THintWindow)
@ -70,13 +70,9 @@ type
end; end;
TJvHTHintWindow = class(THintWindow) TJvHTHintWindow = class(THintWindow)
private
HtLabel: TJvHTLabel;
protected
public public
constructor Create(AOwner: TComponent); override;
function CalcHintRect({%H-}MaxWidth: Integer; function CalcHintRect({%H-}MaxWidth: Integer;
const AHint: THintString; AData: Pointer): TRect; override; const AHint: THintString; {%H-}AData: Pointer): TRect; override;
procedure Paint; override; procedure Paint; override;
end; end;
@ -85,8 +81,8 @@ procedure RegisterHtHints;
implementation implementation
uses uses
Math, LCLIntf, LCLType, Graphics, Math, LCLIntf, LCLType,
JvResources; JvResources, JvHTControls;
//=== { TJvHint } ============================================================ //=== { TJvHint } ============================================================
@ -221,32 +217,39 @@ begin
HintWindow.Caption := ''; HintWindow.Caption := '';
end; end;
//=== { TJvHTHintWindow } ==================================================== //=== { TJvHTHintWindow } ====================================================
constructor TJvHTHintWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
HtLabel := TJvHTLabel.Create(Self);
HtLabel.Parent := Self;
HtLabel.SetBounds(2, 2, 0, 0);
end;
procedure TJvHTHintWindow.Paint;
begin
end;
function TJvHTHintWindow.CalcHintRect(MaxWidth: Integer; function TJvHTHintWindow.CalcHintRect(MaxWidth: Integer;
const AHint: THintString; AData: Pointer): TRect; const AHint: THintString; AData: Pointer): TRect;
var
W, H: Integer;
begin begin
HtLabel.Caption := AHint; H := ItemHTHeight(Canvas, AHint, DefaultSuperSubScriptRatio);
Result := Bounds(0, 0, HtLabel.Width + 6, HtLabel.Height + 2); W := ItemHTWidth(Canvas, Bounds(0, 0, 0, 0), [], AHint, DefaultSuperSubScriptRatio);
Result := Bounds(0, 0, W + 6, H + 6);
if Application.HintHidePause > 0 then if Application.HintHidePause > 0 then
Application.HintHidePause := Application.HintHidePause :=
Max(2500, // default Max(2500, // default
Length(ItemHtPlain(AHint)) * Length(ItemHtPlain(AHint)) *
(1000 div 20)); // 20 symbols per second 1000 div 20 // 20 symbols per second
);
end; end;
procedure TJvHTHintWindow.Paint;
var
R: TRect;
begin
R := ClientRect;
Canvas.Pen.Color := clActiveBorder;
Canvas.Frame(R);
InflateRect(R, -3, -3);
ItemHTDrawHL(Canvas, R, [], Caption, -1, -1, DefaultSuperSubScriptRatio);
end;
//==============================================================================
procedure RegisterHtHints; procedure RegisterHtHints;
begin begin
if Application.ShowHint then if Application.ShowHint then