| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Цветной JPEG -> Серый Bitmap

servs ©   (2003-06-24 15:31:00) 

Как сделать сабж?

У меня есть цветное изображение в TJPEGImage, мне необходимо отобразить его в градациях серого в TImage.

---

Fenik   (2003-06-27 21:04:00) [1]

Переводишь сначала в Bitmap, а потом пропускаешь через процедуру:

procedure GrayBmp(Bitmap: TBitmap);
var n: Byte;
x, y: Integer;
Dest: pRGBTriple;
begin
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
Dest := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do begin
with Dest^ do begin
n := Trunc((rgbtBlue + rgbtGreen + rgbtRed)/3);
rgbtBlue := n;
rgbtGreen := n;
rgbtRed := n;
end;
( Dest)

Переводишь сначала в Bitmap, а потом пропускаешь через процедуру:

procedure GrayBmp(Bitmap: TBitmap);
var n: Byte;
x, y: Integer;
Dest: pRGBTriple;
begin
Bitmap.PixelFormat := pf24Bit;
for y := 0 to Bitmap.Height - 1 do begin
Dest := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width - 1 do begin
with Dest^ do begin
n := Trunc((rgbtBlue + rgbtGreen + rgbtRed)/3);
rgbtBlue := n;
rgbtGreen := n;
rgbtRed := n;
end;
Inc(Dest);
end;
end;
end;

---

servs   (2003-06-27 18:50:00) [2]

Спасибо, попробую.

---

icWasya   (2003-06-25 17:48:00) [3]

я делаю так
сначала вспомогательный юнит

unit UGrayPal;

interface
uses Windows;

function GrayPal:HPalette;
function IsGrayPal(Palette:HPalette):Boolean;
function BWPal:HPalette;OverLoad;
function BWPal(Black,White:LongWord):HPalette;OverLoad;

implementation
var MaxLogPal:TMaxLogPalette;LogPal:TLogPalette Absolute MaxLogPal;
MinLogPal:packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [0..1] of TPaletteEntry;
end;
_2LogPal:TLogPalette Absolute MinLogPal;


function GrayPal:HPalette;
begin
Result := CreatePalette(LogPal);
end;

function BWPal:HPalette;
begin
Result := CreatePalette(_2LogPal);
end;

function BWPal(Black,White:LongWord):HPalette;
var
MinLogPal:packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [0..1] of TPaletteEntry;
end;
_2LogPal:TLogPalette Absolute MinLogPal;

begin

MinLogPal.palNumEntries :=2;
MinLogPal.palVersion :=$300;
with MinLogPal.palPalEntry[1] do begin
peRed :=GetRValue(Black);
peGreen :=GetGValue(Black);
peBlue :=GetBValue(Black);
peFlags :=0;
end;
with MinLogPal.palPalEntry[0] do begin
peRed :=GetRValue(White);
peGreen :=GetGValue(White);
peBlue :=GetBValue(White);
peFlags :=0;
end;

Result := CreatePalette(_2LogPal);
end;

function IsGrayPal(Palette:HPalette):Boolean;
var
TestLogPal: TMaxLogPalette;
LogPal: TLogPalette Absolute TestLogPal;
var I: Integer;

begin
FillChar(TestLogPal,SizeOf(TestLogPal),0);
Result:=False;
GetPaletteEntries(Palette, 0, 256 ,LogPal);
for I:=0 to 255 do with TestLogPal.palPalEntry[I] do begin
if peRed <>I then Exit;
if peGreen <>I then Exit;
if peBlue <>I then Exit;
//if peFlags <>0 then Exit;
end;
Result:=True;
end;

procedure InitPal;
var I:Integer;
begin
MaxLogPal.palNumEntries :=256;
MaxLogPal.palVersion :=$300;

for I:=0 to 255 do with MaxLogPal.palPalEntry[I] do begin
peRed :=I; peGreen :=I; peBlue :=I; peFlags :=0;
end;

MinLogPal.palNumEntries :=2;
MinLogPal.palVersion :=$300;
with MinLogPal.palPalEntry[1] do begin
peRed :=0; peGreen :=0; peBlue :=0; peFlags :=0;
end;
with MinLogPal.palPalEntry[0] do begin
peRed :=255; peGreen :=255; peBlue :=255; peFlags :=0;
end;
end;

initialization
InitPal;

end.


затем


var B:TBitmap;
...
FJPEGImage.LoadFromStream(FStream);

B:=TBitmap.Create;
try
B.PixelFormat:=pf8bit;
B.Witdh:=FJPEGImage.Width;
B.Height:=FJPEGImage.Height;
B.Palette:=UGrayPal.GrayPal;

B.Canvas.Draw(0,0,FJPEGImage);

( B)

я делаю так
сначала вспомогательный юнит

unit UGrayPal;

interface
uses Windows;

function GrayPal:HPalette;
function IsGrayPal(Palette:HPalette):Boolean;
function BWPal:HPalette;OverLoad;
function BWPal(Black,White:LongWord):HPalette;OverLoad;

implementation
var MaxLogPal:TMaxLogPalette;LogPal:TLogPalette Absolute MaxLogPal;
MinLogPal:packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [0..1] of TPaletteEntry;
end;
_2LogPal:TLogPalette Absolute MinLogPal;


function GrayPal:HPalette;
begin
Result := CreatePalette(LogPal);
end;

function BWPal:HPalette;
begin
Result := CreatePalette(_2LogPal);
end;

function BWPal(Black,White:LongWord):HPalette;
var
MinLogPal:packed record
palVersion: Word;
palNumEntries: Word;
palPalEntry: array [0..1] of TPaletteEntry;
end;
_2LogPal:TLogPalette Absolute MinLogPal;

begin

MinLogPal.palNumEntries :=2;
MinLogPal.palVersion :=$300;
with MinLogPal.palPalEntry[1] do begin
peRed :=GetRValue(Black);
peGreen :=GetGValue(Black);
peBlue :=GetBValue(Black);
peFlags :=0;
end;
with MinLogPal.palPalEntry[0] do begin
peRed :=GetRValue(White);
peGreen :=GetGValue(White);
peBlue :=GetBValue(White);
peFlags :=0;
end;

Result := CreatePalette(_2LogPal);
end;

function IsGrayPal(Palette:HPalette):Boolean;
var
TestLogPal: TMaxLogPalette;
LogPal: TLogPalette Absolute TestLogPal;
var I: Integer;

begin
FillChar(TestLogPal,SizeOf(TestLogPal),0);
Result:=False;
GetPaletteEntries(Palette, 0, 256 ,LogPal);
for I:=0 to 255 do with TestLogPal.palPalEntry[I] do begin
if peRed <>I then Exit;
if peGreen <>I then Exit;
if peBlue <>I then Exit;
//if peFlags <>0 then Exit;
end;
Result:=True;
end;

procedure InitPal;
var I:Integer;
begin
MaxLogPal.palNumEntries :=256;
MaxLogPal.palVersion :=$300;

for I:=0 to 255 do with MaxLogPal.palPalEntry[I] do begin
peRed :=I; peGreen :=I; peBlue :=I; peFlags :=0;
end;

MinLogPal.palNumEntries :=2;
MinLogPal.palVersion :=$300;
with MinLogPal.palPalEntry[1] do begin
peRed :=0; peGreen :=0; peBlue :=0; peFlags :=0;
end;
with MinLogPal.palPalEntry[0] do begin
peRed :=255; peGreen :=255; peBlue :=255; peFlags :=0;
end;
end;

initialization
InitPal;

end.


затем


var B:TBitmap;
...
FJPEGImage.LoadFromStream(FStream);

B:=TBitmap.Create;
try
B.PixelFormat:=pf8bit;
B.Witdh:=FJPEGImage.Width;
B.Height:=FJPEGImage.Height;
B.Palette:=UGrayPal.GrayPal;

B.Canvas.Draw(0,0,FJPEGImage);

FDisplayImage.Picture.Assign(B);
finally
B.Free;
end;




---

servs   (2003-06-25 17:35:00) [4]

>AlexT1000 ©
Просто не получаеться. Вот этот код у меня уже был:
FJPEGImage.LoadFromStream(FStream);
FJPEGImage.Grayscale := FGray;
FDisplayImage.Picture.Assign(FJPEGImage);

Картинка отображаеться, но цветная ;(

>Mihey ©
Я с графикой не работал раньше. Что нужно дописать?

---

AlexT1000   (2003-06-24 17:06:00) [5]

>> Mihey
А потом преобразовать в битмап.

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

TJPEGImage.LoadFromFile
TJPEGImage.Grayscale := true
Image.Picture.Assign(TJPEGImage);

---

Mihey   (2003-06-24 16:53:00) [6]

> TJPEGImage.Grayscale := true

А потом преобразовать в битмап.

---

AlexT1000   (2003-06-24 16:30:00) [7]

TJPEGImage.Grayscale := true

---

MBo   (2003-06-24 16:21:00) [8]

преобразовать в битмап, затем пробежать по пикселам (через Scanline).

---

Наверх