拡張ボタン（ＴＢｕｔｔｏｎＥＸ）
ＴＢｕｔｔｏｎの拡張ボタンで、TColorbtnと、似ています。
こちらのボタンは、通常のボタン、楕円ボタン、旧タイプフレームボタン、ユーザー描画ボタンがあり、選択して使用します。
ユーザー描画は、描画割り込みを使用し、その割り込みルーチンに、ボタンの作図プログラムを作成することにより自由なボタンを表示することが可能となります。
ボタンを描画するため、TColorbtn と同じように、 TCanvas を追加して、ボタンの描画をします。
上図で上で、一番左のボタンは、コンポーネント内でなく、描画割り込みで、作図しています。
二番目のボタンは、フォントの色指定をしていますが、ボタンに色をつける場合は、描画割り込みで描画する必要があります。
三番目の楕円ボタンは、楕円形状を指定しています。
一番右は、スタンダードなボタンで、ＴＢｕｔｔｏｎと同じボタンになります。
下側は、デスエブル状態です。
TButtonEX コンポーネントのリスト
interface
uses
Windows, SysUtils, Classes, Controls, StdCtrls, Graphics, Messages;
type
TDrawButtonEvent = procedure (Control: TWinControl; Rect: TRect; Caption: TCaption;
State: TOwnerDrawState) of object;
TButtonExStyle = (bsStandard, bsOvalDraw, bsOwnerDraw, bsOwnerDrawWithFrame);
TButtonEX = class(TButton)
private
{ Private 宣言 }
FBtnColor : TColor;
FCanvas: TCanvas;
FIsFocused: Boolean;
FStyle: TButtonExStyle;
FOnDrawButton: TDrawButtonEvent;
procedure SetStyle(Value: TButtonExStyle);
procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
procedure SetBtnColor(Value: TColor);
protected
{ Protected 宣言 }
procedure CreateParams(var Params: TCreateParams); override;
procedure DrawButton(const Rect: TRect; State: TOwnerDrawState);
dynamic;
procedure SetButtonStyle(ADefault: Boolean); override;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
public
{ Public 宣言 }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read FCanvas;
published
{ Published 宣言 }
property ButtonStyle: TButtonExStyle read FStyle write SetStyle
default bsStandard;
property OnDrawButton: TDrawButtonEvent read FOnDrawButton
write FOnDrawButton;
property Color;
property ParentColor;
property BtnColor: Tcolor read FBtnColor write SetBtnColor default clBtnFace;
end;
procedure Register;
implementation
uses Buttons;
// コンポーネントの登録
procedure Register;
begin
RegisterComponents('MyVCL', [TButtonEX]);
end;
// TButtonEXの生成
constructor TButtonEx.Create(AOwner: TComponent);
begin
inherited Create(AOwner); // Button 生成
FCanvas := TControlCanvas.Create; // Canvas 生成
TControlCanvas(FCanvas).Control := Self;
FBtnColor := clBtnFace;
end;
// TButtonの破棄
destructor TButtonEx.Destroy;
begin
FCanvas.Free; // Canvasの解放
inherited Destroy; // Buttonの破棄
end;
// パラメーターの生成
procedure TButtonEx.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FStyle <> bsStandard then
Params.Style := Params.Style or BS_OWNERDRAW
else
CreateSubClass(Params, 'BUTTON');
end;
// ダブルクリック時、ボタンダウンに変換
procedure TButtonEx.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
// ボタンカラーのセット
procedure TButtonEx.SetBtnColor(Value: TColor);
begin
if FBtnColor <> Value then
begin
FBtnColor := Value;
Refresh;
end;
end;
// ボタンスタイルのセットされたらボタン再生成
procedure TButtonEx.SetStyle(Value: TButtonExStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
RecreateWnd;
end;
end;
// ボタンスタイル指定によるボタンの描画
procedure TButtonEx.DrawButton(const Rect: TRect; State: TOwnerDrawState);
var
R, DR: TRect;
begin
R := Rect;
// フレーム付オーナー作図ボタンなら
if FStyle = bsOwnerDrawWithFrame then
begin
DR := R;
if odFocused in State then
begin
Inc(DR.Left, 1);
Inc(DR.Top, 1);
Dec(DR.Right, 1);
Dec(DR.Bottom, 1);
end;
if not (odSelected in State) then
DrawButtonFace(FCanvas, DR, 1, bsAutoDetect, False, odSelected in State, FIsFocused)
else
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Rectangle(DR.Left, DR.Top, DR.Right, DR.Bottom);
end;
DR := R;
Inc(DR.Left, 3);
Inc(DR.Top, 3);
Dec(DR.Right, 3);
Dec(DR.Bottom, 3);
if Assigned(FOnDrawButton) then
OnDrawButton(Self, DR, Caption, State)
else
begin
if Enabled then
DrawText(FCanvas.Handle, PChar(Caption), -1, DR, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
else
DrawState( FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
0, 0, DST_TEXT or DSS_DISABLED)
end;
InflateRect(DR, -1, -1);
if odFocused in State then
begin
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Font.Color := clBlack;
FCanvas.Brush.Color := clBtnFace;
DrawFocusRect(FCanvas.Handle, DR);
FCanvas.Brush.Style := BsClear;
FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
end;
end
// オーナー作図ボタンで描画割り込みが設定されていなかったら
else if (FStyle = bsOwnerDraw) and not Assigned(FOnDrawButton) then
begin
FCanvas.Brush.Color := FBtncolor;
FCanvas.FillRect(R);
end
// 楕円ボタンだったら
else if FStyle = bsOvalDraw then
with FCanvas do
begin
DR := R;
Dec(DR.Right, 1);
Dec(DR.Bottom, 1);
Pen.Style := psClear;
if odSelected in State then
Brush.Color := clBtnShadow
else
Brush.Color := clBtnHighlight;
with R do
Pie(Left, Top, Right, Bottom, Right, Top, Left, Bottom);
if odSelected in State then
Brush.Color := clBtnHighlight
else
Brush.Color := clBtnShadow;
with R do
Pie(Left, Top, Right, Bottom, Left, Bottom, Right, Top);
Pen.Color := clWindowFrame;
if odFocused in State then
begin
Pen.Style := psSolid;
Brush.Style := BsClear;
with DR do
Ellipse(Left, Top, Right, Bottom);
end;
Brush.Color := FBtnColor;
Brush.Style := BsSolid;
if not (odSelected in State) then
begin
Pen.Style := psClear;
Inc(DR.Left, 2);
Inc(DR.Top, 2);
Dec(DR.Right, 2);
Dec(DR.Bottom, 2);
end
else
begin
Pen.Style := psSolid;
Inc(DR.Left, 3);
Inc(DR.Top, 3);
Dec(DR.Right, 2);
Dec(DR.Bottom, 2);
end;
with DR do
Ellipse(Left, Top, Right, Bottom);
end;
if odDisabled in State then FCanvas.Font.Color := clGrayText
else
FCanvas.Font.Color := Font.Color;
// オーナー作図ボタンで描画割り込みが設定されていたら割り込み処理
if Assigned(FOnDrawButton) and (FStyle = bsOwnerDraw) then
FOnDrawButton(Self, R, Caption, State)
else
// フレーム付オーナー作図ボタンでなかったら
if FStyle <> bsOwnerDrawWithFrame then
begin
DR := R;
Dec(DR.Right, 2);
Dec(DR.Bottom, 2);
DrawText(FCanvas.Handle, PChar(Caption), -1, DR,
DT_EXPANDTABS or DT_WORDBREAK or DT_CALCRECT);
InflateRect(R, (DR.Right - R.Right) div 2,
(DR.Bottom - R.Bottom) div 2);
DrawText(FCanvas.Handle, PChar(Caption), -1, R,
DT_EXPANDTABS or DT_WORDBREAK);
end;
end;
// ボタンスタイルのセット
procedure TButtonEx.SetButtonStyle(ADefault: Boolean);
const
BS_MASK = $000F;
var
Style: Word;
begin
if HandleAllocated then
if FStyle = bsStandard then
begin
if ADefault then Style := BS_DEFPUSHBUTTON else Style := BS_PUSHBUTTON;
if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
SendMessage(Handle, BM_SETSTYLE, Style, 1);
end
else
if FIsFocused <> ADefault then
begin
FIsFocused := ADefault;
Refresh;
end;
end;
// アイテムのサイズ設定
procedure TButtonEx.CNMeasureItem(var Msg: TWMMeasureItem);
begin
with Msg.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end;
// アイテムの作図
procedure TButtonEx.CNDrawItem(var Msg: TWMDrawItem);
var
SaveIndex: Integer;
State: TOwnerDrawState;
begin
with Msg.DrawItemStruct^ do
begin
State := TOwnerDrawState(LongRec(itemState).Lo);
SaveIndex := SaveDC(hDC);
FCanvas.Lock;
try
FCanvas.Handle := hDC;
FCanvas.Font := Font;
FCanvas.Brush.Color := clBtnFace;
FCanvas.Brush.Style := bsSolid;
FCanvas.Pen.Mode := PmCopy;
DrawButton(rcItem, State);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Msg.Result := 1;
end;
end.
ＴＢｕｔｔｏｎＥＸの使用例
フォームに、TButtonEX を四個作成します。
最初のボタンは、プロパティのButtonStyle をbsOwnerDraw に設定した場合です。
更に、イベントのOnDrawButton
を生成します、そして、ButtonEX1DrawButtonの中に描画プログラムを記述します。
二番目のボタンは、ButtonStyle
を bsOwnerDrawWithFrame に設定します。
フォントの色を追加で設定しています。
bsOwnerDrawWithFrameの場合、フォントの色は指定できますが、ボタンの色は指定しても無効となります。
ボタンに色を付ける場合は場合は、OnDrawButton割り込みで作図をする必要があります。
その場合、Caption の文字も作図する必要があります。
三番目のボタンは、ButtonStyleを bsOvalDraw にした場合で、フォントの色と、ボタンの色を指定しています。
四番目のボタンは、ButtonStyleを bsStandard にした場合で、Windowsのデフォルトのボタンが表示されます。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, ButtonEX;
type
TForm1 = class(TForm)
ButtonEX1: TButtonEX;
ButtonEX2: TButtonEX;
ButtonEX3: TButtonEX;
ButtonEX4: TButtonEX;
procedure ButtonEX1DrawButton(Control: TWinControl; Rect: TRect; Caption: TCaption; State: TOwnerDrawState);
procedure ButtonEX1MouseEnter(Sender: TObject);
procedure ButtonEX1MouseLeave(Sender: TObject);
procedure ButtonEX1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ButtonEX1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ButtonEX2Click(Sender: TObject);
procedure ButtonEX4Click(Sender: TObject);
procedure ButtonEX3Click(Sender: TObject);
procedure ButtonEX1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FButtonF : Byte; // ButtonEX1のボタンの状態
// ButtonEX1の作図
procedure TForm1.ButtonEX1DrawButton(Control: TWinControl; Rect: TRect; Caption: TCaption; State: TOwnerDrawState);
var
R, G, B : short; // ボタンの明度調整用
ButtonColor : TColor;
fontColor : TColor;
begin
ButtonColor := ClGreen; // ボタンの色設定
R:= GetRValue(ButtonColor); // RGBに変換
G:= GetGValue(ButtonColor);
B:= GetBValue(ButtonColor);
if FButtonF = 0 then // 通常
ButtonColor := RGB(R, G, B);
if FButtonF = 1 then begin // マウスがボタンの上に来たときの色
R := R + 48;
if R > 255 then R := 255;
G := G + 48;
if G > 255 then G := 255;
B := B + 48;
if B > 255 then B := 255;
ButtonColor := RGB(R, G, B);
end;
if FButtonF = 2 then begin // ボタンが押された時の色
R := round(R / 1.2);
G := round(G / 1.2);
B := round(B / 1.2);
ButtonColor := RGB(R, G, B);
end;
// ボタンの明度によりフォントの色設定
if R + G + B > 400 then fontColor := ClBlack
else fontColor := ClWhite;
// ボタンの描画
with TButtonEx(Control) do begin
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Color := clBlack;
Canvas.Pen.Style := psSolid;
Canvas.pen.Width := 1;
Canvas.Font.Color := fontColor;
if Enabled then begin // イネーブルだったら
Canvas.Brush.Color := ButtonColor; // 設定色
end
else // デスエブルだったらダーク色
begin
R := R div 2;
G := G div 2;
B := B div 2;
ButtonColor := RGB(R, G, B);
Canvas.Brush.Color := ButtonColor;
end;
Canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 2, 2);
// 文字の作図
if Enabled then // イネーブル文字作図
DrawText(Canvas.Handle, PChar(Caption), -1, RECT, DT_SINGLELINE or DT_CENTER or DT_VCENTER)
else // デスエブル文字作図
DrawState( Canvas.Handle, Canvas.Brush.Handle, nil, Integer(Caption), 0,
((Rect.Right - Rect.Left) - Canvas.TextWidth(Caption)) div 2,
((Rect.Bottom - Rect.Top) - Canvas.TextHeight(Caption)) div 2,
0, 0, DST_TEXT or DSS_DISABLED)
end;
end;
// ButtonEX1でマウスを左ボタンを押した場合
procedure TForm1.ButtonEX1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FButtonF := 2;
ButtonEX1.Repaint;
end;
// ButtonEX1の上にマウスカーソルが入った場合
procedure TForm1.ButtonEX1MouseEnter(Sender: TObject);
begin
FButtonF := 1;
ButtonEX1.Repaint;
end;
// ButtonEX1の上からマウスカーソルが離れた場合
procedure TForm1.ButtonEX1MouseLeave(Sender: TObject);
begin
FButtonF := 0;
ButtonEX1.Repaint;
end;
// ButtonEX1でマウスの左ボタンをあげた場合
procedure TForm1.ButtonEX1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FButtonF := 1;
ButtonEX1.Repaint;
end;
procedure TForm1.ButtonEX1Click(Sender: TObject);
begin
if ButtonEX4.Enabled then ButtonEX4.Enabled := False
else ButtonEX4.Enabled := True;
end;
procedure TForm1.ButtonEX2Click(Sender: TObject);
begin
if ButtonEX1.Enabled then ButtonEX1.Enabled := False
else ButtonEX1.Enabled := True;
end;
procedure TForm1.ButtonEX3Click(Sender: TObject);
begin
if ButtonEX2.Enabled then ButtonEX2.Enabled := False
else ButtonEX2.Enabled := True;
end;
procedure TForm1.ButtonEX4Click(Sender: TObject);
begin
if ButtonEX3.Enabled then ButtonEX3.Enabled := False
else ButtonEX3.Enabled := True;
end;
end.
プロパティのButtonStyle をbsOwnerDraw にした場合 ボタンを作図に、ボタンの状態を取得するため
TOwnerDrawStateを使用していますが、マウスカーソルの状態を取得する事が出来ません。
その為、ボタンの上にマウスが来たのか、離れたのか分からないので、MouseEnter、MouseLeave、MouseDown、MouseUp 割り込みを使用して、状態フラグ（FButtonF）を使用して、再描画することにより、ボタンの色を変更しています。
TColorBtn では、マウスカーソルの割り込みをコンポーネントの中に、組み込んでいますが、TButtonExも、コンポーネントの中に組み込んだ方が良いかも知れません。
TColorBtn と、TButtonEX のコンポーネントを参考にすれば、ボタンがどの様にして描画されるか分かると思います。
ButtonEX.zip