Delphi: Changing Buttons Color

Question

How can i change the buttons color in Delphi?

Answer

None of the 3 kinds of Delphi buttons (TButton, TBitBtn, TSpeedButton) has a property "color". Here are some alternatives:

1. Use a TPanel as a TSpeedButton. It has an OnClick event, just like a button, but you also can set its color. To mimic the up/down look of a real Delphi button, write code for the panel's OnMouseDown and OnMouseUp events:

procedure TForm1.Panel1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel1.BevelOuter := bvLowered;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; 
  Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); begin Panel1.BevelOuter := bvRaised; end;

Additional advantage: you can play with the panel's BevelWidth, and you can put any text labels and images on top of it.

2. Or download an existing custom color-button, I remember having seen some on several component sites (search for TColorButton or "colored button").

3. Or program your own color-button. This is no so easy, even if you have some experience in building components, because you have to code all the painting that Windows would otherwise do, plus change the color...

by WAllison

Here is a Delphi TColorButton component...

//by JONATHAN GRANT
unit ColorButton;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls, Buttons;
type
  TAlignment =
    (alTopLeft, alTopCenter, alTopRight,
    alMiddleLeft, alMiddleCenter, alMiddleRight,
    alBottomLeft, alBottomCenter, alBottomRight);
  TButtonBevel = (bbLowered, bbNone, bbRaised);
  TButtonStyles = (bsAutoSize, bsCenter, bsStretch, bsShowFocus, bsShowKey);
  TButtonStyle = set of TButtonStyles;
  TButtonState = (bsUp, bsDown, bsDisabled);
  TColorButton = class(TCustomControl)
  private
    FAlignment: TAlignment;
    FBevelStyle: TButtonBevel;
    FBevelSize: Integer;
    FColor: TColor;
    FPicture: TPicture;
    FSpacing: Integer;
    FStyle: TButtonStyle;
				FFocused: Boolean;
    FState: TButtonState;
    procedure SetAlignment(Value: TAlignment);
    procedure SetBevelStyle(Value: TButtonBevel);
    procedure SetBevelSize(Value: Integer);
    procedure SetCaption(var Message: TMessage); message CM_TEXTCHANGED;
    procedure SetColor(Value: TColor);
    procedure SetEnabled(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure SetFocusOff(var Message: TMessage); message CM_LOSTFOCUS;
    procedure SetFocusOn(var Message: TMessage); message CM_GOTFOCUS;
    procedure SetFont(var Message: TMessage); message CM_FONTCHANGED;
    procedure SetPicture(Value: TPicture);
    procedure SetSpacing(Value: Integer);
    procedure SetStyle(Value: TButtonStyle);
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyAccel(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure MouseDown(Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Paint; override;
  published
    property Alignment: TAlignment read FAlignment write SetAlignment 
      default alMiddleCenter;
    property BevelStyle: TButtonBevel read FBevelStyle write SetBevelStyle 
      default bbRaised;
    property BevelSize: Integer read FBevelSize write SetBevelSize default 2;
    property Caption;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property Cursor;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Height;
    property Left;
    property Name;
    property Picture: TPicture read FPicture write SetPicture;
    property Spacing: Integer read FSpacing write SetSpacing default 2;
    property Style: TButtonStyle read FStyle 
      write SetStyle default [bsCenter, bsShowFocus];
    property Tag;
    property TabOrder;
    property TabStop;
    property Top;
    property Width;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;
procedure Register;
function Smallest(X, Y: Integer): Integer;
function Largest(X, Y: Integer): Integer;
function GetHighlightColor(BaseColor: TColor): TColor;
function GetShadowColor(BaseColor: TColor): TColor;
function GetSpeedKey(var Caption: String): Integer;
implementation
procedure Register;
begin
 RegisterComponents('Additional', [TColorButton]);
end;
// Global procedures and functions
/////////////////////////////////////////////////////////////
function Smallest(X, Y: Integer): Integer;
begin
  if X < Y then Result := X else Result := Y;
end;
function Largest(X, Y: Integer): Integer;
begin
  if X > Y then Result := X else Result := Y;
end;
function GetHighlightColor(BaseColor: TColor): TColor;
begin
  Result := RGB(
    Smallest(GetRValue(ColorToRGB(BaseColor)) + 64, 255),
    Smallest(GetGValue(ColorToRGB(BaseColor)) + 64, 255),
    Smallest(GetBValue(ColorToRGB(BaseColor)) + 64, 255));
end;
function GetShadowColor(BaseColor: TColor): TColor;
begin
  Result := RGB(
    Largest(GetRValue(ColorToRGB(BaseColor)) - 64, 0),
    Largest(GetGValue(ColorToRGB(BaseColor)) - 64, 0),
    Largest(GetBValue(ColorToRGB(BaseColor)) - 64, 0));
end;
function GetSpeedKey(var Caption: String): Integer;
var
  keyPos: Integer;
begin
  // Find the speed key location
  keyPos := Pos('&', Caption);
 // Delete the '&' symbol
 Delete(Caption, keyPos, 1);
 // Return the location of the speed key
 Result := keyPos;
end;
// ColorButton procedures and functions
//////////////////////////////////////////////////////////////////
constructor TColorButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FAlignment	:= alMiddleCenter;
 FBevelStyle	:= bbRaised;
 FBevelSize	:= 2;
 FColor	:= clBtnFace;
 FPicture := TPicture.Create;
 FSpacing := 2;
 FStyle	:= [bsCenter, bsShowFocus, bsShowKey];
 FFocused := False;
 FState := bsUp;
 Width := 75; Height := 25;
 Enabled := True;
 TabStop := True;
end;
destructor TColorButton.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;
procedure TColorButton.Loaded;
begin
  inherited Loaded;
  if Enabled then FState := bsUp else FState := bsDisabled;
end;
procedure TColorButton.Paint;
procedure DrawCaption(Offset: Integer);
var
  xLoc, yLoc, edgeSize, keyPos: Integer;
  newCaption: String;
begin
  edgeSize := (FBevelSize + FSpacing);
  newCaption := Caption;
  keyPos := GetSpeedKey(newCaption);
  with inherited Canvas do begin
    // Work out text location
   case FAlignment of
     alTopLeft:
       xLoc := edgeSize + Offset; yLoc := edgeSize + Offset;
    alTopCenter:
    begin
      xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) 
        - TextWidth(newCaption)) div 2; 
      yLoc := edgeSize + Offset;
    end;
    alTopRight:
    begin
      xLoc := Width - edgeSize - TextWidth(newCaption) + Offset; 
      yLoc := edgeSize + Offset;
     end;
    alMiddleLeft:
    begin
      xLoc := edgeSize + Offset; 
      yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) 
        - TextHeight(newCaption)) div 2;
    end;
    alMiddleCenter:
      begin
        xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) 
          - TextWidth(newCaption)) div 2;
      	yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) 
          - TextHeight(newCaption)) div 2;
      end;
    alMiddleRight:
    begin
      xLoc := Width - edgeSize - TextWidth(newCaption) + Offset;
      yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) 
        - TextHeight(newCaption)) div 2;
    end;
    alBottomLeft:
    begin
      xLoc := edgeSize + Offset; yLoc := Height - edgeSize 
        - TextHeight(newCaption) + Offset;
    end;
    alBottomCenter:
    begin
      xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) 
        - TextWidth(newCaption)) div 2;
      yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
    end;
    alBottomRight:
    begin
      xLoc := Width - edgeSize - TextWidth(newCaption) + Offset;
      yLoc := Height - edgeSize - TextHeight(newCaption) + Offset;
    end;
    else
      // Just in-case...
      xLoc := edgeSize + Offset + ((Width - (edgeSize * 2)) 
         - TextWidth(newCaption)) div 2;
      yLoc := edgeSize + Offset + ((Height - (edgeSize * 2)) 
         - TextHeight(newCaption)) div 2;
    end;

    // Draw the text
    TextOut(xLoc, yLoc, newCaption);
    // Draw the speed key
    if ((keyPos > 0) and (bsShowKey in FStyle)) then
    begin
      // Can't use underscore character - unlikely to be correct width
      Pen.Color := Font.Color;
      MoveTo(xLoc + (TextWidth(Copy(newCaption, 1, keyPos - 1))), 
        yLoc + (TextHeight('ABC')));
      LineTo(xLoc + (TextWidth(Copy(newCaption, 1, keyPos))), 
        yLoc + (TextHeight('ABC')));
    end;
  end;
end;

var
  Client, Picture: TRect;
  clHigh, clLow: TColor;
begin
  if not Enabled and not (csDesigning in ComponentState) then 
    FState := bsDisabled
  else 
    if FState = bsDisabled then FState := bsUp;
  if ((not (FPicture.Graphic = nil)) and (bsAutoSize in FStyle)) then
  begin
    Width := FPicture.Width + (FBevelSize * 2);
    Height := FPicture.Height + (FBevelSize * 2);
  end;
  Client := Bounds(0, 0, Width, Height);
  Canvas.Font.Assign(Font);
  with inherited Canvas do
  begin
    // Clear the background
    Brush.Color := FColor;
    FillRect(Client);
    // Draw the button bevel
    if not (FBevelStyle = bbNone) then
    begin
   // Get the bevel colors
     if ((FState = bsDown) xor (FBevelStyle = bbLowered)) then
     begin
      clHigh := GetShadowColor(FColor);
      clLow := GetHighlightColor(FColor);
     end
    else
     begin
      clHigh := GetHighlightColor(FColor);
      clLow := GetShadowColor(FColor);
     end;
    Frame3D(Canvas, Client, clHigh, clLow, FBevelSize);
  end;
   // Draw the focus
   if (FFocused and (bsShowFocus in FStyle)) and Enabled then
    DrawFocusRect(Rect(
      Client.Left + FSpacing - 1, Client.Top + FSpacing - 1,
       Client.Right - FSpacing + 1, Client.Bottom - FSpacing + 1
       ));
   // Draw the picture
   if (FPicture <> nil) then
   begin
     if (bsStretch in FStyle) then
       Picture := Rect(
         FBevelSize + FSpacing, 
         FBevelSize + FSpacing, Width - (FBevelSize + FSpacing),
         Height - (FBevelSize + FSpacing))
     else if (bsCenter in FStyle) then
       Picture := Bounds(
        (Width - FPicture.Width) div 2, (Height - FPicture.Height) div 2,
        FPicture.Width, FPicture.Height
        )
    else
      case FAlignment of
       alTopLeft, alTopCenter, alTopRight:
         Picture := Bounds(
           (Width - FPicture.Width) div 2,
           ((Height - (FBevelSize + FSpacing)) - FPicture.Height),
           FPicture.Width, FPicture.Height);
       alMiddleLeft:
          Picture := Bounds(
           ((Width - (FBevelSize + FSpacing)) - FPicture.Width),
            (Height - FPicture.Height) div 2,
            FPicture.Width, FPicture.Height);
       alMiddleCenter:
         Picture := Bounds(
           (Width - FPicture.Width) div 2,
          (Height - FPicture.Height) div 2,
          FPicture.Width, FPicture.Height);
       alMiddleRight:
          Picture := Bounds(
           (FBevelSize + FSpacing),
            (Height - FPicture.Height) div 2,
           FPicture.Width, FPicture.Height);
       alBottomLeft, alBottomCenter, alBottomRight:
         Picture := Bounds(
           (Width - FPicture.Width) div 2,
            (FBevelSize + FSpacing),
           FPicture.Width, FPicture.Height);
      end;
      StretchDraw(Picture, FPicture.Graphic);
   end
   else
    begin
     Brush.Color := FColor;
     FillRect(Rect(FBevelSize, FBevelSize, Width - FBevelSize, 
       Height - FBevelSize));
    end;
   // Draw the caption
   if (Caption <> '') then
   begin
     Brush.Style := bsClear;
     if ((not Enabled) and (not (csDesigning in ComponentState))) then
     begin
       Font.Color := GetHighlightColor(FColor); DrawCaption(1);
       Font.Color := GetShadowColor(FColor); DrawCaption(0);
     end 
     else 
       DrawCaption(0);
    end;
  end;
end;
procedure TColorButton.DoEnter;
begin
  FFocused := True; Repaint;
  inherited DoEnter;
end;
procedure TColorButton.DoExit;
begin
  FFocused := False; Repaint;
  inherited DoExit;
end;
procedure TColorButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_SPACE then
    if Enabled then
    begin
      FState := bsDown;
      Repaint;
    end;
end;
procedure TColorButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
  if Key = VK_SPACE then
    if Enabled then
    begin
      FState := bsUp;
      Click; Repaint;
    end;
   if Key = VK_RETURN then 
     if not (FState = bsDisabled) then Click;
end;
procedure TColorButton.KeyAccel(var Message: TCMDialogChar);
begin
  with Message do
  begin
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end
    else inherited;
  end;
end;
procedure TColorButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if Enabled then
  begin
    FState := bsDown;
    Repaint;
  end;
end;
procedure TColorButton.MouseUp(Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if Enabled then
  begin
    FState := bsUp;
    Repaint;
  end;
end;
procedure TColorButton.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  Repaint;
end;
procedure TColorButton.SetBevelStyle(Value: TButtonBevel);
begin
  FBevelStyle := Value;
  Repaint;
end;
procedure TColorButton.SetBevelSize(Value: Integer);
begin
  if Value < 1 then Value := 1;
  FBevelSize := Value;
  Repaint;
end;
procedure TColorButton.SetCaption(var Message: TMessage);
begin
  Repaint;
end;
procedure TColorButton.SetColor(Value: TColor);
begin
  FColor := Value;
  Repaint;
end;
procedure TColorButton.SetEnabled(var Message: TMessage);
begin
  inherited;
  if Enabled then FState := bsUp else FState := bsDisabled;
  Repaint;
end;
procedure TColorButton.SetFocusOff(var Message: TMessage);
begin
  inherited;
  FFocused := False;
  Repaint;
end;
procedure TColorButton.SetFocusOn(var Message: TMessage);
begin
  inherited;
  FFocused := True;
  Repaint;
end;
procedure TColorButton.SetFont(var Message: TMessage);
begin
  inherited;
  Repaint;
end;
procedure TColorButton.SetPicture(Value: TPicture);
begin
  if FPicture <> Value then
  begin
    FPicture.Assign(Value);
    Repaint;
  end;
end;
procedure TColorButton.SetSpacing(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Repaint;
  end;
end;
procedure TColorButton.SetStyle(Value: TButtonStyle);
begin
  if FStyle <> Value then begin
    FStyle := Value;
    Repaint;
  end;
end;

Find related articles

Search for:  Button color  TButton color  Button Glyph


FAQ :: Tutorials :: Source code :: Tips