ImageHash/uFrmAutoMark.pas at master · martok/ImageHash · GitHub

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
unit uFrmAutoMark;

{$mode objfpc}{$H+}
{$ModeSwitch nestedprocvars}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  TfrmAutoMark = class(TForm)
    Label1: TLabel;
    cbLargerResolution: TCheckBox;
    cbCompressedFile: TCheckBox;
    cbLargerFile: TCheckBox;
    cbDirectoryOrder: TCheckBox;
    btnMark: TButton;
    Button2: TButton;
    cbOnlyUnmarked: TCheckBox;
    cbOlderFile: TCheckBox;
    procedure btnMarkClick(Sender: TObject);
  private
  public
  end;

var
  frmAutoMark: TfrmAutoMark;

implementation

{$R *.lfm}

uses
  uThreadClassifier, uFrmMain, uThreadHashing, uUtils;

const
  CompressedFileExtensions = '.jpeg.jpg.jpe.jfif.png.gif.tif.tiff';

{ TfrmAutoMark }

procedure TfrmAutoMark.btnMarkClick(Sender: TObject);
var
  list: TListBox;
  sourcePaths: TStrings;
  imageInfos: PImageInfoList;
  c: TCluster;
  skipstate: set of TImageMark;
  idx, i, m, cluster_seen, cluster_skipped, marked_delete: integer;
  im: PImageInfoItem;
  b: boolean;

  function Compare(const Item1, Item2: integer): integer;
  var
    im1, im2: PImageInfoItem;
    a1, a2: TSearchRec;
    x,y: integer;
  begin
    im1:= @imageInfos[Item1];
    im2:= @imageInfos[Item2];
    if cbLargerResolution.Checked then begin
      x:= im1^.ImgW*im1^.ImgH;
      y:= im2^.ImgW*im2^.ImgH;
      if x>y then
        Exit(-1);
      if x<y then
        Exit(1);
    end;
    if cbCompressedFile.Checked then begin
      x:= Pos(ExtractFileExt(im1^.Filename), CompressedFileExtensions);
      y:= Pos(ExtractFileExt(im2^.Filename), CompressedFileExtensions);
      if (x>0) and (y=0) then
        Exit(-1);
      if (x=0) and (y<0) then
        Exit(1);
    end;
    if cbLargerFile.Checked or cbOlderFile.Checked then begin
      GetFileInfos(im1^.FullName(sourcePaths), a1);
      GetFileInfos(im2^.FullName(sourcePaths), a2);
    end;
    if cbLargerFile.Checked then begin
      if a1.Size>a2.Size then
        Exit(-1);
      if a1.Size<a2.Size then
        Exit(1);
    end;
    if cbOlderFile.Checked then begin
      if a1.TimeStamp<a2.TimeStamp then
        Exit(-1);
      if a1.TimeStamp>a2.TimeStamp then
        Exit(1);
    end;
    if cbDirectoryOrder.Checked then begin
      x:= im1^.Sourcedir;
      y:= im2^.Sourcedir;
      if x<y then
        Exit(-1);
      if y>x then
        Exit(1);
    end;
    Result:= 0;
  end;

begin
  list:= fmMain.lbClusters as TListBox;
  imageInfos:= PImageInfoList(@fmMain.ImageInfos[0]);
  sourcePaths:= fmMain.SourcePaths;
  if cbOnlyUnmarked.Checked then
    skipstate:= [imIgnore, imDelete]
  else
    skipstate:= [imIgnore];
  cluster_seen:= 0;
  cluster_skipped:= 0;
  marked_delete:= 0;
  for idx:= 0 to list.Count - 1 do begin
    c:= list.Items.Objects[idx] as TCluster;
    inc(cluster_seen);
    b:= false;
    for i in c.Items do begin
      im:= @imageInfos[i];
      b:= im^.Mark in skipstate;
      if b then
        break;
    end;
    if b then begin
      inc(cluster_skipped);
      continue;
    end;
    if (specialize TListTool<Integer>).FindSmallestValue(c.Items, @Compare, m) >= 0 then begin
      for i in c.Items do begin
        im:= @imageInfos[i];
        if i = m then
          im^.Mark:= imUnmarked
        else begin
          im^.Mark:= imDelete;
          inc(marked_delete);
        end;
      end;
    end;
  end;
  list.Invalidate;
  MessageDlg(Format('Evaluated clusters: %d'+sLineBreak+
             'Skipped clusters: %d'+sLineBreak+
             'Marked for deletion: %d', [cluster_seen, cluster_skipped, marked_delete]),
              mtInformation, [mbOK], 0);
end;

end.