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

動くラベル

コメントをどうぞ 

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.

アニメーション サンプル

コメントをどうぞ 

unit untImageEffect;

interface

uses
  untImageManager,

  System.Classes,
  System.Types,
  System.UIConsts,
  FMX.Filter.Effects,
  FMX.Types,
  FMX.Controls,
  FMX.Objects;

type
  TCueMark = class(TObject)
private
  FParent: TImage;
  FCueImage: TImage;
  FPathAnimation: TPathAnimation;
  FRoughTimer: TTimer;
  FMSec: Integer;

  procedure OnRoughTimer(Sender: TObject);

  function getScreenHeight: Single;
  function getScreenWidth: Single;
  function getOrginHeight: Single;
  function getOrginWidth: Single;
  procedure OnPathAnimation1Finish(Sender: TObject);

  property ScreenWidth:  Single read getScreenWidth;
  property ScreenHeight: Single read getScreenHeight;
  property OrginWidth:   Single read getOrginWidth;
  property OrginHeight:  Single read getOrginHeight;

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

  procedure Start(aMSec: Integer);

end;

type
  TFloatingStars = class(TObject)
private
  FParent: TImage;
  FStarImage: Array of TImage;
  FPathAnimation: Array of TPathAnimation;
  FFillRGBEffect: Array of TFillRGBEffect;
//  FMSec: Integer;

  procedure setCount(const Value: Integer);

  procedure FreeAllImageAndPathAnimation();
    function getCount: Integer;
    function getScreenHeight: Single;
    function getScreenWidth: Single;
    function getOrginHeight: Single;
    function getOrginWidth: Single;
public
  constructor Create(aParent: TImage);
  destructor Destroy; override;

  procedure Start(aMSec: Integer);

  property ScreenWidth:  Single read getScreenWidth;
  property ScreenHeight: Single read getScreenHeight;
  property OrginWidth:   Single read getOrginWidth;
  property OrginHeight:  Single read getOrginHeight;

  property Count: Integer       read getCount        write setCount;

end;

var
  FloatingStars: TFloatingStars;
  CueMark: TCueMark;

implementation

uses
  untMainForm;

{ TFloatingStars }

constructor TFloatingStars.Create(aParent: TImage);
begin
//  inherited;
  FParent := aParent;
  Count  := 10;
end;

destructor TFloatingStars.Destroy;
begin
  FreeAllImageAndPathAnimation();
  inherited;
end;

procedure TFloatingStars.FreeAllImageAndPathAnimation;
var
  i: Integer;
begin
  //
  for i := 0 to Length(FStarImage) - 1 do
    FStarImage[i].Free;
  SetLength(FStarImage, 0);

  //
  for i := 0 to Length(FPathAnimation) - 1 do
//    if FPathAnimation[i] <> nil then FPathAnimation[i].Free;
  SetLength(FPathAnimation, 0);

  for i := 0 to Length(FFillRGBEffect) - 1 do
//    if FPathAnimation[i] <> nil then FPathAnimation[i].Free;
  SetLength(FFillRGBEffect, 0);

end;

function TFloatingStars.getCount: Integer;
begin
  Result := Length(FStarImage);
end;

function TFloatingStars.getOrginHeight: Single;
begin
  Result := FStarImage[0].Bitmap.Height;
end;

function TFloatingStars.getOrginWidth: Single;
begin
  Result := FStarImage[0].Bitmap.Width;
end;

function TFloatingStars.getScreenHeight: Single;
begin
  Result := FParent.Height;
end;

function TFloatingStars.getScreenWidth: Single;
begin
  Result := FParent.Width;
end;

procedure TFloatingStars.setCount(const Value: Integer);
var
  i: Integer;
begin

  FreeAllImageAndPathAnimation();

  SetLength(FStarImage,     Value);
  SetLength(FPathAnimation, Value);
  SetLength(FFillRGBEffect, Value);

  for i := 0 to Value - 1 do
  begin
    FStarImage[i] := TImage.Create(FParent);
    FStarImage[i].Parent := TFmxObject(FParent);
    FStarImage[i].Width  := 45;
    FStarImage[i].Height := 45;
//    FStarImage[i].Bitmap.SetSize(45,45);

    FStarImage[i].Bitmap.Assign(ImageManager.Item('star.png'));
    FStarImage[i].Position.X :=-100;
    FStarImage[i].Position.Y :=-100;
    FStarImage[i].Enabled := True;
    FStarImage[i].WrapMode := TImageWrapMode.iwFit;

    FStarImage[i].Visible := False;

    //
    FPathAnimation[i] := TPathAnimation.Create(FStarImage[i]);
    FPathAnimation[i].Parent := FStarImage[i];

    //
    FFillRGBEffect[i] := TFillRGBEffect.Create(FStarImage[i]);
    FFillRGBEffect[i].Parent := FStarImage[i];

    //    FPathAnimation[i].Parent := TFmxObject(FStarImage[i]);

  end;

end;

procedure TFloatingStars.Start(aMSec: Integer);
var
  i: Integer;
  tmpSize: Single;
  tmpDiff: Single;
  tmpDelay: Single;
  tmpDuration: Single;
  tmpStartPos: TPointF;
  tmpEndPos: TPointF;
begin

  for i := 0 to Count - 1 do
  begin

    tmpSize     := OrginWidth  * (Random + 0.5);
    tmpDiff     := Random * ScreenWidth * 0.5 + ScreenWidth/2;
    tmpDelay    := Random * (aMSec/1000) * 0.4;
    tmpDuration := Random * (aMSec/1000) * 0.6;

    tmpStartPos := PointF(tmpDiff,          -1 * tmpSize);
    tmpEndPos   := PointF( - ScreenWidth/2, ScreenHeight + tmpSize + 10);

    FStarImage[i].Width      := tmpSize;
    FStarImage[i].Height     := tmpSize;
    FStarImage[i].Position.X := tmpStartPos.X - FParent.Position.X;
    FStarImage[i].Position.Y := tmpStartPos.Y - FParent.Position.Y;

    FPathAnimation[i].Path.Clear;
    FPathAnimation[i].Path.MoveTo(PointF(0, 0));
    FPathAnimation[i].Path.LineTo(tmpEndPos);
//    FPathAnimation[i].Path.ClosePath;

    FPathAnimation[i].Loop := False;
    FPathAnimation[i].Duration := tmpDuration;
    FPathAnimation[i].Delay := tmpDelay;
    FPathAnimation[i].Interpolation := TInterpolationType.itQuadratic;

    case random(5) of
      0: FFillRGBEffect[i].Color := clapink;
      1: FFillRGBEffect[i].Color := claYellow;
      2: FFillRGBEffect[i].Color := claCyan;
      3: FFillRGBEffect[i].Color := claGreen;
      4: FFillRGBEffect[i].Color := claBlue;
    end;

    FStarImage[i].Visible := true;
    FPathAnimation[i].Start;

  end;

end;

{ TCueMark }

constructor TCueMark.Create(aParent: TImage);
begin

  FParent := aParent;

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

  FCueImage := TImage.Create(FParent);
  FCueImage.Parent := TFmxObject(FParent);

  FCueImage.Bitmap.Assign(ImageManager.Item('cuemark.png'));
  FCueImage.Width      := FCueImage.Bitmap.Width;
  FCueImage.Height     := FCueImage.Bitmap.Height;
  FCueImage.Position.X := -100;
  FCueImage.Position.Y := -100;
  FCueImage.WrapMode := TImageWrapMode.iwFit;

  FCueImage.Visible := False;

  //
  FPathAnimation := TPathAnimation.Create(FCueImage);
  FPathAnimation.Parent := FCueImage;
  FPathAnimation.OnFinish  := OnPathAnimation1Finish;

end;

destructor TCueMark.Destroy;
begin
  FCueImage.Free;
//  FPathAnimation.Free;
  inherited;
end;

procedure TCueMark.OnPathAnimation1Finish(Sender: TObject);
begin
  FRoughTimer.Enabled := True;
end;

procedure TCueMark.OnRoughTimer(Sender: TObject);
begin
  FRoughTimer.Interval := FMsec div 2;
  FCueImage.Visible := False;
  FRoughTimer.Enabled := false;
end;

function TCueMark.getOrginHeight: Single;
begin
  Result := FCueImage.Bitmap.Height;
end;

function TCueMark.getOrginWidth: Single;
begin
  Result := FCueImage.Bitmap.Width;
end;

function TCueMark.getScreenHeight: Single;
begin
  Result := FParent.Height;
end;

function TCueMark.getScreenWidth: Single;
begin
  Result := FParent.Width;
end;

procedure TCueMark.Start(aMSec: Integer);
begin
    FMSec   := aMSec;

    FCueImage.Width      := OrginWidth;
    FCueImage.Height     := OrginHeight;

    FCueImage.Position.X := (ScreenWidth - OrginWidth) / 2;
    FCueImage.Position.Y := -1 * OrginHeight;

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

    FCueImage.Visible := true;
    FPathAnimation.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日目 +5　バイナリファイルの読み書き

コメントをどうぞ 
　これがないと実機ではエラーがでる

FileMode := fmOpenRead ;


procedure THistoricalList.saveBinary(aFileName: String);

var
  i: integer;

  F: file of TOHLCRecord;
  tmpOHLCRecord: TOHLCRecord;
begin

  AssignFile(F, aFileName);
  ReWrite(F);

  // ファイルのヘッダー情報を open に書き込む
  tmpOHLCRecord.high  := 0;
  tmpOHLCRecord.low   := 0;
  tmpOHLCRecord.close := 0;
  // 0  THIS_PROGRAM_VERSION
  tmpOHLCRecord.open := THIS_PROGRAM_VERSION;
  Write(F, tmpOHLCRecord);
  // 1  Pair
  tmpOHLCRecord.open := Self.Pair.serial;
  Write(F, tmpOHLCRecord);
  // 2  timeStep
  tmpOHLCRecord.open := timeStep.serial;
  Write(F, tmpOHLCRecord);
  // 3  IsConsecutiveData
  tmpOHLCRecord.open := StrToInt(BoolToStr(Self.IsConsecutiveData));
  Write(F, tmpOHLCRecord);
  // 4  Count
  tmpOHLCRecord.open := Self.Count;
  Write(F, tmpOHLCRecord);

  for i := 5 to BINARYHEADER_COUNT - 1 do
  begin
    tmpOHLCRecord.open := -1;
    Write(F, tmpOHLCRecord);
  end;

  for i := 0 to self.Count - 1 do
  begin
    tmpOHLCRecord.IDateTimeValue := self.Items[i].IDateTime.Value;
    tmpOHLCRecord.open  := self.Items[i].PipOpen;
    tmpOHLCRecord.high  := self.Items[i].PipHigh;
    tmpOHLCRecord.low   := self.Items[i].PipLow;
    tmpOHLCRecord.close := self.Items[i].PipClose;
    Write(F, tmpOHLCRecord);
  end;

  CloseFile(F);
end;

procedure THistoricalList.loadBinary(aFileName: String);
var
  i: integer;

  F: file of TOHLCRecord;
  tmpOHLCRecord: TOHLCRecord;
  counter: Integer;
  tmpRecord: THistoricalRecord;

  tmpStartDateTimeValue: Integer;
  tmpEndDateTimeValue: Integer;
  tmpIsConsecutiveData: Boolean;
  tmpCounter: Integer;
begin

  AssignFile(F, aFileName);
  FileMode := fmOpenRead ;  //   
  Reset(F);

//  if tmpFlag then ShowMessage('Exists') else ShowMessage('NOT Exists');

  // 0  THIS_PROGRAM_VERSION
  Read(F, tmpOHLCRecord);
  // 1  Pair
  Read(F, tmpOHLCRecord);
  Self.pair.serial := tmpOHLCRecord.open;
  // 2  timeStep
  Read(F, tmpOHLCRecord);
  Self.TimeStep.serial := tmpOHLCRecord.open;
  // 3  IsConsecutiveData
  Read(F, tmpOHLCRecord);
  tmpIsConsecutiveData   := StrToBool(IntToStr(tmpOHLCRecord.open));
  // 4  Count
  Read(F, tmpOHLCRecord);
  tmpCounter := tmpOHLCRecord.open;

  // 空読み
  for i := 5 to BINARYHEADER_COUNT - 1 do
    Read(F, tmpOHLCRecord);

  SetLength(Self.Items, tmpCounter);

  for i := 0 to tmpCounter - 1 do
  begin
    Read(F, tmpOHLCRecord);
    tmpRecord.IDateTime.Value := tmpOHLCRecord.IDateTimeValue;
    tmpRecord.PipOpen  := tmpOHLCRecord.open;
    tmpRecord.PipHigh  := tmpOHLCRecord.high;
    tmpRecord.PipLow   := tmpOHLCRecord.low;
    tmpRecord.PipClose := tmpOHLCRecord.close;

    Self.Items[i].Assign(tmpRecord);
  end;

  CloseFile(F);

end;

21日目 TImage Canvas への描画の基本

コメントをどうぞ 

  frmMain.imgLong.Bitmap.SetSize(Floor(frmMain.imgLong.Width),
                                 Floor(frmMain.imgLong.Height));


  with frmMain.imgLong.Bitmap.Canvas do
  begin
    BeginScene;

    Stroke.Kind := TBrushKind.bkSolid;
    Stroke.Color :=  claBlue;
    StrokeThickness := 4;

    Fill.Kind  := TBrushKind.bkSolid;
    Fill.Color := claAqua;

    FillRect(RectF(0 + 4,
                   0 + 4,
                   ScreenInfo.ButtonLongRect.Width - 4,
                   ScreenInfo.ButtonLongRect.Height - 4),
                   10,
                   10,
                   AllCorners,
                   1.0);

    DrawRect(RectF(0 + 4,
                   0 + 4,
                   ScreenInfo.ButtonLongRect.Width - 4,
                   ScreenInfo.ButtonLongRect.Height - 4),
                   10,
                   10,
                   AllCorners,
                   1.0);

    Fill.Color := claBlack;
    FillText(RectF(0 + 4,
                   0 + 4,
                   ScreenInfo.ButtonShortRect.Width - 4,
                   ScreenInfo.ButtonShortRect.Height - 4),
                   'SHORT',
                   False,
                   1.0,
                   [],
                   TTextAlign.taCenter);

    EndScene;
  end;

17日目 サウンドマネージャー

コメントをどうぞ 

unit untSoundManager10;

interface

uses
untFileNameInfo,

{$IFDEF IOS}
FMX.Media,
{$else}
MMSYSTEM,
{$ENDIF}

IOUtils,
SysUtils,
Classes,
Types;


type
TSoundManager = class
private

{$IFDEF IOS}
FMediaPlayer: TMediaPlayer;
{$else}
FMemoryStreamArray: Array of TMemoryStream;
{$ENDIF}

FNameArray: Array of String;
FPathName: String;

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

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

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

property PathName: String write setPathName;
end;


implementation


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;





{$IFDEF IOS}

// ---------------------------------------------------------------------------
//  For iOS
// ---------------------------------------------------------------------------

constructor TSoundManager.Create(aPathFileName: String);
begin
FMediaPlayer := TMediaPlayer.Create(nil);
PathName := aPathFileName;
end;

destructor TSoundManager.Destroy;
var
i: Integer;
begin

Init();
Stop();
FMediaPlayer.Free;

inherited;
end;


procedure TSoundManager.Init;
begin
SetLength(FNameArray, 0);
end;

procedure TSoundManager.Stop();
begin
FMediaPlayer.Stop;
end;



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

Stop();

for i := Low(FNameArray) to High(FNameArray) do
if FNameArray[i] = Trim(aItemName) then
begin
tmpPathFileName  := FPathName + FNameArray[i] + '.mp3';
FMediaPlayer.FileName := tmpPathFileName;
FMediaPlayer.CurrentTime := 0;
FMediaPlayer.Play;
end;

end;


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

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

fileListOfFolder(FPathName, tmpFileList);

SetLength(FNameArray, 0);

for i := 0 to tmpFileList.Count - 1 do
if ((ExtractFileExt(tmpFileList[i]) = '.mp3') or
(ExtractFileExt(tmpFileList[i]) = '.mp3')) then
begin
SetLength(FNameArray, Length(FNameArray) + 1);
FNameArray[High(FNameArray)] := ChangeFileExt(ExtractFileName(tmpFileList[i]),'');
end;

tmpFileList.Free;
end;


{$else}


// ---------------------------------------------------------------------------
// - For Win
// ---------------------------------------------------------------------------


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

destructor TSoundManager.Destroy;
var
i: Integer;
begin
Stop();
for i := 0 to Length(FMemoryStreamArray) - 1 do
FMemoryStreamArray[i].Free;

inherited;
end;


procedure TSoundManager.Stop();
begin
PlaySound(nil,0, SND_PURGE);
end;

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

Stop();

for i := 0 to Length(FNameArray) - 1 do
if FNameArray[i] = Trim(aItemName) then
PlaySound(FMemoryStreamArray[i].Memory,
0,
SND_MEMORY or SND_ASYNC);

end;



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

fileListOfFolder(FPathName, tmpFileList);

SetLength(FMemoryStreamArray, 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(FMemoryStreamArray, Length(FMemoryStreamArray) + 1);
SetLength(FNameArray        , Length(FNameArray)         + 1);

tmpIndex := Length(FMemoryStreamArray) - 1;

FMemoryStreamArray[tmpIndex] := TMemoryStream.Create();
tmpPathFileName := FPathName + tmpFileList[i];
FMemoryStreamArray[tmpIndex].LoadFromFile(tmpPathFileName);

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

tmpFileList.Free;
end;

procedure TSoundManager.Init;
begin
SetLength(FMemoryStreamArray, 0);
end;

{$ENDIF}



end.

12日目 スリープタイマー

コメントをどうぞ 



uses
	FMX.Types;

type
  TGameStep = (gsOpening,
               gsGameStart,
               gsStageReady,
               gsStageStart,
               gsOnStage,
               gsStageEnd,
               gsStageResult,
               gsGameResult,
               gsGameEnd
               );



type
  TSleepTimer = class
private
  FTimerForSleep: TTimer;
  FTimerInterval: Integer;
  FTimeMS: Integer;
  FNextGameStep: TGameStep;
  FCount: Integer;
  procedure OnTimer(Sender: TObject);
public
  constructor Create();
  destructor Destroy; override;
  procedure Sleep(aTimeMS: Integer; aNextGameStep: TGameStep);
  procedure Stop();
end;



{ TSleepTimer }

constructor TSleepTimer.Create;
begin
  FTimerInterval := 100;

  FTimerForSleep := TTimer.Create(nil);
  FTimerForSleep.OnTimer  := OnTimer;
  FTimerForSleep.Interval := FTimerInterval;
  FTimerForSleep.Enabled  := False;


end;

destructor TSleepTimer.Destroy;
begin
  FTimerForSleep.Enabled := False;
  FTimerForSleep.Free;

  inherited;
end;

procedure TSleepTimer.OnTimer(Sender: TObject);
begin
  FCount := FCount + 1;
  if FCount * FTimerInterval >= FTimeMS then
  begin
    GameModel.GameStep := FNextGameStep;
    Stop();
  end;

end;

procedure TSleepTimer.Sleep(aTimeMS: Integer; aNextGameStep: TGameStep);
begin
  FTimeMS := aTimeMS;
  FNextGameStep := aNextGameStep;
  FCount := 0;
  FTimerForSleep.Enabled  := True;
end;

procedure TSleepTimer.Stop;
begin
  FTimerForSleep.Enabled  := False;
end;

10日目 構造体を使ったリスト

コメントをどうぞ 

unit untTrade;

interface

uses
  untIDateTime,
  untPair,
  untHistoricalList;

type
  TTradeRecord = record
  private
  Public
    Pair    : TPair;
    TimeStep: TTimeStep;

    procedure Init();
    procedure Assign(aTradeRecord: TTradeRecord);
  end;

  TTradeList = record
  private
    function getCount: Integer;
  Public
    Items: Array of TTradeRecord;

    procedure Init();
    procedure Assign(aTradeList: TTradeList);
    procedure Add(aTradeRecord: TTradeRecord);
    property Count: Integer read getCount;

  end;

implementation

{ TTradeRecord }

procedure TTradeRecord.Assign(aTradeRecord: TTradeRecord);
begin
  Self.Pair     := aTradeRecord.Pair;
  Self.TimeStep := aTradeRecord.TimeStep;

end;

procedure TTradeRecord.Init;
begin
  Self.Pair          := peUSDJPY;
  Self.TimeStep.enum := ts1Hour;

end;

{ TTradeList }

procedure TTradeList.Add(aTradeRecord: TTradeRecord);
begin
  SetLength(Self.Items, Length(Self.Items) + 1);
  Self.Items[High(Self.Items)].Assign(aTradeRecord);
end;

procedure TTradeList.Assign(aTradeList: TTradeList);
var
  i: Integer;
begin
  SetLength(Self.Items, aTradeList.Count);
  for i := 0 to Self.Count - 1 do
    Self.Items[i].Assign(aTradeList.Items[i]);
end;

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

procedure TTradeList.Init;
begin
  SetLength(Self.Items, 0);
end;

end.

6日目 TTimer を動的に利用する

コメントをどうぞ 
unit untModel;

interface

uses
  FMX.Types;


type
  TModel = class
  private
    FDrawTimer: TTimer;
    procedure OnDrawTimer(Sender: TObject);
  public
    destructor Destroy; override;
    constructor Create();
  end;

implementation

{ TModel }
constructor TModel.Create;
begin
  FDrawTimer          := TTimer.Create(nil);
  FDrawTimer.OnTimer  := OnDrawTimer;
  FDrawTimer.Interval := 1000;
  FDrawTimer.Enabled  := False;
end;

destructor TModel.Destroy;
begin
  FDrawTimer.Free;
  inherited;
end;

procedure TModel.OnDrawTimer(Sender: TObject);
begin
  //
end;

end.

1日目 列挙型をもとにした構造体サンプル

コメントをどうぞ 

type
  TPairEnum = (
    peEURUSD,
    peGBPUSD,
    peUSDCHF,
    peUSDJPY,
    peEURGBP,
    peEURCHF,
    peEURJPY,
    peGBPCHF,
    peGBPJPY,
    peCHFJPY,
    peUSDCAD,
    peEURCAD,
    peAUDUSD,
    peAUDJPY,
    peNZDUSD,
    peNZDJPY);


type
  TPair = record
  private
    FEnum: TPairEnum;

    function getName(): String;

    procedure setEnum(const Value: TPairEnum);
    procedure setName(const Value: String);
    function getCount: Integer;
    function getSerial: Integer;
    procedure setSerial(const Value: Integer);


  public
    property Enum:      TPairEnum read FEnum        write setEnum;
    property Serial:    Integer   read getSerial    write setSerial;
    property Name:      String    read getName      write setName;
    property ShortName: String    read getShortName;

    property Count: Integer read getCount;
  end;

implementation

{ TPair }

function TPair.getCount: Integer;
var
  tmpInfo :PTypeInfo;
  tmpData :PTypeData;
begin
  tmpInfo :=TypeInfo(TPairEnum);
  tmpData :=GetTypeData(tmpInfo);
  Result := tmpData.MaxValue - tmpData.MinValue + 1;
end;

function TPair.getName: String;
begin
  case FEnum of
    peEURUSD: result := 'EURUSD';
    peGBPUSD: result := 'GBPUSD';
    peUSDCHF: result := 'USDCHF';
    peUSDJPY: result := 'USDJPY';
    peEURGBP: result := 'EURGBP';
    peEURCHF: result := 'EURCHF';
    peEURJPY: result := 'EURJPY';
    peGBPCHF: result := 'GBPCHF';
    peGBPJPY: result := 'GBPJPY';
    peCHFJPY: result := 'CHFJPY';
    peUSDCAD: result := 'USDCAD';
    peEURCAD: result := 'EURCAD';
    peAUDUSD: result := 'AUDUSD';
    peAUDJPY: result := 'AUDJPY';
    peNZDUSD: result := 'NZDUSD';
    peNZDJPY: result := 'NZDJPY';
  else
    ShowMessage('TPair.getName');
  end;
end;

function TPair.getSerial: Integer;
begin
  result := Integer(FEnum);
end;

procedure TPair.setEnum(const Value: TPairEnum);
begin
  FEnum := Value;
end;

procedure TPair.setName(const Value: String);
var
  tmpValue: String;
begin
  tmpValue := trim(Value);
       if tmpValue = 'EURUSD' then self.enum := peEURUSD
  else if tmpValue = 'GBPUSD' then self.enum := peGBPUSD
  else if tmpValue = 'USDCHF' then self.enum := peUSDCHF
  else if tmpValue = 'USDJPY' then self.enum := peUSDJPY
  else if tmpValue = 'EURGBP' then self.enum := peEURGBP
  else if tmpValue = 'EURCHF' then self.enum := peEURCHF
  else if tmpValue = 'EURJPY' then self.enum := peEURJPY
  else if tmpValue = 'GBPCHF' then self.enum := peGBPCHF
  else if tmpValue = 'GBPJPY' then self.enum := peGBPJPY
  else if tmpValue = 'CHFJPY' then self.enum := peCHFJPY
  else if tmpValue = 'USDCAD' then self.enum := peUSDCAD
  else if tmpValue = 'EURCAD' then self.enum := peEURCAD
  else if tmpValue = 'AUDUSD' then self.enum := peAUDUSD
  else if tmpValue = 'AUDJPY' then self.enum := peAUDJPY
  else if tmpValue = 'NZDUSD' then self.enum := peNZDUSD
  else if tmpValue = 'NZDJPY' then self.enum := peNZDJPY
  else
    ShowMessage('TPair.setName');
end;


procedure TPair.setSerial(const Value: Integer);
begin
  FEnum := TPairEnum(Value);
end;

24日目+29 シンプルなストップウォッチ

コメントをどうぞ 

unit untStopWatch;

interface

uses
  Windows;

type
  TStopWatch = class
  private
    StartCount: Integer;
    procedure Reset;
  public
    procedure Start;
    function Time : Integer;
  end;

var
 StopWatch: TStopWatch;

implementation

procedure TStopWatch.Reset;
begin
  StartCount := GetTickCount;
end;

procedure TStopWatch.Start;
begin
  Reset();
end;

function TStopWatch.Time: Integer;
begin
  Result := GetTickCount - StartCount;
end;

end.

24日目+20 文字列の添字の下限について

コメントをどうぞ

Win32 では 1
iOS では 0

  for i := 0 to Length(tmpRemoveOrderArray) - 1 do
{$IFDEF IOS}
    TileManager.TileList.Items[tmpRemoveOrderArray[i]].Letter := tmpQuestString[i];
{$else}
    TileManager.TileList.Items[tmpRemoveOrderArray[i]].Letter := tmpQuestString[i+1];
{$ENDIF}

もしくは

  tmpMinIndex := Low(tmpQuestString);
  for i := 0 to Length(tmpRemoveOrderArray) - 1 do
    TileManager.TileList.Items[tmpRemoveOrderArray[i]].Letter := tmpQuestString[tmpMinIndex+i];

24日目+2　メッセージダイアログ

コメントをどうぞ

uses
FMX.Dialogs,
System.UITypes;

を追加

列挙型は、型から書くのがFiremonkey流らしい。

  if mrOk = MessageDlg('ゲームを終了していいですか。', TMsgDlgType.mtConfirmation,  [TMsgDlgBtn.mbOk, TMsgDlgBtn.mbCancel], 0) then
  begin
    GameStep := gsGameEnd;
    Viewer.MainTabPage := mtTitle;
  end;

21日目 クイックソート　序列の配列も返す

コメントをどうぞ 
type
  TSortArray = array of Integer;



procedure QuickSortWithOrderList(var vSortArray: TSortArray; var vOrderArray:TSortArray);
var
  i: Integer;

  procedure DoQuickSort(vSortArray:TSortArray; vSortOrderArray:TSortArray; start,last:integer);
  var
    tmpCompareIndex,
    tmpSwapIndex,
    tmpCompareValue: integer;

    procedure swapValue(aIndexA, aIndexB: Integer);
    var
      tmpDummyValue: Integer;
    begin
      tmpDummyValue := vSortArray[aIndexA];
      vSortArray[aIndexA] := vSortArray[aIndexB];
      vSortArray[aIndexB] := tmpDummyValue;

      tmpDummyValue := vSortOrderArray[aIndexA];
      vSortOrderArray[aIndexA] := vSortOrderArray[aIndexB];
      vSortOrderArray[aIndexB] := tmpDummyValue;
    end;

  begin
    tmpSwapIndex := (start + last) div 2;

    swapValue(start, tmpSwapIndex);

    tmpCompareValue := vSortArray[start];
    tmpSwapIndex    := start + 1;
    tmpCompareIndex := start + 1;
    while tmpCompareIndex <= last do
    begin
      if vSortArray[tmpCompareIndex] < tmpCompareValue then   	// 降順
      begin
        swapValue(tmpCompareIndex, tmpSwapIndex);
        Inc(tmpSwapIndex);
      end;
      Inc(tmpCompareIndex);
    end;
    Dec(tmpSwapIndex);

    swapValue(start, tmpSwapIndex);

    if tmpSwapIndex-start > 1 then
      DoQuickSort(vSortArray,vSortOrderArray,start,tmpSwapIndex);
    if last-tmpSwapIndex > 1 then
      DoQuickSort(vSortArray,vSortOrderArray,tmpSwapIndex+1,last);
  end;

begin
  SetLength(vOrderArray, Length(vSortArray));
  for i :=0 to Length(vOrderArray) - 1 do
    vOrderArray[i] := i;

  DoQuickSort(vSortArray, vOrderArray, LOW(vSortArray), HIGH(vSortArray));
end;

19日目 クイックソート

コメントをどうぞ 
数値配列の整列　～QuickSort～

http://www5d.biglobe.ne.jp/~tomoya03/shtml/algorithm/QSort.htm

procedure QuickSort(vSortArray:TSortArray; start,last:integer);
var
  tmpCompareIndex,
  tmpSwapIndex,
  tmpCompareValue: integer;

  procedure swapValue(aIndexA, aIndexB: Integer);
  var
    tmpDummyValue: Integer;
  begin
    tmpDummyValue := vSortArray[aIndexA];
    vSortArray[aIndexA] := vSortArray[aIndexB];
    vSortArray[aIndexB] := tmpDummyValue;
  end;

begin
  tmpSwapIndex := (start + last) div 2;

  swapValue(start, tmpSwapIndex);

  tmpCompareValue := vSortArray[start];
  tmpSwapIndex    := start + 1;
  tmpCompareIndex := start + 1;
  while tmpCompareIndex <= last do
  begin
    if vSortArray[tmpCompareIndex] < tmpCompareValue then   	// 降順
    begin
      swapValue(tmpCompareIndex, tmpSwapIndex);
      Inc(tmpSwapIndex);
    end;
    Inc(tmpCompareIndex);
  end;
  Dec(tmpSwapIndex);

  swapValue(start, tmpSwapIndex);

  if tmpSwapIndex-start > 1 then
    QuickSort(vSortArray,start,tmpSwapIndex);
  if last-tmpSwapIndex > 1 then
    QuickSort(vSortArray,tmpSwapIndex+1,last);
end;

７日目　音を出してみた２

コメントをどうぞ 
TMediaPlayer を一つにして、音を出すタイミングでファイルを読み込む方法を試してみる。
タイムラグがとてもある！残念。やっぱり、TMediaPlayer を複数作ったほうが断然タイムラグが小さい。
でも、とりあえずこの方法で行くか。
たぶん、TMemoryStream なんかにデータを置いておく方法があるはず。

unit untSoundManager;

interface

uses
  untFileUtil200,
  untFileNameInfo,
  untConfig,

  FMX.Media,
  SysUtils,
  Classes,
  Types;

type
  TSoundType = (stSound, stMusic);

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

    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;

var
  SoundManager: TSoundManager;

implementation

constructor TSoundManager.Create(aPathFileName: String);
begin
  FMediaPlayer := TMediaPlayer.Create(nil);
  PathName := aPathFileName;
end;

destructor TSoundManager.Destroy;
var
  i: Integer;
begin

  Init();
  Stop();
  FMediaPlayer.Free;

  inherited;
end;

procedure TSoundManager.Init;
begin
  SetLength(FNameArray, 0);
end;

procedure TSoundManager.Stop();
begin
  FMediaPlayer.Stop;
end;

procedure TSoundManager.Play(aItemName: String; SoundType: TSoundType);
var
  i: Integer;
  tmpPathFileName: String;
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
        tmpPathFileName  := SoundEffectRootDirectoryName() + FNameArray[i] + '.wav';
        FMediaPlayer.FileName := tmpPathFileName;
        FMediaPlayer.CurrentTime := 0;
        FMediaPlayer.Play;
      end;
  end;
end;

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

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

  fileListOfFolder(tmpPathName, tmpFileList);

  SetLength(FNameArray, 0);

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

  tmpFileList.Free;
end;

end.