Kolejny raz o BaloonTip (pewnie kAzek będzie wiedział ale może nie tylko On(.

0

Witam.

Pytanie do kAzka tak się chyba odmienia ;)), ale może ktoś jeszcze będzie widział. Napisałem sobie
taki moduł, o kodzie poniżej i on działa. wyświetla baloniki bez XPManifestu oraz - na czym mi także
zależało, w dowolnym punkcie ekranu. Na google jest wiele kodów, ale albo działając tylko dla tych
kontrolek, ktore dziedziczą po TCustomEdit albo jeżeli się już pojawia dymek pod przyciskiem to nie
pokzuje się na dlugo tylo zznika po poruszeniu kursorem. I stąd pytanie - czy da się prościej zrobić
to co poniżej? Bo jak widac nie umiejąc inaczej wykombinować chowania się balonika po czasie, to
wysyłam do apamiętanym w zmiennej gloalnej uchwycie TTM_TRACKACTIVATE z parametrem False
oraz jak widać mment kliknięcia na dymek przechytuje Hookiem na mtszkę, bo nie wiem w jaki inny
sposób można wykryć komunikat kliknięcia myszki. Taki balonik chyba nie posiada WndPRoc. Jeżeli
ktoś może to prosiłbym o wskazówki. Tak - wiem, kod niżej przekombinowany, ale jako tako działa.

unit balloontip;

interface

uses
  Windows, Messages, Classes, CommCtrl;

var
  WM_BALLOONTIPCLICKED : Word;

procedure ShowBalloonHint(Point : TPoint; Handle : HWND;
  ATitle : string; AMessage : string; WhichIcon : Byte; PauseTime : Word);
procedure HideBalloonTip;

implementation

type
  TPauseThread = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  TempH : HWND;
  APause : Word;
  Thr : TThread;
  OldPos : TPoint;
  MouseHook : integer;
  MessageBuffer : TEventMsg;

procedure TPauseThread.Execute;
begin
  Sleep(APause);
  HideBalloonTip;
end;

function MouseHookProc(Code : integer; wParam, lParam : Longint) : Longint; stdcall;
var
  WinH : HWND;
  MouseCord : TPoint;
begin
  Result := 0;
  case Code of
    HC_ACTION :
      begin
        GetCursorPos(MouseCord);
        if APause = 0 then
        begin
          if (MouseCord.X <> OldPos.X)
            or (MouseCord.Y <> OldPos.Y) then
          begin
            APause := GetDoubleClickTime;
            Thr := TPauseThread.Create(False);
          end;
        end;
        MessageBuffer := PEventMsg(lParam)^;
        if (MessageBuffer.Message = WM_LBUTTONDOWN)
          or (MessageBuffer.Message = WM_MBUTTONDOWN)
          or (MessageBuffer.Message = WM_RBUTTONDOWN) then
        begin
          WinH := WindowFromPoint(MouseCord);
          if (TempH > 0) and (WinH = TempH) then
          begin
            SendMessage(HWND_BROADCAST, WM_BALLOONTIPCLICKED, 0, 0);
            HideBalloonTip;
          end;
          Result := -1;
        end;
      end;
  else
    Result := CallNextHookEx(MouseHook, Code, wParam, lParam);
  end;
end;

procedure ShowBalloonHint(Point : TPoint; Handle : HWND;
  ATitle : string; AMessage : string; WhichIcon : Byte; PauseTime : Word);
const
  TTS_BALLOON = $40;
var
  Rect : TRect;
  TI : TToolInfo;
  TipHandle : HWND;

  procedure SetToolTipTitle(TT : HWND; IconType : integer; Title : string);
  var
    Buffer : array[0..255] of Char;
  const
    TTM_SETTITLE = (WM_USER + 32);
  begin
    FillChar(Buffer, SizeOf(Buffer), #0);
    LStrcpy(Buffer, PChar(Title));
    SendMessage(TT, TTM_SETTITLE, IconType, Integer(@Buffer));
  end;

begin
  if TempH > 0 then
  begin
    HideBalloonTip;
  end;
  TipHandle := CreateWindowEx(0, TOOLTIPS_CLASS, nil,
    TTS_ALWAYSTIP or TTS_BALLOON,
    0, 0, 0, 0, Handle, 0, Handle, nil);
  SetWindowPos(TipHandle, HWND_TOPMOST, 0, 0, 0, 0,
    SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
  GetClientRect(Handle, Rect);
  with TI do
  begin
    cbSize := SizeOf(TToolInfo);
    uFlags := TTF_TRACK;
    hwnd := Handle;
    hInst := Handle;
    uId := Handle;
    lpszText := PChar(AMessage);
  end;
  TI.Rect.Left := Rect.Left;
  TI.Rect.Top := Rect.Top;
  TI.Rect.Right := Rect.Right;
  TI.Rect.Bottom := Rect.Bottom;
  SendMessage(TipHandle, TTM_ADDTOOL, 1, Integer(@TI));
  if WhichIcon > 3 then
  begin
    WhiChIcon := 0;
  end;
  SetToolTipTitle(TipHandle, WhichIcon, ATitle);
  SendMessage(TipHandle, TTM_TRACKPOSITION, 0, MakeLParam(Point.X, Point.Y));
  SendMessage(TipHandle, TTM_TRACKACTIVATE, Integer(True), Integer(@TI));
  TempH := TipHandle;
  APause := PauseTime;
  GetCursorPos(OldPos);
  MouseHook := SetWindowsHookEx(WH_JOURNALRECORD, MouseHookProc, HInstance, 0);
  if PauseTime > 0 then
  begin
    Thr := TPauseThread.Create(False);
  end;
end;

procedure HideBalloonTip;
begin
  if TempH > 0 then
  begin
    UnHookWindowsHookEx(MouseHook);
    SendMessage(TempH, TTM_TRACKACTIVATE, Integer(False), 0);
    TempH := 0;
    APause := 0;
    if Thr <> nil then
    begin
      Thr.Suspend;
      Thr := nil;
    end;
  end;
end;

initialization
  WM_BALLOONTIPCLICKED := RegisterWindowMessage('MouseClickedOnTheBalloonTip');
end.
0

Nie mam teraz czasu (ważny projekt a już jestem dzień w plecy) ale to jest przecież okienko więc musi mieć WinProc tyle, że "ukryty" ale na pewno słyszałeś u SubClasingu (SetWindowLong GWL_WNDPROC i te sprawy) to sobie nadpisz procedurę obsługi okna i po krzyku ;) Będziesz mógł reagować na wszystkie komunikaty :)
Jak sobie nie poradzisz, to pisz to naskrobię jakiś przykład ale pewnie najwcześniej jutro (a właściwie dzisiaj bo 2 w nocy) wieczorem.

EDIT// Tak sobie przypominam, że chyba już tutaj podawałem przykład tyle, że z jakąś kontrolką ale albo po wprowadzeniu "świeżego" wyglądu wciągło pół postów albo nie umiem znaleźć.

0

Spoko, jak będziesz miał czas to możesz podać kod jakiejś innej metody. Faktycznie da się
ustawić WndProc jak dla każdego okna. Póki co efekt moich kombinacji jest poniżej. Ale nie
udało mi się i tak zmusić wygaszania dymka przez TTM_SETDELAYTIME nawet bez zmian w
WndProc. Niestety przykłady dostępne w sieci dla kontrolek innych niż pola edycyjne, jak po
lekturze i testach stwierdziłem dzialają, lecz trzeba najechać na okno myszką. Poza tym nie
podoba się mi to, że strzałka balonika jest po jego środku, a nie w lewym górnym rogu jeżeli
balonik jest wyświetlany pod kontrolką. No i właśnie takie z flagą TTF_SUBCLASS znikają za
szybko i pomimo lektury MSDN'a oraz fragmentów kodów w necie - nie potrafię dlla balonika
ustawić czasu wygaszenia. Działa tylko dla kontrolek edycyjnych z odstepem 10 s. Także jak
znajdziesz chwilę czasu to podaj lepszy przykład. I bardzo dziękuję za dotychczasową pomoć.

unit balloontip;

interface

uses
  Windows, Messages, Classes, CommCtrl;

procedure ShowBalloonHint(Point : TPoint; AHandle : HWND;
  ATitle : string; AMessage : string; WhichIcon : Byte; PauseTime : Word);

implementation

type
  TPauseThread = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  TempH : HWND;
  AThr : TThread;
  ASleepTime : Word;
  OldWindowProc : Pointer;
  OldPos, CurPos : TPoint;

procedure HideBalloonTip;
begin
  if TempH > 0 then
  begin
    SendMessage(TempH, TTM_TRACKACTIVATE, Integer(False), 0);
    TempH := 0;
    ASleepTime := 0;
    if AThr <> nil then
    begin
      AThr.Suspend;
      AThr := nil;
    end;
  end;
end;

procedure TPauseThread.Execute;
begin
  GetCursorPos(OldPos);
  if ASleepTime = 0 then
  begin
    while True do
    begin
      GetCursorPos(CurPos);
      if (CurPos.X <> OldPos.X) or (CurPos.Y <> OldPos.Y) then
      begin
        ASleepTime := GetDoubleClickTime;
        Break;
      end;
    end;
  end;
  Sleep(ASleepTime);
  HideBalloonTip
end;

function NewWindowProc(WindowHandle : hWnd; TheMessage : Longint; ParamW : Longint;
  ParamL : Longint) : Longint stdcall;
begin
  if (TheMessage = TTM_TRACKACTIVATE) and (ParamW = Integer(True)) then
  begin
    AThr := TPauseThread.Create(False);
  end;
  if (TheMessage = WM_LBUTTONDOWN)
    or (TheMessage = WM_MBUTTONDOWN)
    or (TheMessage = WM_RBUTTONDOWN) then
  begin
    SendMessage(WindowHandle, TTM_TRACKACTIVATE, Integer(False), 0);
  end;
  Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
end;

procedure ShowBalloonHint(Point : TPoint; AHandle : HWND;
  ATitle : string; AMessage : string; WhichIcon : Byte; PauseTime : Word);
const
  TTS_BALLOON = $40;
var
  Rect : TRect;
  TI : TToolInfo;
  TipHandle : HWND;

  procedure SetToolTipTitle(TT : HWND; IconType : integer; Title : string);
  var
    Buffer : array[0..255] of Char;
  const
    TTM_SETTITLE = (WM_USER + 32);
  begin
    FillChar(Buffer, SizeOf(Buffer), #0);
    LStrcpy(Buffer, PChar(Title));
    SendMessage(TT, TTM_SETTITLE, IconType, Integer(@Buffer));
  end;

begin
  if TempH > 0 then
  begin
    HideBalloonTip;
  end;
  TipHandle := CreateWindowEx(0, TOOLTIPS_CLASS, nil,
    TTS_ALWAYSTIP or TTS_BALLOON,
    0, 0, 0, 0, AHandle, 0, AHandle, nil);
  SetWindowPos(TipHandle, HWND_TOPMOST, 0, 0, 0, 0,
    SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
  GetClientRect(AHandle, Rect);
  with TI do
  begin
    cbSize := SizeOf(TToolInfo);
    uFlags := TTF_TRACK;
    hwnd := AHandle;
    hInst := AHandle;
    uId := AHandle;
    lpszText := PChar(AMessage);
  end;
  TI.Rect.Left := Rect.Left;
  TI.Rect.Top := Rect.Top;
  TI.Rect.Right := Rect.Right;
  TI.Rect.Bottom := Rect.Bottom;
  SendMessage(TipHandle, TTM_ADDTOOL, 1, Integer(@TI));
  if WhichIcon > 3 then
  begin
    WhiChIcon := 0;
  end;
  SendMessage(TipHandle, TTM_TRACKPOSITION, 0, MakeLParam(Point.X, Point.Y));
  TempH := TipHandle;
  ASleepTime := PauseTime;
  SetToolTipTitle(TipHandle, WhichIcon, ATitle);
  OldWindowProc := Pointer(SetWindowLong(TipHandle, GWL_WNDPROC, Longint(@NewWindowProc)));
  SendMessage(TipHandle, TTM_TRACKACTIVATE, Integer(True), Integer(@TI));
end;

end.

1 użytkowników online, w tym zalogowanych: 0, gości: 1