Reputation: 489
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.
Upvotes: 0
Views: 1483
Reputation: 28515
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)
Upvotes: 2