Nadesłany przez Tomasz Lubiński, 31 lipca 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Floyd-Steinberg- Delphi/Unit1.pas:
//Tomasz Lubiński (C)2009 // http://www.algorytm.org //Algorytm Floyd'a-Steinberg'a unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) Image1: TImage; Label1: TLabel; Image2: TImage; Image3: TImage; Label2: TLabel; Label3: TLabel; Label4: TLabel; Edit1: TEdit; Button1: TButton; UpDown1: TUpDown; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; PPixelRec = ^TPixelRec; TPixelRec = packed record B: Byte; G: Byte; R: Byte; Reserved: Byte; end; var Form1: TForm1; a: Array [-1..248] of Array [0..230] of Real; implementation {$R *.DFM} procedure TForm1.Button1Click(Sender: TObject); var i,j,p: Integer; w: Real; pixelOrg, pixelNew: PPixelRec; white, black: TPixelRec; begin //przygotuj wartosci bialy i czarny white.B := 255; white.G := 255; white.R := 255; black.B := 0; black.G := 0; black.R := 0; //przygotuj obrazy wynikowe Image2.Canvas.Brush.Color := clWhite; Image2.Canvas.Rectangle(0, 0, Image2.Width, Image2.Height); Image2.Picture.Bitmap.PixelFormat := pf32Bit; Image3.Canvas.Brush.Color := clWhite; Image3.Canvas.Rectangle(0, 0, Image3.Width, Image3.Height); Image3.Picture.Bitmap.PixelFormat := pf32Bit; //przygotuj format obrazu zrodlowego Image1.Picture.Bitmap.PixelFormat := pf32Bit; //pobierz prog p := StrToInt(Form1.Edit1.Text); //zwykle progowe for j:=0 to 229 do begin pixelOrg := Image1.Picture.Bitmap.ScanLine[j]; pixelNew := Image2.Picture.Bitmap.ScanLine[j]; for i:=0 to 247 do begin if (p>pixelOrg.R) then pixelNew^ := black else pixelNew^ := white; Inc(pixelOrg); Inc(pixelNew); end; end; //Floyd-Steinberg for j:=0 to 230 do for i:=-1 to 248 do a[i,j] := 0; for j:=0 to 229 do begin pixelOrg := Image1.Picture.Bitmap.ScanLine[j]; pixelNew := Image3.Picture.Bitmap.ScanLine[j]; for i:=0 to 247 do begin w := pixelOrg.R+a[i,j]; if (p>w) then pixelNew^ := black else begin pixelNew^ := white; w := w-255; end; a[i+1, j ] := a[i+1, j ] + (w*7/16); a[i-1, j+1] := a[i-1, j+1] + (w*3/16); a[i , j+1] := a[i , j+1] + (w*5/16); a[i+1, j+1] := a[i+1, j+1] + (w*1/16); Inc(pixelOrg); Inc(pixelNew); end; end; end; end.