もののついでですので．
Halbow 資料館の以下のサンプルコードを使用したサンプルです．
動作確認は Windows 7 U64(SP1) + Delphi 7 Pro です．
[２７−４ ツールチップをコードでつくる]
http://mrxray.on.coocan.jp/Halbow/Chap27.html#Chap27-4
Delphi XE5 でも動作しますが，ランタイムテーマが無効だと動作しません．
また，背景色の設定が無視されるようです．
Delphi 2009 で実装されている TBalloonHint コンポーネントも，ランタイムテーマ
が無効だと，バルーン型ではなく，普通のツールチップになります．
下のコードでは，CreateWindowEx の TTS_BALLOON を除けば，普通のツールチップに
なります．
つまり，Halbow さんのコードに TTS_BALLOON フラグを追加しただけですが，
実際には，変数名を若干変えています．Delphi 6 以降では 主な定数名は定義済み
ですので，コードから削除しています．
Halbow さんのコードは Delphi 3 での確認コードです．
また，表示時間に関するコードを追加しています．
implementation
uses CommCtrl;
{$R *.dfm}
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
function CreateToolTip(hParent: HWND): HWND;
const
TTS_BALLOON = $40;
begin
Result := CreateWindowEx(WS_EX_TOPMOST,
TOOLTIPS_CLASS,
nil,
WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON,
0,
0,
0,
0,
hParent,
0,
hInstance,
nil);
end;
function TTMAddToolControl(hToolTip, MainWndHandle, hCtrl: HWND;
Tips: String): Boolean;
var
TI : TToolInfo;
begin
ZeroMemory(@TI, SizeOf(TI));
TI.cbSize := SizeOf(TI);
TI.hwnd := MainWndHandle;
TI.uFlags := TTF_SUBCLASS or TTF_IDISHWND;
TI.uId := hCtrl;
TI.lpszText := PChar(Tips);
Result := Boolean(SendMessage(hToolTip, TTM_ADDTOOL, 0, LPARAM(@TI)));
end;
function TTMAddToolRect(hToolTip, hParent: HWND; ID: Integer; Rect: TRect;
Tips: String): Boolean;
var
TI : TToolInfo;
r : TRect;
begin
ZeroMemory(@TI, SizeOf(TI));
SetRect(r, Rect.Left, Rect.Top, Rect.Left + Rect.Right, Rect.Top + Rect.Bottom);
TI.cbSize := SizeOf(TI);
TI.uFlags := TTF_SUBCLASS;
TI.hwnd := hParent;
TI.uId := ID;
TI.Rect := r;
TI.lpszText := PChar(Tips);
Result := Boolean(SendMessage(hToolTip, TTM_ADDTOOL, 0, LPARAM(@TI)));
end;
procedure TTMSetBkColor(hToolTip: HWND; CL: COLORREF);
begin
SendMessage(hToolTip, TTM_SETTIPBKCOLOR, CL, 0);
end;
procedure TTMSetTextColor(hToolTip: HWND; CL: COLORREF);
begin
SendMessage(hToolTip, TTM_SETTIPTEXTCOLOR, CL, 0);
end;
procedure TTMSetMaxWidth(hToolTip: HWND; MW: Integer);
begin
SendMessage(hToolTip, TTM_SETMAXTIPWIDTH, 0, MW);
end;
procedure TTMSetMargin(hToolTip: HWND; R: TRect);
begin
SendMessage(hToolTip, TTM_SETMARGIN, 0, Integer(@R));
end;
//-----------------------------------------------------------------------------
// フォーム表示開始時の処理
// Button1のヒントウィンドウを設定
//-----------------------------------------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
var
hToolTip : HWND;
StrHint : String;
begin
StrHint := '複数行のヒント文字列' + sLineBreak + 'テストヒント';
hToolTip := CreateToolTip(Handle);
TTMAddToolControl(hToolTip, Handle, Button1.Handle, StrHint);
TTMSetMaxWidth(hToolTip, 200);
TTMSetBkColor(hToolTip, $00D5F2D9);
//表示開始までの時間(ミリ秒指定)
SendMessage(hToolTip, TTM_SETDELAYTIME, TTDT_INITIAL, MakeLParam(10, 0));
//表示時間(ミリ秒指定)
//WORD値の指定となっているが，実際にはLPARAM自体がIntegerなのでSmallInt以内?
SendMessage(hToolTip, TTM_SETDELAYTIME, TTDT_AUTOPOP, MakeLParam(MAXSHORT, 0));
end;
メッセージ類については，このスレッドの最初の書き込みにある MSDN の記事へのリンクを
参考にしてください．
※ SendMessage の 第3引数は WPALAM型(UINT_PTR : NativeUInt型) です．
32 ビットアプリでは 符号なし32ビット整数で，
64 ビットアプリでは 符号なし64ビット整数です．
※ SendMessage の 第4引数は LPALAM型(INT_PTR : NativeInt型) です．
32 ビットアプリでは 符号あり32ビット整数で，
64 ビットアプリでは 符号あり64ビット整数です．
※ Integer 型は，32ビットアプリでも64ビットアプリでも 32 ビットの符号あり整数値です．
Cardinal 型は，32ビットアプリでも64ビットアプリでも 32 ビットの符号なし整数値です．
つまり，Integer と Cardinal はプラットフォームに依存しません．
 |