Wie Bitmap per API erstellen und speichern

[Zacherl]

Danke ich habe es nun hinbekommen ein Bitmap zu erstellen und zu speichern. Ein Problem gibt es allerdings noch, wenn ich bei der Farbtiefe auf unter 16 Bits gehe. Dann kann das Bild gespeicherte Bild nicht dargstellt werden und im Hexeditor sieht das Farbarray auch komplett anders aus.

Delphi-Quellcode:

function PixelFormatToBitCount(Format: TPixelFormat): Integer;
begin
  Result := 0;
  case Format of
    pf1bit:  Result := 1;
    pf4bit:  Result := 4;
    pf8bit:  Result := 8;
    pf15bit: Result := 15;
    pf16bit: Result := 16;
    pf24bit: Result := 24;
    pf32bit: Result := 32;
  end;
end;

procedure CreateBitmap(var BitmapDC: HDC; var Bitmap: HBITMAP;
  var BitmapMemory: Pointer; Width, Height: Integer; Format: TPixelFormat);
var
  BMI: BITMAPINFO;
begin
  BitmapDC := CreateCompatibleDC(0);
  with BMI do
  begin
    bmiHeader.biSize := SizeOF(bmi.bmiHeader);
    bmiHeader.biWidth := Width;
    bmiHeader.biHeight := Height;
    bmiHeader.biPlanes := 1;
    bmiHeader.biBitCount := PixelFormatToBitCount(Format);
    bmiHeader.biCompression := BI_RGB;
    bmiHeader.biSizeImage := 0;
    bmiHeader.biXPelsPerMeter := 0;
    bmiHeader.biYPelsPerMeter := 0;
    bmiHeader.biClrUsed := 0;
    bmiHeader.biClrImportant := 0;
  end;
  Bitmap := CreateDIBSection(BitmapDC, BMI, DIB_RGB_COLORS, BitmapMemory, 0, 0);
  SelectObject(BitmapDC, Bitmap);
end;

procedure DeleteBitmap(BitmapDC: HDC; Bitmap: HBITMAP);
begin
  DeleteDC(BitmapDC);
  DeleteObject(Bitmap);
end;

function CalculateImageSize(BitmapInfoX: BITMAPINFOHEADER): Cardinal;
begin
  Result := Round((BitmapInfoX.biBitCount / 8) * BitmapInfoX.biWidth *
    BitmapInfoX.biHeight);
end;

procedure CreateBitmapScreenShot(Format: TPixelFormat; Ratio: TResolutionRatio);
var
  C: HDC;
  NormalWidth, NormalHeight,
  RatioWidth, RatioHeight: Integer;
  BitmapDC: HDC;
  Bitmap: HBITMAP;
  BitmapMemory: Pointer;
  BitmapInfoX: BITMAPINFOHEADER;
  BitmapHeader: BITMAPFILEHEADER;
  hFile: THandle;
  dwWritten: DWord;
begin
  C := GetWindowDC(GetDesktopWindow);
  try
    NormalWidth := GetSystemMetrics(SM_CXSCREEN);
    NormalHeight := GetSystemMetrics(SM_CYSCREEN);
    RatioWidth := Round(NormalWidth * 0.01 * Ratio);
    RatioHeight := Round(NormalHeight * 0.01 * Ratio);

    CreateBitmap(C, BitmapDC, Bitmap, BitmapMemory, RatioWidth, RatioHeight, Format);
    if (Bitmap <> 0) then
    try
      StretchBlt(BitmapDC, 0, 0, RatioWidth, RatioHeight, C, 0, 0, NormalWidth,
        NormalHeight, SRCCOPY);

      FillChar(BitmapInfoX, SizeOf(BITMAPINFOHEADER), #0);
      BitmapInfoX.biSize := SizeOf(BITMAPINFOHEADER);
      BitmapInfoX.biWidth := RatioWidth;
      BitmapInfoX.biHeight := RatioHeight;
      BitmapInfoX.biPlanes := 1;
      BitmapInfoX.biBitCount := PixelFormatToBitCount(Format);
      BitmapInfoX.biCompression := BI_RGB;
      BitmapInfoX.biSizeImage := CalculateImageSize(BitmapInfoX);
      FillChar(BitmapHeader, SizeOf(BITMAPFILEHEADER), #0);
      BitmapHeader.bfType := $4D42;
      BitmapHeader.bfOffBits := SizeOf(BITMAPINFOHEADER) + SizeOf(BITMAPFILEHEADER);
      BitmapHeader.bfSize := BitmapHeader.bfOffBits + BitmapInfoX.biSizeImage;
      hFile := CreateFile('C:\test.bmp', GENERIC_WRITE, FILE_SHARE_READ, nil,
        CREATE_ALWAYS, 0, 0);
      WriteFile(hFile, BitmapHeader, SizeOf(BITMAPFILEHEADER), dwWritten, nil);
      WriteFile(hFile, BitmapInfoX, SizeOf(BITMAPINFOHEADER), dwWritten, nil);
      WriteFile(hFile, BitmapMemory^, BitmapInfoX.biSizeImage, dwWritten, nil);
      CloseHandle(hFile);
    finally
      DeleteBitmap(BitmapDC, Bitmap);
    end;
  finally
    ReleaseDC(0, C);
  end;
end;

Muss ich für Farbtiefen unter 16 bit eventuell etwas an der Farbpalette anpassen oder so?

Viele Grüße
Zacherl