5
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

[Delphi] iOS / Android で画像を Shared Pictures に保存する(Delphi 12.x)

Posted at

Delphi 12 で画像保存の問題点

Windows と macOS では得に問題がないものの、モバイルOS では画像保存に大きなバグがあります。

なんなら画像保存なんてできないぐらいの大きなバグです。
影響範囲は全ての画像保存です。
TBitmap.SaveToFile や、その実体である TBitmapCodecManager.SaveToFileIFMXPhotoLibrary.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 を使っているため、保存に失敗します。

image.png

Quality Portal 報告済み

解決方法

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 関数が皆様の工数削減になれば幸いです。

5
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
5
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?