Project1.dpr
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Unit1.pas
unit Unit1;
{http://www.phidels.com}
{à noter que si vous avez D6 et +, il est plus simple d'utiliser la nouvelle }
{propriété Proportional du TImage }
{Comment en partant d'une image quelconque la faire tenir dans des dimensions }
{précises (ici : dans un panel) et ce, en gardant les mêmes proportions }
{entre hauteur et largeur }
{cet exemple a été fait pour être facile à comprendre. Vous trouverez sur les }
{site une méthodes pour rendre légèrement plus fluide le redimensionnement et }
{pour améliorer le rendu de l'image notament lorsqu'il faut afficher une image}
{dans des dimensions supérieures à la taille d'origine (interpolation
{bilinéaire) }
{à noter également que dans cet exemple, le picture de l'image conserve }
{l'image d'origine }
{donc pas de perte de qualité si vous reprenez ce picture pour }
{par exemple l'afficher dans une image plus grande }
{inconvénient : plus de place prise en mémoire }
{=> ne pas en avoir des centaines à l'écran }
{si vous avez ce problème de mémoire, une autre solution aurait été de prendre}
{une picture provisoire et de faire }
{un DrawStrech vers notre image à l'aide d'une fonctin du style :
procedure ChangeTailleDessin(DessinSource:TPicture;var DessinCible:TImage;NouvX,NouvY:word);
var Rect:Trect;
begin
Rect.Left:=0;
Rect.Top:=0;
Rect.Right:=NouvX;
Rect.Bottom:=NouvY;
DessinCible.Canvas.StretchDraw(rect,DessinSource.Graphic);
end;
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
jpeg, ComCtrls, ExtCtrls, ExtDlgs, StdCtrls ;
type
TForm1 = class(TForm)
ButtonChargementImage: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Panel1: TPanel;
Image1: TImage;
StatusBar1: TStatusBar;
procedure ButtonChargementImageClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure CalculLimiteImage
(WidthLimit,HeightLimit, //Limite en taille dans laquelle l'image
WidthSource,HeightSource:integer;//doit tenir au maximum(Height et Width)
var NouvWidthSource,NouvHeightSource:integer);
var
RapportWsHSource:real;
begin
RapportWsHSource:=WidthSource/HeightSource;
if RapportWsHSource*HeightLimit<=WidthLimit then
begin
// dans ce cas, la hauteur sera celle donnée par la limite
NouvHeightSource:=HeightLimit;
// et la largeur sera calculé pour garder les proportions
NouvWidthSource:=Round(NouvHeightSource*RapportWsHSource);
end
else
// sinon, c'est le contraire.
begin
NouvWidthSource:=WidthLimit;
NouvHeightSource:=Round(NouvWidthSource/RapportWsHSource);
end;
end;
procedure TForm1.ButtonChargementImageClick(Sender: TObject);
//Chargement d'un fichier image
begin
if OpenPictureDialog1.Execute then
begin
//chargement de l'image :
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FormResize(Sender);// pour que les dimensions de l'affichage se calculent
// et donc avoir un affichage de la bonne dimension.
end;
end;
procedure TForm1.FormResize(Sender: TObject);
var
NouvWidth,NouvHeight:integer;
begin
if image1.Picture.Width>0 then
begin
// calcul des nouvelles dimensions d'image1
CalculLimiteImage(Panel1.Width,Panel1.Height,
Image1.Picture.Width, Image1.Picture.Height,
NouvWidth,NouvHeight);
Image1.Height:=NouvHeight;
Image1.Width:=NouvWidth;
// centrage par rapport au panel :
Image1.Left:=Round((Panel1.Width-Image1.Width)/2);
Image1.Top:=Round((Panel1.Height-Image1.Height)/2);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Stretch:=true;
end;
end.
