カテゴリー別アーカイブ: firemonkey

スコアマネージャー

コメントをどうぞ 

unit untScore;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Generics.Collections,
  System.IOUtils,
  System.Types,
  FMX.Dialogs,
  System.UITypes;

type
  TScoreRecord = class
  private
    function getIsCorrect: boolean;

  const
    DELIMITER_CHAR = ',';

  public
    DateTime: TDateTime;
    SessionIndex: Integer;
    YomifudaSerial: Integer;
    TorifudaSerial: Integer;
    ResponceTime: Single;

    constructor Create();
    destructor Destroy; override;

    procedure DecodedString(aCodedString: String);
    function EncodeString(): String;

    property IsCorrect: boolean read getIsCorrect;
  end;

type
  TScoreList = class
  private

  public
    Items: TList<TScoreRecord>;

    constructor Create();
    destructor Destroy; override;

    procedure Init();
    procedure Load(aPathFileName: String);
    procedure Save(aPathFileName: String);

    procedure Add(aDateTime: TDateTime;
                  aSessionIndex: Integer;
                  aYomifudaSerial: Integer;
                  aTorifudaSerial: Integer;
                  aResponceTime: Single);


  end;

type
  TScoreManager = class
  const
    INITIAL_PLAYER_NAME = 'ゲスト';

  private
    FScoreRootPathName: String;

  public
    constructor Create(aScoreRootPathName: String);
    destructor Destroy; override;

    procedure PlayerList(vStringList: TStringList);
    procedure AddPlayer(aPlayerName: String);
    procedure DeletePlayer(aPlayerName: String);
    function IsPlayerExists(aPlayerName: String): Boolean;

  end;

var
  ScoreManager: TScoreManager;

const
  ON_SKIP    = -1;
  ON_TIMEOUT = -2;


implementation



// 要 System.IOUtils  System.Types
procedure fileListOfFolder(aFolderName: string; vFileList: TStringList);
var
  SearchPattern: string;
  Option: TSearchOption;
  FileNames: TStringDynArray;
  FileName: string;
begin
  // ファイル名に一致する検索パターン
  SearchPattern := '*.*';

  // ディレクトリの列挙モード
  Option := TSearchOption.soTopDirectoryOnly; // トップレベル列挙モード
  // Option := TSearchOption.soAllDirectories; // 再帰列挙モード

  //指定のディレクトリ内のファイルのリスト
  FileNames := TDirectory.GetFiles(aFolderName, SearchPattern, Option);
  vFileList.Clear;
  for FileName in FileNames do
    vFileList.Add(TPath.GetFileName(FileName));
end;





{ TScoreRecord }

constructor TScoreRecord.Create;
begin

end;

destructor TScoreRecord.Destroy;
begin

  inherited;
end;

procedure TScoreRecord.DecodedString(aCodedString: String);
var
  i: Integer;
  tmpFieldStringList: TStringList;
begin

  tmpFieldStringList := TStringList.Create;
  tmpFieldStringList.Delimiter := DELIMITER_CHAR;
  tmpFieldStringList.DelimitedText := aCodedString;

  Self.DateTime       := StrToDateTime(tmpFieldStringList[0]);
  Self.SessionIndex   := StrToInt     (tmpFieldStringList[1]);
  Self.YomifudaSerial := StrToInt     (tmpFieldStringList[2]);
  Self.TorifudaSerial := StrToInt     (tmpFieldStringList[3]);
  Self.ResponceTime   := StrToFloat   (tmpFieldStringList[4]);

  tmpFieldStringList.Free;
end;

function TScoreRecord.EncodeString: String;
var
  tmpFieldStringList: TStringList;
  tmpResult: string;
begin

  tmpFieldStringList := TStringList.Create;
  tmpFieldStringList.Delimiter := DELIMITER_CHAR;

  tmpFieldStringList.Add(DateTimeToStr(Self.DateTime));
  tmpFieldStringList.Add(IntToStr     (Self.SessionIndex));
  tmpFieldStringList.Add(IntToStr     (Self.YomifudaSerial));
  tmpFieldStringList.Add(IntToStr     (Self.TorifudaSerial));
  tmpFieldStringList.Add(FloatToStr   (Self.ResponceTime));

  tmpResult := tmpFieldStringList.DelimitedText;

  tmpFieldStringList.Free;

  Result := tmpResult;
end;

function TScoreRecord.getIsCorrect: boolean;
begin

end;

{ TScoreList }


constructor TScoreList.Create;
begin
  Items := TList<TScoreRecord>.Create;
  Init();
end;

destructor TScoreList.Destroy;
begin
  Init();
  Items.Free;
  inherited;
end;

procedure TScoreList.Init;
var
  i: Integer;
begin
  for i := 0 to Items.Count - 1 do
    Items[i].Free;
  Items.Clear;
end;

procedure TScoreList.Add(aDateTime: TDateTime;
                         aSessionIndex: Integer;
                         aYomifudaSerial,
                         aTorifudaSerial: Integer;
                         aResponceTime: Single);
var
  tmpScoreRecord: TScoreRecord;
begin
  tmpScoreRecord := TScoreRecord.Create;
  tmpScoreRecord.DateTime       := aDateTime;
  tmpScoreRecord.SessionIndex   := aSessionIndex;
  tmpScoreRecord.YomifudaSerial := aYomifudaSerial;
  tmpScoreRecord.TorifudaSerial := aTorifudaSerial;
  tmpScoreRecord.ResponceTime   := aResponceTime;

  Items.Add(tmpScoreRecord);
end;



procedure TScoreList.Load(aPathFileName: String);
var
  i: Integer;
  tmpRecordStringList: TStringList;
  tmpScoreRecord: TScoreRecord;
begin

  Self.Init();
  if FileExists(aPathFileName) then
  begin
    tmpRecordStringList := TStringList.Create;
    tmpRecordStringList.LoadFromFile(aPathFileName);

    for i := 0 to tmpRecordStringList.Count - 1 do
    begin
      tmpScoreRecord := TScoreRecord.Create();
      tmpScoreRecord.DecodedString(tmpRecordStringList[i]);
      Items.Add(tmpScoreRecord);
    end;
    tmpRecordStringList.Free;
  end;

end;

procedure TScoreList.Save(aPathFileName: String);
var
  i: Integer;
  tmpRecordStringList: TStringList;
begin

  tmpRecordStringList := TStringList.Create;
  tmpRecordStringList.Clear;
  for i := 0 to Self.Items.Count - 1 do
    tmpRecordStringList.Add(Self.Items[i].EncodeString);

  tmpRecordStringList.SaveToFile(aPathFileName);

  tmpRecordStringList.Free;
end;





{ TScoreManager }


constructor TScoreManager.Create(aScoreRootPathName: String);
begin
  FScoreRootPathName := aScoreRootPathName;

  ForceDirectories(aScoreRootPathName);
  if not IsPlayerExists(INITIAL_PLAYER_NAME) then AddPlayer(INITIAL_PLAYER_NAME);

end;

destructor TScoreManager.Destroy;
begin

  inherited;
end;

function TScoreManager.IsPlayerExists(aPlayerName: String): Boolean;
var
  tmpPathFileName: String;
begin
  tmpPathFileName := FScoreRootPathName + aPlayerName + '.txt';
  Result := TFile.Exists(tmpPathFileName);
end;

procedure TScoreManager.AddPlayer(aPlayerName: String);
var
  tmpPathFileName: String;
  tmpStringList: TStringList;
begin
  tmpPathFileName := FScoreRootPathName + aPlayerName + '.txt';
  tmpStringList := TStringList.Create;
  tmpStringList.Clear;
  tmpStringList.SaveToFile(tmpPathFileName);
  tmpStringList.Free;
end;

procedure TScoreManager.DeletePlayer(aPlayerName: String);
var
  tmpPathFileNameOld: String;
  tmpPathFileNameNew: String;
begin
  if aPlayerName = INITIAL_PLAYER_NAME then
  begin
    MessageDlg('このプレイヤーは削除できません。', TMsgDlgType.mtConfirmation,  [TMsgDlgBtn.mbOk], 0);
    Exit;
  end;
  tmpPathFileNameOld := FScoreRootPathName + aPlayerName + '.txt';
  tmpPathFileNameNew := FScoreRootPathName + aPlayerName + '.dum';
  RenameFile(tmpPathFileNameOld, tmpPathFileNameNew)
end;

procedure TScoreManager.PlayerList(vStringList: TStringList);
var
  i: Integer;
  tmpStringList: TStringList;
begin

  tmpStringList:= TStringList.Create;
  fileListOfFolder(FScoreRootPathName, tmpStringList);

  vStringList.Clear;
  for i := 0 to tmpStringList.Count - 1 do
    if ExtractFileExt(tmpStringList[i]) = '.txt' then
      vStringList.add(ChangeFileExt(ExtractFileName(tmpStringList[i]),''));

  tmpStringList.Free;

end;

end.

ファイルシステム関数

コメントをどうぞ
System.SysUtils.AnsiCompareFileName 現在のロケールに基づいてファイル名を比較します。
System.SysUtils.AnsiLowerCaseFileName ファイル名を小文字に変換します。
System.IOUtils.TPath.ChangeExtension 指定されたパスで示されるファイルまたはディレクトリの拡張子を変更します。
System.SysUtils.ChangeFileExt ファイル名の拡張子を変更します。
System.SysUtils.ChangeFilePath ファイル名のパスを変更します。
System.IOUtils.TPath.Combine 2 つのパス文字列を結合します。
System.IOUtils.TPath.DriveExists 指定されたパスで使用されているドライブ文字が実際に存在するかどうかを確かめます。
System.SysUtils.ExcludeTrailingBackslash 末尾の区切り記号を削除したパス名を返します。
System.SysUtils.ExcludeTrailingPathDelimiter 末尾の区切り記号を削除したパス名を返します。
System.SysUtils.ExpandFileName 相対ファイル名の完全パス名を返します。
System.SysUtils.ExpandFileNameCase 大文字と小文字を区別するファイル システム上の相対ファイル名の完全パス名を返します。
System.SysUtils.ExpandUNCFileName 適切な場合、UNC 形式のファイル名の完全パスを返します。
System.SysUtils.ExtractFileDir ファイル名からドライブ部分とディレクトリ部分を抜き出します。
System.SysUtils.ExtractFileDrive ファイル名のドライブ部分を返します。
System.SysUtils.ExtractFileExt ファイル名の拡張子部分を返します。
System.SysUtils.ExtractFileName ファイル名の名前部分と拡張子部分を抽出します。
System.SysUtils.ExtractFilePath ファイル名のドライブ部分とディレクトリ部分を返します。
System.SysUtils.ExtractRelativePath 特定のベース ディレクトリからの相対パス名を返します。
System.SysUtils.ExtractShortPathName ファイル名を短い 8.3 形式に変換します。
System.IOUtils.TPath.GetAttributes ファイルまたはディレクトリ属性を返します。
System.IOUtils.TPath.GetDirectoryName ファイル名のドライブ部分とディレクトリ部分を抽出します。
System.IOUtils.TPath.GetExtendedPrefix 指定されたパスの拡張プレフィックス タイプを返します。
System.IOUtils.TPath.GetExtension ファイル名の拡張子部分を抽出します。
System.IOUtils.TPath.GetFileName ファイル名の名前部分と拡張子部分を抽出します。
System.IOUtils.TPath.GetFileNameWithoutExtension ファイル名の名前部分（拡張子を除く）を抽出します。
System.IOUtils.TPath.GetFullPath 指定されたパスの絶対パスを返します。
System.IOUtils.TPath.GetGUIDFileName 一意なファイル名として使用できる新しい GUID を生成します。
System.IOUtils.TPath.GetHomePath ユーザーのホーム パスを返します。
System.IOUtils.TPath.GetRandomFileName ランダムなファイル名を新たに生成します。
System.IOUtils.TPath.GetTempFileName 一意な一時ファイルを生成します。
System.IOUtils.TPath.GetTempPath システムの一時ディレクトリへのパスを返します。
System.IOUtils.TPath.HasExtension 指定されたファイル名に拡張子部分があるかどうかを確かめます。
System.IOUtils.TPath.HasValidFileNameChars 指定されたファイル名が使用可能な文字だけで構成されているかどうかを確かめます。
System.IOUtils.TPath.HasValidPathChars 指定されたパス文字列が使用可能な文字だけで構成されているかどうかを確かめます。
System.SysUtils.IncludeTrailingBackslash パス名の末尾が必ず区切り記号になるようにします。
System.SysUtils.IncludeTrailingPathDelimiter パス名の末尾が必ず区切り記号になるようにします。
System.IOUtils.TPath.IsDriveRooted 指定されたパスがドライブ文字で始まる絶対パスかどうかを確かめます。
System.IOUtils.TPath.IsExtendedPrefixed 指定されたパスに拡張プレフィックスが含まれているかどうかを確かめます。
System.SysUtils.IsPathDelimiter 文字列内の指定位置にあるバイト データがパス区切り記号かどうかを示します。
System.IOUtils.TPath.IsPathRooted 指定されたパスが相対パスか絶対パスかを確かめます。
System.IOUtils.TPath.IsUNCPath 指定されたパスが UNC（Universal Naming Convention：汎用命名規則）形式かどうかを確かめます。
System.IOUtils.TPath.IsUNCRooted 指定されたパスが UNCルート形式かどうかを確かめます（UNC は、汎用命名規則（Universal Naming Convention）を表す）。
System.IOUtils.TPath.IsValidFileNameChar 指定された文字がファイル名で使用可能かどうかを確かめます。
System.IOUtils.TPath.IsValidPathChar 指定された文字がパス文字列で使用可能かどうかを確かめます。
Vcl.FileCtrl.MinimizeName 指定された長さ制限の中に描画できるように、完全修飾パス名を短縮します。
System.SysUtils.SameFileName 現在のロケールに基づいてファイル名を比較します。
System.IOUtils.TPath.SetAttributes ファイルまたはディレクトリ属性を設定します。
System.IOUtils.TFile.CreateSymLink シンボリック リンクを作成します。「System.SysUtils.TSymLinkRec」を参照。

 

TcomboBox コンボボックス TCombobox コンボボックスのまとめ

コメントをどうぞ

ボックスアイテムのフォントサイズを設定

  for i := 0 to frmConfig.cmbDesignFontName.Count -1 do
  begin
    frmConfig.cmbDesignFontName.ListItems[i].StyledSettings := [];
    frmConfig.cmbDesignFontName.ListItems[i].Font.Size := 11;
  end;

フォントと列挙


procedure TfrmMain.initFontCombo;
var
  tmpFileList: TstringList;
  i: Integer;
  DC:HDC;

  function EnumFamToLines(lplf: PLOGFONT; lpntm: PNEWTEXTMETRIC;
                            FontType: DWORD; Lines: LPARAM): Integer; stdcall;
  begin
    with lplf^ do
//      if    (lfCharSet = SHIFTJIS_CHARSET) and (lfPitchAndFamily and $0F = FIXED_PITCH) then
      // シフトJIS文字セット
      if    (lfCharSet = SHIFTJIS_CHARSET) then
        TStrings(Lines).Add(lplf.lfFaceName);
    Result := 1;
  end;

begin
  tmpFileList := TstringList.Create();
  DC := GetDC(0);
  tmpFileList.Clear;

  frmConfig.cmbDesignFontName.Items.Add(DEFAULT_DesignFontName);

  EnumFontFamilies(DC, nil, @EnumFamToLines, LongInt(tmpFileList));
  for i := 0 to tmpFileList.Count - 1 do
    if pos('@', tmpFileList[i]) = 0 then
      frmConfig.cmbDesignFontName.Items.Add(tmpFileList[i]);
  tmpFileList.Free;

  for i := 0 to frmConfig.cmbDesignFontName.Count -1 do
  begin
    frmConfig.cmbDesignFontName.ListItems[i].StyledSettings := [];
    frmConfig.cmbDesignFontName.ListItems[i].Font.Size := 11;
  end;

end;

OnChange　のタイミング

iOS では clear で OnChange イベントが発生する
iOS では BeginUpdate、EndUpdate が無いとエラーが起こる可能性がある？

  frmMain.cbxValueStep.BeginUpdate;
  frmMain.cbxValueStep.Items.Clear;
  for i := 0 to TValueStep.count - 1 do
  begin
    tmpValueStep.serial := i;
    ListBoxItem      := TListBoxItem.Create(frmMain.cbxValueStep);
    ListBoxItem.Tag  := tmpValueStep.serial;
    ListBoxItem.Text :=tmpWatchPair.pipToPriceStr(tmpValueStep.pip);
    frmMain.cbxValueStep.AddObject(ListBoxItem);
  end;

  frmMain.cbxValueStep.EndUpdate;

動くラベル

コメントをどうぞ 

unit untMoveLabel10;

interface

uses
  System.UIConsts,
  System.UITypes,
  System.Types,
  FMX.StdCtrls,
  FMX.Objects,
  FMX.Filter.Effects,
  FMX.Ani,
  FMX.Controls,
  SysUtils,
  FMX.Types;

type
  TCaptionEffect = class
  private
    FParentImage: TImage;
    FLabel: TLabel;
    FPathAnimation: TPathAnimation;

    FDuration: Single;
    FDelay: Single;

    function getText: String;
    procedure setColor(const Value: TAlphaColor);
    procedure setFontSize(const Value: Integer);
    procedure setText(const Value: String);
    function getScreenHeight: Single;
    function getScreenWidth: Single;
    function getHeight: Single;
    function getWidth: Single;
    procedure setDuration(const Value: Single);
    procedure setDelay(const Value: Single);

    property ScreenWidth:  Single read getScreenWidth;
    property ScreenHeight: Single read getScreenHeight;
    property Width:        Single read getWidth;
    property Height:       Single read getHeight;

  public
    constructor Create(aParenImaget: TImage);
    destructor Destroy; override;

    procedure MoveIn();
    procedure Erase();

    property Text:     String      read  getText     write setText;
    property FontSize: Integer     write setFontSize;
    property Color:    TAlphaColor write setColor;
    property Duration: Single      write setDuration;
    property Delay:    Single      write setDelay;

end;

const
  LABEL_HEIGHT     = 200;
  DEFAULT_FontSize =  24;
  DEFAULT_Color    =   0;
  DEFAULT_DURATION =   1;
  DEFAULT_DELAY    =   0;
  DEFAULT_TEXT     =  '';

implementation

{ TCaptionEffect }

constructor TCaptionEffect.Create(aParenImaget: TImage);
begin
  FParentImage := aParenImaget;

  FLabel := TLabel.Create(FParentImage);
  FLabel.Parent    := TFmxObject(FParentImage);
  FLabel.AutoSize  := False;
  FLabel.Visible   := False;
  FLabel.TextAlign := TTextAlign.taCenter;
  FLabel.Height := LABEL_HEIGHT;
  FLabel.Width  := ScreenWidth;
  FLabel.StyledSettings := [];
  FLabel.ClipChildren := True;

  FPathAnimation        := TPathAnimation.Create(FLabel);
  FPathAnimation.Parent := TFmxObject(FLabel);

  Self.FontSize := DEFAULT_FontSize;
  Self.Color    := DEFAULT_Color;
  Self.Duration := DEFAULT_DURATION;
  Self.Delay    := DEFAULT_DELAY;
  Self.Text     := DEFAULT_TEXT;

end;

destructor TCaptionEffect.Destroy;
begin
  FLabel.Free;
  inherited;
end;

procedure TCaptionEffect.Erase;
begin
  FLabel.Visible := False;
end;

function TCaptionEffect.getHeight: Single;
begin
  Result := FLabel.Height;
end;

function TCaptionEffect.getScreenHeight: Single;
begin
  Result := FParentImage.Height;
end;

function TCaptionEffect.getScreenWidth: Single;
begin
  Result := FParentImage.Width;
end;

function TCaptionEffect.getText: String;
begin
  Result := FLabel.Text;
end;

function TCaptionEffect.getWidth: Single;
begin
  Result := FLabel.Width;
end;

procedure TCaptionEffect.MoveIn;
var
  tmpVCenter: Single;
begin

  FLabel.Font.Size := FLabel.Font.Size;
  Self.Text := Self.Text;

  FLabel.Position.X := (ScreenWidth - Width) / 2;
  FLabel.Position.Y := -1 * Height;

  tmpVCenter := (ScreenHeight - Height) / 2;
  FPathAnimation.Path.Clear;
  FPathAnimation.Path.MoveTo(PointF(0, 0));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height + 40));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height - 40));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height + 20));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height - 20));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height +  5));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height -  5));
  FPathAnimation.Path.LineTo(PointF(0, tmpVCenter + Height));
  FPathAnimation.Loop := False;
  FPathAnimation.Duration := FDuration;
  FPathAnimation.Delay := 0;
  FPathAnimation.Interpolation := TInterpolationType.itQuadratic;

  FLabel.Visible := true;
  FPathAnimation.Start;

end;

procedure TCaptionEffect.setColor(const Value: TAlphaColor);
begin
  FLabel.FontColor := Value;
end;

procedure TCaptionEffect.setDelay(const Value: Single);
begin
  FDelay := Value;
end;

procedure TCaptionEffect.setDuration(const Value: Single);
begin
  FDuration := Value;
end;

procedure TCaptionEffect.setFontSize(const Value: Integer);
begin
  FLabel.Font.Size := Value;
end;

procedure TCaptionEffect.setText(const Value: String);
begin
  FLabel.Text := Value;
end;

end.

メッセージボード

コメントをどうぞ 
unit untMessageBoard;

interface

uses
  System.SysUtils,
  System.Classes,
  System.Types,
  System.UIConsts,

  FMX.Filter.Effects,
  FMX.StdCtrls,
  FMX.Types,
  FMX.Ani,
  FMX.Controls,
  FMX.Objects;


type
  TMessageBoard = class
  private
    FOwnerImage: TImage;
    FBGImage: TImage;
    FTitleLabel: TLabel;
    FContentsText: TText;
    FFloatAnimation: TFloatAnimation;

    procedure setBGBitmap(const Value: TBitmap);
    procedure ReSize();

    property BGBitmap: TBitmap write setBGBitmap;

  public

    constructor Create(AOwner: TImage);
    destructor Destroy; override;
    procedure Hide();
    procedure Show(aBGBitmap: TBitmap; aTitle: String; aContents: String);
    procedure RePosition();

end;




implementation

{ TMessageBoard }

constructor TMessageBoard.Create(AOwner: TImage);
begin
  FOwnerImage := AOwner;


  //
  Self.FBGImage         := TImage.Create(AOwner);
  Self.FBGImage.Parent  := TFmxObject(AOwner);
  Self.FBGImage.HitTest := False;

  //
  Self.FTitleLabel         := TLabel.Create(AOwner);
  Self.FTitleLabel.Parent  := FBGImage;
  Self.FTitleLabel.HitTest := False;

  //
  Self.FContentsText         := TText.Create(AOwner);
  Self.FContentsText.Parent  := FBGImage;
  Self.FContentsText.HitTest := False;

  //
  Self.FFloatAnimation              := TFloatAnimation.Create(AOwner);

end;


destructor TMessageBoard.Destroy;
begin

  Self.FTitleLabel.Free;
  Self.FContentsText.Free;
  Self.FBGImage.Free;
//  Self.FFloatAnimation.Free;

  inherited;
end;

procedure TMessageBoard.Hide;
begin
  Self.FBGImage.Visible := false;
end;

procedure TMessageBoard.RePosition;
begin
  Self.FBGImage.Position.X := (FOwnerImage.Width  - Self.FBGImage.Width) / 2;
  Self.FBGImage.Position.Y := (FOwnerImage.Height - Self.FBGImage.Height) / 2;
end;

procedure TMessageBoard.ReSize;
begin
  Self.FBGImage.Width  := Self.FBGImage.Bitmap.Width;
  Self.FBGImage.Height := Self.FBGImage.Bitmap.Height;

  Self.FBGImage.Padding.Left   := Self.FBGImage.Width  * 0.1;
  Self.FBGImage.Padding.Right  := Self.FBGImage.Width  * 0.1;
  Self.FBGImage.Padding.Top    := Self.FBGImage.Height * 0.1;
  Self.FBGImage.Padding.Bottom := Self.FBGImage.Height * 0.1;

  self.FTitleLabel.StyledSettings := [];
  self.FTitleLabel.Font.Size   := Self.FBGImage.Height * 0.08;
  self.FTitleLabel.FontColor   := claWhite;
  self.FTitleLabel.TextAlign   := TTextAlign.taCenter;
  self.FTitleLabel.Height      := Self.FBGImage.Height * 0.2;
  self.FTitleLabel.Align       := TAlignLayout.alTop;

  self.FContentsText.Align     := TAlignLayout.alClient;
  self.FContentsText.Font.Size := Self.FBGImage.Height * 0.05;

end;

procedure TMessageBoard.setBGBitmap(const Value: TBitmap);
begin
  Self.FBGImage.Bitmap.Assign(Value);
  Self.ReSize();
  Self.RePosition();
end;

procedure TMessageBoard.Show(aBGBitmap: TBitmap; aTitle: String; aContents: String);
begin
  self.BGBitmap           := aBGBitmap;
  Self.FTitleLabel.Text   := aTitle;
  Self.FContentsText.Text := aContents;

  Self.FFloatAnimation.Delay    := 0;
  Self.FFloatAnimation.Duration := 1;
  Self.FFloatAnimation.StartValue := 0;
  Self.FFloatAnimation.StopValue  := 1;

  Self.FFloatAnimation.Parent       := FBGImage;
  Self.FFloatAnimation.PropertyName := 'Opacity';
  Self.FBGImage.Opacity := Self.FFloatAnimation.StartValue;
  Self.FBGImage.Visible          := True;
  Self.FFloatAnimation.Start();

end;
end.

正確なタイマーを無理やり作る

コメントをどうぞ 
Firemonkey TTimer はざっくりしすぎているので、TStopWatch を使って正確な時間を測る。
これでずいぶん正確になった。



unit untTaskIndicater;

interface

uses
  untViewer,
  untWordDic,
  untWaveFilePlayer,
  untClientManager,

  System.Diagnostics,
  MMsystem,
  FMX.Filter.Effects,
  FMX.Objects,
  FMX.Types,
  FMX.Dialogs,
  System.Types,
  System.UITypes,
  SysUtils;

const
  CLOCK_INTERVAL = 5;

type
  TTaskIndicator = class
  private

    FWordRecord: TWordRecord;
    FRoughTimer: TTimer;
    FIndicatingIndex: Integer;

    FIsVoiceOnly: Boolean;
    FStopwatch :TStopwatch;

    procedure OnRoughTimer(Sender: TObject);
  public
    constructor Create();
    destructor Destroy(); override;

    procedure Reset();
    procedure Indicate(aWordRecord: TWordRecord; aIsVoiceOnly: Boolean);

  end;

implementation

uses
  untModel,
  untMainForm;

constructor TTaskIndicator.Create;
begin
  FStopwatch.Create;

  FRoughTimer := TTimer.Create(nil);
  FRoughTimer.OnTimer  := OnRoughTimer;
  FRoughTimer.Enabled  := False;
  FRoughTimer.Interval := CLOCK_INTERVAL;
end;

destructor TTaskIndicator.Destroy;
begin

  FRoughTimer.Free;
  inherited;
end;

procedure TTaskIndicator.Indicate(aWordRecord: TWordRecord; aIsVoiceOnly: Boolean);
var
  i: Integer;
begin
  FIsVoiceOnly := aIsVoiceOnly;
  FWordRecord := aWordRecord;

  Viewer.DispAllPlanes();

  // タイマーが動く前に再生開始が望ましい
  WaveFilePlayer.Play(FWordRecord.VoiceStream);

  FRoughTimer.Enabled  := True;
  FStopwatch.Reset;
  FStopwatch.Start;

  FIndicatingIndex := -1;

end;

procedure TTaskIndicator.OnRoughTimer(Sender: TObject);
var
  tmpTime: Integer;
begin
  // For Pause
  if Model.IsPausing then Exit;

   tmpTime := FStopwatch.ElapsedMilliseconds;

  // 終了条件
  if FWordRecord.IndicateScheduleArray[Length(FWordRecord.IndicateScheduleArray)-1].EndTime <= tmpTime then
  begin
    Viewer.DeAccentPlane(Length(FWordRecord.IndicateScheduleArray)-1);
    if not FIsVoiceOnly then Viewer.DispAllPlanes();
    FRoughTimer.Enabled := False;
    FStopwatch.Stop;
    Model.onIndicaterFinished(); // 終わりを知らせる
  end;

  if not FIsVoiceOnly then
  begin
   if FWordRecord.IndicateScheduleArray[FIndicatingIndex+1].StartTime <= tmpTime then
   begin
     FIndicatingIndex := FIndicatingIndex + 1;

     if FIndicatingIndex <> 0 then Viewer.DeAccentPlane(FIndicatingIndex-1);
     Viewer.AccentPlane(FIndicatingIndex);
   end;
  end;

end;

procedure TTaskIndicator.Reset;
begin
  FRoughTimer.Enabled := False;
end;

end.

24日目+25 firemonkey のエフェクトについて

コメントをどうぞ

エフェクトは一つのコンポーネントに対して一つだけ有効みたい。

TLayout を使って、こちらにエフェクトをかけると対応できる場合もある。

あと、Win32 で有効だった Blur エフェクトをアニメーションしたものは iOSシミュレータ、実機ともにコンポーネント自身が表示されなかった。

7日目　動的配列を使ったリスト

コメントをどうぞ

これまでのインスタンスをTListで管理する方法が iOS ではエラーになる。しっかり型変換を行えば動作するとは思うが、ソースがごちゃごちゃするので、動的配列を使ったリストに変更する。
delete や insert も時間があったら作ろう。
しかし、ファイルの読み込みにすごく時間がかかるようになった気がする。

type
TWordRecord = Record
  private
    FWord: string;
    FJapanese: string;
  public
    procedure Assign(aWordRecord: TWordRecord);
    property Word: string read FWord write FWord;
    property Japanese: string read FJapanese write FJapanese;
end;

type
  TWordList = class
  private
    function getCount: Integer;
  public
    Items: Array of TWordRecord;
    constructor Create();
    destructor Destroy; override;
    procedure Load(aPathFileName: string);
    procedure Assign(aWordList: TWordList);
    procedure AddItem(aWordRecord: TWordRecord);
    procedure Clear();
    property Count: Integer read getCount;
  end;

const
  ESCAPE_COMMA_CHR = 35;   // #
  ESCAPE_SPACE_CHR = 36;   // $
  DEMILITR_CHR = 9;        // TAB

implementation

procedure TWordRecord.Assign(aWordRecord: TWordRecord);
begin
  Self.FWord     := aWordRecord.Word;
  Self.FJapanese := aWordRecord.Japanese;
end;

{ TWordList }

constructor TWordList.Create;
begin
  Self.Clear;
end;

destructor TWordList.Destroy;
begin
  Self.Clear;
  inherited;
end;

procedure TWordList.AddItem(aWordRecord: TWordRecord);
begin
  SetLength(Self.Items, Length(Self.Items) + 1);
  Self.Items[High(Items)].Assign(aWordRecord);
end;

procedure TWordList.Assign(aWordList: TWordList);
var
  i: Integer;
begin
  SetLength(Self.Items, Length(aWordList.Items));
  for i := Low(aWordList.Items) to High(aWordList.Items) do
    Self.Items[i].Assign(aWordList.Items[i]);
end;

function TWordList.getCount: Integer;
begin
  Result := Length(Items);
end;

procedure TWordList.Clear;
begin
  SetLength(Self.Items, 0);
end;

procedure TWordList.Load(aPathFileName: string);
var
  i: Integer;
  tmpWordRecord: TWordRecord;
  tmpRecordList: TStringList;
  tmpFieldList: TStringList;
  tmpString: String;
begin

  self.Clear;

  if FileExists(aPathFileName) then
  begin
    tmpFieldList  := TStringList.Create;
    tmpRecordList := TStringList.Create;

    tmpRecordList.LoadFromFile(aPathFileName);

    for i := 0 to tmpRecordList.Count - 1 do
    begin

      tmpFieldList.Delimiter := chr(DEMILITR_CHR);
      tmpFieldList.StrictDelimiter := False;

      tmpString := tmpRecordList[i];
      tmpFieldList.DelimitedText := tmpString;

      tmpWordRecord.Word := trim(tmpFieldList[0]);
      tmpWordRecord.Japanese := trim(tmpFieldList[1]);
      tmpWordRecord.Japanese := StringReplace(tmpWordRecord.Japanese, chr(ESCAPE_COMMA_CHR), ',', [rfReplaceAll]);
      tmpWordRecord.Japanese := StringReplace(tmpWordRecord.Japanese, chr(ESCAPE_SPACE_CHR), ' ', [rfReplaceAll]);

      self.AddItem(tmpWordRecord);

    end;
    tmpRecordList.Free;
    tmpFieldList.Free;
  end;

end;

5日目　どうも動的配列絡みでエラーが起こっているような気がする

コメントをどうぞ

Win32 で動作しているプログラムが iOSシミュレータでは例外エラーを起こすことを確認。

どうも動的配列が関係しているっぽい。

原因は、もしかしてこれ？

デスクトップ アプリケーションから iOS アプリケーションへの Delphi コードの移行

5日目　画像の配置にはまる

コメントをどうぞ

「配置マネージャーを使って配置したはずの画像ファイル、音声ファイルが iOSシミュレーターから読めない」問題が発生。ほぼ8時間試行錯誤の末、いったんあきらめる。
いわゆる、これ。

playerAlarm.FileName := GetHomePath + PathDelim +
'Documents' + PathDelim +
'alarm.mp3';

配置先は
.￥StartUp￥Documents

なぜ？

解決？

空のアプリケーションからもう一度作成するとあっけないほどうまくいった。ナビゲーション付きフォームから始めたの失敗の原因か？

調べてみると

HeaderFooterNavigation　のソースの uses には

System.StartUpCopy,
が無かった。8時間のロスは大きい。

4日目　CopyFromBitmapのバグ？

コメントをどうぞ

本当はバグかどうか分からいけど、なんだか動作がおかしい。たぶん自分がTbitmapの初期化について何か間違った理解をしているんだと思うけど。

とりあえずの対応策として

http://qc.embarcadero.com/wc/qcmain.aspx?d=111324　より

procedure CopyFromBitmapNew(const Source, Dest: TBitmap; SrcRect: TRect; DstX, DstY: Integer);
var
  I: Integer;
  S, D: TBitmapData;
  DstR: TRect;
  MaxWidth : integer;
  MaxHeight: Integer;
begin
  if Dest.Map(TMapAccess.maWrite, D) then
  begin
    if Source.Map(TMapAccess.maRead, S) then
    begin
      if (DstX = 0) and (DstY = 0) and (SrcRect.Left = 0) and (SrcRect.Top = 0) and (SrcRect.Width = Dest.Width) and
         (SrcRect.Height = Dest.Height) and (D.Pitch = S.Pitch) then
        Move(S.Data^, D.Data^, D.Pitch * Dest.Height)
      else
      begin
        IntersectRect(SrcRect, Rect(0, 0, Source.Width, Source.Height));
        DstR := Rect(DstX, DstY, DstX + SrcRect.Width, DstY + SrcRect.Height);
        IntersectRect(DstR, Rect(0, 0, Dest.Width, Dest.Height));
        if (DstR.Width = SrcRect.Width) and (DstR.Height = SrcRect.Height) then
        begin
          MaxHeight := Min(SrcRect.Bottom - 1, Dest.Height - DstY - 1);
          for I := SrcRect.Top to MaxHeight do
          begin
            MaxWidth := Min(SrcRect.Width, Dest.Width - DstX);
            Move(PAlphaColorArray(S.Data)[SrcRect.Left + (I * (S.Pitch div 4))],
              PAlphaColorArray(D.Data)[DstY*Dest.Width + (I - SrcRect.Top) * (D.Pitch div 4) + DstX], MaxWidth * 4);
          end;
        end;
      end;
      Source.Unmap(S);
    end;
    Dest.Unmap(D);
  end;
end;