Question

我需要更改delphi表单控件的视觉样式，以便从.Net环境中显示它们。为此，我需要将delphi控件的颜色更改为蓝色（$ 00FCF5EE）。我已广泛使用“TButton”控件，它没有“颜色”属性。因此，我尝试了一种不同的方法，通过引入父表单并从该父表继承所有其他表单形成。在父表单中，我有一个类助手来更改按钮的颜色。这是代码:(我正在使用Delphi 2007）

TButtonHelper=class helper for TButton
private
  procedure doChangeColor;
public
  procedure DrawChangeColor;
end;

TParentForm = class(TForm)
public
  procedure AfterConstruction; override;
end;

在实施部分，我有

    procedure TButtonHelper.doChangeColor;
    var
      SaveIndex: Integer;
      FCanvas:TCanvas;
      rect:TRect;
    begin
      if csDestroying in ComponentState then exit;
      FCanvas:=TCanvas.Create;

        SaveIndex := SaveDC(Self.Handle);
        FCanvas.Lock;
        try
          FCanvas.Handle := Handle;
          FCanvas.Font := Font;
          FCanvas.Brush := self.Brush;
          FCanvas.Brush.Color:=$00FCF5EE;
          FCanvas.FillRect(BoundsRect);//Omitting the code to draw the text
        finally
          FCanvas.Handle := 0;
          FCanvas.Unlock;
          RestoreDC(handle, SaveIndex);
          FCanvas.Free;
        end;
    end;


    procedure TButtonHelper.DrawChangeColor;
    begin
        doChangeColor;
        self.Repaint;
    end;

procedure TParentForm.AfterConstruction;
    var
     i : Integer;
     wc: TControl;
    begin
      inherited;
      for i := 0 to self.ControlCount - 1 do begin
         wc:=Controls[i];
         if wc is  TButton then
            TButton(wc).DrawChangeColor;
      end;
    end;

但这不起作用。虽然执行了doChangeColor方法，但它并没有改变按钮的颜色。请让我知道我在这里缺少的东西。

感谢大家，

与Pradeep

Answer 1

这是一个为标准TButton添加颜色属性的类：

unit u_class_colorbutton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Buttons, ExtCtrls;

type
  TColorButton = class(TButton)
  private
    ShowBackColor  : Boolean;
    FCanvas        : TCanvas;
    IsFocused      : Boolean;
    FBackColor     : TColor;
    FForeColor     : TColor;
    FHoverColor    : TColor;
    procedure SetBackColor(const Value: TColor);
    procedure SetForeColor(const Value: TColor);
    procedure SetHoverColor(const Value: TColor);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message : TMessage); override;

    procedure SetButtonStyle(Value: Boolean); override;
    procedure DrawButton(Rect: TRect; State: UINT);

    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;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BackColor : TColor read FBackColor  write SetBackColor default clBtnFace;
    property ForeColor : TColor read FForeColor  write SetForeColor default clBtnText;
    property HoverColor: TColor read FHoverColor write SetHoverColor default clBtnFace;
  end;

procedure Register;

implementation

constructor TColorButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ShowBackColor := True;
 FCanvas := TCanvas.Create;
 BackColor := clBtnFace;
 ForeColor := clBtnText;
 HoverColor := clBtnFace;
end;

destructor TColorButton.Destroy;
begin
 FreeAndNil(FCanvas);
 inherited Destroy;
end;

procedure TColorButton.WndProc(var Message : TMessage);
begin
 if (Message.Msg = CM_MOUSELEAVE) then
  begin
   ShowBackColor := True;
   Invalidate;
  end;
 if (Message.Msg = CM_MOUSEENTER) then
  begin
   ShowBackColor := False;
   Invalidate;
  end;
 inherited;
end;

procedure TColorButton.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
  with Params do
    Style := Style or BS_OWNERDRAW;
end;

procedure TColorButton.SetButtonStyle(Value: Boolean);
begin
 if Value <> IsFocused then
  begin
   IsFocused := Value;
   Invalidate;
  end;
end;

procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
 with Message.MeasureItemStruct^ do
  begin
   itemWidth  := Width;
   itemHeight := Height;
  end;
end;

procedure TColorButton.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 TColorButton.CMEnabledChanged(var Message: TMessage);
begin
 inherited;
 Invalidate;
end;

procedure TColorButton.CMFontChanged(var Message: TMessage);
begin
 inherited;
 Invalidate;
end;

procedure TColorButton.SetBackColor(const Value: TColor);
begin
 if FBackColor <> Value then
  begin
   FBackColor:= Value;
   Invalidate;
  end;
end;

procedure TColorButton.SetForeColor(const Value: TColor);
begin
 if FForeColor <> Value then
  begin
   FForeColor:= Value;
   Invalidate;
  end;
end;

procedure TColorButton.SetHoverColor(const Value: TColor);
begin
 if FHoverColor <> Value then
  begin
   FHoverColor:= Value;
   Invalidate;
  end;
end;

procedure TColorButton.DrawButton(Rect: TRect; State: UINT);

var Flags, OldMode: Longint;
    IsDown, IsDefault, IsDisabled: Boolean;
    OldColor: TColor;
    OrgRect: TRect;
    NewCaption : string;

begin
 NewCaption := Caption;
 OrgRect := Rect;
 Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
 IsDown := State and ODS_SELECTED <> 0;
 IsDisabled := State and ODS_DISABLED <> 0;
 IsDefault := State and ODS_FOCUS <> 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
  begin
   DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
  end;

  if IsDown then OffsetRect(Rect, 1, 1);

  OldColor := FCanvas.Brush.Color;
  if ShowBackColor then
   FCanvas.Brush.Color := BackColor
  else
   FCanvas.Brush.Color := HoverColor;
  FCanvas.FillRect(Rect);
  FCanvas.Brush.Color := OldColor;
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
  FCanvas.Font.Color := ForeColor;
  if IsDisabled then
   DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(NewCaption), 0,
             ((Rect.Right - Rect.Left) - FCanvas.TextWidth(NewCaption)) div 2,
             ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(NewCaption)) div 2,
             0, 0, DST_TEXT or DSS_DISABLED)
  else
   begin
    InflateRect(Rect, -4, -4);
    DrawText(FCanvas.Handle, PChar(NewCaption), - 1, Rect, DT_WORDBREAK or DT_CENTER);
   end;

  SetBkMode(FCanvas.Handle, OldMode);

 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;

procedure Register;
begin
  RegisterComponents('Standard', [TColorButton]);
end;

initialization
  RegisterClass(TColorButton); // needed for persistence at runtime


end.

您可以轻松地将其入侵您的应用程序：查找/替换所有对TColorButton的TButton引用在.pas和.dfm文件中。您可以为背景，字体和悬停设置单独的颜色。

如果你想要添加样式应用程序，也许最好用一个具有本机支持的库创建GUI，如DevExpress，TMS，... 就个人而言，我最喜欢DevExpress，但这是个人品味的问题。

Delphi：使用类助手更改按钮颜色

1 个答案: