TAlphacolor 色に関するメモ

コメントをどうぞ


  function valueToColor(aValue: double): TAlphaColor;
  var
    tmpSingle: Single;
    tmpAlphaColor: TAlphaColor;
  begin
    // 割合を0.15 なら1とするように切り上げる
    tmpSingle := aValue * (1/0.15);
    if tmpSingle > 1 then tmpSingle := 1;
    // 最大値 160（青） 最小値 0（赤）に補正
    tmpSingle := tmpSingle * 220 / 360;
    tmpAlphaColor := HSLtoRGB(tmpSingle, 0.75,0.5);

    tmpAlphaColorRec.Color := tmpAlphaColor;

    result := MakeColor(tmpAlphaColorRec.R,
                        tmpAlphaColorRec.G,
                        tmpAlphaColorRec.B,
                        $80);
  end;

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;

配列のあふれを検出

コメントをどうぞ

配列があふれると、予想のできないエラーが発生する。

デバッグ時には、プロジェクトオプションの、「コンパイラ」「実行時エラー」にある、「範囲チェック」を true にしておく。

Win32 とiOSの違い

コメントをどうぞ

iOS で TRectangle のThickness を 0 にするとエラー発生

iOS でコンボボックスのクリアで onChange イベントが発生

iOS では変数の初期化が自動的に行われていない。

メモリリークのチェック

コメントをどうぞ

プロジェクトファイルに


begin

  {$IFDEF DEBUG}
  ReportMemoryLeaksOnShutdown := True;
  {$ENDIF}

  Application.Initialize;
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run;
end

LiveBinding　利用のための調査

コメントをどうぞ

注意点

・　A から B にリンクした場合、Bの初期値がAに渡される。（Aの初期値がBに渡されるわけではない。）？

・　LiveBinding デザイナでドラッグでリンクできない場合はウィザードを使えばリンクできる。

TBindSourceDB データベースへのバインディングを作成するために使用されます。

TPrototypeBindSource 着手するデータがまだない場合に手始めに使用できるサンプルデータを生成するためのデータソースを提供します。後で、このデータソースを何らかの実データに置き換えることができます。

TBindingsList バインディングリストを保持するために使用されます。

TDataGeneratorAdapter データジェネレータのアダプタです。

TBindNavigator (FMX) FMX アプリケーションの開発時にデータセット内のレコードを順次参照するために使用されます。

TBindNavigator (VCL) VCL アプリケーションの開発時にデータセット内のレコードを順次参照するために使用されます。

動くラベル

コメントをどうぞ


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.

TFont の色、サイズがコードから変更できない件

コメントをどうぞ

self.FTitleLabel.StyledSettings := []　で解決

  self.FTitleLabel.StyledSettings := [];
  self.FTitleLabel.Font.Size   := Self.FBGImage.Height * 0.1;
  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;

アニメーションサンプル

コメントをどうぞ


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.

生成した TImage への描画がうまくいかない件

コメントをどうぞ

StarImage.Parent := self;

が大切。

https://forums.embarcadero.com/thread.jspa?threadID=97048&tstart=0
で教えてもらいました。





procedure TForm3.FormCreate(Sender: TObject);
begin
 StarImage := TImage.Create(Self);
 StarImage.Parent := self;
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 StarImage.Free;
end;

procedure TForm3.Button1Click(Sender: TObject);
var
 p1, p2: TPointF;
begin

 p1.Create(20, 2);
 p2.Create(400, 400);

 StarImage.Width := 400;
 StarImage.Height := 400;
 StarImage.Position.X :=40;
 StarImage.Position.Y :=40;
 StarImage.Visible := True;
 StarImage.Enabled := True;
 StarImage.WrapMode := TImageWrapMode.iwFit;

 StarImage.Bitmap.SetSize(400,400);
 StarImage.Bitmap.Canvas.BeginScene;
 StarImage.Bitmap.Canvas.DrawLine(p1, p2, 100);
 StarImage.Bitmap.Canvas.EndScene;
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.

Firemonkey の TCheckbox のイベントについて

コメントをどうぞ

onChange イベントは変更後の IsChecked を正しく持っている。
ただし、コードによって変更された場合もこのイベントは起こってしまう。

onClick イベントは、変更される前に呼び出されてしまう。

で、インターバル50msくらいのタイマーを置いて、こんな感じ。

procedure TfrmMain.tmrForCheckBoxTimer(Sender: TObject);
begin
  DispSearchResult();
  tmrForCheckBox.Enabled := False;
end;

procedure TfrmMain.chkIsOnlySeionClick(Sender: TObject);
begin
  tmrForCheckBox.Enabled := True;
end;

もっといい方法が絶対あるはずだけど、とりあえずこれでOK。

フォントの一覧を所得 Windows

コメントをどうぞ

uses に Windows


procedure TfrmMain.initFontCombo;
var
  tmpFileList: TstringList;
  tmpFolderName: string;
  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;
  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;
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;

「DelphiによるiPhone / iPadアプリ開発コンテスト」の景品が届く

コメントをどうぞ

iTuneカード10000円分でした。

TFloatAnimation の AutpReverse おかしくない？

コメントをどうぞ

TFloatAnimation の AutpReverse おかしくない？

なんだか周期が1.5。

TFloatKeyAnimation を用いる。

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;

だった。

月	火	水	木	金	土	日
« 9月
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29	30

24Days　iPhoeアプリはdelphiでいっとく

24日でiPhoneアプリを開発・公開するまでの過程を実況するサイト

TAlphacolor 色に関するメモ

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

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

フォントと列挙

OnChange　のタイミング

配列のあふれを検出

Win32 とiOSの違い

メモリリークのチェック

LiveBinding　利用のための調査

動くラベル

メッセージボード

TFont の色、サイズがコードから変更できない件

アニメーションサンプル

生成した TImage への描画がうまくいかない件

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

Firemonkey の TCheckbox のイベントについて

フォントの一覧を所得 Windows

24日目 +5　バイナリファイルの読み書き

「DelphiによるiPhone / iPadアプリ開発コンテスト」の景品が届く

TFloatAnimation の AutpReverse おかしくない？

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

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

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

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

フォントと列挙

OnChange のタイミング

OnChange　のタイミング