如何根据图位生成透明的窗体（如果我的图位是异形的）(5分)

现在急需这样的功能，请高手帮助，我只有5分家当，全部…

分数太少就没有人帮忙，好痛苦；

版主，怎样才能加钱

有相应的控件可以用.1stclass可以中的fcimageform可以.
下载地址可以搜以前的贴子.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, shellapi;

const
WM_BARICON = WM_USER + 200;

type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
Image2: TImage;
Image3: TImage;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image3DblClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
function CreateRegion(wMask: TBitmap; wColor: TColor; hControl: THandle): HRGN;
procedure SetPos(var msg: TWMWINDOWPOSCHANGED); message WM_WindowPosChanging;
procedure WMBarIcon(var Message: TMessage); message WM_BARICON;
public
{ Public declarations }
end;

var
Form1: TForm1;
MPos: TPoint;

implementation

{$R *.DFM}

procedure TForm1.SetPos(var msg: TWMWINDOWPOSCHANGED);
begin
//使窗体始终在最低下
msg.WindowPos.hwndInsertAfter := 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
ExStyle: longint;
w1: TBitmap;
w2: TColor;
rgn: HRGN;
lpData: PNotifyIconData;
begin
//让窗体不在任务栏显示
ExStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE); //Must Application Handle
ExStyle := ExStyle or WS_EX_TOOLWINDOW;
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExStyle);
//在任务栏上添加图标
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;
lpData.Wnd := Form1.Handle;
lpData.hIcon := Application.Icon.Handle;
//lpData.uCallbackMessage := WM_BARICON;
lpData.uID := 0;
lpData.szTip := 'Samples';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD, lpData);
dispose(lpData);
//画窗体
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;
//窗体位置
form1.Left := screen.Width - form1.Width;
form1.Top := screen.Height - form1.Height - 32;
end;

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);
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;
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);
CloseFigure(dc);
end;
end;
end;
end;
EndPath(dc);
rgn := PathToRegion(dc);
ReleaseDC(hControl, dc);
Result := rgn;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
ang: double;
x, y, x1, x2, y1, y2, x3, y3: double;
rad, mx, sx, hx: integer;
MyOther, MyRect: TRect;
dt: TDate;
hh, mm, ss, ms, dy, dm, dd: word;
begin
MyRect := Rect(10, 28, 115, 132); //刷新
MyOther := Rect(0, 0, 105, 104);
image1.Canvas.BrushCopy(MyRect, image1.Picture.Bitmap, MyRect, clwhite);
image2.Canvas.CopyRect(MyOther, image1.Canvas, MyRect);

//分解当前时间
dt := now();
DecodeTime(dt, hh, mm, ss, ms);
sx := ss;
hx := hh;
mx := mm;
Decodedate(dt, dy, dm, dd);

//时针
rad := 30;
ang := (2.0 * PI) * (6 - hx) / 12;
ang := ang - (((2.0 * PI) / 12) / 60) * mx; //时针偏移
x := sin(ang) * rad + 51;
y := cos(ang) * rad + 51;

rad := -3;
x2 := sin(ang) * rad + 51;
y2 := cos(ang) * rad + 51;

rad := 4;
x1 := sin(ang + 0.8) * rad + 51;
y1 := cos(ang + 0.8) * rad + 51;

rad := 4;
x3 := sin(ang - 0.8) * rad + 51;
y3 := cos(ang - 0.8) * rad + 51;

image2.Canvas.Pen.Color := clred;
image2.Canvas.Brush.Color := clred;
image2.Canvas.Polygon([Point(Round(x), Round), Point(Round(x1), Round(y1)), Point(Round(x2), Round(y2)), Point(Round(x3), Round(y3))]);

//分针
rad := 35;
ang := (2.0 * PI) * (30 - mx) / 60;
x := sin(ang) * rad + 51;
y := cos(ang) * rad + 51;

rad := -8;
ang := (2.0 * PI) * (30 - mx) / 60;
x2 := sin(ang) * rad + 51;
y2 := cos(ang) * rad + 51;

rad := 5;
ang := (2.0 * PI) * (30 - mx) / 60;
x1 := sin(ang + 0.4) * rad + 51;
y1 := cos(ang + 0.4) * rad + 51;

rad := 5;
ang := (2.0 * PI) * (30 - mx) / 60;
x3 := sin(ang - 0.4) * rad + 51;
y3 := cos(ang - 0.4) * rad + 51;

image2.Canvas.Pen.Color := clblue;
image2.Canvas.Brush.Color := clblue;
image2.Canvas.Polygon([Point(Round(x), Round), Point(Round(x1), Round(y1)), Point(Round(x2), Round(y2)), Point(Round(x3), Round(y3))]);

//秒针
rad := 40;
ang := (2.0 * PI) * (30 - sx) / 60;
x := sin(ang) * rad + 51;
y := cos(ang) * rad + 51;
image2.Canvas.Pen.Color := clblack;
image2.Canvas.moveto(51, 51);
image2.Canvas.LineTo(Round(x), Round);
//写日期
image2.Canvas.Font.Color := clblack;
image2.Canvas.Brush.Color := $00F5F6A0;
image2.Canvas.TextOut(87, 46, inttostr(dd));
end;

procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MPos.X := X;
MPos.Y := Y;
end;

procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
i: integer;
abd: TAppBarData;
begin
if ssLeft in Shift then
begin
i := 30;
if (Form1.Left - (MPos.X - X)) < i then
Form1.Left := 0
else
if screen.Width - Form1.Width - (Form1.Left - (MPos.X - X)) < i then
Form1.Left := screen.Width - Form1.Width
else
Form1.Left := Form1.Left - (MPos.X - X);
abd.cbSize := sizeof(abd);
SHAppBarMessage(ABM_GETTASKBARPOS, abd);
if (Form1.Top - (MPos.Y - Y)) < i then
Form1.Top := 0
else
if screen.Height - Form1.Height - (Form1.Top - (MPos.y - y)) - (abd.rc.Bottom - abd.rc.Top) < i then
form1.top := screen.Height - Form1.Height - (abd.rc.Bottom - abd.rc.Top)
else
Form1.Top := Form1.Top - (MPos.Y - Y);
end;
end;

procedure TForm1.Image3DblClick(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
lpData: PNotifyIconData;
begin
//删除任务栏图标。
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88; //SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Application.Icon.Handle;
lpData.uCallbackMessage := WM_BARICON;
lpData.uID := 0;
lpData.szTip := 'Samples';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE, lpData);
dispose(lpData);
end;

procedure TForm1.WMBarIcon(var Message: TMessage);
begin

end;

end.