作成者別アーカイブ: kawabata


type
  TMover = class
  private

    FOnChange: TNotifyEvent;

    procedure OnAnimationFinish(Sender: TObject);
    procedure OnAnimationProcess(Sender: TObject);

    property OnChange: TNotifyEvent read FOnChange write FOnChange;

end;


type
  TMyMessageBoard = class
  private
    procedure OnSingleAnimationFinish(Sender: TObject);

  public
    constructor Create();
    destructor Destroy; override;

    procedure OpenAndClose(aParent, aTargetA, aTargetB: TFmxObject);

end;



procedure TMover.OnAnimationFinish(Sender: TObject);
begin
  if Assigned( FOnChange) then FOnChange(Self);
  Self.Free;
end;


procedure TMyMessageBoard.OnSingleAnimationFinish(Sender: TObject);
begin
  Form5.Caption := 'zzz';
end;

procedure TMyMessageBoard.OpenAndClose(aParent: TFmxObject;
                                       aTargetA: TFmxObject;
                                       aTargetB: TFmxObject);
var
  tmpIn: TMover;
begin
  tmpIn := TMove_SwellClose.Create(aParent, aTargetA);
  tmpIn.AdjustSize;
  tmpIn.Animate(0.5, 2);
  tmpIn.OnChange := OnSingleAnimationFinish;
end;

ブラウザでWebサイトを開く

コメントをどうぞ

uses に

{$IFDEF MACOS}
,Posix.Stdlib
{$ENDIF}
{$IFDEF MSWINDOWS}
,Windows
,ShellAPI
{$ENDIF}
;

procedure TfrmMain.actOpenOnlineHelpExecute(Sender: TObject);
const
TMP_URL = 'http://www.rigakukan.com';
begin
{$IFDEF MACOS}
_system(PAnsiChar('open ' + TMP_URL));
{$ENDIF}
{$IFDEF MSWINDOWS}
ShellExecute(0, 'open', PChar(TMP_URL),
'', '', SW_SHOWNORMAL);
{$ENDIF}
end;

メッセージのまとめ

コメントをどうぞ

System.UITypes,
FMX.Dialogs,


MessageDlg('Err: GetSpecialFolder', TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);

ツールチップ　ポップアップヘルプ

コメントをどうぞ

unit untMyToolTipPanel1408;

interface

 uses
   System.Types,
   System.Classes,
   System.UITypes,
   FMX.Objects,
   FMX.StdCtrls,
   FMX.Types,
   FMX.Controls,
   FMX.Forms,
   FMX.Edit;

 type
   TToolTipPanel = class(TPanel)
   private
//     FOnlyInputFields: Boolean;
     FDataName: array of string;
     FDataTip:  array of string;

     FMousePoint: TPointF;
     FCounter: Cardinal;
     FActiveControl: TFmxObject;
     FLabel: TLabel;
     FRectangle: TRectangle;
     FTimer: TTimer;
     FBorderWidth: Single;
     FFontColor: TAlphaColor;
    FColor: TAlphaColor;
    FStrokeColor: TAlphaColor;
     function GetToolTipText: string;
     procedure SetToolTipText(const Value: string);
     procedure OnTimer(Sender: TObject);

     function TipWhereNameIs(aName: string): string;

   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure ShowToolTip(AX, AY: Single);

     procedure ClearData();
     procedure AppendData(aName: String; aTip: String);

     property Text: string read GetToolTipText write SetToolTipText;
     property BorderWidth: Single read FBorderWidth write FBorderWidth;

     property FontColor: TAlphaColor   read FFontColor   write FFontColor;
     property Color: TAlphaColor       read FColor       write FColor;
     property StrokeColor: TAlphaColor read FStrokeColor write FStrokeColor;

     //     property OnlyInputFields: Boolean read FOnlyInputFields write FOnlyInputFields;
   end;

implementation

 function TToolTipPanel.GetToolTipText: string;
 begin
   Result := FLabel.Text;
 end;
 procedure TToolTipPanel.SetToolTipText(const Value: string);
 begin
   FLabel.Text := Value ;
 end;

procedure TToolTipPanel.AppendData(aName, aTip: String);
var
  tmpNewLength: Integer;
begin
  tmpNewLength := Length(FDataName) + 1;

  SetLength(FDataName, tmpNewLength);
  SetLength(FDataTip,  tmpNewLength);

  FDataName[tmpNewLength-1] := aName;
  FDataTip [tmpNewLength-1] := aTip;
end;

procedure TToolTipPanel.ClearData;
begin
  SetLength(FDataName, 0);
  SetLength(FDataTip,  0);
end;

function TToolTipPanel.TipWhereNameIs(aName: string): string;
var
  i: Integer;
  tmpResult: String;
begin
  tmpResult := '';
  for i := 0 to Length(FDataName) - 1 do
    if aName = FDataName[i] then
      tmpResult := FDataTip[i];

  Result := tmpResult;
end;

constructor TToolTipPanel.Create(AOwner: TComponent);
 begin
   inherited; //inherits the behavior from TPanel

   Visible := False;

   FRectangle := TRectangle.Create(AOwner);
   FRectangle.Parent := Self;
   FRectangle.Align := TAlignLayout.alClient;

   FLabel := TLabel.Create(AOwner);
   FLabel.Parent := FRectangle;
   FLabel.StyledSettings := [];
   FLabel.FontColor := $FF000000;
   if assigned(FLabel.Canvas) then
     Height := FLabel.Canvas.TextHeight(FLabel.Text);
   FLabel.Align := TAlignLayout.alClient;
   FLabel.TextAlign := TTextAlign.taCenter;
   FLabel.VertTextAlign := TTextAlign.taCenter;

   FTimer := TTimer.Create(AOwner);
   FTimer.OnTimer := OnTimer;
   FTimer.Enabled := True;
   FTimer.Interval := 500;

   FActiveControl := nil;

   FCounter := 1000;

   FBorderWidth := 10;
 end;

 destructor TToolTipPanel.Destroy;
 begin
   inherited;
 end;

procedure TToolTipPanel.ShowToolTip(AX, AY: Single);
var
  tmpAdjustedPosition: TPointF;
const
  TMP_MARGIN = 3;
begin
  FLabel.FontColor        := FFontColor;
  FRectangle.Fill.Color   := FColor;
  FRectangle.Stroke.Color := FStrokeColor;

  self.Height := FLabel.Canvas.TextHeight(FLabel.Text) + 2 * FBorderWidth;
  self.Width  := FLabel.Canvas.TextWidth (FLabel.Text) + 2 * FBorderWidth;

  if Round(FMousePoint.X) < (Parent as TForm).Width / 2 then
    tmpAdjustedPosition.X := AX + TMP_MARGIN
  else
    tmpAdjustedPosition.X := AX - Width - TMP_MARGIN;

  if Round(FMousePoint.Y) < (Parent as TForm).Height / 2 then
    tmpAdjustedPosition.Y := AY + TMP_MARGIN
  else
    tmpAdjustedPosition.Y := AY - Height - TMP_MARGIN;

   self.Position.Point := tmpAdjustedPosition;

   self.Visible := True;
 end;

procedure TToolTipPanel.OnTimer;
var
  LActiveControl : IControl;
  LControl : TControl;
  LMousePos : TPointF;
  LObject : IControl ;
  tmpObjectName: String;
begin

  // 動いていれば
  if Screen.MousePos <> FMousePoint then
  begin
    FMousePoint := Screen.MousePos ;
    FCounter := 0;
    Visible := False;
  end ;

  Inc(FCounter);

  case FCounter of
    0..1: Visible := False ;
    2:
    begin
      tmpObjectName := '';
      if Parent is TForm then
      begin
        //identifies the object on which the mouse cursor is located
        LObject := (Parent as TForm).ObjectAtPoint(FMousePoint) ;
        if Assigned(LObject) then
          tmpObjectName := LObject.GetObject.Name;
      end;

      Text := TipWhereNameIs(tmpObjectName);

      LMousePos := (Parent as TForm).ScreenToClient(FMousePoint);

      if Text <> '' then
        ShowToolTip(LMousePos.X, LMousePos.Y);
    end;
    // the tooltip is displayed for a limited time. In this case it is displayed until FCounter reaches 10
    3..15:;
    else
    begin
      FCounter := 1000;
      Visible := False ;
    end;
  end;

 end;

end.

ヘルプフォーム

コメントをどうぞ


unit untFormHelp;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
  FMX.StdCtrls, FMX.TabControl, FMX.Objects, FMX.Layouts;

type
  TfrmHelp = class(TForm)
    tbcHelp: TTabControl;
    TabItem1: TTabItem;
    TabItem2: TTabItem;
    TabItem3: TTabItem;
    TabItem4: TTabItem;
    Image1: TImage;
    Label1: TLabel;
    Image2: TImage;
    VertScrollBox1: TVertScrollBox;
    VertScrollBox2: TVertScrollBox;
    Image3: TImage;
    VertScrollBox3: TVertScrollBox;
    Image4: TImage;
    Layout1: TLayout;
    Button0: TButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Layout2: TLayout;
    btnClose: TButton;
    Layout3: TLayout;
    Layout4: TLayout;
    Layout5: TLayout;
    Layout6: TLayout;
    TabItem5: TTabItem;
    procedure FormCreate(Sender: TObject);
    procedure Button0Click(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    const
      PAGE_COUNT = 5;
  private

    FButton: array[0..PAGE_COUNT-1] of TButton;
    procedure setPageIndex(const Value: Integer);

  public
    property PageIndex: Integer write setPageIndex;
  end;

var
  frmHelp: TfrmHelp;


implementation

uses
  untMainForm;



{$R *.fmx}

procedure TfrmHelp.btnCloseClick(Sender: TObject);
begin
  self.Close;
end;

procedure TfrmHelp.Button0Click(Sender: TObject);
begin
  PageIndex := TButton(Sender).Tag;
end;

procedure TfrmHelp.FormCreate(Sender: TObject);
begin
  FButton[0] := Button0;
  FButton[1] := Button1;
  FButton[2] := Button2;
  FButton[3] := Button3;
  FButton[4] := Button4;


  tbcHelp.TabPosition := TTabPosition.tpNone;
  PageIndex := 0;
end;

procedure TfrmHelp.setPageIndex(const Value: Integer);
var
  i: Integer;
begin
  for i := 0 to PAGE_COUNT - 1 do
    if i <> Value then
      FButton[i].IsPressed := False
    else
      FButton[i].IsPressed := True;

  tbcHelp.TabIndex := Value;
end;

end.

アニメーションのまとめ

コメントをどうぞ

アニメーションの property プロパティはコードから変更できない？

コントロールをドラッグして移動する

コメントをどうぞ


unit untMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
  FMX.StdCtrls, FMX.Objects, FMX.Layouts, FMX.ListBox, FMX.Edit;

type
  TForm1 = class(TForm)
    crcBase: TCircle;
    lotMain: TLayout;
    btnOK: TButton;
    recSquare0: TRectangle;
    recSquare2: TRectangle;
    recSquare1: TRectangle;
    recSquare3: TRectangle;
    recSquare4: TRectangle;
    btnInit: TButton;
    cmbTaskName: TComboBox;
    Label1: TLabel;
    edtClientName: TEdit;
    Label2: TLabel;
    Layout1: TLayout;
    Layout3: TLayout;
    Rectangle1: TRectangle;
    lblDebug: TLabel;

    procedure recSquare0MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure recSquare0MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure recSquare0MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure btnInitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure recSquare0MouseLeave(Sender: TObject);
  private
    FRectangle: array[0..4] of TRectangle;

    FIsMove: Boolean;
    FOldPosition: TPointF;

    procedure RePosition;
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}


procedure TForm1.FormCreate(Sender: TObject);
begin
  //
  FRectangle[0] := recSquare0;
  FRectangle[1] := recSquare1;
  FRectangle[2] := recSquare2;
  FRectangle[3] := recSquare3;
  FRectangle[4] := recSquare4;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  RePosition();
  FIsMove := False;
end;



procedure TForm1.FormDestroy(Sender: TObject);
begin
//
end;



procedure TForm1.FormResize(Sender: TObject);
begin
  RePosition();
end;





procedure TForm1.btnInitClick(Sender: TObject);
begin
//
end;

procedure TForm1.btnOKClick(Sender: TObject);
begin
//
end;


procedure TForm1.recSquare0MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
//  lblDebug.Text := IntToStr(Round(X));

  FIsMove := True;

  FOldPosition.X := X;
  FOldPosition.Y  := Y;

end;

procedure TForm1.recSquare0MouseLeave(Sender: TObject);
begin
  FIsMove := False;
end;

procedure TForm1.recSquare0MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
  if FIsMove = False then Exit;

  TRectangle(Sender).Position.X := TControl(Sender).Position.X + X - FOldPosition.X;
  TRectangle(Sender).Position.Y  := TControl(Sender).Position.Y  + Y - FOldPosition.Y;

end;

procedure TForm1.recSquare0MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  FIsMove := False;

  TRectangle(Sender).Position.X := TControl(Sender).Position.X + X - FOldPosition.X;
  TRectangle(Sender).Position.Y  := TControl(Sender).Position.Y  + Y - FOldPosition.Y;

end;










procedure TForm1.RePosition();
var
  tmpPartsRect: TRectF;
  tmpMainRect: TRectF;
  tmpScreenWidth: Single;
  tmpScreenHeight: Single;


  tmpCircleSize: Single;

const
  LEFT_MARGIN_RATE = 0.25;

begin
  tmpScreenWidth  := lotMain.Width;
  tmpScreenHeight := lotMain.Height;

  //
  tmpPartsRect.Left   := 0;
  tmpPartsRect.Top    := 0;
  tmpPartsRect.Right  := lotMain.Width * LEFT_MARGIN_RATE;
  tmpPartsRect.Bottom := lotMain.Height;

  //
  tmpMainRect.Left   := lotMain.Width * LEFT_MARGIN_RATE;
  tmpMainRect.Top    := 0;
  tmpMainRect.Right  := lotMain.Width;
  tmpMainRect.Bottom := lotMain.Height;


  if tmpMainRect.Width > tmpMainRect.Height then
    tmpCircleSize := tmpMainRect.Height
  else
    tmpCircleSize := tmpMainRect.Width;

  //
  crcBase.Width  := tmpCircleSize;
  crcBase.Height := tmpCircleSize;

  //
  crcBase.Position.X := tmpMainRect.Left + (tmpMainRect.Width  - tmpCircleSize) / 2;
  crcBase.Position.Y := tmpMainRect.Top  + (tmpMainRect.Height - tmpCircleSize) / 2;

end;


end.

TTMSFMXGrid についてのメモ

コメントをどうぞ

固定セルだけセンタリング

OnGetCellLayout イベントに

procedure TfrmScore.grdWakaScoreGetCellLayout(Sender: TObject; ACol,
  ARow: Integer; ALayout: TTMSFMXGridCellLayout; ACellState: TCellState);
begin
  if ARow < grdWakaScore.FixedRows then
    ALayout.TextAlign := TTextAlign.taCenter;
end;

アンチウィルスソフト（カスペルスキー）で

コメントをどうぞ

アンチウィルスソフト（カスペルスキー）2014　で　システムウォッチャーを有効（デフォルトで有効）だと、Delphi で開発したソフトの動作速度が著しく低下する。

スコアマネージャー

コメントをどうぞ


unit untScore;

interface

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

type
  TScoreRecord = class
  private
    function getIsCorrect: boolean;

  const
    DELIMITER_CHAR = ',';

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

    constructor Create();
    destructor Destroy; override;

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

    property IsCorrect: boolean read getIsCorrect;
  end;

type
  TScoreList = class
  private

  public
    Items: TList<TScoreRecord>;

    constructor Create();
    destructor Destroy; override;

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

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


  end;

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

  private
    FScoreRootPathName: String;

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

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

  end;

var
  ScoreManager: TScoreManager;

const
  ON_SKIP    = -1;
  ON_TIMEOUT = -2;


implementation



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

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

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





{ TScoreRecord }

constructor TScoreRecord.Create;
begin

end;

destructor TScoreRecord.Destroy;
begin

  inherited;
end;

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

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

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

  tmpFieldStringList.Free;
end;

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

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

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

  tmpResult := tmpFieldStringList.DelimitedText;

  tmpFieldStringList.Free;

  Result := tmpResult;
end;

function TScoreRecord.getIsCorrect: boolean;
begin

end;

{ TScoreList }


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

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

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

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

  Items.Add(tmpScoreRecord);
end;



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

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

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

end;

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

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

  tmpRecordStringList.SaveToFile(aPathFileName);

  tmpRecordStringList.Free;
end;





{ TScoreManager }


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

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

end;

destructor TScoreManager.Destroy;
begin

  inherited;
end;

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

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

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

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

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

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

  tmpStringList.Free;

end;

end.

アニメーションに関するまとめ

コメントをどうぞ

TPathAnimation の親コンポーネントが削除されると、自動的に TPathAnimation の TPath も自動的に解放されてしまう。対策として、OnFinish イベントで Parent プロパティに nil を代入しておく。

ファイルシステム関数

コメントをどうぞ

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

CopyFromBitmap, DrawBitmap がうまくいなないので

コメントをどうぞ

CopyFromBitmap, DrawBitmap がうまくいなないので、とりあえずの苦肉の策




procedure TBoard.DrawAllTiles;
var
  i, j, k: Integer;
  tmpTileListIndex: Integer;
  tmpBitmap: TBitmap;
  tmpPatternName: String;
  tmpTileBitmap: TBitmap;
  tmpSelectedBitmap: TBitmap;
  tmpRect: TRect;
begin
  tmpBitmap := TBitmap.Create(BoardWidth, BoardHeight);
  tmpBitmap.Clear($0);
  tmpBitmap.Canvas.BeginScene;

  for k := GameController.TileManager.Grid3D.ZMin to GameController.TileManager.Grid3D.ZMax do
    for i := GameController.TileManager.Grid3D.XMin to GameController.TileManager.Grid3D.XMax do
      for j := GameController.TileManager.Grid3D.YMin to GameController.TileManager.Grid3D.YMax do
      begin
        tmpTileListIndex := GameController.TileManager.Grid3D[i,j,k];
        if tmpTileListIndex <> VALUE_OF_TILE_EMPTY then
        begin
          tmpPatternName := 'animal' + IntToStr(GameController.TileManager.TileList[tmpTileListIndex].KindSerial);
          tmpTileBitmap := frmASMain.ImageManager.Item(tmpPatternName);
          tmpRect := Pos3DToAreaRect(GameController.TileManager.TileList[tmpTileListIndex].Pos3D);

          tmpBitmap.Canvas.DrawBitmap(tmpTileBitmap,
                                      RectF(0,
                                            0,
                                            tmpTileBitmap.Width,
                                            tmpTileBitmap.Height),
                                      RectF(tmpRect.Left,
                                            tmpRect.Top,
                                            tmpRect.Right,
                                            tmpRect.Bottom),
                                      1);

          if GameController.TileManager.TileList[tmpTileListIndex].IsSelected then
          begin
            tmpSelectedBitmap := frmASMain.ImageManager.Item('selected');
            tmpBitmap.Canvas.DrawBitmap(tmpSelectedBitmap,
                                        RectF(0,
                                              0,
                                              tmpSelectedBitmap.Width,
                                              tmpSelectedBitmap.Height),
                                        RectF(tmpRect.Left,
                                              tmpRect.Top,
                                              tmpRect.Right,
                                              tmpRect.Bottom),
                                        1);

          end;
        end;
      end;
  tmpBitmap.Canvas.EndScene;

  frmASMain.imgTileCanvas.Bitmap.Assign(tmpBitmap);
  frmASMain.lblCount.Text := IntToStr(GameController.TileManager.TileList.Count);
  tmpBitmap.Free;
end;

花火　アニメーションサンプル

コメントをどうぞ


unit untFireworks;

interface

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


type
  TFireWorksStatus = record
  private
  public
    StartX: Single;
    FireY: Single;
    FireRadius: Single;
    FireColorHue:  Single;      // -1 から 1 までの値を取る
    LauncherDelay:  Single;
    LauncherDuration:  Single;
    FireDuration:  Single;

    BallRadius: Single;
    BallCount:  Integer;
    BallBitmap: TBitmap;

    LauncherWidth: Single;
    LauncherHeight: Single;

  end;

type
  TFireworks = class
  private
    FTimer: TTimer;

    FParentImage: TImage;
    FOwner:       TComponent;

    FStatus: TFireWorksStatus;

    FLauncher:    TRectangle;
    FLauncherPositionYAnimation: TFloatAnimation;
    FLauncherBlur: TBlurEffect;


    FBall:                  Array of TCircle;
    FBallImage:             Array of TImage;
    FBallPositionAnimation: Array of TPathAnimation;
    FBallOpacityAnimation:  Array of TFloatAnimation;
    FBallHueAdjustEffect:   Array of THueAdjustEffect;

    procedure OnTimer(Sender: TObject);
    procedure OnFLauncherPositionYAnimationFinish(Sender: TObject);
    procedure OnBallOpacityAnimationFinish(Sender: TObject);

    function getScreenHeight: Single;
    function getScreenWidth: Single;

    property ScreenWidth:  Single read getScreenWidth;
    property ScreenHeight: Single read getScreenHeight;

  public

    constructor Create(aOwner: TComponent;
                              aParent: TImage;
                              aFireWorksStatus: TFireWorksStatus);
    destructor Destroy(); override;

    procedure Fire();


  end;

const
  START_POSITION_V_MARGIN  = 0.1;
  START_POSITION_H_MARGIN  = 0.1;
  FINISH_POSITION_V_MARGIN = 0.1;

implementation


{ TFireworks }

constructor TFireworks.Create(aOwner: TComponent;
                              aParent: TImage;
                              aFireWorksStatus: TFireWorksStatus);
var
  i: Integer;
  tmpRad: Single;
begin

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

  FOwner := aOwner;
  FParentImage := aParent;
  FParentImage.ClipChildren := True;

  FStatus := aFireWorksStatus;

  //
  FTimer.Interval := Round(FStatus.LauncherDelay * 1000);
  FTimer.Enabled := False;
  //
  FLauncher := TRectangle.Create(FOwner);
  FLauncher.Parent := FParentImage;
  FLauncher.Visible := False;

  FLauncherBlur := TBlurEffect.Create(FOwner);
  FLauncherBlur.Parent := FLauncher;
  FLauncherBlur.Softness := 0.1;

  with FStatus do
  begin
    FLauncherPositionYAnimation := TFloatAnimation.Create(FOwner);
    FLauncherPositionYAnimation.Parent := FLauncher;
    FLauncherPositionYAnimation.PropertyName := 'Position.Y';
    FLauncherPositionYAnimation.OnFinish  := OnFLauncherPositionYAnimationFinish;

    FLauncher.Width      := LauncherWidth;
    FLauncher.Height     := LauncherHeight;
    FLauncher.Position.X := StartX - LauncherWidth  / 2;
    FLauncher.Position.Y := Self.ScreenHeight * 0.95 - LauncherHeight / 2;

    FLauncherPositionYAnimation.StartValue := FLauncher.Position.Y;
    FLauncherPositionYAnimation.StopValue  := FireY - LauncherHeight / 2;
    FLauncherPositionYAnimation.Duration   := LauncherDuration;
    FLauncherPositionYAnimation.AnimationType := TAnimationType.atOut;
    FLauncherPositionYAnimation.Interpolation := TInterpolationType.itCubic;
  end;


  //
  SetLength(FBall,                  FStatus.BallCount);
  SetLength(FBallPositionAnimation, FStatus.BallCount);
  SetLength(FBallOpacityAnimation,  FStatus.BallCount);
  SetLength(FBallImage,             FStatus.BallCount);
  SetLength(FBallHueAdjustEffect,   FStatus.BallCount);

  for i := 0 to FStatus.BallCount - 1 do
  begin

    FBallImage[i]            := TImage.Create(FOwner);
    FBallImage[i].Parent     := FParentImage;
    FBallImage[i].Bitmap.Assign(FStatus.BallBitmap);
    FBallImage[i].Width      := FStatus.BallRadius * 2;
    FBallImage[i].Height     := FStatus.BallRadius * 2;
    FBallImage[i].Position.X := FStatus.StartX - FStatus.BallRadius;
    FBallImage[i].Position.Y := FStatus.FireY - FStatus.BallRadius;
    FBallImage[i].RotationAngle := (360 / FStatus.BallCount) * i + 90;
    FBallImage[i].Visible     := False;

    //
    FBallPositionAnimation[i] := TPathAnimation.Create(FOwner);
    FBallPositionAnimation[i].Parent := FBallImage[i];
    FBallPositionAnimation[i].Duration := FStatus.FireDuration * 0.8;
    FBallPositionAnimation[i].AnimationType := TAnimationType.atOut;
    FBallPositionAnimation[i].Interpolation := TInterpolationType.itCubic;
    FBallPositionAnimation[i].Path.Clear;
    FBallPositionAnimation[i].Path.MoveTo(PointF(0, 0));
    tmpRad := (2 * PI / FStatus.BallCount) * i;
    FBallPositionAnimation[i].Path.LineTo(PointF(Cos(tmpRad) * FStatus.FireRadius,
                                                 Sin(tmpRad) * FStatus.FireRadius));

    //
    FBallOpacityAnimation[i] :=TFloatAnimation.Create(FOwner);
    FBallOpacityAnimation[i].Parent := FBallImage[i];
    FBallOpacityAnimation[i].PropertyName := 'Opacity';
    FBallOpacityAnimation[i].Duration   := FStatus.FireDuration;
    FBallOpacityAnimation[i].StartValue := 1;
    FBallOpacityAnimation[i].StopValue  := 0.1;
    FBallOpacityAnimation[i].AnimationType := TAnimationType.atIn;
    FBallOpacityAnimation[i].Interpolation := TInterpolationType.itCubic;

    //
    FBallHueAdjustEffect[i] := THueAdjustEffect.Create(FOwner);
    FBallHueAdjustEffect[i].Parent := FBallImage[i];
    FBallHueAdjustEffect[i].Hue := FStatus.FireColorHue;

  end;

  // 代表として Index 0 を基準にする
  FBallOpacityAnimation[0].OnFinish := OnBallOpacityAnimationFinish;

end;

destructor TFireworks.Destroy;
begin
  FTimer.Free;
  inherited;
end;

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

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

procedure TFireworks.OnBallOpacityAnimationFinish(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to FStatus.BallCount - 1 do
  begin
    FBallImage[i].Visible := False;
  end;

  self.Free;
end;

procedure TFireworks.OnFLauncherPositionYAnimationFinish(Sender: TObject);
var
  i: Integer;
begin
  FLauncher.Visible := False;
  for i := 0 to FStatus.BallCount - 1 do
  begin
    FBallImage[i].Visible := True;
    FBallPositionAnimation[i].Start();
    FBallOpacityAnimation[i].Start();
  end;
end;

procedure TFireworks.OnTimer(Sender: TObject);
begin
  FLauncher.Visible := True;
  FLauncherPositionYAnimation.Start();
  FTimer.Enabled := False;
end;

procedure TFireworks.Fire;
begin
  // Start
  FTimer.Enabled := True;
end;


end.

TIniFile を使って色の保存

コメントをどうぞ



  tmpStr := tmpIni.ReadString('design', 'DesignFontColor', IntToStr(DEFAULT_DesignFontColor));
  Self.DesignFontColor   := StringToAlphaColor(tmpStr);


  tmpStr := AlphaColorToString(Self.DesignFontColor);
  tmpIni.WriteString  ('design', 'DesignFontColor', tmpStr);

Unable to locate DeviceSupport directory matched with connected device info

コメントをどうぞ

‘Unable to locate DeviceSupport directory matched with connected device info’（接続したデバイスの情報に一致する DeviceSupport ディレクトリが見つかりません）

デバイスの iOS バージョンを最近アップグレードした場合は、iOS デバイスでアプリケーションを実行しようとしたときに上記のエラーメッセージが出力される可能性があります。このメッセージが表示されたら、以下の手順を実行してください。

メッセージを閉じます。
Mac で Xcode を開きます。
［ウインドウ｜オーガナイザ］を選択し、お使いのデバイスが Xcode で認識されるかどうかを判断して、以下を行います。
デバイスが Xcode で認識される場合は、Xcode にデバイスのサポート情報をインポートし直し、RAD Studio からアプリケーションを再度実行してみます。
デバイスが Xcode で認識されない場合は、Xcode をアップグレードする必要があります。

メモ：あるいは、デバイスが Xcode で認識されないが、お使いの Mac の Xcode をアップグレードしたくないという場合には、お使いのデバイスを認識するアップグレード版の Xcode がインストールされている別の Mac にデバイスを接続してみることもできます。お使いのデバイスのサポート情報を新しいバージョンの Xcode で再度インポートしたら、古いバージョンの Xcode で、アップグレードした iOS デバイスも認識されるようになる可能性があります。

エラーメッセージ： Unable to install package

コメントをどうぞ

e8008016　は？？？

e8000018：証明書の有効期限が切れています。新しいバージョンの証明書をダウンロードします。

e800001c： iOS シミュレータが Mac 上で動作している場合は、シミュレータを終了し、アプリケーションを iOS デバイス上でもう一度実行してみます。

e800002d：お使いの iOS デバイスを再起動します。詳細については、Apple サポートコミュニティの関連スレッドを参照してください。

e800007e：お使いの iOS デバイスのバージョンが、デフォルトの最小バージョンを下回っています。［プロジェクト｜オプション…｜Delphi コンパイラ｜リンク］を選択し、［サポートされている iOS の最小バージョン］をお使いの iOS デバイスのバージョンに変更します。たとえば、5.0 などに変更します（それでもうまくいかない場合は、新しい iOS デバイスを入手しなければならない可能性があります）。

e8000080：プロジェクトに定義されている iOS フォームファクタ（UIDeviceFamily）に一致しない iOS デバイスで iOS アプリケーションを実行しようとしています。たとえば、iOS アプリケーションが iPhone でのみ動作するように構成されているにもかかわらず、そのアプリケーションを iPad で実行しようとしている場合などです。［プロジェクト｜オプション…｜バージョン情報］を選択し、お使いの iOS デバイスに一致する UIDeviceFamily キー値を選びます。たとえば、アプリケーションを任意の iOS デバイスで実行する場合は、［iPhone および iPad］を選択します。

e8008015：RAD Studio で構成したプロビジョニングプロファイルがターゲット iOS デバイスに準備されていません。構成済みのプロビジョニングプロファイルをターゲットデバイスに準備するか、RAD Studio のプロジェクト構成を別のプロビジョニングプロファイルに変更します。「［プロビジョニング］ページに必要な情報をすべて入力する」を参照してください。RAD Studio 内のプロビジョニングデータが、Mac デベロッパアカウントではなく iOS デベロッパアカウントに必ず一致するようにします。iOS デベロッパ証明書名を指定する際は、特に注意してください。

e8008018：証明書の有効期限が切れています。新しいバージョンの証明書をダウンロードします。

ListBox.Clear でエラー

コメントをどうぞ

iOS シミュレータの ListBox.Clear でエラー

  frmMain.lbxCardList.BeginUpdate;
  while frmMain.lbxCardList.Items.Count &lt;&gt; 0 do
  frmMain.lbxCardList.Items.Delete(frmMain.lbxCardList.Items.Count - 1);
  frmMain.lbxCardList.EndUpdate;

で対応

stylebook についてのメモ

コメントをどうぞ

コンポーネントをドロップするのはなぜか構造ペイン
XE4以降には「スタイルの構造を表す」ペインと「スタイルの作成」のペインが無くなっている
新規スタイルの作成は構造ペインのTStylecontainerにコンポーネントをドロップ
スタイル設計フォームで、StyleName に Tを除いたクラス名が含まれている必要がある。例えばTLabelのスタイルは、LabelBlue や BigLabel001とか。この条件を満たさないとStyleLookup プロパティコンボから選択できない。
プロパティも StyleName で識別している
データには　Item.StylesData['depth'] :=　等でアクセス
TListboxItem の Itemdata.bitmap は、TImage の Stylename を icon にして配置

http://edn.embarcadero.com/article/42832

エンバラデロのサンプルコード


//---------------------------------------------------------------------------

// This software is Copyright (c) 2012 Embarcadero Technologies, Inc.
// You may only use this software if you are an authorized licensee
// of Delphi, C++Builder or RAD Studio (Embarcadero Products).
// This software is considered a Redistributable as defined under
// the software license agreement that comes with the Embarcadero Products
// and is subject to that software license agreement.

//---------------------------------------------------------------------------
unit customlistfrm;

interface

uses
  System.SysUtils, System.Variants, System.Classes, System.Types, System.UITypes,
  System.Rtti, FMX.Forms, FMX.Dialogs, FMX.Types, FMX.Layouts, FMX.Styles, FMX.StdCtrls,
  FMX.ListBox, FMX.Objects, FMX.Controls, FMX.Edit, FMX.Effects;

type
  TfrmCustomList = class(TForm)
    ListBox1: TListBox;
    Resources1: TStyleBook;
    OpenDialog1: TOpenDialog;
    InfoLabel: TLabel;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox1Change(Sender: TObject);
  private
    { Private declarations }
    procedure DoInfoClick(Sender: TObject);
    procedure DoVisibleChange(Sender: TObject);
  public
    { Public declarations }
  end;

var
  frmCustomList: TfrmCustomList;

implementation

{$R *.fmx}

procedure TfrmCustomList.Button1Click(Sender: TObject);
var
  Item: TListBoxItem;
  I: Integer;
begin
  OpenDialog1.Filter := TBitmapCodecManager.GetFilterString;
  if OpenDialog1.Execute then
  begin
    // create item and save file name in the tag
    for I := 0 to OpenDialog1.Files.Count - 1 do
    begin
      Item := TListBoxItem.Create(nil);
      Item.Parent := ListBox1;
      Item.TagString := OpenDialog1.Files[I];
      Item.StyleLookup := 'CustomItem';
      Item.Text := OpenDialog1.Files[i]; // set filename
      Item.StylesData['icon'] := OpenDialog1.Files[i];
      Item.StylesData['resolution'] := '1024x768 px'; // set size
      Item.StylesData['depth'] := '32 bit';
      Item.StylesData['visible'] := true; // set Checkbox value
      Item.StylesData['visible.OnChange'] := TValue.From(DoVisibleChange); // set OnChange value
      Item.StylesData['info.OnClick'] := TValue.From(DoInfoClick); // set OnClick value
    end;
    Caption := IntToStr(ListBox1.Count) + ' items';
  end;
end;

procedure TfrmCustomList.Button2Click(Sender: TObject);
var
  Item: TListBoxItem;
begin
  // create custom item
  Item := TListBoxItem.Create(nil);
  Item.Parent := ListBox1;
  Item.StyleLookup := 'CustomItem';
  Item.Text := 'item ' + IntToStr(Item.Index); // set filename
  if Odd(Item.Index) then
    Item.ItemData.Bitmap := Image1.Bitmap // set thumbnail
  else
    Item.ItemData.Bitmap := Image2.Bitmap; // set thumbnail
  Item.StylesData['resolution'] := '1024x768 px'; // set size
  Item.StylesData['depth'] := '32 bit';
  Item.StylesData['visible'] := true; // set Checkbox value
  Item.StylesData['visible.OnChange'] := TValue.From(DoVisibleChange); // set OnChange value
  Item.StylesData['info.OnClick'] := TValue.From(DoInfoClick); // set OnClick value
end;

procedure TfrmCustomList.DoInfoClick(Sender: TObject);
begin
  InfoLabel.Text := 'Info Button click on ' + IntToStr(ListBox1.ItemIndex) + ' listbox item';
end;

procedure TfrmCustomList.DoVisibleChange(Sender: TObject);
begin
  InfoLabel.Text := 'Checkbox changed ' + IntToStr(ListBox1.ItemIndex) + ' listbox item to ' + BoolToStr(Listbox1.Selected.StylesData['visible'].AsBoolean, true);
end;

procedure TfrmCustomList.Button3Click(Sender: TObject);
var
  i: integer;
begin
  ListBox1.BeginUpdate;
  for i := 1 to 1000 do
    Button2Click(Sender);
  ListBox1.EndUpdate;

  Caption := IntToStr(ListBox1.Count) + ' items';
end;

procedure TfrmCustomList.CheckBox1Change(Sender: TObject);
begin
  ListBox1.AllowDrag := CheckBox1.IsChecked;
end;

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アプリを開発・公開するまでの過程を実況するサイト

作成者別アーカイブ: kawabata

FireDAC のチュートリアル

独自イベントの実装

ブラウザでWebサイトを開く

メッセージのまとめ

ツールチップ　ポップアップヘルプ

ヘルプフォーム

アニメーションのまとめ

コントロールをドラッグして移動する

TTMSFMXGrid についてのメモ

固定セルだけセンタリング

アンチウィルスソフト（カスペルスキー）で

スコアマネージャー

アニメーションに関するまとめ

ファイルシステム関数

CopyFromBitmap, DrawBitmap がうまくいなないので

花火　アニメーションサンプル

TIniFile を使って色の保存

Unable to locate DeviceSupport directory matched with connected device info

エラーメッセージ： Unable to install package

ListBox.Clear でエラー

stylebook についてのメモ