DelphiList22

Listing 22

//Graustufenkonvertierung einer 24bit Bitmap

unit Gray;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function CreateGrayPalette: HPalette;
const PalSize = sizeof(TLogPalette)+(255*sizeof(TPaletteEntry));
var Pal: PLogPalette;
    cv: Integer;

begin
GetMem(Pal, PalSize);

with Pal^ do
begin
   palVersion:=$300;
   palNumEntries:=256;

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

result:=CreatePalette(Pal^);

FreeMem(Pal, PalSize);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x, y : integer;
  BitMap : TBitMap;
  P, P1 : PByteArray;
  rgbValue: DWord;
  r1, g1, b1: Byte;

begin
  BitMap := TBitMap.create;
  BitMap.width:=Image1.Picture.Bitmap.width;
  BitMap.height:=Image1.Picture.Bitmap.height;
  BitMap.PixelFormat:=pf8bit;
  BitMap.Palette:=CreateGrayPalette;

  try

    for y := 0 to Image1.Picture.Bitmap.height -1 do
    begin
      P := BitMap.ScanLine[y];
      P1 := Image1.Picture.Bitmap.ScanLine[y];
      for x := 0 to Image1.Picture.Bitmap.width -1 do
      begin
        r1:=P1[3*x];
        g1:=P1[3*x+1];
        b1:=P1[3*x+2];
        rgbValue := Round(r1*0.3+g1*0.59+b1*0.11);
        P[x]:=rgbValue;
      end;
    end;

    canvas.draw(0, 0, BitMap);

  finally
    BitMap.free;
  end;
end;

end.

Zurück zur Hauptseite