Может кто подскажет все таки почему при первом появлении hinta он гасится раньше времени,я поковырялся дошел до того что первый раз FparentWindow=0 и после выполняется DestroyHandle,но почему не понимаю.
procedure TWinControl.SetParentWindow(Value: HWnd);
begin
if (FParent = nil) and (FParentWindow <> Value) then
begin
if (FHandle <> 0) and (FParentWindow <> 0) and (Value <> 0) then
begin
FParentWindow := Value;
Windows.SetParent(FHandle, Value);
if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
Perform(WM_CHANGEUISTATE, MakeWParam(UIS_INITIALIZE, UISF_HIDEACCEL or UISF_HIDEFOCUS), 0);
end else
begin
DestroyHandle;
FParentWindow := Value;
end;
UpdateControlState;
end;
end;
Это код самого хинта в комбо.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, StdCtrls, ExtCtrls;
type
TComboItemHint = Class(THintWindow)
private
DoHint : boolean;
FControlName: string;
procedure SetControlName(const Value: string);
private
property ControlName : string read FControlName write SetControlName;
procedure DoActivateHint(ControlName : string; Text : string);
end;
TForm1 = class(TForm)
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboItemLabel: TLabel;
procedure FormCreate(Sender: TObject);
private
hw : TComboItemHint;
procedure ComboDropDown(sender : TObject);
procedure ComboCloseUp(sender : TObject);
procedure ApplicationIdle(sender : TObject; var Done : boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure DoHint(AControl: TControl) ;
var
pt: TPoint;
begin
pt := AControl.ClientToScreen(Point(1,1)) ;
SetCursorPos(pt.x, pt.y) ;
Application.ActivateHint(pt) ;
end;
procedure TForm1.ApplicationIdle(
sender: TObject; var Done: boolean);
var
pt : TPoint;
w : Hwnd;
ItemBuffer : array[0..256] of Char;
idx : Integer;
s : string;
begin
pt := Mouse.CursorPos;
w := WindowFromPoint(pt);
if w = 0 then
Exit;
GetClassName(w, ItemBuffer, SizeOf(ItemBuffer));
if StrIComp(ItemBuffer, 'ComboLBox') = 0 then
begin
Windows.ScreenToClient(w, pt);
idx := SendMessage(w,
LB_ITEMFROMPOINT,
0,
LParam(PointToSmallPoint(pt)));
if idx >= 0 Then
begin
if LB_ERR <> SendMessage(w,
LB_GETTEXT,
idx,
LParam(@ItemBuffer)) then
begin
s := 'Mouse over item: ' + #13#10 +
Format('Combo.Name: %s,%sItem.Text: %s',
[ActiveControl.Name, #13#10, ItemBuffer]);
ComboItemLabel.Caption := s;
hw.DoActivateHint(ActiveControl.Name + ItemBuffer, 'Hint for: ' + ItemBuffer);
end;
end;
end;
end; (*ApplicationIdle*)
procedure TForm1.ComboCloseUp(sender: TObject);
begin
Application.OnIdle := nil;
hw.ReleaseHandle;
end; (*ComboCloseUp*)
procedure TForm1.ComboDropDown(sender: TObject);
begin
Application.OnIdle := ApplicationIdle;
end; (*ComboDropDown*)
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.OnDropDown := ComboDropDown;
ComboBox2.OnDropDown := ComboDropDown;
ComboBox1.OnCloseUp := ComboCloseUp;
ComboBox2.OnCloseUp := ComboCloseUp;
hw := TComboItemHint.Create(self);
end;
{ TComboItemHint }
procedure TComboItemHint.DoActivateHint(ControlName : string; Text: string);
var
pt : TPoint;
r : TRect;
begin
self.ControlName := ControlName;
if DoHint then
begin
pt := Mouse.CursorPos;
//some hard-coding
r:= Rect(pt.X + 16 ,pt.Y + 16,pt.X + 100, pt.Y + 32);
ActivateHint(r,Text);
DoHint := false;
end;
end;
procedure TComboItemHint.SetControlName(const Value: string);
begin
if FControlName <> Value then
begin
ReleaseHandle;
//remove flicker
DoHint := True;
FControlName := Value;
end;
end;
end.
... << RSDN@Home 1.1.4 beta 4 rev. 303>>
Ну может тогда кто-нибудь компонентом не глюкавым поделится или ссылкой.
... << RSDN@Home 1.1.4 beta 4 rev. 303>>