Как ускорить снятие скриншота, Ассемблерная вставка

← →
Вова (2013-08-14 16:21) [0]

Обнаружил я такой вот код.
Питаю надежду, что он будет работать быстрей моего.

http://www.programmersforum.ru/showthread.php?t=35588
asm push esi push edx mov ecx, BufLength // размер массива (Integer) mov esi, PointerBuf1Scr // указатель на источник (Pointer) mov edx, PointerBuf2Scr // указатель на приемник (Pointer) @@mix: movq xmm0, [esi] // buf1 -> в регистр movq [edx], xmm0 // buf2 <- из регистра add esi, 8 add edx, 8 loop @@mix pop edx pop esi emms end;

Естественно ничего из написаного мне не понятно. Но исходя из контекста у меня возникло ощущение, что это можно использовать для снятия скриншота. Только вот как это должно выглядеть на делфи я не знаю. В общем то в этом и вопрос.

Procedure TMyObject.getScreen(var tbmp: Tbitmap; tmpCoord: TCoord); var hDC1: HDC; R: TRect; Canvas: TCanvas; begin if tmpCoord.x2search = 0 then tmpCoord.x2search := screen.Width; if tmpCoord.y2search = 0 then tmpCoord.y2search := screen.Height; hDC1 := GetDC(0); Canvas := TCanvas.Create(); Canvas.Lock; Canvas.Handle := hDC1; R := Rect(tmpCoord.x1search, tmpCoord.y1search, tmpCoord.x2search, tmpCoord.y2search); tbmp := Tbitmap.Create; tbmp.Canvas.Lock; tbmp.Width := R.Right - R.Left; tbmp.Height := R.Bottom - R.Top; tbmp.PixelFormat := pf24bit; tbmp.Canvas.CopyRect(Rect(0,0,tbmp.Width,tbmp.Height), Canvas, R); ReleaseDC(0, hDC1); Canvas.Free; Canvas.Unlock; end;

как то так делался у меня скриншот, ну примерно в общем не суть, как это объединить?

← →
Вова (2013-08-14 16:26) [1]

Procedure Copy(BufLength:Integer; PointerBuf1Scr:Pointer; PointerBuf2Scr : Pointer);
begin

asm
push esi
push edx

mov ecx, BufLength // размер массива (Integer)
mov esi, PointerBuf1Scr // указатель на источник (Pointer)
mov edx, PointerBuf2Scr // указатель на приемник (Pointer)

@@mix:
movq xmm0, [esi] // buf1 -> в регистр
movq [edx], xmm0 // buf2 <- из регистра

add esi, 8
add edx, 8

loop @@mix

pop edx
pop esi

emms
end;

End;

Но что есть указатели?

← →
Вова (2013-08-14 16:37) [2]

h := R.Bottom - R.Top - 1; w := R.Right - R.Left; BufLength := (h+1)*w; PointerBuf2Scr := tbmp.ScanLine[h];

так??
а источник???

← →
Sapersky (2013-08-14 17:03) [3]

А источник в видеопамяти. То есть - нет, не поможет.

Может немного помочь использование 32-битного битмапа вместо 24 и (возможно) BitBlt вместо CopyRect, т.к. CopyRect вызывает StretchBlt.

Если скриншот подразумевается не один, то создавать/задавать размеры битмапа заранее. При этом лучше сначала задать PixelFormat, потом Width/Height.

← →
Вова (2013-08-14 17:23) [4]

но BitBlt как то же получает его из видеопамяти?

моя практика показывает, что WinApi функции далеки от идеалов быстроты.

← →
Sapersky (2013-08-14 17:40) [5]

BitBlt дёргает функции драйвера видеокарты.
Больше ты до них никак не доберёшься, разве что через другой API (DirectX), но по моему опыту в этом нет смысла - копирование картинки работает (если усреднить результаты на разном железе) с одинаковой скоростью на любых API.

← →
Rouse_ © (2013-08-14 22:56) [6]

> movq xmm0, [esi] // buf1 -> в регистр
> movq [edx], xmm0 // buf2 <- из регистра

12 тактов на перемещение 8 байт? Оптимизация "однако"...

← →
Rouse_ © (2013-08-14 22:58) [7]

да еще и "loop", мндя...

← →
ProgRAMmer Dimonych © (2013-08-14 23:19) [8]

> [7] Rouse_ © (14.08.13 22:58)

Наверное, по размеру оптимизируют :) Хотя без процедуры компактнее было бы.

← →
Rouse_ © (2013-08-14 23:28) [9]

> Наверное, по размеру оптимизируют :) Хотя без процедуры
> компактнее было бы.

Допустим, но тут другое, это делается в разы проще и гораздо быстрее.
Если человек начинает писать на ассемблере, он должен понимать - зачем он это делает, чтоб не получить такой-вот грустный код...

← →
Rouse_ © (2013-08-14 23:43) [10]

Врочем - код не рабочий чуть более чем полностью :)
В ХЕ4 плывет, а в семерке CopyMemory в 6 раз быстрее чем "это"...

← →
Smile (2013-08-15 00:03) [11]

Куда спешим с ASM?

DC: HDC;

BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY);

не???

← →
Sapersky (2013-08-15 02:49) [12]

Ну да, BitBlt.
Но это же скучно, то ли дело - такты считать :)
procedure CopySSE(Src, Dst : Pointer; Cnt : Integer); asm shr ecx, 5 @@mix: movapd xmm0, [eax] movapd xmm1, [eax+16] movapd [edx], xmm0 movapd [edx+16], xmm1 add eax, 32 add edx, 32 dec ecx jnz @@mix end;
В 2 раза быстрее Move, но работает только для идеальных случаев - кратный 32 размер и выравнивание на 16.
Неидеальные мне лень обрабатывать, возможно это сделано в FastCode Move Challenge, там были варианты с SSE.

← →
Вова (2013-08-15 09:46) [13]

> BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
> DC, 0, 0, SRCCOPY);

не, это уже есть.

эх....ну вот) а у меня уже пришла идея бил битом делать скрин в отдельном потоке, а потом этой штукой копировать его тыщу раз...а она оказываецо плохая (

> и выравнивание на 16

эт что значит?

← →
Вова (2013-08-15 09:49) [14]

Procedure getScreen(var tbmp: TBitmap; tmpCoord: TCoord); var hDC1: HDC; hSrcDC: HDC; hBmp: HBITMAP; R: TRect; begin if tmpCoord.x2work = 0 then tmpCoord.x2work := screen.Width; if tmpCoord.y2work = 0 then tmpCoord.y2work := screen.Height; tbmp.Canvas.Lock; R := Rect(tmpCoord.x1work, tmpCoord.y1work, tmpCoord.x2work, tmpCoord.y2work); tbmp.Width := R.Right - R.Left; tbmp.Height := R.Bottom - R.Top; hSrcDC := CreateDC("DISPLAY", Nil, nil, nil); hDC1 := CreateCompatibleDC(hSrcDC); SelectObject(hDC1, tbmp.Handle); BitBlt(hDC1, 0, 0, tbmp.Width, tbmp.Height, hSrcDC, tmpCoord.x1work, tmpCoord.y1work, SRCCOPY); tbmp.PixelFormat := pf24bit; DeleteDC(hDC1); DeleteDC(hSrcDC); tbmp.Canvas.Unlock; end;

вот такая актуальная моя процедура. без пиксель формата почему то не работает, потом посмотрю.

← →
брат Птибурдукова (2013-08-15 12:23) [15]

> hSrcDC := CreateDC("DISPLAY", Nil, nil, nil); hDC1 := CreateCompatibleDC(hSrcDC);
а это зачем?

← →
Sapersky (2013-08-15 15:20) [16]

> > и выравнивание на 16
эт что значит?

Адреса Src, Dst должны быть кратны 16. Для битмапов это условие выполняется, если будешь копировать полностью (ну или фрагмент с начала).

MMX-у в [0] тоже требуется выравнивание на 8, иначе никакого ускорения в принципе не получится.

← →
Вова (2013-08-15 16:01) [17]

нет...буду копировать квадрат по случайным координатам, ну можно увеличить немного квадрат. 32 битный битмап сделаю. Как его выровнять? потому что я так и не понял, почему это адрес вдруг кратен 16 )

← →
ProgRAMmer Dimonych © (2013-08-15 17:26) [18]

> [17] Вова (15.08.13 16:01)
> потому что я так и не понял, почему это адрес вдруг кратен
> 16 )

IMHO, значит, рано ещё про ассемблер думать.

← →
Вова (2013-08-15 17:34) [19]

> IMHO, значит, рано ещё про ассемблер думать.

IMHO мне нужен конкретный результат, а не ассемблер или что либо еще, так что это неправильное ИМХО

← →
Вова (2013-08-15 17:36) [20]

Я ведь делфи когда учил я не потому это делал, что мне нужно было стать мастером делфи, а потому что мне нужно было что то сделать и я так же мыкался, прогресс по моему на лицо )

← →
Sapersky (2013-08-15 18:10) [21]

В данном случае ради результата как раз не стоит заморачиваться - наверняка копирование картинки (тем более фрагмента картинки) не будет узким местом, всё остальное будет тормозить сильнее. BitBlt с экрана, обработка, сжатие или что там у тебя - на этом фоне ускорение копирования в 2 раза не будет заметно.

> Как его выровнять? потому что я так и не понял, почему это
> адрес вдруг кратен 16 )

Требование такое у SSE-команд, иначе вываливается с ошибкой.
Если битмап 32-битный, значит x-координата должна быть кратна 4.

← →
antonn_tmp (2013-08-15 20:12) [22]

Требование к выравниванию у movaps, movups переварит и невыровненные, но скорость будет не выше чем через РОН :)

← →
Rouse_ © (2013-08-15 21:48) [23]

> antonn_tmp (15.08.13 20:12) [22]
> Требование к выравниванию у movaps, movups переварит и невыровненные

Скорее AV c кодом С0000005 будет, впрочем, предлагаю потестировать всем желающим данный код под ХЕ4:

program Project2; {$APPTYPE CONSOLE} {$R *.res} uses windows, System.SysUtils; Procedure Copy1(BufLength:Integer; PointerBuf1Scr:Pointer; PointerBuf2Scr : Pointer); asm push esi push edx mov ecx, BufLength // размер массива (Integer) mov esi, PointerBuf1Scr // указатель на источник (Pointer) mov edx, PointerBuf2Scr // указатель на приемник (Pointer) @@mix: movq xmm0, [esi] // buf1 -> в регистр movq [edx], xmm0 // buf2 <- из регистра add esi, 8 add edx, 8 loop @@mix pop edx pop esi emms end; procedure CopySSE(Src, Dst : Pointer; Cnt : Integer); asm shr ecx, 5 @@mix: movapd xmm0, [eax] movapd xmm1, [eax+16] movapd [edx], xmm0 movapd [edx+16], xmm1 add eax, 32 add edx, 32 dec ecx jnz @@mix end; var A: array [0..63] of Byte; B: array [0..63] of Byte; S: Cardinal; I: Integer; begin try S := GetTickCount; for I := 0 to 1000 do CopyMemory(@a[0], @b[0], 64); Writeln(GetTickCount - S); S := GetTickCount; for I := 0 to 1000 do CopySSE(@a[0], @b[0], 64); Writeln(GetTickCount - S); S := GetTickCount; for I := 0 to 1000 do Copy1(64, @a[0], @b[0]); Writeln(GetTickCount - S); except on E: Exception do Writeln(E.ClassName, ": ", E.Message); end; readln; end.

CopySSE выдаст:
Project Project2.exe raised exception class $C0000005 with message "access violation at 0x00418d57: read of address 0xffffffff".

а Copy1 (переименованная процедура от "Вова (14.08.13 16:26) [1]") выдаст вообще печальную картинку (обратите внимание на изменения итератора I на каждой итерации цикла)

← →
Sapersky (2013-08-15 23:51) [24]

> antonn_tmp (15.08.13 20:12) [22]

Про movups - да, слышал, что медленная, поэтому даже не пробовал. Я уже как-то привык, что любому SIMD нужно выравнивание.

> Rouse_ © (15.08.13 21:48) [23]

Я не утверждал, что это универсальная замена Move на все случаи жизни. Если бы подходило для всех случаев, оно бы уже давно было в RTL.
Type PByteArr = ^TByteArr; TByteArr = array [0..MAXINT-1] of Byte; DByteArr = array of Byte; function Arr_Aligned(Var Arr : DByteArr; ByteSize : Integer; AShift : Integer = 3): Pointer; Var i, Offs : NativeInt; AVal : Integer; begin AVal := (1 shl AShift); SetLength(Arr, ByteSize + AVal); i := NativeInt(Arr); While ( ((i shr AShift) shl AShift) <> i ) do Inc(i, 4); Result := Pointer(i); end; procedure TForm1.Button2Click(Sender: TObject); Const Cycles = 100000; Size = 64 * 1024; Var n : Integer; a : DByteArr; pa : PByteArr; S: Cardinal; begin pa := Arr_Aligned(a, Size*2, 4); For n:=0 to Size-1 do pa[n] := n; S := GetTickCount; For n:=0 to Cycles-1 do CopySSE(pa, @pa[Size], Size); // Move(pa[0], pa[Size], Size); Caption := InttoStr(GetTickCount - S); end;
(ну или можно включить в FastMM опцию "выравнивать на 16")

А про код из [0] никто не сомневается, что он нерабочий, не мучай трупик.

← →
Вова (2013-08-16 00:59) [25]

> В данном случае ради результата как раз не стоит заморачиваться
> - наверняка копирование картинки (тем более фрагмента картинки)
> не будет узким местом, всё остальное будет тормозить сильнее.
> BitBlt с экрана, обработка, сжатие или что там у тебя -
> на этом фоне ускорение копирования в 2 раза не будет заметно.
>

ну самое забавное как раз в том, что благодаря Sha теперь самое узкое место у меня скриншот ) потому что фильтр делается за 2 милисекунды, что как то теряется на фоне 30 миллисекунд за скриншот ) ну и все что осталось на небольших участках картинки тож в пределах 30 миллисекунд пролетает )

← →
ProgRAMmer Dimonych © (2013-08-16 01:03) [26]

> ну самое забавное как раз в том, что благодаря Sha теперь
> самое узкое место у меня скриншот ) потому что фильтр делается
> за 2 милисекунды, что как то теряется на фоне 30 миллисекунд
> за скриншот ) ну и все что осталось на небольших участках
> картинки тож в пределах 30 миллисекунд пролетает )

А конечная цель тогда сколько? И чем сделаны замеры с 2 мс?

← →
Вова (2013-08-16 01:07) [27]

> А конечная цель тогда сколько? И чем сделаны замеры с 2
> мс?

GetTickCount - за 1000 итераций. конечная цель чем быстрее тем лучше ) и у меня пока есть ощущение, что еще есть куда быстрее. ну не фильтр быстрее 2 миллисекунд, а все остальное ) тем более у меня есть еще 1 фильтр он очень тормозной ) есть куда стремиться )

← →
ProgRAMmer Dimonych © (2013-08-16 01:26) [28]

> GetTickCount - за 1000 итераций. конечная цель чем быстрее
> тем лучше ) и у меня пока есть ощущение, что еще есть куда
> быстрее. ну не фильтр быстрее 2 миллисекунд, а все остальное
> ) тем более у меня есть еще 1 фильтр он очень тормозной
> ) есть куда стремиться )

GetTickCount() точнее 15 мс не расскажет. И, пардон, если 1000 копирований выполняется за 30 мс, то кто-то растрачивает своё время на экономию на спичках.

1. Скопировать кусок памяти быстрее, чем за O(N) не удастся и оптимизации с ассемблером и инструкциями не помогут сделать O(log N).
2. С низкоуровневыми оптимизациями надо очень осторожно, ибо здесь и сейчас работает шустро, а завтра что-то поменялось (процессор, версия ОС) — и вдруг оказывается, что так только хуже (если не ошибаюсь, те же loop/loopcc на старых процессорах были быстрее, чем циклы с jcc, сейчас наоборот). Плюс сопровождаемость падает: наоптимизировав, можно выжать лишние 15 мс, а через полгода не понять ни строчки. Да ещё и для нового формата данных оптимизация окажется неподходящей.
3. Написанием своих замен для стандартных функций (тех же GDI) лучше не злоупотреблять: Microsoft не гарантирует, что в одной из следующих версий не изменятся внутренние структуры данных. Хотя битмап-то вряд ли, конечно.

← →
Вова (2013-08-16 04:51) [29]

нет, 1000 итераций и вычисляется среднее, т.е. 30 за одну. и это не копирование из одного битмапа в другой, а именно скриншот.

← →
Sapersky (2013-08-16 05:06) [30]

По поводу скриншотов: я заметил, что скорость получения картинки конкретного окна гораздо выше, чем картинки десктопа. Очевидно, из-за того, что в Win7 картинка окна изначально рисуется (если через GDI) в системной памяти, а десктоп со всеми стеклянными рюшечками уже в видео. Можно это использовать.
Ещё, отключение рюшечек (Aero) ускоряет скриншот с десктопа.

А копирование скриншота можно совместить с фильтром, т.е. сделать у фильтра исходную и результирующую картинку.

← →
Вова (2013-08-16 18:28) [31]

>
> > hSrcDC := CreateDC("DISPLAY", Nil, nil, nil); hDC1 :=
> CreateCompatibleDC(hSrcDC);
> а это зачем?

чтобы работало, есть конструктивные предложния?

← →
Вова (2013-08-16 19:20) [32]

procedure TScreenShot.Execute; var T: cardinal; i:integer; begin T := GetTickCount; for I := 0 to 2000 do BitBlt(fhDC1, 0, 0, fScreen.Width, fScreen.Height, fhSrcDC, 0,0, SRCCOPY); T := GetTickCount - T; fScreen.SaveToFile("C:\test.bmp"); MessageDlg("Процедура заняла " + IntToStr(Round(t/2000)) + " миллисекунд",mtError, [mbOK], 0); end;

Ощем оттакот, быстрее некуда 46 милисекунд...

← →
Вова (2013-08-16 19:26) [33]

тююю, впомнил что битмап 32 нужен, поменял. разницы никакой.

← →
Алканавт расправил плечи (2013-08-16 21:14) [34]

> чтобы работало, есть конструктивные предложния?
А банальное GetDC(0) не работает? Мне до сих пор хватало его.

← →
Styx (2013-08-16 21:44) [35]

> А банальное GetDC(0) не работает?

Да это не важно. Тормозит-то не здесь. А BitBlt с Aero всегда тормозил и тормозить будет. Не знаю, может, через DirectX быстрей будет, но едва ли.

← →
Sapersky (2013-08-17 00:07) [36]

Через DX тоже особо не развернёшься. Брать картинку с экрана (а не из своего окна) без Fullscreen можно только в DX7 и более ранних, при этом единственный способ, который не отключает Aero - копирование в системную память наподобие того же BitBlt. И работает с такой же скоростью или медленнее.

Я предлагал в [30] брать картинки с окон, ну или хотя бы с одного активного окна, таким образом бОльшую часть площади экрана можно получить быстрым методом. Хотя если окно рисуется не через GDI, а через какой-нибудь Direct2D, тогда наверное будет тормозить так же как с десктопом.

← →
Вова (2013-08-17 00:27) [37]

Почему CopyScreen ошибку выдает, ошибка записи в память?

Procedure TScreenShot.CopyScreen(var tbmpDest:TBitmap; Coord:TCoord); var Source,Destination:Pointer; begin //WaitForSingleObject(MyMutex, INFINITE); Source := fScreen.ScanLine[0]; Destination := tbmpDest.ScanLine[0]; Move(Source, Destination, 1000); //ReleaseMutex(MyMutex); end;

var fScreen: TBitmap; tmpCoord: TCoord; ScreenObj :TScreenShot; begin ScreenObj := TScreenShot.Create; //ScreenObj.FreeOnTerminate := true; //ScreenObj.Resume; fScreen := TBitmap.Create; fScreen.Width := 100; fScreen.Height := 100; fScreen.PixelFormat := pf32bit; tmpCoord.x1work := 0; tmpCoord.y1work := 0; tmpCoord.x2work := 99; tmpCoord.y2work := 99; ScreenObj.getScreen; Sleep(400); WaitForSingleObject(ScreenObj.MyMutex, INFINITE); ScreenObj.ScreenShot.SaveToFile("C:\Scrn.bmp"); ReleaseMutex(ScreenObj.MyMutex); ScreenObj.CopyScreen(fScreen, tmpCoord); CODE>

← →
Вова (2013-08-17 00:30) [38]

> Я предлагал в [30] брать картинки с окон, ну или хотя бы
> с одного активного окна, таким образом бОльшую часть площади
> экрана можно получить быстрым методом. Хотя если окно рисуется
> не через GDI, а через какой-нибудь Direct2D, тогда наверное
> будет тормозить так же как с десктопом.

не брать скриншот окна не вариант, т.е. я так раньше делал, все круто, но мне так нельзя ))

← →
Вова (2013-08-17 00:45) [39]

Source := fScreen.ScanLine[fScreen.Height-1]; Destination := tbmpDest.ScanLine[tbmpDest.Height-1]; Move(Source, Destination, 400);

и так тоже...

← →
Sapersky (2013-08-17 00:48) [40]

Move(Source^, Destination^, 1000);
Я предлагал брать окно и потом остальное вокруг этого окна с десктопа.

← →
Вова (2013-08-17 00:54) [41]

эм...эт как? окно по хендлу Апи функцией? вот это мне низя. А уж как воокруг еще взять, не скриншотом я и не знаю )

← →
Вова (2013-08-17 01:02) [42]

ндааа

Source := fScreen.ScanLine[0];
Destination := tbmpDest.ScanLine[0];
Move(Source^, Destination^, 1500);

такое ощущение, что он копирует только первую строку, а на 1500 уже вылетает по ошибке....точно хз на скольки, но суть в том что что то не то...

← →
Sapersky (2013-08-17 01:18) [43]

Ну тогда ScanLine[fScreen.Height-1].

Окно - например через GetForegroundWindow, потом GetDC/BitBlt. Непонятно, какой в этом криминал и почему "низя".
Вокруг окна - обычным скриншотом через GetDC(0), в надежде, что площадь будет небольшая и сработает быстро. Точнее, 4-мя скриншотами (сверху, снизу, слева, справа).

← →
Sapersky (2013-08-17 01:43) [44]

Или подождать, когда у большинства будет Win8 - MS как раз родил специальный API для доступа к десктопу:
http://msdn.microsoft.com/en-us/library/windows/desktop/hh404487(v=vs.85).aspx
Лет 5?

← →
antonn_tmp (2013-08-17 10:04) [45]

А если окна слоеные и пересекаются, с полупрозрачностями, как сфотографируется окно?

← →
Вова (2013-08-17 11:03) [46]

> Ну тогда ScanLine[fScreen.Height-1].

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

← →
Туповатый (2013-08-17 13:23) [47]

Задача не озвучена, но чувствуется, что пытаются гвозди микроскопом забивать. НИМХО

← →
Вова (2013-08-17 14:09) [48]

Procedure TScreenShot.CopyScreen(var tbmpDest:TBitmap; Coord:TCoord); var Source,Destination:Pointer; i:word; begin for I := 0 to tbmpDest.Height-1 do begin Source := fScreen.ScanLine[fScreen.Height-1-i]; Destination := tbmpDest.ScanLine[tbmpDest.Height-1-i]; Move(Source^, Destination^, tbmpDest.Width*4); end; end;

если так, то полный скрин 3.5 миллисекунд копируется

← →
Вова (2013-08-17 14:15) [49]

for i := 0 to tbmpDest.Height - 1 do
begin
Source := fScreen.ScanLine[fScreen.Height - 1 - i];
Destination := tbmpDest.ScanLine[tbmpDest.Height - 1 - i];
CopySSE(Source, Destination, tbmpDest.Width*4)
end;

а так 2.44

← →
Вова (2013-08-17 14:35) [50]

procedure CopySSE(Src, Dst : Pointer; Cnt : Integer); asm shr ecx, 5 @@mix: movapd xmm0, [eax] movapd xmm1, [eax+16] movapd [edx], xmm0 movapd [edx+16], xmm1 add eax, 32 add edx, 32 dec ecx jnz @@mix end; Procedure TScreenShot.CopyScreen(var tbmpDest: Tbitmap; Coord: TCoord); var Source, Destination: Pointer; i: Word; begin // WaitForSingleObject(MyMutex, INFINITE); for i := 0 to tbmpDest.Height - 1 do begin Source := fScreen.ScanLine[(fScreen.Height - 1 -Coord.y1work- i)-Coord.x1work*4]; Destination := tbmpDest.ScanLine[tbmpDest.Height - 1 - i]; //Move(Source^, Destination^, tbmpDest.Width*4); CopySSE(Source, Destination, tbmpDest.Width*4) end; // ReleaseMutex(MyMutex); end;

в таком варианте в конце картинки не хватает пикселя в конце строки, если кусок длинной 500, но если 504 то хватает... как то я не понял фишку )

← →
Вова (2013-08-17 14:42) [51]

кратно 8 должно быть?

← →
Вова (2013-08-17 16:05) [52]

че то я там с вырезанием квадрата накосячил )

function LockConvertBmpToRGBColorMapM(ppixel: pInteger;ppixelDest: pInteger;last:pInteger): Boolean; begin repeat ppixelDest^:=ppixel^; inc(ppixel,1); inc(ppixelDest,1); until ppixel=last; Result := true; end; Procedure TScreenShot.CopyScreen(var tbmpDest: Tbitmap; Coord: TCoord); var i: Word; Destination,Start,Last: pInteger; begin Start:= fScreen.ScanLine[(fScreen.Height - 1)]; Last := fScreen.ScanLine[0]; Destination := tbmpDest.ScanLine[tbmpDest.Height - 1]; LockConvertBmpToRGBColorMapM(Start,Destination,last); end;

а так 2.9 (

ассемблер всех обогнал ) только картинка должна быть размером кратно 4

← →
Вова (2013-08-17 16:57) [53]

Вообщем дальнейшие тесты показали, что если копировать небольшие картинки (кусок 500 на 500 разница на 0.1 милисекунды), то заморачиться смысла нет. Тем более, что на ассемблере еще нужно прикручивать выравнивание, а оно тоже чего нибудь отожрет.

И возник вопрос: Как правильно написать, чтобы по x сдвинуть копируемый участок? как я сейчас сделал получается какая то фигня, слева вроде все нормально, но справа рисуется левая часть (которая в копируемый диапазон вроде как не попала) картинки источника.

Procedure TScreenShot.CopyScreenSSE(var tbmpDest: Tbitmap; Coord: TCoord);
var
Source, Destination: pInteger;
i: Word;
begin

//WaitForSingleObject(MyMutex, INFINITE);
for i := 0 to tbmpDest.Height - 1 do
begin
//i:=0;
Source := fScreen.ScanLine[(fScreen.Height - 1 -Coord.y1work- i)];
inc(Source,Coord.x1work);
Destination := tbmpDest.ScanLine[tbmpDest.Height - 1 - i];
//Move(Source^, Destination^, tbmpDest.Width*4);
CopySSE(Source, Destination, tbmpDest.Width*4);
end;
//ReleaseMutex(MyMutex);

end;

← →
Вова (2013-08-17 17:16) [54]

упс......
> И возник вопрос: Как правильно написать, чтобы по x сдвинуть
> копируемый участок? как я сейчас сделал получается какая
> то фигня, слева вроде все нормально, но справа рисуется
> левая часть (которая в копируемый диапазон вроде как не
> попала) картинки источника.

это я исправил еще в том же посте где и спросил ))

function LockConvertBmpToRGBColorMapM(ppixel: pInteger;ppixelDest: pInteger;last:pInteger): Boolean; begin repeat ppixelDest^:=ppixel^; inc(ppixel); inc(ppixelDest); until ppixelDest=last; end; Procedure TScreenShot.CopyScreenScanLine(var tbmpDest: Tbitmap; Coord: TCoord); var //Source, Destination: Pointer; i: Word; Destination,Start,Last: pInteger; begin for i := 0 to tbmpDest.Height - 1 do begin //i:=0; Start := fScreen.ScanLine[(fScreen.Height - 1 -Coord.y1work- i)]; inc(Start,Coord.x1work); Destination := tbmpDest.ScanLine[tbmpDest.Height - 1 - i]; Last := Destination; inc(Last,tbmpDest.Width); LockConvertBmpToRGBColorMapM(Start,Destination,Last); end; end;

ну и в заключении решил дать шанс просто сканлайну, работает немножко медленней чем Move. на картинке размером 500 на 500 пикселей все 3 варианта в пределах одной десятой миллисекунды различаются ))

где же Sha?))

← →
Вова (2013-08-17 18:14) [55]

единственное, что хорошо в сканлайне, это то что я понимаю как его с фильтром объединить ) Move вообще никак, а ассемблер надо знать как )

← →
ProgRAMmer Dimonych © (2013-08-18 15:20) [56]

Может, пора заняться функционалом, а не оптимизацией быстрого?

← →
Вова (2013-08-18 17:16) [57]

функционал уже есть. Вчера перевел все что мог на 32 битный битмап (но не на сканлайн)....до сих пор баги исправляю (

← →
Вова (2013-08-21 00:34) [58]

где в последней процедуре ошибка? ( какой то неправильный он мне квадрат вырезает (

← →
Sha © (2013-08-21 01:42) [59]

Попробуй обработать отрезок каждой строки, пересекающей твой квадрат.
Сразу поймешь в чем дело.

← →
Вова (2013-08-21 01:49) [60]

ну навскидку квадрат должен быть из верхней части скрина, а получается из нижней.....т.е. видимо

Start := fScreen.ScanLine[(fScreen.Height - 1 -Coord.y1work- i)];

тут что то не так, но что я понять не могу......

по x примерно совпадает...

причем если Coord.y1work = 0 то проблем нет....

← →
Вова (2013-08-21 02:04) [61]

Start := fScreen.ScanLine[(Coord.y2work - i)];

емае, я думал что первый пиксель битмапа в fScreen.Height - 1, оказывается он все же в 0, просто обход идет снизу вверх и справа налево....

← →
Вова (2013-08-21 02:12) [62]

скорость поиска теперь доставляет ) пора переходить на микросекунды ) на замеры в микросекундах )

← →
Sapersky (2013-08-21 02:46) [63]

> я думал что первый пиксель битмапа в fScreen.Height - 1,
> оказывается он все же в 0

Таки в Height-1, но TBitmap.GetScanline переворачивает координату, задаёшь 0 - будет Height-1.
Если работать со сканлиниями по одной, не пытаясь скопировать/обработать сразу несколько, то по идее о переворотах можно не думать. Хотя частые вызовы Scanline в некоторых случаях здорово всё тормозят.
На уровне WinAPI есть способ создать нормальный, не перевёрнутый битмап - задать ему отрицательную высоту. Но с TBitmap это не работает, разве что наследника писать.

← →
Sha © (2013-08-21 09:33) [64]

Адреса сканлайнов представляют собой арифметическую прогрессию.
Просто мысль.

← →
Вова (2013-08-21 11:42) [65]

таки если он в Height-1 то как выходит так, что если я, отнимаю от этого значения координату У верхнего угла целевого прямоугольника и на выходе получаю что прямоугольник вырезается внизу? хотя на деле он вверху ). Таким образом я пошел другим путем, и от 0 взял координату У нижнего угла прямоугольника, и тогда попал в цель. Т.е. когда приращиваешь адрес то идешь от нижнего угла к верхнему.....хотя в данном случае чтобы перейти на следующую строку нужно опять делать сканлайн, так что неочень понятно опять же.

Вообще уже пора сайт с картинками сделать, а то нифига невозможно понять)

← →
Вова (2013-08-21 11:52) [66]

Хотя частые вызовы Scanline в некоторых случаях здорово всё тормозят.

а что тут есть возможность не вызывать часто сканлайн? когда я пытался просто идти как идется, то получалось, что делался проход по всей строке источника.....если наставить условий, что от сих до сих пишем в принимающий битмап, а остальные места просто пропускаем, то будет быстрее, чем если в цикле сканлайн запускать? хм....кстати да, особенно что если выходишь за отрезок который нужно копировать можно не inc(ppixel,1) делать, а сразу длину всего отрезка. над попробовать будет.

← →
Sapersky (2013-08-21 11:57) [67]

> Адреса сканлайнов представляют собой арифметическую прогрессию.

Это всё уже обсуждалось:
http://delphimaster.net/view/9-1186325580/
Но это нужно лишнюю переменную заводить на каждый сканлайн и каждый раз её инициализировать.

> Вообще уже пора сайт с картинками сделать, а то нифига невозможно
> понять)

Да, постоянно считать эти перевороты довольно утомительно.
Я в конечном счёте перешёл на не перевёрнутые битмапы (с отрицательной высотой), благо класс-контейнер (TFastDIB) позволяет.

← →
Sha © (2013-08-21 14:04) [68]

> Но это нужно лишнюю переменную заводить на каждый сканлайн
> и каждый раз её инициализировать.

Зачем? Достаточно одной... т.е. двух переменных:

a:=ScanLine(0);
d:=ScanLine(1)-a;

А дальше вместо ScanLine(n) использовать a+n*d

← →
Sha © (2013-08-21 14:10) [69]

А в Вовином случае для перехода к границе квадрата на следующей строке
достаточно увеличить старую границу на d.

← →
Вова (2013-08-21 14:30) [70]

1) адрес старта
2) расстояние от начала строки до точки старта + расстояние от конца копируемого отрезка до конца строки;
3) Длина копируемого отрезка (можно BmpDest.Width)
4) адрес конца вырезаемого прямоугольника. (BmpDest.ScanLine(0))

4 переменных, а что за ScanLine(0); и ScanLine(1); это вообще не понятно.

← →
Sha © (2013-08-21 14:42) [71]

> что за ScanLine(0); и ScanLine(1); это вообще не понятно.

дык то ж загадка, она не обязана быть понятной

← →
Вова (2013-08-21 15:09) [72]

а отгадка где? сканлайн же на начало строки всегда показывает?

> а отгадка где?

это тот, кто отгадал, должен сказать?

> сканлайн же на начало строки всегда показывает?

она же на границу слова всегда выровнена ?

двойного?

← →
проф. Преображенский (2013-08-21 15:27) [75]

Мне мысли морщат мозг,
От знаний я старею,
Ответьте мне скорее:
А то созрел еще вопрос...

← →
Вова (2013-08-21 17:00) [76]

вот зануды.

ассеблер вырезание 500 на 500 делает за 0.468 миллисекунды
мув за 0.515 миллисекунды
Сканлайн в цикле за 0.562 миллисекудны

а сканлайн без сканлайна в цикле за 0.296
function LockConvertBmpToRGBColorMapM2(ppixel: pInteger; ppixelDest: pInteger; last: pInteger;Lenght,SkipLine:word): Boolean; var i:word; begin i:=0; repeat repeat ppixelDest^ := ppixel^; inc(ppixel); inc(ppixelDest); inc(i); until i=Lenght; i:=0; inc(ppixel,SkipLine) until ppixelDest = last; end; Procedure TScreenShot.CopyScreenScanLine(var tbmpDest: Tbitmap; Coord: TCoord); var LineLength,SkipLine,i: Word; Destination, Start, last: pInteger; begin WaitForSingleObject(MyMutex, INFINITE); if (fNumberOfShot = 0) or (tbmpDest.Height < 2) then exit; //y*LineLength+x*PixelSize Start := fScreen.ScanLine[Coord.y2work]; inc(Start, Coord.x1work); Destination := tbmpDest.ScanLine[(tbmpDest.Height - 1)]; last := tbmpDest.ScanLine[0]; LineLength := tbmpDest.Width; SkipLine := fScreen.Width - tbmpDest.Width; //inc(last, tbmpDest.Width); LockConvertBmpToRGBColorMapM2(Start, Destination, last,LineLength,SkipLine); ReleaseMutex(MyMutex); end;

некузяво

1. название? а результат? а варнинг?
2. word? integer!
3. inc(i)? dec(count)!

4. опять эти чудеса на виражах с переворотами картинок?
5. остаток строки SkipLine лучше вычислять в вызываемой процедуре.
6. inc(last, tbmpDest.Width); правильнее вычислять дельту между строками, хотя в данном случае это одно и то же.

← →
Вова (2013-08-21 17:35) [79]

я ничего не пытался даже переворачивать, просто подругому вообще ничего внятного на выходе не получается.

ничо не понял, и это ничего не дает.
function LockConvertBmpToRGBColorMapM2(ppixel: pInteger; ppixelDest: pInteger; last: pInteger;Lenght,SkipLine:integer): Boolean; var count:integer; begin count:=Lenght; repeat repeat ppixelDest^ := ppixel^; inc(ppixel); inc(ppixelDest); dec(count); until count = 0; count:=Lenght; inc(ppixel,SkipLine) until ppixelDest = last; end;

← →
Вова (2013-08-21 17:48) [80]

все же по идее должно быть так....но на боевых данных вчера так не работало....

Procedure TScreenShot.CopyScreenScanLine(var tbmpDest: Tbitmap; Coord: TCoord); var LineLength,SkipLine,i: integer; Destination, Start, last: pInteger; begin WaitForSingleObject(MyMutex, INFINITE); if (fNumberOfShot = 0) or (tbmpDest.Height < 2) then exit; //y*LineLength+x*PixelSize Start := fScreen.ScanLine[(fScreen.Height - 1) - Coord.y1work]; inc(Start, Coord.x1work); Destination := tbmpDest.ScanLine[(tbmpDest.Height - 1)]; last := tbmpDest.ScanLine[0]; LineLength := tbmpDest.Width; SkipLine := fScreen.Width - tbmpDest.Width; //inc(last, tbmpDest.Width); LockConvertBmpToRGBColorMapM2(Start, Destination, last,LineLength,SkipLine); ReleaseMutex(MyMutex); end;

Разумеется, не дает. Но красота - страшная сила!

Замени ленч на каунт в объявлении процедуры - и локальная переменная будет не нужна.

← →
Вова (2013-08-21 17:57) [82]

как так не нужна, мне же ее нужно в цикле восстанавливать к прежнему значению, если я его затру, к чему же я его буду восстанавливать?

← →
Вова (2013-08-21 21:49) [83]

Start := fScreen.ScanLine[Coord.y2work]; inc(Start, Coord.x1work);

короче работает тока так.... а так не работает....Start := fScreen.ScanLine[(fScreen.Height - 1) - Coord.y1work]; где логика......

> мне же ее нужно в цикле восстанавливать к прежнему значению

Ах, да, конечно. Это я съел что-нибудь.

> где логика......

Действительно. Потерял, наверное.

← →
Sapersky (2013-08-22 00:15) [85]

Проверил - обычный BitBlt быстрее копирования через Move и совсем немного уступает варианту с SSE (зато без ограничений по выравниванию и размеру).

← →
Вова (2013-08-22 07:38) [86]

да но последний scanline быстрее SSE )

← →
Вова (2013-08-22 14:23) [87]

вооот, а если вместо PInteger сделать pInt64, то скорость вырастет еще на треть. ток надо чтобы битмап имел четное количество пикселей.

разверни цикл, Люк

← →
Вова (2013-08-22 15:21) [89]

> разверни цикл, Люк

это я так и не понял как делается (

теорию сам погугли, а пример могу дать:

http://guildalfa.ru/alsha/node/22

← →
Вова (2013-08-29 01:06) [91]

тысяча чертей, почему у меня верхняя строка целевого битмапа пустая? я уже все глаза сломал не могу понять (

function CopyRect(ppixel,ppixelDest,last: pInt64; Lenght, SkipLine: integer): Boolean; var count: integer; begin count := Lenght; repeat repeat ppixelDest^ := ppixel^; inc(ppixel); inc(ppixelDest); dec(count); until count = 0; count := Lenght; inc(ppixel, SkipLine) until ppixelDest = last; end; function CalcLenght(EndS, StartS: integer): integer; begin result := EndS - StartS; end; Procedure TScreenShot.CopyScreenScanLine(var tbmpDest: Tbitmap; Coord: TCoord); var LineLength, SkipLine, i: integer; Destination, Start, last: pInt64; begin tbmpDest.Width := Coord.x2work - Coord.x1work + 1; tbmpDest.Height := Coord.y2work - Coord.y1work + 1; if Coord.x2work = 0 then begin tbmpDest.Width := screen.Width; Coord.x2work := screen.Width - 1 end; if Coord.y2work = 0 then begin tbmpDest.Height := screen.Height; Coord.y2work := screen.Height - 1; end; if (tbmpDest.Width div 2) <> (tbmpDest.Width / 2) then // строка битмапа должна быть четной if tbmpDest.Width = screen.Width then tbmpDest.Width := tbmpDest.Width - 1 else tbmpDest.Width := tbmpDest.Width + 1; WaitForSingleObject(MyMutex, INFINITE); if (fNumberOfShot = 0) or (tbmpDest.Height < 2) then exit; Start := fScreen.ScanLine[Coord.y2work]; inc(Start, Coord.x1work div 2); Destination := tbmpDest.ScanLine[(tbmpDest.Height - 1)]; last := tbmpDest.ScanLine[0]; LineLength := tbmpDest.Width div 2; SkipLine := CalcLenght(fScreen.Width, tbmpDest.Width) div 2; CopyRect(Start, Destination, last, LineLength, SkipLine); ReleaseMutex(MyMutex); end;

потому что строка, для которой ppixelDest=last, не копируется

← →
Вова (2013-08-30 01:35) [93]

логично, но вопрос как раз в том, почему.

Для того, чтобы скопировать в цикле элементы
с индесами от N-1 до 0, необходимо выйти из цикла
либо после копирования элемента, имеющего нулевой индекс,
либо перед копированием элемента, имеющего отрицательный индекс.

← →
Вова (2013-08-30 13:20) [95]

правильный ответ: Потому что в результате того, что у того кто разрабатывал всю эту архитектуру были не все дома, то tbmpDest.ScanLine[0]; указывает не на конец битмапа, а на конец последней строки(который находится в крайней правой точке картинки), как и любой сканлайн указывает на конец строки битмапа , переданной в параметре, в памяти.

← →
Вова (2013-08-30 13:30) [96]

и таким образом получается, что битмап в памяти не перевернут вообще. Перевернут обход по пикселям. Т.е. если идти по возрастанию, то обход нужно начинать в правом нижнем углу.

← →
Вова (2013-08-30 13:58) [97]

тваюмашу, неугадал (

← →
Sapersky (2013-08-30 14:05) [98]

Ну а что ты хотел - во всех хелпах написано, что на начало, все используют, у всех работает, а тут у Вовы ВНЕЗАПНО на конец...
procedure CopyPart32(Src, Dst : TBitmap; OffsX, OffsY : Integer; Inverted : Boolean = True); Var y : Integer; ps, pd : PDWord; begin If Inverted then begin ps := Src.ScanLine[0]; // последняя строка Dec(ps, Src.Width * (OffsY + Dst.Height)); // битмап перевёрнут, отступаем СНИЗУ на OffsY + Height end else begin ps := Src.ScanLine[Src.Height-1]; // первая строка Inc(ps, Src.Width * OffsY); end; Inc(ps, OffsX); pd := Dst.ScanLine[Dst.Height-1]; // первая строка For y:=0 to Dst.Height-1 do begin Move(ps^, pd^, Dst.Width * 4); Inc(ps, Src.Width); Inc(pd, Dst.Width); end; end;
Inverted = True - битмапы перевёрнуты, режим по умолчанию.
Inverted = False - битмапы с отрицательной высотой, не перевёрнутые. Это таки работает, но до сканлайна не доходит, что битмап "нормальный", поэтому нужно брать начало (Src.ScanLine[Src.Height-1]) и дальше считать все смещения самостоятельно.

← →
Вова (2013-09-02 01:35) [99]

> Вовы ВНЕЗАПНО на конец...

а все потому, что нет ни одной понятной картинки

опщем, да нужно было просто inc от scanline[0] в конец строки сделать. И также меня вдруг осенило как работать с перевернутым массивом так как будто он не перевернут. И то что Ша тут партизанит, не думаю, что это чему то меня учит, просто я потратил кучу времени чтобы понять то что мог понять с одного поста ответа тут ) удивительное отношение на форуме, я уже тут полгода со всем этим сношаюсь, а ко мне относятся так как будто я студент пришел кусовую нахаляву списать )

Вообщем вроде все починил, 3.3 миллисекунды на 1920 на 1080 шарашит, но че то на win7 работает, а на XP нет...нада будет смотреть опять (

← →
Вова (2013-09-02 01:42) [100]

хотя в начале Ша конечно меня нереально продвинул ) сам бы я до такого не дошел. Спал бы спокойно )) Сейчас скорость программы даже создает определенные трудности, она работает так быстро, что приходится паузы ставить, что бы инфа успевала обновляться ) но зато есть задел на бОльшие объемы данных. Хотя второй фильтр все еще медленней 170 милисекунд, но уже его в 2 раза убыстрил )

> И также меня вдруг осенило как работать с перевернутым массивом
> так как будто он не перевернут. И то что Ша тут партизанит,
> не думаю, что это чему то меня учит, просто я потратил
> кучу времени чтобы понять то что мог понять с одного поста
> ответа тут )

А вот это и есть самый лучший способ действительно разобраться в вопросе: дойти самому, а не получить готовое на блюдечке :)

Как ускорить снятие скриншота, Ассемблерная вставка Найти похожие ветки