| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Оптимизация кода
Вова © (2013-06-25 20:17:00)
Страницы: < 1 2 3 4 5 6 7 8 9 10 11 >
Есть процедура задачей которой является приведения пикселя любого цвета к цвету одного из диапазонов. Но скорость ее работы огорчает меня, можно ли ее как нибудь ускорить?
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-08-23 02:58:00) [41]function RGB2(r, g, b: Byte): COLORREF;
begin
Result := (b or (g shl 8) or (r shl 16));
end;
методом научного тыка я выяснил, что теперь каналы как раз RGB и идут, а были BGR, а вот где альфа канал я так и не понял...
Вова (2013-08-23 02:48:00) [42]
function ColorToRGB(Color: TColor): Longint;
begin
if Color < 0 then
Result := GetSysColor(Color and $000000FF) else
Result := Color;
end;
Вова (2013-08-23 02:41:00) [43]
function RGB(r, g, b: Byte): COLORREF;
begin
Result := (r or (g shl 8) or (b shl 16));
end;
во т.е. я так понимаю она как раз делает BGR? но в Start^ 4 байта, и куда прилепляется 4й?
Sapersky (2013-08-23 02:41:00) [44]По поводу варианта с ColorToRGB - посмотрел бы, что она делает, Ctrl-клик и все дела.
В общем, не нужна она тут, rrgb.RGB := color должно работать.
Вариант со сдвигами - ещё в [21] писали, что нужно отрезать нужные байты масками.
Вова (2013-08-23 02:34:00) [45]ша тут нипричем, массив можно выкинуть вообще, и это ничего не изменит.
Start^ := ConvertColorToRGBColorMap(Start^).color;
т.е. вот такой код дает точно такой же результат. но... это значение вернула функция RGB(255,255,0); причем у меня там нет ниодной функции, которая генерит голубой цвет...а в итоговом бмп он есть...т.е. если даже допустить, что входной цвет у меня какой то неправильный, то выходной то как становится голубым? вот в чем вопрос )
Sapersky (2013-08-23 02:25:00) [46]Всё-таки запутался в этих битах:
Start^ := ColorMap[(i shr 4 and $F) or (i shr 16 and $F) or (i shr 28)];
Sapersky (2013-08-23 02:23:00) [47]Ну мне не сразу стало очевидно, пришлось вчитаться в [119].
Sha тоже хорош - изменил порядок цветов и упомянул об этом практически вскользь, я сначала подумал что acb это опечатка.
Делаем нормальный порядок цветов, хотя и менее оптимально:
$BbGgRr00 -> $00000RGB
R на 1 вправо, 4 бита.
G на 4 вправо, 16 бит.
B на 7 вправо, 28 бит.
i := Start^;
Start^ := ColorMap[(i shr 1 and $F) or (i shr 4 and $F) or (i shr 28)];
7 операций вместо 5.
Вова (2013-08-23 02:02:00) [48]здорово что хоть кому то все очевидно...
т.к. мне и теперь стало еще непонятней чем было.
Sapersky (2013-08-23 01:49:00) [49]С битами всё объяснено в [119], только мне кажется лучше обозвать стандартными "цветными" буквами:
$00aabbcc -> $00000acb
$00RrGgBb -> $00000RBG
внезапно RBG, а не RGB. На этом можно сэкономить, B не двигать, R и G обрабатывать вместе.
Сейчас у нас (с учётом доп. сдвига i := Start^ shr 8):
$00BbGgRr -> $00000BRG
вроде ж всё очевидно: пара B_G двигается на 3 символа вправо (байт - два символа, сдвиг на полтора байта = shr 12), and $F0F отрезает всё лишнее. R никуда не двигается, просто отрезается лишнее маской $F0.
В результате имеем то самое шаманское заклинание.
А цвета в таблицу нужно подставлять в порядке BRG, получается.
Мог бы и сам понять, если бы внимательно читал, что тебе пишут...
Вова (2013-08-23 01:47:00) [50]RGB(255, 255, 255);дело в этой функции...
Вова (2013-08-23 01:21:00) [51]
TRGB = record
case integer of
1: (RGB: LongInt);
2: (B, G, R, O: BYTE);
var
rRGB:TRGB;
rrgb.RGB := ColorToRGB(color);
RGBV.red := rrgb.B;
RGBV.green := rrgb.G;
RGBV.blue := rrgb.R;
CODE</>
RGBV.red := color;
RGBV.green := color shr 8;
RGBV.blue := color shr 16;
оба варианта дают одинаковый результат. (второй старый на 24 бита был). то что было раньше желтым теперь красное, и появился голубой....откуда блин голубой, у меня в массиве его вообще нет.
Function ConvertColorToRGBColorMap(color: LongInt; ColSel: string = 'None')
: TColorWithName;
var
RGBV: trgbcolor;
bg: Boolean;
rb: Boolean;
rg: Boolean;
rRGB:TRGB;
begin
// rrgb.RGB := ColorToRGB(color);
// RGBV.red := rrgb.B;
// RGBV.green := rrgb.G;
// RGBV.blue := rrgb.R;
RGBV.red := color;
RGBV.green := color shr 8;
RGBV.blue := color shr 16;
rb := almostEqual(RGBV.red, RGBV.blue);
bg := almostEqual(RGBV.blue, RGBV.green);
rg := almostEqual(RGBV.red, RGBV.green);
with RGBV do
if rg and rb and bg then // тогда это серый или черный или белый
begin
if red > 230 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 bg 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 rb and (red > 130) then
begin
result.color := RGB(255, 0, 255);
result.Name := 'Pink';
end // розовый
else if (blue < green) and (blue < red) and rg 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 InitColorMap();
var
i, j, k: byte;
begin
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 * 256 * 256 + j * 256 + k) * 16).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;
Function ConvertBmpToRGBColorMap(var tBmp: Tbitmap;
ColSel: String = 'None'): Boolean;
var
QP: TQuickPixels;
Pixel1: Cardinal;
x: integer;
y: integer;
i: integer;
numCol: byte;
Start,Stop:pInteger;
begin
if (tBmp.Height > 2) and (tBmp.Width >= 1) then
begin
numCol := TextColorToDigit(ColSel);
if numCol = 0 then
begin
Start := tBmp.ScanLine[tBmp.Height - 1];
Stop := tBmp.ScanLine[0];
repeat
i:= Start^;
Start^ := ColorMap[i shr 12 and $F0F or i and $F0];
inc(Start);
inc(Pixel1);
until Start = Stop;
end;
Result := true;
end
else
Result := false;
end;
Германн (2013-08-23 01:13:00) [52]
> и ниодной нормальной инструкции с картинками
))))
Вова (2013-08-23 00:57:00) [53]
> Проще всего как раз в этом месте поменять red и blue, чтобы
> не ковырять биты заново. И ещё i:= Start^ shr 8, чтобы
> привести BGRA к BGR.
не ( не помогает, еще больше цвета путаются.
ненавижу тех кто придумал вот эту хренотень с битмапами и всем вывернутым на изнанку ( и ниодной нормальной инструкции с картинками.
Sapersky (2013-08-23 00:50:00) [54]Проще всего как раз в этом месте поменять red и blue, чтобы не ковырять биты заново. И ещё i:= Start^ shr 8, чтобы привести BGRA к BGR.
Вова (2013-08-23 00:34:00) [55]
RGBV.red := color;
RGBV.green := color shr 8;
RGBV.blue := color shr 16;
блин, а это теперь тогда тоже не правильно? чот как не крутил все равно лажа (
Вова (2013-08-23 00:18:00) [56]
repeat
i:= Start^;
Start^ := ColorMap[i shr 12 and $F0F or i and $F0];
inc(Start);
inc(Pixel1);
until Start = Stop;
да (
проблемма в том, что я так и не понял что все это значит(i shr 12 and $F0F or i and $F0). Вообщем первую проблему то я решил.....но, при таком преобразовании, результат вовсе не такой как был раньше (
вместо желтого красный ну и т.д ( как поменять?
Sapersky (2013-08-23 00:10:00) [57][78]:
> Проблемы с цветами видимо из-за того, что порядок цветовых
> компонент изменился, раньше было RGB, сейчас BGR. Нужно
> сдвиги и and'ы с масками поменять соот-но.
Точнее BGRA, раз это 32 бита.
Вова (2013-08-22 23:43:00) [58]итаг, я приступил к воплощению сего плана и начал переворачивать все шо не попадя. и вот ниже процедура, часть из которой закоментирована. И суть проблемы в том, что закоментированный и раскоментированный участки делают вроде бы одно и тоже. Но нижний участок при обратном преобразовании в битмап дает нормальные цвета. А вот тот что ща закоментирован, желтый делает голубым, голубой светлокоричневым и т.д. получается очень красиво, но нихрена не работает в результате. Почему так и как исправить верхний закоментированный кусок? )
function ConvertBmpToRGBColorMapM(tbmp:TBitmap; var M: TMass;
Mass: TColorMapByte): Boolean;
var
Pixel1,i,x,y:Integer;
Start,Stop:pInteger;
QP: TQuickPixels;
begin
// Start := tbmp.ScanLine[tbmp.Height - 1];
// Stop := tbmp.ScanLine[0];
// Pixel1:= 0;
// repeat
// i:= Start^;
// M.Mass[Pixel1] := i;
// //Mass[i shr 12 and $F0F or i and $F0];
// inc(Start);
// inc(Pixel1);
// until Start = Stop;
QP := TQuickPixels.Create;
QP.Attach(tbmp);
for y := 0 to QP.Height - 1 do
begin
for x := 0 to QP.Width - 1 do
begin
Pixel1 := QP.GetPixels32(x, y);
M.Mass[x + y * M.Xsize] := Pixel1;
//Mass[Pixel1 shr 12 and $F0F or Pixel1 and $F0];
end;
end;
Result := true;
QP.Free;
Result := true;
end;
DevilDevil (2013-07-29 21:00:00) [59]> Вова (29.07.13 20:31) [151]
дак ты покажи рабочий вариант )
p.s.
и рассчёт индекса в табличке выглядит как-то странно
Вова (2013-07-29 20:31:00) [60]как то так было:
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 миллисекунды, ток все через черную полоску.
> и даж цвета похожи на те что я выводил
только я ему картинку неправильную давал
| |
