function SaveBitmapToFile(HBM: HBitmap;BitCount: word):
string;
const
BMType = $4D42;
type
TBitmap =
record
bmType: Integer;
bmWidth: Integer;
bmHeight: Integer;
bmWidthBytes: Integer;
bmPlanes: Byte;
bmBitsPixel: Byte;
bmBits: Pointer;
end;
var
BM: TBitmap;
BFH: TBitmapFileHeader;
BIP: PBitmapInfo;
DC: HDC;
HMem: THandle;
Buf: Pointer;
ColorSize, DataSize: Longint;
stream: tmemorystream;
function AlignDouble(Size: Longint): Longint;
begin
Result := (Size + 31)
div 32 * 4;
end;
begin
if GetObject(HBM, SizeOf(TBitmap), @BM) = 0
then Exit;
//BitCount := 4;
if (BitCount <> 24)
then ColorSize := SizeOf(TRGBQuad) * (1
shl BitCount)
else ColorSize := 0;
DataSize := AlignDouble(bm.bmWidth * BitCount) * bm.bmHeight;
GetMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
if BIP <>
nil then begin
with BIP^.bmiHeader
do begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := bm.bmWidth;
biHeight := bm.bmHeight;
biPlanes := 1;
biBitCount := BitCount;
biCompression := 0;
biSizeImage := DataSize;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
with BFH
do begin
bfOffBits := SizeOf(BFH) + SizeOf(TBitmapInfo) + ColorSize;
bfReserved1 := 0;
bfReserved2 := 0;
bfSize := longint(bfOffBits) + DataSize;
bfType := BMType;
end;
HMem := GlobalAlloc(gmem_Fixed, DataSize);
if HMem <> 0
then begin
Buf := GlobalLock(HMem);
DC := GetDC(0);
if GetDIBits(
DC, hbm, 0, bm.bmHeight,Buf, BIP^, dib_RGB_Colors) <> 0
then begin
Stream := TMemoryStream.Create;
Stream.WriteBuffer(BFH, SizeOf(BFH));
Stream.WriteBuffer(PChar(BIP)^, SizeOf(TBitmapInfo) + ColorSize);
Stream.WriteBuffer(Buf^, DataSize);
SetString(Result, PChar(Stream.Memory), Stream.Size);
stream.Free;
end;
ReleaseDC(0,
DC);
GlobalUnlock(HMem);
GlobalFree(HMem);
end;
end;
FreeMem(BIP, SizeOf(TBitmapInfoHeader) + ColorSize);
DeleteObject(HBM);
end;