| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Сохранение Bitmap из буфера обмена(Clipboard) в файл [D6, NT4, Win2k, WinXP]
Alexis © (2004-08-21 19:21:00)Делаю снимок экрана в Clipboard так :
ClipHandle : Cardinal;
keybd_event(VK_SNAPSHOT, 0, 0, 0);
ClipHandle := GetClipboardData(CF_BITMAP);
А что потом делать с полученным handle, чтобы сохранить изображение в bmp файл?
Заранее спасибо.
Alexis (2004-09-19 14:51:00) [1]2 Рыба[13] - в моей проге, которая на данный момент весит 60 KB, использовать Graphics смертельно.
Рыба (2004-09-18 11:33:00) [2]> Bmp. SaxeToFile('gg.bmp');
очепяточка %))))
Рыба (2004-09-18 11:31:00) [3]
uses ClipBrd;
Bmp: TBitmap;
...
if ClipBoard.HasFormat(CF_BITMAP) then begin
Bmp.Assign(ClipBoard);
Bmp.SaxeToFile('gg.bmp');
end;
Сделай так и не парься.
Graphics не смертельно увеличивает размер.
enel (2004-09-18 01:34:00) [4]Попробуй так:
//Три подпрограммы, необходимые для выявления ошибок 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 бита нужно еще и сохранение палитры.
enel (2004-09-08 01:12:00) [5]Определение объеьа памяти, необходимого для хранения 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)
Alexis (2004-09-02 09:35:00) [6]
> 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.
enel (2004-09-01 02:38:00) [7]Во-первых у тебя не освобождается память в твоем коде
> GetMem(lpvObject, sizeof(BITMAP));
Во-вторых, объяви переменную Size в которую запиши
значение lpvObject.bmWidth*lpvObject.bmHeight*(lpvObject.bmBitsPixel div 8)+ SizeOf(Bitmap) это необходимый размер буффера;
Потом повторяй ObjectSize := GetObject(hbm, Size, lpvObject);
после сохрани в файл, но не с расширением bmp, Size байт.
( т.к. он не будет правильным bmp-файлом, там нужно еще 30 байт информации)
enel (2004-08-31 23:49:00) [8]А тебе нужно сохранить в формате BMP?
А ты его знаешь? Если нет, то не выделывайся и подключай Graphic.
enel (2004-08-31 23:41:00) [9]Можно проще:
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;
Cobalt (2004-08-31 22:13:00) [10]2 Alexis © (31.08.04 17:38) [5]
ShowMessage(IntToStr(sizeof(BITMAP)));
Alexis (2004-08-31 17:38:00) [11]
> Ты же сам сказал "буфер у меня на 24 байта"
> Ф-ция честно вернула тебе 24 байта.
Где ты такое увидел? Я по-моему такого не говорил.
KSergey (2004-08-29 14:04:00) [12]Ты же сам сказал "буфер у меня на 24 байта"
Ф-ция честно вернула тебе 24 байта.
Это не имеет никакого отношения к размеру картинки.
> [2] Alexis © (22.08.04 11:21)
> 2 Dimaxx - может и проще, но я не подключаю к проекту Graphics
> по причине увеличения размера.
Заняться тебе просто нефигом... Ну и чатай сам книжки.. Там все написано...
Не, ну раз хочешь что-то познать - похвально, но тогда и прорывайся без подпорок!
Alexis (2004-08-29 12:45:00) [13]Ну вот, что я попытался написать, но все равно не работает :(
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 занимает гораздо больше.
Буду очень благодарен за помощь!
Alexis (2004-08-22 11:21:00) [14]2 Dimaxx - может и проще, но я не подключаю к проекту Graphics по причине увеличения размера.
Может ли кто нибудь помочь по первоначальному вопросу?
Dimaxx (2004-08-21 23:18:00) [15]А не проще ли сделать это через BitBlt и сразу кинуть в TBitmap?
| |
