BSOne.SFC/EM.Lib/ImageEn_SRC/Demos/ImageAcquisition/PortableDevices/uMain.pas

640 lines
19 KiB
Plaintext

unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, iexWPD, ComCtrls, ImgList, ieview, imageenview, iemview,
hyieutils, iexBitmaps, hyiedefs, iesettings, iexLayers, iexRulers;
type
TfrmMain = class(TForm)
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
imlGlyphs: TImageList;
grpDevices: TGroupBox;
grpObjects: TGroupBox;
lbxDevices: TListBox;
btnDeviceProps: TButton;
btnRefreshDevices: TButton;
chkIncludeSubfolders: TCheckBox;
lbxObjects: TListBox;
lblCurrentFolder: TLabel;
edtCurrentFolder: TEdit;
btnOpenRoot: TButton;
btnOpenParent: TButton;
btnOpenObject: TButton;
grpFunctions: TGroupBox;
grpFindFiles: TGroupBox;
lblFindFilesHelp: TLabel;
edtFindFiles: TEdit;
btnFindFiles: TButton;
cmbFindFiles: TComboBox;
chkFindFilesSubFolders: TCheckBox;
btnCopyFromDevice: TButton;
btnShowObjectProps: TButton;
btnDeleteAll: TButton;
btnDeleteFromDevice: TButton;
btnCopyToDevice: TButton;
btnNavigateToPath: TButton;
edtNavigateToPath: TEdit;
lblNavigateToPath: TLabel;
pgvView: TPageControl;
tabLogging: TTabSheet;
tabPreview: TTabSheet;
ImageEnView1: TImageEnView;
memLog: TMemo;
chkHideEmptyDevices: TCheckBox;
tabThumbs: TTabSheet;
ImageEnMView1: TImageEnMView;
procedure btnCopyFromDeviceClick(Sender: TObject);
procedure btnCopyToDeviceClick(Sender: TObject);
procedure btnDeleteAllClick(Sender: TObject);
procedure btnDeleteFromDeviceClick(Sender: TObject);
procedure btnNavigateToPathClick(Sender: TObject);
procedure btnOpenObjectClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnRefreshDevicesClick(Sender: TObject);
procedure btnOpenParentClick(Sender: TObject);
procedure btnShowObjectPropsClick(Sender: TObject);
procedure btnDevicePropsClick(Sender: TObject);
procedure btnFindFilesClick(Sender: TObject);
procedure btnOpenRootClick(Sender: TObject);
procedure chkIncludeSubfoldersClick(Sender: TObject);
procedure cmbFindFilesChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ImageEnMView1ImageIDRequestEx(Sender: TObject; Index, ID: Integer; var Bitmap: TIEBitmap);
procedure lbxDevicesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure lbxObjectsClick(Sender: TObject);
procedure lbxObjectsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure pgvViewChange(Sender: TObject);
private
{ Private declarations }
fPortableDevices: TIEPortableDevices;
procedure AddToLog(Sender : TObject; const sMsg : string);
procedure ClearLog;
procedure RefreshDeviceList();
function GetSelectedDeviceID: string;
function GetSelectedObjectID: string;
procedure UpdateControlStatus;
procedure OpenFolder(const sFolderID : WideString);
procedure FillObjectList;
procedure UpdateImagePreview;
procedure UpdateThumbnailPreview;
public
{ Public declarations }
property SelectedDeviceID : string read GetSelectedDeviceID;
property SelectedObjectID : string read GetSelectedObjectID;
end;
var
frmMain: TfrmMain;
implementation
uses
iexHelperFunctions, ShellAPI, imageenio, iexShellThumbnails, iexWindowsFunctions;
{$R *.dfm}
{$R WindowsTheme.res}
const
// cmbFindFiles Items
cmbFindFiles_Index_FindExtensions = 0;
cmbFindFiles_Index_ByName = 1;
procedure TfrmMain.ClearLog;
begin
memLog.Lines.Clear;
end;
// fPortableDevices Logging event
procedure TfrmMain.AddToLog(Sender : TObject; const sMsg : string);
begin
memLog.Lines.Add( sMsg );
end;
// Copy the selected file from the device
procedure TfrmMain.btnCopyFromDeviceClick(Sender: TObject);
var
Idx: Integer;
aObject: TIEWPDObject;
begin
if SelectedObjectID = '' then
exit;
Idx := fPortableDevices.ObjectIDToIndex( SelectedObjectID );
aObject := fPortableDevices.Objects[ Idx ];
if aObject.ObjectType = iewFolder then
exit;
SaveDialog1.FileName := aObject.Filename;
if SaveDialog1.Execute then
fPortableDevices.CopyFileFromDevice( SelectedDeviceID, aObject.ID, SaveDialog1.FileName );
end;
// Copy a local file to the device
procedure TfrmMain.btnCopyToDeviceClick(Sender: TObject);
var
sFilename : WideString;
sDeviceID: string;
sDestFolderID: string;
begin
if ( SelectedObjectID = '' ) or
( fPortableDevices.ObjectIsFolder( SelectedObjectID ) = False ) then
exit;
// Prompt for a file to copy
if OpenDialog1.Execute = False then
exit;
ShowTempHourglass;
sDeviceID := SelectedDeviceID;
sFilename := OpenDialog1.FileName;
sDestFolderID := SelectedObjectID;
// Copy to folder on device
if fPortableDevices.CopyFileToDevice(sDeviceID, sDestFolderID, sFilename) then
ShowMessage( 'File successfully copied to device' )
else
ShowMessage( 'Failed to copy file to device!' );
end;
// Delete all displayed files
procedure TfrmMain.btnDeleteAllClick(Sender: TObject);
var
sResultText: WideString;
iCount: Integer;
begin
if lbxObjects.Items.Count = 0 then
exit;
if MessageDlg( format( 'Are you sure you want to delete the %d files in this folder?', [ lbxObjects.Items.Count ] ),
mtConfirmation, [ mbYes, mbNo ], 0) = mrYes then
begin
ShowTempHourglass;
iCount := fPortableDevices.DeleteFromDevice( SelectedDeviceID, lbxObjects.Items, True, sResultText );
if iCount = -1 then
ShowMessage( sResultText )
else
begin
lbxObjects.Items.Clear;
ShowMessage( format( '%d files were successfully deleted', [ iCount ] ));
end;
end;
UpdateThumbnailPreview;
end;
// Delete the selected file or folder
procedure TfrmMain.btnDeleteFromDeviceClick(Sender: TObject);
var
sResultText: WideString;
Idx: Integer;
aObject: TIEWPDObject;
begin
if SelectedObjectID = '' then
exit;
Idx := fPortableDevices.ObjectIDToIndex( SelectedObjectID );
aObject := fPortableDevices.Objects[ Idx ];
if MessageDlg( 'Are you sure you want to delete the file: ' + aObject.Filename, mtConfirmation, [ mbYes, mbNo ], 0 ) = mrYes then
begin
ShowTempHourglass;
// Note: bDeleteSubObjects is true, so if a folder is selected it will also delete any files in it
if fPortableDevices.DeleteFromDevice(SelectedDeviceID, aObject.ID, True, sResultText) > -1 then
lbxObjects.Items.Delete( lbxObjects.ItemIndex );
ShowMessage( sResultText );
UpdateThumbnailPreview;
end;
end;
// Navigate to a path on the device
procedure TfrmMain.btnNavigateToPathClick(Sender: TObject);
begin
if ( SelectedDeviceID = '' ) or ( edtNavigateToPath.Text = '' ) then
exit;
ShowTempHourglass;
if fPortableDevices.NavigateToFolderPath(SelectedDeviceID, edtNavigateToPath.Text) then
FillObjectList
else
ShowMessage('Path could not be found!');
end;
// Open the selected folder/Launch the selected file
procedure TfrmMain.btnOpenObjectClick(Sender: TObject);
var
Idx: Integer;
aObject: TIEWPDObject;
sFilename: string;
begin
if SelectedObjectID = '' then
exit;
if fPortableDevices.ObjectIsFolder( SelectedObjectID ) then
OpenFolder( SelectedObjectID )
else
begin
// Save and launch
Idx := fPortableDevices.ObjectIDToIndex( SelectedObjectID );
aObject := fPortableDevices.Objects[ Idx ];
sFilename := IncludeTrailingBackSlash( ExtractFilePath( Application.ExeName )) + aObject.Filename;
if fPortableDevices.CopyFileFromDevice(SelectedDeviceID, aObject.ID, sFileName) then
ShellExecute(Handle, 'open', PChar(sFileName), nil, nil, SW_MAXIMIZE);
end;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
fPortableDevices.Free;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
fPortableDevices := TIEPortableDevices.Create();
fPortableDevices.OnLog := AddToLog;
cmbFindFiles.ItemIndex := cmbFindFiles_Index_FindExtensions;
ImageEnMView1.SetModernStyling( True );
end;
// Rebuild the list of devices
procedure TfrmMain.btnRefreshDevicesClick(Sender: TObject);
begin
RefreshDeviceList();
end;
// Go to the parent of the displayed folder
procedure TfrmMain.btnOpenParentClick(Sender: TObject);
begin
if fPortableDevices.NavigateToParent then
FillObjectList;
end;
procedure TfrmMain.btnShowObjectPropsClick(Sender: TObject);
var
aProps: TIEWPDObjectAdvancedProps;
begin
if fPortableDevices.GetObjectAdvancedProps( SelectedObjectID, aProps ) = False then
raise Exception.create('Cannot access Object properties');
ClearLog;
AddToLog(nil, 'WPD_OBJECT_ID: ' + aProps.ObjectID );
AddToLog(nil, 'WPD_OBJECT_PARENT_ID: ' + aProps.ParentID );
AddToLog(nil, 'WPD_OBJECT_NAME: ' + aProps.FriendlyName );
AddToLog(nil, 'WPD_OBJECT_ORIGINAL_FILE_NAME: ' + aProps.Filename );
AddToLog(nil, 'WPD_OBJECT_PERSISTENT_UNIQUE_ID: ' + aProps.PersistentUniqueID );
AddToLog(nil, 'WPD_OBJECT_FORMAT: '+ IntToStr( ord( aProps.ObjectFormat )));
AddToLog(nil, 'WPD_OBJECT_CONTENT_TYPE: '+ IntToStr( ord( aProps.ContentType )));
AddToLog(nil, 'WPD_OBJECT_ISHIDDEN: ' + BoolToStr( aProps.IsHidden ));
AddToLog(nil, 'WPD_OBJECT_ISSYSTEM: ' + BoolToStr( aProps.IsSystem ));
AddToLog(nil, 'WPD_OBJECT_DATE_CREATED: ' + DateTimeToStr( aProps.DateCreated ));
AddToLog(nil, 'WPD_OBJECT_DATE_MODIFIED: ' + DateTimeToStr( aProps.DateModified ));
end;
procedure TfrmMain.btnDevicePropsClick(Sender: TObject);
begin
{$IFDEF DEBUG}
// Need to recompile the ImageEn source with DEBUG define to use EnumDeviceProperties
// fPortableDevices.EnumDeviceProperties( SelectedDeviceID, memLog.Lines );
MessageDlg( 'Enable DEBUG define and re-enable ImageEn sources to use.', mtInformation, [ mbOK ], 0 );
{$ENDIF}
end;
procedure TfrmMain.btnFindFilesClick(Sender: TObject);
var
iMaxDepth: Integer;
begin
if ( SelectedDeviceID = '' ) or ( edtFindFiles.Text = '' ) then
exit;
ShowTempHourglass;
if chkFindFilesSubFolders.checked then
iMaxDepth := -1 { ALL SUB-FOLDERS }
else
iMaxDepth := 0; { CURRENT FOLDER ONLY }
case cmbFindFiles.ItemIndex of
cmbFindFiles_Index_FindExtensions : begin
// FIND EXTENSIONS
if fPortableDevices.FindFilesOfType( fPortableDevices.ActiveFolderID, edtFindFiles.Text, iMaxDepth) then
FillObjectList;
end;
cmbFindFiles_Index_ByName : begin
// FIND EXTENSIONS
if fPortableDevices.FindFilesByName( fPortableDevices.ActiveFolderID, edtFindFiles.Text, [iewFile, iewFolder], iMaxDepth) then
FillObjectList;
end;
end;
end;
procedure TfrmMain.btnOpenRootClick(Sender: TObject);
begin
OpenFolder('');
end;
procedure TfrmMain.chkIncludeSubfoldersClick(Sender: TObject);
begin
OpenFolder( fPortableDevices.ActiveFolderID )
end;
procedure TfrmMain.cmbFindFilesChange(Sender: TObject);
begin
case cmbFindFiles.ItemIndex of
cmbFindFiles_Index_FindExtensions : begin
edtFindFiles.Text := '*.jpg;*.jpeg;';
lblFindFilesHelp.Caption := 'Specify file extensions, e.g. *.jpg;*.jpeg;*.mp4';
end;
cmbFindFiles_Index_ByName : begin
edtFindFiles.Text := '*File*';
lblFindFilesHelp.Caption := 'Specify search text, e.g. MyFile.jpg (exact match) or *File* (wildcard search';
end;
end;
end;
procedure TfrmMain.RefreshDeviceList();
var
I: Integer;
begin
ShowTempHourglass;
ClearLog;
lbxObjects.Items.Clear;
fPortableDevices.HideEmptyDevices := chkHideEmptyDevices.checked;
if fPortableDevices.RefreshDevices = False then
raise Exception.create('Unable to get devices: ' + fPortableDevices.LastError);
lbxDevices.Items.BeginUpdate;
lbxDevices.Items.Clear;
for I := 0 to fPortableDevices.DeviceCount - 1 do
lbxDevices.Items.Add( fPortableDevices.Devices[i].ID );
lbxDevices.Items.EndUpdate;
UpdateThumbnailPreview;
UpdateControlStatus;
end;
procedure TfrmMain.OpenFolder(const sFolderID : WideString);
begin
// Is Device selected?
if SelectedDeviceID = '' then
exit;
ShowTempHourglass;
if fPortableDevices.NavigateToFolderID( SelectedDeviceID, sFolderID, chkIncludeSubfolders.checked ) then
FillObjectList
else
raise Exception.create('Unable to navigate to folder: ' + fPortableDevices.LastError);
end;
procedure TfrmMain.FillObjectList;
var
I: Integer;
begin
lbxObjects.Items.BeginUpdate;
lbxObjects.Items.Clear;
for I := 0 to fPortableDevices.ObjectCount - 1 do
lbxObjects.Items.Add( fPortableDevices.Objects[i].ID );
lbxObjects.Items.EndUpdate;
UpdateThumbnailPreview;
UpdateControlStatus;
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
RefreshDeviceList();
pgvView.ActivePageIndex := 0;
end;
function TfrmMain.GetSelectedDeviceID: string;
begin
Result := '';
if lbxDevices.ItemIndex >= 0 then
Result := lbxDevices.Items[ lbxDevices.ItemIndex ];
end;
function TfrmMain.GetSelectedObjectID: string;
begin
Result := '';
if ( SelectedDeviceID <> '' ) and
( lbxObjects.ItemIndex >= 0 ) then
Result := lbxObjects.Items[ lbxObjects.ItemIndex ];
end;
procedure TfrmMain.ImageEnMView1ImageIDRequestEx(Sender: TObject; Index, ID: Integer; var Bitmap: TIEBitmap);
var
aObject: TIEWPDObject;
aMemStream : TMemoryStream;
Idx: Integer;
begin
Idx := fPortableDevices.ObjectIDToIndex( lbxObjects.Items[ ID ] );
aObject := fPortableDevices.Objects[ Idx ];
if ( aObject.ObjectType = iewFolder ) or ( IsKnownFormat( aObject.Filename ) = False ) then
begin
// Get a folder icon
Bitmap := TIEBitmap.create;
IEGetJumboFileIcon( WindowsProgramFilesFolder, Bitmap );
end
else
begin
ShowTempHourglass;
// Retrieve the image from the device
aMemStream := TMemoryStream.create;
try
if fPortableDevices.CopyStreamFromDevice( SelectedDeviceID, aObject.ID, aMemStream ) then
begin
Bitmap := TIEBitmap.create;
// Standard loading
// Bitmap.Read( aMemStream );
// Or use helper function to load faster by optimizing to the output size
Bitmap.IELoadFromStreamFast( aMemStream, ioUnknown, ImageEnMView1.ThumbWidth, ImageEnMView1.Height, True );
end;
finally
aMemStream.free;
end;
end;
end;
const
// Items of imlGlyphs
IMG_DRIVE = 0;
IMG_DEVICE = 1;
IMG_FOLDER = 2;
IMG_FILE = 3;
procedure TfrmMain.lbxDevicesDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
sText: string;
Idx: Integer;
iImage: Integer;
aDevice: TIEPortableDevice;
begin
Idx := fPortableDevices.DeviceIDToIndex( lbxDevices.Items[ Index ] );
aDevice := fPortableDevices.Devices[ Idx ];
if Idx < 0 then
begin
sText := 'ERROR!!!';
iImage := -1;
end
else
if aDevice.IsDrive then
begin
// Want device display names
sText := aDevice.FriendlyName;
iImage := IMG_DRIVE;
end
else
begin
// Want file extension so use Filename
sText := aDevice.FriendlyName;
iImage := IMG_DEVICE;
end;
IEDrawComboListBoxItem( TListBox( Control ).Canvas, Rect, Control.Enabled, sText, imlGlyphs, iImage );
end;
procedure TfrmMain.lbxObjectsClick(Sender: TObject);
begin
UpdateImagePreview;
UpdateControlStatus;
end;
procedure TfrmMain.lbxObjectsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
sText: string;
Idx: Integer;
iImage: Integer;
begin
Idx := fPortableDevices.ObjectIDToIndex( lbxObjects.Items[ Index ] );
if Idx < 0 then
begin
sText := 'ERROR!!!';
iImage := -1;
end
else
if fPortableDevices.ObjectIsFolder( Idx ) then
begin
// Want device display names
sText := fPortableDevices.Objects[ Idx ].FriendlyName;
iImage := IMG_FOLDER;
end
else
begin
// Want file extension so use Filename
sText := fPortableDevices.Objects[ Idx ].Filename;
iImage := IMG_FILE;
end;
IEDrawComboListBoxItem(TListBox(Control).Canvas, Rect, Control.Enabled, sText, imlGlyphs, iImage);
end;
procedure TfrmMain.pgvViewChange(Sender: TObject);
begin
UpdateImagePreview;
UpdateThumbnailPreview;
end;
procedure TfrmMain.UpdateControlStatus;
var
bHaveDevice: Boolean;
bHaveFolder: Boolean;
bHaveFile: Boolean;
begin
bHaveDevice := SelectedDeviceID <> '';
bHaveFile := ( SelectedObjectID <> '' ) and ( fPortableDevices.ObjectIsFolder( SelectedObjectID ) = False );
bHaveFolder := ( SelectedObjectID <> '' ) and ( fPortableDevices.ObjectIsFolder( SelectedObjectID ));
grpFunctions .Enabled := bHaveDevice;
edtNavigateToPath.Enabled := bHaveDevice;
btnNavigateToPath.Enabled := bHaveDevice;
btnOpenRoot .Enabled := bHaveDevice and ( fPortableDevices.ActiveFolderID <> '' );
btnCopyFromDevice.Enabled := bHaveFile;
btnCopyToDevice.Enabled := bHaveFolder;
btnOpenObject.Enabled := bHaveFile or bHaveFolder;
btnDeleteFromDevice.Enabled := bHaveFile or bHaveFolder;
btnShowObjectProps.Enabled := bHaveFile or bHaveFolder;
btnDeleteAll.Enabled := lbxObjects.Items.Count > 0;
btnOpenParent.Enabled := fPortableDevices.CanNavigateToParent;
grpFindFiles.Enabled := bHaveDevice;
cmbFindFiles.Enabled := bHaveDevice;
edtFindFiles.Enabled := bHaveDevice;
btnFindFiles.Enabled := bHaveDevice;
lblFindFilesHelp.Enabled := bHaveDevice;
chkFindFilesSubFolders.Enabled := bHaveDevice;
{$IFDEF DEBUG}
btnDeviceProps.Visible := True;
btnDeviceProps.Enabled := bHaveDevice;
{$ENDIF}
edtCurrentFolder.Text := fPortableDevices.LookupObjectFriendlyName( SelectedDeviceID, fPortableDevices.ActiveFolderID );
if edtCurrentFolder.Text = '' then
edtCurrentFolder.Text := fPortableDevices.LookUpDeviceFriendlyName( SelectedDeviceID );
end;
// Show the current image in the TImageEnView
procedure TfrmMain.UpdateImagePreview;
var
Idx: Integer;
aObject: TIEWPDObject;
aMemStream : TMemoryStream;
begin
ShowTempHourglass;
if ( pgvView.ActivePage <> tabPreview ) or ( SelectedObjectID = '' ) then
ImageEnView1.Blank
else
begin
Idx := fPortableDevices.ObjectIDToIndex( SelectedObjectID );
aObject := fPortableDevices.Objects[ Idx ];
if ( aObject.ObjectType = iewFolder ) or ( IsKnownFormat( aObject.Filename ) = False ) then
ImageEnView1.Blank
else
begin
aMemStream := TMemoryStream.create;
try
if fPortableDevices.CopyStreamFromDevice( SelectedDeviceID, aObject.ID, aMemStream ) then
ImageEnView1.IO.LoadFromStream( aMemStream );
finally
aMemStream.free;
end;
end;
end;
end;
// Show the current folder in the TImageEnMView
procedure TfrmMain.UpdateThumbnailPreview;
var
Idx: Integer;
I: Integer;
begin
ImageEnMView1.Clear;
if ( pgvView.ActivePage <> tabThumbs ) or ( lbxObjects.Count = 0 ) then
exit;
ImageEnMView1.LockUpdate;
for I := 0 to lbxObjects.Count - 1 do
begin
Idx := ImageEnMView1.AppendImage;
ImageEnMView1.ImageID[ Idx ] := I;
if fPortableDevices.ObjectIsFolder( I ) then
ImageEnMView1.ImageBottomText[ Idx ] := fPortableDevices.Objects[ Idx ].FriendlyName
else
ImageEnMView1.ImageBottomText[ Idx ] := fPortableDevices.Objects[ Idx ].Filename;
end;
ImageEnMView1.SelectedImage := 0;
ImageEnMView1.UnlockUpdate;
end;
end.