algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Anaglify - tworzenie obrazów 3D - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 2
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 24 lutego 2009 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.

3D Anaglify - Delphi/Anaglify.pas:
// Anaglify - tworzenie obrazow 3D
// www.algorytm.org
// (c) 2009 by Tomasz Lubinski

unit Anaglify;

interface

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

type
  TForm1 = class(TForm)
    left: TImage;
    right: TImage;
    result: TImage;
    left_result: TImage;
    right_result: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    Button1: TButton;
    method_ps: TRadioButton;
    method_psM: TRadioButton;
    method_dubois: TRadioButton;
    method_mono: TRadioButton;
    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;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
   r, g, b: Integer;
   i, j: Integer;
   lP, rP, lrP, rrP, P: PPixelRec;
begin

   left.Picture.Bitmap.PixelFormat := pf32bit;
   right.Picture.Bitmap.PixelFormat := pf32bit;

   left_result.Canvas.Rectangle(0, 0, left_result.Width, left_result.Height);
   left_result.Picture.Bitmap.PixelFormat := pf32bit;

   right_result.Canvas.Rectangle(0, 0, right_result.Width, right_result.Height);
   right_result.Picture.Bitmap.PixelFormat := pf32bit;

   result.Canvas.Rectangle(0, 0, result.Width, result.Height);
   result.Picture.Bitmap.PixelFormat := pf32bit;

   for i:=0 to left.Picture.Bitmap.Height-1 do
   begin
      lP := left.Picture.Bitmap.ScanLine[i];
      rP := right.Picture.Bitmap.ScanLine[i];
      lrP := left_result.Picture.Bitmap.ScanLine[i];
      rrP := right_result.Picture.Bitmap.ScanLine[i];
      P :=  result.Picture.Bitmap.ScanLine[i];
      for j:=0 to left.Picture.Bitmap.Width-1 do
      begin

         if (method_mono.Checked) then
         begin
            r := Round(lP.R*0.299 + lP.G*0.587 + lP.B*0.114);
            g := Round(rP.R*0.299 + rP.G*0.587 + rP.B*0.114);
            b := Round(rP.R*0.299 + rP.G*0.587 + rP.B*0.114);
         end
         else if (method_ps.Checked) then
         begin
            r := lP.R;
            g := rP.G;
            b := rP.B;
         end
         else if (method_psM.Checked) then
         begin
            r := Round(lP.R*0.299 + lP.G*0.587 + lP.B*0.114);
            g := rP.G;
            b := rP.B;
         end
         else
         begin
            r := Round(0.456100  * lP.R +
                      0.500484   * lP.G +
                      0.176381   * lP.B -
                      0.0434706  * rP.R -
                      0.0879388  * rP.G -
                      0.00155529 * rP.B);
	   if (r > 255) then r := 255
           else if (r < 0)  then r := 0;

 	   g := Round(-0.0400822 * lP.R -
                      0.0378246  * lP.G -
                      0.0157589  * lP.B +
                      0.378476   * rP.R +
                      0.73364    * rP.G -
                      0.0184503  * rP.B);
	   if (g > 255) then g := 255
           else if (g < 0) then g := 0;

 	   b := Round(-0.0152161 * lP.R -
                      0.0205971  * lP.G -
                      0.00546856 * lP.B -
                      0.0721527  * rP.R -
                      0.112961   * rP.G +
                      1.2264     * rP.B);
	   if (b > 255) then b := 255  
           else if (b < 0)  then b := 0;
         end;          

         // show result for left eye
         lrP.R := r;
         lrP.G := 0;
         lrP.B := 0;

         // show result for right eye
         rrP.R := 0;
         rrP.G := g;
         rrP.B := b;

         // show result for both eyes
         P.R := r;
         P.G := g;
         P.B := b;

         //next pixel
         Inc(lP);
         Inc(rP);
         Inc(lrP);
         Inc(rrP);
         Inc(P);
      end;
   end;
end;

end.
Dodaj komentarz