喫茶XRAY [Mr.XRAY掲示板]

[8019] バルーン型のヒントウィンドウ

返信　削除

2014/9/26 (金) 23:55:18 Mr.XRAY

バルーン型のヒントウィンドウ，つまりツールチップの表示です．
Delphi 2009 以降でしたら，以下の記事で可能です．

[ヒントとメッセージ - Delphi 2009 特集]
http://www.watercolor-city.net/ct_delphi/delphi_tiburon/doc_vcl/vcl_balloonhint.htm

Delphi 2007 以前の場合は，以下のコードを参考にして，

http://lupin.client.jp/delphi/#32

例えば，次のコードでテストできます．
動作確認は Windows 7 U64(SP1) + Delphi 7, 2007-R2 ですが，
Delphi 6 でも使用可能だと思います．

implementation

uses CommCtrl;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  バルーン型のツールチップの表示(Delphi 2007 以前用)
//  TToolInfoの使用にはusesにCommCtrlが必要
//-----------------------------------------------------------------------------
procedure ShowBalloonTip(hWnd: THandle; Text: String);
const
  TTS_BALLOON = $40;
var
  hWndTip  : THandle;
  TI       : TToolInfo;
  MaxWidth : Integer;
begin
  hWndTip := CreateWindow(
               TOOLTIPS_CLASS,
               nil,
               WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
               0,
               0,
               0,
               0,
               hWnd,
               0,
               HInstance,
               nil);

  if hWndTip <> 0 then begin
    TI.cbSize := SizeOf(TI);
    TI.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS or TTS_NOPREFIX;
    TI.hwnd   := hWnd;
    MaxWidth  := 200;

    TI.lpszText := PChar(Text);
    Windows.GetClientRect(hWnd, ti.rect);

    SendMessage(hWndTip, TTM_ADDTOOL, 0, LParam(@TI));
    SendMessage(hWndTip, TTM_SETMAXTIPWIDTH, 0, Integer(MaxWidth));
  end;
end;

//-----------------------------------------------------------------------------
//  フォーム表示開始時の処理
//  Button1のヒントウィンドウを設定
//-----------------------------------------------------------------------------
procedure TForm1.FormShow(Sender: TObject);
var
  StrHint : String;
begin
  StrHint := '複数行のヒント文字列' + sLineBreak + 'テストヒント';
  ShowBalloonTip(Button1.Handle, StrHint);
end;

[参考リンク]

[Tooltip (Windows)]
http://msdn.microsoft.com/en-us/library/windows/desktop/bb760246%28v=vs.85%29.aspx
[Tooltip (Windows)] ウェブ翻訳
http://www.microsofttranslator.com/bv.aspx?from=en&to=ja&a=http%3A%2F%2Fmsdn.microsoft.com%2Fen-us%2Flibrary%2Fwindows%2Fdesktop%2Fbb760246%2528v%3Dvs.85%2529.aspx

[How to Implement Multiline Tooltips (Windows)]
http://msdn.microsoft.com/en-us/library/windows/desktop/hh298403%28v=vs.85%29.aspx
[How to Implement Multiline Tooltips (Windows)] ウェブ翻訳
http://www.microsofttranslator.com/bv.aspx?from=en&to=ja&a=http%3A%2F%2Fmsdn.microsoft.com%2Fen-us%2Flibrary%2Fwindows%2Fdesktop%2Fhh298403%28v%3Dvs.85%29.aspx

[8032] Re:バルーン型のヒントウィンドウ

返信　削除

2014/9/28 (日) 00:49:00 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 はプラットフォームに依存しません．

[▼次のスレッド]

INCM/CMT
Cyclamen v3.82