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

Вниз

Про пиксели - 2   Найти похожие ветки 

 
Серж Долгов   (2002-03-29 22:17) [0]

Благодарю за ответ, чтобы не было впечатления, что я от любопытства у народа время отнимаю - поясню ситуацию. Задача у проги такая. Ей передается сканированное изображение (*.BMP), затем необходимо вытянуть из этого файла кол-во пикселей такого -то цвета. Либо посчитать сумму всех не белых пикселей. Скорость работы прерогативой не является, каким из 3 методов проще все это дело крутануть?. Заранее извинюсь, но в ентом деле я пока чайник, разве что не закипаю пока от своих ошибок, если есть возможность поподробнее - очень прошу. Еще раз Вашему сайту и людям человеческое спасибо.


 
SDS   (2002-03-29 23:35) [1]

Самый простой (хотя это для кого как)
В цикле по Width и Height твоего BMP прогнать все пиксели с помощью Pixels[i,j] и посмотреть сколько появиться белый цвет, но скорость будет аховая (в смысле очень медленно, особенно если BMP большой)


 
MBo   (2002-03-30 11:39) [2]

с Bitmap.Canvas.Pixels обращаться очень просто.
у меня на P600 1280*960 пробегает за ~8-10 сек.

вот пример для Scanline (менее 1 сек.)

procedure TForm1.Button1Click(Sender: TObject);
type
TRGBTArray = array [word] of TRGBTriple;
PRGBTArray=^TRGBTArray;
var b:tbitmap;
i,j,n:integer;
p:PRGBTArray;
begin
b:=tbitmap.create;
b.LoadFromFile("e:\dsc00001.bmp");
n:=0;
for i:=0 to b.height-1 do begin
p:=b.ScanLine[i];
for j:=0 to b.width-1 do
if (p[j].rgbtBlue and p[j].rgbtRed and p[j].rgbtGreen)=$FF then
inc(n);
end;
label1.caption:=inttostr(n);// число белых пикселов
b.free;
end;


 
Серж Долгов   (2002-03-30 14:00) [3]

To MBo:

К сожалению, не мойгу в версии 3й дельфи scanline, а если так? (ниже привожу свою кривульку) Правда здесь ищется сумма всех небелых, но это не суть важно.
Чуть не забыл. О-Г-Р-О-М-Н-О-Е Вам спасибо

procedure TForm1.Button1Click(Sender: TObject);
type
var b:tbitmap;
i,j,n:integer;
begin
b:=tbitmap.create;
b.LoadFromFile("e:\dsc00001.bmp"); //есть ли возможность
//загрузки любого файла
//с винта?
n:=0;
For i:= 0 to b.height do // поясните смысл b.height-1
//пож-та
for j:= 0 to b. width do // -//- b.Width -1
if b.Canvas.Pixels [i,j]<>clWhite then
inc (n);
end;
edit1.caption:=inttostr(n);
b.free;
end;


 
MBo   (2002-03-30 14:21) [4]

любой bmp можно загрузить - а можно из другого источника, например, нарисовать или со сканера напрямую, если есть возможность.
b.height-1
потому что нумерация с нуля, если высота 10, то последняя строка с индексом 9

программа правильная.(кроме -1 пропущенных) и end перед Edit1. убери

Посмотри, как кодируется цвет - это Integer, 3 байта- RGB
если понадобится более сложное сравнение.


 
Серж Долгов   (2002-03-30 23:54) [5]

Всем уважаемым Мастерам вечер добрый.
Снова прошу у Вас помощи по предыдущему вопросу.
Добавил процедуру для загрузки изображения. Как теперь указать Дельфе, что считать колво пикселей нужно именно этого изображ-я. Пожайлуста помогите.

procedure TForm1.Button4Click(Sender: TObject);
Var
begin
With OpenPictureDialog1 Do
IF Execute then
Begin
Image1.Picture.LoadFromFile(FileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Image1:TBitMap;
i,j,Sum:integer;
begin
Image1:=TBitmap.create;
//b.LoadFromFile("e:\dsc00001.bmp");
Sum:=0;
For i:= 0 to Image1.Height-1 do
for j:= 0 to Image1.Width-1 do
if Image1.Canvas.Pixels [i,j]<>clWhite then
inc(Sum);
label9.caption:=inttostr(Sum);
Image1.free;
end;


 
Sergey_n   (2002-03-31 03:04) [6]

procedure TForm1.Button1Click(Sender: TObject);
var
pBits: array of Byte;
i: Integer;
j: Integer;
Sum: Integer;
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile("C:\My Documents\PERSONAL\History\VisitCard.bmp");

//Для Картинки типа BMP имеющей 4*8=32bit цветов
SetLength(pBits, Bitmap.Height * Bitmap.Width*4);
GetBitmapBits(Bitmap.Handle,640*480*4,pBits);
Sum :=0;
for i:=0 to Bitmap.Width-1 do begin
for j:=0 to Bitmap.Height-1 do begin
//pBits[i*480+j*4] Red
//pBits[i*480+j*4+1] Green
//pBits[i*480+j*4+2] Blue
//pBits[i*480+j*4+3] Не знаю
if pBits[i*Bitmap.Width+j*4]+pBits[i*Bitmap.Width+j*4+1]+pBits[i*Bitmap.Width+j*4+2]=765 then inc(Sum);
end;
end;
label9.caption:=inttostr(Sum);
//Если нужно отобразить, то раскоментарь строчки ниже
//Image1.Width := Bitmap.Width;
//Image1.Height := Bitmap.Height;
//Image1.Canvas.Draw(0,0,Bitmap);
Bitmap.Free;
end;


 
Sergey_n   (2002-03-31 03:06) [7]

Блин очепятка
GetBitmapBits(Bitmap.Handle,640*480*4,pBits);
заменить на
GetBitmapBits(Bitmap.Handle,Bitmap.Height * Bitmap.Width*4,pBits);
есессено


 
Sergey_n   (2002-03-31 03:06) [8]

Блин очепятка
GetBitmapBits(Bitmap.Handle,640*480*4,pBits);
заменить на
GetBitmapBits(Bitmap.Handle,Bitmap.Height * Bitmap.Width*4,pBits);
есессено


 
Серж Долгов   (2002-03-31 04:05) [9]

Спасибо. Интересует насколько плох предыдущий код?Мне просто его понять легче - просто копировать не хочу, мне в ентом разобраться нужно. И еще. Необходимо повесить открытие файла (любого из любой директории через Image1.Picture.LoadFromFile(FileName) и процедуру расчета на разные кнопари. Будет много рисунков, возможно большого размера - не хотелось бы что б после открытия имелась возможность просмотра чего там загрузилось, а затем уж процедурка рассчета. У меня не получилось корректно указать в procedure TForm1.Button1Click(Sender: TObject) на загруженный файл. Как это попрямее сделать. Ну и возвращусь - чем лучше предложенный алгоритм с практической точки зрения?
Заранее благодарен всем Вам.


 
Sergey_n   (2002-03-31 04:26) [10]

1. GetBitmapBits(Bitmap.Handle,Bitmap.Height * Bitmap.Width*4,pBits); загоняет битмар в массив, ну а с массивом работаь IMXO быстрее.
2. Из любого файла? Замени Bitmap.LoadFromFile("C:\My Documents\PERSONAL\History\VisitCard.bmp"); на Bitmap.LoadFromFile(OpenPictureDialog1.FileName"); но не забывай про битность рисунка, ее в принципе тоже можно выудить, если покопаться в хелпе
3. Воозможность просмотра:
//Если нужно отобразить, то раскоментарь строчки ниже
//Image1.Width := Bitmap.Width;
//Image1.Height := Bitmap.Height;
//Image1.Canvas.Draw(0,0,Bitmap);

вставить после Bitmap.LoadFromFile(OpenPictureDialog1.FileName"); и смотри на здоровье.
4. с прктической точки зрения:
a. имеешь доступ к каждой составляющей цвета (R,G,B) по отдельности
b. скорость (сравни сам)


 
Серж Долгов   (2002-04-01 01:03) [11]

Всем Мастерам своего дела вечер добрый. Грустно, но нужна Ваша помощь. Помогите разобраться. Привожу прежний код, а то Вам смотреть неудобно – скролировать придется, а чужое время уважать нужно. К делу. Помогите повесить процедуру открытия файла (бмп) и расчетноко блока n:=0; For i:= 0 to b.height do …… и.д.. на разные кнопари. Есть необходимость такая. Последнее. Не получается подружить процесс открытия любого файла (спрашивал – без ответа) Image1.Picture.LoadFromFile(FileName) с нижеприведенным кодом. Буду очень признателен, если процесс весь опишете в коде, что б уже не надоедать более по этому вопросу.
Искреннее спасибо Всем помогающим.


procedure TForm1.Button1Click(Sender: TObject);
type
var b:tbitmap;
i,j,n:integer;
begin
b:=tbitmap.create;
b.LoadFromFile("e:\dsc00001.bmp");
n:=0;
For i:= 0 to b.height do
for j:= 0 to b. width do
if b.Canvas.Pixels [i,j]=clWhite then
inc (n);
end;
label3.caption:=inttostr(n);
b.free;
end;



 
Серж Долгов   (2002-04-01 01:06) [12]

Всем Мастерам своего дела вечер добрый. Грустно, но нужна Ваша помощь. Помогите разобраться. Привожу прежний код, а то Вам смотреть неудобно – скролировать придется, а чужое время уважать нужно. К делу. Помогите повесить процедуру открытия файла (бмп) и расчетноко блока n:=0; For i:= 0 to b.height do …… и.д.. на разные кнопари. Есть необходимость такая. Последнее. Не получается подружить процесс открытия любого файла (спрашивал – без ответа) Image1.Picture.LoadFromFile(FileName) с нижеприведенным кодом. Буду очень признателен, если процесс весь опишете в коде, что б уже не надоедать более по этому вопросу.
Искреннее спасибо Всем помогающим.


procedure TForm1.Button1Click(Sender: TObject);
type
var b:tbitmap;
i,j,n:integer;
begin
b:=tbitmap.create;
b.LoadFromFile("e:\dsc00001.bmp");
n:=0;
For i:= 0 to b.height do
for j:= 0 to b. width do
if b.Canvas.Pixels [i,j]=clWhite then
inc (n);
end;
label3.caption:=inttostr(n);
b.free;
end;



 
Sergey_n   (2002-04-01 02:03) [13]

Я так и не понял... Чё те надо, вроде все написано, и даже скорость увеличили..... Разъясняй конкрктнее... и вообще причем тут Image1.Picture.LoadFromFile(FileName)????????????
Задай вопрос конткретно.


 
Mbo   (2002-04-01 06:49) [14]

var
form1:TForm1;
b:TBitmap;//глобальная переменная

procedure TForm1.FormCreate(Sender: TObject);
begin
b:=tbitmap.create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
b.free;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
b.LoadFromFile(OpenDialog1.Filename);
Image1.Picture.Assign(b);//если надо показывать
end;

procedure TForm1.Button2Click(Sender: TObject);
i,j,n:integer;
begin
For i:= 0 to b.height -1 do //еще раз подчеркиваю
for j:= 0 to b. width -1 do
if b.Canvas.Pixels [i,j]=clWhite then
inc (n);
end;
label3.caption:=inttostr(n);
end;


 
Mbo   (2002-04-01 06:50) [15]

n:=0 забыл перед циклом


 
Серж Долгов   (2002-04-02 02:52) [16]

TO Mbo, Sergey_n, SDS
Спасибо Вам огромное. За поддержку и терпение. (to Sergey_n - cогласен, чушь понаворотил в последнем вопросе)
Сейчас все компилится.
Ежели снова "попрошусь" - не "выгоняйте".
Имелось бы "виртуальне пиво" - "проставился" бы обизон. Хотя, говорят и безалкогольное-то пиво и то - первый шаг на пути к резиновой женщине 8)
Спасибо



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

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

Наверх





Память: 0.62 MB
Время: 0.029 c
7-24257
vasilevs2000
2002-05-22 07:23
2002.08.08
При печати шрифт меняется на абракадабру


7-24243
yozhik
2002-05-22 11:11
2002.08.08
как зашить rar.exe в мою прогу


3-23868
Китаец Ла Ме
2002-07-19 19:45
2002.08.08
МОЖНО ЛИ выполнить select-query для другого select-query?


6-24158
yastal
2002-01-10 16:38
2002.08.08
Нужно скачать по ftp с удаленного компьютера сразу несколько файлов


14-24186
wed
2002-07-11 17:59
2002.08.08
помогите с Betrieve





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский