Mega Code Archive
Make a form transparent after a bitmap
<![CDATA[
Title: Make a form transparent after a bitmap
Question: I wanted to shape a form after an image.
Answer:
unit ubmp2rgn;
{
I found this routine at http://www.codeguru.com. The only
problem with this routine is that was written in C. So
I ported the routine for use in Delphi.
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics; //, Controls, Forms, Dialogs;
type BITMAP = record
bmType : integer;
bmWidth : integer;
bmHeight : integer;
bmWidthBytes : integer;
bmPlanes : Word;
bmBitsPixel : Word;
bmBits : pointer;
end;
TRectArray = Array[0..0] of TRect;
PRect = ^TRectArray;
//
// BitmapToRegion : Create a region from the "non-transparent" pixels of a bitmap
// Author : Jean-Edouard Lachand-Robert (http://www.geocities.com/Paris/LeftBank/1160/resume.htm), June 1998.
//
// hBmp : Source bitmap
// cTransparentColor : Color base for the "transparent" pixels (default is black)
// cTolerance : Color tolerance for the "transparent" pixels.
//
// A pixel is assumed to be transparent if the value of each of its 3 components (blue, green and red) is
// greater or equal to the corresponding value in cTransparentColor and is lower or equal to the
// corresponding value in cTransparentColor + cTolerance.
// HRGN BitmapToRegion (HBITMAP hBmp, COLORREF cTransparentColor = 0, COLORREF cTolerance = 0x101010)
//
function PascalBitmapToRegion(hBmp : HBITMAP; cTransparentColor : COLORREF; cTolerance : COLORREF) : HRGN;
implementation
function min(i1, i2 : integer) : integer;
begin
if (i1 result := i1
else if (i2 result := i2
else
result := i1;
end;
function PascalBitmapToRegion(hBmp : HBITMAP; cTransparentColor : COLORREF; cTolerance : COLORREF) : HRGN;
var
hRegion : HRGN;
hMemDC : HDC;
bm : Bitmap;
RGB32BITSBITMAPINFO : TBITMAPINFOHEADER;
BITMAPINFO : TBitmapInfo;
hOldBmp1 : HBITMAP;
hOldBmp2 : HBITMAP;
hDC1 : HDC;
hBM32 : HBITMAP;
bm32 : Bitmap;
pbits32 : pointer;
maxRects : dword;
hData : THandle;
pData : ^TRGNDATA;
lr : Byte;
lg : Byte;
lb : Byte;
hr : Byte;
hg : Byte;
hb : Byte;
p32 : ^Byte;
x,
y : integer;
x0 : integer;
p : ^longint;
b : Byte;
pr : PRect;
h : HRGN;
const
ALLOC_UNIT = 100;
begin
hRegion := 0;
if (hBMP 0) then
begin
hMemDC := CreateCompatibleDC(0);
if (hMemDC 0) then
begin
GetObject(hBMP, sizeof(bm), Addr(bm));
with RGB32BITSBITMAPINFO do
begin
biSize := sizeof(TBITMAPINFOHEADER);
biWidth := bm.bmWidth;
biHeight := bm.bmHeight;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
biSizeImage := 0;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
bitmapinfo.bmiHeader := RGB32BITSBITMAPINFO;
hbm32 := CreateDIBSection(hMemDC, BITMAPINFO, DIB_RGB_COLORS, pbits32, 0, 0);
if (hbm32 0) then
begin
holdBmp1 := HBITMAP(SelectObject(hMemDC, hbm32));
// Create a DC just to copy the bitmap into the memory DC
hDC1 := CreateCompatibleDC(hMemDC);
if (hDC1 0) then
begin
// Get how many bytes per row we have for the bitmap bits (rounded up to 32 bits)
GetObject(hbm32, sizeof(bm32), addr(bm32));
while ((bm32.bmWidthBytes mod 4) 0) do
begin
inc(bm32.bmWidthBytes);
end;
// Copy the bitmap into the memory DC
holdBmp2 := HBITMAP(SelectObject(hDC1, hBmp));
BitBlt(hMemDC, 0, 0, bm.bmWidth, bm.bmHeight, hDC1, 0, 0, SRCCOPY);
// For better performances, we will use the ExtCreateRegion() function to create the
// region. This function take a RGNDATA structure on entry. We will add rectangles by
// amount of ALLOC_UNIT number in this structure.
maxRects := ALLOC_UNIT;
hData := GlobalAlloc(GMEM_MOVEABLE, sizeof(TRGNDATAHEADER) + (sizeof(RECT) * 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, MAXLONG, MAXLONG, 0, 0);
// Keep on hand highest and lowest values for the "transparent" pixels
lr := GetRValue(cTransparentColor);
lg := GetGValue(cTransparentColor);
lb := GetBValue(cTransparentColor);
hr := min($ff, lr + GetRValue(cTolerance));
hg := min($ff, lg + GetGValue(cTolerance));
hb := min($ff, lb + GetBValue(cTolerance));
// Scan each bitmap row from bottom to top (the bitmap is inverted vertically)
{TRICKY!!!}
p32 := ptr(integer(addr(bm32.bmBits^)) + ((bm32.bmHeight - 1) * bm32.bmWidthBytes));
for y := 0 to (bm.bmHeight-1) do
begin
// Scan each bitmap pixel from left to right
x := 0;
while (x begin
// Search for a continuous range of "non transparent pixels"
x0 := x;
p := ptr(integer(addr(p32^)) + (x*4)); // + x
while (x begin
b := GetRValue(p^);
if (b = lr) and (b begin
b := GetGValue(p^);
if (b = lg) and (b begin
b := GetBValue(p^);
if (b = lb) and (b // This pixel is "transparent"
break;
end; {if (b = lg) and (b end; {if (b = lr) and (b p := ptr(integer(addr(p^)) + 4); // + 1 // p++;
inc(x);
end; {while (x if (x x0) then
begin
// Add the pixels (x0, y) to (x, y+1) as a new rectangle in the region
if (pData^.rdh.nCount = maxRects) then
begin
GlobalUnlock(hData);
maxRects := maxRects + ALLOC_UNIT;
hData := GlobalReAlloc(hData, sizeof(TRGNDATAHEADER) + (sizeof(RECT) * maxRects), GMEM_MOVEABLE);
pData := GlobalLock(hData);
end; {if (pData^.rdh.nCount = maxRects)}
pr := Addr(pData^.Buffer);
{TRICKY!!!} SetRect(pr^[pData^.rdh.nCount], x0, y, x, y+1);
if (x0 pData^.rdh.rcBound.left := x0;
if (y pData^.rdh.rcBound.top := y;
if (x pData^.rdh.rcBound.right) then
pData^.rdh.rcBound.right := x;
if ((y+1) pData^.rdh.rcBound.bottom) then
pData^.rdh.rcBound.bottom := y+1;
inc(pData^.rdh.nCount);
// On Windows98, ExtCreateRegion() may fail if the number of rectangles is too
// large (ie: 4000). Therefore, we have to create the region by multiple steps.
if (pData^.rdh.nCount = 2000) then
begin
h := ExtCreateRegion(nil, sizeof(TRGNDATAHEADER) + (sizeof(RECT) * maxRects), pData^);
if (hRegion 0) then
begin
CombineRgn(hRegion, hRegion, h, RGN_OR);
DeleteObject(h);
end {if (hRgn 0)}
else
hRegion := h;
pData^.rdh.nCount := 0;
SetRect(pData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
end; {if (pData^.rdh.nCount = 2000)}
end; {if (x x0)}
inc(x);
end; {while (x // Go to next row (remember, the bitmap is inverted vertically)
{TRICKY!!!} p32 := ptr(integer(addr(p32^))- bm32.bmWidthBytes);
end; {for y := 0 to (bm.bmHeight-1)}
// Create or extend the region with the remaining rectangles
h := ExtCreateRegion(nil, sizeof(TRGNDATAHEADER) + (sizeof(RECT) * maxRects), pData^);
if (hRegion 0) then
begin
CombineRgn(hRegion, hRegion, h, RGN_OR);
DeleteObject(h);
end {if (hRegion 0)}
else
hRegion := h;
// Clean up
SelectObject(hDC1, holdBmp2);
DeleteDC(hDC1);
end; {if (hDC1 0)}
DeleteObject(SelectObject(hMemDC, holdBmp1));
end; {if (hbm32 0)}
DeleteDC(hMemDC);
end; {if (hMemDC 0)}
end; {if (hBMP 0)}
result := hRegion;
end;
end.
]]>