如何生成字体有边框的效果?(100分)

  • 主题发起人 主题发起人 zzz
  • 开始时间 开始时间
Z

zzz

Unregistered / Unconfirmed
GUEST, unregistred user!
想TextOut出来的字体有某种颜色和宽度的包络边,如何实现?
 
Label控件行吗?
 
canvas.fillrect(rect);
canvas.rectangle(rect.left,rect.top,rect.right,rect.bottom);
canvas.TextRect(5,5,'fasd');
 
谢谢二位
不过我要的是沿着字体边界轮廓形成的Outline。
 
控件就是字体加边框而且支持鼠标移动变颜色的!
如果需要留下Email
 
很多书上都有。我找找!
 
充分应用 Path 与 Region 的概念

procedure InflateRgn(var RGN : HRGN; Dx,Dy : integer);
var
R : TRect;
x,y,xB,xE,yB,YE,xxB,xxE,yyB,yyE : integer;
Tr,Tr1,Tr2 : HRGN;
begin
if RGN<>0 then
begin
Tr1:=CreateRectRgn(0,0,0,0);
Tr2:=CreateRectRgn(0,0,0,0);
R:=Rect(0,0,0,0);
GetRgnBox(RGN,R);
for y:=R.Top to R.Bottom do
begin
xB:=R.Left;
xE:=R.left;
for x:=R.Left to R.Right do
begin
if PtInRegion(RGN,x,y) then xE:=x
else
begin
if xB=xE then
begin
xB:=x;
xE:=x;
end
else
begin
xxB:=xB-Dx;
xxE:=xE+Dx;
if xxB<xxE then
begin
Tr:=CreateRectRgn(xxB,y,xxE+1,y+1);
CombineRgn(Tr1,Tr1,TR,RGN_OR);
DeleteObject(Tr);
end;
xB:=x;
xE:=x;
end;
end;
end;
if xB<>xE then
begin
xxB:=xB-Dx;
xxE:=xE+Dx;
if xxB<xxE then
begin
Tr:=CreateRectRgn(xxB,y,xxE+1,y+1);
CombineRgn(Tr1,Tr1,TR,RGN_OR);
DeleteObject(Tr);
end;
end;
end;
R:=Rect(0,0,0,0);
GetRgnBox(TR1,R);
for x:=R.Left to R.Right do
begin
yB:=R.Top;
yE:=R.Top;
for y:=R.Top to R.Bottom do
begin
if PtInRegion(Tr1,x,y) then yE:=y
else
begin
if yB=yE then
begin
yB:=y;
yE:=y;
end
else
begin
yyB:=yB-Dy;
yyE:=yE+Dy;
if yyB<yyE then
begin
Tr:=CreateRectRgn(x,yyB,x+1,yyE+1);
CombineRgn(Tr2,Tr2,TR,RGN_OR);
DeleteObject(Tr);
end;
yB:=y;
yE:=y;
end;
end;
end;
if yB<>yE then
begin
yyB:=yB-Dy;
yyE:=yE+Dy;
if yyB<yyE then
begin
Tr:=CreateRectRgn(x,yyB,x+1,yyE+1);
CombineRgn(Tr2,Tr2,TR,RGN_OR);
DeleteObject(Tr);
end;
end;
end;
CombineRgn(RGN,Tr2,0,RGN_COPY);
DeleteObject(TR1);
DeleteObject(TR2);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Rgn :Hrgn;
begin
BeginPath(Canvas.Handle);
SetBkMode( Canvas.Handle, TRANSPARENT );
Canvas.Font.Name:= '宋体';
Canvas.Font.Size:=100;
Canvas.TextOut( 20, 20, '卷起千堆雪');
EndPath(Canvas.Handle);
rgn:= PathToRegion(Canvas.Handle);
Canvas.Brush.Color :=clBlue;
PaintRgn(Canvas.Handle,Rgn);
Canvas.Brush.Color :=clRed;
InflateRgn(Rgn,5,5);
PaintRgn(Canvas.Handle,Rgn);
Canvas.Brush.Color :=clBlue;
InflateRgn(Rgn,-5,-5);
PaintRgn(Canvas.Handle,Rgn);
DeleteObject(Rgn);
end;
 
//打印
with printer.Canvas do
begin
printer.Canvas.Font.Name:='宋体';
printer.Canvas.Font.Size:=22;
printer.Canvas.Font.Style:=[fsStrikeout];

strinfor:=strinfor+' 季度政府集中采购计划执行确认书';
TextOut(((printer.pagewidth-textwidth(strinfor))div 2),amountprinted,strinfor);

end;
 
加一句:
printer.Canvas.Font.color:=[clBlue];
 
procedure TForm1.Button3Click(Sender: TObject);
begin
Canvas.Font.Name := '黑体'; //这里的字体一定要是TrueType Font
Canvas.Font.size := 72;
beginpath(canvas.handle); //开始捕获 Canvas上绘制的轮廓
SetBkMode( Canvas.Handle, TRANSPARENT );
canvas.TextOut(20,40,'看我的');
endpath(canvas.handle); //结束捕获
Canvas.Pen.Color := clred; //包络边颜色
Canvas.Pen.Width := 3; //包络边宽度
StrokePath(canvas.handle); //将捕获的轮廓用当前的Pen画到Canvas上
end;
 
后退
顶部