Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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


Страницы:   1 2

lubass ©   (2007-10-22 20:25:00) 

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

rts111   (2007-10-26 09:04:00) [1]

Вот вариант с одним циклом, и компактней и наглядней. ( и вроде быстрее )
К тому же, обычный код и код на 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;

homm   (2007-10-25 21:56:00) [2]

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

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

homm   (2007-10-25 19:32:00) [3]

> [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% быстрее, чем приведенный тобой. Сам в шоке.

rts111   (2007-10-25 13:03:00) [4]

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

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

...
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
...

rts111   (2007-10-25 12:53:00) [5]

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

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

rts111   (2007-10-25 12:42:00) [6]


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


Тогда уж так:


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;

homm   (2007-10-25 07:15:00) [7]

> [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-м, иначе последние пиксели в строке обрабатыватся не будут.

rts111   (2007-10-25 01:56:00) [8]

Кстати, там можно тогда сказать что и с твоей стороны тоже читерство:
Зачем 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;

homm   (2007-10-24 14:07:00) [9]

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

homm   (2007-10-24 14:01:00) [10]

> [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

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

rts111   (2007-10-24 13:48:00) [11]


> Твой вариант на моей машине на моем тестовом примере, который
> прогоняется ровно 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 12:09:00) [12]

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

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


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

rts111   (2007-10-24 12:00:00) [13]


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


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

rts111   (2007-10-24 11:57:00) [14]


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



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


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

homm   (2007-10-24 11:28:00) [15]

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

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

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

rts111   (2007-10-24 07:53:00) [16]


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


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

rts111   (2007-10-24 07:44:00) [17]


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


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

homm   (2007-10-24 05:52:00) [18]

> [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;

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

Pa5ha   (2007-10-24 01:32:00) [19]

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

rts111   (2007-10-23 23:24:00) [20]


> 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;

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо