Delphi 12 で画像保存の問題点
Windows と macOS では得に問題がないものの、モバイルOS では画像保存に大きなバグがあります。
なんなら画像保存なんてできないぐらいの大きなバグです。
影響範囲は全ての画像保存です。
TBitmap.SaveToFile や、その実体である TBitmapCodecManager.SaveToFile 、IFMXPhotoLibrary.AddImageToSavedPhotosAlbum など全ての画像保存に影響があります。
Android での問題
非 Main Thread の場合、画像が保存できません。
TBitmap は非同期操作に対応していると明言されているにもかかわらず、です。
失敗するのは BitmapSurface への BitmapData 転送です。
var Surf := TBitmapSurface.Create;
Surf.Assign(ABitmap);
別に BitmapSurface なんて使って無いよ?と思うかもしれませんが、Android の SaveToFile の実装は BitmapSurface を使うようになっているため、画像保存に失敗します。
じゃあ Thread を使わなければいいのでは?と思うと思いますが、ストレージの速度や画像の大きさにもよりますが、低価格端末では 4K 画像の保存には10秒程かかります。
この場合、ANR (Application Not Responding エラー)が発生してしまうため、Thread を使わないという選択肢はありません。
iOS での問題
iOS 18 から ALAssetsLibrary API が完全に廃止されました。
iOS 9 で既に Deprecated になっていた API です。
Delphi 12.3 でも未だに ALAssetsLibrary を使っているため、保存に失敗します。
解決方法
Android の場合
別スレッドで保存したい場合、メインスレッドで先に BitmapSurface への画像転送処理をやっておきます。
この処理自体は、そこまで時間がかかる訳では無いので問題ありません。
具体的には次のコードのようにします。
// Android 15 以降、非同期実行で失敗するため
// メインスレッドで処理しておく
var Surf := TBitmapSurface.Create;
Surf.Assign(ABitmap);
// 非同期部分では Surface を保存するようにする
TThread.CreateAnonymousThread(
procedure
begin
var Saved := False;
try
var SaveParams: TBitmapCodecSaveParams;
SaveParams.Quality := 100;
Saved := TBitmapCodecManager.SaveToFile(P, Surf, @SaveParams);
// ここで保存完了イベントハンドラなどを呼ぶ
finally
Surf.Free;
end;
end
).Start;
iOS の場合
これは非常に面倒です。
API が廃止されたため別の方法を1から書く必要があります。
公式には PHPhotoLibrary の使用が奨励されていますが、実装が面倒です。
そこで、UIImageWriteToSavedPhotosAlbum API を使います。
こんな感じで非常に簡単に保存できます。
var Image := BitmapToUIImage(ABitmap); // FMX.Helpers.iOS に定義
UIImageWriteToSavedPhotosAlbum(
(Image as ILocalObject).GetObjectID,
nil,
nil,
nil);
が、これだと保存完了が解りません。
保存完了を検知するために、完了コールバックを作る必要があります。
具体的には下記の様なクラスを作ります。
完了コールバッククラス全文
const
METHOD_NAME = 'image:didFinishSavingWithError:contextInfo:';
type
// 完了 Callback (TCompletionTarget) に定義されているメソッドを示す Interface
ICompletionTarget = interface(NSObject)
['{C12D0B3B-C5A6-4599-86E9-45011B84004B}']
[MethodName(METHOD_NAME)]
procedure didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject); cdecl;
end;
// 完了コールバック用クラス
TCompletionTarget = class(TOCLocal)
private class var
FTarget: TCompletionTarget;
FImage: UIImage;
FCompletionProc: TSaveBitmapToSharedFolderCompletionProc;
private
protected
function GetObjectiveCClass: PTypeInfo; override;
public
constructor Create(
const ACompletionProc: TSaveBitmapToSharedFolderCompletionProc);
[MethodName(METHOD_NAME)]
procedure didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject); cdecl;
end;
constructor TCompletionTarget.Create(
const ACompletionProc: TSaveBitmapToSharedFolderCompletionProc);
begin
inherited Create;
FCompletionProc := ACompletionProc;
end;
function TCompletionTarget.GetObjectiveCClass: PTypeInfo;
begin
// TCompletionTarget だと TObject に定義されているメソッドまで
// 登録されてしまうので、Interface を渡す
Result := TypeInfo(ICompletionTarget);
end;
procedure TCompletionTarget.didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject);
begin
if Assigned(FTarget.FCompletionProc) then
begin
var err := TNSError.Wrap(error);
TThread.ForceQueue(
nil,
procedure
begin
var Succeeded := False;
var Msg := SAVED_MESSAGES[True];
if err <> nil then
begin
Succeeded := error.code = 0;
Msg := NSStrToStr(err.localizedDescription);
end;
FTarget.FCompletionProc(Succeeded, Msg);
FreeAndNil(FTarget);
FImage := nil;
end
);
end;
end;
ここで問題になるのが didFinishSavingWithError
メソッドです。
このメソッドが完了コールバックの本体です。
関数の定義は↓このようになっていますが
procedure didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject); cdecl;
これは本来
procedure didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: Pointer); cdecl; // ←最後の引数が Pointer
このように定義されるメソッドです。
ですが、このままだと、Macapi.ObjectiveC Unit の MangleType のバグによりエラーで落ちます。
これは、MangleType が v@:@@^
になってしまうためです。
正しい MangleType は v@:@@^v
であり最後の引数は型無しポインタ型 (void*) になっていないといけません。
が、Delphi の MangleType 関数は、ポインタの定義が間違っており、^
の後ろに型名を付けません。
そのため、間違った MangleType v@:@@^
となり、呼び出すと落ちてしまいます。
そこで、ここでは Pointer ではなく NSObject で受けるようにしました。
この場合の MangleType は v@:@@@
となり、引数のサイズ的には型無しポインタと同じになるため正しく動作するようになります。
なお、contextInfo はユーザー定義のデータなので特に問題はありません。
参考: https://www.kansoftware.ru/?tid=26357
この完了コールバッククラスを使って、UIImageWriteToSavedPhotoAlbum を呼びます。
TCompletionTarget.FTarget := TCompletionTarget.Create(ACompletionProc);
TCompletionTarget.FImage := BitmapToUIImage(ABitmap);
UIImageWriteToSavedPhotosAlbum(
(TCompletionTarget.FImage as ILocalObject).GetObjectID,
TCompletionTarget.FTarget.GetObjectID,
sel_getUid(METHOD_NAME),
nil);
これで保存完了時に didFinishSavingWithError メソッドが呼ばれ、そこから保存完了イベントを発行できます。
全 OS で使える画像の保存関数
ここまで書いてきた事を全て実装した関数 SaveBitmapToSharedFolder
を作りました。
これを使うと画像を Shared Pictures に保存します。
全ての OS で使えますが、実際は、Windows / macOS は TSaveDialog を使って保存する場所を選ぶ方が良いでしょう。
↓ コード全文はこちら
PK.Storage.Utils
(*
* Save Bitmap Support Utils
*
* PLATFORMS
* Windows / macOS / Android / iOS
*
* LICENSE
* Copyright (c) 2020 HOSOKAWA Jun
* Released under the MIT license
* http://opensource.org/licenses/mit-license.php
*
* 2020/02/25 Version 1.0.0
* 2025/08/05 Version 2.0.0 Support: Android 15 over & iOS 18 over
* Programmed by HOSOKAWA Jun (twitter: @pik)
*)
unit PK.Storage.Utils;
interface
uses
System.SysUtils
, System.Classes
, System.IOUtils
, FMX.Consts
, FMX.Graphics
, FMX.Platform
, FMX.MediaLibrary
, FMX.Surfaces
{$IFDEF ANDROID}
, FMX.Helpers.Android
, FMX.Graphics.Android
, Androidapi.JNI.JavaTypes
, Androidapi.JNI.GraphicsContentViewText
, Androidapi.Helpers
, PK.Utils.Log
{$ENDIF}
{$IFDEF IOS}
, System.UITypes
, System.TypInfo
, Macapi.Helpers
, Macapi.ObjectiveC
, Macapi.ObjCRuntime
, iOSapi.Foundation
, iOSapi.UIKit
, FMX.Types
, FMX.Helpers.IOS
, FMX.Dialogs
{$ENDIF}
;
type
TSaveBitmapToSharedFolderCompletionProc =
reference to procedure(const ASaved: Boolean; const AResultMessage: String);
procedure SaveBitmapToSharedFolder(
const ABitmap: TBitmap;
const AFolderName: String = '';
const AFileName: String = '';
const ACompletionProc: TSaveBitmapToSharedFolderCompletionProc = nil);
implementation
const
SAVED_MESSAGES: array [Boolean] of String = (
'Failed to save.',
'Successfully saved.'
);
{$IFDEF IOS}
const
METHOD_NAME = 'image:didFinishSavingWithError:contextInfo:';
type
{
iOS 版の技術的説明
image:didFinishSavingWithError:contextInfo:
上記関数の本来の引数の型は UImage, NSError, Pointer だが、
Macapi.ObjectiveC Unit の MangleType のバグにより MangleType が v@:@@^ に
なってしまう。
正しくは v@:@@^v であり最後の引数は型無しポインタ型 (void*) になっていない
といけない。
v@:@@^ だと最後の ^ はエラーとして扱われるため引数2と解釈される。
その関数に対して引数が3個が渡されるためクラッシュする。
3個目の引数に型無しポインタ ^v と同じサイズの変数を宣言すれば
クラッシュしない。
そこで、ここでは Pointer ではなく NSObject で受けるようにしている。
この場合の MangleType は v@:@@@ となり、引数サイズ的には同じになるため
正しく動作する。
なお、contextInfo はユーザー定義のデータで、このライブラリでは使わない
参考: https://www.kansoftware.ru/?tid=26357
}
// 完了 Callback (TCompletionTarget) に定義されているメソッドを示す Interface
// 型定義用なので特にこれを実装する必要は無い
ICompletionTarget = interface(NSObject)
['{C12D0B3B-C5A6-4599-86E9-45011B84004B}']
[MethodName(METHOD_NAME)]
procedure didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject); cdecl;
end;
// 完了コールバック用クラス
TCompletionTarget = class(TOCLocal)
private class var
FTarget: TCompletionTarget;
FImage: UIImage;
FCompletionProc: TSaveBitmapToSharedFolderCompletionProc;
private
protected
function GetObjectiveCClass: PTypeInfo; override;
public
constructor Create(
const ACompletionProc: TSaveBitmapToSharedFolderCompletionProc);
[MethodName(METHOD_NAME)]
procedure didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject); cdecl;
end;
constructor TCompletionTarget.Create(
const ACompletionProc: TSaveBitmapToSharedFolderCompletionProc);
begin
inherited Create;
FCompletionProc := ACompletionProc;
end;
function TCompletionTarget.GetObjectiveCClass: PTypeInfo;
begin
// TCompletionTarget だと TObject に定義されているメソッドまで
// 登録されてしまうので、Interface を渡す
Result := TypeInfo(ICompletionTarget);
end;
procedure TCompletionTarget.didFinishSavingWithError(
image: UIImage;
error: NSError;
contextInfo: NSObject);
begin
if Assigned(FTarget.FCompletionProc) then
begin
var err := TNSError.Wrap(error);
TThread.ForceQueue(
nil,
procedure
begin
var Succeeded := True;
var Msg := SAVED_MESSAGES[True];
if err <> nil then
begin
Succeeded := error.code = 0;
Msg := NSStrToStr(err.localizedDescription);
end;
FTarget.FCompletionProc(Succeeded, Msg);
FreeAndNil(FTarget);
FImage := nil;
end
);
end;
end;
{$ENDIF}
procedure SaveBitmapToSharedFolder(
const ABitmap: TBitmap;
const AFolderName: String = '';
const AFileName: String = '';
const ACompletionProc: TSaveBitmapToSharedFolderCompletionProc = nil);
begin
{$IFDEF IOS}
// iOS では、AFolderName, AFileName は未使用
// iOS 18 以降、IFMXPhotoLibrary.AddImageToSavedPhotosAlbum が使えない
// そのため、UIImageWriteToSavedPhotosAlbum を使う
// 参考: https://embt.atlassian.net/servicedesk/customer/portal/1/RSS-3763
TCompletionTarget.FTarget := TCompletionTarget.Create(ACompletionProc);
TCompletionTarget.FImage := BitmapToUIImage(ABitmap);
UIImageWriteToSavedPhotosAlbum(
(TCompletionTarget.FImage as ILocalObject).GetObjectID,
TCompletionTarget.FTarget.GetObjectID,
sel_getUid(METHOD_NAME),
nil);
{$ELSE}
var P := TPath.GetSharedPicturesPath;
// アプリケーション独自のフォルダを作る場合は AFolderName を指定する
if not AFolderName.IsEmpty then
begin
P := TPath.Combine(P, AFolderName);
TDirectory.CreateDirectory(P);
end;
if TDirectory.Exists(P) then
begin
var FileName := AFileName;
if FileName.IsEmpty then
FileName :=
TPath.Combine(
P,
FormatDateTime('yymmdd_hhnnsszzz', Now) + SPNGImageExtension
);
P := TPath.Combine(P, FileName);
var Surf := TBitmapSurface.Create;
// Android 15 以降、 非同期実行で失敗するため先に呼ぶ
Surf.Assign(ABitmap);
TThread.CreateAnonymousThread(
procedure
begin
var Saved := False;
try
var SaveParams: TBitmapCodecSaveParams;
SaveParams.Quality := 100;
Saved := TBitmapCodecManager.SaveToFile(P, Surf, @SaveParams);
finally
Surf.Free;
end;
TThread.Synchronize(
nil,
procedure
begin
if Assigned(ACompletionProc) then
ACompletionProc(Saved, SAVED_MESSAGES[Saved]);
end
);
end
).Start;
end
else
begin
TThread.ForceQueue(
nil,
procedure
begin
if Assigned(ACompletionProc) then
ACompletionProc(False, SAVED_MESSAGES[False]);
end
);
end;
{$ENDIF}
end;
end.
この関数の呼び出し方はこうなります。
procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
SaveBitmapToSharedFolder(
FBitmap, // 保存するビットマップ
'アプリ名', // Shared Pictures 内はアプリ毎にフォルダを分ける
'フォルダ名', // アプリの中で更にフォルダを分けたい場合は指定する
procedure(const ASaved: Boolean; const AResultMessage: String)
begin
if ASaved then
ShowMessage('保存成功')
else
ShowMessage('保存失敗: ' + AResultMessage);
end
);
end;
※「アプリ名」と「フォルダ名」は iOS では無視されます。
最後に
Delphi 大好きだが、これは流石に擁護できない…
MangleType の問題も初期から言われているのに直ってない。
ただ、これについては TTypeKind の tkPointer が型無しポインタしか表せないので実装が困難であることは解るものの、型無しポインタなら型無しポインタとして ^v
を返すようにすべき。ただそれだけで今回の件はもっと簡単に対処できた。
ちなみに、両プラットフォームで画像が保存できない原因を解明し解決するために2週間ぐらい掛かっています。
上記の SaveBitmapToSharedFolder
関数が皆様の工数削減になれば幸いです。