Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 07.01.2014, 13:09   #21
tred
чайник
Пользователь
 
Аватар для tred
 
Регистрация: 24.06.2010
Сообщений: 44
По умолчанию

попробуй это
Код:
unit ScrnCap;
interface
uses WinTypes, WinProcs, Forms, Classes, Graphics, Controls;
 
 { Копирует прямоугольную область экрана }
function CaptureScreenRect(ARect : TRect) : TBitmap;
 { Копирование всего экрана }
function CaptureScreen : TBitmap;
 { Копирование клиентской области формы или элемента }
function CaptureClientImage(Control : TControl) : TBitmap;
 { Копирование всей формы элемента }
function CaptureControlImage(Control : TControl) : TBitmap;
 
{===============================================================}
implementation
function GetSystemPalette : HPalette;
var
 PaletteSize  : integer;
 LogSize      : integer;
 LogPalette   : PLogPalette;
 DC           : HDC;
 Focus        : HWND;
begin
 result:=0;
 Focus:=GetFocus;
 DC:=GetDC(Focus);
 try
   PaletteSize:=GetDeviceCaps(DC, SIZEPALETTE);
   LogSize:=SizeOf(TLogPalette)+(PaletteSize-1)*SizeOf(TPaletteEntry);
   GetMem(LogPalette, LogSize);
   try
     with LogPalette^ do
     begin
       palVersion:=$0300;
       palNumEntries:=PaletteSize;
       GetSystemPaletteEntries(DC, 0, PaletteSize, palPalEntry);
     end;
     result:=CreatePalette(LogPalette^);
   finally
     FreeMem(LogPalette, LogSize);
   end;
 finally
   ReleaseDC(Focus, DC);
 end;
end;
 
 
function CaptureScreenRect(ARect : TRect) : TBitmap;
var
 ScreenDC : HDC;
begin
 Result:=TBitmap.Create;
 with result, ARect do begin
  Width:=Right-Left;
  Height:=Bottom-Top;
  ScreenDC:=GetDC(0);
  try
    BitBlt(Canvas.Handle, 0,0,Width,Height,ScreenDC, Left, Top, SRCCOPY        );
  finally
    ReleaseDC(0, ScreenDC);
  end;
  Palette:=GetSystemPalette;
 end;
end;
 
function CaptureScreen : TBitmap;
begin
 with Screen do
  Result:=CaptureScreenRect(Rect(0,0,Width,Height));
end;
 
function CaptureClientImage(Control : TControl) : TBitmap;
begin
 with Control, Control.ClientOrigin do
  result:=CaptureScreenRect(Bounds(X,Y,ClientWidth,ClientHeight));
end;
 
function CaptureControlImage(Control : TControl) : TBitmap;
begin
 with Control do
  if Parent=Nil then
    result:=CaptureScreenRect(Bounds(Left,Top,Width,Height))
  else
   with Parent.ClientToScreen(Point(Left, Top)) do
    result:=CaptureScreenRect(Bounds(X,Y,Width,Height));
end;
end.
tred вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Драйвер для монитора Philips 192 e под Windows 7 Trust_357 Компьютерное железо 9 06.06.2011 04:12
Как написать драйвер виртуального привода CD/DVD? Virus25 Общие вопросы Delphi 7 17.01.2010 01:31
Ищу Документированный Драйвер Для Создания Виртуального Hdd(cdrom) 260db Свободное общение 6 21.06.2009 14:10
Разработка виртуального принтера studentTomsk Помощь студентам 3 03.02.2008 13:39
данные о видеосистеме: тип видеоадаптера, тип монитора, режим монитора: разрешение, частота обновления WaxeP Win Api 9 15.04.2007 18:12