Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 1 133

/ вопрос открыт /

Здравствуйте!
Как сделать скриншот экрана и сохранить его в jpg c с нужными параметрами качества jpg?

Ilia Ermakov Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Ilia Ermakov (статус: 1-ый класс)
Вопрос отправлен: 23 ноября 2007, 17:05
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, Ilia Ermakov!
Всё просто - смотрим в приложении.
И не забываем о Uses JPEG.

Приложение:
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3. JpegIm: TJpegImage;
  4. bm: TBitMap;
  5. begin
  6. bm := TBitMap.Create;
  7. bm.Width := Screen.Width;
  8. bm.Height := Screen.Height;
  9. BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY);
  10. JpegIm := TJpegImage.Create;
  11. JpegIm.Assign(bm);
  12.  
  13. JpegIm.Compress;
  14.  
  15. bm.Destroy;
  16. JpegIm.Destroy;
  17. end;


Ответ отправил: Вадим К (статус: Академик)
Время отправки: 23 ноября 2007, 17:21

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, Ilia Ermakov!
Дополнение к Вадим К.
uses JPEG;
{©Drkb v.3(2007): www.drkb.ru,
®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}
...
var
i: TJPEGImage;
Dwh : HWND;
DRect: TRect;
DescDC : HDC;
Canv : TCanvas;
begin
try
i := TJPEGImage.create;
try
i.CompressionQuality := 100;
image.Width := screen.width;
image.height := screen.height;
DWH := GetDesktopWindow;
GetWindowRect(DWH, DRect);
DescDC := GetDeviceContext(DWH);
Canv.Handle := DescDC;
DRect.Left := 0;
DRect.Top := 0;
DRect.Right := screen.Width;
DRect.Bottom := screen.Height;
Image.Canvas.CopyRect(DRect, Canv, DRect);
i.assign(Image.Picture.Bitmap);
I.SaveToFile('M:\MyFile.jpg');
finally
i.free;
end;
except
end;

Более сложный метод см. в Приложении.

Приложение:
  1. unit ScrnCap;
  2. interface
  3. uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;
  4.  
  5.  
  6. function CaptureScreenRect(ARect : TRect) : TBitmap;
  7.  
  8. function CaptureScreen : TBitmap;
  9.  
  10. function CaptureClientImage(Control : TControl) : TBitmap;
  11.  
  12. function CaptureControlImage(Control : TControl) : TBitmap;
  13.  
  14. {===============================================================}
  15. implementation
  16. function GetSystemPalette : HPalette;
  17. var
  18. PaletteSize : integer;
  19. LogSize : integer;
  20. LogPalette : PLogPalette;
  21. DC : HDC;
  22. Focus : HWND;
  23. begin
  24. result:=0;
  25. Focus:=GetFocus;
  26. DC:=GetDC(Focus);
  27. try
  28. PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
  29. LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
  30. GetMem(LogPalette, LogSize);
  31. try
  32. with LogPalette^ do
  33. begin
  34. palVersion:=$0300;
  35. palNumEntries:=PaletteSize;
  36. GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
  37. end;
  38. result:=CreatePalette(LogPalette^);
  39. finally
  40. FreeMem(LogPalette, LogSize);
  41. end;
  42. finally
  43. ReleaseDC(Focus, DC);
  44. end;
  45. end;
  46.  
  47.  
  48. function CaptureScreenRect(ARect : TRect) : TBitmap;
  49. var
  50. ScreenDC : HDC;
  51. begin
  52. Result:=TBitmap.Create;
  53. with result, ARect do begin
  54. Width:=Right-Left;
  55. Height:=Bottom-Top;
  56. ScreenDC:=GetDC(0);
  57. try
  58. BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY );
  59. finally
  60. ReleaseDC(0, ScreenDC);
  61. end;
  62. Palette:=GetSystemPalette;
  63. end;
  64. end;
  65.  
  66. function CaptureScreen : TBitmap;
  67. begin
  68. with Screen do
  69. Result:=CaptureScreenRect(Rect(0,0,Width,Height));
  70. end;
  71.  
  72. function CaptureClientImage(Control : TControl) : TBitmap;
  73. begin
  74. with Control, Control.ClientOrigin do
  75. result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
  76. end;
  77.  
  78. function CaptureControlImage(Control : TControl) : TBitmap;
  79. begin
  80. with Control do
  81. if Parent=Nil then
  82. result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
  83. else
  84. with Parent.ClientToScreen(Point(Left, Top)) do
  85. result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
  86. end;
  87. end.


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 23 ноября 2007, 17:57


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 25 сентября 2018, 10:11
Выполнено за 0.18 сек.
Рейтинг@Mail.ru