カラーボタン

  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;

    download ColorButton.zip


      コンポーネント一覧へ戻る