Сохранение Bitmap из буфера обмена(Clipboard) в файл

← →
Alexis © (2004-08-21 19:21) [0]

Делаю снимок экрана в Clipboard так :
ClipHandle : Cardinal;

keybd_event(VK_SNAPSHOT, 0, 0, 0);
ClipHandle := GetClipboardData(CF_BITMAP);

А что потом делать с полученным handle, чтобы сохранить изображение в bmp файл?
Заранее спасибо.

← →
Dimaxx (2004-08-21 23:18) [1]

А не проще ли сделать это через BitBlt и сразу кинуть в TBitmap?

← →
Alexis © (2004-08-22 11:21) [2]

2 Dimaxx - может и проще, но я не подключаю к проекту Graphics по причине увеличения размера.
Может ли кто нибудь помочь по первоначальному вопросу?

← →
Alexis © (2004-08-29 12:45) [3]

Ну вот, что я попытался написать, но все равно не работает :(

var
lpvObject : ^BITMAP;
hbm : HBITMAP;
FileH, ObjectSize : Integer;

begin
keybd_event(VK_SNAPSHOT, 0, 0, 0); //Capture all screen
if OpenClipboard(0) then
begin
hbm := HBITMAP(GetClipboardData(CF_BITMAP));
GetMem(lpvObject, sizeof(BITMAP));
ObjectSize := GetObject(hbm, sizeof(BITMAP), lpvObject);
showmessage(IntToStr(ObjectSize));
FileH := FileCreate("ScreenShot.bmp");
if FileH <> -1 then
begin
FileWrite(FileH, lpvObject^, ObjectSize);
FileClose(FileH);
end;

CloseClipboard();
end;
end.

showmessage показывает полученный GetObject"ом размер 24 байта, хотя ясно, что bmp"шник в ClipBoard занимает гораздо больше.

Буду очень благодарен за помощь!

← →
KSergey © (2004-08-29 14:04) [4]

Ты же сам сказал "буфер у меня на 24 байта"
Ф-ция честно вернула тебе 24 байта.
Это не имеет никакого отношения к размеру картинки.

> [2] Alexis © (22.08.04 11:21)
> 2 Dimaxx - может и проще, но я не подключаю к проекту Graphics
> по причине увеличения размера.

Заняться тебе просто нефигом... Ну и чатай сам книжки.. Там все написано...
Не, ну раз хочешь что-то познать - похвально, но тогда и прорывайся без подпорок!

← →
Alexis © (2004-08-31 17:38) [5]

> Ты же сам сказал "буфер у меня на 24 байта"
> Ф-ция честно вернула тебе 24 байта.

Где ты такое увидел? Я по-моему такого не говорил.

← →
Cobalt © (2004-08-31 22:13) [6]

2 Alexis © (31.08.04 17:38) [5]
ShowMessage(IntToStr(sizeof(BITMAP)));

← →
enel © (2004-08-31 23:41) [7]

Можно проще:
procedure TMainForm.SaveScreenInFile; var Dest: TRect; Desk: TCanvas; Bmp: TBitmap; begin Dest:= Rect(0, 0, Screen.Width, Screen.Height); Bmp:= TBitmap.Create; Bmp.Width:= Screen.Width; Bmp.Height:= Screen.Height; Desk:= TCanvas.Create; Desk.Handle:= GetDC(HWND_DESKTOP); bmp.Canvas.CopyRect(Dest, Desk, Dest); bmp.SaveToFile(ExtractFilePath(Application.ExeName) + "FileName.bmp"); ReleaseDC(Desk.Handle, HWND_DESKTOP); Bmp.Free; Desk.Free; end;

← →
enel © (2004-08-31 23:49) [8]

А тебе нужно сохранить в формате BMP?
А ты его знаешь? Если нет, то не выделывайся и подключай Graphic.

← →
enel © (2004-09-01 02:38) [9]

Во-первых у тебя не освобождается память в твоем коде

> GetMem(lpvObject, sizeof(BITMAP));

Во-вторых, объяви переменную Size в которую запиши
значение lpvObject.bmWidth*lpvObject.bmHeight*(lpvObject.bmBitsPixel div 8)+ SizeOf(Bitmap) это необходимый размер буффера;
Потом повторяй ObjectSize := GetObject(hbm, Size, lpvObject);
после сохрани в файл, но не с расширением bmp, Size байт.
( т.к. он не будет правильным bmp-файлом, там нужно еще 30 байт информации)

← →
Alexis © (2004-09-02 09:35) [10]

> Cobalt © (31.08.04 22:13) [6]
> ShowMessage(IntToStr(sizeof(BITMAP)));

Izvini, no pri cem zdes ShowMessage(IntToStr(sizeof(BITMAP)))??
U menia ved" showmessage(IntToStr(ObjectSize)) dlia proverki razmera buffera.

Определение объеьа памяти, необходимого для хранения Bitmap:
> значение lpvObject.bmWidth*lpvObject.bmHeight*(lpvObject.bmBitsPixel
> div 8)+ SizeOf(Bitmap)
- эта запись не годится, есть корректнее:
var DIB: tagDIBSection; DataSize: Integer; HBM: HBitmap; ... GetObject(HBM, SizeOf(DIB), @DIB); DataSize:= GetBitmapBits(HBM, -1, DIB.dsBm.bmBits);
но вообще-то после GetObject в структуру DIB уже должна была быть занесена информация и в DIB.dsBmih.biSizeImage должен быть размер битмап, а в DIB.dsBm.bmBits - ссылка на данные этой битмап; я так и не понял почему, но у меня заполняется только поле dsBm структуры DIB, почему не знаю, полазь в OpenSourse Делфи (см. TBitmap.SaveToClipboardFormat или TBitmap.SaveToStream)

Попробуй так:
//Три подпрограммы, необходимые для выявления ошибок GDI //Нужно включить модуль Consts procedure OutOfResources; begin raise EOutOfResources.Create(SOutOfResources); end; procedure GDIError; var ErrorCode: Integer; Buf: array [Byte] of Char; begin ErrorCode := GetLastError; if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then raise EOutOfResources.Create(Buf) else OutOfResources; end; procedure Error; var ErrorCode: Integer; Buf: array [Byte] of Char; begin ErrorCode := GetLastError; if (ErrorCode <> 0) and (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode, LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil) <> 0) then raise EOutOfResources.Create(Buf) else OutOfResources; end; function GDICheck(Value: Integer): Integer; begin if Value = 0 then GDIError; Result := Value; end; // Сохранение procedure SaveBitmap(ABitmap: HBitmap); var Dib: TDibSection; Buf: Pointer; ISize: Integer; FileH: THandle; begin if ABitmap = 0 then raise Exception.Create("Неправильный дискриптор"); GdiCheck(GetObject(ABitmap, SizeOf(Dib), @Dib)); if Dib.dsBm.bmBitsPixel < 24 then raise Exception.Create("Разрешение картинки менее чем 24 бит на пиксел"); ISize:= GdiCheck(GetBitmapBits(ABitmap, -1, nil)); GdiCheck(ISize); GetMem(Buf, ISize); try GdiCheck(GetBitmapBits(ABitmap, ISize, Buf)); FileH:= FileCreate("ScreenShot.dat"); try FileWrite(FileH, Dib.dsBm, SizeOf(Dib.dsBm)); FileWrite(FileH, Buf^, ISize); finally FileClose(FileH); end; finally FreeMem(Buf); end; end; // Загрузка // Вызывающая программа должна освободить ресурсы procedure LoadBitmap(var ABitmap: HBitmap); var Dib, Dib1: TDibSection; Buf: Pointer; ISize: Integer; FileH: THandle; ScreenDC: HDC; begin FileH:= FileOpen("ScreenShot.dat", fmOpenRead); try ISize:= FileSeek(FileH, 0, soFromEnd)- SizeOf(Dib.dsBm); FileSeek(FileH, 0, soFromBeginning); FileRead(FileH, Dib.dsBm, SizeOf(Dib.dsBm)); Dib.dsBm.bmBits:= nil; GetMem(Buf, ISize); try FileRead(FileH, Buf^, ISize); ScreenDC:= GdiCheck(GetDC(0)); try with Dib.dsBm do ABitmap:= GdiCheck(CreateCompatibleBitmap(ScreenDC, bmWidth, bmHeight)); try GdiCheck(SetBitmapBits(ABitmap, ISize, Buf)); except DeleteObject(ABitmap); end; finally ReleaseDC(0, ScreenDC); end; finally FreeMem(Buf); end; finally FileClose(FileH); end; end; // Пример использования // Нужно включить модуль Clipbrd procedure TForm1.Button1Click(Sender: TObject); var Bitmap: Cardinal; begin Bitmap:= Clipboard.GetAsHandle(cf_Bitmap); SaveBitmap(Bitmap); end; procedure TForm1.Button2Click(Sender: TObject); var Bitmap: HBitmap; begin LoadBitmap(Bitmap); Clipboard.SetAsHandle(cf_Bitmap, Bitmap); DeleteObject(Bitmap); // Обязатльно нужно освободить ресурсы end;

В Win NT работает, на других не знаю. На картинки менее чем 24 бита нужно еще и сохранение палитры.

uses ClipBrd; Bmp: TBitmap; ... if ClipBoard.HasFormat(CF_BITMAP) then begin Bmp.Assign(ClipBoard); Bmp.SaxeToFile("gg.bmp"); end;

Сделай так и не парься.
Graphics не смертельно увеличивает размер.

> Bmp.SaxeToFile("gg.bmp");

очепяточка %))))

2 Рыба[13] - в моей проге, которая на данный момент весит 60 KB, использовать Graphics смертельно.

Сохранение Bitmap из буфера обмена(Clipboard) в файл Найти похожие ветки