有园整字体的空件吗?(50分)

有园整字体的空件吗?

有

to tqz:何处可以下载到

圆整form上所有文字的控件?
还是某个能显示无级缩放文字的label(memo, edit, ...)?

讨论过方法，但不知有无控件。

to Another_eYes:是柔化label.caption,Memo.text....

如果你能等, 我做个label给你, 1-2天

to Another_eYes:先谢了!

unit StretchLabel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TText3D = (txtNone, txtUpper, txtLower, txtRaise, txtSunk);
TStretchLabel = class(TCustomLabel)
private
{ Private declarations }
FStretch : Boolean;
FSaveAsBmp : Boolean;
FText3D : TText3D;
FTextHighLight : TColor;
FTextShadow : TColor;
FCalcing : Boolean;
FBmp : TBitmap;
FBkColor : TColor;
procedure SetStretch(v: boolean);
procedure SetText3D(v: TText3D);
procedure SetTextHighlight(v: TColor);
procedure SetTextShadow(v: TColor);
procedure CMFontChanged(var Msg: TMessage);
message CM_FONTCHANGED;
protected
{ Protected declarations }
procedure AdjustBounds;
override;
proceduredo
DrawText(var Rect: TRect;
Flags: Longint);
override;
procedure DrawEffect;
virtual;
procedure TransCombine(Dst: TBitmap;
x, y: Integer;
Src, Mask: TBitmap);
virtual;
procedure SmoothStretch(Dst, Src: TBitmap);
virtual;
procedure SetAutoSize(v: Boolean);
override;
public
{ Public declarations }
Constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
published
{ Published declarations }
property Bmp : TBitmap read FBmp stored true;
property Stretch : boolean read fstretch write setstretch;
property SaveAsBmp : Boolean read fsaveasbmp write fsaveasbmp;
property Text3D: TText3D read ftext3d write settext3d;
property TextHighLight: TColor read ftexthighlight write settexthighlight;
property TextShadow: TColor read ftextshadow write settextshadow;
property Align;
property Alignment;
property AutoSize;
property Caption;
property Color;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property Font;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDrag;
{$IFDEF Ver120}
property Anchors;
property BiDiMode;
property Constraints;
property ParentBiDiMode;
property OnEndDock;
property OnStartDock;
{$ENDIF}
end;

procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TStretchLabel]);
end;

procedure TStretchLabel.SetStretch(v: boolean);
begin
if fstretch <> v then
begin
fstretch := v;
if v then
autosize := false;
invalidate;
end;
end;

procedure TStretchLabel.SetText3D(v: TText3D);
begin
if ftext3d <> v then
begin
ftext3d := v;
invalidate;
end;
end;

procedure TStretchLabel.SetTextHighlight(v: TColor);
begin
if ftexthighlight <> v then
begin
ftexthighlight := v;
invalidate;
end;
end;

procedure TStretchLabel.SetTextShadow(v: TColor);
begin
if ftextshadow <> v then
begin
ftextshadow := v;
invalidate;
end;
end;

procedure TStretchLabel.CMFontChanged(var Msg: TMessage);
begin
if not fcalcing then
inherited
else
fcalcing := false;
end;

{ Protected declarations }
procedure TStretchLabel.AdjustBounds;
begin
inherited;
end;

procedure TStretchLabel.SetAutoSize(v: Boolean);
begin
if v then
fstretch := false;
inherited setautosize(v);
end;

procedure TStretchLabel.DoDrawText(var Rect: TRect;
Flags: Longint);
var
fbmp1: TBitmap;
l: Integer;
r: TRect;
cr,cg,cb: byte;
savdc: HDC;
begin
if not fsaveasbmp or (csDesigning in Componentstate) then
begin
fbkcolor := color;
if transparent then
begin
cr := getrvalue(colortorgb(font.color));
cg := getgvalue(colortorgb(font.color));
cb := getbvalue(colortorgb(font.color));
fbkcolor := rgb(cr, cg, cb);
end;
fbmp.Width := rect.bottom-2;
fbmp.height := rect.top-2;
fbmp.canvas.brush.style := bsSolid;
fbmp.canvas.brush.color := fbkcolor;
fbmp.canvas.fillrect(rect);
if fstretch then
begin
fcalcing := true;
r := classes.rect(0, 0, 1, 1);
fbmp1 := tbitmap.create;
fbmp1.width := 1;
fbmp1.height := 1;
inheriteddo
drawtext(r, flags or DT_CALCRECT);
l := round((rect.right-2) / r.right * font.size);
if l < round((rect.bottom-2) / r.bottom * font.size) then
l := round((rect.bottom-2) / r.bottom * font.size);
font.size := l;
savdc := canvas.handle;
canvas.handle := fbmp1.canvas.handle;
inheriteddo
drawtext(r, flags or DT_CALCRECT);
canvas.handle := savdc;
fbmp1.width := r.right;
fbmp1.height := r.bottom;
fbmp1.Canvas.brush.color := fbkcolor;
fbmp1.canvas.fillrect(r);
canvas.handle := fbmp1.canvas.handle;
inheriteddo
drawtext(r, flags and not DT_CALCRECT);
canvas.handle := savdc;
smoothstretch(fbmp, fbmp1);
fbmp1.free;
if DT_CALCRECT and flags = 0 then
draweffect
else
rect := classes.rect(0, 0, fbmp.width + 2, fbmp.height + 2);
end
else
begin
savdc := canvas.handle;
canvas.handle := fbmp.canvas.handle;
inheriteddo
drawtext(rect, flags);
canvas.handle := savdc;
if DT_CALCRECT and flags = 0 then
draweffect
else
begin
rect.right := rect.right + 2;
rect.bottom := rect.bottom + 2;
fbmp.width := rect.right;
fbmp.height := rect.bottom;
end;
end;
end
else
if DT_CALCRECT and flags = 0 then
draweffect
else
begin
rect.Right := fbmp.width + 2;
rect.Bottom := fbmp.height + 2;
end;
end;

procedure TStretchLabel.DrawEffect;
var
feffect : TBitmap;
fbmp1 : TBitmap;
fmask : TBitmap;
Rct : TRect;
begin
rct := clientrect;
feffect := tbitmap.create;
fmask := tbitmap.create;
fmask.assign(fbmp);
fmask.PixelFormat := fbmp.PixelFormat;
fmask.mask(fbkcolor);
feffect.Width := rct.right;
feffect.height := rct.bottom;
bitblt(feffect.canvas.handle, 0, 0, rct.right, rct.bottom,
canvas.handle, 0, 0, SRCCOPY);
if (ftext3d <> txtNone) and enabled then
begin
fbmp1 := tbitmap.create;
fbmp1.width := fbmp.width;
fbmp1.height := fbmp.height;
fbmp1.canvas.brush.style := bsSolid;
if ftext3d <> txtUpper then
begin
if ftext3d <> txtSunk then
fbmp1.canvas.brush.color := ftexthighlight
else
fbmp1.canvas.brush.color := ftextshadow;
fbmp1.canvas.fillrect(rct);
transCombine(feffect, 0, 0, fbmp1, fmask);
end;
if ftext3d <> txtLower then
begin
if ftext3d <> txtRaise then
fbmp1.canvas.brush.color := ftextShadow
else
fbmp1.canvas.brush.color := ftexthighlight;
fbmp1.canvas.fillrect(rct);
transcombine(feffect, 2, 2, fbmp1, fmask);
end;
fbmp1.free;
end;
transcombine(feffect, 1, 1, fbmp, fmask);
bitblt(canvas.handle, 0, 0, width, height, feffect.canvas.handle, 0, 0, SRCCOPY);
fmask.free;
feffect.free;
end;

procedure TStretchLabel.TransCombine(Dst: TBitmap;
x, y: Integer;
Src, Mask: TBitmap);
var
l, h: Integer;
bmp: TBitmap;
begin
l := src.width;
h := src.height;
bmp := tbitmap.create;
bmp.assign(mask);
bitblt(Dst.canvas.handle, x, y, l, h, mask.canvas.handle,0, 0, SRCAND);
bitblt(bmp.canvas.handle, 0, 0, l, h, src.canvas.handle,0,0, SRCERASE);
bitblt(Dst.canvas.handle, x, y, l, h, bmp.canvas.handle,0,0, SRCPAINT);
bmp.free;
end;

procedure TStretchLabel.SmoothStretch(Dst, Src: TBitmap);
var
i, x, y,xp, yp, xp2, yp2, s1, s2 : Integer;
w1, w2, w3, w4 : Integer;
p1, p2, p3, p21, p31: Pbyte;
begin
yp := 0;
xp2 := ((src.width - 1) shl 15) div Dst.width;
yp2 := ((src.height - 1) shl 15) div Dst.height;
for y := 0 to Dst.height - 1do
begin
xp := 0;
p2 := src.scanline[yp shr 15];
if (yp shr 16) < src.height - 1 then
p3 := pointer(pchar(p2) + 1)
else
p3 := p2;
p1 := Dst.scanline[y];
s1 := yp and $7fff;
s2 := $8000 - s1;
for x := 0 to Dst.width - 1do
begin
p21 := pointer(pchar(p2) + xp shr 15);
p31 := pointer(pchar(p3) + xp shr 15);
w2 := ((xp and $7fff) * s2) shr 15;
w1 := s2 - w2;
w4 := ((xp and $7fff) * s1) shr 15;
w3 := s1 - w4;
for i := 1 to 3do
begin
p1^ := (p21^ * w1 + pbyte(pchar(p21)+ 3)^ * w2 +
p31^ * w3 + pbyte(pchar(p31) + 3)^ * w4 ) shr 15;
inc(p1);
inc(p21);
inc(p31);
end;
inc(xp, xp2);
end;
inc(yp, yp2);
end;
end;

{ Public declarations }
Constructor TStretchLabel.Create(AOwner: TComponent);
begin
inherited create(aowner);
FStretch := false;
FSaveAsBmp := false;
FText3D := txtNone;
FTextHighLight := clHighlight;
FTextShadow := clbtnshadow;
FCalcing := false;
FBmp := TBitmap.create;
FBkColor := color;
end;

destructor TStretchLabel.Destroy;
begin
fbmp.free;
inherited;
end;

end.

Another_eYes你狠！！！
我崇拜死了，嘿嘿赶快把你的email抄下，有问题问您就行了的说！
嘿嘿

没试过(eYes干什么都想偷懒), 不过编译通过了. 效果不知道.

接受答案了.