//再帖一个 系出同门
unit BMPLite;
{*******************************************************************************
一个简化的 BMP DDB 类，!!!!只能处理 32位色BMP!!!!
BMP 文件格式
[BMP 文件头]
[BMP 消息头]
[BMP Data]
Version: V1.0
Author: Redfox
CreateDate :2007-04-28
********************************************************************************}
interface
uses
Windows;
type
TBMPLite = class
private
m_lpLineBits
ointer;
function getScanLine(i: Integer): Pointer; // 指向一行的 DIBits 数据
public
m_fhi: BITMAPFILEHEADER;
m_bmi: PBitmapInfo; // 指向一个 BitmapInfo ,后面有调色板数据
m_hDc:HDC;
m_hBmp:HBITMAP;
m_Width:Integer;
m_Height:Integer;
m_LineSize:Integer; // 每一行的字节数
m_DataSize:Integer; // Bits 数据大小
m_hPal:HPALETTE; // 调色板
m_BmpInfoLen :Integer; // 信息头+调色板长度
constructor Create(w,h:Integer);
destructor Destroy;override;
procedure SaveToFile(fname:string);
property ScanLine[i:Integer]
ointer read getScanLine;
end;
implementation
{ TBMPLite }
constructor TBMPLite.Create(w, h: Integer);
var
hDeskDc:HDC;
w1:Integer; // 调整后的宽度，必须能被 4 整除
begin
inherited Create;
//m_BmpInfoLen := SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad)-4;
m_BmpInfoLen := SizeOf(TBitmapInfo) -4;
m_bmi := SysGetMem(m_BmpInfoLen);
m_Width := w;
m_Height := h;
w1 := w;
if (w1 mod 4) <> 0 then w1 := ((w1 shr 2) + 1) shl 2; // w1 :=( w1 div 4 +1) * 4;
m_LineSize := w1 *4;
m_DataSize := m_LineSize * h;
m_fhi.bfType := $4D42; // BM
m_fhi.bfSize := SizeOf(BitmapFileHeader) + m_BmpInfoLen + m_DataSize; // 文件大小
m_fhi.bfReserved1 := 0;
m_fhi.bfReserved2 := 0;
m_fhi.bfOffBits := SizeOf(TBitmapfileHeader) + m_BmpInfoLen;
m_bmi^.bmiHeader.biSize := SizeOf(TBitmapInfo) -4; // 由于 Delphi 的问题，最后一个0长度的数组被加了进去
m_bmi^.bmiHeader.biWidth := w;
m_bmi^.bmiHeader.biHeight := h;
m_bmi^.bmiHeader.biPlanes := 1; // 必须等于 1
m_bmi^.bmiHeader.biBitCount := 32; // BitsPerPixel = 8;
m_bmi^.bmiHeader.biCompression := BI_RGB; // 压缩方式，不压缩
m_bmi^.bmiHeader.biSizeImage := m_DataSize; // 位图数据大小， biWidth 必须 4 字节对齐
m_bmi^.bmiHeader.biXPelsPerMeter := 0;
m_bmi^.bmiHeader.biYPelsPerMeter := 0;
m_bmi^.bmiHeader.biClrUsed := 0; // 0 2^8
m_bmi^.bmiHeader.biClrImportant := 0;
hDeskDc := GetDC(0);
m_hDc := CreateCompatibleDC(hDeskDc);
{ 调色板 }
{
m_hPal := CreateHalftonePalette(hDeskDc);
GetPaletteEntries(m_hPal,0,256,Pointer(@m_bmi.bmiColors[0])^);
DeleteObject( SelectPalette(m_hDc,m_hPal,False));
RealizePalette(m_hDc);
}
//m_hBmp := CreateDIBSection(m_hDc,m_bmi^,DIB_PAL_COLORS, m_lpBits, 0,0);
m_hBmp := CreateCompatibleBitmap(hDeskDc,w, h);
SelectObject(m_hDc,m_hBmp);
//SetDIBColorTable(m_hDc,0,256,Pointer(@m_bmi.bmiColors[0])^);
ReleaseDC(0,hDeskDc);
m_lpLineBits := SysGetMem(m_LineSize);
end;
destructor TBMPLite.Destroy;
begin
SysFreeMem(m_bmi);
if m_lpLineBits <> nil then
SysFreeMem(m_lpLineBits);
DeleteObject(m_hBmp);
DeleteDC(m_hDc);
inherited;
end;
function TBMPLite.getScanLine(i: Integer): Pointer;
begin
Result := nil;
if GetDIBits(m_hDc, m_hBmp, m_Height- i-1,1,m_lpLineBits,m_bmi^,DIB_RGB_COLORS) <> 0 then
Result := m_lpLineBits;
end;
procedure TBMPLite.SaveToFile(fname: string);
var
hFile: THandle;
lpData
ointer;
i
WORD;
n
WORD;
begin
//lpData := SysGetMem(m_DataSize);
//i := GetDIBits(m_hDc, m_hBmp, 0,m_Height,lpData,m_bmi^,DIB_RGB_COLORS);
//i := GetLastError;
hFile:=CreateFile(PChar(fname),GENERIC_WRITE,0,nil,CREATE_ALWAYS,0,0);
WriteFile(hFile,m_fhi,SizeOf(BitmapFileHeader),i,nil);
WriteFile(hFile,m_bmi^,m_BmpInfoLen,i,nil);
for i := m_Height-1 downto 0 do
begin
lpData := Self.ScanLine
;
WriteFile(hFile,lpData^,m_LineSize,n,nil);
end;
//WriteFile(hFile,lpData^,m_DataSize,i,nil);
CloseHandle(hFile);
//SysFreeMem(lpData);
end;
end.