在Form上放一个Image，图片的形状不是矩形的，我想设置Form为透明，可以看到图片，请指教，谢谢！

[xuanrk]

在Form上放一个Image，图片的形状不是矩形的，我想设置Form为透明，可以看到图片，请指教，谢谢！

[fei19790920]

现在的分越来越少了，虽然问题不是很难，但也不至于这么少分吧

///////////////////////
procedure SetWindowRGN(hWnd: HWND; bmp: TBitmap; TransparentColor: TColor = clBlack;
RedTol: Byte = 1; GreenTol: Byte = 1; BlueTol: Byte = 1);
const
AllocUnit = 100;
type
PRectArray = ^TRectArray;
TRectArray = array[0..(MaxInt div SizeOf(TRect)) - 1] of TRect;
var
pr: PRectArray;
h: HRGN;
RgnData: PRgnData;
lr, lg, lb, hr, hg, hb: Byte;
x, y, x0: Integer;
b: PByteArray;
ScanLinePtr: Pointer;
ScanLineInc: Integer;
maxRects: Cardinal;
RGN: HRGN;
begin
RGN := 0;
{ Keep on hand lowest and highest values for the "transparent" pixels }
lr := GetRValue(TransparentColor);
lg := GetGValue(TransparentColor);
lb := GetBValue(TransparentColor);
hr := Min($FF, lr + RedTol);
hg := Min($FF, lg + GreenTol);
hb := Min($FF, lb + BlueTol);

bmp.PixelFormat := pf32bit;

maxRects := AllocUnit;
GetMem(RgnData, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
try
with RgnData^.rdh do
begin
dwSize := SizeOf(RGNDATAHEADER);
iType := RDH_RECTANGLES;
nCount := 0;
nRgnSize := 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
end;

ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Integer(bmp.ScanLine[1]) - Integer(ScanLinePtr);
for y := 0 to bmp.Height - 1 do
begin
x := 0;
while x < bmp.Width do
begin
x0 := x;
while x < bmp.Width do
begin
b := @PByteArray(ScanLinePtr)[x * SizeOf(TRGBQuad)];
// BGR-RGB: Windows 32bpp BMPs are made of BGRa quads (not RGBa)
if (b[2] >= lr) and (b[2] <= hr) and
(b[1] >= lg) and (b[1] <= hg) and
(b[0] >= lb) and (b[0] <= hb) then
Break; // pixel is transparent
Inc(x);
end;
{ test to see if we have a non-transparent area in the image }
if x > x0 then
begin
{ increase RgnData by AllocUnit rects if we exceeds maxRects }
if RgnData^.rdh.nCount >= maxRects then
begin
Inc(maxRects, AllocUnit);
ReallocMem(RgnData, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
end;
{ Add the rect (x0, y)-(x, y+1) as a new visible area in the region }
pr := @RgnData^.Buffer; // Buffer is an array of rects
with RgnData^.rdh do
begin
SetRect(pr[nCount], x0, y, x, y + 1);
{ adjust the bound rectangle of the region if we are "out-of-bounds" }
if x0 < rcBound.Left then
rcBound.Left := x0;
if y < rcBound.Top then
rcBound.Top := y;
if x > rcBound.Right then
rcBound.Right := x;
if y + 1 > rcBound.Bottom then
rcBound.Bottom := y + 1;
Inc(nCount);
end;
end; // if x > x0

if RgnData^.rdh.nCount = 2000 then
begin
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
if RGN > 0 then
begin // Expand the current region
CombineRgn(RGN, RGN, h, RGN_OR);
DeleteObject(h);
end
else // First region, assign it to Result
RGN := h;
RgnData^.rdh.nCount := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
end;
Inc(x);
end; // scan every sample byte of the image
Inc(Integer(ScanLinePtr), ScanLineInc);
end;
{ need to call ExCreateRegion one more time because we could have left }
{ a RgnData with less than 2000 rects, so it wasn't yet created/combined }
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
if RGN > 0 then
begin
CombineRgn(RGN, RGN, h, RGN_OR);
DeleteObject(h);
end
else
RGN := h;

Windows.SetWindowRgn(hWnd, RGN, True);
DeleteObject(RGN);

finally
FreeMem(RgnData, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Self.BorderStyle :=bsNone;
SetWindowRGN(Self.Handle,Image1.Picture.Bitmap,Image1.Canvas.Pixels[0,0]);
end;