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

Вниз

Цветной 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 вся ветка

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

Наверх




Память: 0.47 MB
Время: 0.013 c
14-89485
DeMoN-777
2003-10-07 01:15
2003.10.27
Подскажите плиз самый дешевый телефон c поддержкой GPRS

1-89386
Пубертанец
2003-10-15 14:25
2003.10.27
Форма - контейнер для Excel

1-89325
LocalNet
2003-10-16 15:58
2003.10.27
Передача файла в локальной сети

3-89125
x_ANDREW_x
2003-10-08 00:18
2003.10.27
Пропадают UDF в базе

1-89211
SERG_*
2003-10-16 18:55
2003.10.27
Макроподстановка




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