Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: Bitmap2Region not working in XE6 VCL


This question is answered. Helpful answers available: 1. Correct answers available: 1.


Permlink Replies: 1 - Last Post: May 2, 2016 10:11 AM Last Post By: Remy Lebeau (Te...
Bob Spencer

Posts: 26
Registered: 7/4/02
Bitmap2Region not working in XE6 VCL  
Click to report abuse...   Click to reply to this thread Reply
  Posted: May 1, 2016 10:15 PM
Hi
I have used a function in my projects for years but recently needed to use it after upgrading from Delphi 7 to XE6.

Can anyone give me a clue why this isn't working anymore?
I have systematically narrowed it down to the line "b := GetBValue(p^);" but cant tell why its now changed.
Hopefully one of you has already solved this or can help.

I've attached the total code below.

function Bitmap2Region(hBmp: tbitmap; TransColor: tcolor;
Tolerance: 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, LR, LG, LB, HR, HG, HB: byte;
p32: pByte;
x, x0, y: integer;
p: pLongInt;
pr: PRect;
h: hrgn;
begin
Result := 0;
if hBmp <> nil then
begin
{ Create a memory DC inside which we will scan the bitmap contents }
MemDC := CreateCompatibleDC(0);
if MemDC <> 0 then
begin
{ Create a 32 bits depth bitmap and select it into the memory DC }
with BitmapInfo.bmiHeader do
begin
biSize := sizeof(TBitmapInfoHeader);
biWidth := hBmp.Width;
biHeight := hBmp.Height;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB; { (0) uncompressed format }
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);
{
Get how many bytes per row we have for the bitmap bits
(rounded up to 32 bits)
}
GetObject(hbm32, sizeof(bm32), @bm32);
while (bm32.bmWidthBytes mod 4) > 0 do
inc(bm32.bmWidthBytes);
DC := CreateCompatibleDC(MemDC);
{ Copy the bitmap into the memory DC }
holdBmp := SelectObject(DC, hBmp.Handle);
BitBlt(MemDC, 0, 0, hBmp.Width, hBmp.Height, DC, 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(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);
{ Keep on hand highest and lowest values for the "transparent" pixel }
LR := GetRValue(ColorToRGB(TransColor));
LG := GetGValue(ColorToRGB(TransColor));
LB := GetBValue(ColorToRGB(TransColor));
{ Add the value of the tolerance to the "transparent" pixel value }
HR := MinByte($FF, LR + GetRValue(ColorToRGB(Tolerance)));
HG := MinByte($FF, LG + GetGValue(ColorToRGB(Tolerance)));
HB := MinByte($FF, LB + GetBValue(ColorToRGB(Tolerance)));
{
Scan each bitmap row from bottom to top,
the bitmap is inverted vertically
}
p32 := bm32.bmBits;
inc(PChar(p32), (bm32.bmHeight - 1) * bm32.bmWidthBytes);
for y := 0 to hBmp.Height - 1 do
begin
{ Scan each bitmap pixel from left to right }
x := -1;
while x + 1 < hBmp.Width do
begin
inc(x);
{ Search for a continuous range of "non transparent pixels" }
x0 := x;
p := pLongInt(p32);
inc(PChar(p), x * sizeof(LongInt));
while x < hBmp.Width do
begin

//---------PROBLEM AREA
b := GetBValue(p^); // Changed from GetRValue(p^)
if (b >= LR) and (b <= HR) then
begin
b := GetGValue(p^); // Left alone
if (b >= LG) and (b <= HG) then
begin
b := GetRValue(p^); // Changed from GetBValue(p^)
if (b >= LB) and (b <= HB) then
// This pixel is "transparent"
break;
end;
end;

//----------END OF PROBLEM AREA

inc(PChar(p), sizeof(LongInt));
inc(x);
end;
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);
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);
{
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(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;
{
Go to next row (remember, the bitmap is inverted vertically)
that is why we use DEC!
}
Dec(PChar(p32), bm32.bmWidthBytes);
end;
{ Create or extend the region with the remaining rectangle }
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;
{ Clean up }
GlobalFree(hData);
SelectObject(DC, holdBmp);
DeleteDC(DC);
DeleteObject(SelectObject(MemDC, holdMemBmp));
end;
end;
DeleteDC(MemDC);
end;
end;

Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Bitmap2Region not working in XE6 VCL
Helpful
Click to report abuse...   Click to reply to this thread Reply
  Posted: May 2, 2016 10:11 AM   in response to: Bob Spencer in response to: Bob Spencer
Bob wrote:

I have used a function in my projects for years but recently
needed to use it after upgrading from Delphi 7 to XE6.
Can anyone give me a clue why this isn't working anymore?

There are some PChar pointers being used in your code. PChar was an alias
for PAnsiChar in Delphi 7, but is an alias for PWideChar in D2009+. Change
your code to use PAnsiChar explicitly, or better PByte, instead of PChar.

--
Remy Lebeau (TeamB)
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02