Nadesłany przez Tomasz Lubiński, 20 lipca 2011 14: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.
Ordered - Bayer Table - Delphi/Unit1.pas:
//Tomasz Lubiński (C)2009 // http://www.algorytm.org //Uporzadkowane rozpraszanie bledow - tablice Bayer'a unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Math, SHELLAPI; type TForm1 = class(TForm) Image1: TImage; Label1: TLabel; Image2: TImage; Image3: TImage; Label2: TLabel; Label3: TLabel; Label4: TLabel; Edit1: TEdit; Button1: TButton; UpDown1: TUpDown; Label5: TLabel; ComboBox1: TComboBox; Label6: TLabel; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Label6Click(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; bayer : array [0..15] of array [0..15] of Integer; implementation {$R *.DFM} // funkcje do wygenerowanie tablicy Bayer'a function pow(a: Integer; b: Integer): Integer; begin result := 1; while (b > 0) do begin result := result * a; b := b - 1; end; end; function getX(i: Integer; level: Integer; shift: Integer): Integer; begin result := ((i+1) mod 2); if (level = 1) then begin result := result + shift; exit; end; result := getX(i div 4, level-1, shift + result * pow(2, level-1)); end; function getY(i: Integer; level: Integer; shift: Integer): Integer; begin result := (((i+3) mod 4) div 2); if (level = 1) then begin result := result + shift; exit; end; result := getY(i div 4, level-1, shift + result * pow(2, level-1)); end; procedure prepareBayerTable(level: Integer); var size, i, x, y: Integer; begin size := pow(2, level); for i:=1 to size*size do begin x := getX(i-1, level, 0); y := getY(i-1, level, 0); bayer[x][y] := i; end; end; procedure TForm1.Button1Click(Sender: TObject); var i,j,bayerSize: Integer; p: 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; //uporzadkowane rozpraszanie bledow //przygotuj tablice Bayer'a prepareBayerTable(ComboBox1.ItemIndex + 1); bayerSize := pow(2, ComboBox1.ItemIndex + 1); p := p / (bayerSize*bayerSize); 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 if (p * bayer[i mod bayerSize][j mod bayerSize] > pixelOrg.r) then pixelNew^ := black else begin pixelNew^ := white; end; Inc(pixelOrg); Inc(pixelNew); end; end; end; //initialize combobox on start procedure TForm1.FormCreate(Sender: TObject); begin ComboBox1.ItemIndex := 1; end; // http://www.algorytm.org link procedure TForm1.Label6Click(Sender: TObject); begin with (Sender as Tlabel) do ShellExecute(Application.Handle, PChar('open'), PChar(Hint), PChar(0), nil, SW_NORMAL); end; end.