ヒントウィンドウのカスタマイズ

参照元


redball.gif目次へ戻る

n01801.gif

Delphi の TControl の派生クラスには、Hint プロパティーがあってこれに適当な文字列を設定し、ShowHint プロパティーを true にすると、右図のようにコントロールの上にカーソルをもっていくと、しばらくしてヒントウィンドウが表示される。これは VCL の THintWindow クラスのインスタンスが Application オブジェクトに制御されて表示されているものである。TApplication には、ヒントウィンドウの見かけに関する三つのプロパティーがある。HintColor は背景色を設定・取得する。HintPause プロパティーは、ヒントが表示されるまで時間をミリ秒で設定できる。デフォルトは０．５秒である。HintShortPause は、別のヒントがすでに表示されている場合にヒントを呼び出すまでの時間を設定できる。デフォルトは５０ミリ秒である。


n01802.gif

ヒントウィンドウを THintWindow クラスから派生した任意のクラスに置き換えることができる。右図は、その一例である。ヒントウィンドウのフォントを代え、フォントの色を変え、ウィンドウの大きさを変え、左端を任意の色で背景を塗りつぶし、小さなビットマップを表示している。右図の例は配色の趣味がよくないが、要するにコード次第でどのような見かけにすることもできることを示したかったのである。ここでは、この例のようにするにはどうしたらよいかを調べよう。


まず最初は、Application.HintPause と Application.HintColor を変更することから始めよう。これはたんに代入するだけでできるが、ここではヒントウィンドウをカスタマイズする機能をコンポーネントにしたいので、わざわざそのためのクラスをつくってやってみよう。Delphi を起動して保存してから、メニューの[ファイル]、[新規作成]からユニットを選んで、以下のようにして MyHintUnit.pas として保存する。

List 1

unit MyHintUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
THintSetter = class(TComponent)
private
  FBkColor:TColor;
  FHintPause:integer;
  procedure SetBkColor(const Value: TColor);
  procedure SetHintPause(const Value: integer);
protected
public
  constructor Create(AOwner: TComponent);override;
published
  property BkColor:TColor read FBkColor write SetBkColor;
  property HintPause:integer read FHintPause write SetHintPause;
end;

implementation

{ ------------ THintSetter ------------ }

constructor THintSetter.Create(AOwner: TComponent);
begin
  inherited;
  FBkColor := Application.HintColor;
  FHintPause := 500;
end;

procedure THintSetter.SetBkColor(const Value: TColor);
begin
  FBkColor := Value;
  if not (csDesigning in ComponentState) then Application.HintColor := Value;
end;

procedure THintSetter.SetHintPause(const Value: integer);
begin
  FHintPause := Value;
  if not (csDesigning in ComponentState) then Application.HintPause := Value;
end;

end.

ものすごく簡単なコンポーネントだが、以下で少しずつ機能を追加してゆく。このコンポーネントを動的に作成してテストするコードを以下にしめす。uses に MyHintUnit を追加する。

List 2

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MyHintUnit, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    HintSetter:THintSetter;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintSetter := THintSetter.Create(self);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with HintSetter do begin
    BkColor := RGB(230,230,255);
    HintPause := 200;
  end;
end;

end.
n01803.gif

実行して Button1 を押すと右図のようになる。



つぎにヒントウィンドウの大きさを変えてみよう。これは、Application のプロパティーでは設定できない。D5 の VCL では、THintWindow クラスは Controls.pas で宣言・実装されているが、このユニットの型宣言に

type
THintWindowClass = class of THintWindow;

がある。つまり、THintWindowClass は THintWindow のクラス参照型である。ヒントウィンドウは Application オブジェクトによって動的に作成される。このとき、Application は、Forms.pas にあるグローバル変数

var HintWindowClass: THintWindowClass = THintWindow;

を使って作成する。この初期値は、うえのように THintWindow であるが、任意の時点で THintWindow から派生したクラスと置き換えることができる。重要なことは、クラス参照型の変数を置き換える、ということであり、派生クラスのインスタンスを置き換えることはできない。ヒントウィンドウのインスタンスは Application がつくるからである。したがって、たとえば THintWindow を継承して TMyHint クラスをつくって、これを入れ替えるには

    HintWindowClass := TMyHint;
    Application.ShowHint := false;
    Application.ShowHint := true;

とするとよいが、当然、このクラスは、TComponent から派生していないので、そのインスタンスのプロパティーを設計時に直接設定することはできない。ここでは、うえで作った THintSetter のインスタンスを通して、間接的に設定することにしよう。MyHintUnit.pas を以下のようにする。

List 3

unit MyHintUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
THintSetter = class(TComponent)
private
  FBkColor:TColor;
  FHintPause:integer;
  FLeftMargin:integer;
  FHeightMargin:integer;
  procedure SetBkColor(const Value: TColor);
  procedure SetHintPause(const Value: integer);
protected
public
  constructor Create(AOwner: TComponent);override;
published
  property BkColor:TColor read FBkColor write SetBkColor;
  property HintPause:integer read FHintPause write SetHintPause;
  property LeftMargin:integer read FLeftMargin write FLeftMargin;
  property HeightMargin:integer read FHeightMargin write FHeightMargin;
end;

implementation

var
  HintSetter:THintSetter;



type
TMyHint = class(THintWindow)
private
protected
public
  procedure ActivateHint(Rect: TRect; const AHint: string); override;
end;

{ ------------ THintSetter ------------ }

constructor THintSetter.Create(AOwner: TComponent);
begin
  inherited;
  
  HintSetter := self;

  FBkColor := Application.HintColor;
  FHintPause := 500;

  if not (csDesigning in ComponentState) then begin
    HintWindowClass := TMyHint;
    Application.ShowHint := false;
    Application.ShowHint := true;
  end;
end;

procedure THintSetter.SetBkColor(const Value: TColor);
begin
  FBkColor := Value;
  if not (csDesigning in ComponentState) then Application.HintColor := Value;
end;

procedure THintSetter.SetHintPause(const Value: integer);
begin
  FHintPause := Value;
  if not (csDesigning in ComponentState) then Application.HintPause := Value;
end;

{ --------- TMyHint ------------ }

procedure TMyHint.ActivateHint(Rect: TRect; const AHint: string);
begin
  Inc(Rect.Right,HintSetter.LeftMargin);
  Inc(Rect.Bottom,HintSetter.HeightMargin);

  inherited;
end;

end.

そして、これをテストするプログラムの全リストを以下に示す。

List 4

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MyHintUnit, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    HintSetter:THintSetter;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintSetter := THintSetter.Create(self);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with HintSetter do begin
    BkColor := RGB(230,230,255);
    HintPause := 200;
    LeftMargin := 50;
    HeightMargin := 20;
  end;
end;

end.
n01804.gif

実行して Button1 を押すと右図のようになる。


コードを見てみよう。THintSetter に新たに LeftMargin と HeightMargin の二つのプロパティーを追加した。コンストラクタでは

constructor THintSetter.Create(AOwner: TComponent);
begin
  inherited;
  
  HintSetter := self; // ここに注目！

  FBkColor := Application.HintColor;
  FHintPause := 500;

  if not (csDesigning in ComponentState) then begin
    HintWindowClass := TMyHint;
    Application.ShowHint := false;
    Application.ShowHint := true;
  end;
end;

のようにして、実装部のグローバル変数

var
  HintSetter:THintSetter;

に自分のインスタンス参照を設定している。THintWindow の派生クラス TMyHint は実装部に宣言・実装している。

type
TMyHint = class(THintWindow)
private
protected
public
  procedure ActivateHint(Rect: TRect; const AHint: string); override;
end;

ここでは、ActivateHint() をオーバーライドしているだけだ。

{ --------- TMyHint ------------ }

procedure TMyHint.ActivateHint(Rect: TRect; const AHint: string);
begin
  Inc(Rect.Right,HintSetter.LeftMargin);
  Inc(Rect.Bottom,HintSetter.HeightMargin);

  inherited;
end;

このように、THintSetter のインスタンス HintSetter の二つのプロパティーを参照して、継承メソッドに渡す Rect 変数を変更している。このようにして、ヒントウィンドウのサイズを変更することができた。


次にフォントを変更してみよう。いまやったサイズの変更とおなじようにして、TMyHint クラスで CalcHintRect() をオーバーライドすることでできる。MyHintUnit.pas を以下に示す。

List 5

unit MyHintUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
THintSetter = class(TComponent)
private
  FBkColor:TColor;
  FHintPause:integer;
  FLeftMargin:integer;
  FHeightMargin:integer;
  FFont:TFont;
  procedure SetBkColor(const Value: TColor);
  procedure SetHintPause(const Value: integer);
  procedure SetFont(const Value: TFont);
protected
public
  constructor Create(AOwner: TComponent);override;
  destructor Destroy; override;
published
  property BkColor:TColor read FBkColor write SetBkColor;
  property HintPause:integer read FHintPause write SetHintPause;
  property LeftMargin:integer read FLeftMargin write FLeftMargin;
  property HeightMargin:integer read FHeightMargin write FHeightMargin;
  property Font:TFont read FFont write SetFont;
end;

implementation

var
  HintSetter:THintSetter;

type
TMyHint = class(THintWindow)
private
protected
public
  procedure ActivateHint(Rect: TRect; const AHint: string); override;
  function CalcHintRect(MaxWidth: Integer; const AHint: string;
                                      AData: Pointer): TRect; override;
end;

{ ------------ THintSetter ------------ }

constructor THintSetter.Create(AOwner: TComponent);
begin
  inherited;
  FFont := TFont.Create;
  FFont.Assign(Screen.HintFont);

  HintSetter := self;

  FBkColor := Application.HintColor;
  FHintPause := 500;

  if not (csDesigning in ComponentState) then begin
    HintWindowClass := TMyHint;
    Application.ShowHint := false;
    Application.ShowHint := true;
  end;
end;

destructor THintSetter.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure THintSetter.SetBkColor(const Value: TColor);
begin
  FBkColor := Value;
  if not (csDesigning in ComponentState) then Application.HintColor := Value;
end;

procedure THintSetter.SetHintPause(const Value: integer);
begin
  FHintPause := Value;
  if not (csDesigning in ComponentState) then Application.HintPause := Value;
end;

procedure THintSetter.SetFont(const Value: TFont);
begin
  if FFont <> Value then FFont.Assign(Value);
end;

{ --------- TMyHint ------------ }

procedure TMyHint.ActivateHint(Rect: TRect; const AHint: string);
begin
  Inc(Rect.Right,HintSetter.LeftMargin);
  Inc(Rect.Bottom,HintSetter.HeightMargin);

  inherited;
end;

function TMyHint.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
begin
  if Canvas.Font <> HintSetter.Font then Canvas.Font.Assign(HintSetter.Font);
  result := inherited CalcHintRect(MaxWidth,AHint,AData);
end;

end.

これをテストする全リストを以下に示す。

List 6

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MyHintUnit, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    HintSetter:THintSetter;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintSetter := THintSetter.Create(self);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with HintSetter do begin
    BkColor := RGB(230,230,255);
    HintPause := 200;
    LeftMargin := 20;
    HeightMargin := 10;
    Font.Name := 'ＭＳ Ｐ明朝';
    Font.Height := 14;
    Font.Style := Font.Style + [fsBold];
    Font.Color := clGreen;
  end;
end;

end.
n01805.gif

実行して Button1 を押すと右図のようになる。ここでは、Font.Color だけが実際の描画に反映されていない。これは派生元の THintWindow の Paint メソッドのなかで設定し直しているからだ。



それでは最後に、Paint メソッドをオーバーライドして描画そのものを変更してみよう。ここでは、ヒントの文字列を描く部分はカスタマイズせずに、左の LeftMargin で確保された部分を描画する機能を THintSetter のイベントとしてユーザに公開する事にしよう。MyHintUnit.pas の全リストを以下に示す。これは、コンポーネントとして THintSetter をインストールできるようにした最終形である。

List 7

unit MyHintUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
TLeftMarginPaintEvent = procedure (Sender: TObject;
                               R: TRect; Canvas: TCanvas) of object;

THintSetter = class(TComponent)
private
  FBkColor:TColor;
  FHintPause:integer;
  FLeftMargin:integer;
  FHeightMargin:integer;
  FFont:TFont;
  FOnLeftMaginPaint:TLeftMarginPaintEvent;
  procedure SetBkColor(const Value: TColor);
  procedure SetHintPause(const Value: integer);
  procedure SetFont(const Value: TFont);
protected
public
  constructor Create(AOwner: TComponent);override;
  destructor Destroy; override;
published
  property BkColor:TColor read FBkColor write SetBkColor;
  property HintPause:integer read FHintPause write SetHintPause;
  property LeftMargin:integer read FLeftMargin write FLeftMargin;
  property HeightMargin:integer read FHeightMargin write FHeightMargin;
  property Font:TFont read FFont write SetFont;
  property OnLeftMaginPaint:TLeftMarginPaintEvent read FOnLeftMaginPaint
                                                  write FOnLeftMaginPaint;
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [THintSetter]);
end;

//----------

var
  HintSetter:THintSetter;

type
TMyHint = class(THintWindow)
private
  FActivating: Boolean;
protected
  procedure Paint; override;
public
  procedure ActivateHint(Rect: TRect; const AHint: string); override;
  function CalcHintRect(MaxWidth: Integer; const AHint: string;
                                      AData: Pointer): TRect; override;
end;

{ ------------ THintSetter ------------ }

constructor THintSetter.Create(AOwner: TComponent);
begin
  inherited;
  FFont := TFont.Create;
  FFont.Assign(Screen.HintFont);

  HintSetter := self;

  FBkColor := Application.HintColor;
  FHintPause := 500;

  if not (csDesigning in ComponentState) then begin
    HintWindowClass := TMyHint;
    Application.ShowHint := false;
    Application.ShowHint := true;
  end;
end;

destructor THintSetter.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure THintSetter.SetBkColor(const Value: TColor);
begin
  FBkColor := Value;
  if not (csDesigning in ComponentState) then Application.HintColor := Value;
end;

procedure THintSetter.SetHintPause(const Value: integer);
begin
  FHintPause := Value;
  if not (csDesigning in ComponentState) then Application.HintPause := Value;
end;

procedure THintSetter.SetFont(const Value: TFont);
begin
  if FFont <> Value then FFont.Assign(Value);
end;

{ --------- TMyHint ------------ }

procedure TMyHint.ActivateHint(Rect: TRect; const AHint: string);
begin
  Inc(Rect.Right,HintSetter.LeftMargin);
  Inc(Rect.Bottom,HintSetter.HeightMargin);

  inherited;
end;

function TMyHint.CalcHintRect(MaxWidth: Integer; const AHint: string;
  AData: Pointer): TRect;
begin
  if Canvas.Font <> HintSetter.Font then Canvas.Font.Assign(HintSetter.Font);
  result := inherited CalcHintRect(MaxWidth,AHint,AData);
end;

procedure TMyHint.Paint;
var
  R: TRect;
  LM:integer;
begin
  FActivating := true;
  try
    R := ClientRect;
    LM := HintSetter.LeftMargin;

    if Assigned(HintSetter.OnLeftMaginPaint) and (LM > 0) then
      HintSetter.OnLeftMaginPaint(HintSetter,
        Rect(R.Left,R.Top,R.Left+LM-2,R.Bottom),Canvas);

    Canvas.Brush.Style := bsClear;

    Inc(R.Left,LM+2);
    DrawText(Canvas.Handle, PChar(Caption), -1, R,
                        DT_LEFT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE);
  finally
    FActivating := false;
  end;
end;

end.

このコンポーネントを動的に作成してテストするプログラムの全リストを以下に示す。

List 8

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MyHintUnit, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    HintSetter:THintSetter;
    procedure LMPaint(Sender: TObject; R: TRect; Canvas: TCanvas);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  HintSetter := THintSetter.Create(self);
  HintSetter.OnLeftMaginPaint := LMPaint;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with HintSetter do begin
    BkColor := RGB(230,255,230);
    HintPause := 200;
    LeftMargin := 10;
    HeightMargin := 4;
    with Font do begin
      Name := 'MS UI Gothic';
      Style := Style + [fsBold];
      Color := clNavy;
      Height := 12;
    end;
  end;
end;

procedure TForm1.LMPaint(Sender: TObject; R: TRect; Canvas: TCanvas);
var
  Pts:array[0..2] of TPoint;
begin
  Pts[0] := Point(-1,0);
  Pts[1] := Point(R.Right,R.Bottom+1);
  Pts[2] := Point(-1,R.Bottom+1);

  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clBlue;
    FillRect(R);
    Brush.Color := clFuchsia;
    Pen.Color   := clFuchsia;
    Polygon(Pts);
  end;
end;

end.
n01806.gif

実行して Button1 を押すと右図のようになる。


最後に THintSetter をインストールしてテストするプログラムを以下に示す。ここでは、小さなビットマップをここの EXE に埋め込む - リソースの使い方 でやったようにリソースにして TBitmap のインスタンスで取り出して使用している。

List 9

  public
    bmp:TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  bmp.LoadFromResourceName(hInstance,'HintBmp');
  bmp.Transparent := true;

  HintSetter1.LeftMargin := bmp.Width+4;
  HintSetter1.HeightMargin := 2;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

procedure TForm1.HintSetter1LeftMaginPaint(Sender: TObject; R: TRect;
  Canvas: TCanvas);
begin
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clYellow;
  Canvas.FillRect(R);
  Canvas.Draw((R.Right-bmp.Width) div 2,(R.Bottom-bmp.Height) div 2,bmp);
end;
n01807.gif

実行すると右図のようになる。


n01808.gif

また、背景を描画せずに右図のようにビットマップだけを描画してもよい。



以上のように、ここでは Delphi のヒントウィンドウをカスタマイズする方法を調べ、その機能つつみこんだコンポーネントを作成した。

redball.gif目次へ戻る