Форум: "Начинающим";
Текущий архив: 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.062 c