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

Question

i am working with Delphi 7 Below is my code for sample button component. When i place button component on form at design time it is displaying different color in Delphi7 as attached in screen shot.

in Delphi 5 same is Working fine. i mean it is displaying caption as black color.

 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.

at design time, Button caption is displaying in black color with delphi5 and with delphi7 button caption is displaying in different color. Why it is working with delphi5 and why it is not working with Delphi7.

Answer 1

SetTextColor(Canvas.Handle, Canvas.Font.Color); in DrawCaption sets font color to same value it already has.

Different Delphi versions can set different initial values therefore you see the difference in behavior.

Use SetTextColor(Canvas.Handle, clBlack); instead (if you want black text color)