TeksturMeping
Ljudi, da li neko ima proceduru za TextureMapping u 2D prostoru (bez 3D korekcija i sl, samo da se razvuce slika).
Najbolje da je pisana na pascal-delphi jeziku.
Prevrnuh pola interneta ali nisam nasao neku normalnu proceduru. Najbolje sto sam nasao je ovo:
// Make sure to add Math to your uses clause.
procedure TForm1.bmp_rotate(src,dst:tbitmap;angle:extended);
var
c1x,c1y,c2x,c2y:integer;
p1x,p1y,p2x,p2y:integer;
radius,n:integer;
alpha:extended;
c0,c1,c2,c3:tcolor;
begin
//calculate the angle to pi-format
angle := (angle / 180) * pi;
// calculate the central points
c1x := src.width div 2;
c1y := src.height div 2;
c2x := dst.width div 2;
c2y := dst.height div 2;
// number of steps
if c2x < c2y then
n := c2y
else
n := c2x;
dec (n,1);
// starting rotation
for p2x := 0 to n do begin
for p2y := 0 to n do begin
if p2x = 0 then
alpha:= pi/2
else
alpha := arctan2(p2y,p2x);
radius := round(sqrt((p2x*p2x)+(p2y*p2y)));
p1x := round(radius * cos(angle+alpha));
p1y := round(radius * sin(angle+alpha));
c0 := src.canvas.pixels[c1x+p1x,c1y+p1y];
c1 := src.canvas.pixels[c1x-p1x,c1y-p1y];
c2 := src.canvas.pixels[c1x+p1y,c1y-p1x];
c3 := src.canvas.pixels[c1x-p1y,c1y+p1x];
dst.canvas.pixels[c2x+p2x,c2y+p2y]:=c0;
dst.canvas.pixels[c2x-p2x,c2y-p2y]:=c1;
dst.canvas.pixels[c2x+p2y,c2y-p2x]:=c2;
dst.canvas.pixels[c2x-p2y,c2y+p2x]:=c3;
end;
application.processmessages
end;
end;
// Here is how to call it
procedure TForm1.bmpRotateClick(Sender: TObject);
Var
RAngle : Extended;
begin
RAngle := StrToFloat(Edit1.Text);
bmp_rotate(Image1.Picture.Bitmap,Image2.Picture.Bitmap, RAngle);
end;
Smesno, i uz to sporo (:.)
 |  |
 |
Re: TeksturMeping