发信人: lihai155(天琴)
整理人: kingron(2000-12-27 18:05:38), 站内信件
|
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.
//有什么改进意见欢迎回复，谢谢。
----
问彩云何处飞，愿成风永追随。
有奇缘能相聚，死也无悔。
我柔情深似海，你痴心可问天。
誓相守长缱绻，岁岁年年。 |
|