cette source est une petit modification de la source de Spatul le lien
http://www.delphifr.com/codes/DEFORMER-IMAGE-DIMENSIONS-QUADRANGLE-QUELCONQUE_48145.aspx
comme la source de Spatul elle permet de modifier une image par 4 poin en X et Y le petit modification que j'ai fait et que je nutilise plus de paintbox directement un Timage ce code a eter tester avec delphi 2009 ce qui fait que on peu utiliser les formas (BMP,JPEG,PNG) et surement dotre
si vous avez des idées pour ameliorer la source ou des critique n'esité pas.
dsl pour les faute d'ortographe et le manque de commantaire
merci
Source / Exemple :
le unit de lapplicaation
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Math, U_Quadrangle, ExtDlgs, Buttons, pngimage,
jpeg;
type
TForm1 = class(TForm)
Image1: TImage;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
OpenPictureDialog2: TOpenPictureDialog;
CheckBox1: TCheckBox;
Image2: TImage;
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
Render_centrer(form1,'Image2');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
render_droite(form1,'Image2');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
render_gauche(form1,'Image2');
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if OpenPictureDialog2.Execute then begin
Image1.Picture.LoadFromFile(OpenPictureDialog2.FileName);
charger_image_base(image1);
Render_centrer(form1,'Image2');
end;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if checkbox1.Checked=true then
image2.Transparent:=true else image2.Transparent:=false;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
entiblock:=true;
end;
end.
et le unit quadrangle
//-------- Bitmap Déformation Quadrangle
unit U_Quadrangle;
interface
uses
Windows, Graphics, Classes, Math,Dialogs, ExtCtrls, Forms;
type
TRVBArray = array [0..0] of TRGBTriple;
pRVBArray = ^TRVBArray;
TQuadrangle = record A,B,C,D : TPoint; end;
var
Ox, Oy, Fx, Fy : integer;
CQuadrangle:TQuadrangle;
Image_sav_modife:Timage;
Temps_animation: TTimer;
entiblock:boolean;
{renvoi la distance entre deux points}
function DistValeurs(const A,B:integer):integer;
{adapte un bitmap à un quadrangle}
function Distorsion(const AQuadrangle:TQuadrangle;const ABitmap:TBitmap;const BkColor:TColor):TBitmap;
procedure charger_image_base(const img_base:Timage);
procedure Render_centrer(const Fenetre:Tform;const nom_du_Timage_final:string);
procedure Render_gauche(const Fenetre:Tform;const nom_du_Timage_final:string);
procedure Render_droite(const Fenetre:Tform;const nom_du_Timage_final:string);
procedure Render(const Fenetre:Tform;const nom_du_Timage_final:string;const XA,YA,XB,YB,XC,YC,XD,YD:integer);overload;
procedure Render(const Fenetre:Tform;const nom_du_Timage_final:string;const XA,YA,XB,YB,XC,YC,XD,YD:integer;const Animation:boolean;vitesse:byte);overload;
implementation
function DistValeurs(const A,B:integer):integer;
begin
if A > B then result := A-B else result := B-A;
end;
procedure charger_image_base(const img_base:Timage);
begin
Image_sav_modife:=img_base;
end;
procedure Render(const Fenetre:Tform;const nom_du_Timage_final:string;const XA,YA,XB,YB,XC,YC,XD,YD:integer);overload;
var
aBMP: TBitmap; //nom_image_de_base
renderbuffer:tbitmap;
Quadrangle: tquadrangle;
nom_image_de_base:Tbitmap;
begin
if Image_sav_modife=nil then exit;
nom_image_de_base:=TBitmap.Create;
nom_image_de_base.Width:=Timage(fenetre.FindComponent(nom_du_Timage_final)).Width;
nom_image_de_base.Height:=Timage(fenetre.FindComponent(nom_du_Timage_final)).Height;
nom_image_de_base.Canvas.Brush.Color:=clblack;
nom_image_de_base.Canvas.FillRect(nom_image_de_base.Canvas.ClipRect);
nom_image_de_base.Canvas.StretchDraw(nom_image_de_base.Canvas.ClipRect,Image_sav_modife.Picture.Graphic);
RenderBuffer:=TBitmap.Create;
RenderBuffer.Width:=Timage(fenetre.FindComponent(nom_du_Timage_final)).Width;
RenderBuffer.Height:=Timage(fenetre.FindComponent(nom_du_Timage_final)).Height;
RenderBuffer.Canvas.Brush.Color:=clblack;
RenderBuffer.Canvas.FillRect(RenderBuffer.Canvas.ClipRect);
Quadrangle.A:=Point(XA,YA);
Quadrangle.B:=Point(XB,YB);
Quadrangle.C:=Point(XC,YC);
Quadrangle.D:=Point(XD,YD);
aBMP := TBitmap(Distorsion(Quadrangle,nom_image_de_base,clblack));
try RenderBuffer.Canvas.Draw(OX,OY, aBMP);// deformation //
finally aBMP.Free; end;//liberer aBMP //
Timage(fenetre.FindComponent(nom_du_Timage_final)).Canvas.StretchDraw(Timage(fenetre.FindComponent(nom_du_Timage_final)).Canvas.ClipRect,RenderBuffer);
renderbuffer.Free;
nom_image_de_base.Free;
CQuadrangle:=Quadrangle;
end;
procedure Render(const Fenetre:Tform;const nom_du_Timage_final:string;const XA,YA,XB,YB,XC,YC,XD,YD:integer;const Animation:boolean;vitesse:byte);
var
i:integer;
BQuadrangle: tquadrangle;
begin
entiblock:=true;
entiblock:=false;
if Animation=false then Render(fenetre,nom_du_Timage_final,XA,YA,XB,YB,XC,YC,XD,YD);
if Image_sav_modife=nil then exit;
if( (BQuadrangle.A.X=0)and(BQuadrangle.A.Y=0)and(BQuadrangle.B.X=0)and(BQuadrangle.B.Y=0)and(BQuadrangle.C.X=0)and(BQuadrangle.C.Y=0)and(BQuadrangle.D.X=0)and(BQuadrangle.D.Y=0) ) then
Render(fenetre,nom_du_Timage_final,XA,YA,XB,YB,XC,YC,XD,YD)
else
begin
Fenetre.DoubleBuffered:=true;
BQuadrangle:=CQuadrangle;
entiblock:=false;
if vitesse=0 then
vitesse:=1;
if vitesse>10 then
vitesse:=10;
for i := 0 to (Timage(fenetre.FindComponent(nom_du_Timage_final)).Width+Timage(fenetre.FindComponent(nom_du_Timage_final)).Height)*2 do
begin
if( (BQuadrangle.A.X=XA)and(BQuadrangle.A.Y>=YA)and(BQuadrangle.B.X>=XB)and(BQuadrangle.B.Y>=YB)and(BQuadrangle.C.X=XC)and(BQuadrangle.C.Y>=YC)and(BQuadrangle.D.X>=XD)and(BQuadrangle.D.Y>=YD) ) then
break;
if entiblock=true then exit;
if BQuadrangle.A.X>XA then dec(BQuadrangle.A.X,vitesse);if BQuadrangle.A.X<XA then inc(BQuadrangle.A.X,vitesse);
if BQuadrangle.A.Y>YA then dec(BQuadrangle.A.Y,vitesse);if BQuadrangle.A.Y<YA then inc(BQuadrangle.A.Y,vitesse);
if BQuadrangle.B.X>XB then dec(BQuadrangle.B.X,vitesse);if BQuadrangle.B.X<XB then inc(BQuadrangle.B.X,vitesse);
if BQuadrangle.B.Y>YB then dec(BQuadrangle.B.Y,vitesse);if BQuadrangle.B.Y<YB then inc(BQuadrangle.B.Y,vitesse);
if BQuadrangle.C.X>XC then dec(BQuadrangle.C.X,vitesse);if BQuadrangle.C.X<XC then inc(BQuadrangle.C.X,vitesse);
if BQuadrangle.C.Y>YC then dec(BQuadrangle.C.Y,vitesse);if BQuadrangle.C.Y<YC then inc(BQuadrangle.C.Y,vitesse);
if BQuadrangle.D.X>XD then dec(BQuadrangle.D.X,vitesse);if BQuadrangle.D.X<XD then inc(BQuadrangle.D.X,vitesse);
if BQuadrangle.D.Y>YD then dec(BQuadrangle.D.Y,vitesse);if BQuadrangle.D.Y<YD then inc(BQuadrangle.D.Y,vitesse);
Render(fenetre,nom_du_Timage_final,BQuadrangle.A.X,BQuadrangle.A.Y,BQuadrangle.B.X,BQuadrangle.B.Y,BQuadrangle.C.X,BQuadrangle.C.Y,BQuadrangle.D.X,BQuadrangle.D.Y);
Fenetre.Refresh;
Application.ProcessMessages;
sleep(10);
end;
end;
end;
procedure Render_centrer(const Fenetre:Tform;const nom_du_Timage_final:string);
begin
Render(fenetre,nom_du_Timage_final,0,0,Timage(fenetre.FindComponent(nom_du_Timage_final)).Width,0,Timage(fenetre.FindComponent(nom_du_Timage_final)).Width,Timage(fenetre.FindComponent(nom_du_Timage_final)).Height,0,Timage(fenetre.FindComponent(nom_du_Timage_final)).Height,true,8);
end;
procedure Render_gauche(const Fenetre:Tform;const nom_du_Timage_final:string);
begin
Render(fenetre,nom_du_Timage_final,trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Width)*2/4),trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Height)*1/6),Timage(fenetre.FindComponent(nom_du_Timage_final)).Width,0,Timage(fenetre.FindComponent(nom_du_Timage_final)).Width,Timage(fenetre.FindComponent(nom_du_Timage_final)).Height,trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Width)*2/4),trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Height)*3/4),true,8);
end;
procedure Render_droite(const Fenetre:Tform;const nom_du_Timage_final:string);
begin
Render(fenetre,nom_du_Timage_final,0,0,trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Width)*2/4),trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Height)*1/6),trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Width)*2/4),trunc((Timage(fenetre.FindComponent(nom_du_Timage_final)).Height)*3/4),0,Timage(fenetre.FindComponent(nom_du_Timage_final)).Height,true,8);
end;
function Distorsion(const AQuadrangle:TQuadrangle;const ABitmap:TBitmap;const BkColor:TColor):TBitmap;
var
TabScanLine, TSLFinal : array of pRVBArray;
BmpOrigin : TBitmap;
BmpFinal : TBitmap;
v, u, x, y, xd, yd : integer;
RQWidth, RQHeight : integer;
TauxY, TauxX : real;
DistAB, DistDC, PosXAB, PosXDC : real;
DistAD, DistBC, PosYAD, PosYBC : real;
TmpX, TmpY : real;
// pour l'anti-aliasing des contours
nbPxC, PosPxC:integer; // nombre de pixels du contour
TPxC:array of array of integer; // tableau de la position des pixels du contour
RVB, bkRVB : TRGBTriple;
Mxdyd, Nx, Ny:integer; // max de xd,yd
begin
{$R-} {$RANGECHECKS OFF}
PosPxC:=0;
Mxdyd:=0;
//--récupérer la couleur d'arrière plan
bkRVB.rgbtBlue:=GetBValue(ColorToRGB(BkColor));
bkRVB.rgbtRed:=GetRValue(ColorToRGB(BkColor));
bkRVB.rgbtGreen:=GetGValue(ColorToRGB(BkColor));
//--calcul de la zone rectangle (rectangle maitre) contenant le quadrangle
Ox := min(min(AQuadrangle.A.X,AQuadrangle.B.X),min(AQuadrangle.C.X,AQuadrangle.D.X));
Oy := min(min(AQuadrangle.A.Y,AQuadrangle.B.Y),min(AQuadrangle.C.Y,AQuadrangle.D.Y));
Fx := max(max(AQuadrangle.A.X,AQuadrangle.B.X),max(AQuadrangle.C.X,AQuadrangle.D.X));
Fy := max(max(AQuadrangle.A.Y,AQuadrangle.B.Y),max(AQuadrangle.C.Y,AQuadrangle.D.Y));
RQWidth := Fx-Ox;
RQHeight := Fy-Oy;
//--création d'une copie du bitmap d'origine
BmpOrigin := TBitmap.Create;
BmpOrigin.HandleType := bmDIB;
BmpOrigin.PixelFormat := pf24Bit;
BmpOrigin.Height := RQHeight;
BmpOrigin.Width := RQWidth;
//--création du bitmap final qui sera transféré à "result"
BmpFinal := TBitmap.Create;
BmpFinal.HandleType := bmDIB;
BmpFinal.PixelFormat := pf24Bit;
BmpFinal.Height := RQHeight;
BmpFinal.Width := RQWidth;
BmpFinal.Canvas.Brush.Color := BkColor;
BmpFinal.Canvas.FillRect(rect(0,0,RQWidth,RQHeight));
//--mise à l'échelle du bitmap d'origine par rapport au rectangle maitre
BmpOrigin.Canvas.StretchDraw(rect(0,0,RQWidth,RQHeight),ABitmap);
nbPxC:=(RQWidth+RQHeight)*2; //nombre de pixels du contour de l'image
//--définir la taille des tableaux dynamiques
SetLength(TabScanLine,BmpOrigin.Height);
SetLength(TSLFinal,BmpFinal.Height);
SetLength(TPxC,nbPxC,2);
// transférer les données (pixels) dans chaque tableau
For v:=0 to RQHeight-1 do begin
// transférer les information de l'image dans les tableaux
TabScanLine[v] := BmpOrigin.ScanLine[v];
TSLFinal[v] := BmpFinal.ScanLine[v];
end;
//--Transférer les pixels au bon endroit
DistAD := AQuadrangle.D.Y-AQuadrangle.A.Y;
DistBC := AQuadrangle.C.Y-AQuadrangle.B.Y;
DistAB := AQuadrangle.B.X-AQuadrangle.A.X;
DistDC := AQuadrangle.C.X-AQuadrangle.D.X;
{Pour chaque pixel, calcule le taux de positionnement de x et y
et transfère les pixels au bon emplacement}
For v:=1 to BmpOrigin.Height-1 do begin
TauxY := v / BmpOrigin.Height;
PosYAD := AQuadrangle.A.Y-OY+(DistAD*TauxY);
PosYBC := AQuadrangle.B.Y-OY+(DistBC*TauxY);
For u := 1 to BmpOrigin.Width-1 do begin
TauxX := u / BmpOrigin.Width;
PosXAB := AQuadrangle.A.X-OX+(DistAB*TauxX);
PosXDC := AQuadrangle.D.X-OX+(DistDC*TauxX);
TmpX := PosXAB+(PosXDC-PosXAB)*TauxY;
TmpY := PosYAD+(PosYBC-PosYAD)*TauxX;
x := round(Int(TmpX));
y := Round(Int(TmpY));
xd := Round(Frac(TmpX)*10);
yd := Round(Frac(TmpY)*10);
{Si c'est un pixel du contour, on applique un anti-aliasing}
if (v=1) or (v=BmpOrigin.Height-1) or (u=1) or (u=BmpOrigin.Width-1) then begin
if (v=1) or (u=1) then Mxdyd:=(xd+yd);
if (v=BmpOrigin.Height-1) or (u=BmpOrigin.Width-1) then Mxdyd:=20-(xd+yd);
RVB.rgbtBlue:=TabScanLine[v,u].rgbtBlue+((bkRVB.rgbtBlue-TabScanLine[v,u].rgbtBlue)*(Mxdyd) div 20);
RVB.rgbtGreen:=TabScanLine[v,u].rgbtGreen+((bkRVB.rgbtGreen-TabScanLine[v,u].rgbtGreen)*(Mxdyd) div 20);
RVB.rgbtRed:=TabScanLine[v,u].rgbtRed+((bkRVB.rgbtRed-TabScanLine[v,u].rgbtRed)*(Mxdyd) div 20);
if RVB.rgbtBlue>254 then RVB.rgbtBlue:=255;
if RVB.rgbtGreen>254 then RVB.rgbtGreen:=255;
if RVB.rgbtRed>254 then RVB.rgbtRed:=255;
TSLFinal[y,x].rgbtBlue:=RVB.rgbtBlue;
TSLFinal[y,x].rgbtGreen:=RVB.rgbtGreen;
TSLFinal[y,x].rgbtRed:=RVB.rgbtRed;
end else begin
{[Modification proposé par CIREC Administrateur CS]
valeurs RGB des pixels inchangées, pas utile de les affecter individuellement}
TSLFinal[y,x] := TabScanLine[v,u];
//pour lever les "trous..."
If (xd<5) then x:=x-1; if x<0 then x:=0;
If (yd<5) then y:=y-1; if y<0 then y:=0;
TSLFinal[y,x] := TabScanLine[v,u];
end;
end;
end;
//--assigne le bitmap final au "result"
result := TBitmap.create;
Result.Assign(bmpFinal);
bmpFinal.Free;
BmpOrigin.free;
{$R-} {$RANGECHECKS ON}
end;
end.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.