uses
Windows, Graphics, SysUtils;
type
TByteArray =
array of Byte;
procedure CreateMonochromeBitmapWithCopyMemory(
const ByteArray: TByteArray; Width, Height: Integer);
var
Bitmap: HBITMAP;
DC: HDC;
Bits: Pointer;
BitmapInfo: TBitmapInfo;
RowBytes: Integer;
begin
// Bitmap-Info initialisieren
ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
with BitmapInfo.bmiHeader
do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := Width;
biHeight := -Height;
// Top-Down
biPlanes := 1;
biBitCount := 1;
// 1-Bit Farbtiefe (monochrom)
biCompression := BI_RGB;
end;
// Device Context erstellen
DC := GetDC(0);
try
// DIB-Section erstellen
Bitmap := CreateDIBSection(
DC, BitmapInfo, DIB_RGB_COLORS, Bits, 0, 0);
if Bitmap = 0
then
raise Exception.Create('
CreateDIBSection fehlgeschlagen');
// Breite der Bitmap-Zeile in Bytes (jedes Bit repräsentiert einen Pixel)
RowBytes := ((Width + 31)
div 32) * 4;
// Pixelarray kopieren
CopyMemory(Bits, @ByteArray[0], Min(Length(ByteArray), RowBytes * Height));
// Das Bitmap weiterverarbeiten (z.B. in eine TBitmap laden)
with TBitmap.Create
do
try
Handle := Bitmap;
SaveToFile('
MonochromeBitmapWithCopyMemory.bmp');
// Speichern des Bitmaps als Datei
finally
Free;
end;
finally
ReleaseDC(0,
DC);
end;
end;