Delphi Programming / Object Pascal
[掲載 2021年12月02日] [更新 2021年12月24日] Delphi 一般・その他
バルーンヒントウィンドウ
動作確認等
Windows 10 ビルド 19042 + Delphi XE5(UP2) Pro VCL-32
主に,Delphi 2009 で実装されたバルーンヒントの使用に関する記事とサンプルです.
[備考]
記事中の Application.OnShowHint イベント,Application.OnHint イベントをアプリケーションレベルで利用するには,フォームに TApplicationEvents コンポーネントを配置してイベントを実装すると便利です.
01_ Hint プロパティによるヒント表示 ( ツールチップ表示 )
設計時の IDE で,フォームに配置したコントロールや IDE のオブジェクト上にマウスカーソルが移動,つまり,マウスオーパの状態になると,ポップアップウィンドウが短い時間表示さます.そこには,そのオブジェクトについての簡単なヒントが書かれてします.これをヒント,ヒントウィンドウ,あるいはツールチップと呼んでいます.
図1
ヒントウィンドウ
図2
ヒントウィンドウ
Delphi
では,コンポーネントの Hint プロパティに表示するテキストを設定して,ShowHint プロパティを True にしておくと,この機能を実装できます.下図はその例です.
ヒントが表示されるまでの時間とヒントが閉じるでの時間も Application 変数で設定できます.Delphi XE5 では複数行のテキストも設定可能になっています.
この方法によるヒントウィンドウの表示では,Application.OnShowHint, Application.OnHint 両方のイベントが発生します.
図3
ヒントを表示
copy code
// =============================================================================
// フォーム生成時の処理
// バルーンヒントではない通常のヒントウィンドウ (ツールチップ)
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
// 表示するまでの時間と表示してから閉じるまでの時間を設定
// 単位はミリ秒
Application.HintPause := 300 ;
Application.HintHidePause := 10000 ;
Button1.Hint := 'ヒント' + sLineBreak + '複数行の表示が可能' ;
Button1.ShowHint := True;
end ;
Screen 変数を使用すると,説明のテキストのフォントのサイズや色が変更できます.その例です.
図4
フォントサイズと色を変更
リスト2
ヒントウィンドウを表示.テキストのフォントサイズと色を変更
copy code
// =============================================================================
// フォーム生成時の処理
// バルーンヒントではない通常のヒントウィンドウ (ツールチップ)
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
// フォントを設定
Screen.HintFont.Size := 20 ;
Screen.HintFont.Style := [fsBold];
Screen.HintFont.Color := clBlue;
// 表示するまでの時間と表示してから閉じるまでの時間を設定
// 単位はミリ秒
Application.HintPause := 300 ;
Application.HintHidePause := 10000 ;
Button1.Hint := 'ヒント' + sLineBreak + '複数行の表示が可能 ' ;
Button1.ShowHint := True;
end ;
ヒントウィンドウのカスタマイズ例です.このヒントウィンドウのクラス名は THintWindow です.このクラスの継承クラスを作成して Paint メソッド内で自前で描画します.HintWindowClass にこのクラスを指定しておきます.
Canvas に対する処理ですから,画像も描画可能です.
図5
カスタマイズの例
リスト3
ヒントウィンドウのカスタマイズ例.背景色とフォントサイズを変更
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
type
TMyHint = class (THintWindow)
protected
procedure Paint; override ;
end ;
TForm1 = class (TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
FHint : TMyHint;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
Vcl.Themes;
{$R *.dfm}
// =============================================================================
// フォーム生成時の処理
// バルーンヒントではない通常のヒントウィンドウ (ツールチップ)
// THintWindow の継承クラスを作成して使用
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
// ヒントの表示に使用するクラスを指定
// 指定可能なのは THintWindow の継承クラスのみ
HintWindowClass := TMyHint;
FHint := TMyHint.Create(Self);
// フォントを設定
Screen.HintFont.Size := 20 ;
Screen.HintFont.Style := [fsBold];
// 表示するまでの時間と表示してから閉じるまでの時間を設定
// 単位はミリ秒
Application.HintPause := 300 ;
Application.HintHidePause := 10000 ;
Button1.Hint := 'ヒント' + sLineBreak + '複数行の表示が可能 ' ;
Button1.ShowHint := True;
end ;
{ TMyHint }
// =============================================================================
// THintWindow の継承クラスの Paint メソッド
// =============================================================================
procedure TMyHint.Paint;
var
LRect : TRect;
LText : string ;
begin
inherited ;
LRect := Canvas.ClipRect;
LText := Caption;
if SameText(StyleServices.Name, 'Windows' ) then begin
Canvas.Brush.Color := clWebWheat;
Canvas.FillRect(LRect);
Canvas.TextRect (LRect, LText, [tfLeft, tfWordBreak]);
end ;
end ;
end .
ヒントウィンドウの表示は Application.OnShowHint で検知できます.
下図は,フォームに TApplicationEvents コンポーネントを配置して,その OnShowHint イベントでヒントウィンドウに表示するテキストを変更する例です.ヒントを表示したコントロールの名前と,そのコントロール内のマウスカーソル位置を追加表示します.
図6
OnShowHint イベントでヒントのテキストを変更
リスト4
OnShowHint イベントでヒントのテキストを変更. TApplicationEvents コンポーネントを使用
copy code
// =============================================================================
// ApplicationEvents1 の OnShowHint イベント
// ヒントウィンドウに表示するテキストを変更
// =============================================================================
procedure TForm1.ApplicationEvents1ShowHint(var HintStr: string ;
var CanShow: Boolean; var HintInfo: THintInfo);
var
LText : string ;
begin
LText := HintInfo.HintControl.Name + sLineBreak
+ 'X : ' + IntToStr(HintInfo.CursorPos.X) + ' : '
+ 'Y : ' + IntToStr(HintInfo.CursorPos.Y);
HintStr := HintStr + sLineBreak + LText;
// 以下を実行するとヒントを表示しなくなる
// CanShow := False;
end ;
図7
テーマを変更
図8
テーマを変更
02_ TBalloonHint を使用したバルーンヒントウィンドウ
TBalloonHint コンポーネントを使用すると,ヒントウィンドウのスタイルをバルーンにできます.バルーンウィンドウは,一般的には三角形の矢印付きのヒントウィンドウを意味します.BalloonHint コンポーネントをフォームにに配置します.ヒントを表示するコントロールの CustomHint プロパティに,配置した TBalloonHint コンポーネントを指定します.上のサンプルと同じく Hint プロパティに説明のテキストを設定して ShowHint プロパティを True にします.
TBalloonHint を使用してバルーンヒントを表示する場合,ヒントが表示されるまでの時間とヒントが閉じるでの時間は,TBalloonHint コンポーネントのプロパティで設定します.Screen 変数を使用してもフォントのサイズや色の変更はできません.
この方法によるバーンヒント表示では,Application.OnShowHint イベントは発生しませんが, Application.OnHint イベントは発生します.
図9
バルーンヒントを表示
フォームに TBalloonHint コンポーネントを配置
リスト5
TBalloonHint コンポーネントを使用してバルーンヒントを表示
copy code
// =============================================================================
// フォーム生成時の処理
// TBalloonHint コンポーネントを使用するが,通常のヒントウィンドウを表示する例
//
// Application.HintPause, Application.HintHidePause の設定は無効
// 代わりに以下を使用する
// TBalloonHint.Delay
// TBalloonHint.HideAfter
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.CustomHint := BalloonHint1;
Button1.ShowHint := True;
Button1.Hint := 'TBalloonHint を使用' + slineBreak
+ '普通のヒントウィンドウと同じ' + sLineBreak
+ '複数行の表示も可能' ;
end ;
03_ TBalloonHint を使用した画像付きバルーンヒントウィンドウ
TBalloonHint コンポーネントを使用すると,画像付きのバルーンヒントを表示することができます.下図のようにコンポーネントをフォームに配置します.TImageList には画像を追加しておきます.今回は,32 x 32 のアルファーチャンネル付きの 32 ビットの PNG 画像でテストしています.
TBalloonHint.Title プロパティでヒントウィンドウのタイトルを設定します.TBalloonHint.Description プロパティに説明用のテキストを指定します.ヒントウィンドウは ShowHint メソッドで表示します.つまり,この方式は,コントロールへのマウスカーバでヒントを表示するのではなく,通知用のメッセージ表示として利用することになります.
このサンプルでは,Button1 がクリックされたら,メッセージとしてのバルーンヒントを Button1 に表示します.
TBalloonHint を使用してバルーンヒントを表示する場合,ヒントが表示されるまでの時間とヒントが閉じるでの時間は,TBalloonHint コンポーネントのプロパティで設定します.Screen 変数を使用してもフォントのサイズや色の変更はできません.
この方法によるバルーンヒントの表示では,Application.OnShowHint イベントも Application.OnHint イベントも発生しません.
図10
設計時の画面
TBalloonHint と TImageList を配置
図11
オブジェクト・インスペクタの設定
TBalloonHint.Images プロパティに TImageList を指定する
図12
画像付きのバルーンヒント
Button1 がクリックされたら,メッセージとしてのバルーンヒントを表示
図13
タイトルがない場合
TBalloonHint.Title プロパティの値が空文字の場合
リスト6
TBalloonHint コンポーネントを使用して画像付きのバルーンヒントを表示
copy code
// =============================================================================
// Button1 の OnClick イベント
//
// TBalloonHint コンポーネントを使用して,ShowHint メソッドで表示する例
// TBalloonHint.ShowHint メソッドで表示
// 閉じるのは TBalloonHint.HideHint メソッド
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LMousePos : TPoint;
begin
BalloonHint1.HideAfter := 10000 ;
BalloonHint1.ImageIndex := 0 ;
BalloonHint1.Title := 'バルーンヒント' ;
BalloonHint1.Description := '通知用メッセージとして使用可能 ' + sLineBreak
+ '複数行の表示可能' + sLineBreak;
GetCursorPos(LMousePos);
BalloonHint1.ShowHint(LMousePos);
// 以下にすると規定の位置での表示となる
// BalloonHint1.ShowHint(Button1);
end ;
テキストのフォントサイズは,あらかじめ設定することはできませんが,テキスト描画後に上書き描画すれば可能です.そのためには TBalloonHint の継承クラスを作成して PaintHint メソッドで処理します.以下はその例です.
TCanvas のフォントを設定した後,描画する文字列からウィンドウの幅と高さを計算して,ヒントウィンドウの幅と高さを変更します.次に描画領域を算出してテキストを描画します.テーマを変更している場合は,そのテーマで描画するので描画コードを実行する必要はありません.最後にウィンドウの横方向の表示位置を調整しています.
このサンプルは,画像を表示しない時とタイトルを表示しない場合を考慮していません.また,画像のサイズも考慮していません.それらを考慮する場合は調整用の数値を変更する必要があります.
フォームに TBalloonHint コンポーネントを配置していますが使用していません.TBalloonHint は実行時に生成して使用しています.
図14
フォントサイズを変更
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
Vcl.ImgList;
type
TMyBalloonHint = class (TBalloonHint)
public
procedure PaintHint(HintWindow: TCustomHintWindow); override ;
end ;
TForm1 = class (TForm)
Button1: TButton;
BalloonHint1: TBalloonHint;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
FBalloonHint1 : TMyBalloonHint;
end ;
var
Form1: TForm1;
implementation
uses
Vcl.Themes;
{$R *.dfm}
// =============================================================================
// フォーム生成時の処理
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
FBalloonHint1 := TMyBalloonHint.Create(Self);
FBalloonHint1.Style := bhsBalloon;
FBalloonHint1.Images := ImageList1;
end ;
// =============================================================================
// TBalloonHint コンポーネントを使用して,ShowHint メソッドで表示する例
// フォントサイズ変更の TBalloonHint の継承クラスを生成して使用
//
// TBalloonHint.ShowHint メソッドで表示
// 閉じるのは TBalloonHint.HideHint メソッド
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LMousePos : TPoint;
begin
FBalloonHint1.HideAfter := 10000 ;
FBalloonHint1.ImageIndex := 0 ;
FBalloonHint1.Title := 'バルーンヒント' ;
FBalloonHint1.Description := '通知用メッセージとして使用可能 ' + sLineBreak
+ '複数行の表示可能' + sLineBreak;
GetCursorPos(LMousePos);
FBalloonHint1.ShowHint(LMousePos);
end ;
{ TMyBalloonHint }
type
TMyHintWindow = class (TCustomHintWindow);
// -----------------------------------------------------------------------------
// TBalloonHint の継承クラスの PaintHint メソッド
// -----------------------------------------------------------------------------
procedure TMyBalloonHint.PaintHint(HintWindow: TCustomHintWindow);
var
LWidth : Integer;
LCanvas : TCanvas;
LRect : TRect;
LText : string ;
LList : TStringList;
LLen : integer;
LLenMax : Integer;
LHeight : Integer;
LIndex : Integer;
begin
inherited ;
LCanvas := TMyHintWindow(HintWindow).Canvas;
LCanvas.Font.Size := 15 ;
LCanvas.Font.Style := [fsBold];
LWidth := HintWindow.Width;
LRect := HintWindow.ClientRect;
LText := HintWindow.Description;
LList := TStringList.Create;
try
LList.Text := LText;
LLenMax := 0 ;
for LIndex := 0 to LList.Count - 1 do begin
LLen := LCanvas.TextWidth(LList[LIndex]);
if LLen > LLenMax then begin
LLenMax := LLen;
end ;
end ;
HintWindow.Width := LLenMax + 50 ;
HintWindow.Height := LCanvas.TextHeight('hg' ) * LList.Count + 65 ;;
SetRect(LRect, LRect.Left + 40 , LRect.Top + 50 , LRect.Right - 1 , LRect.Bottom - 1 );
if SameText(StyleServices.Name, 'Windows' ) then begin
LCanvas.FillRect(LRect);
LHeight := LCanvas.TextHeight('hg' ) * LList.Count;
LRect.Top := LRect.Top + (LRect.Height - LHeight) div 2 ;
LCanvas.TextRect (LRect, LText, [tfLeft, tfWordBreak]);
end ;
finally
FreeAndNil(LList);
end ;
HintWindow.Left := HintWindow.Left - (HintWindow.Width - LWidth) div 2 ;
end ;
end .
コントロールの OnMouseEnter イベント内で TBalloonHint.ShowHint メソッドを実行すれば,マウスオーパで画像付きバルーンヒントウィンドウを表示できます.
リスト8
マウスカーソルがコントロール内に移動したら画像付きバルーンヒントを表示
copy code
// =============================================================================
// フォーム生成時の処理
// TBalloonHint コンポーネントの使用例
// =============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.CustomHint := nil ;
Button1.ShowHint := False;
// TBalloonHint.Style を bhsBalloon にすると矢印なしになる
BalloonHint1.Style := bhsBalloon;
end ;
// =============================================================================
// Button1 の OnMouseEnter イベント
//
// TBalloonHint.ShowHint メソッドで表示
// 閉じるのは TBalloonHint.HideHint メソッド
// =============================================================================
procedure TForm1.Button1MouseEnter(Sender: TObject);
var
LMousePos : TPoint;
begin
BalloonHint1.HideAfter := 5000 ;
BalloonHint1.ImageIndex := 0 ;
BalloonHint1.Title := 'TBalloonHint' ;
BalloonHint1.Description := 'OnMouseEnter イベントで表示 ' + sLineBreak
+ '複数行の表示可能' + sLineBreak;
GetCursorPos(LMousePos);
BalloonHint1.ShowHint(LMousePos);
// 以下にすると規定の位置での表示となる
// BalloonHint1.ShowHint(Button1);
end ;
図15
テーマを変更
図16
テーマを変更
閉じるボタン付きのバルーンヒントウィンドウを表示するコードとその動作確認のサンプルです.
このサンプルでは,Button1 がクリックされたら,メッセージとしてのバルーンヒントを Button1 に表示します.この閉じるボタンのバルーンヒントには,ウィンドウが表示されるまでの時間と,ウィンドウが閉じるでの時間の設定機能はありません.
この方法によるバルーンヒントの表示では,Application.OnShowHint イベントも Application.OnHint イベントも発生しません.
図17
閉じるボタン付きのバルーンヒント
Button1 がクリックされたら,メッセージとしてのバルーンヒントを表示
図18
閉じるボタン付きのバルーンヒント
TToolInfo.uFlags に TTF_CENTERTIP がない場合
リスト9
閉じるボタン付きのルーンヒントウィンドウを表示
copy code
procedure ShowBalloonTip(Ctrl: TWinControl; Icon: HICON; const Title, Text: string );
var
Form1: TForm1;
implementation
uses
Winapi.CommCtrl;
{$R *.dfm}
var
FhWndTip : THandle;
// =============================================================================
// 閉じるボタン付きのバルーンヒントを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
LhIcon : HICON;
begin
LhIcon := LoadIcon(0 , IDI_QUESTION);
try
LText := '主に通知表示用 ' + sLineBreak
+ '閉じるボタンで閉じる' ;
ShowBalloonTip(Button1, LhIcon, '自作バルーンヒント' , LText);
finally
DestroyIcon(LhIcon);
end ;
end ;
// -----------------------------------------------------------------------------
// 閉じるボタン付きバルーンヒントを表示する手続き
//
// Text が複数行の場合,2 行目以降が長いと全てが表示されない場合がある
// 1 行目の文字列またはタイトルの文字列に全角の空白文字を追加すると回避できる
// -----------------------------------------------------------------------------
procedure ShowBalloonTip(Ctrl: TWinControl; Icon: HICON; const Title, Text: string );
var
LWndFlag : Cardinal;
LToolInfo : TToolInfo;
begin
if FhWndTip <> 0 then begin
PostMessage(FhWndTip, WM_CLOSE, 0 , 0 );
FhWndTip := 0 ;
end ;
LWndFlag := WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil , LWndFlag,
0 , 0 , 0 , 0 , Ctrl.Handle, 0 , HInstance, nil );
if FhWndTip = 0 then Exit;
LToolInfo.cbSize := SizeOf(TToolInfo);
LToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
LToolInfo.hWnd := Ctrl.Handle;
LToolInfo.hInst := HInstance;
LToolInfo.lpszText := PChar(Text);
LToolInfo.Rect := Ctrl.ClientRect;
SendMessage(FhWndTip, TTM_ADDTOOL, 0 , integer(@LToolInfo));
SendMessage(FhWndTip, TTM_SETTITLE, WPARAM(Icon), LPARAM(PChar(Title)));
SendMessage(FhWndTip, TTM_TRACKACTIVATE, 1 , LPARAM(@LToolInfo));
end ;
テキストのフォントサイズの設定例です.変更可能なのは説明用のテキストだけです.タイトルの文字のサイズは変更できません.色関係の設定はできません.
図19
フォントのサイズを変更
リスト10
閉じるボタン付きのルーンヒントウィンドウを表示.フォントサイズの変更例
copy code
procedure ShowBalloonTip(Ctrl: TWinControl; Icon: HICON; const Title, Text: string );
var
Form1: TForm1;
implementation
uses
Winapi.CommCtrl;
{$R *.dfm}
var
FhWndTip : THandle;
// =============================================================================
// 閉じるボタン付きのバルーンヒントを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
LhIcon : HICON;
begin
LhIcon := LoadIcon(0 , IDI_QUESTION);
try
LText := '主に通知表示用 ' + sLineBreak
+ 'フォントサイズ変更サンプル' ;
ShowBalloonTip(Button1, LhIcon, '自作バルーンヒント' , LText);
finally
DestroyIcon(LhIcon);
end ;
end ;
// -----------------------------------------------------------------------------
// 閉じるボタン付きバルーンヒントを表示する手続き
// フォントサイズ変更
// 変更可能なのは説明用テキストのみ
// 色関係の設定は実行しても無効
//
// Text が複数行の場合,2 行目以降が長いと全てが表示されない場合がある
// 1 行目の文字列またはタイトルの文字列に全角の空白文字を追加すると回避できる
// -----------------------------------------------------------------------------
procedure ShowBalloonTip(Ctrl: TWinControl; Icon: HICON; const Title, Text: string );
var
LWndFlag : Cardinal;
LToolInfo : TToolInfo;
LFont : TFont;
begin
if FhWndTip <> 0 then begin
PostMessage(FhWndTip, WM_CLOSE, 0 , 0 );
FhWndTip := 0 ;
end ;
LWndFlag := WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil , LWndFlag,
0 , 0 , 0 , 0 , Ctrl.Handle, 0 , HInstance, nil );
if FhWndTip = 0 then Exit;
LFont := TFont.Create;
try
// フォントサイズ変更
LFont.Size := 20 ;
LFont.Style := [fsBold];
SendMessage(FhWndTip, WM_SETFONT, LFont.Handle, 0 );
LToolInfo.cbSize := SizeOf(TToolInfo);
LToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
LToolInfo.hWnd := Ctrl.Handle;
LToolInfo.hInst := HInstance;
LToolInfo.lpszText := PChar(Text);
LToolInfo.Rect := Ctrl.ClientRect;
SendMessage(FhWndTip, TTM_ADDTOOL, 0 , integer(@LToolInfo));
SendMessage(FhWndTip, TTM_SETTITLE, WPARAM(Icon), LPARAM(PChar(Title)));
SendMessage(FhWndTip, TTM_TRACKACTIVATE, 1 , LPARAM(@LToolInfo));
finally
FreeAndNil(LFont);
end ;
end ;
上のサンプルでは,システムに用意されている画像を表示しいます.次のようにすれば,画像ファイルの画像を読み込んで表示できます.
図20
画像ファイルを読み込んで表示
リスト11
閉じるボタン付きのルーンヒントウィンドウを表示.画像を読み込んで表示する例
copy code
// =============================================================================
// 閉じるボタン付きのバルーンヒントを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
LIcon : TIcon;
begin
LIcon := TIcon.Create;
try
LIcon.LoadFromFile('ACCOUNT_FUNCTIONS.ico' );
LText := '主に通知表示用 ' + sLineBreak
+ 'アイコン画像を読み出して表示' ;
ShowBalloonTip(Button1, LIcon.handle, '自作バルーンヒント' , LText);
finally
FreeAndNil(LIcon);
end ;
end ;
ウィンドウの表示位置をスクリーン座標で指定できます.TToolInfo.hwnd の値を 0 にして,TToolInfo.Rect の値でスクリーン座標を指定します.この場合,ShowBalloonTip 関数内の Ctrl.Handle の値は 0 にして構いません. 以下のサンプルでは,ShowBalloonTip 関数にスクリーン座標値用の引数を設定しています.
自アプリ以外の場所に表示したい場合は以下を参考にしてください.
図21
ウィンドウの表示位置をスクリーン座標で指定
次のコードにすれば,マウスクリックの位置からバルーンヒントウィンドウを表示します.
GetCursorPos(LPos);
ShowBalloonTip(LPos, LhIcon, '自作バルーンヒント' , LText);
図22
マウスクリックの位置に表示
リスト12
バルーンヒントウィンドウのひ表示位置をスクリーン座標値で指定する
copy code
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string );
var
Form1: TForm1;
implementation
uses
Winapi.CommCtrl;
{$R *.dfm}
var
FhWndTip : THandle;
// =============================================================================
// 閉じるボタン付きのバルーンヒントを表示
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
LhIcon : HICON;
LPos : TPoint;
begin
LhIcon := LoadIcon(0 , IDI_QUESTION);
try
LText := '主に通知表示用 ' + sLineBreak
+ '閉じるボタンで閉じる' ;
LPos.X := Form1.Left + Form1.Width;
LPos.Y := Form1.Top;
ShowBalloonTip(LPos, LhIcon, '自作バルーンヒント' , LText);
finally
DestroyIcon(LhIcon);
end ;
end ;
// -----------------------------------------------------------------------------
// 閉じるボタン付きバルーンヒントを表示する手続き
// 表示位置を引数で指定 (スクリーン座標)
//
// Text が複数行の場合,2 行目以降が長いと全てが表示されない場合がある
// 1 行目の文字列またはタイトルの文字列に全角の空白文字を追加すると回避できる
// -----------------------------------------------------------------------------
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string );
var
LWndFlag : Cardinal;
LToolInfo : TToolInfo;
begin
if FhWndTip <> 0 then begin
PostMessage(FhWndTip, WM_CLOSE, 0 , 0 );
FhWndTip := 0 ;
end ;
LWndFlag := WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil , LWndFlag,
0 , 0 , 0 , 0 , 0 , 0 , HInstance, nil );
if FhWndTip = 0 then Exit;
LToolInfo.cbSize := SizeOf(TToolInfo);
LToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
LToolInfo.hWnd := 0 ; // Ctrl.Handle;
LToolInfo.hInst := HInstance;
LToolInfo.lpszText := PChar(Text);
LToolInfo.Rect.Left := APos.X;
LToolInfo.Rect.Right := LToolInfo.Rect.Left;
LToolInfo.Rect.Top := APos.Y;
LToolInfo.Rect.Bottom := LToolInfo.Rect.Top;
SendMessage(FhWndTip, TTM_ADDTOOL, 0 , integer(@LToolInfo));
SendMessage(FhWndTip, TTM_SETTITLE, WPARAM(Icon), LPARAM(PChar(Title)));
SendMessage(FhWndTip, TTM_TRACKACTIVATE, 1 , LPARAM(@LToolInfo));
end ;
この閉じるボタン付きバルーヒントは,アプリを終了するか,閉じるボタンで閉じない限りヒントウィンドウを表示します.次のように,TTimer コンポーネントを使用すれば,ウィンドウを表示してから閉じるまでの時間の設定が可能になります.
TBalloonHint コンポーネントも内部で TTimer を使用しています.
リスト13
TTimer コンポーネントを使用して,一定時間悔過したらバルーンヒントウィンドウを閉じる
copy code
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string );
var
Form1: TForm1;
implementation
uses
Winapi.CommCtrl;
{$R *.dfm}
var
FhWndTip : THandle;
// =============================================================================
// 閉じるボタン付きのバルーンヒントを表示
// タイマーを使用して一定時間経過したら閉じる
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LText : string ;
LhIcon : HICON;
LPos : TPoint;
begin
Timer1.Enabled := False;
LhIcon := LoadIcon(0 , IDI_QUESTION);
try
LText := '主に通知表示用 ' + sLineBreak
+ 'タイマーで,閉じるまでの時間を設定' ;
GetCursorPos(LPos);
ShowBalloonTip(LPos, LhIcon, '自作バルーンヒント' , LText);
finally
DestroyIcon(LhIcon);
end ;
Timer1.Interval := 5000 ;
Timer1.Enabled := True;
end ;
// =============================================================================
// 一定時間経過したらバルーンヒントを閉じる
// =============================================================================
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if FhWndTip <> 0 then begin
PostMessage(FhWndTip, WM_CLOSE, 0 , 0 );
FhWndTip := 0 ;
Timer1.Enabled := False;
end ;
end ;
// -----------------------------------------------------------------------------
// 閉じるボタン付きバルーンヒントを表示する手続き
// 表示位置を引数で指定 (スクリーン座標)
//
// フォントサイズ変更
// 変更可能なのは説明用テキストのみ
// 色関係の設定は実行しても無効
//
// Text が複数行の場合,2 行目以降が長いと全てが表示されない場合がある
// 1 行目の文字列またはタイトルの文字列に全角の空白文字を追加すると回避できる
// -----------------------------------------------------------------------------
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string );
var
LWndFlag : Cardinal;
LToolInfo : TToolInfo;
LFont : TFont;
begin
if FhWndTip <> 0 then begin
PostMessage(FhWndTip, WM_CLOSE, 0 , 0 );
FhWndTip := 0 ;
end ;
LWndFlag := WS_POPUP or TTS_CLOSE or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil , LWndFlag,
0 , 0 , 0 , 0 , 0 , 0 , HInstance, nil );
if FhWndTip = 0 then Exit;
LFont := TFont.Create;
try
// フォントサイズ変更
LFont.Size := 11 ;
LFont.Style := [fsBold];
SendMessage(FhWndTip, WM_SETFONT, LFont.Handle, 0 );
LToolInfo.cbSize := SizeOf(TToolInfo);
LToolInfo.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
LToolInfo.hWnd := 0 ;
LToolInfo.hInst := HInstance;
LToolInfo.lpszText := PChar(Text);
LToolInfo.Rect.Left := APos.X;
LToolInfo.Rect.Right := LToolInfo.Rect.Left;
LToolInfo.Rect.Top := APos.Y;
LToolInfo.Rect.Bottom := LToolInfo.Rect.Top;
SendMessage(FhWndTip, TTM_ADDTOOL, 0 , integer(@LToolInfo));
SendMessage(FhWndTip, TTM_SETTITLE, WPARAM(Icon), LPARAM(PChar(Title)));
SendMessage(FhWndTip, TTM_TRACKACTIVATE, 1 , LPARAM(@LToolInfo));
finally
FreeAndNil(LFont);
end ;
end ;
下図はテーマを変更した結果です.
本サンプルで表示するバルーンヒントウィンドウは,Windows のコモンコントロールがすべての描画を行っています.したがって,Delphi 自身のテーマの影響は受けません.
図23
テーマを変更
図24
テーマを変更
05_ TBalloonHint への閉じるボタン [X] 追加の可能性
TBalloonHint のバルーンヒントウィンドウに閉じるボタン付 [X] を追加したいという質問がネットにありました.これは,ウィンドウのスタイルを動的に変更したいということになります.
ウィンドウのスタイルは,ウィンドウを生成する時に設定します.Delphi の
TWinControl では CreateParams というメソッドが実装されています.このメソッドをオーバライドして生成時のウィンドウのスタイルが変更できます.表示中のウィンドウは,Windows API の SetWindowLong 関数で変更できます.
このことを,前項の閉じるボタン付きのバルーンヒントウィンドウで確認してみます.閉じるボタンを表示する TTS_CLOSE というフラグを除外してウィンドウを生成してみます.下図のように「閉じボタン」がありません.
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string );
var
LWndFlag : Cardinal;
LToolInfo : TToolInfo;
begin
// TTS_CLOSE なしでウィンドウを作成
LWndFlag := WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil , LWndFlag,
0 , 0 , 0 , 0 , 0 , 0 , HInstance, nil );
図25
閉じるボタン [X] なしでウィンドウを生成
SetWindowLong 関数を使用して,ウィンドウのスタイルに TTS_CLOSE を追加した結果です.閉じるボタンが追加されているのが確認できます.
この閉じるボタンは,フォーム (ウィンドウ) のキャプションバー (タイトルバー) の閉じるボタンではありません.
フォームの閉じるボタンは,フォームのシステムメニューとしてのボタンです.TTS_CLOSE の TTS は Tool Tip Style の略と解釈できます.
procedure ShowBalloonTip(APos: TPoint; Icon: HICON; const Title, Text: string );
var
LWndFlag : Cardinal;
LToolInfo : TToolInfo;
LWndStyle : NativeInt;
begin
// TTS_CLOSE なしでウィンドウを作成
LWndFlag := WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP;
FhWndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil , LWndFlag,
0 , 0 , 0 , 0 , 0 , 0 , HInstance, nil );
// SetWindowLong 関数を使用して TTS_CLOSE を追加
// TTS_CLOSE はキャプションバー (タイトルバー) の閉じるボタンではない
LWndStyle := GetWindowLong(FhWndTip, GWL_STYLE);
SetWindowLong(FhWndTip, GWL_STYLE, LWndStyle or TTS_CLOSE);
図26
SetWindowLong 関数で TTS_CLOSE を追加
下図は TBalloonHint のバルーンヒントウィンドウのデフォルトの状態です.
図27
TBalloonHint のデフォルトのウィンドウスタイル
以下のコードを使用して,SetWindowLong 関数で TBalloonHint のウィンドウスタイルを変更するコードを実行してみます.
TBalloonHint は TWinControl ではありません.TComponent --> TCustomHint --> TBalloonHint と派生したコンポーネントです.TWinControl ではないので CreateParams メソッドはありません.TBalloonHint が表示するウィンドウは,クラス名が TCustomHintWindow の HintWindow という変数のウィンドウです.これは,ShowHint メソッドでウィンドウを表示する際に生成されます.つまり内部的な変数です.外部からは操作できません.
TBalloonHint の継承クラスを作成して,PaintHint メソッド,あるいは SetHintSize メソッドをオーバライドすれば,そのメソッド内で HintWindow を操作できます.
下図は,SetHintSize メソッド内で SetWindowLong 関数を使用して,ウィンドウのスタイルに TTS_CLOSE を追加した結果ですが,閉じるボタンはありません.
// -----------------------------------------------------------------------------
// TBalloonHint コンポーネントの継承クラスの SetHintSize メソッド
// -----------------------------------------------------------------------------
procedure TMyBalloonHint.SetHintSize(HintWindow: TCustomHintWindow);
var
LWndStyle : NativeInt;
begin
// ウィンドウのスタイルに TTS_CLOSE を追加
LWndStyle := GetWindowLong(HintWindow.Handle, GWL_STYLE);
SetWindowLong(HintWindow.Handle, GWL_STYLE, LWndStyle or TTS_CLOSE);
inherited ;
end ;
図28
SetWindowLong 関数で TTS_CLOSE を追加
今度は TTS_CLOSE ではなく,WS_CAPTION を追加してみます.結果は下図の通りです.
// -----------------------------------------------------------------------------
// TBalloonHint コンポーネントの継承クラスの SetHintSize メソッド
// -----------------------------------------------------------------------------
procedure TMyBalloonHint.SetHintSize(HintWindow: TCustomHintWindow);
var
LWndStyle : NativeInt;
begin
// ウィンドウのスタイルに WS_CAPTION を追加
LWndStyle := GetWindowLong(HintWindow.Handle, GWL_STYLE);
SetWindowLong(HintWindow.Handle, GWL_STYLE, LWndStyle or WS_CAPTION);
inherited ;
end ;
図29
SetWindowLong 関数で WS_CAPTION を追加
TBalloonHint は,ShowHint メソッドが実行されると,ウィンドウを生成してバルーンヒントウィンドウをカスタム描画しています.それが PaintHint メソッドです.そのウィンドに自前で閉じるボタンを描画することは可能ですが,ボタンクリックを検知するには,おそらくマウスフックが必要です.TBalloonHint のウインドウはカスタム描画のウィンドウなので,Windows のコモンコントロールが発行する WM_NOTIFY メッセージはありません.
現実問題として,閉じるボタンの必要性を検討する必要があるかも知れません.
plBalloonHint.zip [5.0 MB] 2021年12月26日版(次項のサンプルも同梱.EXE 同梱)
Delphi の TBalloonHint コンポーネントに対しての要望があるようです.それらは,文字のサイズの変更,背景色,閉じるボタンの追加,常に下方向,あるいは上に表示したい等です.一部については前掲のサンプルでその方法を示しました.閉じるボタンの可能性についても前項で確認しました.
バルーンヒントウィンドウを自作すれば,解決できる問題もあります.そこで,自作する場合に参考となるサンプルをユニットとして
作成してみました.ユニット名は plBalloonHint です.このファイルをライブラリのパスが通ったフォルダ内において,uses 部に追加して使用します.
最後に plBalloonHint のソースコートを掲載していますが,外部から使用可能なのは BalloonHint 関数だけです.この関数を実行すると,TCustomForm を継承したフォームを生成し,バルーンヒントウィンドウの形のリージョンを作成します.そこに関数の引数に渡したテキストやアイコン画像を描画します.
下図は BalloonHint 関数の使用例です.
図30
plBalloonHint ユニロットの使用例
図31
plBalloonHint ユニロットの使用例
plBalloonHint ユニロットを使用したバルーンヒントウィンドウの表示例
copy code
implementation
uses
plBalloonHint;
{$R *.dfm}
// =============================================================================
// バルーンヒントウィンドウを表示
// 添付の自作バルーンヒントウィンドウの使用例
//
// システムのアイコンを使用する例
// TIcon のオブジェクトを生成しなくてもよい
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LTitle : string ;
LText : string ;
LhIcon : HICON;
LPos : TPoint;
LArrow : TBalloonArrow;
begin
LTitle := 'ヒント' ;
LText := 'バルーンヒント表示テスト' + sLineBreak + '複数行可能' ;
LArrow := baBottomRight;
GetCursorPos(LPos);
LhIcon := LoadIcon(0 , IDI_INFORMATION);
try
BalloonHint(LTitle, LText, LhIcon, LArrow, LPos, 12000 );
finally
DestroyIcon(LhIcon);
end ;
end ;
// =============================================================================
// バルーンヒントウィンドウを表示
// 添付の自作バルーンヒントウィンドウの使用例
//
// TIcon を使用する例
// 引数に TIcon.Handle を渡す場合は TIcon.ReleaseHandle の処理が必要
//
// 添付のアイコン画像は 32 bit (サイズは 32 x 32)
// =============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LTitle : string ;
LText : string ;
LIcon : TIcon;
LPos : TPoint;
LArrow : TBalloonArrow;
begin
LTitle := 'ヒント' ;
LText := 'バルーンヒント表示テスト' + sLineBreak + '複数行可能' ;
LArrow := baBottomLeft;
GetCursorPos(LPos);
LIcon := TIcon.Create;
try
LIcon.LoadFromFile('ACCOUNT_FUNCTIONS.ico' );
BalloonHint(LTitle, LText, LIcon.Handle, LArrow, LPos, 12000 );
finally
LIcon.ReleaseHandle;
FreeAndNil(LIcon);
end ;
end ;
BalloonHint 関数の第 4 引数 ArrowPos (TBalloonArrow 型の変数) は,矢印とテキスト描画領域の位置関係の指定用です.以下のいずれかの値を指定します.baTopxxx を指定すると,常に矢印の上側にテキストを描画します.baBottomxxx を指定すると,常に矢印の下側にテキストを描画します.Center, Left, Right は水平方向の位置の指定です.
TBalloonArrow = (baTopCenter, baTopLeft, baTopRight,
baBottomCenter, baBottomLeft, baBottomRight);
図32
baBottomCenter の場合
図33
baTopCenter の場合
plBalloonHint の Paint メソッドではテーマのスタイルに従った描画を行っていません.下図のようにスタイルを変更しても描画の結果が変わることはありません.
図34
tカスタム描画なのでテーマのスタイルの影響を受けない
テーマのスタイルによる描画にするには uses に Themes を追加して,StyleServices の機能を使用します.コンパイル時に警告が現れますが ThemeServices も使用可能です.変更が必要なのは Paint メソッド内の描画コードです.添付のコンポーネントの Paint メソッドのコードを参考にしてください.
テーマのスタイルの設定に従った描画にしても,アイコンの描画位置,文字のサイズと描画位置等は自由に設定できます.
テーマのスタイルに対応するということは,本項の冒頭で述べた「背景色を変更したい」とは相反することになります.本来の意味でのカスタム描画ではありませんが,必要であれば検討してください.
// バルーンヒントの LDetails (TThemedElementDetails 型の変数)を取得
LDetails := StyleServices.GetElementDetails(thHintBalloon);
// 例えばテキストの色は以下の引数の LColor (TColor 型の変数) で取得
// この色でテキストを描画する
StyleServices.GetElementColor(LDetails, ecTextColor, LColor);
図35
テーマのスタイルに対応した場合
今回作成した plBalloonHint のソースコードです.
外部から実行可能な関数は BalloonHint だけです.この関数でバルーンヒントウィンドウを表示します.この関数の戻り値はバルーンヒントウィンドウのハンドルです.
コンポーネント化する場合,そのコンポーネントは,BalloonHint 関数に渡す値を設定するためのプロパティを実装します.例えば TComponent の派生クラスとします.そして,例えば ShowBalloonHint という名前のメソッドを実装して,そのメソッド内で BalloonHint 関数と同じようなコードを実行します.
この方針で作成したコンポーネントを同梱しています.そのコンポーネントの使用例が次項のサンプルです.
リスト14
バルーンヒントウィンドウを自作する場合の参考サンプル
copy code
unit plBalloonHint;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TBalloonArrow = (baTopCenter, baTopLeft, baTopRight,
baBottomCenter, baBottomLeft, baBottomRight);
function BalloonHint(const Title, Text: string ; AIcon: HICON;
ArrowPos: TBalloonArrow; APos: TPoint; Duration: Cardinal = 0 ): HWND;
implementation
uses
Winapi.CommCtrl,
System.Types;
type
TBalloonForm = class (TCustomForm)
private
FDuration: Cardinal;
FArrowPos: TBalloonArrow;
FRgnRect: TRect;
FRegion: HRGN;
FText: string ;
FInBtnRect : Boolean;
FhTimer: Cardinal;
function CalcBallonRect: TRect;
procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
protected
procedure Paint; override ;
procedure CreateParams(var Params: TCreateParams); override ;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override ;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override ;
procedure Click; override ;
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
public
constructor Create(AOwner: TComponent); override ;
destructor Destroy; override ;
procedure Popup(X, Y: Integer);
property ArrowPos: TBalloonArrow read FArrowPos write FArrowPos;
property Text: string read FText write FText;
property Duration: Cardinal read FDuration write FDuration;
end ;
var
FBalloonForm : TBalloonForm;
FBtnRect : TRect;
FIconWidth : Integer;
FBtnWidth : Integer;
FIconLeft : Integer;
FTextLeft : Integer;
FTextTop : Integer;
// -------------------------------------------------
// 矢印 (三角形) 等の設定値
// FRadSize : 矩形の角の丸み
// FArrowLen : 矢印の長さ
// FArrowX1 : 三角形の底辺の X 座標
// FArrowX2 : 三角形の底辺のもう 1 つの X 座標
// -------------------------------------------------
FRadSize : Integer = 2 ;
FArrowLen : Integer = 20 ;
FArrowX1 : Integer = 16 ;
FArrowX2 : Integer = 36 ;
// -----------------------------------------------------------------------------
// バルーン型の図形 (リージョン) の作成
// -----------------------------------------------------------------------------
function CreateBalloonRgn(const Rect: TRect; Placement: TBalloonArrow): HRGN;
var
LPoints : array [0 ..2 ] of TPoint;
LResRgn : HRGN;
LRectRgn : HRGN;
LArrowRgn : HRGN;
LXStart : Integer;
LXEnd : Integer;
LXDes : Integer;
begin
LResRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
case Placement of
baTopCenter, baTopLeft, baTopRight:
LRectRgn := CreateRoundRectRgn(Rect.Left, Rect.Top,
Rect.Right, Rect.Bottom - FArrowLen, FRadSize, FRadSize);
else
LRectRgn := CreateRoundRectRgn(Rect.Left, Rect.Top + FArrowLen,
Rect.Right, Rect.Bottom, FRadSize, FRadSize);
end ;
LXDes := (FArrowX2 - FArrowX1) div 2 ;
LXStart := (Rect.Width div 2 ) - LXDes;
LXEnd := (Rect.Width div 2 ) + LXDes;
case Placement of
baTopCenter:
begin
LPoints[0 ] := Point(LXStart, Rect.Bottom - FArrowLen - 1 );
LPoints[1 ] := Point(LXStart + LXDes, Rect.Bottom);
LPoints[2 ] := Point(LXEnd, Rect.Bottom - FArrowLen - 1 );
end ;
baBottomCenter:
begin
LPoints[0 ] := Point(LXStart, Rect.Top + FArrowLen);
LPoints[1 ] := Point(LXStart + LXDes, Rect.Top);
LPoints[2 ] := Point(LXEnd, Rect.Top + FArrowLen);
end ;
baTopLeft:
begin
LPoints[0 ] := Point(Rect.Right - FArrowX1, Rect.Bottom - FArrowLen - 1 );
LPoints[1 ] := Point(Rect.Right - FArrowX1, Rect.Bottom);
LPoints[2 ] := Point(Rect.Right - FArrowX2, Rect.Bottom - FArrowLen - 1 );
end ;
baTopRight:
begin
LPoints[0 ] := Point(Rect.Left + FArrowX1, Rect.Bottom - FArrowLen - 1 );
LPoints[1 ] := Point(Rect.Left + FArrowX1, Rect.Bottom);
LPoints[2 ] := Point(Rect.Left + FArrowX2, Rect.Bottom - FArrowLen - 1 );
end ;
baBottomLeft:
begin
LPoints[0 ] := Point(Rect.Right - FArrowX1, Rect.Top + FArrowLen);
LPoints[1 ] := Point(Rect.Right - FArrowX1, Rect.Top);
LPoints[2 ] := Point(Rect.Right - FArrowX2, Rect.Top + FArrowLen);
end ;
baBottomRight:
begin
LPoints[0 ] := Point(Rect.Left + FArrowX1, Rect.Top + FArrowLen);
LPoints[1 ] := Point(Rect.Left + FArrowX1, Rect.Top);
LPoints[2 ] := Point(Rect.Left + FArrowX2, Rect.Top + FArrowLen);
end ;
end ;
LArrowRgn := CreatePolygonRgn(LPoints, Length(LPoints), WINDING);
CombineRgn(LResRgn, LRectRgn, LArrowRgn, RGN_OR);
Result := LResRgn;
DeleteObject(LRectRgn);
DeleteObject(LArrowRgn);
end ;
{ TBalloonForm }
// =============================================================================
// バルーンヒント用のウィンドウ (このフォーム) 生成メソッド
// =============================================================================
constructor TBalloonForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
if FBalloonForm <> nil then FBalloonForm.Release;
BorderStyle := bsNone;
FBalloonForm := Self;
FInBtnRect := False;
FBtnWidth := 16 ;
Width := 200 ;
Height := 200 ;
end ;
// =============================================================================
// CreateParams メソッド
// =============================================================================
procedure TBalloonForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := WS_POPUP;
Params.ExStyle := WS_EX_TOPMOST or WS_EX_NOACTIVATE;
Params.WindowClass.style := Params.WindowClass.Style or CS_DROPSHADOW;
end ;
// =============================================================================
// バルーンヒント用のウィンドウ (このフォーム) 破棄時のメソッド
// =============================================================================
destructor TBalloonForm.Destroy;
begin
if FBalloonForm = Self then FBalloonForm := nil ;
if FRegion <> 0 then DeleteObject(FRegion);
if FhTimer <> 0 then KillTimer(Handle, FhTimer);
inherited Destroy;
end ;
// =============================================================================
// 表示する文字列の長さと行数から文字列を描画する矩形領域のサイズを計算
// 矢印の描画部分を除いた矩形領域
// アイコンの描画開始 X 座標,テキストの描画開始 x, Y 座標も設定
//
// テキストの折り返し表示がある場合の処理はない
// =============================================================================
function TBalloonForm.CalcBallonRect: TRect;
var
LSize : TSize;
LPosX : Integer;
LPosY : Integer;
LStrings : TStrings;
LIndex : Integer;
begin
// アイコンとテキストの描画開始位置
if Icon.Handle = 0 then begin
FIconWidth := 0 ;
FIconLeft := 0 ;
FTextLeft := 12 ;
end else begin
FIconWidth := Icon.Width;
FIconLeft := 8 ;
FTextLeft := FIconLeft + FIconWidth + FIconLeft + 5 ;
end ;
FTextTop := 8 ;
if Caption = '' then begin
LSize.Width := 0 ;
LSize.Height := 0 ;
end else begin
LSize := Canvas.TextExtent(Caption);
end ;
LPosX := LSize.cx;
LPosY := LSize.cy;
if Text <> '' then begin
LStrings := TStringList.Create;
try
LStrings.Text := Text;
if LStrings.Count > 0 then LPosY := LPosY + 8 ;
for LIndex := 0 to LStrings.Count - 1 do begin
LSize := Canvas.TextExtent(LStrings[LIndex]);
if LSize.cx > LPosX then LPosX := LSize.cx;
LPosY := LPosY + LSize.cy;
end ;
finally
FreeAndNil(LStrings);
end ;
end ;
LPosX := LPosx + FTextLeft + 22 ;
if (Caption = '' ) then begin
LPosX := LPosX + FBtnWidth + 7 ;
end ;
SetRect(Result, 0 , 0 , LPosX, LPosY);
end ;
// =============================================================================
// Popup メソッド
// このフォームはこのメソッドで表示する
// =============================================================================
procedure TBalloonForm.Popup(X, Y: Integer);
// ----------------------------
// フォームの表示位置を調整
// ----------------------------
procedure CalcFormPos(var X, Y: Integer);
begin
case FArrowPos of
baTopCenter, baTopLeft, baTopRight:
begin
Y := Y - Height;
if FArrowPos = baTopCenter then begin
X := X - Width div 2 ;
end else
if FArrowPos = baTopLeft then begin
X := X - Width + FArrowX1;
end else begin
X := X - FArrowX1;
end ;
end ;
else
if FArrowPos = baBottomCenter then begin
X := X - Width div 2 ;
end else
if FArrowPos = baBottomLeft then begin
X := X - Width + FArrowX1;
end else begin
X := X - FArrowX1;
end ;
end ;
end ;
begin
// アイコンとテキスト描画の矩形領域を計算
FRgnRect := CalcBallonRect;
FRgnRect.Bottom := FRgnRect.Bottom + FArrowLen + FTextTop * 2 ;
// このフォームのサイズ
Width := FRgnRect.Width;
Height := FRgnRect.Height;
// 表示位置を調整 (x 座標)
CalcFormPos(X, Y);
if FRegion <> 0 then DeleteObject(FRegion);
// リージョンの作成と Windows への登録
FRegion := CreateBalloonRgn(FRgnRect, FArrowPos);
SelectClipRgn(Canvas.Handle, FRegion);
SetWindowRgn(Handle, CreateBalloonRgn(FRgnRect, FArrowPos), True);
// 表示
SetWindowPos(Handle, HWND_TOPMOST, X, Y, Width, Height,
SWP_SHOWWINDOW or SWP_NOACTIVATE);
// タイマーの開始 (表示時間の制御)
if FDuration = 0 then FDuration := 10000 ;
FhTimer := SetTimer(Handle, 1 , FDuration, nil );
end ;
// =============================================================================
// Paint メソッド
// 描画が必要になると自動的に実行されるメソッド
// アイコン,テキスト等をこのフォームの Canvas に描画
// =============================================================================
procedure TBalloonForm.Paint;
// -------------------------
// 閉じるボタンを描画
// -------------------------
procedure DrawCloseBtn(ARect: TRect; AColor: TColor; DrawFrame: Boolean = True);
var
LRect : TRect;
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := AColor;
Canvas.Pen.Width := 1 ;
LRect := ARect;
if DrawFrame then begin
Canvas.Rectangle(LRect);
end ;
InflateRect(LRect, -4 , -4 );
Canvas.MoveTo(LRect.Left, LRect.Top);
Canvas.LineTo(LRect.Right, LRect.Bottom);
Canvas.MoveTo(LRect.Right, LRect.Top);
Canvas.LineTo(LRect.Left, LRect.Bottom);
end ;
var
LBaseRect : TRect;
LRect : TRect;
LBtnXPos : Integer;
LBtnYPos : Integer;
begin
case FArrowPos of
baTopCenter, baTopLeft, baTopRight:
begin
SetRect(LBaseRect, FRgnRect.Left, FRgnRect.Top,
FRgnRect.Left + Width, FRgnRect.Top + Height - FArrowLen);
end ;
else
begin
SetRect(LBaseRect, FRgnRect.Left, FRgnRect.Top + FArrowLen,
FRgnRect.Left + Width, FRgnRect.Top + Height);
end ;
end ;
// バルーン型の図形 (リージョン) の塗り潰しと輪郭線の描画
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := $00E1FFFF ;
FillRgn(Canvas.Handle, FRegion, Canvas.Brush.Handle);
FrameRgn(Canvas.Handle, FRegion, GetStockObject(GRAY_BRUSH), 1 , 1 );
LRect := LBaseRect;
Canvas.Brush.Style := bsClear;
// アイコンを描画
if Icon.Handle <> 0 then begin
Canvas.Draw(LRect.Left + FIconLeft, LRect.Top + FTextTop + 2 , Icon);
end ;
// タイトルを描画
if Caption <> '' then begin
Canvas.Font.Style := [fsBold];
Canvas.Font.Color := clBlue;
Canvas.TextOut(LRect.Left + FTextLeft, LRect.Top + FTextTop, Caption);
end ;
Canvas.Font.Color := clBlack;
// テキストを描画
if FText <> '' then begin
Canvas.Font.Style := [];
if Caption <> '' then begin
LRect.Top := LRect.Top + Canvas.TextHeight(Caption) + FTextTop + 5 ;
end else begin
LRect.Top := LRect.Top + FTextTop;
end ;
LRect.Left := LRect.Left + FTextLeft;
Canvas.TextRect(LRect, FText, []);
end ;
// 閉じるボタンの描画位置
LBtnXPos := LBaseRect.Right - FBtnWidth - 10 ;
LBtnYPos := LBaseRect.Top + 6 ;
SetRect(FBtnRect, LBtnXPos, LBtnYPos, LBtnXPos + FBtnWidth, LBtnYPos + FBtnWidth);
// 閉じるボタンを描画
DrawCloseBtn(FBtnRect, clGray, FInBtnRect);
end ;
// =============================================================================
// WM_TIMER メッセージ
// WM_ACTIVATE メッセージ処理
// このウィンドウはアクティブ化させない
// =============================================================================
procedure TBalloonForm.WMActivate(var Message: TWMActivate);
begin
if Message.Active <> WA_INACTIVE then begin
SetActiveWindow(Message.ActiveWindow);
end ;
end ;
// =============================================================================
// WM_TIMER メッセージ
// 指定時間を経過したらこのフォームを破棄
// =============================================================================
procedure TBalloonForm.WMTimer(var Message: TWMTimer);
begin
KillTimer(Handle, FhTimer);
FhTimer := 0 ;
Release;
end ;
// =============================================================================
// このフォームの Click メソッド
// =============================================================================
procedure TBalloonForm.Click;
begin
inherited ;
// 例えは Release; (このフォームを閉じる) 等を実行
end ;
// =============================================================================
// このフォームの MouseUp メソッド
// 追加描画したボタンの上で Mouseup したらこのフォームを破棄 (つまり閉じる)
// =============================================================================
procedure TBalloonForm.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited ;
if Button = mbLeft then begin
if PtInRect(FBtnRect, Point(X, Y)) then begin
Release;
end ;
end ;
end ;
// =============================================================================
// このフォームの MouseMove メソッド
// 閉じるボタンの描画を変更
// =============================================================================
procedure TBalloonForm.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited ;
if PtInRect(FBtnRect, Point(X, Y)) and not FInBtnRect then begin
FInBtnRect := True;
Invalidate;
end else
if not PtInRect(FBtnRect, Point(X, Y)) and FInBtnRect then begin
FInBtnRect := False;
Invalidate;
end ;
end ;
// -----------------------------------------------------------------------------
// 外部から使用する関数
// バルーンヒントウィンドウを生成して表示
//
// Title : タイトルの文字列.1 行のみ
// Text : テキスト
// Icon : アイコンのハンドル.使用しない場合は 0 とする
// ArrowPos : フォームの相対表示位置.TBalloonArrow 型の値
// APos : 表示位置をスクリーン座標で指定 (矢印の先端の座標)
// Duration : 表示時間 (ミリ秒).1 秒未満も可.0 の時はデフォルトの 10 秒
// Cardinal(-1) にすれば事実上自動で閉じないのと同じ
//
// [備考]
// (1) ArrowPos が baTopxxx の時は APos.Y 座標から上に表示
// ArrowPos が baBottomxxx の時は APos.Y 座標よりも下に表示
// (2) 表示開始までの時間の設定はない
// -----------------------------------------------------------------------------
function BalloonHint(const Title, Text: string ; AIcon: HICON;
ArrowPos: TBalloonArrow; APos: TPoint; Duration: Cardinal = 0 ): HWND;
begin
FBalloonForm := TBalloonForm.Create(Application);
FBalloonForm.Font.Size := 13 ;
FBalloonForm.Caption := Title;
FBalloonForm.Text := Text;
FBalloonForm.Icon.Handle := AIcon;
FBalloonForm.ArrowPos := ArrowPos;
FBalloonForm.Duration := Duration;
FBalloonForm.Popup(APos.X, APos.Y);
Result := FBalloonForm.Handle;
end ;
end .
スクリーンの上端,下端,左端,右端のチェックをして表示位置を変更する場合は,PopUp メソッド内で処理します.例えば以下のようよします.
// 表示位置を調整 (x 座標)
CalcFormPos(X, Y);
// 右端のチェックの場合
if (X + Width) > Screen.Width then begin
if FArrowPos = baTopRight then FArrowPos := baTopLeft;
if FArrowPos = baBottomRight then FArrowPos := baBottomLeft;
// フォームの表示位置を再計算
CalcFormPos(X, Y);
end ;
if FRegion <> 0 then DeleteObject(FRegion);
[備考]
ポップアップメニュー等,親を持たないオーパラップなウィンドウにはコントロール類 (コンポーネント類) を配置することはできません.フォームだけは例外的にコントロール類を配置することができます.
ただし,本サンプルのバルーンヒントウィンドウのフォームにはコントロール類を配置することはできません.本サンプルのフォームは,CreateNew メソッドでフォームを生成しています.CreateNew メソッドで生成したフォームにはコントロール類を配置することができませんが,dfm ファイル,フォームのリソースファイルなしてフォームを生成することができます.
07_ バルーンヒントウィンドウにボタン追加とカスタマイズ
今回作成したバルーンヒントウィンドウ表示用のコンポーネントを使用して,バルーンヒントウィンドウにボタン等を追加したり描画をカスタマイズする例です.実際には TButton 等は配置できません.画像として描画します.
図36
設計時の画面
作成した TplBalloonHint コンポーネントを配置
オブジェクト・インスペクタでイベントを実装します.今回実行するのは下図のイベントです.
図37
イベントを実装
OnMouseDown イベント
OnClick ではなく MouseDown にしてみた
OnPaint イベント
OnSize イベント
下図は科実行結果です.追加した [閉じる] ボタンの上でマウスの左ボタンを押すと,バルーンヒントウィンドウが閉じます.このサンプルでは,元の閉じるボタンは非表示にしています.
このバルーンヒントウィンドウは入力フォーカスを受け取る状態になることはありません.したがって,キー操作のイベントは受信できません.
図38
実行画面
リスト15
バルーンヒントウィンドウにボタンを追加する例
copy code
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
plBalloonHintEx;
type
TForm1 = class (TForm)
Button1: TButton;
plBalloonHint1: TplBalloonHint;
procedure Button1Click(Sender: TObject);
procedure plBalloonHint1Paint(Sender: TObject; ACanvas: TCanvas;
ARect: TRect);
procedure plBalloonHint1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure plBalloonHint1Size(Sender: TObject; var NewWidth,
NewHeight: Integer);
private
{ Private 宣言 }
FAddBtn1Rect : TRect;
public
{ Public 宣言 }
end ;
var
Form1: TForm1;
implementation
uses
Vcl.Themes,
System.Types;
{$R *.dfm}
// =============================================================================
// バルーンヒントウィンドウを表示
// システムのアイコン画像を表示する例
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LPos : TPoint;
begin
plBalloonHint1.Title := '情報' ;
plBalloonHint1.Text := 'バルーンヒント表示テスト' + sLineBreak + '複数行可能' ;
plBalloonHint1.Duration := Dword(-1 );
plBalloonHint1.BkgColor := clWebKhaki;
plBalloonHint1.ShowCloseBtn := False;
plBalloonHint1.FontSize := 13 ;
GetCursorPos(LPos);
plBalloonHint1.Pos := LPos;
plBalloonHint1.Icon.Handle := LoadIcon(0 , IDI_INFORMATION);
plBalloonHint1.ShowBalloonHint;
end ;
// =============================================================================
// TplBalloonHint の OnSize イベント
// このイベントでバルーンヒントウィンドウのサイズ変更が可能
// ボタンを追加するのその分ウィンドウの高さを増やす
// =============================================================================
procedure TForm1.plBalloonHint1Size(Sender: TObject; var NewWidth,
NewHeight: Integer);
begin
NewHeight := NewHeight + 30 ;
end ;
// =============================================================================
// TplBalloonHint の OnPain イベント
// テーマのボタンを追加描画
// =============================================================================
procedure TForm1.plBalloonHint1Paint(Sender: TObject; ACanvas: TCanvas;
ARect: TRect);
var
LDetails : TThemedElementDetails;
LText : string ;
LColor : TColor;
begin
SetRect(FAddBtn1Rect, ARect.Left + 16 , ARect.Bottom - 32 ,
ARect.Left + 76 , ARect.Bottom - 10 );
// テーマのボタンを描画
LDetails := StyleServices.GetElementDetails(tbPushButtonDefaulted);
StyleServices.DrawElement(ACanvas.Handle, LDetails, FAddBtn1Rect);
// ボタンの Caption を描画
StyleServices.GetElementColor(LDetails, ecTextColor, LColor);
LText := '閉じる' ;
ACanvas.Font.Size := 9 ;
ACanvas.Font.Color := LColor;
ACanvas.Brush.Style := bsClear;
ACanvas.TextRect(FAddBtn1Rect, LText, [ tfSingleLine, tfVerticalCenter, tfCenter]);
end ;
// =============================================================================
// TplBalloonHint の OnMouseDown イベント
// 追加したボタン上で MouseDown したらヒントウィンドウを閉じる
// ボタンクリックと同じ動作を実現する
//
// 本来は OnClick の処理にすべきであるが OnMouseDown のテストとした
// =============================================================================
procedure TForm1.plBalloonHint1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
if PtInRect(FAddBtn1Rect, Point(X, Y)) then begin
plBalloonHint1.CloseBalloonHint;
end ;
end ;
end ;
end .
TplBalloonHint コンポーネントでテキスト等の描画をカスタマイズする際の参考コードです.このサンプルでは,描画内容に関するプロパティを設定しないでバルーンヒントウィンドウを表示します.そのままではウィンドウのサイズが小さすぎます.そこで,OnSize イベントでウィンドウのサイズを設定します.描画は OnPaint イベントで実行します.
図39
実行画面
リスト16
描画をカスタマイズする際の参考サンプル
copy code
// =============================================================================
// バルーンヒントウィンドウを表示
// 描画内容を指定しない例
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LPos : TPoint;
begin
GetCursorPos(LPos);
plBalloonHint1.Pos := LPos;
plBalloonHint1.ShowBalloonHint;
end ;
// =============================================================================
// TplBalloonHint の OnSize イベント
// このイベントでバルーンヒントウィンドウのサイズ変更が可能
// =============================================================================
procedure TForm1.plBalloonHint1Size(Sender: TObject; var NewWidth,
NewHeight: Integer);
begin
NewWidth := 250 ;
NewHeight := 200 ;
end ;
// =============================================================================
// TplBalloonHint の OnPaint イベント
// 自由な描画が可能
// =============================================================================
procedure TForm1.plBalloonHint1Paint(Sender: TObject; ACanvas: TCanvas;
ARect: TRect);
begin
ACanvas.Font.Size := 25 ;
ACanvas.TextOut(ARect.Left + 50 , ARect.Top + 25 , '情報' );
end ;
次も描画をカスタマイズする際の参考コードです.バルーンヒントウィンドウの背景を塗り潰します.これで自由に描画できます.
Title プロパティの値も Text プロパティの値も実行時に変更できますが,ウィンドウのサイズが変わることはありません.
図40
バルーンヒントウィンドウの背景を塗り潰した結果
リスト17
バルーンヒントウィンドウの背景を塗り潰す
copy code
// =============================================================================
// バルーンヒントウィンドウを表示
// システムのアイコン画像を表示する例
// =============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LPos : TPoint;
begin
plBalloonHint1.Title := '情報' ;
plBalloonHint1.Text := 'バルーンヒント表示テスト' + sLineBreak + '複数行可能' ;
GetCursorPos(LPos);
plBalloonHint1.Pos := LPos;
plBalloonHint1.Icon.Handle := LoadIcon(0 , IDI_INFORMATION);
plBalloonHint1.ShowBalloonHint;
end ;
// =============================================================================
// TplBalloonHint の OnSize イベント
// このイベントでバルーンヒントウィンドウのサイズ変更が可能
// =============================================================================
procedure TForm1.plBalloonHint1Size(Sender: TObject; var NewWidth,
NewHeight: Integer);
begin
NewWidth := 250 ;
NewHeight := 200 ;
end ;
// =============================================================================
// TplBalloonHint の OnPain イベント
// バルーンヒントウィンドウの背景を塗り潰す
// =============================================================================
procedure TForm1.plBalloonHint1Paint(Sender: TObject; ACanvas: TCanvas;
ARect: TRect);
begin
ACanvas.Brush.Color := clWebKhaki;
ACanvas.FillRect(ACanvas.ClipRect);
end ;