Главная страница
    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.068 c
11-1244182809
QAZ
2009-06-05 10:20
2013.03.22
HeapMM vs FastMM


6-1261978289
Tornado
2009-12-28 08:31
2013.03.22
Отправка почты через MS Exchange сервер


2-1332313764
Erwik1900
2012-03-21 11:09
2013.03.22
Объединение SQL запросов


15-1339653614
KSergey
2012-06-14 10:00
2013.03.22
Ассемблерные вставки и переносимость кода


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





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский