Преобразование Bitmap в Region (маску для формы)

unit ProjetoX_Screen;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls, StdCtrls, DBCtrls;
type
 TFormScreen = class(TForm)
 ImgFundo: TImage;
 procedure FormCreate(Sender: TObject);
 public
 MyRegion: HRGN;
 function BitmapToRegion(hBmp: TBitmap; TransColor: TColor): HRGN;
 end;
var
 FormScreen: TFormScreen;
implementation
{$R *.DFM}
function TFormScreen.BitmapToRegion(hBmp: TBitmap; TransColor: TColor): HRGN;
const
 ALLOC_UNIT = 100;
var
 MemDC, DC: HDC;
 BitmapInfo: TBitmapInfo;
 hBm32, hOldBmp, hOldMemBmp: HBitmap;
 pBits32: Pointer;
 Bm32: BITMAP;
 MaxRects: DWORD;
 hData: HGLOBAL;
 pData: PRgnData;
 b, CR, CG, CB: Byte;
 p32: pByte;
 x, x0, y: Integer;
 p: pLongInt;
 pr: PRect;
 h: HRGN;
begin
 Result := 0;
 if hBmp <> nil then
 begin
 MemDC := CreateCompatibleDC(0);
 if MemDC <> 0 then
 begin
 with BitmapInfo.bmiHeader do
 begin
 biSize := SizeOf(TBitmapInfoHeader);
 biWidth := hBmp.Width;
 biHeight := hBmp.Height;
 biPlanes := 1;
 biBitCount := 32;
 biCompression := BI_RGB;
 biSizeImage := 0;
 biXPelsPerMeter := 0;
 biYPelsPerMeter := 0;
 biClrUsed := 0;
 biClrImportant := 0;
 end;
 hBm32 := CreateDIBSection(MemDC, BitmapInfo, DIB_RGB_COLORS, pBits32, 0, 0);
 if hBm32 <> 0 then
 begin
 hOldMemBmp := SelectObject(MemDC, hBm32);
 GetObject(hBm32, SizeOf(bm32), @bm32);
 while (bm32.bmWidthBytes mod 4) > 0 do
 Inc(bm32.bmWidthBytes);
 DC := CreateCompatibleDC(MemDC);
 hOldBmp := SelectObject(DC, hBmp.Handle);
 BitBlt(MemDC, 0, 0, hBmp.Width, hBmp.Height, DC, 0, 0, SRCCOPY);
 MaxRects := ALLOC_UNIT;
 hData := GlobalAlloc(GMEM_MOVEABLE, SizeOf(TRgnDataHeader) +
 SizeOf(TRect) * MaxRects);
 pData := GlobalLock(hData);
 pData^.rdh.dwSize := SizeOf(TRgnDataHeader);
 pData^.rdh.iType := RDH_RECTANGLES;
 pData^.rdh.nCount := 0;
 pData^.rdh.nRgnSize := 0;
 SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0);
 CR := GetRValue(ColorToRGB(TransColor));
 CG := GetGValue(ColorToRGB(TransColor));
 CB := GetBValue(ColorToRGB(TransColor));
 p32 := bm32.bmBits;
 Inc(PChar(p32), (bm32.bmHeight - 1) * bm32.bmWidthBytes);
 for y := 0 to hBmp.Height-1 do
 begin
 x := -1;
 while x+1 < hBmp.Width do
 begin
 Inc(x);
 x0 := x;
 p := PLongInt(p32);
 Inc(PChar(p), x * SizeOf(LongInt));
 while x < hBmp.Width do
 begin
 b := GetBValue(p^);
 if (b = CR) then
 begin
 b := GetGValue(p^);
 if (b = CG) then
 begin
 b := GetRValue(p^);
 if (b = CB) then
 break;
 end;
 end;
 Inc(PChar(p), SizeOf(LongInt));
 Inc(x);
 end;
 if x > x0 then
 begin
 if pData^.rdh.nCount >= maxRects then
 begin
 GlobalUnlock(hData);
 Inc(MaxRects, ALLOC_UNIT);
 hData := GlobalReAlloc(hData, SizeOf(TRgnDataHeader) +
 SizeOf(TRect) * MaxRects, GMEM_MOVEABLE);
 pData := GlobalLock(hData);
 Assert(pData <> NIL);
 end;
 pr := @pData^.Buffer[pData^.rdh.nCount * SizeOf(TRect)];
 SetRect(pr^, x0, y, x, y+1);
 if x0 < pData^.rdh.rcBound.Left then
 pData^.rdh.rcBound.Left := x0;
 if y < pData^.rdh.rcBound.Top then
 pData^.rdh.rcBound.Top := y;
 if x > pData^.rdh.rcBound.Right then
 pData^.rdh.rcBound.Left := x;
 if y+1 > pData^.rdh.rcBound.Bottom then
 pData^.rdh.rcBound.Bottom := y+1;
 Inc(pData^.rdh.nCount);
 if pData^.rdh.nCount = 2000 then
 begin
 h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
 (SizeOf(TRect) * MaxRects), pData^);
 Assert(h <> 0);
 if Result <> 0 then
 begin
 CombineRgn(Result, Result, h, RGN_OR);
 DeleteObject(h);
 end
 else
 Result := h;
 pData^.rdh.nCount := 0;
 SetRect(pData^.rdh.rcBound, MaxInt, MaxInt, 0, 0);
 end;
 end;
 end;
 Dec(PChar(p32), bm32.bmWidthBytes);
 end;
 h := ExtCreateRegion(NIL, SizeOf(TRgnDataHeader) +
 (SizeOf(TRect) * maxRects), pData^);
 Assert(h <> 0);
 if Result <> 0 then
 begin
 CombineRgn(Result, Result, h, RGN_OR);
 DeleteObject(h);
 end
 else
 Result := h;
 GlobalFree(hData);
 SelectObject(DC, holdBmp);
 DeleteDC(DC);
 DeleteObject(SelectObject(MemDC, holdMemBmp));
 end;
 end;
 DeleteDC(MemDC);
 end;
end;
procedure TFormScreen.FormCreate(Sender: TObject);
begin
 MyRegion := BitmapToRegion(imgFundo.Picture.Bitmap, imgFundo.Canvas.Pixels[0, 0]);
 SetWindowRgn(Handle, MyRegion, True);
end;
procedure TFormXXXXXX.FormCreate(Sender: TObject);
begin
 FormScreen.MyRegion := FormScreen.BitmapToRegion(imgFundo.Picture.Bitmap,
 imgFundo.Canvas.Pixels[0, 0]);
 SetWindowRgn(Handle, FormScreen.MyRegion, True);
end;
Source: http://delphiworld.narod.ru
ID: 03830
Category:Графика
Category:Bitmap
Category:WinAPI