Алгоритм преобразования монохромного изображения

← →
Штотоносец (2005-03-11 20:28) [0]

Не знаю как точно сказать. Вообщем есть монохромное изображение и надо его преобразовать в 2, 4, 8 и т.д. цветное, т.е. градацией серого. Во. Вроде понятно объяснил :)

← →
Virgo_Style © (2005-03-11 20:31) [1]

Осредняй значение яркости в некоторой области каждой точки, нормируй... И смотри, в какой диапазон попадает...

← →
YurikGL © (2005-03-11 20:31) [2]

Чего во что преобразовать то надо? Цветное->монохромное или монохромное->цветное? Вророе, вроде как, нельзя. А первое - формулу я как-то яндексом в свое время нашел...

← →
TUser © (2005-03-11 20:32) [3]

Не не понятно.
В монохромном изображении размера n*m есть m*n бит информации. Ты хочешь преобразовать его в изображение того же размера, но большей цветности, так? Там информации больше. Откуда брать занчения дополнительных бит.

← →
YurikGL © (2005-03-11 20:32) [4]

тьфу... прочитал

> 2, 4, 8 и т.д. цветно"е

по науке, делается это методами кластеризации...

← →
YurikGL © (2005-03-11 20:33) [5]

> Штотоносец (11.03.05 20:28)

можно поискать как Image-ready гифы делает...

← →
Штотоносец (2005-03-11 20:37) [6]

Нет не цветное, а как бы серое 8\ Всмысле если двухцветное, то это черный и белый, если 4, то белый, черный и две градации серого. Всего, максимально, какбы 256 градаций. Изображение-то монохромное, т.е. серое и то, что колор получить никак я понимаю, вообщем это и не надо.

← →
YurikGL © (2005-03-11 20:49) [7]

Тебе нужны методы кластеризации.
Кратко, суть в том, что произвольное множество точек делится на заранее заданное (в твоем случае) количество "сгущений". Результатом применения метода будут центры "сгущений". Дальше, вычисляя расстояние между конкретной точкой и центрами "сгущений" заменяем эту точку центром ближайшего "сгущения". Не уверен, что эти методы можно в инете нарыть, на на лабах такие рассчеты мы делали.

← →
Штотоносец (2005-03-11 21:01) [8]

Да уж, мудрено. А может у кого завалялся исходничек?

← →
Virgo_Style © (2005-03-11 21:02) [9]

> Да уж, мудрено

Мне тоже так показалось :-) А чем [1] не устраивает?

← →
Штотоносец (2005-03-11 21:05) [10]

Так там, помоему, еще мудреней :)

← →
YurikGL © (2005-03-11 21:09) [11]

> А чем [1] не устраивает?

есть у тебя картинка, где реально используются цвета
0,1,2,10,11,12,230,231,232,250,251,252.
Нужно к 4-м цветам преобразовать на основании чего будещ диапазоны цветов выбирать?

← →
Virgo_Style © (2005-03-11 21:50) [12]

Да, я, кажется, неправ :-) Это для Черный+Белый -> градации серого, а вопрос, как я теперь понял, о снижении цветности? Тогда молчу :-)

← →
TUser © (2005-03-11 21:50) [13]

> YurikGL ©

я понимаю - тут обратная задачав. воссановить информацию из изображения, где эта инфа потеряна. низя ...

← →
Virgo_Style © (2005-03-11 22:11) [14]

TUser © (11.03.05 21:50) [13]
Хм. Автор! Объясните народу - информацию надо потерять или найти? Градации серого - в меньшее количество градаций серого, или же B&W - в градации?
:-)

← →
Штотоносец (2005-03-11 23:52) [15]

Так, попробую. В ПАМЯТИ хранится изображение. Монохромное - 256 градаций. В зависимости от положения бегунка, на форму выводится изображение преобразованное с оригинала (в памяти). Поэтому восстановление потерянной информации не подразумевается из-за отсутствие таковой =)

← →
XProger © (2005-03-12 04:30) [16]

Штотоносец, дык тебе уменьшение кол-ва байт на пиксель нужно? ;)

← →
XProger © (2005-03-12 04:31) [17]

т.е. бит?
Допустим было изображение 8 бит на киксель урезали стало 7 бит ... 1 бита на пиксель. С потерей качества разумеется.

← →
Fenik (2005-03-12 12:05) [18]

Ты в баню?
Нет, я в баню.
Ааа, я думал, что ты в баню.

← →
Штотоносец (2005-03-12 13:19) [19]

Допустим есть изображение, у которого каждый Image2.Canvas.Pixels[w,h] равен некоему колору, в момнохроме от 0..255, точнее например RGB(0,0,0), это черный, а RGB(255,255,255), это белый.
Понятно, что если просто уменьшать это значение, то при двухцветности, рисунок станет просто черным, да это будет видно и раньше.

Я понимаю, что YurikGL [7] высказал верную идею, но у меня возникают проблемы с ее реализацией, точнее на проблемы, а я не знаю даже как начать.

← →
Virgo_Style © (2005-03-12 15:08) [20]

Самое дубовое решение - разбить диапазон 0..255 на поддиапазоны в нужном количестве. Например
0..128 - это цвет (0+128)/2
128..255 - это цвет (128+255)/2
Куда попадает твой серый - тем цветом он и станет.
Чуть менее дубовое - считать средний цвет для каждого диапазона.
Но это все равно дубово, а если надо хорошо - тогда [7]

← →
Штотоносец (2005-03-12 15:13) [21]

К сожалению мне надо уехать, а буду я в воскресенье вечером, тогда и продолжим.

← →
Fenik (2005-03-12 19:38) [22]

Ладно уж, даю грубый вариант:

procedure SetGrayScale(Bitmap: TBitmap; Value: Byte); var Pixel: pRGBTriple; x, y, n: Integer; A: array [Byte] of Byte; begin if Value > 1 then begin A[0] := 0; A[255] := 255; for x := 1 to 254 do begin case Value of 2: A[x] := Byte(x>127)*255; 3..127: begin n := Round(256/(Value-1)); n := Round(x/n)*n; if n <= 255 then A[x] := n else A[x] := 255; end; else A[x] := x; end; end; end else FillChar(A, SizeOf(A), 0); for y := 0 to Bitmap.Height - 1 do begin Pixel := Bitmap.ScanLine[y]; for x := 0 to Bitmap.Width - 1 do begin with Pixel^ do begin rgbtBlue := A[rgbtBlue]; rgbtGreen := A[rgbtGreen]; rgbtRed := A[rgbtRed]; end; Inc(Pixel); end; end; end;

← →
Fenik (2005-03-12 20:04) [23]

Забыл:
n := Round(256/(Value-1));
можно вынести из цикла :)

← →
Штотоносец (2005-03-14 18:16) [24]

У меня по YurikGL [7] получилось следующее;
procedure Tfrm_Main.GetGrayScale(Value:Integer); var i,w,h:integer; a,c:Real; b:byte; begin w:=0; h:=0; if value<>256 then a:=256/value; for i:=1 to Length(ArrByteImg) do begin b:=ArrByteImg[i-1]; if value<>256 then begin c:=Ceil(b/a); if (b-a*c)>(a/2) then c:=Floor(b/(a+1)); b:=Round(c*a); if (b=0) and (c<>0) then dec(b); end; Image2.Canvas.Pixels[w,h]:=b shl 16 + b shl 8 + b; inc(w); if w=Image2.Width then begin w:=0; inc(h); end; end; end;

Единственная проблема в то, что при 2-х цветности получаются 128 и 255, т.е. белый и серый, а не черный.
Посмотрите пожалуйста в чем проблема.

Да, вот еще. ArrByteImg это ArrByteImg:array of byte;
a:=0; SetLength(ArrByteImg,Image2.Height*Image2.Width-1); for h:=0 to Image2.Height-1 do begin for w:=0 to Image2.Width-1 do begin ArrByteImg[a]:=GetRValue(Image2.Canvas.Pixels[w,h]); inc(a); end; end;

← →
Fenik (2005-03-14 19:13) [25]

Это че за лабуда? :))
Я тебе процедуру дал? Дал.
Ты скорость работы сравнивал со своим произведением? Сомневаюсь.
Короче, не парься и возьми мою функцию. Правь в ней первоначальное заполнение массива по своему усмотрению и всё. Для двух цветов там как тебе надо работает.
Не забудь только Bitmap.PixelFormat := pf24Bit;

← →
Штотоносец (2005-03-14 19:24) [26]

Fenik [25]
Послушай, я не лабы пишу и мне завтра это не здавать, я для себя пишу, так сказать для общего развития, поэтому хочеться самому =)
Если хочешь помочь, так лучше укажи на ошибки, объясни, если не влом, а то; "Это че за лабуда?". Ты типа лох, я тебе все дал, а ты типа, даже просто код скопировать не можешь. Так можно инерпретировать твои слова. А это обидно.

← →
Fenik (2005-03-14 19:34) [27]

Прости, не хотел обидеть. Там вообще-то смайлы.. :)
Вместо Canvas.Pixels целесообразней использовать ScanLine. Это первое. (Выигрыш в скорости офигенный)
А второе - это че за лабуда? :))))) Шутю.
Ты можешь объяснить, зачем тебе понадобилсся какой-то массив пикселей ArrByteImg?
Вообще прокомментируй свой код.
Потом посмотри внимательно на мой и подумай, что в нем тебе не понятно. Короче - смотри, думай и спрашивай.

← →
dmk © (2005-03-14 21:23) [28]

Вот тебе еще немного кода. Преобразование BiLevel в Grayscale.
Преобразует 8 BiLevel-строк в 1 Grayscale.
Кстати! Потрясная скорость!

Только для этого надо сначала подсчитать
кол-во бит в кубике 8х8 и занести их в массив из
которого эта процедура выборку делает.
Я делаю это в секции Initialization

function Bit(TestByte, TestBit:Integer):boolean; asm bt eax, edx setc al and eax, 0FFh end; Function BitsCount(v:byte):byte; var c: Byte; res: Integer; begin Res := 0; For c := 0 to 7 do If Bit(v,c) then Inc(Res, 32); If Res > 255 then Res := 255; Result := Byte(Res); end; procedure InitHalphtoneBits; var Counter:Byte; begin For Counter := 0 to 255 do HBitsArray[Counter] := BitsCount(Counter); HBitsArray[0] := 0; HBitsArray[255] := 255; HBitsArrayAddr := DWord(Addr(HBitsArray[0])); //Ìàññèâ ïîäñ÷èòàííûõ çíà÷åíèé end; procedure TImageStream.HalftoneLine(InputAddress, OutputAddress, Len:DWord); var FStart: DWord; FPos: DWord; FNewStart: DWord; FNewPos: DWord; //... FLineSize: DWord; FLinePos: DWord; //... FSum: DWord; FHMem: DWord; begin FStart := InputAddress; FHMem := HBitsArrayAddr; //Ìàññèâ ïîäñ÷èòàííûõ çíà÷åíèé FLineSize := Len; //... FNewStart := OutputAddress; FNewPos := 0; FPos := 0; //... asm push edi push esi push ebx mov edx, FStart {Íà÷àëüíûé àäðåñ â bitmap èçîáðàæåíèè} add edx, FPos {Ïîçèöèÿ â bitmap èçîáðàæåíèè} mov edi, FNewStart {Íà÷àëüíûé àäðåñ â grayscale èçîáðàæåíèè} add edi, FNewPos {Ïîçèöèÿ â grayscale èçîáðàæåíèè} mov esi, FHMem {Ñòàðòîâûé àäðåñ â ìàññèâå ïîäñ÷èòàííûõ çíà÷åíèé} mov ecx, FLineSize {äëèíà ñêàí-ëèíèè} mov ebx, ecx mov FLinePos, 0 @@Cyc: mov FSum, 0 xor eax, eax {0}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx, ebx {1}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx,ebx {2}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx,ebx {3}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx,ebx {4}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx,ebx {5}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx,ebx {6}mov al, [edx] mov al, [esi+eax] add FSum, eax add edx,ebx {7}mov al, [edx] mov al, [esi+eax] add FSum, eax mov eax, FSum shr ax, 3 mov [edi], al //Çàïèñü ñóììû â grayscale èçîáðàæåíèå inc edi mov edx, FStart //Èñõîäíûé àäðåñ add edx, FPos inc FLinePos add edx, FLinePos loop @@Cyc //... pop ebx pop esi pop edi end; end;

← →
Fenik (2005-03-14 21:33) [29]

Ну всё, завалили парня кодом :)))

← →
YurikGL © (2005-03-14 21:33) [30]

> Fenik (12.03.05 19:38) [22]

Я в [11] пример привел, который методом деления "в лоб" не решается.

Автору:
Посмотри http://www.megaputer.ru/content/production/pa/_polyanalyst_info.html#5_05

Алгоритм кластеризации в твоем случае, примерно такой:
Пусть нам надо представить все в 4-х цветах. Тогда, делим всю область пополам т.е. цвета меньше 127,5 и больше 127,5 т.е. граница между двумя кластерами будет 127.5. Далее сдвигаем эту границу в сторону с большим количеством точек до тех пор, когда точек с обоих сторон не станет поровну. Далее, каждый получившийся кластер делим аналогичным способом пополам. После этого у нас в каждом из 4-х кластеров поровну точек (или почти поровну). Берем за новые цвета средние арифметические значений точек в каждом кластере и заменяем точки каждого кластера полученным значением.

Конечно, будут и пограничные значения и разное количество точек в кластерах, но общий алгоритм может быть такой. Ситуацию [11] он должен обработать корректно. Хотя существуют ситуации, которые и этот алгоритм обработает некорректно. Например значения
1,1,1,1,1,1, 200,201,202. разделить на 4 цвета. Для учета таких ситуаций надо еще много чего считать.

Хотя в университете нам вроде давали гораздо более оптимальные алогоритмы, но это надо в лекциях рыться :-)

← →
Fenik (2005-03-14 21:40) [31]

>YurikGL © (14.03.05 21:33) [30]
>Я в [11] пример привел, который методом деления "в лоб" не решается.

Я понимаю и полностью поддерживаю.
Поэтому и написал "грубый вариант". Просто как пример.

А если хочешь с RGB работать, что крайне непонятно для меня,
сначала конвертни Bitmap-строку в RGB. Также сначала
создай RGB-представление битов.

//Ïðîöåäóðà ñîçäàåò ìàññèâ îòîáðàæàþùèé áèòû â RGB ïðåäñòàâëåíèè //Ïðèìåð: (10001111) = ($00000000 $00FFFFFF $00FFFFFF $00FFFFFF $00000000 $00000000 $00000000 $00000000) //Èñïîëüçóåòñÿ äëÿ ïðîðèñîâêè ïðè áèòíîñòè 1 Bpp //Ìàññèâ çàíèìàåò 8Êá Procedure TImageStream.InitRgbMapOfBits; var Counter: Byte; //Ñ÷åò÷èê áàéòîâ bc: Byte; //Ñ÷åò÷èê áèòîâ begin For Counter := 0 to 255 do begin For bc := 0 to 7 do If Bit(Counter, bc) then FRGBBitsArray[Counter].Cell[7 - bc] := clWhite else FRGBBitsArray[Counter].Cell[7 - bc] := clBlack; end; //Àäðåñ íà÷àëà ìàññèâà FRGBBitsAddr := DWord(Addr(FRGBBitsArray[0].Cell[0])); RgbBits := FRgbBitsAddr; end;

Procedure ConvertBitmapScLineToRgb(ImgLineAddr:DWord; DBufferLineAddr:DWord; NumberBits:DWord; StartBit:Byte);
var
SrcAddr: DWord;
DestAddr: DWord;
BitsOffs: DWord; //Ñìåùåíèå â ìàññèâå RGBBits
FBitsLen: DWord; //Äëèíà êîïèðóåìîé ÿ÷åéêè
FBitsStart: DWord; //Íà÷àëî â ÿ÷åéêå
FTotalBits: DWord;
FFirstBitsLen: DWord;
FLastBitsLen: DWord;
FBitsForCycle: DWord;

begin
//Àäðåñ ñêàí-ëèíèè â èçîáðàæåíèè
SrcAddr := ImgLineAddr;

//Àäðåñ ñêàí-ëèíèè â êîíå÷íîì áóôåðå
DestAddr := DBufferLineAddr;

//Êîë-âî áèòîâ â ñêàí-ëèíèè
FTotalBits := NumberBits;

//Ðàñ÷åò ñìåùåíèÿ â áàéòå, ò.ê. ïèêñåëü ìîæåò íà÷èíàòñÿ â áàéòå ãäå óãîäíî
FBitsStart := StartBit;

//Äëÿ öèêëà áèòîâ íåò
FBitsForCycle := 0;

//Äëÿ ïîñëåäíåãî áàéòà òîæå íåò
FLastBitsLen := 0;

//Åñëè äëèíà ìåíüøå âîñüìè ïèêñåëîâ(áàéòà)
If FTotalBits < 8 then
begin
//åñëè íà÷àëüíûé áèò íå íóëåâîé
If StartBit <> 0 then
begin
//Ñ÷èòàåì, ÷òî äëèíà öåïî÷êè â ïåðâîì áàéòå
//ðàâíà îñòàâøèìñÿ áèòàì
FFirstBitsLen := 8 - StartBit;
//Íó à åñëè äëèíà îñòàâøèõñÿ áèòîâ
//ìåíüøå äëèíû âõîäíîé öåïî÷êè
//òî ñáðàñûâàåì äëèíó ïåðâîé öåïî÷êè
//ê âõîäíîìó êîë-âó
If FFirstBitsLen > FTotalBits then FFirstBitsLen := FTotalBits;
//Åñëè êîë-âî áèòîâ â ïåðâîì áàéòå
//ìåíüøå ÷åì âñåãî, òî
//ïðîèñõîäèò ïåðåõîä â ñëåäóþùèé áàéò
If FFirstBitsLen < FTotalBits then
FLastBitsLen := FTotalBits - FFirstBitsLen;
end//If aX <> 0 then
else
begin
//Äëèíà ïåðâîé öåïî÷êè
FFirstBitsLen := FTotalBits;
end;
end//If FTotalBits < 8
else//Åñëè êîë-âî áèòîâ áîëüøå 8

begin
//åñëè íà÷àëüíûé áèò íå íóëåâîé
If StartBit <> 0 then
begin
//Ñ÷èòàåì, ÷òî äëèíà öåïî÷êè â ïåðâîì áàéòå
//ðàâíà îñòàâøèìñÿ áèòàì
FFirstBitsLen := 8 - StartBit;
//Ïîñìîòðèì. Ñêîëêî æå áèòîâ îñòàëîñü?
Dec(FTotalBits,FFirstBitsLen);
//Åñëè îñòàëîñü 8 èëè ìåíüøå òî
If FTotalBits <= 8 then
begin
//Äëÿ öèêëà áèòîâ íåò
FBitsForCycle := 0;
//Îíè âñå äëÿ ïîñëåäíåãî ïèêñåëà
FLastBitsLen := FTotalBits;
end
else//åñëè îñòàëîñü áîëüøå áèòîâ
begin
//Äëèíà öåïî÷êè â ïîñëåäíåì áàéòå
FLastBitsLen := FTotalBits mod 8;
//à äëÿ öèêëà ÷òî-òî èìååì
FBitsForCycle := FTotalBits - FLastBitsLen;
end;//else
end//If aX <> 0
else//Åñëè âñå æå ïèêñåëû íà÷èíàþòñÿ ñ 0-ãî áèòà
begin
//Òî ïåðâûé áàéò ïîëíûé
FFirstBitsLen := 0;
//Êîë-âî áàéò äëÿ öèêëà
FBitsForCycle := (FTotalBits shr 3) shl 3;
//Êîë-âî áèò â ïîñëåäíåì áàéòå
FLastBitsLen := FTotalBits - FBitsForCycle;
end;
end;//If FTotalBits >= 8

If FFirstBitsLen <> 0 then
begin
//êîë-âî áèòîâ ðàâíî 8 - ïîïðàâêà íà íà÷àëî áèòà
FBitsLen := FFirstBitsLen;

//Ñìåùåíèå â ìàññèâå RGBBits
asm
mov eax, SrcAddr
mov al, [eax] //×èòàåì ïèêñåë
and eax, $000000FF //Î÷èñòèì ñòàðøèå 3 áàéòà ðåãèñòðà EAX
and al, gvIndexedMask //Îòêëþ÷åí ëè êàíàë? Òåïåðü â AL 8 ïèêñåëîâ èçîáðàæåíèÿ
shl eax, 5 //Óìíîæàåì íà 32, ò.ê. ýëåìåíò ìàññèâà - ýòî 32 áàéòà
mov BitsOffs, eax
end;

//Êîïèðóåì RGB áàéòû â êîíå÷íûé áóôåð
MoveBytes(RgbBits + BitsOffs + (FBitsStart shl 2), DestAddr, FBitsLen shl 2);
//Ñìåùàåìñÿ ê ñëåäóþùåìó áàéòó â èçîáðàæåíèè
Inc(SrcAddr);
//Ñìåùàåìñÿ ê ñëåäóþùèì áèòàì â ìàññèâå RGBBits
Inc(DestAddr,FBitsLen shl 2);
end;

If FBitsForCycle <> 0 then
begin
While FBitsForCycle <> 0 do
begin
//Ñìåùåíèå â ìàññèâå RGBBits
asm
mov eax, SrcAddr
mov al, [eax] //×èòàåì ïèêñåë
and eax, $000000FF //Î÷èñòèì ñòàðøèå 3 áàéòà ðåãèñòðà EAX
and al, gvIndexedMask //Îòêëþ÷åí ëè êàíàë? Òåïåðü â AL 8 ïèêñåëîâ èçîáðàæåíèÿ
shl eax, 5 //Óìíîæàåì íà 32, ò.ê. ýëåìåíò ìàññèâà - ýòî 32 áàéòà
mov BitsOffs, eax
end;

MoveBytes(RgbBits + BitsOffs, DestAddr, 32);
Inc(SrcAddr);
Inc(DestAddr,32);
Dec(FBitsForCycle,8);
end;//While
end;

If FLastBitsLen <> 0 then
begin
//Ñìåùåíèå â ìàññèâå RGBBits
asm
mov eax, SrcAddr
mov al, [eax] //×èòàåì ïèêñåë
and eax, $000000FF //Î÷èñòèì ñòàðøèå 3 áàéòà ðåãèñòðà EAX
and al, gvIndexedMask //Îòêëþ÷åí ëè êàíàë? Òåïåðü â AL 8 ïèêñåëîâ èçîáðàæåíèÿ
shl eax, 5 //Óìíîæàåì íà 32, ò.ê. ýëåìåíò ìàññèâà - ýòî 32 áàéòà
mov BitsOffs, eax
end;

MoveBytes(RgbBits + BitsOffs, DestAddr, (FLastBitsLen shl 2));
end;//If
end;

← →
Fenik (2005-03-14 22:25) [36]

>dmk ©

Блин, ну ты даешь. Человеку нужен алгоритм, красивый четкий наглядный код. А не секреты оптимизации графики инструментами встроенного ассемблера. Учится он ещё, понимаешь? =)

← →
Штотоносец (2005-03-14 23:21) [37]

YurikGL © (14.03.05 21:33) [30]

Вот ты мой код даже не глянул =) я именно это и пытался реализовать. И сейчас я его доделал, и он теперь работает правильно с любым количеством цветности. Вот последний вариант:
procedure Tfrm_Main.GetGrayScale(Value:Integer); var i,w,h:integer; a,c:Real; b:byte; begin w:=0; h:=0; a:=255/value; for i:=1 to Length(ArrByteImg) do begin b:=ArrByteImg[i-1]; c:=Round(b/a); if (b-a*c)>(a/2) then c:=Round(b/(a+1)); b:=Round(c*a); Image2.Canvas.Pixels[w,h]:=b shl 16 + b shl 8 + b; inc(w); if w=Image2.Width then begin w:=0; inc(h); end; end; end;

Остается теперь оптимизацией заняться =)

2 Fenik
Я не волшебник, я только учусъ (C) Золушка
Ну а вдруг ему интересно?! =)

← →
Штотоносец (2005-03-14 23:55) [39]

dmk © (14.03.05 23:49) [38]
Ну а вдруг ему интересно?! =)

Да вообщем интересно, но с такими коментариями, код сложнее воспринимается =)

Так черещз блокнот скопируй и шрифт поменяй.
Все читается =)

← →
Fenik (2005-03-15 17:44) [41]

> Штотоносец (14.03.05 23:21) [37]
> Остается теперь оптимизацией заняться =)

procedure SetGrayScale(Bitmap: TBitmap; Value: Byte); var Pixel: pRGBTriple; X, Y: Integer; A, A_2, B: Double; ByteTable: array [Byte] of Byte; begin Bitmap.PixelFormat := pf24Bit; if Value > 1 then begin A := 255/(Value-1); A_2 := A/2; for X := 0 to 255 do begin B := A * Round(X/A); if (X - B) > A_2 then ByteTable[X] := Round(A*Round(X/(A+1))) else ByteTable[X] := Round(X); end; end else FillChar(ByteTable, SizeOf(ByteTable), 0); for Y := 0 to Bitmap.Height - 1 do begin Pixel := Bitmap.ScanLine[Y]; for X := 0 to Bitmap.Width - 1 do begin with Pixel^ do begin rgbtBlue := ByteTable[rgbtBlue]; rgbtGreen := ByteTable[rgbtGreen]; rgbtRed := ByteTable[rgbtRed]; end; Inc(Pixel); end; end; end;

Тестирование - http://fenik.nm.ru/Gray.zip
Но этот алгоритм не умный, так сказать. Так как - [11].
Возьми например какртинку http://fenik.nm.ru/UGADAY.JPG и установи 3 цвета. В итоге лажа. Нужен умный алгоритм, который будет анализировать распределение цветов и в соответствии с этим подбирать опорные точки.

← →
Fenik (2005-03-15 18:53) [42]

Упс, опечаточка, вместо строки -
else ByteTable[X] := Round(X)
нужно
else ByteTable[X] := Round(B)

В тесте тоже исправить.
Это я перед отправкой решил подправить, понимаешь.. :))

← →
Fenik (2005-03-15 19:19) [43]

> Штотоносец

Кстати, я проверил ситуации (b-a*c)>(a/2) никогда не возникает.
Поэтому всё заполнение таблицы сводится к

A := 255/(Value-1); for X := 0 to 255 do ByteTable[X] := Round(A * Round(X/A));

Тест я перезакачал. Можешь проверить.
Вот такая оптимизация. :))

← →
Fenik (2005-03-15 19:39) [44]

Блин, да это ж почти тоже самое, что и я первый раз писал "грубый вариант". -))

Алгоритм преобразования монохромного изображения Найти похожие ветки