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-30 20:04:00) [141]


function ConvertBmpToRGBColorMapM(var tBmp: Tbitmap; var M: TMass;
 Mass: TColorMapByte): Boolean;
var
 Count,h,w:integer;
 ppixel: pAnsiChar;
 pixel: integer;
 pp   : pInteger;
begin

 h := tbmp.Height-1;
 count := tbmp.Height * tbmp.Width;
 ppixel:= tbmp.ScanLine[h];
 repeat
   
   pp := pInteger(ppixel);
   pixel:=pInteger(ppixel)^ and $FFFFFF;

     
     pp^ := ColorMap[Pixel shr 12 and $F0F or Pixel and $F0];
 
   inc(ppixel,3);

   dec(Count);

 until Count <1;

 Result := true;
end;


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

Вова   (2013-06-30 19:31:00) [142]


function ConvertBmpToRGBColorMapM(tBmp: Tbitmap; var M: TMass;
 Mass: TColorMapByte): Boolean;
var
 Count,h,w:integer;
 ppixel: pAnsiChar;
 pixel: integer;
 pp   : pInteger;
begin

 h := tbmp.Height-1;
 count := tbmp.Height * tbmp.Width;
 repeat
   ppixel:= tbmp.ScanLine[h];
 
   pp := pInteger(ppixel);
   pixel:=pInteger(ppixel)^ and $FFFFFF;

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

   inc(ppixel,3);
   dec(h);
   dec(Count);
  until h <0;

 Result := true;
end;

че то ничего не происходит, картинка вообще не меняется.

Вова   (2013-06-30 19:15:00) [143]

Вообще я этот массив изобретал именно потому, что в нем быстрее все читается и пишется, поэтому я при первом же проходе битмапа (например при вычислении среднего перепада яркостей в том же цикле) выгружал в массив одновременно его переводя в градацию серого, а потом и в черно белый, получается что теперь обратно переделывать нужно? (

Вова   (2013-06-30 19:12:00) [144]

попробовал менять в том же битмапе как в ссылке, но возник вопрос, а как в значение на которое указывает указатель AnsiChar записать Integer?

Вова   (2013-06-30 18:45:00) [145]


function ConvertBmpToRGBColorMapM(tBmp: Tbitmap; var M: TMass;
 Mass: TColorMapByte): Boolean;
var
 Count,h,w:integer;
 ppixel: pAnsiChar;
 pixel: integer;
begin

 h := tbmp.Height-1;

 repeat
   ppixel:= tbmp.ScanLine[h];
   w := 0;

   repeat
     pixel:=pInteger(ppixel)^ and $FFFFFF;
     inc(ppixel,3);

     M.Mass[(h)*tbmp.Width+w] := Mass[pixel shr 12 and $F0F or pixel and $F0];
       inc(w);
   until w = tbmp.Width-1;
 
   dec(h);
 until h=0;

 Result := true;
end;

блин, боюсь что мне теперь не до скорости ) кое как перевернул картинку в нормальное состояние, но цвета вставляются все равно не те. И даже не то что красный вместо синего, а вообще хрен поймешь как...да и скорость 23мс. что с цветами? (

Sha   (2013-06-30 16:24:00) [146]

1. Хинт: строки расположены в памяти с одинаковым смещением одна относительно другой. Подумай, как это можно использовать.

2. "Ничего кроме" означает "ничего кроме". Должно получиться нечто вроде Grayscale2 или Grayscale3, на которые я давал ссылку.

Вова   (2013-06-30 16:01:00) [147]


> а где нормальная процедура?


да че то не получается пока )

Sha   (2013-06-30 15:19:00) [148]

> где 5-10 раз?

а где нормальная процедура?

Sha   (2013-06-30 15:15:00) [149]

0. Зачем опять проверять формат каждого кадра?

1. Адрес начала строки кратен 4. Поэтому если у тебя ширина картинки не кратна 4, то ScanLine надо вызывать для каждой строки.

2. Любой пиксел, кроме последнего, можно читать за одно обращение.
 ppixel: pAnsiChar;
 pixel: integer;
 pixel:=pInteger(ppixel)^ and $FFFFFF; inc(ppixel,3);
Не надо никаких RGB, r, g, b - это лишнее.

Вова   (2013-06-30 14:36:00) [150]

ой, вместо Pixel1 там row^

Вова   (2013-06-30 14:35:00) [151]

на 8 битной  9 милисекунд


function ConvertBmpToRGBColorMapM(tBmp: Tbitmap; var M: TMass;
 Mass: TColorMapByte): Boolean;
var

 Pixel1: Cardinal;
 i, j: integer;
 Row: ^byte;
 Count:integer;
begin

 Count := tbmp.Width * tbmp.Height;
 Row   := tbmp.ScanLine[tBmp.Height - 1];

 repeat

   M.Mass[Count-1] := Mass[Pixel1 shr 12 and $F0F or Pixel1 and $F0];

   inc(Row);
   dec(Count);

 until Count=0;


где 5-10 раз?

Вова   (2013-06-30 14:21:00) [152]


function ConvertBmpToRGBColorMapM(tBmp: Tbitmap; var M: TMass;
 Mass: TColorMapByte): Boolean;
var

 Pixel1: Cardinal;
 x: integer;
 y: integer;
 r,g,b:byte;
 i, j: integer;
 Row: ^byte;
 Count:integer;
begin
 IF tBmp.PixelFormat <> pf24bit then
   exit;

 Count := tbmp.Width * tbmp.Height;
 Row   := tbmp.ScanLine[tBmp.Height - 1];

 repeat
   r := row^;
   inc(Row);
   g := row^;
   inc(Row);
   b := row^;
   Pixel1 := RGB(r,g,b);

   M.Mass[Count-1] := Mass[Pixel1 shr 12 and $F0F or Pixel1 and $F0];

   inc(Row);
   dec(Count);

 until Count=0;

получилось 10 миллисекунд, на купикселях 13. Но я чувствую что я написал тут какую то лажу

Вова   (2013-06-29 21:21:00) [153]

http://guildalfa.ru/alsha/node/16

Sha   (2013-06-29 16:27:00) [154]

> Вова   (29.06.13 11:22) [49]
> в купикселях есть общая процедура GetPixel, SetPixel и отдельная на каждый формат.

не нужны они тебе

> Но в купикселях написано, что вызывать конкретный быстрее.

на заборах тоже много чего понаписано, но тебе ж не приходить в голову проверять?

> Сканлайн я проверял, купиксели купикселят на 30% быстрее.

Бред. Ты опять  что-то не то проверил. Зачем тебе надо кувыркаться с цветом?
А Прямое чтение из памяти всегда быстрее, чем любое действие, выполненное чужой процедурой.

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

вот это Pixel1 := QP.GetPixels24(x, y);

может, это поможет http://guildalfa.ru/alsha/node/14

> изменение формата я могу впринципе и убрать, оно там для "перестраховки".

все перестраховки делаются обычно в начале программы

Как я понимаю, тебе просто не хочется ускорить обработку кадра еще раз в 5-10.
Ну так посто скажи, и мы закончим лохматить бабушку.

Вова   (2013-06-29 15:22:00) [155]


function ConvertBmpToRGBColorMapM(QP: TQuickPixels; var M: TMass;
 Mass: TColorMapByte): Boolean;
var
 Pixel1: Cardinal;
 x: integer;
 y: integer;
begin
 for y := 0 to QP.Height - 1 do
 begin
   for x := 0 to QP.Width - 1 do
   begin
     Pixel1 := QP.GetPixels24(x, y);
     // Pixel1 := ColorMap[numcol][Pixel1 shr 12 and $F0F or Pixel1 and $F0];
     // FindConvertedColor(Pixel1, MainColor).color;
     M.Mass[x + y * M.Xsize] := Mass[Pixel1 shr 12 and $F0F or Pixel1 and $F0];
   end;
 end;
 Result := true;
end;

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

даж меньше 10

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

этот кусок это процентов 10 от всей программы, если вы таки считаете, что так легко все перелопатить. Тем более еще хз где мне это аукнется. Так что это пока не приоритет, когда буду точить напильником тогда. В принципе по данному куску, результат уже превзошел все мои ожидания )

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

ох, вот самый конструктивный топик форума чуть не получился ) и началось )

Inovet   (2013-06-29 11:52:00) [159]

Помогите оптимизировать, но мне лень оптимизировать. Что-то напоминает.

Anatoly Podgoretsky   (2013-06-29 11:49:00) [160]


> Я с самого начала выбрал 24вот и мучаюсь с ним до сих пор,
>  т.к. лень везде менять.
А что я не так делаю с купикселями?

А вот это.

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

Наверх

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