Скриншоты по сетке

← →
Gamer (2005-07-29 22:38) [0]

Здравствуйте.
Посоветуйте как можно реализовать передачу скриншотов по сети с максимально возможной скоростью. У меня получается довольно медленно. И еще вопрос как сделать тоже самое (передачу) с положением мыши. То есть это должно работать вместе. У меня есть наброски проги которая это делает. Но как я уже говорил - очень медленно.

← →
kami © (2005-07-30 00:48) [1]

1. Сжимать чем угодно - лишь бы побыстрее полный экран
2. Разбить экран на участки и сравнивать "старые" и "новые" части изображения, после чего опять-таки сжимать с информацией для восстановления и передавать.

Нашел с курсором (с) не моё:
procedure MakeScreenshot (Bmp: TBitmap; CaptureCursor: Boolean = True); var DC: HDC; ACursor: HICON; Pt: TPoint; CurInfo: tagCURSORINFO; IcoInfo: _ICONINFO; begin Bmp.Width := Screen.Width; Bmp.Height := Screen.Height; DC := GetDC (GetDesktopWindow); try BitBlt ( Bmp.Canvas.Handle, 0,0,Bmp.Width,Bmp.Height, DC, 0,0, SRCCOPY); // -- êóðñîð if CaptureCursor then begin CurInfo.cbSize := SizeOf(CurInfo); GetCursorInfo(CurInfo); ACursor := CurInfo.hCursor; Pt := CurInfo.ptScreenPos; GetIconInfo (ACursor,IcoInfo); DrawIcon( Bmp.Canvas.Handle, Pt.X-IcoInfo.xHotspot, Pt.Y-IcoInfo.yHotspot, ACursor ) end; finally ReleaseDC (GetDesktopWindow,DC); end; end; procedure TForm1.Button1Click(Sender: TObject); var Bmp: TBitmap; rect:TRect; begin rect.left:=0; rect.Top:=0; rect.Bottom:=600; rect.Right:=800; Bmp := TBitmap.Create; try // ñíèìàåì èçîáðàæåíèå ýêðàíà ñ êóðñîðîì MakeScreenshot(Bmp,True); // è ñîõðàíÿåì åãî â ôàéë äèðåêòîðèè ïðîãðàììû img.Canvas.StretchDraw(rect,bmp); finally Bmp.Free; img.Refresh; end;

← →
kami © (2005-07-30 00:58) [2]

Под "информацией для восстановления" имел ввиду размеры и положение изменившейся части экрана.

Сравнение битмапов на предмет хоть одного отличающегося пикселя:

function TForm1.BitmapsEqual(Bmp1, Bmp2: TBitMap): Boolean; { Автор Магнитоныч (c)} var H, H2, LineLength, y: Integer; DS: TDIBSection; function EqualLine(Line: Integer): Boolean; begin Result := CompareMem(@bmp1.ScanLine[Line]^, @bmp2.ScanLine[Line]^, LineLength); end; begin Result := False; {сравнение базовых параметров} if GetObject(bmp1.Handle, SizeOf(DS), @DS) > 0 then LineLength := DS.dsBm.bmWidthBytes else Exit; //error H := Bmp1.Height - 1; if H = 0 then Result := EqualLine(0) else begin Result := True; H2 := ((H+1) div 2) - 1; { Сравниваем строки. Цикл проходит одновременно сверху и снизу, сходясь в центре - так больше вероятность скорейшего обнаружения отличающихся пикселей } for y := 0 to h2 do if not(EqualLine(y))or not(EqualLine(h-y)) then begin Result := False; Exit; end; { Если высота не кратна двум, сравниваем средние строки, которые пропустили в цикле. Это сделано, чтобы дважды не вызывать CompareMem для одной строки. } if (H mod 2) = 0 then Result := EqualLine(H2 + 1); end; end;

Из оригинального кода убрано сравнение габаритов битмапов и (кажется) глубины цвета.

← →
Gamer (2005-07-30 16:16) [3]

kami ©
Спасибо за столь полные ответы. Задам еще два вопроса.
Если я буду передавать только изменившиеся строки, то это будет намного быстее?
Когда я удалил Exit; после нахождения неравных строчек (чтобы записать все разные строки) то получилось что процедура, которая делает скриншот и сравнивает его с предыдущим, выполняется ~2,2 сек. Можно ли как нибудь ускорить этот процесс?

← →
kami © (2005-07-30 17:41) [4]

1. Да, если еще сжимать изменившиеся (не обязательно строки, можно брать более крупные еденицы - у меня, например, максимум скорости получался при разбиении экрана на части по 3 строки).Сжимать можно ZLib`ом
2. Ты не правильно понял назначение BitmapsEqual: в нее не нужно "пихать" полностью старый и новый экраны. В своей процедуре создай 2 временных битмапа с нужными габаритами, в один скопируй часть "старого" изображения, в другой - нового. После этого их и сравнивай.

ЗЫ. Если и этого будет мало - есть пример, рабочий 100%, могу выложить. Но пока постарайся сам :)

← →
kami © (2005-07-30 17:48) [5]

> это будет намного быстее

Сравни, что лучше: передать 4-8Kb сжатой информации о изменившихся участках, или несколько метров полного скриншота.

Единственная ситуация, когда получается медленнее - при полном изменении экрана (в основном только из-за потерь времени на сжатие)

← →
Gamer (2005-07-30 23:27) [6]

kami ©
Попробую использовать ZLib.

← →
Gamer (2005-08-03 15:35) [7]

kami ©
Сделал так как Вы написали. Делю екран на квадраты и сжимаю. Но интерестно посмотреть Ваш пример. Насколько он большой?

← →
kami © (2005-08-03 21:23) [8]

Хе. Я еще мал и очень глуп, чтоб меня на вы называть, да и уверен, что у тебя получилось ничуть не хуже, а даже гораздо лучше. И тоже очеть интересно посмотреть реализацию :)
{ не претендует на истину в какой-либо инстанции, можно и НУЖНО сделать гораздо быстрее} unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, JPEG, ShellAPI, ZLibEx; const divider=256;// на сколько частей делим экран type TForm1 = class(TForm) Image1: TImage; bbInit: TBitBtn; bbLetDoIt: TBitBtn; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure bbInitClick(Sender: TObject); procedure bbLetDoItClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); public mcomp,mdecomp:TMemoryStream; img2:TBitMap;//"новый" экран PartImg1:array[0..divider-1] of TBitMap;//ВСЕ части старого экрана PartImg2:TBitMap;//часть нового экрана Rect:TRect; DC:HDC; Flag:Boolean;// флаг окончания "скриншотирования" CompressStream:TMemoryStream;//поток для сжатой измененной части экрана DataStream:TMemoryStream;//аккумулятор сжатых измененных частей PartStream:TMemoryStream;//несжатый поток измененной части экрана img:TBitmap;//часть экрана на приемной стороне FillImg:TBitmap;//восстановленное изображение на приемной стороне function BitmapsEqual(Bmp1, Bmp2: TBitMap):Boolean; function CopyImgToPart(yPos:word;const Source:tbitmap;var PartIMG:TBitMap):Boolean; function DoSend(yPos:integer;var PartImg:TBitMap):Boolean; procedure DecompressToImage; end; var Form1:TForm1; implementation {$R *.DFM} //============================================================ // передающая часть //============================================================ //BitMapEquial пропускаю-уже есть в ветке function TForm1.CopyImgToPart(yPos:word;const Source:tbitmap;var PartImg:TBitMap):Boolean; begin Result:=BitBLT(PartImg.Canvas.Handle,0,0,REct.Right,PartImg.Height,Source.Canvas.handle,0,yPos*PartImg.Height,SRCCOPY); end; function TForm1.DoSend(yPos:integer;var PartImg:TBitMap):Boolean; var s:string; begin {Процедура вызывается только,если Img1[i], то есть часть экрана, сохраненная в памяти отличается от соотв. части на экране} CopyImgToPart(0,PartImg,PartImg1[ypos]);//сохранили измененную часть экрана {сохраняем в поток. После сохранения всех отличающихся участков будет пересылка общего потока DataStream главному компьютеру} PartStream.clear; PartIMG.SaveToStream(PartStream); PartStream.Position:=0; CompressStream.Clear; ZCompressStream(PartStream,CompressStream,zcDefault); CompressStream.Position:=0; {теперь в CompressStream-сжатая часть экрана} s:=Format("MyTesting Part:=%15d VertLines:=%15d MyPartSize:=%15d",[yPos,PartImg.Height,CompressStream.Size]); DataStream.WriteBuffer(s[1],Length(s));{положили в общий поток измененных частей заголовок} DataStream.CopyFrom(CompressStream,CompressStream.Size);{и саму сжатую часть экрана} end; procedure TForm1.bbLetDoItClick(Sender:TObject); var i:integer; j,k,n:integer; max:integer; begin n:=0; max:=0; While not Flag do begin k:=GetTickCount; DataStream.Clear; BitBLT(img2.Canvas.Handle,0,0,Rect.Right,Rect.Bottom,dc,0,0,SRCCopy); for i:=0 to divider-1 do begin CopyImgToPart(i,img2,PartImg2); if not BitMapsEqual(PartImg2,PartImg1[i]) then DoSend(i,PartImg2); end; {Здесь в DataStream содержатся все измененные части, то есть измененные PartImg1 уже сжатые и с информацией для восстановления} j:=GetTickCount; if DataStream.Size>max then max:=DataStream.Size; Label1.Caption:="Кадр "+IntToStr(n)+" Протикало тиков "+IntToStr(j-k)+ " Размер данных "+IntToStr(DataStream.Size)+" max="+IntToStr(max); inc(n); DecompressToImage;//вместо этой процедуры в реальном приложении //нужно отправить кому-нибудь DataStream, а на приемной стороне //уже вызывать DecompressToImage после приема потока ProcessMessages; end; end; //============================================================ // приемная часть //============================================================ procedure TForm1.DecompressToImage; var s:string; part,vertlines,partsize:integer; begin {итак,в DataStream содержатся заголовки сжатых частей и сами части} {будем считать,что разрешение экрана подчиненного компа нам известно, так как первый скриншот должен пересылаться полностью.(здесь не отражено)} DataStream.Position:=0; SetLength(s,87); while DataStream.Position<DataStream.Size do begin mcomp.Clear; mdecomp.Clear; DataStream.Read(s[1],86); part:=StrToInt(Copy(s,17,15)); VertLines:=StrToInt(Copy(s,44,15)); PartSize:=StrToInt(Copy(s,72,15)); img.Width:=1024; img.Height:=VertLines; mcomp.CopyFrom(DataStream,PartSize); mcomp.Position:=0; ZDecompressStream(mcomp,mdecomp); mdecomp.Position:=0; img.LoadFromStream(mdecomp); bitblt(FillImg.Canvas.Handle,0,part*VertLines,1024,VertLines,img.Canvas.Handle,0,0,SRCCopy); end; {раскомментировать следующую строку для отображения результатов} //Image1.Canvas.StretchDraw(Image1.ClientRect,FillImg); end; procedure TForm1.FormKeyDown(Sender:TObject;var Key:Word;Shift:TShiftState); begin if Key=vk_Escape then Flag:=True; end; procedure TForm1.FormCloseQuery(Sender:TObject;var CanClose:Boolean); begin Flag:=True; CanClose:=True; end; procedure TForm1.FormCreate(Sender:TObject); var i:integer; begin Windows.GetClientRect(GetDeskTopWindow,Rect); img2:=TBitMap.Create; PartImg2:=TBitMap.Create; FillImg:=TBitMap.Create;// а если создавать и удалять его локально, //в DecompressToImage, то будут видны только измененные части изображения. FillImg.Width:=Rect.Right FillImg.Height:=Rect.Bottom; mcomp:=TMemoryStream.Create; mdecomp:=TMemoryStream.Create; img:=TBitMap.Create; for i:=0 to divider-1 do// глупости, конечно, можно оперировать // не частями старого экрана, а им всем begin PartImg1[i]:=TBitMap.Create; PartImg1[i].Width:=Rect.Right; PartImg1[i].Height:=Rect.Bottom div divider;{это не правильно-экран может не поделиться на 256 частей, и тогда нижний "кусок" не будет просчитываться} end; CompressStream:=TMemoryStream.Create; PartStream:=TMemoryStream.Create; DataStream:=TMemoryStream.create; img2.Width:=Rect.Right; PartImg2.Width:=Rect.Right; img2.Height:=Rect.Bottom; PartImg2.Height:=Rect.Bottom div divider; dc:=GetDC(GetDesktopWindow); end; // FormClose пропускаю-ничего интересного :) procedure TForm1.bbInitClick(Sender: TObject); begin //по идее-нужно перенести экран на PartImg1, но лень писать - сами напишете Flag:=False; end; end.

← →
Gamer (2005-08-04 22:49) [9]

kami ©
Свой код выставлю через пару дней.

← →
Gamer (2005-08-08 01:04) [10]

kami ©

Обещанный код. Ограничился только функцией деления на квадраты. Так как сжимаю таким же способом.

var b1,b2:tbitmap; t,x,w,y,h:integer; stepx,stepy{ширина,высота квадрата},sw,sh{рaзмtр экрана}:integer; yw,xw:boolean; begin t:=gettickcount; sw:=screen.Width; sh:=screen.Height; stepx:=sw; stepy:=5; b1:=tbitmap.Create; b2:=tbitmap.Create; x:=-stepx; y:=-stepy; if stepy<sh then begin yw:=true; while yw=true do begin xw:=true; h:=stepy; y:=y+stepy; if y+stepy>sh then begin h:=y+stepy-sh; yw:=false; end; if y+stepy=sh then yw:=false; while xw=true do begin w:=stepx; x:=x+stepx; if x+stepx>sw then begin w:=x+stepx-sw; xw:=false; end; if x+stepx=sw then begin xw:=false; end; b1.width:=w; b2.width:=w; b1.height:=h; b2.height:=h; bitblt(b1.canvas.Handle,0,0,w,h,i1.picture.Bitmap.canvas.Handle,x,y,SRCCOPY); bitblt(b2.canvas.Handle,0,0,w,h,i2.picture.Bitmap.canvas.Handle,x,y,SRCCOPY); if BitmapsEqual(B1, B2)=false then filecreate("c:\temp\"+inttostr(x)+"."+inttostr(y));; b1.SaveToFile("c:\temp\1 "+inttostr(x)+"."+inttostr(y)+" "+inttostr(w)+"."+inttostr(h)+".bmp"); b2.SaveToFile("c:\temp\2 "+inttostr(x)+"."+inttostr(y)+" "+inttostr(w)+"."+inttostr(h)+".bmp"); if xw=false then x:=-stepx; end; end;

Компоненты:
i1: TImage; //Старый скриншот
i2: TImage; //Новый скриншот
Хотя разницы между ними нет.
Проверяет квадратами stepx*stepy. Если что не ясно написано - спрашивай.

И еще вопрос: Ты используешь TThreadBlocking сервер?

← →
Slym © (2005-08-08 09:04) [11]

А в файлы то зачем? Это же тормоз! Мемори стреам пользуй

> Ты используешь TThreadBlocking сервер?

нет, ctNonBlocking.

2. Неужто, действительно сохраняешь в файлы?
3. Поясни, пожалуйста, смысл этого:
> if BitmapsEqual(B1, B2)=false then filecreate("c:\temp\"+inttostr(x)+"."+inttostr(y));;

Для ленивых есть способ проще.
Один битмап накладывается на другой с CopyMode:=SrcInvert.
Совпадающие участки дадут чёрный цвет.
Далее преобразовать в JPG как описано в
http://www.delphimaster.ru/articles/catcher.html

Преимущество одно: меньше кода - меньше ошибок.

Беру свои слова обратно. CopyMode=cmSrcInvert проводит операцию XOR. Восстановление изображения проводится также методом накладывания. Но JPEG искажает "чёрный рисунок" поэтому восстановление не всегда возможно.

← →
LoGeen (2005-08-08 23:28) [15]

Я и работаю с MemoryStream. Файлы создавал для отладки.
Т.е. filecreate("c:\temp\"+inttostr(x)+"."+inttostr(y)); чтобы узнать количество разных отрезков.
А
b1.SaveToFile("c:\temp\1 "+inttostr(x)+"."+inttostr(y)+" "+inttostr(w)+"."+inttostr(h)+".bmp"); b2.SaveToFile("c:\temp\2 "+inttostr(x)+"."+inttostr(y)+" "+inttostr(w)+"."+inttostr(h)+".bmp");
для того чтобы увидеть сами отрезки.

← →
Gamer (2005-08-08 23:37) [16]

Извините, верхнее [15] сообщение было от меня.

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