works:programmer:delphi:baloon-tooltip
Создать всплывающую подсказку как в Office
uses CommCtrl; type TShowBalloonTipIcon = (btIconNone, btIconInfo, btIconWarning, btIconError); procedure ShowBalloonTip( AOwner: TWinControl; AIconType: TShowBalloonTipIcon; AInfoText: PWideChar; ATitle: PAnsiChar = nil; ABackgroundColor: TColor = clInfoBk; ATextColor: TColor = clInfoText); const TOOLTIPS_CLASS = 'tooltips_class32'; TTS_ALWAYSTIP = $01; TTS_NOPREFIX = $02; TTS_BALLOON = $40; TTF_SUBCLASS = $0010; TTF_TRANSPARENT = $0100; TTF_CENTERTIP = $0002; TTM_ADDTOOL = $0400 + 50; TTM_SETTITLE = (WM_USER + 32); ICC_WIN95_CLASSES = $000000FF; type TOOLINFO = packed record cbSize: Integer; uFlags: Integer; hwnd: THandle; uId: Integer; rect: TRect; hinst: THandle; lpszText: PWideChar; lParam: Integer; end; var hControlWnd : HWND; hWndTooltip : HWND; pToolInfo : TOOLINFO; begin hControlWnd := AOwner.Handle; hWndTooltip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, hControlWnd, 0, HInstance, nil); if hWndTooltip <> 0 then begin SetWindowPos(hWndTooltip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); ZeroMemory(@pToolInfo, SizeOf(TOOLINFO)); pToolInfo.cbSize := SizeOf(TOOLINFO); pToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS; pToolInfo.hwnd := hControlWnd; pToolInfo.lpszText := AInfoText; Windows.GetClientRect(hControlWnd, pToolInfo.rect); PostMessageW(hWndTooltip, TTM_SETTIPBKCOLOR, ColorToRGB(ABackgroundColor), 0); PostMessageW(hWndTooltip, TTM_SETTIPTEXTCOLOR, ColorToRGB(ATextColor), 0); PostMessageW(hWndTooltip, TTM_ADDTOOL, 1, Integer(@pToolInfo)); if Assigned(ATitle) then PostMessageW(hWndTooltip, TTM_SETTITLE, Ord(AIconType) mod 4, Integer(ATitle)); end; end;
procedure TForm1.Button1Click(Sender: TObject); begin ShowBalloonTip(Button1, btIconError, 'Helloworld!', 'Nothing to loose'); end;
works/programmer/delphi/baloon-tooltip.txt · Последнее изменение: 2022/11/23 05:19 — 127.0.0.1