カラーボタン
Delphiには、カラーボタンがありません。
Windowsが、色つきのボタンを標準で用意していないからです。
理由は、画面のデザインを統一して、種々雑多なボタンを使用されないようにするためのもののようです。
操作性の統一の意味もあるでしょう。
しかし、プログラムを作成するものにとって、色つきのボタンが欲しいところです。
ボタンに色をつける為には、自分でボタンを作画する必要があります。
色々な条件に応じてボタンを作図する必要があるので、結構面倒です。
此処で紹介するのは、TButtonを継承し、TCanvasを追加して、そのキャンバスに、色をつけて描画するものです。
左二個は、デスエブル状態です、又一番右は、通常のボタンです。
一応、Window7 と、似た表示にしています。
左のボタンの状態は、此処で紹介しているボタンの状態と表示の関係を表しています。
ボタンの色に、clBtnFace を指定すると、通常のボタンとほぼ近いボタンとなり、それ以外の色を指定すると指定された色のボタンになります。
色によっては、ボタンの上下の色が、思ったような色にならないことがあります、その時には、色のして方法を変更して下さい。
ここのプログラムで使用している、色の作成方法はあまり良い方法ではありません。
RGBで指定したほうが、良いかとおもいます。
clBtnFace
色の場合は、Windowsのデフォルト設定なので、Win8、8.1の場合Win8、8.1のボタンとなりますが、clBtnFace 以外の色を指定すると、WIN7タイプのボタンを描画します。
Win8、8.1のタイプにしたい場合は、テーマ時の描画を変更して下さい。
コンパイル時に次のメッセージが表示されますが、問題ありません。
ThemeServicesを使用しないと、画面の表示にテーマを使用しているかどうか判別が出来ません。
[dcc32 警告]
ColorBtn.pas(163): W1000 シンボル 'ThemeServices' を使用することは推奨されていません : 'Use
StyleServices'
TColorBtn コンポーネント
unit ColorBtn; interface uses Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, CommCtrl, System.UITypes; type TColorBtn = class(TButton) // TButtonから継承 private FCanvas: TCanvas; // ボタンの色形状描画用 Canvas IsFocused: Boolean; // フォーカスの有無 FMouseInControl: Boolean; // マウスのコントロールフラグ FFocusedFrame: Boolean; // テーマ使用時フォーカスがある場合のフレーム枠表示フラグ procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; // ボタンにマウスカーソルが移動した場合 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; // ボタンからマウスカーソルが離れた場合 procedure SetFocusedFrame(Varue: Boolean); // フォーカス時フレーム枠表示非表示 protected procedure CreateParams(var Params: TCreateParams); override; procedure SetButtonStyle(ADefault: Boolean); override; // ボタンスタイルオーバライズ procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; // イネーブルメッセージ procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; // フォント変更メッセージ procedure CNMeasureItem(var Message: TWMMeasureItem ); message CN_MEASUREITEM; // 幅、高さ procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; // 描画アイテム procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; // ダブルクリック procedure DrawButton(const DrawItemStruct: TDrawItemStruct); // ボタン描画処理 public constructor Create(AOwner: TComponent); override; // ボタンの生成オーバライズ TCanvas追加 destructor Destroy; override; // ボタンの破棄オーバライズ TCanvas解放の追加 property Canvas: TCanvas read FCanvas; // キャンバスの読み出し用 published property Color; // 色設定用 property FocusedFrame: Boolean read FFocusedFrame write SetFocusedFrame default False; // フォーカスフレームの設定 end; procedure Register; ////////////////////////////////////////////////////////////////////////////// implementation uses SysUtils, Themes; procedure Register; begin RegisterComponents('MyVCL', [TColorBtn]); // パレットへの登録 end; // カラーボタンの生成 constructor TColorBtn.Create(AOwner: TComponent); begin inherited Create(AOwner); // TButton を継承 FCanvas := TCanvas.Create; // TCanvas追加生成 end; // カラーボタンの破棄 destructor TColorBtn.Destroy; begin inherited Destroy; // TButtonの破棄 FCanvas.Free; // TCanvasの解放 end; // ボタンフォーカススタイル設定 procedure TColorBtn.SetButtonStyle(ADefault: Boolean); begin if ADefault <> IsFocused then begin IsFocused := ADefault; Refresh; end; end; // テーマ有効時フォーカス点々枠表示非表示設定 procedure TColorBtn.SetFocusedFrame(Varue: Boolean); begin if Varue <> FFocusedFrame then begin FFocusedFrame := Varue; Refresh; end; end; // オーナー描画スタイルのボタンに設定 procedure TColorBtn.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style or BS_OWNERDRAW; end; // ボタンアイテムのサイズ設定 procedure TColorBtn.CNMeasureItem(var Message: TWMMeasureItem); begin with Message.MeasureItemStruct^ do begin itemWidth := Width; itemHeight := Height; end; end; // 描画アイテムの設定とボタン描画 procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem); var SaveIndex: Integer; begin with Message.DrawItemStruct^ do begin SaveIndex := SaveDC(hDC); FCanvas.Lock; try FCanvas.Handle := hDC; FCanvas.Font := Font; FCanvas.Brush := Brush; DrawButton(Message.DrawItemStruct^); finally FCanvas.Handle := 0; FCanvas.Unlock; RestoreDC(hDC, SaveIndex); end; end; Message.Result := 1; end; procedure TColorBtn.CMEnabledChanged(var Message: TMessage); begin inherited; Invalidate; end; procedure TColorBtn.CMFontChanged(var Message: TMessage); begin inherited; Invalidate; end; procedure TColorBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk); begin Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos)); end; // ボタンの描画 procedure TColorBtn.DrawButton(const DrawItemStruct: TDrawItemStruct); var Flags, OldMode: Longint; IsDown, IsDefault, IsDisabled: Boolean; OldColor: TColor; Rect: TRect; Button : TThemedButton; Details: TThemedElementDetails; BriteColor : integer; DowndColor : integer; MDownColor : integer; LeftP1, LeftP2, RightM1, RightM2, TopP1, TopP2, BottomM2: integer; defOne: integer; begin Rect := ClientRect; Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; // ボタン状態フラグ設定 with DrawItemStruct do begin FCanvas.Handle := hdc; // Handle設定 FCanvas.Font := Self.Font; // Font設定 IsDown := itemState and ODS_SELECTED <> 0; // Downフラグ設定 IsDefault := itemState and ODS_FOCUS <> 0; // デフォルト設定 IsDisabled := itemState and ODS_DISABLED <> 0; // デスエブル設定 end; if IsDown then Flags := Flags or DFCS_PUSHED; // Downだったらプッシュフラグセット if IsDisabled then Flags := Flags or DFCS_INACTIVE;// ディスエブルだったら無効な(淡色表示の)ボタンを描画します if ThemeServices.ThemesEnabled then // テーマが有効ならテーマボタン描画 Windows 7タイプのボタンです begin PerformEraseBackGround(Self,Canvas.Handle); // 背景消去 if not Enabled then // ボタンの状態によりボタン作図選択 Button := tbpushButtonDisabled else if isDown then Button := tbPushButtonPressed else if FMouseInControl then Button := tbPushButtonHot else if IsFocused or IsDefault then button := tbPushButtonDefaulted else Button := tbPushButtonNormal; Details := ThemeServices.GetElementDetails(Button); // ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hdc, @Details, True); ThemeServices.DrawElement(DrawItemStruct.hdc, Details, DrawItemStruct.rcItem); // ボタン基本部作図 Rect := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem); // ボタン作図部サイズ取得 // Paint Size set defOne := 0; if FFocusedFrame then defOne := 1; // フォーカスがあったら枠サイズ変更 LeftP1 := Rect.Left + defOne; LeftP2 := LeftP1 + 1; RightM1 := Rect.Right - defOne; RightM2 := RightM1 - 1; TopP1 := Rect.Top + defOne; TopP2 := TopP1 + 1; BottomM2:= Rect.Bottom - Defone -1; // Button Color set 色によっては問題があるので値の変更が必要です OldColor := ColorToRGB(Color); // システム色のRGB変換2015年7月9日追加 BriteColor := OldColor; // OldColorに変更 DowndColor := OldColor; MDownColor := OldColor; if BriteColor and $00FF0000 >= $00DF0000 then BriteColor := BriteColor or $00FF0000; if BriteColor and $0000FF00 >= $0000DF00 then BriteColor := BriteColor or $0000FF00; if BriteColor and $000000FF >= $000000DF then BriteColor := BriteColor or $000000FF; if BriteColor and $00FF0000 < $00DF0000 then BriteColor := BriteColor + $00200000; if BriteColor and $0000FF00 < $0000DF00 then BriteColor := BriteColor + $00002000; if BriteColor and $000000FF < $000000DF then BriteColor := BriteColor + $00000020; if MDownColor and $00FF0000 > $000C0000 then MDownColor := MDownColor - $000C0000; if MDownColor and $0000FF00 > $00000C00 then MDownColor := MDownColor - $00000C00; if MDownColor and $000000FF > $0000000C then MDownColor := MDownColor - $0000000C; if DowndColor and $00FF0000 > $00140000 then DowndColor := DowndColor - $00140000; if DowndColor and $0000FF00 > $00001400 then DowndColor := DowndColor - $00001400; if DowndColor and $000000FF > $00000014 then DowndColor := DowndColor - $00000014; FCanvas.Pen.Width := 1; FCanvas.Brush.Style := BsSolid; if FMouseInControl then begin FCanvas.Pen.Color := BriteColor; FCanvas.Brush.Color := BriteColor; end else begin FCanvas.Pen.Color := Color; FCanvas.Brush.Color := Color; end; if Color <> clbtnface then // ボタンの色がデフォルトのボタン色でなかったらボタン作図 begin if isDown then // ボタンが押されていたら begin if FFocusedFrame then // フォーカスフレーム作図指定なら begin FCanvas.Brush.Color := DowndColor; FCanvas.Pen.Color := DowndColor; end else // 指定されていなかったら begin FCanvas.Pen.Color := MDownColor; FCanvas.Brush.Color := MDownColor; end; // ボタンが押された状態の作図 FCanvas.MoveTo(LeftP2, TopP1); // ボタン上半分描画 FCanvas.LineTo(RightM2, TopP1); FCanvas.Rectangle( LeftP1, TopP2, RightM1, ((Rect.Bottom - Rect.Top) Div 5) * 3 + Rect.Top); if not FFocusedFrame then begin FCanvas.Brush.Color := DowndColor; FCanvas.Pen.Color := DowndColor; end; // ボタン下半分描画 FCanvas.Rectangle( LeftP1, ((Rect.Bottom - Rect.Top) Div 5) * 3 + Rect.Top, RightM1, BottomM2); FCanvas.MoveTo(LeftP2, BottomM2); FCanvas.LineTo(RightM2, BottomM2); end else // 押されていなかったら begin if not Enabled then // イネーブルでなかったらデスエブル色セット begin FCanvas.Pen.Color := DowndColor; FCanvas.Brush.Color := DowndColor; end; // ボタンが押されていない状態作図 FCanvas.MoveTo(LeftP2, TopP1); // ボタン上半分描画 FCanvas.LineTo(RightM2, TopP1); FCanvas.Rectangle( LeftP1, TopP2, RightM1, ((Rect.Bottom - Rect.Top) Div 2) + Rect.Top); if Enabled then // イネーブル色セット if not FFocusedFrame then // フォーカスフレーム表示セットされていなかったら begin if FMouseInControl then // MouseEnterだったらEnter色セット begin FCanvas.Pen.Color := MDownColor; FCanvas.Brush.Color := MDownColor; end else // MouseEnterで無かったらデスエブル色セット begin FCanvas.Pen.Color := DowndColor; FCanvas.Brush.Color := DowndColor; end; end; // ボタン下半分描画 FCanvas.Rectangle(LeftP1, ((Rect.Bottom - Rect.Top) Div 2) + Rect.Top, RightM1, BottomM2); FCanvas.MoveTo(LeftP2, BottomM2); FCanvas.LineTo(RightM2, BottomM2); end; end; // Caption set FCanvas.Brush.Style := bsClear; FCanvas.Font.Color := Font.Color; if IsDisabled then 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) else DrawText(FCanvas.Handle, PChar(Caption), -1, Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER); // Focuse Frame Draw if IsFocused and IsDefault and FFocusedFrame then begin InflateRect(Rect, 0, 0); FCanvas.Pen.Color := clWindowFrame; FCanvas.Font.Color := clBlack; FCanvas.Brush.Color := clBtnFace; DrawFocusRect(FCanvas.Handle, Rect); end; end else // テーマで無いなら begin // Button Frame set if IsFocused or IsDefault then begin FCanvas.Pen.Color := clWindowFrame; FCanvas.Pen.Width := 1; FCanvas.Brush.Style := bsClear; FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); InflateRect(Rect, -1, -1); end; if IsDown then // ボタンが押された時の描画 begin FCanvas.Pen.Color := clBtnShadow; FCanvas.Pen.Width := 1; FCanvas.Brush.Color := clBtnFace; FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); InflateRect(Rect, -1, -1); end else // 押されていなかったらスタンダードボタン描画 DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); if IsDown then OffsetRect(Rect, 1, 1); // 押されたらオフセットして描画 OldColor := FCanvas.Brush.Color; // ブラシ色バックアップ FCanvas.Brush.Color := Color; // ブラシの色指定色に変更 FCanvas.FillRect(Rect); // ボタン塗りつぶし FCanvas.Brush.Color := OldColor; // 元の色に戻し OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); // 背景をそのまま残す透過指定 // Caption set FCanvas.Font.Color := Font.Color; // 文字色指定色にセット if IsDisabled then // デスエブル文字描画 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) else // イネーブル文字描画 DrawText(FCanvas.Handle, PChar(Caption), -1, Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER); SetBkMode(FCanvas.Handle, OldMode); // Focuse Frame Draw if IsFocused and IsDefault then begin InflateRect(Rect, -1, -1); FCanvas.Pen.Color := clWindowFrame; FCanvas.Font.Color := clBlack; FCanvas.Brush.Color := clBtnFace; DrawFocusRect(FCanvas.Handle, Rect); end; end; end; // マウスカーソルがボタンの上に来たときの処理 procedure TColorBtn.CMMouseEnter(var Message: TMessage); begin inherited; if ThemeServices.ThemesEnabled and not FMouseinControl and not (csDesigning in ComponentState) then begin FMouseInControl := True; Repaint; end; end; // マウスカーソルがボタンの上から離れた時の処理 procedure TColorBtn.CMMouseLeave(var Message: TMessage); begin inherited; if ThemeServices.ThemesEnabled and FMouseinControl then begin FMouseInControl := False; Repaint; end; end; end.
コンポーネントのファイルの置き場所は、何処でも良いのですが、パスを通す必要があります。
基本的には、
ユーザー ->
パブリック -> パブリックのドキュメント -> RAD Studio -> 10.0 -> MyHolder ->Colorbutton
10.0は、Delphiのバージョンによって異なります。
MyHolder、ColorButtonは、自分用のホルダーと言う事で、好きな名前を付けてください。
更に、ツールのオプションで、ライブラリ ライブラリパス で、パスを通す必要があります。
パスは、コンポーネントプログラムの入ったホルダーまで通します。
上記例では、 ColorButton です。
プロジェクトを開いて、インストールすれば、カラーボタンコンポーネントが追加されます。
コンポーネントのアイコンを変更する場合は、Delphi には、リソースエディターが無いので、フリーのリソースエディターをダウンロードして使用して下さい。
修正 2015/7/9
Windows
システム色を指定された場合、正しく色が設定されないのを修正しました。
// Button Color set 色によっては問題があるので値の変更が必要です
OldColor := ColorToRGB(Color);
// システム色のRGB変換2015年7月9日追加
BriteColor := OldColor; // OldColorに変更
DowndColor := OldColor;
MDownColor := OldColor;
ColorButton.zip