カテゴリー別アーカイブ: サンプルコード

7日目 音を出してみた

TMediaPlayer を効果音の数だけ作って音を出す方法
これでもかなりのタイムラグがある。
コンパイルに時間がかかる。
音は出るが、いい方法には思えない。

unit untSoundManager;

interface

uses
  untFileUtil200,
  untFileNameInfo,
  untConfig,
  FMX.Media,
  SysUtils,
  Classes,
  Types;

type
  TSoundType = (stSound, stMusic);

type
  TSoundManager = class
  private
    FMediaPlayer:     Array of TMediaPlayer;
    FNameArray: Array of String;
    FCurMediaIndex: Integer;

    procedure setPathName(const Value: String);
    procedure Stop;
  public

    constructor Create(aPathFileName: String);
    destructor Destroy; override;

    procedure Play(aItemName: String; SoundType: TSoundType);
    procedure Init();

    property PathName: String write setPathName;
end;

const
  UNDEFINED_CURRENT_MEDIA_INDEX = -1;

var
  SoundManager: TSoundManager;

implementation

constructor TSoundManager.Create(aPathFileName: String);
begin
  PathName := aPathFileName;
  FCurMediaIndex := UNDEFINED_CURRENT_MEDIA_INDEX;
end;

destructor TSoundManager.Destroy;
var
  i: Integer;
begin
  Stop();
  Init();

  inherited;
end;

procedure TSoundManager.Init;
var
  i: Integer;
begin
  for i := Low(FMediaPlayer) to High(FMediaPlayer)  do
    FMediaPlayer[i].Free;
end;

procedure TSoundManager.Stop();
begin
  if FCurMediaIndex <> UNDEFINED_CURRENT_MEDIA_INDEX then
    FMediaPlayer[FCurMediaIndex].Stop;
end;

procedure TSoundManager.Play(aItemName: String; SoundType: TSoundType);
var
  i: Integer;
begin

  if (((SoundType = stSound) and Config.IsSoundOn) or
      ((SoundType = stMusic) and Config.IsMusicOn)) then
  begin
    Stop();

    for i := Low(FNameArray) to High(FNameArray) do
      if FNameArray[i] = Trim(aItemName) then
      begin
        FCurMediaIndex := i;
        FMediaPlayer[FCurMediaIndex].CurrentTime := 0;
        FMediaPlayer[FCurMediaIndex].Play;
      end;
  end;
end;

procedure TSoundManager.setPathName(const Value: String);
var
  tmpPathName: String;
  tmpFileList: TStringList;
  i: Integer;
  tmpIndex: Integer;
  tmpPathFileName: String;
begin
  Init();

  tmpPathName := Value;
  tmpFileList := TStringList.Create();

  fileListOfFolder(tmpPathName, tmpFileList);

  SetLength(FMediaPlayer    , 0);
  SetLength(FNameArray, 0);

  for i := 0 to tmpFileList.Count - 1 do
    if ((ExtractFileExt(tmpFileList[i]) = '.wav') or
        (ExtractFileExt(tmpFileList[i]) = '.WAV')) then
    begin
      SetLength(FMediaPlayer,     Length(FMediaPlayer)     + 1);
      SetLength(FNameArray, Length(FNameArray) + 1);

      tmpIndex := High(FMediaPlayer);

      tmpPathFileName  := SoundEffectRootDirectoryName() + tmpFileList[i];
      FMediaPlayer[tmpIndex] := TMediaPlayer.Create(nil);
      FMediaPlayer[tmpIndex].FileName := tmpPathFileName;

      FNameArray[tmpIndex] := ChangeFileExt(ExtractFileName(tmpFileList[i]),'');
    end;

  tmpFileList.Free;
end;
end.

7日目 動的配列を使ったリストに delete insert を実装した


type
TTileRecord = record
  private
    function getX: Integer;
    function getY: Integer;
    function getZ: Integer;
    function getIsRemoved: Boolean;
    function getLetter: String;
    procedure setLetter(const Value: String);

  public

    LetterCode : Integer;
    TileType   : TTileTypeEnum;
    Pos3Dn      : TPos3Dn;
    RemovedStep: Integer;

    procedure Init;
    procedure Assign(aTileRecord: TTileRecord);
    property IsRemoved : Boolean read getIsRemoved;

    property X: Integer read getX;
    property Y: Integer read getY;
    property Z: Integer read getZ;
    Property Letter: String read getLetter write setLetter;

end;

type
  TTileList = class
  private
    function getCount: Integer;
  public
    Items: array of TTileRecord;

    constructor Create();
    destructor Destroy; override;
    procedure Assign(aTileList: TTileList);
    procedure Clear();
    procedure AddItem(aTileRecord: TTileRecord);
    procedure DeleteItem(aIndex: Integer);
    procedure InsertItem(aIndex: Integer; aTileRecord: TTileRecord);
    property Count: Integer read getCount;

  end;

implementation

{ TTileReord }

procedure TTileRecord.Assign(aTileRecord: TTileRecord);
begin
  Self.LetterCode  := aTileRecord.LetterCode;
  Self.TileType    := aTileRecord.TileType;
  Self.Pos3Dn      := aTileRecord.Pos3Dn;
  Self.RemovedStep := aTileRecord.RemovedStep;
end;

procedure TTileRecord.Init;
begin
  Self.LetterCode  := 0;
  Self.TileType    := ttNormal;
  Self.Pos3Dn.X    := 0;
  Self.Pos3Dn.Y    := 0;
  Self.Pos3Dn.Z    := 0;
  Self.RemovedStep := VALUE_OF_UNREMOVED;
end;

function TTileRecord.getIsRemoved: Boolean;
begin
  if Self.RemovedStep = VALUE_OF_UNREMOVED then
    Result := False
  else
    Result := True
end;

function TTileRecord.getLetter: String;
begin
end;

function TTileRecord.getX: Integer;
begin
  Result := Pos3Dn.X;
end;

function TTileRecord.getY: Integer;
begin
  Result := Pos3Dn.Y;
end;

function TTileRecord.getZ: Integer;
begin
  Result := Pos3Dn.Z;
end;

procedure TTileRecord.setLetter(const Value: String);
begin
end;

{ TTileList }
function TTileList.AddTile(aPos3D: TPos3D; aKindSerial: Integer): Integer;
var
  tmpTileRecord: TTileRecord;
begin
  tmpTileRecord := TTileRecord.Create;
  tmpTileRecord.Pos3D      := aPos3D;
  tmpTileRecord.KindSerial := aKindSerial;
  Self.Add(tmpTileRecord);

  Grid3D[aPos3D.X, aPos3D.Y, aPos3D.Z] := Self.Count - 1;
  Result := Self.Count - 1;
end;

procedure TTileList.AddItem(aTileRecord: TTileRecord);
begin
  SetLength(Self.Items, Length(Self.Items) + 1);
  Self.Items[High(Items)].Assign(aTileRecord);
end;

procedure TTileList.Assign(aTileList: TTileList);
var
  i: Integer;
  tmpTileRecord: TTileRecord;
begin
  Self.Clear();
  SetLength(Self.Items, Length(aTileList.Items));
  for i := Low(aTileList.Items) to High(aTileList.Items) do
  begin
    Self.Items[i].Assign(aTileList.Items[i]);
  end;
end;

constructor TTileList.Create;
begin
  Self.Clear();
end;

procedure TTileList.DeleteItem(aIndex: Integer);
var
  i: Integer;
begin
  if aIndex > High(Self.Items) then Exit;

  for i:= aIndex to High(Self.Items) - 1 do
    Self.Items[i].Assign(Self.Items[i+1]);
  SetLength(Self.Items, Length(Self.Items) - 1);
end;

procedure TTileList.InsertItem(aIndex: Integer; aTileRecord: TTileRecord);
var
i: Integer;
begin
if aIndex > High(Self.Items) then Exit;

SetLength(Self.Items, Length(Self.Items) + 1);
for i:= High(Self.Items) downto aIndex + 1 do
Self.Items[i].Assign(Self.Items[i-1]);

Self.Items[aIndex].Assign(aTileRecord);
end;


destructor TTileList.Destroy;
begin
  Self.Clear();
  inherited;
end;

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

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

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;