本文整理自网络，侵删。
unit MLabel;
interface
uses
Windows Messages SysUtils Classes Graphics Controls Forms Dialogs
StdCtrls;
type
TColorStyle=(Horizontal Vertical);
type
TMLabel = class(TLabel)
private
CRed CGreen CBlue:Integer;
incRed incGreen incBlue:Integer;
FColor1: TColor;
FColor2: TColor;
FColorStyle: TColorStyle;
procedure SetColor1(const Value: TColor);
procedure SetColor2(const Value: TColor);
procedure SetColorStyle(const Value: TColorStyle);
procedure GetRGB(Color1 Color2:TColor);
{ Private declarations }
protected
{ Protected declarations }
procedure Paint;override;
public
{ Public declarations }
Constructor Create(AOwner:TComponent);override;
published
{ Published declarations }
property Color1:TColor read FColor1 Write SetColor1;
property Color2:TColor read FColor2 Write SetColor2;
property ColorStyle:TColorStyle read FColorStyle write SetColorStyle;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples' [TMLabel]);
end;
{ TMLabel }
constructor TMLabel.Create(AOwner: TComponent);
begin
inherited;
Width:=210;
Height:=40;
Font.Height:=43;
Font.Name:='楷体_GB2312';
FColor1:=clRed;
FColor2:=clWhite;
Canvas.Brush.Style:=bsClear;
Canvas.Font.Assign(Font);
end;
procedure TMLabel.GetRGB(Color1 Color2: TColor);
Var
R G B:Integer;
begin
CRed:=GetRValue(FColor1);
CGreen:=GetGValue(FColor1);
CBlue:=GetBValue(FColor1);
R:=GetRValue(FColor2);
G:=GetGValue(FColor2);
B:=GetBValue(FColor2);
incRed:=(R-CRed) div 10;
incGreen:=(G-CGreen) div 10;
incblue:=(B-CBlue) div 10;
end;
procedure TMLabel.Paint;
Var
i:Integer;
Rect:TRect;
begin
Rect:=ClientRect;
Canvas.Font.Color:=FColor1;
Canvas.TextRect(Rect 0 0 Caption);
for i:=1 to 10 do
Begin
if FColorStyle=Horizontal then
Rect.Right:=Rect.Right - (Rect.Right - Rect.Left) div 10
else
Rect.Bottom:=Rect.Bottom - (Rect.Bottom - Rect.Top) div 10;
Canvas.Font.Color:=RGB(CRed+incRed*i CGreen+incGreen*i CBlue+incBlue*i);
Canvas.TextRect(Rect 0 0 Caption);
End;
end;
procedure TMLabel.SetColor1(const Value: TColor);
begin
FColor1 := Value;
GetRGB(FColor1 FColor2);
Paint;
end;
procedure TMLabel.SetColor2(const Value: TColor);
begin
FColor2 := Value;
GetRGB(FColor1 FColor2);
Paint;
end;
procedure TMLabel.SetColorStyle(const Value: TColorStyle);
begin
FColorStyle := Value;
Paint;
end;
end.
相关阅读 >>
Delphi xe 与plc通讯（intcpserver 二进制）
Delphi tms web core webmemo 横竖滚动条
更多相关阅读请进入《Delphi》频道 >>
