Проблемы с хинтом(в combobox)
От: linker Россия  
Дата: 11.04.05 06:28
Оценка:
Может кто подскажет все таки почему при первом появлении 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>>
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.