EugeneX MiniWeb

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== Создать всплывающую подсказку как в Office ======

<code pascal>
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;
</code>

<code pascal>
    procedure TForm1.Button1Click(Sender: TObject);
    begin
        ShowBalloonTip(Button1, btIconError, 'Helloworld!', 'Nothing to loose');
    end;
</code>
EugeneX MiniWeb

User Tools

Site Tools

Page Tools
