По-моему функция из drkb
| Код |
function BitmapToRgn(Image: TBitmap): HRGN;
var
TmpRgn: HRGN;
x, y: Integer;
ConsecutivePixels: Integer;
CurrentPixel: TColor;
CreatedRgns: Integer;
CurrentColor: TColor;
begin
CreatedRgns := 0;
Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
Inc(CreatedRgns);
if (Image.Width = 0) or (Image.Height = 0) then
Exit;
for y := 0 to Image.Height - 1 do
begin
CurrentColor := Image.Canvas.Pixels[0, y];
ConsecutivePixels := 1;
for x := 0 to Image.Width - 1 do
begin
CurrentPixel := Image.Canvas.Pixels[x, y];
if CurrentColor = CurrentPixel then
Inc(ConsecutivePixels)
else
begin
// Входим в новую зону
if CurrentColor = clWhite then
begin
TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
Inc(CreatedRgns);
DeleteObject(TmpRgn);
end;
CurrentColor := CurrentPixel;
ConsecutivePixels := 1;
end;
end;
if (CurrentColor = clWhite) and (ConsecutivePixels > 0) then
begin
TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
Inc(CreatedRgns);
DeleteObject(TmpRgn);
end;
end;
end;
|
зы неплохо бы ее оптимизировать |
)
я уже переделаю