Mega Code Archive
Change Color of standard controls
<![CDATA[
Title: Change Color of standard controls
Question: How to change color of standard Delphi controls
Answer:
//Hi
//There is a way to change color of standars controls like
//TrackBar, ProgressBar etc.
//put this code after the code below
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
//this code
type
TAccessControl = class(TWinControl)
public
property Color;
end;
//and this is it
//now you just write following code in tha TForm1.FormCreate() section:
TAccessControl(ProgressBar1).Color:= clBlack{or some other color};
If you want to change color of standard Button control you'll need
something diferent..Below is code of my component which has possibility
to do this. Just save code like "Dugme.pas". Go to component button in
Delphi menu, choose install component and navigate to "Dugme.pas".
unit Dugme;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls;
type
TDrawButtonEvent = procedure(Control: TWinControl;
Rect: TRect; State: TOwnerDrawState) of object;
TDugme = class(TButton)
private
FCanvas: TCanvas;
IsFocused: Boolean;
FOnDrawButton: TDrawButtonEvent;
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(Rect: TRect; State: UINT);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas: TCanvas read FCanvas;
published
property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
property Color;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TDugme]);
end;
constructor TDugme.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TCanvas.Create;
end;
destructor TDugme.Destroy;
begin
inherited Destroy;
FCanvas.Free;
end;
procedure TDugme.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do Style := Style or BS_OWNERDRAW;
end;
procedure TDugme.SetButtonStyle(ADefault: Boolean);
begin
if ADefault IsFocused then
begin
IsFocused := ADefault;
Refresh;
end;
end;
procedure TDugme.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do
begin
itemWidth := Width;
itemHeight := Height;
end;
end;
procedure TDugme.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(rcItem, itemState);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
RestoreDC(hDC, SaveIndex);
end;
end;
Message.Result := 1;
end;
procedure TDugme.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TDugme.CMFontChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TDugme.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
procedure TDugme.DrawButton(Rect: TRect; State: UINT);
var
Flags, OldMode: Longint;
IsDown, IsDefault, IsDisabled: Boolean;
OldColor: TColor;
OrgRect: TRect;
begin
OrgRect := Rect;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
IsDown := State and ODS_SELECTED 0;
IsDefault := State and ODS_FOCUS 0;
IsDisabled := State and ODS_DISABLED 0;
if IsDown then Flags := Flags or DFCS_PUSHED;
if IsDisabled then Flags := Flags or DFCS_INACTIVE;
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);
FCanvas.Font.Color := clBtnText;
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);
if Assigned(FOnDrawButton) then
FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo));
if IsFocused and IsDefault then
begin
Rect := OrgRect;
InflateRect(Rect, - 4, - 4);
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Brush.Color := clBtnFace;
DrawFocusRect(FCanvas.Handle, Rect);
end;
end;
end.
]]>