Обратная функцыя к RGB() существует?

← →
lubass © (2007-10-22 20:25) [0]

Как мне достать значения цветов (красного, зеленого и синего) из цвета?

← →
homm © (2007-10-22 20:32) [1]

var r,g,b: byte; color: TColor; begin r := byte(color); g := byte(color shr 8); b := byte(color shr 16); end;

← →
Pa5ha © (2007-10-22 20:32) [2]

function GetRValue(color: tcolor): byte;
и т.д.

← →
lubass © (2007-10-22 20:38) [3]

Спосибо

← →
antonn © (2007-10-22 20:40) [4]

дежавю? :)

← →
rts111 © (2007-10-22 23:21) [5]

type

TColor4b = record
r,g,b,a :byte;

...

var
color: TColor;
r: byte;
...

begin

...
r := TColor4b (color).r;
...

end;

← →
@!!ex © (2007-10-23 11:40) [6]

> [3] lubass © (22.10.07 20:38)

варианты [1] и [2] - идеентичны. Но я бы предпочел первый, поскольку нет лишнего вызова процедур.

← →
rts111 © (2007-10-23 12:37) [7]

> @!!ex © (23.10.07 11:40) [6]

А чем тебе мой вариант не нравится, там бообще обращение напрямую к значению без shr.

Правка:
TColor4b = record
r,g,b,a :byte;
end;

← →
antonn © (2007-10-23 13:42) [8]

> А чем тебе мой вариант не нравится, там бообще обращение
> напрямую к значению без shr.

без shr написано, или без shr откомпилируется?

← →
rts111 © (2007-10-23 14:35) [9]

> antonn © (23.10.07 13:42) [8]
>
> > А чем тебе мой вариант не нравится, там бообще обращение
>
> > напрямую к значению без shr.
>
> без shr написано, или без shr откомпилируется?

Именно без shr откомпилируется.

← →
@!!ex © (2007-10-23 18:03) [10]

> [7] rts111 © (23.10.07 12:37)

Ну хотя бы потому, что придется приведение типов использовать при переходе TColor<->TColor4b.
а так... конечно лучший вариант. С ним лично я и работаю. Только не с WinAPI, а с OpenGL, там так удобнее.

← →
homm © (2007-10-23 19:19) [11]

> [7] rts111 © (23.10.07 12:37)
> А чем тебе мой вариант не нравится, там бообще обращение
> напрямую к значению без shr.

procedure SwapChanels(BMP: TBitmap); type ADWORD = array [0..0] of DWORD; var i, j: Integer; Pix: DWORD; Line: ^ADWORD; begin for i := 0 to BMP.Height-1 do begin Line := BMP.ScanLine[i]; for j := 0 to BMP.Width-1 do begin Pix := Line[j]; //Line[j] := GetBValue(Pix) + (GetGValue(Pix) shl 8) + (GetRValue(Pix) shl 16); // 1200 mSec //Line[j] := byte(Pix shr 16) + (byte(Pix shr 8) shl 8) + (byte(Pix) shl 16); // 300 mSec //Line[j] := TRGBQuad(Pix).rgbRed + (TRGBQuad(Pix).rgbGreen shl 8) + (TRGBQuad(Pix).rgbBlue shl 16); //650 mSec TRGBQuad(Line[j]).rgbBlue := TRGBQuad(Pix).rgbRed; // 610 mSec TRGBQuad(Line[j]).rgbGreen := TRGBQuad(Pix).rgbGreen; TRGBQuad(Line[j]).rgbRed := TRGBQuad(Pix).rgbBlue; end; end; end; procedure TForm1.Button1Click(Sender: TObject); type ADWORD = array [0..0] of DWORD; var i, T: Integer; begin Image1.Picture.Bitmap := TBitmap.Create; Image1.Picture.Bitmap.LoadFromFile("C:\1.bmp"); Image1.Picture.Bitmap.PixelFormat := pf32bit; T := GetTickCount; for i := 0 to 98 do SwapChanels(Image1.Picture.Bitmap); ShowMessage(IntToStr(GetTickCount-T)); end;

← →
rts111 © (2007-10-23 23:24) [12]

> homm © (23.10.07 19:19) [11]

procedure SwapChanels(BMP: TBitmap);
type
ADWORD = array [0..0] of DWORD;
var
i, j: Integer;
//Pix: DWORD;
Line: ^ADWORD;
Temp: byte;
begin
for i := 0 to BMP.Height-1 do
begin
Line := BMP.ScanLine[i];
for j := 0 to BMP.Width-1 do
with TRGBQuad(Line[j]) do
begin
Temp := rgbRed; // 1 mSec!!! :)
rgbRed := rgbBlue;
rgbBlue := Temp;
end;
end;
end;

← →
Pa5ha © (2007-10-24 01:32) [13]

операции битового сдвига выполняюца за один такт процессора и этим все сказано.

← →
homm © (2007-10-24 05:52) [14]

> [12] rts111 © (23.10.07 23:24)

В таком варианте действительно пошустрее работает.

procedure SwapChanels(BMP: TBitmap); type ADWORD = array [0..0] of DWORD; var i, j: Integer; Pix: DWORD; Line: ^ADWORD; Temp: byte; begin for i := 0 to BMP.Height-1 do begin Line := BMP.ScanLine[i]; for j := 0 to BMP.Width-1 do begin Pix := Line[j]; //Line[j] := GetBValue(Pix) + (GetGValue(Pix) shl 8) + (GetRValue(Pix) shl 16); // 1200 mSec //Line[j] := byte(Pix shr 16) + (byte(Pix shr 8) shl 8) + (byte(Pix) shl 16); // 300 mSec //Line[j] := TRGBQuad(Pix).rgbRed + (TRGBQuad(Pix).rgbGreen shl 8) + (TRGBQuad(Pix).rgbBlue shl 16); //650 mSec {TRGBQuad(Line[j]).rgbBlue := TRGBQuad(Pix).rgbRed; // 610 mSec TRGBQuad(Line[j]).rgbGreen := TRGBQuad(Pix).rgbGreen; TRGBQuad(Line[j]).rgbRed := TRGBQuad(Pix).rgbBlue;} with TRGBQuad(Line[j]) do begin // 300 mSec Temp := rgbRed; rgbRed := rgbBlue; rgbBlue := Temp; rgbGreen := rgbGreen; end; end; end; end; procedure TForm1.Button1Click(Sender: TObject); type ADWORD = array [0..0] of DWORD; var i, T: Integer; begin Image1.Picture.Bitmap := TBitmap.Create; Image1.Picture.Bitmap.LoadFromFile("C:\1.bmp"); Image1.Picture.Bitmap.PixelFormat := pf32bit; T := GetTickCount; for i := 0 to 99 do SwapChanels(Image1.Picture.Bitmap); ShowMessage(IntToStr(GetTickCount-T)); end;

Но твоего юмора насчет одной миллисекундны я не вкурил.

← →
rts111 © (2007-10-24 07:44) [15]

> homm © (24.10.07 05:52) [14]

А зачем ты rgbGreen := rgbGreen;

← →
rts111 © (2007-10-24 07:53) [16]

> Но твоего юмора насчет одной миллисекундны я не вкурил.

Да, глупо. Так я хотел сказать что такой способ быстрее.

← →
homm © (2007-10-24 11:28) [17]

> [15] rts111 © (24.10.07 07:44)
> А зачем ты rgbGreen := rgbGreen;

А за тем, что-бы убрать оптимизацию алгоритма под задачу, и абстрагироватся от задачи как можно больше.
В принципе можешь и так написать:
Temp := rgbRed; rgbRed := rgbGreen; rgbGreen := rgbBlue; rgbBlue := Temp;

Но я думаю это еше более замедлит твой вариант.

← →
rts111 © (2007-10-24 11:57) [18]

> homm © (24.10.07 11:28) [17]

> Но я думаю это еше более замедлит твой вариант.

Я не понял, при чем тут ЕЩЕ БОЛЬШЕ замедлит, ведь мой вариант быстрее?
Или у тебя на ПК не быстрее?

← →
rts111 © (2007-10-24 12:00) [19]

> homm © (24.10.07 11:28) [17]

А от задачи, никак невозможно абстрагироваться.
Хочешь я приведу пример? ( только вечером, сейчас некогда )

← →
homm © (2007-10-24 12:09) [20]

> [18] rts111 © (24.10.07 11:57)
> Я не понял, при чем тут ЕЩЕ БОЛЬШЕ замедлит, ведь мой вариант
> быстрее?

Твой вариант на моей машине на моем тестовом примере, который прогоняется ровно 100 раз отрабатывает за 300 mSec, как и мой вариант с shr и shl.

> [19] rts111 © (24.10.07 12:00)
> А от задачи, никак невозможно абстрагироваться.
Согласен, но то, что в [12] на трогается один из каналов — явное читерство :)

← →
rts111 © (2007-10-24 13:48) [21]

> Твой вариант на моей машине на моем тестовом примере, который
> прогоняется ровно 100 раз отрабатывает за 300 mSec, как
> и мой вариант с shr и shl.

А ты ( //Pix := Line[j]; ) не забыл закоментировать? Там ведь эта операция лишняя. Хотя, по идее компилятор сам должен игнорировать.

> Согласен, но то, что в [12] на трогается один из каналов
> — явное читерство :)

:)
Да уж читерство, но ведь функция то делает именно то что нужно.
Вот пример, как обещал:

var TestColor :TColor =$01010101; TestSum :integer =0; procedure Test1; var i :integer; begin for i := 0 to 1000 do begin TestSum := TestSum + TRGBQuad(TestColor).rgbRed + TRGBQuad(TestColor).rgbGreen + TRGBQuad(TestColor).rgbBlue; // 703 //TestSum := TestSum + byte(TestColor) + byte(TestColor shr 8) + byte(TestColor shr 16); // 1318 end; end; procedure TForm1.Button1Click(Sender: TObject); var i :Integer; T :cardinal; begin T := GetTickCount; for i := 0 to n do Test1; Caption := IntToStr(GetTickCount-T); end;

Тут уж не придраться, все один к одному.А можно придумать пример когда будут все наоборот.

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

← →
homm © (2007-10-24 14:01) [22]

> [21] rts111 © (24.10.07 13:48)
> А ты ( //Pix := Line[j]; ) не забыл закоментировать?

оптимизатор закоментировал. Да и не забыл, здесь на форуме просто такой вариант.

> TestSum := TestSum + TRGBQuad(TestColor).rgbRed + TRGBQuad(TestColor)
> .rgbGreen + TRGBQuad(TestColor).rgbBlue; // 703
> //TestSum := TestSum + byte(TestColor) + byte(TestColor
> shr 8) + byte(TestColor shr 16); // 1318

Не тянет на тестовый пример теста различных подходов к доступу. Получил то ты как цвета, а заносишь то уже в просто интеджер…
Попробуй, кстати реальнцю картинку подсунуть, мне кажется результат должен изменится, все-же тут у тебя операций с памятью больше, чем в моем варианте.

Впрочем я не настаиваю, что вариант shr (который кстати и не мной) быстрее, просто действительно нужно под задачу подбирать, а в данной задаче, и так ясно, что быстрее MMX :)

Кстати, там можно тогда сказать что и с твоей стороны тоже читерство:
Зачем Pix то для "моего" ( который тоже не мой ) случая использовать?

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

procedure SwapChanels(BMP: TBitmap); type ADWORD = array [0..0] of DWORD; var i, j: Integer; Pix: DWORD; Line: ^ADWORD; Temp: byte; begin for i := 0 to BMP.Height-1 do begin Line := BMP.ScanLine[i]; for j := 0 to BMP.Width-1 do begin Pix := Line[j]; //Line[j] := byte(Pix shr 16) + (byte(Pix shr 8) shl 8) + (byte(Pix) shl 16); with TRGBQuad(Line[j]) do Line[j]:=rgbBlue+(rgbGreen shl 8)+(rgbRed shl 16); end; end; end;

> [24] rts111 © (25.10.07 01:56)
> Смотри, код по структуре абсолютно аналогичный, и сравни
> результаты:

Идентично
with TRGBQuad(SL[j]) do begin // 300 mSec Temp := rgbRed; rgbRed := rgbBlue; rgbBlue := Temp; rgbGreen := rgbGreen; end;

Ладно, хватит игратся, теперь сравни с этим:
procedure SwapChanels(SourceBitmap: TBitmap); type ARGBQuad = array [0..0] of DWORD; PARGBQuad = ^ARGBQuad; AByte = array [0..0] of Byte; PAByte = ^AByte; const int62: int64 = $ff00ff00ff00ff00; int63: int64 = $000000ff000000ff; var SL: PARGBQuad; //V1, V2: TRGBQuad; //R: ^TRGBQuad; i, j: Integer; A_1, A: Integer; Delta: DWORD; W, H: Integer; Temp: byte; Pix: DWORD; begin SL := SourceBitmap.ScanLine[0]; Delta := DWORD(SourceBitmap.ScanLine[1]) - DWORD(SourceBitmap.ScanLine[0]); W := SourceBitmap.Width shr 1; h := SourceBitmap.Height; if CPUisMMX then begin asm movq mm3, [int62] movq mm4, [int63] mov ecx, H push ecx @@loop1: mov edx, [SL] mov ecx, W @@loop2: movq mm0, [edx] movq mm1, mm0 pslld mm0, 24 movq mm2, mm1 psrld mm1, 16 psrld mm0, 8 pand mm1, mm4 por mm0, mm1 pand mm2, mm3 por mm0, mm2 movq [edx], mm0 add edx, 8 dec ecx jnz @@loop2 mov eax, [Delta] add [SL], eax dec dword ptr [esp] jnz @@loop1 pop ecx emms end; end else begin …… end; end;

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

> Ладно, хватит игратся, теперь сравни с этим:

Тогда уж так:

procedure SwapChanels(SourceBitmap: TBitmap); type ARGBQuad = array [0..0] of DWORD; PARGBQuad = ^ARGBQuad; AByte = array [0..0] of Byte; PAByte = ^AByte; const int62: int64 = $ff00ff00ff00ff00; int63: int64 = $000000ff000000ff; var SL: PARGBQuad; //V1, V2: TRGBQuad; //R: ^TRGBQuad; i, j: Integer; A_1, A: Integer; Delta: DWORD; W, H: Integer; Temp: byte; Pix: DWORD; begin SL := SourceBitmap.ScanLine[0]; Delta := DWORD(SourceBitmap.ScanLine[1]) - DWORD(SourceBitmap.ScanLine[0]); W := SourceBitmap.Width shr 1; h := SourceBitmap.Height; if CPUisMMX then begin asm movq mm3, [int62] movq mm4, [int63] mov ecx, H push ecx @@loop1: mov edx, [SL] mov ecx, W @@loop2: { movq mm0, [edx] movq mm1, mm0 pslld mm0, 24 movq mm2, mm1 psrld mm1, 16 psrld mm0, 8 pand mm1, mm4 por mm0, mm1 pand mm2, mm3 por mm0, mm2 movq [edx], mm0 } movq mm0, [edx] pshufw mm1, mm0, $b1 pand mm0, mm3 por mm0, mm1 movq [edx], mm0 add edx, 8 dec ecx jnz @@loop2 mov eax, [Delta] add [SL], eax dec dword ptr [esp] jnz @@loop1 pop ecx emms end; end else begin …… end; end;

Т.е. вот так точнее будет:

...
const
//int62: int64 = $ff00ff00ff00ff00;
int62: int64 = $00ff00ff00ff00ff;
...
...
movq mm0, [edx]
pshufw mm1, mm0, $b1
pand mm1, mm3
por mm0, mm1
movq [edx], mm0
...

Вааа, ошибся!

Вот так правильно:

...
const
// int62: int64 = $ff00ff00ff00ff00;
// int63: int64 = $000000ff000000ff;
int62: int64 = $00ff00ff00ff00ff;
int63: int64 = $ff00ff00ff00ff00;
...
...
movq mm0, [edx]
pshufw mm1, mm0, $b1
pand mm1, mm3
pand mm0, mm4
por mm0, mm1
movq [edx], mm0
...

> [28] rts111 © (25.10.07 13:03)

Только не падай, но код
movq mm0, [edx] pshufw mm1, mm0, $E4 pslld mm0, 24 pshufw mm2, mm1, $E4 psrld mm1, 16 psrld mm0, 8 pand mm1, mm4 por mm0, mm1 pand mm2, mm3 por mm0, mm2 movq [edx], mm0

работает на 2,5% быстрее, чем приведенный тобой. Сам в шоке.

> [29] homm © (25.10.07 19:32)
> Только не падай, но код работает на 2,5% быстрее, чем приведенный тобой.

За то твой вариант можно оттюнинговать еше на 12% быстрее за счет одной хитрой команды в самом начале, чего лишен мой вариант…
PREFETCHT0 [edx+40]

Вот вариант с одним циклом, и компактней и наглядней. ( и вроде быстрее )
К тому же, обычный код и код на asm не смешаны внутри одной функции,
а то кто его знает как там компилятор все перетусует:
procedure SwapChanels( BMP :TBitmap ); procedure ExchangeRB( Data :pointer; Count :integer ); const ii2 :int64 = $ff00ff00ff00ff00; ii3 :int64 = $00ff00ff00ff00ff; asm movq mm2, [ii2] movq mm3, [ii3] mov ecx, edx @@loop: movq mm0, [eax] pshufw mm1, mm0, $b1 pand mm0, mm2 pand mm1, mm3 por mm0, mm1 movq [eax], mm0 add eax, 8 dec ecx jnz @@loop emms end; begin with BMP do ExchangeRB( ScanLine[Height-1] , ( Width * Height ) shr 1 ); end;

А что ты QueryPerformanceCounter не юзаешь?
Результаты теста точнее ведь же будут.
procedure TForm1.Button1Click(Sender: TObject); var i :Integer; t1,t2 :int64; begin Image1.Picture.Bitmap := TBitmap.Create; Image1.Picture.Bitmap.LoadFromFile("1.bmp"); Image1.Picture.Bitmap.PixelFormat := pf32bit; QueryPerformanceCounter(t1); for i:=0 to 100 do SwapChanels( Image1.Picture.Bitmap ); QueryPerformanceCounter(t2); caption := IntToStr(t2-t1); beep; end;

Обратная функцыя к RGB() существует? Найти похожие ветки