自定义按钮组件：标题在Delphi7中显示不同的颜色

我正在与Delphi7合作 下面是我的示例按钮组件代码。当我在设计时将按钮组件放在表单上时，它在Delphi7中显示不同的颜色，如屏幕截图中所附

在Delphi 5中，同样的操作很好。我的意思是，它以黑色显示标题

 unit TestButton1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Math;

type
  TButtonShape = (bsRectangle, bsOval, bsTriangle);

type
  TTestButton = class(TCustomControl)
  private
    { Private declarations }
    FCaption:       TCaption;
    FButtonDown:    boolean;
    FBorderStyle:   TBorderStyle;
    FBtnHighLight:  TColor;
    FBtnShadow:     TColor;
    FBtnFace:       TColor;

    procedure DrawButton;
    procedure DrawButtonDown;
    procedure DrawCaption(rc: TRect);
    procedure DrawButtonUp;
    procedure SetCaption(Value: TCaption);
    procedure SetButtonColor(Value: TColor);

  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   WndProc(var Msg: TMessage); override;

  published
    { Published declarations }
    property    Caption: TCaption read FCaption write SetCaption;
     property    Color: TColor read FBtnFace write SetButtonColor;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TTestButton]);
end;

{ TTestButton }

constructor TTestButton.Create(AOwner: TComponent);
begin
  inherited;
  if AOwner is TWinControl then Parent := TWinControl(AOwner);
  FCaption := Name;
  FButtonDown := FALSE;
  FBorderStyle := bsNone;
  ControlStyle := ControlStyle - [csDoubleClicks];
  FBtnHighLight := clBtnHighLight;
  FBtnShadow := clBtnShadow;
  FBtnFace := clBtnFace;
  Width := 75;
  Height := 25;
end;

destructor TTestButton.Destroy;
begin

  inherited;
end;

procedure TTestButton.DrawButton;
var rc: TRect;
begin
  with rc do
  Begin
    Top := 0;
    Left := 0;
    Bottom := Height;
    Right := Width;
  end;

  with Canvas do
  Begin
    if FBorderStyle = bsSingle then
    Begin
      Brush.Color := clBlack;
      Framerect(rc);
    end;
  end;

  if FButtonDown then DrawButtonDown
  else DrawButtonUp;

end;

procedure TTestButton.DrawButtonDown;
var rc: TRect;
    Cnv: TCanvas;
begin
  with rc do
  Begin
    Top := 0;
    Left := 0;
    Bottom := Height - 1;
    Right := Width - 1;
  end;

  Cnv := TCanvas.Create;
  Cnv.Handle := CreateCompatibleDC(Canvas.Handle);
  SelectObject(Cnv.Handle, CreateCompatibleBitmap(Canvas.Handle, Width, Height));

  with Canvas do
  Begin
    Brush.Color := FBtnFace;
    FillRect(rc);

      Pen.Color := clBlack;
      MoveTo(rc.Left, rc.Bottom - 1);
      LineTo(rc.Left, rc.Top);
      LineTo(rc.Right, rc.Top);
      Pen.Color := FBtnShadow;
      MoveTo(rc.Left + 1, rc.Bottom - 2);
      LineTo(rc.Left + 1, rc.Top + 1);
      LineTo(rc.Right - 1, rc.Top + 1);
      Pen.Color := FBtnHighlight;
      MoveTo(rc.Left, rc.Bottom);
      LineTo(rc.Right, rc.Bottom);
      Lineto(rc.Right, rc.Top - 1);

      rc.Top := rc.Top + 1;
      rc.Left := rc.Left + 1;

  end;
  rc.Top := rc.Top + 1;
  rc.Left := rc.Left + 1;

  if FCaption > '' then DrawCaption(rc);
end;

procedure TTestButton.DrawButtonUp;
var rc: TRect;
begin
  with rc do
  Begin
    Top := 0;
    Left := 0;
    Bottom := Height - 1;
    Right := Width - 1;
  end;

  with Canvas do
  Begin
    Brush.Color := FBtnFace;
    FillRect(rc);

      Pen.Color := FBtnHighlight;
      MoveTo(rc.Left, rc.Bottom - 1);
      LineTo(rc.Left, rc.Top);
      LineTo(rc.Right, rc.Top);
      Pen.Color := FBtnShadow;
      MoveTo(rc.Left + 1, rc.Bottom - 1);
      LineTo(rc.Right - 1, rc.Bottom - 1);
      LineTo(rc.Right - 1, rc.Top);
      Pen.Color := clBlack;
      MoveTo(rc.Left, rc.Bottom);
      LineTo(rc.Right, rc.Bottom);
      Lineto(rc.Right, rc.Top - 1);
  end;


  if FCaption > '' then DrawCaption(rc);
end;

procedure TTestButton.DrawCaption(rc: TRect);
begin
  Canvas.Brush.Style := bsClear;
  SetTextColor(Canvas.Handle, Canvas.Font.Color);
  DrawText(Canvas.Handle, PChar(FCaption), Length(FCaption), rc, DT_CENTER + DT_VCENTER + DT_SINGLELINE);
end;

procedure TTestButton.SetButtonColor(Value: TColor);
var OldValue: TColor;
begin
  OldValue := FBtnFace;
  FBtnFace := Value;
  if (OldValue <> Value) then Repaint;
end;

procedure TTestButton.SetCaption(Value: TCaption);
begin
  FCaption := Value;
  Repaint;
end;

procedure TTestButton.WndProc(var Msg: TMessage);
begin
  inherited;
  with Msg do if Msg = WM_PAINT then
  Begin
    DrawButton;
    Result := 0;
    Exit;
  end
  else if Msg = WM_LBUTTONDOWN then
  Begin
    if not (csDesigning in ComponentState) then FButtonDown := TRUE;
    Repaint;
    Result := 0;
    Exit;
  end
  else if Msg = WM_LBUTTONUP then
  Begin
    FButtonDown := FALSE;
    Repaint;
    Result := 0;
    Exit;
  end
end;

end.

单元测试按钮1；
接口
使用
窗口、消息、系统工具、类、图形、控件、窗体、对话框、，
StdCtrls、ExtCtrls、数学；
类型
t按钮形状=（b矩形、b椭圆形、b三角形）；
类型
TTestButton=类（TCustomControl）
私有的
{私有声明}
FCaption:TCaption；
FButtonDown：布尔值；
FBorderStyle:TBorderStyle；
FBtnHighLight:TColor；
FBtnShadow:TColor；
FBtnFace:t彩色；
程序按钮；
程序DrawButtonDown；
程序说明（rc:TRCT）；
程序绘制按钮；
过程设置标题（值：t选项）；
程序SetButtonColor（值：TColor）；
受保护的
{受保护的声明}
公众的
{公开声明}
构造函数创建（AOwner:TComponent）；推翻
毁灭者毁灭；推翻
程序WndProc（var Msg:TMessage）；推翻
出版
{已发布声明}
属性标题：tcoption read FCaption on write SetCaption；
属性颜色：TColor read FBtnFace write SetButtonColor；
结束；
程序登记册；
实施
程序登记册；
开始
注册表组件（'Samples'，[TTestButton]）；
结束；
{TTestButton}
构造函数TTestButton.Create（所有者：TComponent）；
开始
继承；
如果AOOwner是TWinControl，则父项：=TWinControl（AOOwner）；
FCaption:=名称；
FButtonDown:=假；
FBorderStyle:=bsNone；
ControlStyle:=ControlStyle-[csDoubleClicks]；
FBtnHighLight:=clBtnHighLight；
FBtnShadow:=clBtnShadow；
FBtnFace:=clBtnFace；
宽度：=75；
高度：=25；
结束；
析构函数TTestButton.Destroy；
开始
继承；
结束；
程序TTestButton.DrawButton；
var-rc:TRect；
开始
用rc-do
开始
顶部：=0；
左：=0；
底部：=高度；
右：=宽度；
结束；
用帆布做
开始
如果FBorderStyle=bsSingle，则
开始
画笔颜色：=黑色；
Framerect（rc）；
结束；
结束；
如果FButtonDown，则DrawButtonDown
否则，你会被扣掉扣子；
结束；
程序TTestButton.DrawButtonDown；
var-rc:TRect；
Cnv:TCanvas；
开始
用rc-do
开始
顶部：=0；
左：=0；
底部：=高度-1；
右：=宽度-1；
结束；
Cnv:=TCanvas.Create；
Cnv.Handle:=CreateCompatibleDC（Canvas.Handle）；
选择对象（Cnv.Handle，CreateCompatibleBitmap（Canvas.Handle，Width，Height））；
用帆布做
开始
画笔颜色：=FBtnFace；
FillRect（rc）；
钢笔颜色：=黑色；
移动到（右键左侧，右键底部-1）；
LineTo（钢筋混凝土左侧，钢筋混凝土顶部）；
LineTo（右钢筋混凝土，顶部钢筋混凝土）；
笔颜色：=FBtnShadow；
移动到（钢筋混凝土左侧+1，钢筋混凝土底部-2）；
LineTo（钢筋混凝土左侧+1，钢筋混凝土顶部+1）；
LineTo（右钢筋混凝土-1，顶部钢筋混凝土+1）；
笔颜色：=FBTNHIGHT；
移动到（右下方，右下方）；
LineTo（右钢筋混凝土，底部钢筋混凝土）；
Lineto（右钢筋混凝土，顶部钢筋混凝土-1）；
rc.Top:=rc.Top+1；
rc.Left:=rc.Left+1；
结束；
rc.Top:=rc.Top+1；
rc.Left:=rc.Left+1；
如果FCaption>''，则DrawCaption（rc）；
结束；
程序TTestButton.DrawButtonUp；
var-rc:TRect；
开始
用rc-do
开始
顶部：=0；
左：=0；
底部：=高度-1；
右：=宽度-1；
结束；
用帆布做
开始
画笔颜色：=FBtnFace；
FillRect（rc）；
笔颜色：=FBTNHIGHT；
移动到（右键左侧，右键底部-1）；
LineTo（钢筋混凝土左侧，钢筋混凝土顶部）；
LineTo（右钢筋混凝土，顶部钢筋混凝土）；
笔颜色：=FBtnShadow；
移动到（rc.Left+1，rc.Bottom-1）；
LineTo（右栏-1，右栏-1）；
LineTo（右钢筋混凝土-1，右钢筋混凝土顶部）；
钢笔颜色：=黑色；
移动到（右下方，右下方）；
LineTo（右钢筋混凝土，底部钢筋混凝土）；
Lineto（右钢筋混凝土，顶部钢筋混凝土-1）；
结束；
如果FCaption>''，则DrawCaption（rc）；
结束；
程序TTestButton.DrawCaption（rc:TRect）；
开始
Canvas.Brush.Style:=bsClear；
SetTextColor（Canvas.Handle、Canvas.Font.Color）；
DrawText（Canvas.Handle、PChar（FCaption）、Length（FCaption）、rc、DT_中心+DT_VCENTER+DT_单线）；
结束；
程序TTestButton.SetButtonColor（值：TColor）；
var OldValue:TColor；
开始
OldValue:=FBtnFace；
FBtnFace:=值；
如果为（旧值），则重新绘制；
结束；
程序TTestButton.SetCaption（值：TCaption）；
开始
FCaption:=值；
重新油漆；
结束；
程序TTestButton.WndProc（var Msg:TMessage）；
开始
继承；
如果Msg=WM_，则使用Msg do
开始
牵引按钮；
结果：=0；
出口
结束
否则，如果Msg=WM_LBUTTONDOWN，则
开始
如果不是（组件状态下的csDesigning），则FButtonDown:=真；
重新油漆；
结果：=0；
出口
结束
否则，如果Msg=WM_LBUTTONUP，则
开始
FButtonDown:=假；
重新油漆；
结果：=0；
出口
结束
结束；
结束。

在设计时，按钮标题用delphi5以黑色显示，而用delphi7按钮标题用不同的颜色显示。 为什么使用delphi5，为什么不使用Delphi7。

SetTextColor（Canvas.Handle、Canvas.Font.Color）DrawCaption

中的code>将字体颜色设置为其已具有的相同值

不同的Delphi版本可以设置不同的初始值，因此您可以看到行为上的差异

---

使用

SetTextColor（Canvas.Handle，clBlack）相反（如果您想要黑色文本颜色）
您的问题是什么？为什么按钮标题使用Delphi 7 exe以不同的颜色显示？请更新您的实际问题，而不是添加注释。代码有一些奇怪的地方。例如，它在每次调用
DrawButtonDown
时都会泄漏一个
tcavas
、它的设备上下文和一个位图。这会导致奇怪的副作用。我怀疑代码是否可以描述