XE8からフォトアルバム(カメラロール)に画像を保存する機能が追加されました。
IFMXPhotoLibraryのAddImageToSavedPhotosAlbumメソッドを使うと画像をフォトアルバム(カメラロール)に保存できます。
参考:Delphi 10 SeattleのFiremonkeyアプリケーションでフォトアルバム(カメラロール)に画像を保存するには
procedure TForm1.Button1Click(Sender: TObject);
var
Service: IFMXPhotoLibrary;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXPhotoLibrary, Service) then
begin
Service.AddImageToSavedPhotosAlbum(Image1.Bitmap, WriteImageCompletion);
end;
end;
IFMXPhotoLibraryは、Windowsでは使用できません。
Windows上でDUnitXを使って、フォトアルバムに写真を登録するコードをテストしたい。
コールバックが呼ばれるようになんとかしたい。
そこで、Windows用のIFMXPhotoLibraryを作成しました。
Windowsにフォトアルバムはありませんので、何もしないで、登録成功を返します。
unit ImageManagerWindows;
interface
uses FMX.Platform, FMX.MediaLibrary, FMX.Graphics;
type
TImageManagerWindows = class sealed(TInterfacedObject, IFMXPhotoLibrary)
public
procedure AddImageToSavedPhotosAlbum(const ABitmap: TBitmap;
const AWriteImageCompletionEvent: TWriteImageCompletionEvent = nil);
end;
implementation
var
ImageManager: TImageManagerWindows;
{ TImageManagerWindows }
procedure TImageManagerWindows.AddImageToSavedPhotosAlbum
(const ABitmap: TBitmap; const AWriteImageCompletionEvent
: TWriteImageCompletionEvent);
begin
// 何もしないで成功したことにする
if Assigned(AWriteImageCompletionEvent) then
AWriteImageCompletionEvent(True, '保存しました。');
end;
procedure RegisterMediaLibraryServices;
begin
ImageManager := TImageManagerWindows.Create;
TPlatformServices.Current.AddPlatformService(IFMXPhotoLibrary,
IInterface(ImageManager));
end;
initialization
RegisterMediaLibraryServices;
end.
たとえば、次のようなクラスをWindowsでテストできます。
unit Diary;
interface
type
/// <summary>
/// 日記
/// </summary>
TDiary = class
private
FSaved: Boolean;
FResultMessage: string;
procedure WriteImageCompletion(const ASaved: Boolean;
const AResultMessage: string);
public
/// <summary>
/// フォトアルバムへの登録に成功したときはTrue
/// </summary>
property Saved: Boolean read FSaved;
/// <summary>
/// フォトアルバムに登録したときの結果のメッセージ
/// </summary>
property ResultMessage: string read FResultMessage;
/// <summary>
/// 指定した日付の写真をフォトアルバムへ登録する
/// </summary>
procedure ExportPhoto(const ADate: TDate);
end;
implementation
{ TDiary }
uses FMX.Platform, FMX.MediaLibrary, FMX.Graphics;
procedure TDiary.ExportPhoto(const ADate: TDate);
var
Service: IFMXPhotoLibrary;
ABitmap: TBitmap;
begin
ABitmap := nil;
if TPlatformServices.Current.SupportsPlatformService(IFMXPhotoLibrary, Service)
then
begin
Service.AddImageToSavedPhotosAlbum(ABitmap, WriteImageCompletion);
end;
end;
procedure TDiary.WriteImageCompletion(const ASaved: Boolean;
const AResultMessage: string);
begin
FSaved := ASaved;
FResultMessage := AResultMessage;
end;
end.
テストコードです。
unit MyTest;
interface
uses
DUnitX.TestFramework;
type
[TestFixture]
TMyTest = class(TObject)
public
[Test]
procedure SavePhotoAlbum;
end;
implementation
{ TMyTest }
uses System.DateUtils, Diary;
procedure TMyTest.SavePhotoAlbum;
var
Diary: TDiary;
begin
Diary := TDiary.Create;
Diary.ExportPhoto(Today); // フォトアルバムに登録する
Assert.IsTrue(Diary.Saved); // 登録に成功したときはTrue
Diary.Free;
end;
initialization
TDUnitX.RegisterTestFixture(TMyTest);
end.
Windowsでもテストを実行できるようになりました。