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?

Zmiana wielkości obrazu - Interpolacja dwuliniowa - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 3
SłabyŚwietny
Nadesłany przez Tomasz Lubiński, 03 kwietnia 2006 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.

Zmiana wielkosci obrazu - Bilinear Interpolation - Delphi/BI.pas:
// Zmiana wielkosci obrazka -
// Algorytm Bilinear Interpolation - algorytm interpolacji podwójnej
// www.algorytm.org
// Tomasz Lubinski (c) 2006

unit BI;

interface

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

type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Reserved: Byte;
  end;

  TForm1 = class(TForm)
    src: TImage;
    dst: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Label3: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    function Bilinear_Inter(x, y: Double): TPixelRec;
    function Inter(f1, f2, d: Double): Double;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  org: Array [1..122] of Array [1..100] of TPixelRec;

implementation

{$R *.DFM}

function TForm1.Inter(f1, f2, d: Double): Double;
begin
   Result := f1*(1-d) + f2*d;
end;

function TForm1.Bilinear_Inter(x, y: Double): TPixelRec;
var
  x0,y0,x0_1, y0_1 : Integer;
  dx,dy : Double;
begin

  x0 := Floor(x);
  y0 := Floor(y);
  dx := x-x0;
  dy := y-y0;
  if (x0 + 1 > src.Width) then
     x0_1 := x0
  else
     x0_1 := x0 + 1;
  if (y0 + 1 > src.Width) then
     y0_1 := y0
  else
     y0_1 := y0 + 1;

  Result.r := Round(Inter(Inter(org[x0, y0].R, org[x0_1, y0].R, dx), Inter(org[x0, y0_1].R, org[x0_1, y0_1].R, dx), dy));
  Result.g := Round(Inter(Inter(org[x0, y0].G, org[x0_1, y0].G, dx), Inter(org[x0, y0_1].G, org[x0_1, y0_1].G, dx), dy));
  Result.b := Round(Inter(Inter(org[x0, y0].B, org[x0_1, y0].B, dx), Inter(org[x0, y0_1].B, org[x0_1, y0_1].B, dx), dy));
end;


procedure TForm1.Button1Click(Sender: TObject);
var
   i,j: Integer;
   ratiox, ratioy : Double;
   pixel: PPixelRec;
begin

   //pobierz wartosci pliku wejsciowego
   src.Picture.Bitmap.PixelFormat := pf32Bit;
   for j:= 1 to src.Height do
   begin
      pixel := src.Picture.Bitmap.ScanLine[j-1];
      for i:=1 to src.Width do
         begin
            org[i][j] := pixel^;
            Inc(pixel);
         end;
   end;

   //pobierz nowy rozmiar
   dst.Width := StrToInt(Edit2.Text);
   dst.Height := StrToInt(Edit1.Text);
   dst.Picture.Bitmap := TBitmap.Create;
   dst.Picture.Bitmap.Width := dst.Width;
   dst.Picture.Bitmap.Height := dst.Height;
   ratiox := (src.Width-1)/(dst.Width-1);
   ratioy := (src.Height-1)/(dst.Height-1);

   //przygotuj obraz wynikowy
   dst.Canvas.Brush.Color := clWhite;
   dst.Canvas.Rectangle(0, 0, dst.Width, dst.Height);
   dst.Picture.Bitmap.PixelFormat := pf32Bit;

   for j:= 1 to dst.Height do
   begin
      pixel := dst.Picture.Bitmap.ScanLine[j-1];
      for i:=1 to dst.Width do
         begin
            pixel^ := Bilinear_Inter((i-1)*ratiox+1, (j-1)*ratioy+1);
            Inc(pixel);
         end;
   end;
end;

end.
Dodaj komentarz