Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Чёрно-белые изображения 
:(
    Опции темы
Sergey89
Дата 25.10.2004, 17:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 122
Регистрация: 14.9.2004

Репутация: нет
Всего: нет
Как в delphi из цветного сделать чёрно белое изображение?
--------------------
mlib.com.ru
PM MAIL   Вверх
Kesh
Дата 25.10.2004, 20:51 (ссылка) | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Эксперт
Сообщений: 2488
Регистрация: 31.7.2002
Где: Германия, Saarbrü cken

Репутация: 1
Всего: 54
Код

//Решение в лоб...
var
 i,j: integer;
 Color: TColor;
 B: TBitmap;
 Mid: Byte;
 Res: integer;
begin
// Сначала перевод в градации серого как среднее арифметическое цветовых компонент
 for i := 0 to imgMain.Picture.Bitmap.Height-1 do
     for j := 0 to imgMain.Picture.Bitmap.Width-1 do
       begin
         Color := ColorToRGB(imgMain.Picture.Bitmap.Canvas.Pixels[j,i]);
         Mid := Round((GetRValue(Color)+GetGValue(Color)+GetBValue(Color))/3);
         imgMain.Picture.Bitmap.Canvas.Pixels[j,i] := RGB(Mid,Mid,Mid);
       end;
// А потом из градаций серого в ч.б...
 for i := 0 to imgMain.Picture.Bitmap.Height-1 do
     for j := 0 to imgMain.Picture.Bitmap.Width-1 do
       begin
         Color := ColorToRGB(imgMain.Picture.Bitmap.Canvas.Pixels[j,i]);
         if GetRValue(Color)<128 then Mid := 0 else Mid := 255;
         imgMain.Picture.Bitmap.Canvas.Pixels[j,i] := RGB(Mid,Mid,Mid);
       end;
end;



--------------------
user posted image
PM MAIL WWW ICQ Skype   Вверх
Illusion Dolphin
Дата 25.10.2004, 21:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63
А теперь более правильное решение, в котором правильно преобразуется цвет и немного быстрее:

Код


type

type
 TRGB=record
 b,g,r : byte;
  end;
 Type
   ARGB=array [0..1] of TRGB;
   PARGB=^ARGB;

procedure BlackWhite(image : tbitmap);
var
 i, j, c : integer;
 p : PARGB;
begin
image.PixelFormat:=pf24bit;
for i:=0 to image.Height-1 do
begin
 p:=image.ScanLine[i];
 for j:=0 to image.Width-1 do
 begin
  c:=round(0.3*p[j].r+0.59*p[j].g+0.11*p[j].b);
  if c>=128 then c:=255 else c:=0; //эту строку надо убрать чтобы получить градации серого
  p[j].r:=c;
  p[j].g:=c;
  p[j].b:=c;
 end;
end;
end;



Это сообщение отредактировал(а) Illusion Dolphin - 25.10.2004, 21:27


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Kesh
Дата 25.10.2004, 21:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Эксперт
Сообщений: 2488
Регистрация: 31.7.2002
Где: Германия, Saarbrü cken

Репутация: 1
Всего: 54
Illusion Dolphin А откуда берутся эти коэффициенты?.. 0.3 0.59 и 0.11


--------------------
user posted image
PM MAIL WWW ICQ Skype   Вверх
Illusion Dolphin
Дата 25.10.2004, 23:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63
Цитата

А откуда берутся эти коэффициенты

Очень просто: если взять три лампочки разных цветов (красный, синий и зелёный) и одинаковой мощности светимости, то человеческий глаз будет думать, что все они светятся с разной интенсивностью, т.к. чувствительность глаза зависит от длины волны света. Отсюда получается, что при переводе в чёрно-белый (т.е. по сути в интенсивность) ДЛЯ ЧЕЛОВЕКА нужно брать эти коэффициенты и т.к. все тут пока ещё люди, то пользуются именно этим разложением. Т.е. это вопрос по сути относится к физике+биологии\физиологии человека


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
cardinal
Дата 19.11.2004, 00:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Инженер
****


Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: нет
Всего: 99
Цитата(Sergey89 @ 25.10.2004, 16:55)
Как в delphi из цветного сделать чёрно белое изображение?

Если с "сохранением серых тонов", то читайте тут:
http://www.compuphase.com/riemer.htm


--------------------
Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино".  А. и Б. Стругацкие
PM   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0666 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.