paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 21:10:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed LM_LVChangedItem, OnShowHint, small bugs

Browse Source 
git-svn-id: trunk@1317 -
This commit is contained in:
lazarus 2002-02-09 01:48:16 +00:00
parent e6efe82614
commit b41079d877
2 changed files with 17 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/include/application.inc
View File

@ -30,8 +30,7 @@ const
function GetHintControl(Control: TControl): TControl;
begin
Result := Control;
while (Result <> nil)
and ((not Result.ShowHint) or (Result.Hint='')) do
while (Result <> nil) and (not Result.ShowHint) do
Result := Result.Parent;
if (Result <> nil)
and ([csDesigning,csDestroying,csLoading]*Result.ComponentState<>[]) then
@ -304,12 +303,10 @@ begin
FShowHint:=AValue;
if FShowHint then
begin
FHintWindow := HintWindowClass.Create(Self);
FHintWindow.Color := FHintColor;
//
end else
begin
FHintWindow.Free;
FHintWindow := nil;
FreeThenNil(FHintWindow);
end;
end;
@ -410,7 +407,6 @@ begin
if not FShowHint then exit;
FHintControl:=Info.Control;
FillChar(HintInfo,SizeOf(HintInfo),0);
HintInfo.HintControl := FHintControl;
HintInfo.HintPos := Info.MousePos;
Inc(HintInfo.HintPos.Y, GetCursorHeightMargin);
@ -439,8 +435,11 @@ begin
if CanShow and (FHintControl <> nil) and (HintInfo.HintStr <> '') then
begin
// create hint window
if (FHintWindow<>nil) and (FHintWindow.ClassType<>HintInfo.HintWindowClass)
then
FreeThenNil(FHintWindow);
if FHintWindow=nil then begin
FHintWindow:=THintWindow.Create(Self);
FHintWindow:=HintInfo.HintWindowClass.Create(Self);
with FHintWindow do begin
Visible := False;
Caption := '';
@ -475,8 +474,8 @@ begin
FHintWindow.ActivateHint(HintWinRect,HintInfo.HintStr);
// start hide timer
StartHintTimer(HintHidePause,ahtHideHint);
Exit;
end;
end else
HideHint;
//writeln('TApplication.ShowHintWindow Info.ControlHasHint=',Info.ControlHasHint,' Type=',ord(FHintTimerType));
end;
@ -818,6 +817,9 @@ end;
{ =============================================================================
$Log$
Revision 1.34 2002/11/09 15:02:06 lazarus
MG: fixed LM_LVChangedItem, OnShowHint, small bugs
Revision 1.33 2002/11/05 23:44:47 lazarus
MG: implemented Application.OnShowHint

7
lcl/include/control.inc
View File

@ -351,7 +351,7 @@ end;
{------------------------------------------------------------------------------}
{ TControl.CMHITTEST }
{------------------------------------------------------------------------------}
procedure TControl.CMHITTEST(var MEssage : TCMHitTest);
procedure TControl.CMHITTEST(var Message : TCMHitTest);
begin
message.Result := 1;
end;
@ -379,7 +379,7 @@ end;
------------------------------------------------------------------------------}
procedure TControl.CMHintShow(var Message: TLMessage);
begin
DoOnShowHint(@TCMHintShow(Message).HintInfo);
DoOnShowHint(TCMHintShow(Message).HintInfo);
if (ActionLink <> nil)
and not ActionLink.DoShowHint(TCMHintShow(Message).HintInfo^.HintStr)
then
@ -2041,6 +2041,9 @@ end;
{ =============================================================================
$Log$
Revision 1.100 2002/11/09 15:02:06 lazarus
MG: fixed LM_LVChangedItem, OnShowHint, small bugs
Revision 1.99 2002/11/06 15:59:24 lazarus
MG: fixed codetools abort