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

Вниз

Преобразование изображения   Найти похожие ветки 

 
Tasha   (2005-10-18 23:30) [0]

Подскажите, плиззззз, как в делфи сделать из цветной картинки черно-белую???


 
Fenik ©   (2005-10-19 00:08) [1]

Исходный текст:

{ **** UBPFD *********** by delphibase.spb.ru ****
>> Порог между двумя цветами на Bitmap

Bitmap преобразуется в двухцветное изображение.

Зависимости: Graphics
Автор:      Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:  Собственное написание (Николай федоровских)
Дата:       1 июня 2002 г.
************************************************ }

procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
type TRGB = record
      B, G, R: Byte;
    end;
    pRGB = ^TRGB;
   
 function ColorToRGB(Color: TColor): TRGB;
 begin
   with Result do begin
     R := Lo(Color);
     G := Lo(Color shr 8);
     B := Lo((Color shr 8) shr 8);
   end;
 end;

var x, y: Word;
   C1, C2: TRGB;
   Dest: pRGB;
begin
 Bitmap.PixelFormat := pf24Bit;
 C1 := ColorToRGB(Color1);
 C2 := ColorToRGB(Color2);
 for y := 0 to Bitmap.Height - 1 do begin
   Dest := Bitmap.ScanLine[y];
   for x := 0 to Bitmap.Width - 1 do begin
     //если среднеарифметическое R, G и B больше Value,
     //то точку (x, y) закрашиваем цветом Color1,
     //иначе - цветом Color2
     if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value
       then Dest^ := C1
       else Dest^ := C2;
     Inc(Dest);
   end;
 end;
end;


Пример использования:

Threshold(FBitmap, 127, clWhite, clBlack);

http://delphibase.spb.ru/?action=viewfunc&topic=mediaimg&id=10176


 
MBo ©   (2005-10-19 06:23) [2]

>Fenik
Думаю, тебе стоит явно указывать в описании своих процедур, работающих через Scanline, что они для 24-х битовых битмапов.


 
WondeRu ©   (2005-10-19 11:13) [3]

Fenik ©   (19.10.05 0:08) [1]
если среднеарифметическое R, G и B больше Value,

яркостные веса разные у R G B!!!

необходимо использовать одну из формул яркости:

Y = K1*R + K2*G + K3*B

1. 0,360*R + 0.530*G + 0.110*B
2. Стандаpт CCIR 601-1 (как в стандаpтной VGA-ой функции):
0,299*R + 0,587*G + 0,114*B
3. Стандаpт CCIR 709:
0,213*R + 0,715*G + 0,072*B
4. Стандаpт ITU:
0,222*R + 0,707*G + 0,071*B


http://wap.wonderu.com/index.wml?pid=3


 
Antonn ©   (2005-10-19 15:45) [4]

Fenik ©   (19.10.05 0:08) [1]
возможно не понял, ему нужно картинка в градациях серого(о как замутил), а не 2 цвета и порог. я так делал(веса цветов из посто[3] уж сам расставьте, меня и так устраивает:)):

procedure PrepareBitmapBW(_B_out:Tbitmap);
const
 Pixels = MaxInt div SizeOf(TRGBTriple);
type
 PRGBArray = ^TRGBArray;
 TRGBArray = array[0..Pixels-1] of TRGBTriple;
var x, y: Integer; RowOut: PRGBArray; _s:integer;
begin
 _B_out.PixelFormat:=pf24bit;
 for y:=0 to _B_out.Height-1 do begin
    RowOut:= _B_out.ScanLine[y];
   for x:=0 to _B_out.Width-1 do begin
         _s:=trunc((RowOut[x].rgbtRed+RowOut[x].rgbtGreen+RowOut[x].rgbtBlue)/3);
        if _s>255 then _s:=255; if _s<0 then _s:=0;
         RowOut[x].rgbtRed:=_s;
         RowOut[x].rgbtGreen:=_s;
         RowOut[x].rgbtBlue:=_s;
   end;
 end
end;


 
WondeRu ©   (2005-10-19 15:56) [5]

Antonn ©   (19.10.05 15:45) [4]
s:=trunc((RowOut[x].rgbtRed+RowOut[x].rgbtGreen+RowOut[x].rgbtBlue)/3);


см. [3] - нельзя использовать среднее арифметическое для вычисления яркости!


 
Fenik ©   (2005-10-19 18:09) [6]

> MBo ©  (19.10.05 06:23) [2]
> Думаю, тебе стоит явно указывать в описании своих процедур, работающих через Scanline, что они для 24-х битовых битмапов.


Да, я помню, когда мне посыпались письма, что функции не работают, я попросил во все вставить строку
Bitmap.PixelFormat := pf24Bit; :)
По-моему, это самое явное указание.
Кстати, база почему-то закрыта для записи. Забыл про неё Димка Маслов что ли?

> WondeRu ©  (19.10.05 11:13) [3]
> яркостные веса разные у R G B!!!


Да знаю я про эти стандарты, не кричи так :)

> необходимо использовать одну из формул яркости:

Почему это? В данном случае есть большая разница?

Ну замени

  if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value

на

with Dest^ do
  if (28*B+151*G+77*R) shr 8 > Value // это оптимизированная формула (0.299R+0.587G+0.114B)


Сможешь отличить результаты на глаз? :)

> Antonn ©  (19.10.05 15:45) [4]
> возможно не понял, ему нужно картинка в градациях серого(о как замутил), а не 2 цвета и порог.


Градации серого - это градации серого, а черно-белая - это черно-белая :))


 
Antonn ©   (2005-10-19 18:09) [7]

WondeRu ©   (19.10.05 15:56) [5]
см. [3] - нельзя использовать среднее арифметическое для вычисления яркости!

а слабо прочитать комментарий в скобках?
:)


 
Antonn ©   (2005-10-19 18:11) [8]

Fenik ©   (19.10.05 18:09) [6]
Градации серого - это градации серого, а черно-белая - это черно-белая :))

хм, по-моему, мы по разному понимаем значение "черно-белое". Телевизоры черно-белые видели? :)


 
Fenik ©   (2005-10-19 20:20) [9]

> Телевизоры черно-белые видели? :)

Видели. Это градации серого :)


 
Antonn ©   (2005-10-20 03:20) [10]

Fenik ©   (19.10.05 20:20) [9]
Видели. Это градации серого :)

однако называется черно-белый:)


 
WondeRu ©   (2005-10-20 13:56) [11]

Antonn ©   (19.10.05 18:09) [7]
а слабо прочитать комментарий в скобках?

Извини :) Я тока на исходник глянул :)))



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

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

Наверх




Память: 0.47 MB
Время: 0.041 c
2-1141994458
jeka_t
2006-03-10 15:40
2006.03.26
Как определить текущий TDBGrid.Row при событии DrawColumnCell?


6-1134211668
chistik
2005-12-10 13:47
2006.03.26
приём почты с hotmail


2-1142314019
Cirus
2006-03-14 08:26
2006.03.26
Активизация DBGRID


3-1139147979
OldNick
2006-02-05 16:59
2006.03.26
Удаленные записи в paradox


2-1142083990
Horadric
2006-03-11 16:33
2006.03.26
как из текстового поля Edit достать выражение





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