Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2003.11.20;
Скачать: [xml.tar.bz2];

Вниз

Пиксель   Найти похожие ветки 

 
Юля   (2003-07-24 14:17) [0]

Уважаемые мастера!!! Подскажите каким образом можно узнать на фотке число пикселей, например желтого цвета. Если можно, то с примерчиком, буду очень благодарна.


 
MBo   (2003-07-24 14:28) [1]

Нужно их сосчитать.
медленно - canvas.pixels
быстрее - scanline
махом - http://www.delphimaster.ru/articles/pixels/index.html


 
iXuSs   (2003-07-24 22:23) [2]

Сайт:
http://www.efg2.com

И это:
http://www.efg2.com/Lab/Graphics/Colors/ShowImage.htm


 
Fenik   (2003-07-24 22:43) [3]

Очень просто:

function HowManyColours(Bitmap: TBitmap; Color: TColor): Integer;
var R, G, B: Byte;
p: pByteArray;
x, y: Integer;
begin
Result := 0;
R := Lo(Color);
G := Lo(Color shr 8);
B := Lo((Color shr 8) shr 8);
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
p := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do
if (B = p[x*3]) and
(G = p[x*3+1]) and
( R = p[x*3+2]) Очень просто:

function HowManyColours(Bitmap: TBitmap; Color: TColor): Integer;
var R, G, B: Byte;
p: pByteArray;
x, y: Integer;
begin
Result := 0;
R := Lo(Color);
G := Lo(Color shr 8);
B := Lo((Color shr 8) shr 8);
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
p := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do
if (B = p[x*3]) and
(G = p[x*3+1]) and
(R = p[x*3+2]) then Inc(Result);
end;
end;

...

x := HowManyColours(Bmp, clYellow);


 
iXuSs   (2003-07-24 23:34) [4]

> Colours

Гм... англичанин?


 
Fenik   (2003-07-25 00:32) [5]

А ты переведи..


 
Юля   (2003-07-25 06:48) [6]

>Fenik Все здорово, только x постоянно равен 0 :((


 
wiz   (2003-07-25 13:46) [7]

> Юля Процедура работает (сам проверял ;). Может быть все дело в том, что в фотке нет чистого желтого цвета?

Тогда нужно брать не только сам желтый, но и лежащие рядом цвета.

Например так:


function HowManyColoursSmooth(Bitmap: TBitmap; Color: TColor; smoothing:double): Integer;
var R, G, B: Byte;
p: pByteArray;
x, y: Integer;
delta:double;
begin
Result := 0;
R := Lo(Color);
G := Lo(Color shr 8);
B := Lo((Color shr 8) shr 8);
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
p := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do
begin
delta:=sqrt(sqr(B - p[x*3])+sqr(G - p[x*3+1])+sqr(R - p[x*3+2]));
if delta<smoothing then Inc(Result);
( Bmp, clYellow, smooth)
> Юля Процедура работает (сам проверял ;). Может быть все дело в том, что в фотке нет чистого желтого цвета?

Тогда нужно брать не только сам желтый, но и лежащие рядом цвета.

Например так:


function HowManyColoursSmooth(Bitmap: TBitmap; Color: TColor; smoothing:double): Integer;
var R, G, B: Byte;
p: pByteArray;
x, y: Integer;
delta:double;
begin
Result := 0;
R := Lo(Color);
G := Lo(Color shr 8);
B := Lo((Color shr 8) shr 8);
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
p := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do
begin
delta:=sqrt(sqr(B - p[x*3])+sqr(G - p[x*3+1])+sqr(R - p[x*3+2]));
if delta<smoothing then Inc(Result);
end;
end;
end;

...

smooth:=30;
x := HowManyColoursSmooth(Bmp, clYellow, smooth);


параметр smooth задает максимальную разницу между цветом pixel"а и целевым цветом

2 Fenik: Приношу искренние извинения, за использование (и модификацию) вашего кода


 
Fenik   (2003-07-25 18:08) [8]

> Юля (25.07.03 06:48)

>Fenik Все здорово, только x постоянно равен 0 :((


Или на изображении нет того цвета который подсчитывается, или битмэп изначально не полноцветный (не 24 бит на пиксель), что при переводе его в полноцветный (Bitmap.PixelFormat := 24Bit) искомый цвет искажается.

У меня функция работает безупречно.


> wiz © (25.07.03 13:46)

> 2 Fenik: Приношу искренние извинения, за использование (и модификацию) вашего кода


Я просто улыбаюсь :)))


 
Fenik   (2003-07-25 21:45) [9]

> Я просто улыбаюсь :)))

В смысле, непонятно за что вы извиняетесь :))
Это же замечательно!


 
wiz   (2003-07-26 02:39) [10]

2 Fenik: Просто разные люди реагируют по-разному на использование их кода. Тут, как говорится, лучше перебдеть, чем недопить...
;)))



Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2003.11.20;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.011 c
1-65991
Слэш2
2003-11-10 15:22
2003.11.20
FormStyle поменять назад


1-65894
Liss
2003-11-08 18:20
2003.11.20
Delphi & Outlook


3-65773
TATIANA
2003-10-30 10:16
2003.11.20
Хранимые процедуры


1-65942
JL
2003-11-10 21:51
2003.11.20
защита программ


14-66116
Alex Konshin
2003-10-28 22:05
2003.11.20
Возвращаясь к изображению в воздухе





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский