[reqyz]

Сообщение от angvelem

Как то писал для подобных случаев

Код:

procedure SaveBitmap(Name : String; bmp : HBITMAP);
var
  FileHandle	: THandle;
  Size, Res,
  HeaderSize	: DWORD;
  BFH		: TBITMAPFILEHEADER;
  BIH		: TBITMAPINFOHEADER;
  FDIB		: TDIBSection;

  function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
  begin
    dec(Alignment);
    Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result div 8;
  end;

  procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
  var
    DS		: TDIBSection;
    Bytes	: Integer;
  begin
    DS.dsbmih.biSize := 0;
    Bytes := GetObject(Bitmap, SizeOf(DS), @DS);
    if (Bytes >= (SizeOf(DS.dsbm) + SizeOf(DS.dsbmih))) and (DS.dsbmih.biSize >= SizeOf(DS.dsbmih)) then
      BI := DS.dsbmih
    else
    begin
      FillChar(BI, SizeOf(BI), 0);
      with BI, DS.dsbm do
      begin
	biSize   := SizeOf(BI);
	biWidth  := bmWidth;
	biHeight := bmHeight;
      end;
    end;
    BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;
    BI.biPlanes   := 1;
    if BI.biSizeImage = 0 then
      BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);
  end;

begin
  GetObject(bmp, SizeOf(FDIB), @FDIB);
  with FDIB, dsbm, dsbmih do
  begin
    biSize     := sizeof(dsbmih);
    biWidth    := bmWidth;
    biHeight   := bmHeight;
    biPlanes   := 1;
    biBitCount := bmPlanes * bmBitsPixel;
  end;
  
  InitializeBitmapInfoHeader(Bmp, BIH);
  HeaderSize := SizeOf(TBitmapInfoHeader);
  Size := BIH.biSizeImage;
  inc(Size, HeaderSize + SizeOf(BFH));

  FillChar(BFH, SizeOf(BFH), 0);
  BFH.bfType    := $4D42;
  BFH.bfSize    := Size;
  BFH.bfOffBits := SizeOf(BFH) + HeaderSize;

  FileHandle := CreateFile(PChar(Name + '.bmp'), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  WriteFile(FileHandle, BfH, SizeOf(BFH), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbmih, SizeOf(FDIB.dsbmih), Res, NIL);
  WriteFile(FileHandle, FDIB.dsbm.bmBits^, FDIB.dsbmih.biSizeImage, Res, NIL);
  CloseHandle(FileHandle);
end;

Рассчитпно на 24-битный битмап.

Спасибо) только не работает

получаю HBitmap таким способом:

Код:

function GetDesktopBitmap: HBitmap;
var
 DC, MemDC: HDC;
 Bitmap, OBitmap: HBitmap;
 BitmapWidth, BitmapHeight: integer;
begin
 DC := GetDC(GetDesktopWindow);
 MemDC := CreateCompatibleDC(DC);
 BitmapWidth := GetDeviceCaps(DC, HORZRES);
 BitmapHeight := GetDeviceCaps(DC, VERTRES);

 Bitmap := CreateCompatibleBitmap(DC, BitmapWidth, BitmapHeight);
 OBitmap := SelectObject(MemDC, Bitmap);
 BitBlt(MemDC, 0, 0, BitmapWidth, BitmapHeight, DC, 0, 0, SRCCOPY);
 SelectObject(MemDC, OBitmap);
 DeleteDC(MemDC);
 ReleaseDC(GetDesktopWindow, DC);
 Result := Bitmap;
end;

вызываю всё так:

Код:

    SaveBitmap(SaveDialog1.FileName,GetDesktopBitmap);

в итоге получаю пустой файл( что тут не так? где ошибка?