CreateWindowEx ウィンドウ(コントロール)を作成
DestroyWindow CreateWindowExの解放
InitCommonControls コモンコントロールのダイナミックリンクライブラリ(DLL)に含まれている、特定のコモンコントロールクラスを登録
SendMessage ウィンドウにメッセージを送信
SetWindowPos ウィンドウのサイズ、位置、および Z オーダーを設定
　

'================================================================
'= ツールチップの作成(�T)
'=    (ToolTip.bas)
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Type TOOLINFO
    cbSize   As Long
    uFlags   As Long
    hwnd     As Long
    uId      As Long
    cRect    As RECT
    hinst    As Long
    lpszText As Long
End Type
   
' ウィンドウ(コントロール)を作成
Declare Function Api_CreateWindowEx& Lib "user32" Alias "CreateWindowExA" (ByVal ExStyle&, ByVal ClassName$, ByVal WinName$, ByVal Style&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal Parent&, ByVal Menu&, ByVal Instance&, Param As Any)

' CreateWindowExの解放
Declare Function Api_DestroyWindow& Lib "user32" Alias "DestroyWindow" (ByVal hWnd&)

' コモンコントロールのダイナミックリンクライブラリ(DLL)に含まれている、特定のコモンコントロールクラスを登録
Declare Sub Api_InitCommonControls Lib "comctl32" Alias "InitCommonControls" ()

' ウィンドウにメッセージを送信
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)

' ウィンドウのサイズ、位置、および Z オーダーを設定
Declare Function Api_SetWindowPos& Lib "user32" Alias "SetWindowPos" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal CX&, ByVal CY&, ByVal uFlags&)

#define WM_USER &H400                   'ユーザーが定義できるメッセージの使用領域を表すだけでこれ自体に意味はない
#define TTM_ADDTOOL (&H400 + 4)         'ツールチップをツールに登録
#define TTM_SETMAXTIPWIDTH (&H400 + 24) 'ツールチップの最大幅
#define TTF_CENTERTIP &H2               'チップをツールの中心に表示
#define TTF_IDISHWND &H1                'uIdメンバは、ツールのウィンドウハンドル
#define TTF_RTLREADING &H4              'テキストを右から左に表示(ヘブライ語、またはアラビア語)
#define TTF_SUBCLASS &H10               'ツールをサブクラス化してメッセージを取得
#define HWND_TOPMOST (-1)               'ウィンドウを常に最前面に配置
#define SWP_NOMOVE &H2                  'ウィンドウの現在位置を保持する
#define SWP_NOSIZE &H1                  'ウィンドウの現在のサイズを保持する
#define SWP_NOACTIVATE &H10             'ウィンドウをアクティブにしない

Var Shared MainForm As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object
Var Shared Button2 As Object

MainForm.Attach GethWnd
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14

Var Shared hToolTip As Long

'================================================================
'=
'================================================================
Declare Sub SetMultiLineToolTip(ByVal hwnd As Long, sToolTip As String)
Sub SetMultiLineToolTip(ByVal hwnd As Long, sToolTip As String)
    Var ti As TOOLINFO
  
    ti.cbSize = Len(ti)
    ti.hwnd = hWnd
    ti.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    ti.uId = hWnd
    ti.hinst = GethInst
    ti.lpszText = StrAdr(sToolTip & Chr$(0))

    Ret = Api_SendMessage(hToolTip, TTM_ADDTOOL, 0, ti)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    Api_InitCommonControls

    hToolTip = Api_CreateWindowEx(0, "tooltips_class32", "", 0, 0, 0, 0, 0, 0, 0, 0, 0)

    Ret = Api_SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0, 300)
  
    SetMultiLineToolTip Button1.GethWnd, "このボタンクリックで" & Chr$(13, 10) & "エディットにTooltip表示"
    SetMultiLineToolTip Button2.GethWnd, "このボタン" & Chr$(13, 10) & "クリックで" & Chr$(13, 10) & "プログラム終了"
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    SetMultiLineToolTip Edit1.GethWnd, Edit1.GetWindowText
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Ret As Long

    Ret = Api_DestroyWindow(hToolTip)
    End
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose edecl ()
Sub mainForm_QueryClose()
    Var Ret As Long

    Ret = Api_DestroyWindow(hToolTip)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End