充分应用 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;
