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-06-29 11:30:00) [161]

изменение формата я могу впринципе и убрать, оно там для "перестраховки". И даже могу передавать в процедуру уже не tbmp а сразу QP, только это врядли поможет, потому что аттач мне все равно нужно делать на новый кадр, и эта процедура вызывается раз на кадр.

Вова   (2013-06-29 11:22:00) [162]


> 2. зачем нужно изменение PixelFormat?Ты ДОЛЖЕН уметь обрабатывать
> любой допустимый формат.


в купикселях есть общая процедура GetPixel, SetPixel и отдельная на каждый формат. Я с самого начала выбрал 24 вот и мучаюсь с ним до сих пор, т.к. лень везде менять. Но в купикселях написано, что вызывать конкретный быстрее. Сканлайн я проверял, купиксели купикселят на 30% быстрее.

А что я не так делаю с купикселями?

Sha   (2013-06-29 10:22:00) [163]

Замечание.

Пункт [47.4] подразумевает об работу с массивом типа
 TColorMapByte = array[0..16*16*16-1] of byte;
через указатель на его начало
 PColorMapByte= ^TColorMapByte
аналогично тому, как используется ScanLine.

Sha   (2013-06-29 10:14:00) [164]

> Вова   (29.06.13 01:42) [45]

Улучшения ConvertBmpToRGBColorMapM, чтобы получить еще одно заметное ускорение:

1. зачем этот оператор
 numCol := TextColorToDigit(MainColor);
внутри функции?
У тебя НЕ ДОЛЖНОэтого быть нигде, кроме процедур инициализации.

2. зачем нужно изменение PixelFormat?
Ты ДОЛЖЕНуметь обрабатывать любой допустимый формат.

3. зачет тебе
 QP: TQuickPixels;
То, как ты применяешь TQuickPixels только создает дополнительные тормоза
Посмотри пример для ScanLine из справки. Его вполне достаточно. И быстрее будет.
Во вложенном цикле (который бежит по пикселам строки) НЕ ДОЛЖНОбыть обращений к процедурам.

4. Массив MassColorMap, конечно может быть двумерным, но во вложенном цикле ты ДОЛЖЕНработать с одномерным массивом. Подумай, как это сделать.

5. Ты ДОЛЖЕНвыделить двойной цикл обработки изображения (и ничего кроме него) в отдельную процедуру.

Inovet   (2013-06-29 03:57:00) [165]

Так, к слову.

> [45] Вова   (29.06.13 01:42)
> if nameCol = 'Red' then
>     result := 1;
> if nameCol = 'Blue' then
>     result := 2;


if nameCol = 'Red' then
 result := 1;
else if nameCol = 'Blue' then
 result := 2;
else if
...


> [45] Вова   (29.06.13 01:42)
> if ABS(a - b) < 10 then
>   result := true
> else
>   result := false;


result := ABS(a - b) < 10

Зачем повторять это в ConvertColorToRGBColorMap? Я знаю один ответ - чтобы найти приключений. А теперь эту функцию вызвать 100500 раз.

Вова   (2013-06-29 01:42:00) [166]


TColorMapByte = array[0..16*16*16-1] of byte;

TMassOfColorMap = array[1..9] of TColorMapByte;
//0 - все цвета(не используется)
//1 - красный белый (255), остальное черный
//2 - синий   белый
//3 - зеленый белый
//4 - белый   белый
//5 - черный  белый
//6 - темно -серый
//7 - светло-серый
//8 - желтый
//9 - розовый

var
 MassColorMap  :TMassOfColorMap;

инициализация

function TextColorToDigit(nameCol: string): byte;
begin

 result := 0;

 if nameCol = 'Red' then
     result := 1;
 if nameCol = 'Blue' then
     result := 2;

 if nameCol = 'Green' then
     result := 3;

 if nameCol = 'White' then
     result := 4;

 if nameCol = 'Black' then
     result := 5;

 if nameCol = 'DarkGray' then
     result := 6;
 if nameCol =  'LightGray' then
     result := 7;

 if nameCol = 'Yellow' then
     result := 8;

 if nameCol = 'Pink' then
     result := 9;
 
end;

function DigitColorToText(nameCol: byte): string;
begin
 case nameCol of
   1:
     result := 'Red';
   2:
     result := 'Blue';
   3:
     result := 'Green';
   4:
     result := 'White';
   5:
     result := 'Black';
   6:
     result := 'DarkGray';
   7:
     result := 'LightGray';
   8:
     result := 'Yellow';
   9:
     result := 'Pink';
   else
     result := 'None';
 end;
end;

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, 240) 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 (ColSel = result.Name) then
   begin
     result.color := 255; //картинка инвертирована для дальнейшей обработки
   end
   else
   begin
     result.color := 0;
   end;
end;

Procedure InitColorMapMass();
var
 i, j, k, col: byte;
begin
 for col := 1 to 9 do
   for i := 0 to 15 do
     for j := 0 to 15 do
       for k := 0 to 15 do
         MassColorMap[col][i * 256 + 16 * k + j] := ConvertColorToRGBColorMap
           ((i * 256 * 256 + j * 256 + k) * 16,DigitColorToText(col)).color;

 // for i:=0 to 15 do for j:=0 to 15 do for k:=0 to 15 do ColorMap[i*256+16*k+j]:=ConvertColorToRGBColorMap((i*16+15)*256*256+(j*16+15)*256+(k*16+15));
end;

собственно процедура, которая перелопачивает все изображение (конвертирует в двух цветное, по сути в 2 яркости):


function ConvertBmpToRGBColorMapM(tBmp: Tbitmap; var M: TMass;
 MainColor: string): Boolean;
var
 QP: TQuickPixels;
 Pixel1: Cardinal;
 x: integer;
 y: integer;
 numCol: byte;
begin
 Result := false;

 if MainColor = 'None' then
   exit;

 numCol := TextColorToDigit(MainColor);

 if numCol = 0 then
   exit;

 if (tBmp.Height > 2) and (tBmp.Width >= 1) then
 begin
   tBmp.PixelFormat := pf24bit;

   QP := TQuickPixels.Create;
   QP.Attach(tBmp);

   M := TMass.Create();

   M.Xsize := QP.Width;
   M.Ysize := QP.Height;
   M.size := M.Xsize * M.Ysize;

   M.NewMassSize(M.size);

   for y := 0 to QP.Height - 1 do
   begin
     for x := 0 to QP.Width - 1 do
     begin
       Pixel1 := QP.GetPixels24(x, y);
       M.Mass[x + y * M.Xsize] := MassColorMap[numCol]
         [Pixel1 shr 12 and $F0F or Pixel1 and $F0];
     end;
   end;
   QP.Free;
   Result := true;
 end;

end;

Sha   (2013-06-29 00:55:00) [167]

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

Sha   (2013-06-29 00:51:00) [168]

> Вова   (29.06.13 00:08) [40]
> то что вызывать сразу из массива, а не из фунции, то это если что то и дало, то я не заметил

Потому и не заметил, что засекал не время предоления стометровки,
а суммарное время с разминкой перед бегом.

Не стоит делать выводы из неправильно поставленных экспериментов.

Sha   (2013-06-29 00:44:00) [169]

наверно, потому, что GetTickCount тикает 1 раз в 15-16 сек

Вова   (2013-06-29 00:12:00) [170]

по сравнению с первоначальными 300-400  милисекунд на картинку 1920x1080 скорость выросла до 30-40 милисекунд, хотя иногда и 15-16 хз почему так )

Вова   (2013-06-29 00:08:00) [171]

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

MBo   (2013-06-28 16:25:00) [172]

>у меня вроде одинаковый)

:)
Это я, балбес, с прямым углом перепутал (с or, xor)

Sha   (2013-06-28 16:24:00) [173]

и размер элемента массива становится 1 байт (или даже бит - это можно сделать, если размер имеет значение)

Sha   (2013-06-28 16:21:00) [174]

искомый цвет задается не именем, а адресом массива

Sha   (2013-06-28 16:13:00) [175]

Тогда 10 массивов лучше

Вова   (2013-06-28 16:12:00) [176]

да но по сути это
1)  видеопоток
2)  ищутся разные объекты в разном цвете

Sha   (2013-06-28 16:08:00) [177]

Где?
Лучше 1 массив инициализировать каждый раз, когда надо.
Все твои случаи сводятся к этому.
И все будет просто летать, т.к. вызовов функции при работе с картинками вообще не будет.

Вова   (2013-06-28 16:05:00) [178]

даж 10, 1 универсальный и 9 по штуке на каждый цвет.

Вова   (2013-06-28 16:04:00) [179]

таки вы уже хотите сказать что лучше 9 массивов забубенить по 4к элементов?

Sha   (2013-06-28 15:40:00) [180]

> Вова   (28.06.13 15:10) [26]

И эта. Не надо хранить имена. Правильное объявление ColorMap в [22].

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

Наверх

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