Преобразование цвета битмапа в оттенки серого Опции

[Гробовщик]

Есть необработанный файл (массив данных). Все это выводится на экран посредством битмапа. Не могу вывести это в оттенках серого. Мучался с палитрой, не вышло. Как?

[Ozzя]

Код

Gray := Round((0.30 * GetRValue(RGBColor)) +
                (0.59 * GetGValue(RGBColor)) +
                (0.11 * GetBValue(RGBColor )));
  Result := RGB(Gray, Gray, Gray);

[Altair]

Не могу вывести это в оттенках серого.

надеюсь 256 палитра ?
Есть один способ.
заметь, что через каждые 16, в палитре начинается цветвой "блок", там цвета начинаются от светлого к темному (или наоборот - не важно).
а http://forum.pascalnet.ru/index.php?showtopic=9037&hl= вот тут я указывал, что от 16 до 32 идет ч\б палитра.
Попробуй сопоставить каждому цвету , цвет из этого интервала.

Это вариант преобразования без смены палитры.
Есть конечно вариант со сменой палитры.

вот пример для следующих режимов: VGA, VESA и еще какого-то нестандартного режима,
Инициализация режимов (на всякий случай)...

asm
{$IFDEF VGA}
    mov ax,13h				{ for VGA adapter: 320x200x256 }
{$ENDIF}
{$IFDEF CIRRUS}
    mov ax,5Fh				{ for Cirrus Logic adapter: 640x480x256 }
{$ENDIF}
{$IFDEF VESA}
    mov ax,4F02h			{ for VESA-compatible adapter: 640x480x256 }
    mov	bx,101h
{$ENDIF}
    int 10h
  end

а вот смена палитры:

procedure SetPalette; assembler;		{ гбв ­(r)ўЄ  Ї «Ёвал }
asm
  mov	si,word ptr BufPal
  mov	bx,0
  mov	dh,63
  mov	ch,dh
  mov	cl,dh
  mov	ax,1010h
  int	10h
@1:
  mov	dl,[si]
@2:
  add	dh,[si+1]
  add	ch,[si+2]
  add	cl,[si+3]
  inc	bx
  mov	ax,1010h
  int	10h
  dec	dl
  jnz @2
  add	si,4
  cmp	byte ptr [si],0
  jne @1
end

если теперь строки

  add	dh,[si+1]
  add	ch,[si+2]
  add	cl,[si+3]

заменить на

  add	dh,[si+1]
  add	ch,[si+1]
  add	cl,[si+1]

то получим генерацию ч\б палитры.
т.е. вот так:

procedure SetPalette; assembler;		{ гбв ­(r)ўЄ  Ї «Ёвал }
asm
  mov	si,word ptr BufPal
  mov	bx,0
  mov	dh,63
  mov	ch,dh
  mov	cl,dh
  mov	ax,1010h
  int	10h
@1:
  mov	dl,[si]
@2:
  add	dh,[si+1]
  add	ch,[si+1]
  add	cl,[si+1]
  inc	bx
  mov	ax,1010h
  int	10h
  dec	dl
  jnz @2
  add	si,4
  cmp	byte ptr [si],0
  jne @1
end

Вот тебе полезный модуль:

unit Global;

interface

{$DEFINE VESA}

const
  MaxX = 640;					{ а §аҐиҐ­ЁҐ Ї(r) Ј(r)аЁ§(r)­в «Ё }
  MaxY = 480;					{ а §аҐиҐ­ЁҐ Ї(r) ўҐавЁЄ «Ё }
  NumPal = 256 * 3 - 1;


type
  Line = array[0..MaxX] of byte;
  PLine = ^Line;
  BlockPal = array[0..NumPal] of byte;
  PBlockPal = ^BlockPal;

function GetPixel( X, Y: word ): byte;
{inline( $5A/		{ pop dx }
{	$59/		{ pop cx }
{	$B4/$0D/	{ mov ah,0Dh }
{	$B7/$00/	{ mov bh,0 }
{	$CD/$10 );	{ int 10h }

procedure SetPixel( X, Y: word; Color: byte );
{inline( $58/		{ pop ax }
{	$5A/		{ pop dx }
{	$59/		{ pop cx }
{	$B4/$0C/	{ mov ah,0Ch }
{	$B7/$00/	{ mov bh,0 }
{	$CD/$10 );	{ int 10h }

procedure GetPalette( Buffer: PBlockPal );

procedure SetPalette( BufPal: pointer );

procedure SetAllPalette( Buffer: PBlockPal );

procedure GetLine( Buffer: PLine; NumLine: word );

procedure SetLine( Buffer: PLine; NumLine: word );


implementation

procedure SetPixel; assembler;			{ (r)ваЁб(r)ўЄ  в(r)зЄЁ }
asm
  mov	ax,MaxX
  mul	Y
  add	ax,X
  mov	di,ax
{$IFNDEF VGA}
  adc	dl,0
  mov	ah,dl
{$ENDIF}
{$IFDEF CIRRUS}
  shl	ah,4
  mov	al,9
  mov	dx,$3CE
  out	dx,ax
{$ENDIF}
{$IFDEF VESA}
  mov	ax,$4F05
  push	ax
  push	dx
  xor	bx,bx
  int	10h
  pop	dx
  pop	ax
  inc	bx
  int	10h
{$ENDIF}
  mov	ax,$A000
  mov	es,ax
  mov	al,Color
  stosb
end

function GetPixel; assembler;			{ Ї(r)«г祭ЁҐ жўҐв  в(r)зЄЁ }
asm
  mov	ax,MaxX
  mul	Y
  add	ax,X
  mov	di,ax
{$IFNDEF VGA}
  adc	dl,0
  mov	ah,dl
{$ENDIF}
{$IFDEF CIRRUS}
  shl	ah,4
  mov	al,9
  mov	dx,$3CE
  out	dx,ax
{$ENDIF}
{$IFDEF VESA}
  mov	ax,$4F05
  push	ax
  push	dx
  xor	bx,bx
  int	10h
  pop	dx
  pop	ax
  inc	bx
  int	10h
{$ENDIF}
  mov	ax,$A000
  mov	es,ax
  mov	al,es:[di]
end

procedure GetPalette; assembler;		{ Ї(r)«г祭ЁҐ ⥪гйҐ(c) Ї «Ёвал }
asm
  mov	ax,1017h
  les	dx,Buffer
  mov	bx,0
  mov	cx,256
  int	10h
end

procedure SetPalette; assembler;		{ гбв ­(r)ўЄ  Ї «Ёвал }
asm
  mov	si,word ptr BufPal
  mov	bx,0
  mov	dh,63
  mov	ch,dh
  mov	cl,dh
  mov	ax,1010h
  int	10h
@1:
  mov	dl,[si]
@2:
  add	dh,[si+1]
  add	ch,[si+2]
  add	cl,[si+3]
  inc	bx
  mov	ax,1010h
  int	10h
  dec	dl
  jnz @2
  add	si,4
  cmp	byte ptr [si],0
  jne @1
end

procedure SetAllPalette; assembler;
asm
  les	dx,Buffer
  mov	ax,1012h
  mov	bx,0
  mov	cx,256
  int	10h
end

procedure GetLine;
var
  Cnt: word;
begin
  for Cnt := 0 to MaxX - 1 do Buffer^[Cnt] := GetPixel( Cnt, NumLine )
end;

procedure SetLine;
var
  Cnt: word;
begin
  for Cnt := 0 to MaxX - 1 do SetPixel( Cnt, NumLine, Buffer^[Cnt] )
end;

end.

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

uses 
crt,	Global;


const
  MaxIter = 1000;				{ ¬ ЄбЁ¬ «м­(r)Ґ зЁб«(r) ЁвҐа жЁ(c) }
  MaxColor = 250;				{ зЁб«(r) 梥в(r)ў }

const						{ Ї «Ёвал }
  Palette1: array[1..37] of shortint = ( 21,-3,0,0,31,2,-2,0,31,0,2,-2,31,-2,
	0,2,21,0,-3,0,31,2,0,-2,31,-2,2,0,31,0,-2,2,21,0,0,-3,0 );
  Palette2: array[1..37] of shortint = ( 21,-3,0,0,31,1,-2,-1,31,1,1,-1,31,-2,
	1,2,21,0,-3,0,31,2,1,-1,31,-1,1,-1,31,-1,-2,2,21,0,0,-3,0 );
  Palette3: array[1..37] of shortint = ( 21,-3,0,0,31,1,-2,-1,31,1,1,-1,31,-2,
	1,2,21,0,-3,0,31,1,2,-2,31,1,-1,1,31,-2,-1,1,21,0,0,-3,0 );
  Palette4: array[1..37] of shortint = ( 21,0,0,-3,31,-2,0,2,31,2,-2,0,31,0,
	2,-2,21,-3,0,0,31,0,-2,2,31,2,0,-2,31,-2,2,0,21,0,-3,0,0 );
  Palette5: array[1..45] of shortint = ( 15,-4,0,0,1,-3,0,0,31,1,-2,0,31,1,1,-2,
	31,-2,1,1,31,1,-2,1,31,1,1,-2,31,-2,1,1,31,0,-2,1,1,0,0,-3,15,0,0,-4,0 );
  Palette6: array[1..69] of shortint = ( 9,-7,0,0,21,3,0,-3,9,0,-7,0,21,-3,0,3,
	9,7,0,0,21,0,3,-3,9,-7,0,0,21,3,0,3,9,0,-7,0,21,-3,3,0,9,0,0,-7,
	21,3,-3,0,21,0,3,3,9,0,0,-7,21,-3,0,3,9,0,0,-7,9,0,-7,0,0 );


{$DEFINE VESA}
begin
  {init graph mode}
  asm
{$IFDEF VGA}
    mov ax,13h				{ for VGA adapter: 320x200x256 }
{$ENDIF}
{$IFDEF CIRRUS}
    mov ax,5Fh				{ for Cirrus Logic adapter: 640x480x256 }
{$ENDIF}
{$IFDEF VESA}
    mov ax,4F02h			{ for VESA-compatible adapter: 640x480x256 }
    mov	bx,101h
{$ENDIF}
    int 10h
  end
  SetPalette( @Palette1 );		{ Ї(r) г¬(r)«з ­Ёо 1-п Ї «Ёва  }
  
  
  {что-то вывели }
   
    case ReadKey of
      '1': SetPalette( @Palette1 );	{ жЁдал (r)в 1 ¤(r) 6 ¬Ґ­пов Ї «Ёваг }
      '2': SetPalette( @Palette2 );
      '3': SetPalette( @Palette3 );
      '4': SetPalette( @Palette4 );
      '5': SetPalette( @Palette5 );
      '6': SetPalette( @Palette6 )
    end;
   {в текст mode} 
  asm
    mov ax,3				{ гбв ­(r)ўЁвм ⥪бв(r)ўл(c) ०Ё¬ 80е25 }
    int 10h
  endend.

[Гробовщик]

То Altair: спасибо, этот модуль пригодится. Но хотелось бы под виндовс подкопаться без ассемблера. Скорее нужно рыть в сторону заголовка. У меня не проходит следующий код:

Код

var
  LogPalette: PLogPalette;
  I: Integer;
  begin  

  GetMem(LogPalette,  SizeOf(TLogPalette) + (NumShades-1)*SizeOf(TPaletteEntry));
   LogPalette.palVersion := $300;
   LogPalette.palNumEntries := 256;
   for I := 0 to 256 do
     begin
       LogPalette.palPalEntry[I].peRed  := I;
       LogPalette.palPalEntry[I].peGreen := I;
       LogPalette.palPaLEntry[I].peBlue := I;
       LogPalette.palPalEntry[I].peFlags := 0;
      end;

     Result := CreatePalette(LogPalette^);
     FreeMem(LogPalette)

В общем result напрямую присваиваю в один из параметров структуры HBitmap. Не проходит.

[Гробовщик]

Все. Тема закрыта. Спасибо за ответы.

[Altair]

Но хотелось бы под виндовс подкопаться без ассемблера

Так надо было сразу скзаать, что ты в 32 бита пишешь. Есть ведь специальный форум для этого.

Все. Тема закрыта. Спасибо за ответы.

Жалко конечно, что ты не сказал как решил проблемму.

Заходи на форум еще !