写过一段将图片转成region的程序， 希望能帮你：
定义:
{从tbitmap中获取region}
function CreateRgnFromBmp(Bmp: TBitmap; TransColor: TColor; x:Integer=0; y: Integer=0): HRGN;
{从单色图中获取region}
function CreateRgnFromMask(Msk: HBITMAP; x: Integer = 0 y: Integer=0): HRGN;
实现:
function CreateRgnFromBmpBits(Bits: Pointer; Left, Top, Width, height, gap: Integer): HRGN;
var
Rct: TRect;
i, l: Integer;
RgnH: PRgnDataHeader;
MaxLen: Integer;
p, p1: PByte;
b, e: Byte;
LineP, LastP: PRect;
procedure ResizeRects;
var
p: PRect;
begin
p := LineP;
while Integer(p) < Integer(LastP) do
begin
Inc(p^.Bottom);
Inc(p);
end;
Inc(RgnH^.rcBound.Bottom);
end;
procedure NewRectInStruct(x, y: Integer);
var
i, j: Integer;
begin
if Integer(LastP) >= Integer(RgnH) + MaxLen then
begin
i := Integer(LastP) - Integer(RgnH);
j := Integer(LineP) - Integer(RgnH);
Inc(maxLen, 4096);
ReAllocMem(RgnH, MaxLen);
LastP := Pointer(Integer(RgnH) + i);
LineP := Pointer(Integer(RgnH) + j);
end;
Inc(RgnH^.nCount);
with LastP^ do
begin
Left := x;
Top := y;
Right := x + 1;
Bottom := y + 1;
if Left < RgnH^.rcBound.Left then
RgnH^.rcBound.Left := Left;
if Top < RgnH^.rcBound.Top then
RgnH^.rcBound.Top := Top;
if Right > RgnH^.rcBound.Right then
RgnH^.rcBound.Right := Right;
if Bottom > RgnH^.rcBound.Bottom then
RgnH^.rcBound.Bottom := Bottom;
end;
end;
function IsScanLineEmpty(v: PByte): Boolean;
var
i: Integer;
begin
if l < 0 then
Result := (v^ or b) = $ff
else begin
Result := v^ or b = $ff;
if not Result then Exit;
Inc(v);
for i := 0 to l - 1 do
begin
Result := Result and (v^ = $ff);
if not Result then Exit;
Inc(v);
end;
Result := v^ or e = $ff;
end;
end;
function SameScanLine(v, v1: PByte): Boolean;
begin
Result := (v^ or b) = (v1^ or b);
if not Result then Exit;
if l < 0 then Exit;
Inc(v);
Inc(v1);
if l > 0 then
Result := CompareMem(v, v1, l);
if not Result then Exit;
Inc(v, l);
Inc(v1, l);
Result := v^ or e = v1^ or e;
end;
procedure ScanLineToRects(n: Integer; v: PByte);
var
i, j, x: Integer;
f: Boolean;
begin
LineP := LastP;
f := False;
x := Rct.Left and $fffffff8;
for i := 0 to 7 do
if $80 shr i and (v^ or b) = 0 then
if f then Inc(LastP^.Right)
else begin
NewRectInStruct(x + i, n);
f := True;
end
else if f then
begin
f := False;
Inc(LastP);
end;
if l >= 0 then
begin
Inc(v);
Inc(x, 8);
for i := 0 to l-1 do
begin
if v^ and $ff = $ff then
if f then begin
f := False;
Inc(LastP);
end
else
else if v^ and $ff = 0 then
if f then
Inc(LastP^.Right, 8)
else begin
f := True;
NewRectInStruct(x, n);
Inc(LastP^.Right, 7);
end
else
for j := 0 to 7 do
if ($80 shr j) and v^ = 0 then
if f then
Inc(LastP^.Right)
else begin
f := True;
NewRectInStruct(x + j, n);
end
else if f then
begin
f := False;
Inc(LastP);
end;
Inc(v);
Inc(x, 8);
end;
for i := 0 to 7 do
if $80 shr i and (v^ or e) = 0 then
if f then Inc(LastP^.Right)
else begin
NewRectInStruct(x + i, n);
f := True;
end
else if f then
begin
f := False;
Inc(LastP);
end;
end;
if f then Inc(LastP);
if Integer(LastP) > Integer(LineP) then
with PRect(Integer(LastP)-16)^ do
if Right > RgnH^.rcBound.Right then
RgnH^.rcBound.Right := Right;
end;
begin
Rct := Rect(0,0,Width, abs(Height));
if IsRectEmpty(Rct) then
begin
Result := CreateRectRgn(-2, -2, -1, -1);
Exit;
end;
MaxLen := SizeOf(_RGNDATAHEADER);
GetMem(RgnH, MaxLen);
LastP := Pointer(Integer(RgnH) + MaxLen);
RgnH^.dwSize := MaxLen;
RgnH^.iType := RDH_RECTANGLES;
RgnH^.nCount := 0;
with RgnH^.rcBound do
begin
Left := Rct.Right + 1;
Top := Rct.Bottom + 1;
Right := Rct.Left - 1;
Bottom := Rct.Top - 1;
end;
l := (Rct.Right - Rct.Left) shr 3;
if Rct.Left mod 8 <> 0 then Inc(l);
if Rct.Right mod 8 <> 0 then Inc(l);
Dec(l, 2);
if height > 0 then
begin
p := pointer(integer(bits)+(height-1)*gap);
gap := -gap;
end
else
p := bits;
p1 := p;
b := $ff shl (8 - Rct.Left mod 8);
e := $ff shr ((Rct.Right-1) mod 8 + 1);
if l < 0 then
b := b or e;
ScanLineToRects(Rct.Top, p);
p := Pointer(Integer(p) + gap);
for i := Rct.Top + 1 to Rct.Bottom - 1 do
begin
if not IsScanLineEmpty(p) then
if SameScanLine(p, p1) then
ResizeRects
else
ScanLineToRects(i, p);
p := Pointer(Integer(p) + gap);
p1 := Pointer(Integer(p1) + gap);
end;
if IsRectEmpty(RgnH^.rcBound) then
Result := CreateRectRgn(-2, -2, -1, -1)
else begin
RgnH^.nRgnSize := RgnH^.nCount * 16;
Result := ExtCreateRegion(nil, RgnH^.nRgnSize + SizeOf(_RGNDATAHEADER),
PRgnData(Integer(RgnH))^);
offsetrgn(result, left, top);
end;
FreeMem(RgnH, MaxLen);
end;
function CreateRgnFromMask(Msk: HBITMAP; x, y: Integer): HRGN;
var
Info: PBitmapInfo;
Bits: Pointer;
InfoSize, ImgSize: DWORD;
DS: TDIBSection;
DC: HDC;
Gap: Integer;
begin
infosize := sizeof(TBitmapInfo)+256*sizeof(TRGBQuad);
GetObject(Msk, sizeof(ds), @ds);
info := allocmem(infosize);
fillchar(info^, sizeof(TBitmapInfo), #0);
with info^.bmiHeader do
begin
bisize := sizeof(TBitmapInfoHeader);
biWidth := ds.dsBm.bmWidth;
biheight := ds.dsBm.bmHeight;
biplanes := 1;
bibitcount := 1;
gap := bytesperscanline(biwidth, 1, 32);
imgsize := gap * abs(biheight);
bits := allocmem(imgsize);
dc := createcompatibledc(0);
getdibits(dc, msk, 0, biheight, bits, info^, DIB_RGB_COLORS);
deletedc(dc);
result := creatergnfromBmpbits(bits, x, y, biwidth, biheight, Gap);
end;
freemem(info, infosize);
freemem(bits, imgsize);
end;
function CreateRgnFromBmp(Bmp: TBitmap; TransColor: TColor; x, y: Integer): HRGN;
var
monoDC, ScreenDC: HDC;
MonoImg: HBITMAP;
sav: THandle;
begin
screendc := getdc(0);
monodc := createcompatibledc(screendc);
monoimg := createbitmap(bmp.width, bmp.height, 1, 1, nil);
sav := selectobject(monodc, monoimg);
setbkcolor(bmp.canvas.handle, colortorgb(transcolor));
bitblt(monodc, 0, 0, bmp.width, bmp.height, bmp.canvas.handle, 0, 0, SRCCOPY);
selectobject(monodc, sav);
deletedc(monodc);
releasedc(0, screendc);
result := creatergnfrommask(monoimg, x, y);
deleteobject(monoimg);
end;
