名前
題名
▼ Mr.XRAYさん > もののついでですので． > 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 はプラットフォームに依存しません． >
GIF,JPEG,PNG画像ファイル及びLZH,ZIPファイルをアップロードできます.
600 x 1200 ピクセルを超える画像は縮小表示されます(画像クリックで拡大表示).
(上限122000(120k)バイト)

削除キー Link