自定义按钮组件:标题在 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);
(如果你想要黑色文本颜色)
我正在和 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);
(如果你想要黑色文本颜色)