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

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

Оптимизация кода


Страницы:   1 2 3 4 5 6 7 8 9 10 11

Вова ©   (2013-06-25 20:17:00) 

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


function almostEqual(a, b: byte): Boolean;
begin
 if ABS(a - b) < 10 then
   result := true
 else
   result := false;
end;

Function ConvertColorToRGBColorMap(color: LongInt; ColSel: String = 'None')
 : TColorWithName;
var
 RGBV: trgbcolor;
begin

 RGBV.red := color;
 RGBV.green := color shr 8;
 RGBV.blue := color shr 16;

 with RGBV do

   if almostEqual(red, green) and almostEqual(red, blue) and
     almostEqual(blue, green) then // тогда это серый или черный или белый
   begin
     if almostEqual(red, 255) then // белый
     begin
       result.color := RGB(255, 255, 255);
       result.Name := 'White';
     end
     else if red > 120 then
     begin
       result.color := RGB(190, 190, 190);
       result.Name := 'LightGray';
     end
     else if (red > 92) then // темно серый
     begin
       result.color := RGB(100, 100, 100);
       result.Name := 'DarkGray';
     end
     else
     begin
       result.color := RGB(0, 0, 0);
       result.Name := 'Black';
     end // черный
   end
   else
   begin
     if (red < green) and (red < blue) and almostEqual(green, blue) and
       (blue > 130) then
     begin
       result.color := RGB(0, 0, 255);
       result.Name := 'Blue';
     end // result:= rgb(0,255,255)//голубой
     else if (green < red) and (green < blue) and almostEqual(red, blue) and
       (red > 130) then
     begin
       result.color := RGB(255, 0, 255);
       result.Name := 'Pink';
     end // розовый
     else if (blue < green) and (blue < red) and almostEqual(green, red) and
       (green > 130) then
     begin
       result.color := RGB(255, 255, 0);
       result.Name := 'Yellow';
     end // желтый
     else if (red > green) and (red > blue) and (red > 130) then
     begin
       result.color := RGB(255, 0, 0);
       result.Name := 'Red';
     end // красный
     else if (blue > green) and (blue > red) and (blue > 130) then
     begin
       result.color := RGB(0, 0, 255);
       result.Name := 'Blue';
     end // синий
     else if (green > blue) and (green > red) and (green > 130) then
     begin
       result.color := RGB(0, 255, 0);
       result.Name := 'Green';
     end // зеленый
     else
     begin
       result.color := RGB(0, 0, 0);
       result.Name := 'Black';
     end
   end;

   if not (ColSel = 'None') then
     if not (ColSel = Result.Name) then
     begin
       result.color := RGB(255, 255, 255);
       result.Name := 'White'; //Если выборка только по одному цвету, то
       //все остальные цвета переводим в белый
     end
     else
     begin
       result.color := RGB(0, 0, 0);
       result.Name := 'Black'; //Если выборка только по одному цвету, то
       //этот цвет переводим в черный
     end

end;

Вова   (2013-07-01 17:49:00) [121]

я твой не менял, просто передал в функцию вот это...

Sha   (2013-07-01 17:46:00) [122]

У меня компилится без проблем. Ты мой код меняй.
Свой меняй. И свою секретную ошибку сюда давай.

Sha   (2013-07-01 17:46:00) [123]

* Ты мой код неменяй.

Вова   (2013-07-01 17:42:00) [124]


> результат давай: проценты или разы?


пока только ошибка j:=p[1];

Если p := tbmp.Scanline(tbmp.Height-1)

RWolf   (2013-07-01 17:41:00) [125]


> есть где нибудь описание "на пальцах"

учебник по информатике, 7-й класс.

Sha   (2013-07-01 17:38:00) [126]

Там в коде [81] ошибочка вкралась, исправить надо:

   if rest>0 then begin; //последний нечетный пиксел
     i:=pWordArray(p)[0]+pByteArray(p)[2] shl 16;
     i:=ColorMap[i and $F0 or i shr 12 and $F0F];
     pWordArray(p)[0]:=i;
     pByteArray(p)[2]:=i shr 16;
     inc(pAnsiChar(p),3);    
     end;

Sha   (2013-07-01 17:24:00) [127]

результат давай: проценты или разы?

Вова   (2013-07-01 17:24:00) [128]

есть где нибудь описание "на пальцах" как вот это i shr 24 and $F0 or j shr 4 and $F0F понять? )

Вова   (2013-07-01 17:22:00) [129]

омг, ну ради такого профита можно перейти и на 32, но вот только все эти i and $F0 это писец ) статью выше я читал, понял не очень, но это по сравнению с той статьей вообще космос )

Sha   (2013-07-01 17:12:00) [130]

> Sapersky
> В целом, насчёт ускорения в 5-10 раз Sha всё-таки загнул.
> ещё вариант - обрабатывать пачками по 4 пикселя

как бы нам это проверить... )

> Вова
> и в добавок эта битовая математика ад какой то

если скорость нужна, научишься и разберешься: )

var
 ColorMap: array[0..16*16*16-1] of integer;
procedure ShaConvert(p: pIntegerArray; rowcount, pixelcount: integer);
var
 i, j, t, rest: integer;
begin;
 pixelcount:=pixelcount*3;
 while rowcount>0 do begin;
   rest:=pixelcount;
   while rest>=6 do begin;
     i:=p[0];
     j:=p[1];
     t:=ColorMap[i shr 24 and $F0 or j shr 4 and $F0F];
     i:=ColorMap[i and $F0 or i shr 12 and $F0F];
     p[0]:=i or t shl 24;
     if rest<12 then begin;
       pWordArray(p)[2]:=t shr 8;
       inc(pAnsiChar(p),6);
       dec(rest,6);
       break;
       end;
     i:=p[2];
     j:=ColorMap[j shr 16 and $F0 or j shr 28 and $F or i shl 4 and $F00];
     p[1]:=t shr 8 or j shl 16;
     p[2]:=j shr 16 or ColorMap[i shr 8 and $F0 or i shr 20 and $F0F] shl 8;
     inc(pAnsiChar(p),12);
     dec(rest,12);
     end;
   if rest>0 then begin; //последний нечетный пиксел
     i:=pWordArray(p)[0]+pByteArray(p)[2] shl 16;
     i:=ColorMap[i and $F0 or i shr 12 and $F0F];
     pWordArray(p)[0]:=i;
     pByteArray(p)[2]:=i shr 16;
     end;
   dec(rowcount);
   inc(pAnsiChar(p),(4-pixelcount) and 3);
   end;
 end;

Вова   (2013-07-01 16:36:00) [131]

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

Sapersky   (2013-07-01 15:17:00) [132]

Или, если перейти на 32 бита сложно, ещё вариант - обрабатывать пачками по 4 пикселя (12 байт, 3 чтения по 4 байта). Опять же, развёртка цикла получается, тоже полезно.
Но для того чтобы выковырять эти 4 пикселя, понадобятся дополнительные сдвиги и and'ы. Функция станет совсем уж монструозной, через полгода сам без комментариев (и/или поллитры) не разберёшься.

Sapersky   (2013-07-01 14:54:00) [133]

Указатель увеличиваешь на 4, а цвет 24-битный, поэтому и полоска.
Скорость повышается из-за того, что доступ по выровненным на 4 адресам быстрее, чем невыровненный с шагом 3 (+ обращений на 25% меньше). Отсюда вывод - 32-битные битмапы должны быть быстрее, даже при большем размере данных.
Как вариант, результирующий битмап (или массив) можно сделать 8-битным, всё равно там цвета можно по пальцам пересчитать. Хотя не факт, что скорость при этом вырастет.

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

В целом, насчёт ускорения в 5-10 раз Sha всё-таки загнул. Не может такого быть за счёт отказа от вызова одной (несложной) функции и причёсывания всяких мелочей. Скорее уж проценты, а не разы.
При шаге 4 байта получились разы, но это другое.

Вова   (2013-07-01 13:31:00) [134]

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

Вова   (2013-07-01 13:30:00) [135]

function LockConvertBmpToRGBColorMapM(ppixel: pAnsiChar;last:pAnsiChar): Boolean;
var
 i    : integer ;
begin

 repeat;
  i:=pInteger(ppixel)^;
  pInteger(ppixel)^:=ColorMap[i shr 12 and $F0F or i and $F0];
  inc(ppixel,4)
  until ppixel=last;

 Result := true;
end;

лол, а вот так 2 миллисекунды, ток все через черную полоску.  и даж цвета похожи на те что я выводил

Sha   (2013-06-30 22:40:00) [136]

но в цикле [74] есть 2 ошибки

1. Затираем результатом то, что еще не обработали.
2. теоретически на последнем пикселе может быть AV из-за выхода за границу строки

Думай, как исправить

Sha   (2013-06-30 22:36:00) [137]

> а на что влияет and $FFFFFF

Оно отрезает старший байт прочитанного из памяти целого i, т.к. нужный нам триплет лежит в младших байтах. Без него все также работает только потому, что при вычислении индекса в таблице старший байт не участвует: [i shr 12 and $F0F or i and $F0].

//цикл по строке
repeat;
  i:=pInteger(p)^;
  pInteger(p)^:=ColorMap[i shr 12 and $F0F or i and $F0];
  inc(p,3)
  until p<last;

Вова   (2013-06-30 20:50:00) [138]

да в массив наверное быстрее даж 10 будет, но в перевернутый (

Вова   (2013-06-30 20:46:00) [139]


function LockConvertBmpToRGBColorMapM(ppixel: pAnsiChar;Count:integer): Boolean;
var
 //pixel: integer;
 pp   : pInteger;
begin

 repeat
   pp := pInteger(ppixel);

   //pixel:=pInteger(ppixel)^ and $FFFFFF;

   pp^ := ColorMap[pp^ shr 12 and $F0F or pp^ and $F0];

   inc(ppixel,3);

   dec(Count);

 until Count <1;

 Result := true;
end;

капитально ничего лишнего 16 миллисекунд. непонятные цвета. а на что влияет and $FFFFFF...  я че то не понял вроде без него все также.

Вова   (2013-06-30 20:08:00) [140]

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

Страницы:   1 2 3 4 5 6 7 8 9 10 11

Наверх

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