1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422
| unit UInterface;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs, UChargement, UDessin, UPersonne, UVisage, ULunettes, magick_wand, ImageMagick;
type
// Définition de la structure d'enregistrement pour le fichier typé
TDonnees = Record
aNom : string[40];
aPrenom : string[40];
aAge : integer;
OeilGauche : CoordonneesPoint;
OeilDroit : CoordonneesPoint;
formeVisage : string[10];
aSexe : Boolean;
photo : array [0..37454] of byte; //37454 correspond à la taille en octet occupée par l'image de dimension 220x170 (en 32bits)
taillePhoto : integer;
end;
{ TmainInterface }
TmainInterface = class(TForm)
Essayer: TButton;
Indication: TLabel;
lunette2: TImage;
lunette3: TImage;
lunette1: TImage;
Importer: TButton;
Editer: TButton;
Fermer: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
ImagePhoto: TImage;
Photo:TBitmap;
Nom: TLabel;
OpenPictureDialog1: TOpenPictureDialog;
Prenom: TLabel;
Age: TLabel;
Homme: TRadioButton;
Femme: TRadioButton;
Choix1: TRadioButton;
Choix2: TRadioButton;
Choix3: TRadioButton;
RadioGroup1: TRadioGroup;
RadioGroup2: TRadioGroup;
TRadioGroup2: TRadioGroup;
SaveDialog1: TSaveDialog;
Sexe: TLabel;
procedure Edit1Change(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
procedure KeyPress(Sender: TObject; var Key: char);
procedure EditerClick(Sender: TObject);
procedure EssayerClick(Sender: TObject);
procedure FermerClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ImporterClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
Procedure Enregistre(Donnees : TDonnees);
Procedure Lecture(Var Donnees : TDonnees);
Procedure OuvreFichier(aName : String);
Procedure FermeFichier;
procedure TransfertPhotoDansStructure(aPhoto : TBitmap);
procedure TransfertPhotoDepuisStructure(var aPhoto : TBitmap);
end;
var
mainInterface: TmainInterface;
utilisateur : CPersonne;
nomEdit, prenomEdit, ageEdit, lunetteCreer : boolean;
Donnees :TDonnees;
Fichier : file of TDonnees;
NomFichier : string;
chargementCompte : Boolean;
implementation
//-------------------------------------------------------------------------------------------------------------------------------
//Permet l'ajustement des lunettes sur le visage de l'utilisateur : dimensionnement des lunettes suivant les proportions du visage
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure ajuster (LunettesInitiale, LunettesAjuster:CLunettes; OeilGauche, OeilDroit : CoordonneesPoint);
var A, B : integer;
status : MagickBooleanType;
wand : PMagickWand;
Begin
//Calcul de la distance inter-yeux sur le visage de l'utilisateur à partir des tracés
A:= abs(OeilDroit.X - OeilGauche.X);
//Calcul de la distance entre le centre droit et gauche des lunettes
B:= abs(LunettesInitiale.LunetteDroite.X - LunettesInitiale.LunetteGauche.X);
//Dimensionnement de la nouvelle image pour les lunettes
LunettesAjuster.ImageLunettes.Height := ROUND (LunettesInitiale.ImageLunettes.Height * (A/B));
LunettesAjuster.ImageLunettes.Width := ROUND (LunettesInitiale.ImageLunettes.Width * (A/B));
//Affectation des 2 points de la lunette avec les nouvelles proportions
LunettesAjuster.LunetteGauche.X := ROUND (LunettesInitiale.LunetteGauche.X * (A/B));
LunettesAjuster.LunetteGauche.Y := ROUND (LunettesInitiale.LunetteGauche.Y * (A/B));
LunettesAjuster.LunetteDroite.X := LunettesAjuster.LunetteGauche.X + A;
LunettesAjuster.LunetteDroite.Y := LunettesAjuster.LunetteDroite.Y;
{Utilisation de la librairie PascalMagick pour le changement de taille des lunettes}
//initialisation de la librairie
MagickWandGenesis;
//création du container
wand := NewMagickWand;
//chargement du fichier dans le container et renvoi éventuel d'erreur
status := MagickReadImage(wand,PChar('lunettes/lunette1.bmp'));
//changement de la taille dans le container
MagickResizeImage(wand,LunettesAjuster.ImageLunettes.Width,LunettesAjuster.ImageLunettes.Height,LanczosFilter,1.0);
//sauvegarde du container dans un fichier et renvoi éventuel d'erreur
status := MagickWriteImages(wand,'containerImage.bmp',MagickTrue);
//chargement du fichier container sauvegardé
LunettesAjuster.ImageLunettes.LoadFromFile('containerImage.bmp');
//libération du container
wand := DestroyMagickWand(wand);
//libération de la librairie
MagickWandTerminus;
//Suppression du container
DeleteFile('containerImage.bmp');
end;
//-------------------------------------------------------------------------------------------------------------------------------
//Chargement des lunettes permettant de définir les différents attributs des lunettes choisies par l'utilisateur
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure ChargementLunette (NomLunette : string; lunetteEssai : CLunettes);
begin
//Chargement de l'image des lunettes
lunetteEssai.ImageLunettes.LoadFromFile(NomLunette);
//Chargement des coordonnées des 2 points importants des lunettes (voir Unité ULunettes)
lunetteEssai.LunetteGauche.X := 27;
lunetteEssai.LunetteGauche.Y := 16;
lunetteEssai.LunetteDroite.X := 91;
lunetteEssai.LunetteDroite.Y := 16;
//+forme
end;
{ TmainInterface }
procedure TMainInterface.TransfertPhotoDansStructure(aPhoto : TBitmap);
Var Flux : TMemoryStream;
C, T : Integer;
Buff : ^Byte;
begin
Flux := TMemoryStream.Create;
// Transfert de la photo dans le flux
aPhoto.SaveToStream(Flux);
// Connaitre la taille en octets du flux
T := Flux.Size;
// Attribuer un espace mémoire au buffer
GetMem(Buff,T);
// Placer le lecteur du flux en position zéro.
Flux.Position :=0;
// Transfert des données de la photo dans le tableau
Flux.Read(Buff^,T);
Move(Buff^,Donnees.Photo,T);
// Memorisation de la taille du flux
Donnees.taillePhoto := T;
Flux.Free;
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TMainInterface.TransfertPhotoDepuisStructure(var aPhoto : TBitmap);
Var Flux : TMemoryStream;
T : Integer;
Buff : ^Byte;
begin
Flux := TMemoryStream.Create;
//Il faut atribuer au flux un espace mémoire correspondant à la taille du bitmap.
T:= Donnees.taillePhoto;
Flux.SetSize(T);
// Transfert des données de la photo depuis le tableau, dans le flux
GetMem(Buff,T);
Move(Donnees.Photo,Buff^,T);
// Replacer le pointeur de flux à la position 0
Flux.Seek(0,soFromBeginning);
Flux.Position :=0;
Flux.Write(Buff^,T);
// Replacer le pointeur de flux à la position 0
Flux.Seek(0,soFromBeginning);
// Transfert du flux dans le bitmap
aPhoto.LoadFromStream(Flux);
Flux.Free;
end;
//-------------------------------------------------------------------------------------------------------------------------------
//Procédures de gestion du fichier (ouverture, fermeture, enregistrement, lecture)
//
//-------------------------------------------------------------------------------------------------------------------------------
Procedure TMainInterface.Enregistre(Donnees : TDonnees);
Begin
// Ecriture de la variable "Donnees"
Write(Fichier,Donnees);
End;
//-------------------------------------------------------------------------------------------------------------------------------
Procedure TMainInterface.Lecture(Var Donnees : TDonnees);
Begin
// Lecture correspondant à la variable "Donnees"
Read(Fichier,Donnees);
End;
//-------------------------------------------------------------------------------------------------------------------------------
Procedure TMainInterface.OuvreFichier(aName : String);
Begin
AssignFile(Fichier,aName);
If Not FileExists(aName) Then Rewrite(Fichier)
Else Reset(Fichier);
End;
//-------------------------------------------------------------------------------------------------------------------------------
Procedure TMainInterface.FermeFichier;
Begin
CloseFile(Fichier);
End;
//-------------------------------------------------------------------------------------------------------------------------------
//Fermeture de la fenêtre avec enregristrement des données de l'utilisateur (nom, prénom, âge et sexe) dans un fichier type
//et de sa photo, puis arrêt du programme
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.FermerClick(Sender: TObject);
begin
close;
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
utilisateur.free;
If SaveDialog1.Execute Then
begin
NomFichier := SaveDialog1.FileName;
If FileExists(NomFichier) Then
begin
If MessageDlg('Le fichier <' + NomFichier + '> existe déjà !' + #13#10 + 'Faut il le remplacer? ',mtConfirmation,[mbYes,mbNo],0) = mrNo Then Exit
Else DeleteFile(NomFichier);
end;
OuvreFichier(NomFichier);
end;
With Donnees Do
begin
aNom := Edit1.Text;
aPrenom := Edit2.Text;
aAge := strtoint(Edit3.Text);
FormeVisage := utilisateur.visage.forme;
OeilGauche := utilisateur.visage.tabPoints[1];
OeilDroit := utilisateur.visage.tabPoints[2];
aSexe := utilisateur.sexe;
TransfertPhotoDansStructure(utilisateur.visage.PhotoUtilisateur);
end;
Enregistre(Donnees);
FermeFichier;
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.FormCreate(Sender: TObject);
begin
lunetteCreer := FALSE;
utilisateur := CPersonne.create;
Essayer.Enabled:= FALSE;
if chargementCompte then
Indication.Caption:= 'VOUS POUVEZ ESSAYER LES PAIRES DE LUNETTES PROPOSÉES OU MODIFIEZ VOTRE PHOTO'
else
Indication.Caption:= 'VEUILLEZ ENTRER VOS INFORMATIONS SVP (Nom, Prénom, Âge et Sexe)';
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.FormShow(Sender: TObject);
begin
Form2.showModal;
end;
//-------------------------------------------------------------------------------------------------------------------------------
//Permet le chargement de la photo de l'utilisateur ainsi que l'enregistrement de ses indications personnelles
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.ImporterClick(Sender: TObject);
var NomImage : string;
begin
if (Importer.Enabled AND OpenPictureDialog1.Execute) then
begin
// Chargement de l'image
if ImagePhoto.Picture.Bitmap.Empty then
begin
Photo:=TBitmap.create;
NomImage := OpenPictureDialog1.FileName;
Photo.LoadFromFile(NomImage);
ImagePhoto.Picture.assign(Photo);
utilisateur.visage.PhotoUtilisateur.Assign(Photo);
end;
//Enregistrement des données personnelles de l'utilisateur
utilisateur.nom := Edit1.text;
utilisateur.prenom := Edit2.text;
utilisateur.age := StrToInt(Edit3.text);
if (Homme.checked) then
utilisateur.sexe := TRUE
else utilisateur.sexe := FALSE;
//Boutton EDITER active --> l'utilisateur peut désormais tracé les différents points demandés
Editer.Enabled := TRUE;
Indication.Caption := 'VEUILLEZ À PRÉSENT ÉDITER VOTRE PHOTO SVP';
end;
end;
//-------------------------------------------------------------------------------------------------------------------------------
//Les différentes procédures de chaque TEdit permettent d'activer le boutton IMPORTER une fois que l'utilisateur
//a rentré toutes ses données personnelles
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.Edit1Change(Sender: TObject);
begin
nomEdit := TRUE;
if (prenomEdit AND ageEdit) then Importer.Enabled := TRUE;
Indication.Caption := 'VOUS POUVEZ DÉSORMAIS CHARGER UNE PHOTO DE VOTRE VISAGE';
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.Edit2Change(Sender: TObject);
begin
prenomEdit := TRUE;
if (nomEdit AND ageEdit) then Importer.Enabled := TRUE;
Indication.Caption := 'VOUS POUVEZ DÉSORMAIS CHARGER UNE PHOTO DE VOTRE VISAGE';
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.Edit3Change(Sender: TObject);
begin
ageEdit := TRUE;
if (nomEdit AND prenomEdit) then Importer.Enabled := TRUE;
Indication.Caption := 'VOUS POUVEZ DÉSORMAIS CHARGER UNE PHOTO DE VOTRE VISAGE';
end;
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.KeyPress(Sender: TObject; var Key: char);
begin
If Not (Key In['0'..'9',#8]) Then Key:=#0; //PROBLÈME : on peut toujours tapper les caractères suivant é è à ù.
end;
//-------------------------------------------------------------------------------------------------------------------------------
//Permet d'ouvrir la 2nd fenêtre du programme (Form1) que si l'utilisateur a bien rentré la photo de son visage
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.EditerClick(Sender: TObject);
begin
//Vérifaction de la présence de la photo
if (not ImagePhoto.Picture.Bitmap.Empty) then
Form1.showModal
else
begin
ImagePhoto.Picture.LoadFromFile('noImage.jpeg');
Editer.Enabled := FALSE;
end;
end;
//-------------------------------------------------------------------------------------------------------------------------------
//Essayage des paires de lunetes proposées
//
//-------------------------------------------------------------------------------------------------------------------------------
procedure TmainInterface.EssayerClick(Sender: TObject);
var lunettePosX, lunettePosY : integer;
lunetteAjuster : CLunettes;
lunetteEssai : CLunettes;
begin
//Création de la paire initiale et ajustée
lunetteAjuster := CLunettes.create;
lunetteEssai := CLunettes.create;
{Chargement, ajustement et pose des lunettes suivant le choix de l'utilisateur}
if choix1.checked then
begin
//Chargement des lunettes
ChargementLunette('lunettes/lunette1.bmp', lunetteEssai);
//Ajustement des lunettes
ajuster(lunetteEssai,lunetteAjuster, utilisateur.visage.tabPoints[1], utilisateur.visage.tabPoints[2]);
//Définition de la position des lunettes sur le visage
lunettePosX := utilisateur.visage.tabPoints[1].X - lunetteAjuster.LunetteGauche.X;
lunettePosY := utilisateur.visage.tabPoints[1].Y - lunetteAjuster.LunetteGauche.Y;
//Placement de lunettes sur le visage de l'utilisateur
lunetteAjuster.ImageLunettes.Transparent:= TRUE;
lunetteAjuster.ImageLunettes.TransparentColor:= clwhite;
ImagePhoto.Canvas.Draw(lunettePosX, lunettePosY, lunetteAjuster.ImageLunettes);
end
else if choix2.checked then
ChargementLunette('lunettes/lunette2.bmp', lunetteEssai)
else if choix3.checked then
ChargementLunette('lunettes/lunette3.bmp', lunetteEssai);
end;
initialization
{$I uinterface.lrs}
end. |
Partager