Here is a demo you can use:
unit Unit1;
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
ProcessFiles1: TButton;
procedure ProcessFiles1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses Winapi.ShlObj, iexBitmaps;
function DesktopFolder: string;
var
iResult: bool;
iPath: array [0 .. MAX_PATH] of Char;
begin
iResult := Winapi.ShlObj.ShGetSpecialFolderPath(0, iPath,
CSIDL_DESKTOP, False);
if not iResult then
raise Exception.Create('Could not find Desktop folder location.');
Result := IncludeTrailingPathDelimiter(iPath);
end;
function GetAllFiles(AMask: string; AStringList: TStringList): integer;
{ Get all files matching mask (*.bmp) and add them to a stringlist }
var
iSearch: TSearchRec;
iDirectory: string;
iCount: integer;
iFileAttrs: integer;
begin
iCount := 0;
iDirectory := ExtractFilePath(AMask);
iFileAttrs := $23 - faHidden;
{ Find all files }
if FindFirst(AMask, iFileAttrs, iSearch) = 0 then
begin
repeat
{ Add the files to the stringlist }
AStringList.Add(iDirectory + iSearch.name);
Inc(iCount);
until FindNext(iSearch) <> 0;
end;
{ Subdirectories }
if FindFirst(iDirectory + '*.*', faDirectory, iSearch) = 0 then
begin
repeat
if ((iSearch.Attr and faDirectory) = faDirectory) and
(iSearch.name[1] <> '.') then
GetAllFiles(iDirectory + iSearch.name + '\' + ExtractFileName(AMask),
AStringList);
until FindNext(iSearch) <> 0;
FindClose(iSearch);
end;
Result := iCount;
end;
function GetFilesMatchingMask(const APathName: string;
const AExtensions: string; var AStringList: TStringList): integer;
{ Given a pathname, this function fills AStringList with filenames matching the extensions mask (*.bmp;*.jpg;*.png) }
const
iFileMask = '*.*';
var
iSearchRec: TSearchRec;
iPath: string;
iCount: integer;
begin
iCount := 0;
iPath := IncludeTrailingBackslash(APathName);
if FindFirst(iPath + iFileMask, faAnyFile - faDirectory, iSearchRec) = 0 then
try
repeat
if AnsiPos(ExtractFileExt(iSearchRec.name), AExtensions) > 0 then
begin
AStringList.Add(iPath + iSearchRec.name);
Inc(iCount);
end;
until FindNext(iSearchRec) <> 0;
finally
System.SysUtils.FindClose(iSearchRec);
end;
if FindFirst(iPath + '*.*', faDirectory, iSearchRec) = 0 then
try
repeat
if ((iSearchRec.Attr and faDirectory) <> 0) and (iSearchRec.name <> '.')
and (iSearchRec.name <> '..') then
GetFilesMatchingMask(iPath + iSearchRec.name, AExtensions,
AStringList);
until FindNext(iSearchRec) <> 0;
finally
FindClose(iSearchRec);
end;
Result := iCount;
end;
function JustFilename(const APathName: string): string;
{ Return a filename from a string }
var
iString: string;
i: integer;
{ Turn }
{ Reverse characters in a string ABCD -> DCBA }
function Turn(const AString: string): string;
var
i: integer;
begin
Result := '';
if AString <> '' then
for i := 1 to Length(AString) do
Result := AString[i] + Result;
end;
begin
iString := Turn(APathName);
i := Pos('\', iString);
if i = 0 then
i := Pos(':', iString);
if i = 0 then
Result := APathName
else
Result := Turn(Copy(iString, 1, i - 1));
end;
function JustName(const APathName: string): string;
{ Return just the name from a file string }
var
iString: string;
begin
iString := JustFilename(APathName);
if Pos('.', iString) <> 0 then
Result := Copy(iString, 1, Pos('.', iString) - 1)
else
Result := iString;
end;
procedure TForm1.ProcessFiles1Click(Sender: TObject);
var
i: integer;
iFolder: string;
iNumberofFiles: integer;
iIsMultiFrameImage: Boolean;
iSourceFilename: string;
iExtension: string;
iDestinationFilename: string;
iStringList: TStringList;
iIEMultiBitmap: TIEMultiBitmap;
j: integer;
iFrames: integer;
begin
{Create a string list to hold the filenames in a folder}
iStringList := TStringList.Create;
{ Set the source folder }
iFolder := IncludeTrailingPathDelimiter(DesktopFolder);
{ Add the files to the string list }
iNumberofFiles := GetAllFiles(iFolder + '*.*', iStringList);
if iNumberofFiles > 0 then
begin
for i := 0 to iNumberofFiles - 1 do
begin
{ Get the source filename }
iSourceFilename := iStringList[i];
{ Get the extension }
iExtension := ExtractFileExt(iSourceFilename);
{ Get the number of frames in the file }
iFrames := IEGetFileFramesCount(iSourceFilename);
{ Does the filename contain multiframe pages }
iIsMultiFrameImage := iFrames > 1;
{ If the format is known and is a multiframe image }
if (IsKnownFormat(iSourceFilename)) and (iIsMultiFrameImage) then
begin
for j := 0 to iFrames - 1 do
begin
{ Set the destination Filename }
iDestinationFilename := iFolder + JustName(iSourceFilename) + ' Page '
+ IntToStr(j + 1) + iExtension;
{ Create the iemultibitmap }
iIEMultiBitmap := TIEMultiBitmap.Create;
{ Read the bitmap page }
iIEMultiBitmap.Read(iSourceFilename);
{ Save the bitmap page }
iIEMultiBitmap.GetImageToFile(j, iDestinationFilename);
{ Free the IEMultibitmap }
iIEMultiBitmap.Free;
end;
end;
end;
end;
{ Free the string list }
iStringList.Free;
end;
end.
Bill Miller
Adirondack Software & Graphics
Email: w2m@hughes.net
EBook: http://www.imageen.com/ebook/
Custom Commercial ImageEn Development