-
Как мне достать значения цветов (красного, зеленого и синего) из цвета?
-
var
r,g,b: byte;
color: TColor;
begin
r := byte(color);
g := byte(color shr 8);
b := byte(color shr 16);
end;
-
function GetRValue(color: tcolor): byte;
и т.д.
-
Спосибо
-
дежавю? :)
-
type
TColor4b = record
r,g,b,a :byte;
...
var
color: TColor;
r: byte;
...
begin
...
r := TColor4b (color).r;
...
end;
-
> [3] lubass © (22.10.07 20:38)
варианты [1] и [2] - идеентичны. Но я бы предпочел первый, поскольку нет лишнего вызова процедур.
-
> @!!ex © (23.10.07 11:40) [6]
А чем тебе мой вариант не нравится, там бообще обращение напрямую к значению без shr.
Правка:
TColor4b = record
r,g,b,a :byte;
end;
-
> А чем тебе мой вариант не нравится, там бообще обращение
> напрямую к значению без shr.
без shr написано, или без shr откомпилируется?
-
> antonn © (23.10.07 13:42) [8]
>
> > А чем тебе мой вариант не нравится, там бообще обращение
>
> > напрямую к значению без shr.
>
> без shr написано, или без shr откомпилируется?
Именно без shr откомпилируется.
-
> [7] rts111 © (23.10.07 12:37)
Ну хотя бы потому, что придется приведение типов использовать при переходе TColor<->TColor4b.
а так... конечно лучший вариант. С ним лично я и работаю. Только не с WinAPI, а с OpenGL, там так удобнее.
-
> [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];
TRGBQuad(Line[j]).rgbBlue := TRGBQuad(Pix).rgbRed;
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;
-
> 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;
-
операции битового сдвига выполняюца за один такт процессора и этим все сказано.
-
> [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];
with TRGBQuad(Line[j]) do begin
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; Но твоего юмора насчет одной миллисекундны я не вкурил.
-
> homm © (24.10.07 05:52) [14]
А зачем ты rgbGreen := rgbGreen;
-
> Но твоего юмора насчет одной миллисекундны я не вкурил.
Да, глупо. Так я хотел сказать что такой способ быстрее.
-
> [15] rts111 © (24.10.07 07:44)
> А зачем ты rgbGreen := rgbGreen;
А за тем, что-бы убрать оптимизацию алгоритма под задачу, и абстрагироватся от задачи как можно больше. В принципе можешь и так написать: Temp := rgbRed;
rgbRed := rgbGreen;
rgbGreen := rgbBlue;
rgbBlue := Temp; Но я думаю это еше более замедлит твой вариант.
-
> homm © (24.10.07 11:28) [17]
> Но я думаю это еше более замедлит твой вариант.
Я не понял, при чем тут ЕЩЕ БОЛЬШЕ замедлит, ведь мой вариант быстрее?
Или у тебя на ПК не быстрее?
-
> homm © (24.10.07 11:28) [17]
А от задачи, никак невозможно абстрагироваться.
Хочешь я приведу пример? ( только вечером, сейчас некогда )
-
> [18] rts111 © (24.10.07 11:57)
> Я не понял, при чем тут ЕЩЕ БОЛЬШЕ замедлит, ведь мой вариант
> быстрее?
Твой вариант на моей машине на моем тестовом примере, который прогоняется ровно 100 раз отрабатывает за 300 mSec, как и мой вариант с shr и shl.
> [19] rts111 © (24.10.07 12:00)
> А от задачи, никак невозможно абстрагироваться.
Согласен, но то, что в [12] на трогается один из каналов — явное читерство :)
-
> Твой вариант на моей машине на моем тестовом примере, который
> прогоняется ровно 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;
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;
Тут уж не придраться, все один к одному.А можно придумать пример когда будут все наоборот. Вовод такой: не стоит обобщать, и нужно писать для компилятора а не для себя, когда требуется скорость.
-
> [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];
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
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;
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;
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]
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;
|
Есть новые 
Нет новых [134431 +10][b:0][p:0.007]