Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Вниз

скриншот и BitBlt...   Найти похожие ветки 

 
guest   (2012-06-15 12:56) [0]

при получении скриншота, на некоторых ПК возникает лаг, судя по логированию, это происходит на BitBlt
т.е. весь рабочий стол, окна на мгновение как бы замирают (хорошо заметно в win7)


function GetScreenShotBMP(Quality: TPixelFormat = pf32bit): TBitmap;
const
 CAPTUREBLT = $40000000;
var
 DesktopCanvas: TCanvas;
 DC: HDC;
 Left, Top: Integer;
begin
 Result  := TBitmap.Create;
 try

   DC := GetDC(0);

   Result.PixelFormat := Quality;

   try
     if (DC = 0) then
       Exit;

     Result.Width := Screen.DesktopWidth;
     Result.Height := Screen.DesktopHeight;
     Left := Screen.DesktopLeft;
     Top := Screen.DesktopTop;

     DesktopCanvas := TCanvas.Create;
     try
       DesktopCanvas.Handle := DC;

       BitBlt(
         Result.Canvas.Handle,0,0,Result.Width,Result.Height,
         DesktopCanvas.Handle,Left,Top,SRCCOPY or CAPTUREBLT
       );
     finally
       DesktopCanvas.Free;
     end;
   finally
     if (DC <> 0) then
       ReleaseDC(0, DC);
   end;
 except
   Result.Free;
   Result := nil;
 end;
end;


нашел другой метод, но он в win7 вообще не работает..

const
cTileSize = 50;
function GetSCREENSHOT: TBitmap;
var
Locked: Boolean;
X, Y, XS, YS: Integer;
Canvas: TCanvas;
R: TRect;
begin
Result := TBitmap.Create;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
Canvas := TCanvas.Create;
Canvas.Handle := GetDC(0);
Locked := Canvas.TryLock;
try
  XS := Pred(Screen.Width div cTileSize);
  if Screen.Width mod cTileSize > 0 then
    Inc(XS);
  YS := Pred(Screen.Height div cTileSize);
  if Screen.Height mod cTileSize > 0 then
    Inc(YS);
  for X := 0 to XS do
    for Y := 0 to YS do
    begin
      R := Rect(
        X * cTileSize, Y * cTileSize, Succ(X) * cTileSize,
        Succ(Y) * cTileSize);
      Result.Canvas.CopyRect(R, Canvas, R);
    end;
finally
  if Locked then
    Canvas.Unlock;
  ReleaseDC(0, Canvas.Handle);
  Canvas.Free;
end;
end;


куда копать, чтобы делать скрины незаметно для ui винды?
(сразу оговорюсь, что это не вирус и тп)


 
stas ©   (2012-06-15 13:10) [1]

Как-то все сложно. У меня это работает на 7-ке без проблем.


procedure ScreenShort(Bmp:TBitmap);
begin
   bmp.Width := Screen.Width;
   bmp.Height := Screen.Height;
   BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
          GetDC(0), 0,0,SRCCOPY);
end;



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2013.03.22;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.069 c
15-1336195150
Дмитрий С
2012-05-05 09:19
2013.03.22
Частичное совпадение с регуляркой.


15-1349535707
Baks
2012-10-06 19:01
2013.03.22
Увеличение громкости звука на ноутбуке


2-1335777792
Vladolin7
2012-04-30 13:23
2013.03.22
Как ввести данные в поле Memo?


15-1351562934
Вепрь
2012-10-30 06:08
2013.03.22
UUID Компьютера.


15-1342284725
ПЛОВ
2012-07-14 20:52
2013.03.22
Некорректная работа StringReplace, или я туплю?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский