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

Custom Button Component : caption is displaying different color in Delphi7

我正在和 Delphi 7 一起工作 下面是我的示例按钮组件代码。当我在设计时将按钮组件放在窗体上时,它在 Delphi7 中显示不同的颜色,如屏幕截图中所附。

in 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.

在设计时,按钮标题在 delphi5 中显示为黑色,而在 delphi7 中按钮标题显示为不同颜色。 为什么它与 delphi5 一起工作以及为什么它不与 Delphi7.

一起工作

SetTextColor(Canvas.Handle, Canvas.Font.Color); in DrawCaption 将字体颜色设置为它已有的相同值。

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

改用SetTextColor(Canvas.Handle, clBlack);(如果你想要黑色文本颜色)