这是网上得到的技巧，不知是否合你的题意。可不是我写的[?]
***************************************
建立任意图片形状窗口的方法
function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
dc, dc_c: HDC;
rgn: HRGN;
x, y: integer;
coord: TPoint;
line: boolean;
color: TColor;
begin
dc := GetWindowDC(hControl);
dc_c := CreateCompatibleDC(dc);
{创建一个与特定设备场景一致的内存设备场景}
SelectObject(dc_c, wMask.Handle);
{把位图选入内存设备场景这样才可以操作！}
BeginPath(dc);
{启动一个路径分支。
在这个命令后执行的GDI绘图命令会自动成为路径的一部分。
对线段的连接会结合到一起。并且设备场景中任何现成的路径都会被清除。}
for x:=0 to wMask.Width-1 do
begin
line := false;
for y:=0 to wMask.Height-1 do
begin
color := GetPixel(dc_c, x, y);
if not (color = wColor) then
begin
if not line then
{如果这个不同颜色的线段开始了当然就不记录了！}
begin
line := true;{这是记录下这一列连续的不是背景颜色的颜色段的第一个位子。}
coord.x := x;{其实这个X是不用的，因为coord.x是恒等于x的。但尊重源作者，保留！}
coord.y := y;
end;
end;
if (color = wColor) or (y=wMask.Height-1) then{如果这个颜色段完了或者到了图片底部}
begin
if line then
begin
line := false;
MoveToEx(dc, coord.x, coord.y, nil);{就把画线的起点移到这个列线段不同颜色的开始}
LineTo(dc, coord.x, y);
LineTo(dc, coord.x + 1, y);
LineTo(dc, coord.x + 1, coord.y);{上面三个LineTo()语句就是画一个2×y的矩形。
一定要这样才可以画上每个点！并且连在一起的如果你查查Win32 SDK手册你还可以用Rectangle(dc, coord.x, coord.y, x + 2, y)等其他的画图函数代替从MoveToEx()开始的四个语句！也是一样的，只要记住要把点画完而且要重叠地画才可以把路径连在一起！}
CloseFigure(dc);{描绘到一个路径时，关闭当前打开的图形。万重大侠说不可以少，我不理解，但是多了不错。}
end;
end;
end;
end;
EndPath(dc);{结束画路径}
rgn := PathToRegion(dc);{连接路径为区域的函数。}
ReleaseDC(hControl, dc);{释放资源，公式化的必须使用。}
Result := rgn;
end;
不过后来看到了罗云彬(http://asm.yeah.net)大侠给出了不同的算法，我以为更好些，源程序可是用100%的汇编写成的(厉害吧！) 我改为了Delphi的样子！首先解释两个函数。
1、原形:function CreateRectRgn(p1, p2, p3, p4: Integer): HRGN; stdcall;创建一个由点p1，p2和p3，p4描述的矩形区域;
2、原形:function CombineRgn(p1, p2, p3: HRGN; p4: Integer): Integer; stdcall;把p2和p3区域合并为区域p1，p4是合并方式，p4取值如下:RGN_AND 交集合并，RGN_COPY拷贝p2的内容,RGN_DIFF合并p2和p3不相交的地方，RGN_OR并集合并，RGN_XOR不同时在p2和p3中的部分。
下面给出完整源程序:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
function CreateRegion(wMask: TBitmap; wColor: TColor;
hControl: THandle): HRGN;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function Tform1.CreateRegion(wMask:TBitmap;wColor:TColor;hControl:THandle): HRGN;
var
dc, dc_c: HDC;
Rgn, TempRgn: HRGN;
X, Y, BeginY: Integer;
line: boolean;
color: TColor;
begin{代码风格不统一，因为有些是照抄那个外国人的。
dc := GetWindowDC(hControl);
dc_c := CreateCompatibleDC(dc);
SelectObject(dc_c, wMask.Handle);
BeginY := 0;{这句可以不要，有了可以避免编译器警告。}
Rgn := CreateRectRgn(0, 0, 0, 0);{先初始化一个空的区域给Rgn。}
for X := 0 to wMask.Width - 1 do
begin
line := False;
for Y := 0 to wMask.Height - 1 do
begin
color := GetPixel(dc_c, X, Y);
if not (color = wColor) then
begin
if not line then
begin
line := True;
BeginY:= Y;
end;
end;
if (color = wColor) or (Y = wMask.Height - 1) then
begin
if line then
begin
line := False;
TempRgn := CreateRectRgn(X, BeginY, X + 1, Y);
CombineRgn(Rgn, Rgn, TempRgn, RGN_OR);
{把图形以连续得线段为单位生成区域，并且合并到总的区域中}
end;
end;
end;
end;
ReleaseDC(hControl, dc);
DeleteObject(dc);
Result := Rgn;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
w1:TBitmap;
w2:TColor;
rgn: HRGN;
begin
w1:=TBitmap.Create;
w1.Assign(image1.Picture.Bitmap);
w2:=w1.Canvas.Pixels[0,0];
rgn := CreateRegion(w1,w2,Handle);
if rgn<>0 then
begin
SetWindowRgn(Handle, rgn, true);
end;
w1.Free;
end;
********************************************************
