Wie Bitmap per API erstellen und speichern

[Zacherl]

Hey,

ich habe eine Funktion, mit der ich einen Screenshot des kompletten Desktops erstellen kann:

Delphi-Quellcode:

procedure TScreenCaptureThread.CreateBitmapScreenShot(Bitmap: TBitmap;
  Format: TPixelFormat; Ratio: TResolutionRatio);
var
  C: TCanvas;
  R: TRect;
  Width, Height: Integer;
  B: TBitmap;
begin
  C := TCanvas.Create;
  C.Handle := GetWindowDC(GetDesktopWindow);
  try
    Width := GetSystemMetrics(SM_CXSCREEN);
    Height := GetSystemMetrics(SM_CYSCREEN);
    R := Rect(0, 0, Width, Height);
    if (Ratio = 100) then
    begin
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      Bitmap.PixelFormat := Format;
      Bitmap.Canvas.CopyRect(R, C, R);
    end else
    begin
      B := TBitmap.Create;
      try
        B.Width := Width;
        B.Height := Height;
        B.PixelFormat := Format;
        B.Canvas.CopyRect(R, C, R);
        Bitmap.Width := Round(Width * 0.01 * Ratio);
        Bitmap.Height := Round(Height * 0.01 * Ratio);
        Bitmap.PixelFormat := Format;
        Bitmap.Canvas.StretchDraw(Rect(0, 0, Bitmap.Width, Bitmap.Height), B);
      finally
        B.Free;
      end;
    end;
  finally
    ReleaseDC(0, C.Handle);
    C.Free;
  end;
end;

Jetzt will ich allerdings gerne auf die Graphics.pas Unit verzichten und kann daher auch nicht mehr die Klassen TCanvas und TBitmap verwenden. Meine Frage jezt:
Welche Windows APIs benötige ich, um die Screenshot Funktion ohne die Delphi RTL nachzubilden?
Und ganz wichtig: Wie kann ich das so erstellte Bitmap dann in einer Datei oder einem Buffer speichern?

Viele Grüße
Zacherl

[SirThornberry]

Bei deiner Delphiversion sollten eigentlich die Quellcodes dabei sein. Hast du dir diese mal angesehen?

[Zacherl]

Zitat von SirThornberry:

Bei deiner Delphiversion sollten eigentlich die Quellcodes dabei sein. Hast du dir diese mal angesehen?

Habe mir die Graphics.pas mal angeschaut, aber aufgrund der enormen Größe dauert es bestimmt eine Woche, bis ich da alles durchgelesen habe

Denke mal die Sache ist mit höchstens 10 APIs gelöst, bloß kenne ich mich im GDI Bereich absolut nicht aus, deshalb hoffe ich darauf, dass mir jemand grade die API Namen + Reihenfolge oder kurzer beschreibung posten könnte. Den Rest mach ich dann per MSDN und ausprobieren.

[SirThornberry]

Ich kenne die Befehle auch nicht auswendig. Es ist aber definitiv nicht nötig die gesamte Graphics.pas anzuschauen. Einfach nur das anschauen was du in der VCL auch nutzt. Wenn du zum Beispiel Bitmap.width setzt schaust du einfach nach was die set-Methode von width des Bitmaps macht.

Anstelle der Methode TCanvas.StretchDraw ist die Api StretchBlt ganz ok.
Und TCanvas.CopyRecht ist durch BitBlt ersetzbar.

[DeddyH]

Evtl. ist der MSDN-Artikel zu CreateBitmap hilfreich. Im ersten Link ist auch ein Beispiel in C++ (das scheint zwar für Windows CE zu sein, macht aber nichts).

[blackfin]

Das hier könnte dir vielleicht auch helfen:

http://www.winprog.org/tutorial/bitmaps.html

[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