0/5 (16 avis)
Vue 14 900 fois - Téléchargée 1 370 fois
unit MainFormUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ShlObj, Buttons, StdCtrls, ExtCtrls, ToolWin, ComCtrls, ExtDlgs, ImgList, Menus, StrUtils, SearchProgressFormUnit, CompareProgressFormUnit, DecisionFormUnit, ShellAPI, JPEG; type TMainForm = class(TForm) GroupBox1: TGroupBox; Edit1: TEdit; SpeedButton1: TSpeedButton; CheckBox1: TCheckBox; BitBtn1: TBitBtn; GroupBox2: TGroupBox; ListView1: TListView; ImageList1: TImageList; ImageList2: TImageList; ToolBar1: TToolBar; ToolButton1: TToolButton; PopupMenu1: TPopupMenu; Details1: TMenuItem; List1: TMenuItem; Details2: TMenuItem; Smallicons1: TMenuItem; ImageList3: TImageList; ToolButton2: TToolButton; PopupMenu2: TPopupMenu; Byname1: TMenuItem; Bydimensions1: TMenuItem; Byfilesize1: TMenuItem; Bydate1: TMenuItem; N1: TMenuItem; Ascendant1: TMenuItem; Descendant1: TMenuItem; BitBtn2: TBitBtn; Panel1: TPanel; TrackBar1: TTrackBar; ComboBox1: TComboBox; ToolButton3: TToolButton; Panel2: TPanel; ImageList4: TImageList; ToolButton4: TToolButton; Panel3: TPanel; ComboBox2: TComboBox; procedure FormCreate(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure Smallicons1Click(Sender: TObject); procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn); procedure BitBtn2Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure Descendant1Click(Sender: TObject); procedure Bydate1Click(Sender: TObject); procedure ComboBox2Change(Sender: TObject); private FAscendantOrder:Boolean; // Ordre de classement croissant/décroissant FColumnSortID:Integer; // Critère de classement public CurrentFolder:string; // Variables utilisées par les fenêtres de progression FileCount,FolderCount:Integer; CompareProgress:Single; procedure ClearData; // Pour nettoyer le ListView (la propriété Data des TListItem contient un pointeur vers une matrice de coefficients) end; TTriVertex=packed record x:Longint; y:Longint; Red:Word; Green:Word; Blue:Word; Alpha:Word; end; TSingleArray=array[0..$FFFFFF] of Single; PSingleArray=^TSingleArray; TSearchThread=class(TThread) // Thread de recherche de fichiers images private FSearchData:TSearchRec; // Variables utilisées dans la méthode synchronisée FPicture:TPicture; FBitmap1,FBitmap2:TBitmap; FRect1,FRect2:TRect; FPath,FSubPath:string; FSize:Integer; FBuffer:PSingleArray; protected procedure Execute;override; procedure Finished; // Méthode appelée à la fin du thread pour enlever la fenêtre de progression procedure AddFile; // Méthode synchronisée avec le thread principal pour manipuler le ListView1 end; TCompareThread=class(TThread) // Thread de comparaison des fichiers images trouvés private FFile1,FFile2:string; // Variables utilisées dans la méthode synchronisée FAction:TImageAction; FSimilarity:Single; protected procedure Execute;override; procedure Finished; // Méthode appelée à la fin du thread pour enlever la fenêtre de progression procedure FileAction; // Méthode synchronisée avec le thread principal pour manipuler le ListView1 et lancer le dialogue de suppression end; var MainForm: TMainForm; implementation {$R *.dfm} function CallBack(Wnd:HWND;uMsg:UINT;wParam,lpData:LPARAM):Integer;stdcall; // Fonction de "callback" appelée à l'initialisation de la begin // boîte de sélection de répertoire pour définir le répertoire if uMsg=BFFM_INITIALIZED then // par défaut SendMessage(Wnd,BFFM_SETSELECTION,1,lpData); Result:=0; end; function SelectFolder(var Folder:string;const AllowCreateNew:Boolean=False;const Title:string=''):Boolean; // Fonction pour demander à l'utilisateur de const // choisir un répertoire BIF_NEWDIALOGSTYLE=$0040; // Folder: le répertoire par défaut var // qui contiendra le répertoire BI:TBrowseInfo; // choisi en cas de confirmation p:PItemIDList; // AllowCreateNew: autorise ou non la possibilité begin // de créer un nouveau dossier ZeroMemory(@BI,SizeOf(BI)); // Title: titre de la boîte de dialogue with BI do begin // Résultat: True si l'utilisation a cliqué hwndOwner:=Application.Handle; // sur OK, False sinon pszDisplayName:=PChar(Folder); lpszTitle:=PChar(Title); ulFlags:=BIF_RETURNONLYFSDIRS; if AllowCreateNew then ulFlags:=ulFlags or BIF_NEWDIALOGSTYLE; if Folder<>'' then begin lParam:=Integer(PChar(Folder)); lpfn:=CallBack; end; end; p:=SHBrowseForFolder(BI); if Assigned(p) then begin SetLength(Folder,MAX_PATH); Result:=SHGetPathFromIDList(p,PChar(Folder)); GlobalFreePtr(p); SetLength(Folder,Length(PChar(Folder))); end else Result:=False; end; { TSearchThread } procedure TSearchThread.AddFile; // Procédure synchronisée avec le thread principal pour ajoutter un item dans le TListView function BuildWavelet:PSingleArray; // Fonction qui construit la transformée en ondelettes de Haar de l'image var a,b,c,d,e:Integer; s:PByteArray; begin GetMem(Result,FBitmap2.Width*FBitmap2.Height*3*SizeOf(Single)); for b:=0 to FBitmap2.Height-1 do begin s:=FBitmap2.ScanLine[b]; for a:=0 to 3*FBitmap2.Width-1 do Result[FSize*b*3+a]:=s[a]; end; c:=FSize; while c>1 do begin // Transformée en paquets d'ondelettes... e:=c div 2; for d:=0 to 2 do begin // On fait successivement la transformée des 3 canaux RGB for a:=0 to FSize-1 do begin // Transformée horizontale for b:=0 to c-1 do FBuffer[b]:=Result[(FSize*a+b)*3+d]; for b:=0 to e-1 do begin Result[(FSize*a+b)*3+d]:=0.5*(FBuffer[2*b]+FBuffer[2*b+1]); Result[(FSize*a+b+e)*3+d]:=0.5*(FBuffer[2*b+1]-FBuffer[2*b]); end; end; for a:=0 to FSize-1 do begin // Transformée verticale for b:=0 to c-1 do FBuffer[b]:=Result[(FSize*b+a)*3+d]; for b:=0 to e-1 do begin Result[(FSize*b+a)*3+d]:=0.5*(FBuffer[2*b]+FBuffer[2*b+1]); Result[(FSize*(b+e)+a)*3+d]:=0.5*(FBuffer[2*b+1]-FBuffer[2*b]); end; end; end; c:=c div 2; // Passage à l'échelle suivante end; end; begin MainForm.CurrentFolder:=FSubPath; // Variables utilisées par la fenêtre de progression... FPicture.LoadFromFile(FPath+'\'+FSearchData.Name); FBitmap1.Canvas.StretchDraw(FRect1,FPicture.Graphic); FBitmap2.Canvas.StretchDraw(FRect2,FPicture.Graphic); with MainForm,ListView1.Items.Add do begin Data:=BuildWavelet; Caption:=FSubPath+FSearchData.Name; SubItems.Add(Format('%d x %d',[FPicture.Width,FPicture.Height])); {$WARNINGS OFF} SubItems.Add(IntToStr(Int64(FSearchData.FindData.nFileSizeHigh) shl 32+FSearchData.FindData.nFileSizeLow)); {$WARNINGS ON} SubItems.Add(DateTimeToStr(FileDateToDateTime(FileAge(FPath+'\'+FSearchData.Name)))); ImageIndex:=ImageList1.Add(FBitmap1,nil); ImageList2.Add(FBitmap2,nil); end; Inc(MainForm.FileCount); end; procedure TSearchThread.Execute; var l:TStringList; procedure ListFolder(Path:string;SubPath:string); // Parcours récursif (en fonction de CheckBox1.Checked) d'un répertoire var f:TSearchRec; begin Inc(MainForm.FolderCount); if FindFirst(Path+'\*',faAnyFile or faDirectory,f)=0 then try repeat if Terminated then Break; if f.Attr and faDirectory=faDirectory then begin if MainForm.CheckBox1.Checked and (f.Name<>'.') and (f.Name<>'..') then ListFolder(Path+'\'+f.Name,SubPath+f.Name+'\'); end else if l.IndexOf(ExtractFileExt(f.Name))>-1 then begin // Si l'extension est une extension graphique connue (en l'occurence *.JPEG, *.BMP, *.ICO, *.WMF) try FSearchData:=f; FSubPath:=SubPath; FPath:=Path; Synchronize(AddFile); // Synchronisation de la méthode d'ajout except ; end; end; until FindNext(f)<>0; finally FindClose(f); end; end; begin l:=TStringList.Create; l.Text:=AnsiReplaceText(AnsiReplaceStr(GraphicFileMask(TGraphic),';',#13),'*',''); // Extraction de la liste des extensions graphiques connues l.CaseSensitive:=False; FPicture:=TPicture.Create; FBitmap1:=TBitmap.Create; FBitmap1.Width:=MainForm.ImageList1.Width; FBitmap1.Height:=MainForm.ImageList1.Height; FRect1:=Rect(0,0,FBitmap1.Width,FBitmap1.Height); FBitmap2:=TBitmap.Create; FBitmap2.Width:=MainForm.ImageList2.Width; FBitmap2.Height:=MainForm.ImageList2.Height; FBitmap2.PixelFormat:=pf24bit; // Format RGB24 SetStretchBltMode(FBitmap2.Canvas.Handle,HALFTONE); // Meilleur redimensionnement FRect2:=Rect(0,0,FBitmap2.Width,FBitmap2.Height); FSize:=FBitmap2.Width; GetMem(FBuffer,FSize*SizeOf(Single)); // Buffer de travail... MainForm.ListView1.Items.BeginUpdate; // Pour éviter des réaffichages multiples try ListFolder(MainForm.Edit1.Text,''); finally MainForm.ListView1.Items.EndUpdate; FreeMem(FBuffer); FBitmap2.Destroy; FBitmap1.Destroy; FPicture.Destroy; l.Destroy; if not Terminated then Synchronize(Finished); // On cache la fenêtre de progression si elle est encore visible end; end; procedure TSearchThread.Finished; // On cache la fenêtre de progression si elle est encore visible begin if SearchProgressForm.Visible then SearchProgressForm.ModalResult:=mrOk; end; { TCompareThread } procedure TCompareThread.Execute; var a,b,c,n:Integer; t:PSingleArray; r,m:Single; const u:array[0..1,0..1] of Single=((0.25,1),(1,1)); function Dist(p,q:PSingleArray):Single; // Distance de 2 transformées d'ondelettes var a,b,c:Integer; begin Result:=0; for a:=0 to n-1 do begin if Result>m then // Si les 2 images sont déjà assez différentes, pas besoin de faire le calcul jusqu'au bout. Exit; for b:=0 to n-1 do for c:=0 to 2 do Result:=Result+t[n*a+b]*Abs(p[(n*a+b)*3+c]-q[(n*a+b)*3+c]); // Ajout des différences pondérées des 2 transformées en ondelettes end; end; begin n:=MainForm.ImageList2.Width; GetMem(t,n*n*SizeOf(Single)); // Matrice de pondération multi-échelle c:=1; r:=1/16; t[0]:=1; while c<n do begin // remplissage de la matrice de pondérations for a:=0 to c-1 do for b:=0 to c-1 do begin t[n*(a+c)+b]:=r*u[1,0]; t[n*a+b+c]:=r*u[0,1]; t[n*(a+c)+b+c]:=r*u[1,1]; end; c:=2*c; r:=r*u[0,0]; end; m:=100-MainForm.TrackBar1.Position/10; DecisionForm.Canceled:=False; DecisionForm.CheckBox1.Checked:=False; try a:=0; with MainForm do while a<ListView1.Items.Count do begin MainForm.CompareProgress:=a/(ListView1.Items.Count+1); for b:=ListView1.Items.Count-1 downto a+1 do begin FSimilarity:=100-Dist(ListView1.Items[a].Data,ListView1.Items[b].Data); if (FSimilarity>=TrackBar1.Position/10) then begin FFile1:=Edit1.Text+'\'+ListView1.Items[a].Caption; FFile2:=Edit1.Text+'\'+ListView1.Items[b].Caption; Synchronize(FileAction); // Synchronisation de l'affichage du dialogue de suppression case FAction of // Mise à jour du ListView1 en fonction de l'action choisie par l'utilisateur iaDelete1:begin FreeMem(ListView1.Items[a].Data); ListView1.Items.Delete(a); Dec(a); Break; end; iaDelete2:begin FreeMem(ListView1.Items[b].Data); ListView1.Items.Delete(b); end; end; end; if DecisionForm.Canceled or Terminated then // Action annulée... Break; end; if DecisionForm.Canceled or Terminated then // Action annulée... Break; Inc(a); end; finally FreeMem(t); end; if not Terminated then Synchronize(Finished); // On ferme la fenêtre de progression si elle est encore visible... end; procedure TCompareThread.FileAction; procedure DoDeleteFile(FileName:string); // Suppression d'un fichier var FOS:TSHFileOpStruct; begin if MainForm.ComboBox1.ItemIndex=1 then begin if not DeleteFile(FileName) then // Suppression irréversible RaiseLastOSError; end else begin ZeroMemory(@FOS,SizeOf(FOS)); // Envoi à la corbeille with FOS do begin wFunc:=FO_DELETE; pFrom:=PChar(FileName+#0#0); fFlags:=FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; end; if ShFileOperation(FOS)<>0 then RaiseLastOSError; end; end; begin FAction:=DecisionForm.Execute(FFile1,FFile2,FSimilarity); // On demande son avis à l'utilisateur... case FAction of // Et on fait ce qu'il a décidé... iaDelete1:DoDeleteFile(FFile1); iaDelete2:DoDeleteFile(FFile2); end; end; procedure TCompareThread.Finished; begin if CompareProgressForm.Visible then CompareProgressForm.ModalResult:=mrOk; // On ferme la fenêtre de progression si elle est encore visible... end; { TMainForm } procedure TMainForm.FormCreate(Sender: TObject); begin Edit1.Text:=GetCurrentDir; // On se met dans le répertoire de travail end; procedure TMainForm.BitBtn1Click(Sender: TObject); const T:array[0..3] of Integer=(16,32,64,128); // Qualités de la transformée en ondelettes: Low, Average, Good, Very good begin ClearData; // On efface les données précédantes ImageList2.Width:=T[ComboBox2.ItemIndex]; // La taille de ImageList2 va définir la taille de la transformée en ondelettes (en fonction de la qualité désirée) ImageList2.Height:=T[ComboBox2.ItemIndex]; CurrentFolder:=''; // Initialisations diverses... FileCount:=0; FolderCount:=0; with TSearchThread.Create(False) do begin // Lancement du thread de recherche if SearchProgressForm.ShowModal=mrCancel then begin // Affichage de la fenêtre de progression: si l'utilisateur appuie dur "cancel"... Terminate; // ...alors on arrête le thread WaitFor; end; Destroy; end; GroupBox2.Caption:=Format('%d graphic files',[ListView1.Items.Count]); // Nombre de fichiers trouvés BitBtn2.Enabled:=True; // On peut passer à l'étape suivante end; procedure TMainForm.SpeedButton1Click(Sender: TObject); var s:string; begin s:=Edit1.Text; if SelectFolder(s) then begin // Changement du répertoire de recherche Edit1.Text:=s; ClearData; end; end; procedure TMainForm.Smallicons1Click(Sender: TObject); var a:Integer; begin // En fonction du menu coché, on adapte l'affichage du ListView for a:=0 to PopupMenu1.Items.Count-1 do if PopupMenu1.Items[a].Checked then ListView1.ViewStyle:=TViewStyle(a); end; procedure TMainForm.ListView1Compare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); function BoolSgn(x:Boolean):Integer; begin if x then Result:=1 else Result:=-1; if FAscendantOrder then Result:=-Result; end; function StrToDim(s:string):Integer; var a:Integer; begin a:=Pos(' x ',s); Result:=StrToInt(Copy(s,1,a-1))*StrToInt(Copy(s,a+3,Length(s))); end; begin case FColumnSortID of // Différentes méthodes de comparaison en fonction de la colonne cliquée 0:Compare:=BoolSgn(Item1.Caption>Item2.Caption); 1:Compare:=BoolSgn(StrToDim(Item1.SubItems[0])>StrToDim(Item2.SubItems[0])); 2:Compare:=BoolSgn(StrToInt(Item1.SubItems[1])>StrToInt(Item2.SubItems[1])); 3:Compare:=BoolSgn(StrToDateTime(Item1.SubItems[2])>StrToDateTime(Item2.SubItems[2])); end; end; procedure TMainForm.ListView1ColumnClick(Sender: TObject; Column: TListColumn); begin if Column.Index=FColumnSortID then begin // Si on a cliqué 2 fois sur la même colonne FAscendantOrder:=not FAscendantOrder; // alors on inverse l'ordre de classement Ascendant1.Checked:=not FAscendantOrder; // Mise à jour du menu coché Descendant1.Checked:=FAscendantOrder; end; FColumnSortID:=Column.Index; PopupMenu2.Items[FColumnSortID].Checked:=True; // Mise à jour du menu coché ListView1.CustomSort(nil,0); // on classe les items end; procedure TMainForm.ClearData; // libération de la mémoire occupée par les transformées en ondelette et on vide le ListView1 var a:Integer; begin BitBtn2.Enabled:=False; ListView1.Items.BeginUpdate; try for a:=0 to ListView1.Items.Count-1 do FreeMem(ListView1.Items[a].Data); ListView1.Clear; finally ListView1.Items.EndUpdate; end; ImageList1.Clear; // on efface les listes d'images ImageList2.Clear; ListView1.Repaint; end; procedure TMainForm.BitBtn2Click(Sender: TObject); begin with TCompareThread.Create(False) do begin // Lancement du thread de comparaison if CompareProgressForm.ShowModal=mrCancel then begin // Si l'utilisateur annule l'opération Terminate; // on arrête le thread WaitFor; end; Destroy; end; GroupBox2.Caption:=Format('%d graphic files',[ListView1.Items.Count]); // Nombre de fichiers restants end; procedure TMainForm.TrackBar1Change(Sender: TObject); begin Panel1.Caption:=Format('Max similarity value: %f %%',[TrackBar1.Position/10]); // Mise à jour de l'interface end; procedure TMainForm.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin with ComboBox1,ComboBox1.Canvas do begin // Affichage des icônes de la ComboBox if odSelected in State then Brush.Color:=clHighlight; Dec(Rect.Right,1); FillRect(Rect); ImageList4.Draw(Canvas,Rect.Left+1,Rect.Top,Index); TextOut(Rect.Left+21,Rect.Top+2,Items[Index]); end; end; procedure TMainForm.Descendant1Click(Sender: TObject); begin FAscendantOrder:=Ascendant1=Sender; // Changement de l'ordre d'affichage ListView1ColumnClick(nil,ListView1.Columns[FColumnSortID]); end; procedure TMainForm.Bydate1Click(Sender: TObject); begin FColumnSortID:=PopupMenu2.Items.IndexOf(TMenuItem(Sender)); // Changement du critère d'affichage ListView1ColumnClick(nil,ListView1.Columns[FColumnSortID]); // On range de nouveau les items end; procedure TMainForm.ComboBox2Change(Sender: TObject); begin ClearData; // On doit recalculer les transformées en ondelettes donc on efface tout end; end.
6 sept. 2009 à 17:08
6 sept. 2009 à 16:58
j'aimerais réaliser un code qui me permettrait de trouver dans une image dans une autre image qui serait contenue dans une base de données par exemple. ètant novice en ce qui concerne le traitement d'image je ne trouve pas de solutions.
je m'explique j'aimerais par exemple reconnaitre un panneau routier sur une image et ainsi le signaler au conducteur.
Merci pour votre aide.
ps j'utilise scanline pour renvoyer les information sur les pixels
16 juil. 2008 à 17:55
oui bien sûr, c'est possible, il faudrait modifier un peu la procédure TCompareThread.Execute et faire quelque chose qui y ressemble beaucoup, mais avec une seule boucle (et pas 2 imbriquées, puisqu'on compare chaque image une seule fois avec la l'image source).
Le sous-fonction Dist permet de calculer la distance entre 2 images. Il te suffit de calculer cette distance entre chacune des images de la liste et l'image source, et de garder en mémoire le numéro de l'image de la liste qui minimise la distance. Ceci dit, il faudrait aussi modifier l'interface graphique du programme pour spécifier une image source.
16 juil. 2008 à 17:33
Est-il possible de chercher dans un répertoire quelle est l'image (quelles sont les images par ordre de ressemblance) qui se rapproche le plus de l'image 'source'?
Merci,
PhilLu
6 juin 2008 à 09:30
J'ai découvert ce lien par internet car je cherche un logiciel qui serait capable de trouver mes images en doubles mais pourrais-tu m'expliquer comment fabriquer le logiciel à partir de vos sources car je ne comprends pas...
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.