DelphiList23

Listing 23

//S/W Dithering einer 24bit Bitmap mittels einer Dithermatrix

unit SWDithering;

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}

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:=pf1bit;

  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);

        if y/2 = y div 2 then
        begin
           if x/2 = x div 2 then
           begin
              if rgbValue>0 then rgbValue:=255 else rgbValue:=0;
           end
           else
              if rgbValue>128 then rgbValue:=255 else rgbValue:=0;
        end
        else
           if x/2 = x div 2 then
           begin
              if rgbValue>192 then rgbValue:=255 else rgbValue:=0;
           end
           else
              if rgbValue>64 then rgbValue:=255 else rgbValue:=0;

        case rgbValue of
            255: if (P[x div 8] and Exp(2, 7-(x-(x div 8*8))))=0 then P[x div 8]:=P[x div 8]+Exp(2, 7-(x-(x div 8*8)));
              0: if (P[x div 8] and Exp(2, 7-(x-(x div 8*8))))>0 then P[x div 8]:=P[x div 8]-Exp(2, 7-(x-(x div 8*8)));
        end;

      end;
    end;

    canvas.draw(150, 0, BitMap);

  finally
    BitMap.free;
  end;

end;

end.

Zurück zur Hauptseite