Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.10.27;
Скачать: CL | DM;

Вниз

Цветной JPEG -> Серый Bitmap   Найти похожие ветки 

← →
servs ©   (2003-06-24 15:31) [0]

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

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

← →
MBo ©   (2003-06-24 16:21) [1]

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

← →
AlexT1000 ©   (2003-06-24 16:30) [2]

TJPEGImage.Grayscale := true

← →
Mihey ©   (2003-06-24 16:53) [3]

> TJPEGImage.Grayscale := true

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

← →
AlexT1000 ©   (2003-06-24 17:06) [4]

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

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

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

← →
servs ©   (2003-06-25 17:35) [5]

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

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

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

← →
icWasya ©   (2003-06-25 17:48) [6]

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

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-27 18:50) [7]

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

← →
Fenik ©   (2003-06-27 21:04) [8]

Переводишь сначала в 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;


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

Текущий архив: 2003.10.27;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.039 c
4-89637
Rel_
2003-08-21 16:19
2003.10.27
Глюк при перерисовке

1-89361
Stas
2003-10-17 09:58
2003.10.27
Подсветка в TRichEdit

1-89338
AndreyG
2003-10-16 15:07
2003.10.27
Как загрузить данные из текстового файла (с разделителями) в базу

3-89164
rosl
2003-10-07 03:34
2003.10.27
sql

14-89525
zzet
2003-10-09 12:03
2003.10.27
iKobo