Работа с CreateDIBSection

← →
McFalu © (2006-09-29 19:16) [0]

У меня проблема. При многократном вызове функции CreateDIBSection программа выдает ошибку Floatin point division by zero. В нете почитал, что CreateDIBSection не опустошает память выделенной под нее.
Что можете подсказать?

← →
X9 © (2006-09-30 12:45) [1]

Приведите код использования, без этого сказать что-либо трудно.

function PNGtoIcon( str : string;
ACursor : Boolean = false;
AHotSpotX : Integer = 0;
AHotSpotY : Integer = 0) : HICON;
var
APNG : TPNGObject;
Width, Height : Integer;
BitmapHeader : PBitmapV5Header;
hNewBitmap, hMonoBitmap : HBITMAP;
Bits : Pointer;
x, y : Integer;
DC : HDC;
IconInfo : _ICONINFO;
Pixel : ^Integer;
ScanLine : PRGBTriple;
AlphaScanline : pByteArray;
begin

APNG := TPNGObject.Create;
APNG.LoadFromFile(str);

Width := APNG.Width;
Height := APNG.Height;

New(BitmapHeader);
BitmapHeader.bV5Size := sizeof(BITMAPV5HEADER);
BitmapHeader.bV5Width := Width;
BitmapHeader.bV5Height := -Height;
BitmapHeader.bV5Planes := 1;
BitmapHeader.bV5BitCount := 32;
BitmapHeader.bV5Compression := BI_BITFIELDS;
BitmapHeader.bV5RedMask := $00FF0000;
BitmapHeader.bV5GreenMask := $0000FF00;
BitmapHeader.bV5BlueMask := $000000FF;
BitmapHeader.bV5AlphaMask := $FF000000;

DC := GetDC(0);
// Вот в этом месте при многократном вызове в программе и выводить ошибку
hNewBitmap := CreateDIBSection( DC,PBitmapInfo(BitmapHeader)^, DIB_RGB_COLORS,Bits,0,0);
Dispose(BitmapHeader);
ReleaseDC(0,dc);
hMonoBitmap:=CreateBitmap(Width,Height,1,1,nil);

Pixel := Bits;
for y := 0 to Height-1 do
begin
ScanLine := APNG.Scanline[y];
AlphaScanline := APNG.AlphaScanline[y];
for x := 0 to Width - 1 do
begin

Pixel^ := AlphaScanLine[x];
Pixel^ := Pixel^ shl 8;
Inc(Pixel^, Scanline^.rgbtRed);
Pixel^ := Pixel^ shl 8;
Inc(Pixel^, Scanline^.rgbtGreen);
Pixel^ := Pixel^ shl 8;

Inc(Pixel^, Scanline^.rgbtBlue);
Inc(Pixel);
Inc(ScanLine);
end;
end;

IconInfo.fIcon := not ACursor;
if ACursor then
begin

IconInfo.xHotspot := AHotSpotX;
IconInfo.yHotspot := AHotSpotY;
end;

IconInfo.hbmMask := hMonoBitmap;
IconInfo.hbmColor := hNewBitmap;
Result := CreateIconIndirect(IconInfo);
DeleteObject(hNewBitmap);
DeleteObject(hMonoBitmap);

APNG.Free;
end;

Работа с CreateDIBSection Найти похожие ветки