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

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

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

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

#   

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


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

Подробнее »

Вопрос # 1 133

Раздел: Delphi » Взаимодействие с Windows
/ вопрос открыт /

Здравствуйте!
Как сделать скриншот экрана и сохранить его в 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)
© 2005-2025
Текущее время: 22 февраля 2025, 11:35
Выполнено за 0.02 сек.