(*//============================================================================
设计思路:～～
就是对画布一行一行的扫描～～
对于不是透明色相连的像素都看成一条条的线段～～
───────── ─ ─── ─────
─────── ──── ───────
─── ─── ── ───────
── ─────────
用这些线段组合成不规则的区域～～
线段就是找到开始位置和结束位置就行了～～
组合区域是最花时间的地方～～
减少组合区域的频率就可以提高运行的速度～～
用线段组合就比用点组合少多了～～
============================================================================//*)

function GraphicToRGN(mGraphic: TGraphic; mTransPoint: TPoint): HRGN;
var
I, J: Integer;
vStart: Integer;
vHandle: HRGN;
vTransColor: TColor;
begin
Result := 0;
if not Assigned(mGraphic) then Exit;
Result := CreateRectRgn(0, 0, 0, 0);
with TBitmap.Create do try
Width := mGraphic.Width;
Height := mGraphic.Height;
Canvas.Draw(0, 0, mGraphic);
vTransColor := Canvas.Pixels[mTransPoint.X, mTransPoint.Y];
for I := 0 to Height - 1 do begin
vStart := 0;
for J := 0 to Width do begin
if (Canvas.Pixels[J, I] <> vTransColor) and (J < Width) then
if vStart < 0 then
vStart := J
else
else if vStart >= 0 then begin
vHandle := CreateRectRgn(vStart, I, J, I + 1);
try
CombineRgn(Result, Result, vHandle, RGN_OR);
finally
DeleteObject(vHandle);
end;
vStart := -1;
end;
end;
end;
finally
Free;
end;
end; { GraphicToRGN }

//Example
procedure TForm1.Button1Click(Sender: TObject);
var
vRGN: HRGN;
begin
BorderStyle := bsNone;
Image1.Left := 0;
Image1.Top := 0;
vRGN := GraphicToRGN(Image1.Picture.Graphic, Point(0, 0));
try
SetWindowRgn(Handle, vRGN, True);
finally
DeleteObject(vRGN);
end;
end;