Check-in [149636cc23]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added start of unit to manage the list of files. Added unit to determine image size without loading the entire image.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:149636cc236552ffa2a3cb85174e24cea90c3c26
User & Date: tinus 2014-10-05 19:26:35
Context
2014-11-07
22:47
Added wrapper units for FreeImage (version 3.16) check-in: 7dae23150a user: tinus tags: trunk
2014-10-05
19:26
Added start of unit to manage the list of files. Added unit to determine image size without loading the entire image. check-in: 149636cc23 user: tinus tags: trunk
2014-10-04
15:18
Started on class structure (TWPImage). Configured ignore-glob. check-in: 2ec105df21 user: tinus tags: trunk
Changes

Added src/ImgSize.pas.



















































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
unit ImgSize;
(*
  http://stackoverflow.com/questions/15209076/how-to-get-dimensions-of-image-file-in-delphi
  2014-10-04
*)

interface

uses Classes;

function GetJPGSize(const sFile: string; out wWidth, wHeight: word): Boolean; inline; overload;
function GetJPGSize(const Stream: TStream; out wWidth, wHeight: word): Boolean; overload;
function GetPNGSize(const sFile: string; out wWidth, wHeight: word): Boolean; inline; overload;
function GetPNGSize(const Stream: TStream; out wWidth, wHeight: word): Boolean; overload;
function GetGIFSize(const sGIFFile: string; out wWidth, wHeight: word): Boolean; inline; overload;
function GetGIFSize(const Stream: TStream; out wWidth, wHeight: word): Boolean; overload;
function GetBMPSize(const sFile: string; out Width, Height: integer): boolean; inline; overload;
function GetBMPSize(const Stream: TStream; out Width, Height: integer): boolean; overload;

implementation

uses
  System.SysUtils,
  Winapi.Windows;

function ReadMWord(f: TStream): word;

type
  TMotorolaWord = record
  case byte of
  0: (Value: word);
  1: (Byte1, Byte2: byte);
end;

var
  MW: TMotorolaWord;
begin
  // It would probably be better to just read these two bytes in normally and
  // then do a small ASM routine to swap them. But we aren't talking about
  // reading entire files, so I doubt the performance gain would be worth the trouble.
  f.Read(MW.Byte2, SizeOf(Byte));
  f.Read(MW.Byte1, SizeOf(Byte));
  Result := MW.Value;
end;


function GetJPGSize(const sFile: string; out wWidth, wHeight: word): Boolean;
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(sFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := GetJPGSize(FS, wWidth, wHeight);
  finally
    FS.Free;
  end;
end {GetJPGSize};

function GetJPGSize(const Stream: TStream; out wWidth, wHeight: word): Boolean;
const
  ValidSig : array[0..1] of byte = ($FF, $D8);
  Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
  Sig: array[0..1] of byte;
  x: integer;
  Seg: byte;
  Dummy: array[0..15] of byte;
  Len: word;
  ReadLen: LongInt;
begin
  FillChar(Sig, SizeOf(Sig), #0);
  ReadLen := Stream.Read(Sig[0], SizeOf(Sig));
  for x := Low(Sig) to High(Sig) do
    if Sig[x] <> ValidSig[x] then
      ReadLen := 0;
    if ReadLen > 0 then
    begin
      ReadLen := Stream.Read(Seg, 1);
      while (Seg = $FF) and (ReadLen > 0) do
      begin
        ReadLen := Stream.Read(Seg, 1);
        if Seg <> $FF then
        begin
          if (Seg = $C0) or (Seg = $C1) then
          begin
            ReadLen := Stream.Read(Dummy[0], 3);  // don't need these bytes
            wHeight := ReadMWord(Stream);
            wWidth := ReadMWord(Stream);
          end
          else
          begin
            if not (Seg in Parameterless) then
            begin
              Len := ReadMWord(Stream);
              Stream.Seek(Len - 2, 1);
              Stream.Read(Seg, 1);
            end
            else
              Seg := $FF;  // Fake it to keep looping.
          end;
        end;
      end;
    end;
  Result := True; // TODO: fail if we run into strange stuff?
end;


function GetPNGSize(const sFile: string; out wWidth, wHeight: word): boolean;
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(sFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := GetPNGSize(FS, wWidth, wHeight);
  finally
    FS.Free;
  end;
end {GetPNGSize};

function GetPNGSize(const Stream: TStream; out wWidth, wHeight: word): boolean;
type
  TPNGSig = array[0..7] of byte;
const
  ValidSig: TPNGSig = (137, 80, 78, 71, 13, 10, 26, 10);
var
  Sig: TPNGSig;
  x: integer;
begin
  Result := False;
  FillChar(Sig, SizeOf(Sig), #0);
  Stream.Read(Sig[0], SizeOf(Sig));
  for x := Low(Sig) to High(Sig) do
    if Sig[x] <> ValidSig[x] then
      exit;
  Stream.Seek(18, 0);
  wWidth := ReadMWord(Stream);
  Stream.Seek(22, 0);
  wHeight := ReadMWord(Stream);
  Result := True;
end {GetPNGSize};


function GetGIFSize(const sGIFFile: string; out wWidth, wHeight: word): Boolean;
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(sGIFFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := GetGIFSize(FS, wWidth, wHeight);
  finally
    FS.Free;
  end;
end {GetGIFSize};

function GetGIFSize(const Stream: TStream; out wWidth, wHeight: word): Boolean;
type
  TGIFHeader = record
  Sig: array[0..5] of char;
  ScreenWidth, ScreenHeight: word;
  Flags, Background, Aspect: byte;
end;
  TGIFImageBlock = record
  Left, Top, Width, Height: word;
  Flags: byte;
end;
var
  Header: TGifHeader;
  ImageBlock: TGifImageBlock;
  nResult: integer;
  x: integer;
  c: ansichar;
  DimensionsFound: boolean;
begin
  Result := False;
  wWidth  := 0;
  wHeight := 0;

  {$I-}

  // Read header and ensure valid file
  nResult := Stream.Read(Header, SizeOf(TGifHeader));
  if (nResult <> SizeOf(TGifHeader)) or (StrLComp('GIF', Header.Sig, 3) <> 0) then
  begin
    // Image file invalid
    exit;
  end;
  // Skip color map, if there is one
  if (Header.Flags and $80) > 0 then
  begin
    x := 3 * (1 SHL ((Header.Flags and 7) + 1));
    Stream.Seek(x, TSeekOrigin.soBeginning);
  end;
  DimensionsFound := False;
  FillChar(ImageBlock, SizeOf(TGIFImageBlock), #0);
  // Step through blocks
  nResult := Stream.Read(c, 1);
  while (not (Stream.Position >= Stream.Size)) and (not DimensionsFound) do
  begin
    case c of
    ',':  // Found image
      begin
        nResult := Stream.Read(ImageBlock, SizeOf(TGIFImageBlock));
        if nResult <> SizeOf(TGIFImageBlock) then
        begin
          // Invalid image block encountered
          exit;
        end;
        wWidth := ImageBlock.Width;
        wHeight := ImageBlock.Height;
        DimensionsFound := True;
      end;
      // nothing else, just ignore
    end;
    nResult := Stream.Read(c, 1);
  end {while};
{$I+}

end{GetGIFSize};


function GetBMPSize(const sFile: string; out Width, Height: integer): boolean;
var
  FS: TFileStream;
begin
  FS := TFileStream.Create(sFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := GetBMPSize(FS, Width, Height);
  finally
    FS.Free;
  end;
end {GetBMPSize};

function GetBMPSize(const Stream: TStream; out Width, Height: integer): boolean;
const
  BMP_MAGIC_WORD = ord('M') shl 8 or ord('B');
var
  header: TBitmapFileHeader;
  info: TBitmapInfoHeader;
begin
  result := false;
  if Stream.Read(header, sizeof(header)) <> sizeof(header) then Exit;
  if header.bfType <> BMP_MAGIC_WORD then Exit;
  if Stream.Read(info, sizeof(info)) <> sizeof(info) then Exit;
  Width := info.biWidth;
  Height := abs(info.biHeight);
  result := true;
end;

end.

Added src/L_FileList.pas.























































































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

interface
uses
  System.Generics.Collections;

type
  TPLInclusion = (Inherit, Include, IncludeRecursive, Exclude, ExcludeRecursive);

  TPLFileListSource = class
  public
    constructor Create(const Path: string; const Inclusion: TPLInclusion);
  end;

  TPLFileListSources = class(TList<TPLFileListSource>);

  TPLFileList = class(TList<string>)
  private
    FSources: TPLFileListSources;
  public
    constructor Create;
    destructor  Destroy; override;

    property Sources: TPLFileListSources  read FSources;
  end;

implementation

{ TPLFileList }

constructor TPLFileList.Create;
begin
  inherited Create({TODO: string comparer});
  FSources := TPLFileListSources.Create;
end;

destructor TPLFileList.Destroy;
begin
  FSources.Free;
  inherited;
end;

end.

Changes to src/U_WPImages.pas.

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
var
  FS: TFileStream;
  OG: TOleGraphic;
  W, H: Word;
begin
  FS := TFileStream.Create(Path, fmOpenRead or fmShareDenyNone);
  try
    // Try identifying the image type by its signature, then retrieve the file size
    if GetJPGSize(FS, W, H) or GetPNGSize(FS, W, H) or GetGIFSize(FS, W, H) then begin
      FWidth := W;
      FHeight := H;
    end else if not GetBMPSize(FS, FWidth, FHeight) then begin
      // All else has failed; see if Windows recognizes it
      OG := TOleGraphic.Create;
      try
        OG.LoadFromStream(FS);
        Width := OG.Width;
        Height := OG.Height;







|

|
|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
var
  FS: TFileStream;
  OG: TOleGraphic;
  W, H: Word;
begin
  FS := TFileStream.Create(Path, fmOpenRead or fmShareDenyNone);
  try
    // Try to identify the image type by its signature, and retrieve the image dimensions
    if GetJPGSize(FS, W, H) or GetPNGSize(FS, W, H) or GetGIFSize(FS, W, H) then begin
      Width := W;
      Height := H;
    end else if not GetBMPSize(FS, FWidth, FHeight) then begin
      // All else has failed; see if Windows recognizes it
      OG := TOleGraphic.Create;
      try
        OG.LoadFromStream(FS);
        Width := OG.Width;
        Height := OG.Height;

Changes to src/WPCycler.dpr.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
program WPCycler;

uses
  Vcl.Forms,
  F_Main in 'F_Main.pas' {frmMain},
  U_WPImages in 'U_WPImages.pas',
  ImgSize in '..\..\..\..\..\..\..\Common\Delphi\ImgSize.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.




|
|
|









1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
program WPCycler;

uses
  Vcl.Forms,
  F_Main {frmMain},
  U_WPImages,
  L_FileList;

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end.

Changes to src/WPCycler.dproj.

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
        <DCC_DebugInformation>0</DCC_DebugInformation>
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="F_Main.pas">
            <Form>frmMain</Form>
            <FormType>dfm</FormType>
        </DCCReference>
        <DCCReference Include="U_WPImages.pas"/>
        <DCCReference Include="..\..\..\..\..\..\..\Common\Delphi\ImgSize.pas"/>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
        </BuildConfiguration>







<
<
<
<
<
<







83
84
85
86
87
88
89






90
91
92
93
94
95
96
        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
        <DCC_DebugInformation>0</DCC_DebugInformation>
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>






        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
        </BuildConfiguration>