カテゴリー別アーカイブ: 24Days Season2 FX練習ソフトを作成する

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.

15日目 property に代入できない件

コメントをどうぞ

config.HSTimeStep.Enum := ts1Hour;

に代入しようとして、「代入できない左辺値です」的なエラーが出るとき、
プロパティーの定義をチェックしてみると、

ダメパターン
property Enum: TTimeStepEnum   read FEnum        write FEnum;

OKパターン
property Enum: TTimeStepEnum   read FEnum        write setEnum;
procedure TTimeStep.setEnum(const Value: TTimeStepEnum);
begin
FEnum := Value;
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;

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.

2日目 色の指定は uses に UIConsts

コメントをどうぞ

色の指定は uses に UIConsts

procedure TCandleChartCreator.DrawCandle;
var
  tmpRectF: TRectF;
begin

  ChartBitmap.SetSize(Round(FWidth), Round(FHeight));

  tmpRectF.Left   := FWidth *0.05;
  tmpRectF.Right  := FWidth *0.95;
  tmpRectF.Top    := FHeight*0.05;
  tmpRectF.Bottom := FHeight*0.95;

  with ChartBitmap.Canvas do
  begin
    BeginScene;
    Stroke.Kind := TBrushKind.bkSolid;
    Stroke.Color :=  claLime;
    StrokeThickness := 4;
    DrawRect(tmpRectF, 20, 20, AllCorners, 1.0);
    EndScene
  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;