我自己解决了这个问题,所以,不能给大家分了,对不起,不过还是谢谢大家
我将其做成了一个控件,该控件可以将字符间距自动均匀排列并可以加上正确
的人民币符号.
---------------重庆 柯岗 2001.10.13
//该控件主要属性说明如下
1)是否使用自动间距: AutoInterval;
2)是否加上人民币符号: RmbUseing;
3)最大字符数量: TextNumber;
unit ELable;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TELable = class(TGraphicControl)
private
FAutoMark: Boolean;
//自动间距
FAutoInterval: Boolean;
//是否加上人民币符号
FRmbUseing: Boolean;
FFont : TFont;
FCaption : String;
FTextTop : Integer;
FTextLeft: Integer;
//字符数量
FTextNumber: Integer;
//字符居中/左/右
FTextAlign: Integer;
//是否透明
FTransparent: Boolean;
{ Procedures for setting property values }
procedure SetAutoMark(Value: Boolean);
procedure SetAutoInterval(Value: Boolean);
procedure SetRmbUseing(Value: Boolean);
procedure SetFont(AFont: TFont);
procedure SetCaption(Value: String);
procedure SetTextTop(Value: Integer);
procedure SetTextLeft(Value: Integer);
procedure SetTextNumber(Value: Integer);
procedure SetTextAlign(Value: Integer);
procedure SetTransparent(Value: Boolean);
{ Fill procedure }
procedure GradientFill;
protected
procedure Paint;
override;
public
constructor Create(AOwner: TComponent);
override;
published
{ Repaint when autosized }
property AutoMark: Boolean read FAutoMark write SetAutoMark default True;
property AutoInterval: Boolean read FAutoInterval write SetAutoInterval default True;
property RmbUseing: Boolean read FRmbUseing write SetRmbUseing default True;
{ Starting color of fill }
property Font: TFont read FFont write SetFont;
property Caption: String read FCaption write SetCaption;
property TextTop: Integer read FTextTop write SetTextTop;
property TextLeft: Integer read FTextLeft write SetTextLeft;
property TextNumber: Integer read FTextNumber write SetTextNumber;
property TextAlign: Integer read FTextAlign write SetTextAlign;
property Transparent: Boolean read FTransparent write SetTransparent default True;
property Align;
property DragCursor;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
constructor TELable.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 25;
Width := 40;
AutoMark :=True;
AutoInterval :=True;
RmbUseing:=False;
Transparent:=True;
FTextLeft:=0;
FTextTop:= 5;
FTextNumber:=12;
FTextAlign:=1;
FFont:= TFont.Create;
// FFOnt.Style:= [fsbold];
FCaption:= 'TELable';
end;
procedure TELable.SetAutoMark(Value: Boolean);
begin
FAutoMark := Value;
Invalidate;
Refresh;
end;
procedure TELable.SetAutoInterval(Value: Boolean);
begin
FAutoInterval := Value;
Invalidate;
Refresh;
end;
procedure TELable.SetRmbUseing(Value: Boolean);
begin
FRmbUseing := Value;
Invalidate;
Refresh;
end;
procedure TELable.SetFont(AFont: TFont);
begin
if AFont <> FFont then
begin
FFont.Assign(AFont);
GradientFill;
Refresh;
end;
end;
procedure TELable.SetCaption(Value: String);
begin
FCaption:= Value;
GradientFill;
Refresh;
end;
procedure TELable.SetTextTop(Value: Integer);
begin
FTextTop:= Value;
GradientFill;
Refresh;
end;
procedure TELable.SetTextLeft(Value: Integer);
begin
FTextLeft:= Value;
GradientFill;
Refresh;
end;
procedure TELable.SetTextNumber(Value: Integer);
begin
FTextNumber:= Value;
GradientFill;
Refresh;
end;
procedure TELable.SetTextAlign(Value: Integer);
begin
FTextAlign:= Value;
GradientFill;
Refresh;
end;
procedure TELable.SetTransparent(Value: Boolean);
begin
FTransparent := Value;
Invalidate;
Refresh;
end;
procedure TELable.Paint;
begin
GradientFill;
end;
procedure TELable.GradientFill;
var
a,b,c,w,e,f:integer;
d:string;
SourRun:integer;
SourText:string;
begin
if FTransparent=False then
begin
Canvas.Brush.Color:=Color;
Canvas.Pen.Color:=Color;
Canvas.Rectangle(0,0,Width,Height);
end;
if FAutoInterval then
begin
if RmbUseing=False then
begin
SourText:=FCaption;
end
else
begin
SourText:='Y'+FCaption;
SourText:=copy(SourText,Length(SourText)-FTextNumber+1,FTextNumber);
for SourRun:=1 to FTextNumber-Length(SourText)do
begin
SourText:=' '+SourText;
end;
end;
Canvas.Brush.Style:= bsClear;
Canvas.Font.Assign(FFont);
c:=length(SourText);
a:=FFont.Size*6 div 10;
//尾部剩余点阵
f:=0;
if FAutoMark then
f:=a;
e:=1;
d:=copy(SourText,c,1);
if d>chr(128) then
begin
a:=FFont.Size*12 div 10;
e:=2;
end;
b:=1;w:=width-FTextLeft-a-f;
while b<=(c-e)do
begin
if copy(SourText,b,1)>chr(128) then
begin
//hanzi
Canvas.Textout(FTextLeft+(b-1)*w div (c-e),FTextTop,copy(SourText,b,2));
b:=b+2;
end
else
begin
//asc
Canvas.Textout(FTextLeft+(b-1)*w div (c-e),FTextTop,copy(SourText,b,1));
b:=b+1;
end;
if (copy(SourText,b,1)='Y') and (RmbUseing=True) then
begin
Canvas.Textout((FTextLeft+(b-1)*w div (c-e))+1,FTextTop+2,'=');
end;
end;
Canvas.Textout(width-a-f,FTextTop,copy(SourText,c-e+1,e));
end
else
begin
if RmbUseing=False then
begin
SourText:=FCaption;
end
else
begin
SourText:='Y'+FCaption;
end;
Canvas.Brush.Style:= bsClear;
Canvas.Font.Assign(FFont);
Canvas.Textout(0,FTextTop,SourText);
if (copy(SourText,1,1)='Y') and (RmbUseing=True) then
begin
Canvas.Textout(0,FTextTop+2,'=');
end;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [TELable]);
end;
end.
]
]