Delphi iOSアプリケーションでネイティブコントロールの上に画像を表示する

FireMonkeyのコントロールはネイティブコントロールの上に表示することができません。

Delphi iOSアプリケーションでネイティブコントロールの上に画像を表示するために
ネイティブコントロールのUIImageViewをラップしたクラスを作成しました。

UIImageViewもネイティブコントロールのため、ネイティブコントロールの上に画像を表示できます。

使用例

FUIImageView := FMX.iOS.UIImageView.TUIImageView.Create(Layout1);
FUIImageView.ImageWrapMode := TImageWrapMode.Fit;
FUIImageView.SetBitmap(Bitmap);

ソースコード

unit FMX.iOS.UIImageView;

interface

uses
  iOSapi.UIKit, iOSapi.CoreGraphics,
  System.Classes, System.Types, FMX.Graphics,
  FMX.Layouts, FMX.Forms, FMX.Objects;

type
  TUIImageView = class
  private
    FUIImageView: iOSapi.UIKit.UIImageView;
    FLayout: TLayout;
    FImageWrapMode: TImageWrapMode;
    procedure SetImageWrapMode(const Value: TImageWrapMode);
    function GetForm: TCustomForm;
    function GetLayoutRect: TRect;
    function getFrame: CGRect;
  public
    constructor Create(const ALayout: TLayout);
    destructor Destroy; override;
    procedure SetBitmap(const ABitmap: TBitmap);
    procedure Resize;
    property ImageWrapMode: TImageWrapMode read FImageWrapMode
      write SetImageWrapMode;
    property frame: CGRect read getFrame;
    property ImageView: iOSapi.UIKit.UIImageView read FUIImageView;

  end;

implementation

uses

  Macapi.Helpers, FMX.Helpers.iOS, iOSapi.Foundation, FMX.Platform.iOS,

  System.SysUtils, FMX.Types;

{ TUIImageView }

constructor TUIImageView.Create(const ALayout: TLayout);
var
  AForm: TCustomForm;
begin
  FLayout := ALayout;

  FUIImageView := iOSapi.UIKit.TUIImageView.Wrap
    (iOSapi.UIKit.TUIImageView.Alloc.init);
  FUIImageView.retain;
  Resize;

  AForm := GetForm;
  if AForm <> nil then
    WindowHandleToPlatform(AForm.Handle).View.addSubview(FUIImageView);

  Self.ImageWrapMode := TImageWrapMode.Stretch;
end;

destructor TUIImageView.Destroy;
begin
  if FUIImageView <> nil then
  begin
    FUIImageView.removeFromSuperview;
    FUIImageView.release;
    FUIImageView := nil;
  end;

  inherited;
end;

function TUIImageView.GetForm: TCustomForm;
var
  Parent: TFmxObject;
begin
  Parent := FLayout.Parent;

  while True do
  begin
    if Parent = nil then
      Exit(nil);
    if Parent is TForm then
      Exit(Parent as TForm);
    Parent := Parent.Parent;
  end;
end;

function TUIImageView.getFrame: CGRect;
begin
  Result := FUIImageView.frame;
end;

function TUIImageView.GetLayoutRect: TRect;
var
  ATopLeft, ABottomRight: TPoint;
begin
  if FLayout = nil then
  begin
    Log.d('Layout = nil');
    Exit(Rect(0, 0, 0, 0));
  end;

  ATopLeft := FLayout.LocalToAbsolute(PointF(0, 0)).Truncate;
  ABottomRight := ATopLeft.Add(PointF(FLayout.width, FLayout.height).Truncate);
  Result := System.Classes.Rect(ATopLeft, ABottomRight);
end;

procedure TUIImageView.Resize;
begin
  FUIImageView.setFrame(Macapi.Helpers.RectToNSRect(GetLayoutRect));
end;

procedure TUIImageView.SetBitmap(const ABitmap: TBitmap);
var
  Image: UIImage;
  AutoreleasePool: NSAutoreleasePool;
begin
  AutoreleasePool := TNSAutoreleasePool.Create;
  try
    Image := FMX.Helpers.iOS.BitmapToUIImage(ABitmap);
    FUIImageView.setImage(Image);
  finally
    AutoreleasePool.release
  end;
end;

procedure TUIImageView.SetImageWrapMode(const Value: TImageWrapMode);
begin
  FImageWrapMode := Value;

  case Value of
    TImageWrapMode.Fit: // コントロールの四角形にちょうど合うように調整します(画像の比率は保たれます)。
      FUIImageView.setContentMode(UIViewContentModeScaleAspectFit);
    TImageWrapMode.Stretch: // 画像を引き伸ばして、コントロールの四角形全体を埋めます。
      FUIImageView.setContentMode(UIViewContentModeScaleToFill);
    TImageWrapMode.Original: // 画像を元のサイズで表示します。
      FUIImageView.setContentMode(UIViewContentModeTopLeft);
    TImageWrapMode.Center: // 画像をコントロールの四角形の中央に表示します。
      FUIImageView.setContentMode(UIViewContentModeCenter);
    TImageWrapMode.Tile: // 画像を敷き詰めて(画像の数を増やして)、コントロールの四角形全体を覆います。
      raise System.SysUtils.ENotImplemented.Create('TImageWrapMode.Tile');
  end;
end;

end.

サンプルプログラム

TWebBrowserコントロールはネイティブコントロールのため、その上にコンポーネントを配置できません。

このサンプルプログラムでは、TWebBrowserコントロールの上にTUIImageViewを配置して、画像を表示します。

実行例は次のようになります。

Simulator Screen Shot 2016.06.20 0.30.50

フォームにTWebBrowserコントロールとTLayoutコントロールを配置します。
TLayoutコントロールはTUIImageViewの配置場所になります。

TUIImageView01

TUIImageView02

メニューの「プロジェクト」→「リソースと画像」を選択し、表示する画像を追加します。

TUIImageView03

今回使用した画像は次の画像です。

sample

画像を読み込む関数を作成します。

function GetImage: TBitmap;
var
  RS: TResourceStream;
begin
  Result := TBitmap.Create;
  RS := TResourceStream.Create(HInstance, 'PngImage_1', RT_RCDATA);
  try
    Result.LoadFromStream(RS);
  finally
    RS.Free;
  end;
end;

フォームにprivate変数にTUIImageViewを追加します。

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Layout1: TLayout;
    procedure FormCreate(Sender: TObject);
  private
    { private 宣言 }
    FUIImageView: TUIImageView;
  public
    { public 宣言 }
  end;

フォームのOnCreateイベントで、TWebBrowserコントロールにURLを指定してアクセスします。

procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.Navigate('http://www.gesource.jp/weblog/');
end;

フォームのOnCreateイベントにTUIImageViewを作成する処理を追加します。

uses
  FMX.Objects;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  WebBrowser1.Navigate('http://www.gesource.jp/weblog/');

  FUIImageView := FMX.iOS.UIImageView.TUIImageView.Create(Layout1);
  FUIImageView.ImageWrapMode := TImageWrapMode.Fit;

  Bitmap := GetImage;
  try
    FUIImageView.SetBitmap(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

アプリケーションを実行すると、ブラウザの上に画像が表示されます。

Simulator Screen Shot 2016.06.20 0.30.50

DelphiでiOSの端末の情報を取得する

実行中の端末がiPhoneとiPadのどちらであるかを取得する

FMX.Helpers.iOSユニットにあるIsPhone関数とIsPadを使用します。

uses
  FMX.Helpers.iOS;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IsPhone then
    ShowMessage('iPhoneです');
  if IsPad then
    ShowMessage('iPadです');
end;

Simulator Screen Shot 2016.06.18 23.13.25

Simulator Screen Shot 2016.06.18 23.17.50

モデル(機種名)や名前、バージョンを取得する

TUIDeviceで端末の情報を取得できます。

uses
  iOSapi.UIKit;

procedure TForm1.Button1Click(Sender: TObject);
var
  Model, Name, LocalizedModel, SystemName, SystemVersion: string;
begin
  // デバイスのモデル
  Model := UTF8ToString(TUIDevice.Wrap(TUIDevice.OCClass.currentDevice).model.UTF8String);
  Memo1.Lines.Add('Model=' + Model);

  // デバイスの名前
  Name := UTF8ToString(TUIDevice.Wrap(TUIDevice.OCClass.currentDevice).name.UTF8String);
  Memo1.Lines.Add('Name=' + Name);

  // デバイスのローカルバージョン
  LocalizedModel := UTF8ToString(TUIDevice.Wrap(TUIDevice.OCClass.currentDevice).localizedModel.UTF8String);
  Memo1.Lines.Add('LocalizedModel=' + LocalizedModel);

  // OS名
  SystemName := UTF8ToString(TUIDevice.Wrap(TUIDevice.OCClass.currentDevice).systemName.UTF8String);
  Memo1.Lines.Add('SystemName=' + SystemName);

  // OS名
  SystemVersion := UTF8ToString(TUIDevice.Wrap(TUIDevice.OCClass.currentDevice).systemVersion.UTF8String);
  Memo1.Lines.Add('SystemVersion=' + SystemVersion);
end;

取得出来るモデルは次のようになります。

  • iPhone
  • iPod touch
  • iPad
  • iPhone Simulator

Simulator Screen Shot 2016.06.19 11.30.05

Delphi 10 SeattleのFireMonkeyアプリケーションでバージョン番号を取得するには

FireMonkeyアプリケーションでバージョン番号を取得する方法を紹介します。

使用したバージョンはDelphi 10 Seattleです。

バージョン番号を取得には、FMX.Platform.IFMXApplicationServiceAppVersionプロパティを使用します。

  if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService) then
  begin
    ApplicationService := IFMXApplicationService(TPlatformServices.Current.GetPlatformService(IFMXApplicationService));
    Result := ApplicationService.AppVersion; //バージョン番号
  end;

サンプルアプリケーションを作成します。

フォームにボタンを配置し、ボタンのOnClickイベントを追加します。

01

ボタンを押すと、バージョン番号を表示します。

uses FMX.Platform;

/// <summary>
/// アプリケーションのバージョン番号を取得する
/// </summary>
function GetAppVersion: string;
var
  ApplicationService: IFMXApplicationService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService)
  then
  begin
    ApplicationService := IFMXApplicationService
      (TPlatformServices.Current.GetPlatformService(IFMXApplicationService));
    Result := ApplicationService.AppVersion;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetAppVersion);
end;

バージョンは、プロジェクトオプションの「バージョン情報」で設定できます。

02

アプリケーションを実行し、ボタンを押します。

2016-04-19-22-42-51

バージョン番号が表示されました。

2016-04-19-22-43-02

FireMonkeyアプリケーションでユーザー定義のWindowsメッセージを受信するには?

FireMonkeyアプリケーションでユーザー定義のWindowsメッセージを受信するには?

ドキュメントを読むと、IFMXApplicationServiceHandleMessageメソッドを使用するみたいです。

下位クラスでは、HandleMessage はアプリケーションのメッセージを処理するための機能を実装します。

FMX.Platform.IFMXApplicationService.HandleMessage – RAD Studio API Documentation」より

サンプルアプリケーションを作りながら動作を確認します。

ボタンを押すとメッセージを送信して、メッセージを受信したらMemo1に表示するアプリを作ります。

フォームにTButtonとTMemoを配置します。

winmsg-1

ボタンを押すと、メッセージを送信します。

const
  WM_HOGEHOGE = WM_USER + 100;

procedure TForm1.Button1Click(Sender: TObject);
var
  WindowHandle: TWinWindowHandle;
begin
  WindowHandle := WindowHandleToPlatform(Form1.Handle);
  Winapi.Windows.PostMessage(WindowHandle.Wnd, WM_HOGEHOGE, WPARAM(0),
    LPARAM(0));
end;

IFMXApplicationServiceインターフェースを継承したクラスを作成します。

type
  TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
  public
    procedure Run;
    function HandleMessage: Boolean;
    procedure WaitMessage;
    function GetDefaultTitle: string;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    function GetVersionString: string;
    procedure Terminate;
    function Terminating: Boolean;
    property DefaultTitle: string read GetDefaultTitle;
    property Title: string read GetTitle write SetTitle;
    property AppVersion: string read GetVersionString;
  end;

変数を追加します。

type
  TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
  private
    class var OldFMXApplicationService: IFMXApplicationService;
    class var NewFMXApplicationService: IFMXApplicationService;

OldFMXApplicationServiceはIFMXApplicationServiceを継承した標準で使用されているオブジェクト、
NewFMXApplicationServiceは新しく作成するオブジェクトです。

TFMXApplicationServiceクラスを登録する処理を追加します。

type
  TFMXApplicationService = class(TInterfacedObject, IFMXApplicationService)
  private
    class procedure AddPlatformService;

class procedure TFMXApplicationService.AddPlatformService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService,
    IInterface(OldFMXApplicationService)) then
  begin
    TPlatformServices.Current.RemovePlatformService(IFMXApplicationService);
    NewFMXApplicationService := TFMXApplicationService.Create;
    TPlatformServices.Current.AddPlatformService(IFMXApplicationService,
      NewFMXApplicationService);
  end;
end;

既存のIFMXApplicationServiceオブジェクトをOldFMXApplicationServiceに代入し、作成したTFMXApplicationServiceオブジェクトを登録します。

起動時に、TFMXApplicationService.AddPlatformServiceメソッドを呼び、TFMXApplicationServiceオブジェクトを登録します。

initialization

TFMXApplicationService.AddPlatformService;

TFMXApplicationServiceクラスは、HandleMessageメソッド以外の処理はOldFMXApplicationServiceオブジェクトに委譲します。

function TFMXApplicationService.GetDefaultTitle: string;
begin
  Result := OldFMXApplicationService.GetDefaultTitle;
end;

function TFMXApplicationService.GetTitle: string;
begin
  Result := OldFMXApplicationService.GetTitle;
end;

function TFMXApplicationService.GetVersionString: string;
begin
  Result := OldFMXApplicationService.GetVersionString;
end;

procedure TFMXApplicationService.Run;
begin
  OldFMXApplicationService.Run;
end;

procedure TFMXApplicationService.SetTitle(const Value: string);
begin
  OldFMXApplicationService.SetTitle(Value);
end;

procedure TFMXApplicationService.Terminate;
begin
  OldFMXApplicationService.Terminate;
end;

function TFMXApplicationService.Terminating: Boolean;
begin
  Result := OldFMXApplicationService.Terminating;
end;

procedure TFMXApplicationService.WaitMessage;
begin
  OldFMXApplicationService.WaitMessage;
end;

TFMXApplicationServiceクラスのHandleMessageメソッドでは、受信したメッセージがWM_HOGEHOGEのときはTForm1のMemo1に’WM_HOGEHOGE’を追加し、その他の時は標準の処理を行います。

function TFMXApplicationService.HandleMessage: Boolean;
var
  Msg: TMsg;
begin
  Result := False;
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
    Result := True;
    if Msg.Message = WM_HOGEHOGE then
    begin
      (Application.MainForm as TForm1).Memo1.Lines.Add('WM_HOGEHOGE');
    end
    else if Msg.Message <> WM_QUIT then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end
    else
      Application.Terminated := True;
  end;
end;

実行してみると、正しく動作しているようです。

winmsg-2