• Assign
• 型
• volatile
• 列挙型
• 集合
• 構造体,Record
• Generics
  • 定義の例
  • 使い方例
• System.Generics.Collections
  • TDictionaryで列挙してみる
  • ソートTArray.Sort
  • ソートTObjectList.Sort
    • 比較するクラスを作る
    • 無名メソッド版1
    • 無名メソッド版2
• インライン変数
• デフォルトパラメータ
• 仮想メソッドと動的メソッド
• 静的クラスメソッド
• 手続き・関数・メソッド
• オーバーライドと隠蔽
• 抽象メソッド
• クラスフィールド
• メッセージ
• インターフェース
  • インターフェースを用いたSingletonの実装
• TImage画像読み込み
• PNG読み込み
• GDI+
  • GDI+DelphiXE2
  • GDI+Delphi2009
• 配列
  • 配列の型宣言
  • 動的配列の要素数
    • 要素数取得の例1
    • 要素数取得の例2
  • 動的配列の引数渡し
  • 多次元動的配列
  • 動的メモリ
  • AllocMemとGetMem
  • ポインタが指すメモリの初期化
  • TMemoryStream
  • TByteArray
  • フィル
  • コピー
    • move例1
    • move例2
  • 配列のバイナリファイル書き込み
  • スタックサイズ
• 文字列・バイト配列
  • 文字(配列)操作
  • 文字列からバイト配列(ANSI)に変換 DelphiXE7
  • バイト配列(ANSI)から文字列に変換 DelphiXE7
  • 文字列からバイト列に変換 Delphi2010
  • TBytesからStringに変換 DelphiXE10.1
  • バイト配列からStringに変換 Delphi2010
    • 例1
    • 例2
  • Pointerからstringに変換 Delphi2010
  • 静的配列からstringに変換 Delphi10.1Seatle
  • 文字列を数値に変換する
  • 文字列処理とUnicode(Delphi2009以降)
• 数値文字列変換
• 文字列処理
  • 指定文字で分割
  • 比較
  • 検索
  • 切り出し
  • 置換
  • 正規表現
    • 正規表現 検索
    • 正規表現 置換
  • 文字列の繰り返し
  • CSV
    • TSTringList.CommaText
    • SplitString
• BCD
• 初期化 initialization
• 終了時実行 finalization
• ラベルとgoto
• プロパティで配列
• プロパティで関数
• 例外
  • デフォルト例外処理
• 浮動小数点(double,float)を文字列に変換
• 日付時刻
  • TDateTimeを年月日時分秒ミリ秒に分解
  • 文字列から日付時刻を生成
  • EncodeDateTime 年月日から日付時刻を生成
  • DateTimeToStr 日付時刻を文字列に変換
  • DateTimeToString 日付時刻を文字列に変換
  • TDateTimeから曜日を取得
  • TDateTime演算
  • TDateTime置き換え
  • ファイルの日付取得
• ファイル読み書き
• ファイル読み書き TFileStream,ファイルサイズ,共有モード
  • read
    • GetMemして読み込み
    • 配列に読み込み
    • record(構造体)に読み込み
  • 注意点
  • write
    • 配列(array of Byte)をファイルに保存
    • 配列(array of UInt16)をファイルに保存
    • 配列(TByteArray)をファイルに保存
    • Pointerで示しているバッファをファイルに保存
    • PCharのバッファをファイルに保存
• ファイル読み書き TextFile,AssignFile,Append,WriteLn,CloseFile
• テキストファイルから行読み込み TStreamReader
• ファイル操作
  • ファイルコピー
• ZIPファイル
• TImage上でマウスドラッグ
• マウスボタン
• グローバルマウスフック
• グローバルキーフック
• TChart(TeeChart)
  • サンプルソース
  • サンプルソース2
  • TChartのヘルプ
  • TChartの情報
  • シリーズ動的生成
  • シリーズの名前
  • Legendsのチェックボックス
  • PointerのStyle
  • 棒グラフ
  • 縦右軸を使う(ソース)
  • 縦右軸を使う(IDE)
  • TCharHelperの使い方
  • スクロールするグラフ
  • TChartの画面をpngに保存する
  • TChartの画面自動更新を止めて、描画速度を上げる
  • TChartのX軸を90度回転して日付時刻にする
• 終了コード
• 別のexe実行
  • ShellExecute
  • ShellExecuteEX
  • CreateProcess
• エクスプローラからドラッグドロップ
  • FMXコンポーネントのTDropTarget
  • コードでドロップ受け入れ
• コンポーネントを動的に生成
• タスクバーに表示しない
• 環境変数
• タイトルバーの無いフォームの移動(WM_NCHITTEST)
• TListView
  • 選択されたアイテムを取得する方法。
• TListを継承して独自のリストを作成。ついでにソートもしてみる。
  • 実装
  • 使い方
• Indy
  • UDPテキスト通信例
  • UDPバイナリ通信例
  • UDPバイナリ通信例2
  • TCP通信例
  • TCPとUDPの通信例
  • Indy10 IdFTP
  • TIdHTTPServer.AutoSession
  • TIdTCPServer.OnExecuteでポート番号
  • TIdTCPServerの接続数
  • iOS,Indy,XML
  • TIdHttpServer
  • Indy.TIdHttpでSSL通信が失敗する
• コンポーネントのインストール方法
• インストール
  • Delphi2007
• glyFXはどこー？
• グローバル変数、ローカルな変数
• 色定数
• KeyPressイベント
• DLL
• DLL呼び出し
• DLLの遅延ロード
• ディレクトリ選択ダイアログ
• 第16回エンバカデロ・デベロッパーキャンプ
• 文字列処理とエンコーディング
  • Delphi2010での文字列処理
  • UTF-8エンコーディング指定して保存。BOM無し。
• TStringGrid
• 表示が従来と違う。サンプル例とかと違う。
• 値が変更できない、Edit出来ない
• 選択範囲の取得
• TColorとRGB
• ダイアログ XE10.1
• 乱数
• DUnit
• TFlowPanel
• Formの重なり順序
• ファイル名操作
• ファイルとフォルダの有無確認
• ファイルの列挙
• ディレクトリ操作
• パス取得
• 時間を計るTStopWatch
  • msec単位で計測
  • 高解像度で計測
• 便利なTStringList
• Editでキーイベント
• スレッド
  • 無名メソッドとスレッド
  • TAnonymousThread
    • TAnonymouseThread.Startの例
  • スレッドの同期
    • 名前付きイベントを使ったスレッド例
    • 名前付きイベント発行例
  • クリティカルセクション
  • SynchronizeとQueue
  • スレッドの終了処理でリーク
  • スレッドの終了処理
  • スレッド間データ受け渡し
  • スレッド同期
  • TThread,TThreadedQueueサンプル
  • TThread,TQueueサンプル
• デバッグ出力
• TActionList
  • 別フォームのActionを使う
• コンパイラ指令
• ソースコードの折りたたみ
• ショートカットキー
  • ソース整形,フォーマッタ
  • カーソル位置のクラス宣言補完(コード生成)
  • 同期編集(リファクタリングより軽くて便利)
• OSXで動的読み込み可能ライブラリ(dylib)を遅延読み込みできない
• DeleteFileでワーニング
• タイプライブラリの取り込み
• JSONを使う
• リモートデバッグ(paserver)
  • paserverのインストール
  • paserverの実行
  • 接続プロファイルの作成
  • アプリケーションの配置
  • リモートデバッグからもとに戻す
• メモリリーク検出
  • FastMM Delphi11 + FastMM-4993
    • 手順
  • FastMM DelphiXE6 + FastMM-4991
    • リークの検出(Delphi2006以降)
    • リークの検出方法(詳細)
  • メモリリーク検出(Delphi200x)
• DLL,dylibをダイナミックロード
• キー入力の仮想キーコード
• マウスカーソルを隠す(非表示)
• Canvas.FillRect
• Canvas.CopyRect
• TRectの当たり判定とか演算
• 32bitのOSで印刷出来ない
• GUIDの生成
• コードの折りたたみ
• ブレークポイントがずれる
• なんか例外出る0xFEEEFEEE
• リソースからファイル読み込み
• バージョン管理対象
• EurekaLog
  • EurekaLogでスレッド
• DelphiとPython
• 出力ディレクトリの指定
• 高DPI対応
• リンク

volatile 属性は、別のスレッドにより変更される可能性があるフィールドにマークを付けて、そのフィールドの値をレジスタまたは別の一時メモリ領域にコピーする操作がコード生成の際に最適化されないようにするために使用されます。

type
 TMyClass = class(TObject)
 private
 [volatile] count:integer;
 end;

type
  TGohan = (ghAsaGohan,ghHiruGohan,ghBanGohan);

type
  TGohan = set of (ghAsaGohan,ghHiruGohan,ghBanGohan);

 if ghAsaGohan in gohan then
   nattou.mazemaze;

  Grid.Options := Grid.Options + [goEditing];

 type
   PNS_HEAD = ^NOTE_TO_SH;
   NOTE_TO_SH = record
     lMitei2Size:Longint;
     lVerUpStartAddress:Longword;
     cYobi:array[0..31] of char;
   end;

 type
   TIxSerial = record
     Used: boolean;
     Value: UInt64;
   end;

 function IxSerial(val: UInt64; Used: boolean): TIxSerial;
 begin
   Result.Value := val;
   Result.Used := Used;
 end;

type
  TIxBuffer<T> = class(TObject)
  protected
    FValue: T;
  public
    procedure Push(Value: T);
    function Pop: T;
  end;

function TIxBuffer<T>.Pop: T;
begin
  Result := FValue;
end;

procedure TIxBuffer<T>.Push(Value: T);
begin
  FValue := Value;
end;

var
  buf_str: TIxBuffer<string>;
  buf_int: TIxBuffer<integer>;
begin
  buf_str := TIxBuffer<string>.Create;
  try
    buf_str.Push('abcd');
    memo(buf_str.Pop);
  finally
    buf_str.Free;
  end;

  buf_int := TIxBuffer<integer>.Create;
  try
    buf_int.Push(10);
    memo(buf_int.Pop.toString);
  finally
    buf_int.Free;
  end;

end;

• TThreadedQueue 受け渡しにロック操作不要
• TThreadList 追加・削除にロック操作不要、Listアクセス時ロック

uses Generics.Collections;
var
  MemoQueue: TThreadedQueue<string>;
begin
  MemoQueue := TThreadedQueue<string>.Create(100, 1, 1);//キュー深さ、Pushタイムアウト、Popタイムアウト。タイムアウト指定無しはタイムアウト無しになる。

 MemoQueue.PushItem('hello');

//別スレッド
var
  str:string;
begin
  if MemoQueue.PopItem(str)=wrSignaled then
    Memo1.Lines.Add(str);//wrSignaledの時str有効。タイムアウト時間はCreate時指定。

uses Generics.Collections;
var
 xlist:TList<integer>;
begin
 xlist:=TList<integer>.Craete;
 try
   xlist.Add(1);
   xlist.Add(2);
   xlist.Add(3);
   for i=0 to xlist.Count-1 do
   begin
     memo(StrToInt(xlist[i]))
   end;
 finally
   xlist.Free;
 end;

var
  pairs: TDictionary<string, integer>;
  val: TPair<string, integer>;
  i:integer;
begin
  pairs := TDictionary<string, integer>.Create;
  pairs.Add('name1', 10);
  pairs.Add('name2', 220);
  pairs.Add('name3', 11);
  pairs.Add('name4', 310);

  //ペアの列挙
  for val in pairs do
    memo(val.Key + '=' + IntToStr(val.Value));

  //値の列挙
  for i in pairs.Values do
    memo(IntToStr(i));
end;

uses System.Generics.Collections, System.Generics.Defaults;

type
  TPointFComparer = class(TComparer<TPointF>)
  public
    function Compare(const Left, Right: TPointF): Integer; override;
  end;

function TPointFComparer.Compare(const Left, Right: TPointF): Integer;
begin
  if Left.X < Right.X then
    Result := -1
  else if Left.X > Right.X then
    Result := +1
  else if Left.Y < Right.Y then
    Result := -1
  else if Left.Y > Right.Y then
    Result := +1
  else
    Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  pt: TPointF;
  arr: array of TPointF;
begin
  // -----------------------------------------
  // init
  // -----------------------------------------
  Randomize;

  SetLength(arr, 10);
  for i := Low(arr) to High(arr) do
  begin
    arr[i].X := Random(100);
    arr[i].Y := Random(100);
  end;

  // -----------------------------------------
  // show
  // -----------------------------------------
  ListBox1.Clear;
  for pt in arr do
  begin
    ListBox1.Items.Add(FloatToStr(pt.X) + ' ' + FloatToStr(pt.Y));
  end;

  // -----------------------------------------
  // sort
  // -----------------------------------------
  TArray.Sort<TPointF>(arr, TPointFComparer.Create);

  // -----------------------------------------
  // show
  // -----------------------------------------
  ListBox2.Clear;
  for pt in arr do
  begin
    ListBox2.Items.Add(FloatToStr(pt.X) + ' ' + FloatToStr(pt.Y));
  end;

end;

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo,
  Generics.Collections, Generics.Defaults;

type
  TIxPoint = class(TObject)
  public
    Text: string;
    X: Single;
    Y: Single;
  end;

type
  TIxPointComparer = class(TComparer<TIxPoint>)
  public
    function Compare(const Left, Right: TIxPoint): Integer; override;
  end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function TIxPointComparer.Compare(const Left, Right: TIxPoint): Integer;
begin
    Result := Round(Left.Text.ToSingle - Right.Text.ToSingle);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  objlist: TObjectList<TIxPoint>;
  obj: TIxPoint;
begin
  objlist := TObjectList<TIxPoint>.Create;
  try
    obj := TIxPoint.Create;
    obj.Text := '2';
    objlist.Add(obj);

    obj := TIxPoint.Create;
    obj.Text := '3';
    objlist.Add(obj);

    obj := TIxPoint.Create;
    obj.Text := '1';
    objlist.Add(obj);

    Memo1.Lines.Add('---- before sort ----');
    for obj in objlist do
    begin
      Memo1.Lines.Add(obj.Text);
    end;

    objlist.Sort(TIxPointComparer.Create);

    Memo1.Lines.Add('---- after sort ----');
    for obj in objlist do
    begin
      Memo1.Lines.Add(obj.Text);
    end;

  finally
    objlist.Free;
  end;

end;

end.

    objlist.Sort(TComparer<TIxPoint>.Construct(
      function(const Item1, Item2: TIxPoint): Integer
      begin
        Result := Round(Item1.Text.ToSingle - Item2.Text.ToSingle);
      end));

type
  TIxItem = class(TObject)
  public
    Value: Integer;
  end;

uses System.Generics.Collections;

procedure TForm1.Button1Click(Sender: TObject);
var
  objlst: TObjectList<TIxItem>;
  item: TIxItem;
begin
  // 生成
  objlst := TObjectList<TIxItem>.Create;
  try
    for var i := 0 to 5 do
    begin
      item := TIxItem.Create;
      item.Value := Round(Random(100));
      objlst.Add(item);
    end;

    // ソート前
    Memo1.Lines.Add('before sort.');
    for item in objlst do
    begin
      Memo1.Lines.Add(item.Value.ToString);
    end;

    // ソート
    objlst.Sort(System.Generics.Defaults.TComparer<TIxItem>.Construct(
      function(const L, R: TIxItem): Integer
      begin
        if L.Value = R.Value then
          Result := 0
        else if L.Value < R.Value then
          Result := -1
        else
          Result := 1;
      end));

    // ソート後
    Memo1.Lines.Add('after sort.');
    for item in objlst do
    begin
      Memo1.Lines.Add(item.Value.ToString);
    end;

  finally
    objlst.Free;
  end;
end;

 for var i:=0 to 3 do

 procedure FillArray(A: array of Integer; Value: Integer = 0);

 program OverrideRedeclared;

 {$APPTYPE CONSOLE}
 {$R *.res}

 uses
   System.SysUtils;

 const
   CRLF = #13#10;

 type
   T1 = class(TObject)
     procedure Act; virtual;
   end;

   T2 = class(T1)
     procedure Act; // Act is redeclared, but not overridden
   end;

   T3 = class(T1)
     procedure Act; override; // Act is redeclared, overridden
   end;

 procedure std_out(str: string);
 begin
   write(str + CRLF);
 end;

 var
   SomeObject1: T1;
   SomeObject2: T2;

 procedure T1.Act;
 begin
   std_out('T1.Act');
 end;

 procedure T2.Act;
 begin
   std_out('T2.Act');
 end;

 procedure T3.Act;
 begin
   std_out('T3.Act');
 end;

 begin
   try
     SomeObject1 := T2.Create;
     try
       SomeObject1.Act; // calls T1.Act
     finally
       SomeObject1.Free;
     end;

     SomeObject2 := T2.Create;
     try
       SomeObject2.Act; // calls T2.Act
     finally
       SomeObject2.Free;
     end;

     SomeObject1 := T3.Create;
     try
       SomeObject1.Act; // calls T3.Act
     finally
       SomeObject1.Free;
     end;


   except
     on E: Exception do
       Writeln(E.ClassName, ': ', E.Message);
   end;

 end.

procedure DoSomething; virtual; abstract;

type TMyClass = class(TObject)
  public
    class var//静的クラスフィールドのブロック開始
      Top:Integer;
      Bottom:Integer;
    var//ブロック終了
    end;

uses System.Messaging;
var
  SubscriptionId: Integer;
    MessageManager: TMessageManager;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MessageManager := TMessageManager.DefaultManager;

  SubscriptionId := MessageManager.SubscribeToMessage(TMessage<UnicodeString>,
    procedure(const Sender: TObject; const M: TMessage)
    begin
      ShowMessage((M as TMessage<UnicodeString>).Value);
    end);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MessageManager.Unsubscribe(TMessage<UnicodeString>,SubscriptionId);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  msg: TMessage<UnicodeString>;
begin
  MessageManager := TMessageManager.DefaultManager;
  msg := TMessage<UnicodeString>.Create('This is a string message.');
  MessageManager.SendMessage(Sender, msg, True);
end;

uses PngImage;
var
  png: TPngImage;
  ext: string;
begin
  ext := ExtractFileExt(opt_src_fname);
  if ext = '.bmp' then
  begin
    bmp_src.LoadFromFile(opt_src_fname);
  end
  else if ext = '.png' then
  begin
    png := TPngImage.Create;
    try
      png.LoadFromFile(opt_src_fname);
      bmp_src.SetSize(png.Width, png.Height);
      bmp_src.Canvas.Draw(0, 0, png);
    finally
      png.Free;
    end;
  end;

implementation

uses GDIPAPI, GDIPOBJ;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  grp: TGPGraphics;
  img: TGPImage;
  rct: TGPRect;
  ratio: double;
begin
  if OpenPictureDialog1.Execute then
  begin
    grp := TGPGraphics.Create(Image1.Canvas.Handle);
    img := TGPImage.Create(OpenPictureDialog1.FileName);
    try
      ratio := img.GetWidth / img.GetHeight;
      rct := MakeRect(0, 0, Trunc(Image1.Height * ratio), Image1.Height);
      grp.DrawImage(img, rct);
    finally
      grp.Free;
      img.Free;
    end;
  end;
end;

type TByteArray = array [0..32767] of Byte;

  TArray<T> = array of T;

var
  colors: array of TColor;
  i: integer;
begin
  SetLength(colors, 5);
  Memo1.Lines.Add('High(colors)=' + IntToStr(High(colors)));

High(colors)=4

var
  buf1: array [0 .. 9] of Byte;
  buf2: array [0 .. 9] of Word;
  buf3:array of Byte;
  buf4:array of Word;
begin
  SetLength(buf3,10);
  SetLength(buf4,10);
  memo('SizeOf(buf1)='+IntToStr(SizeOf(buf1)));
  memo('SizeOf(buf2)='+IntToStr(SizeOf(buf2)));
  memo('SizeOf(buf3)='+IntToStr(SizeOf(buf3)));
  memo('SizeOf(buf4)='+IntToStr(SizeOf(buf4)));
  memo('Length(buf1)='+IntToStr(Length(buf1)));
  memo('Length(buf2)='+IntToStr(Length(buf2)));
  memo('Length(buf3)='+IntToStr(Length(buf3)));
  memo('Length(buf4)='+IntToStr(Length(buf4)));
end;

SizeOf(buf1)=10
SizeOf(buf2)=20
SizeOf(buf3)=4
SizeOf(buf4)=4
Length(buf1)=10
Length(buf2)=10
Length(buf3)=10
Length(buf4)=10

procedure TForm1.test3;
var
  buffer: TBytes;
begin
  SetLength(buffer, 8);
  Memo1.Lines.Add('array of bytes : High(buffer)=' + IntToStr(High(buffer)));
  func_set_len(buffer);
  Memo1.Lines.Add('array of bytes : High(buffer)=' + IntToStr(High(buffer)));
end;

procedure TForm1.func_set_len(var buf: TBytes);
begin
  SetLength(buf, 16);
end;

array of bytes : High(buffer)=7
array of bytes : High(buffer)=15

 const
   SIZEH = 3;
   SIZEW = 8;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   arr1: array [0 .. SIZEH - 1] of array [0 .. SIZEW - 1] of integer;
   arr2: array of array of integer;
   i, j, k: integer;
   str: string;
 begin
   SetLength(arr2, SIZEH, SIZEW);
   //(
   //  (0,1,2,3,4,5,6,7),
   //  (0,1,2,3,4,5,6,7),
   //  (0,1,2,3,4,5,6,7)
   //)

   k := 0;
   for i := 0 to SIZEH - 1 do
   begin
     for j := 0 to SIZEW - 1 do
     begin
       arr1[i, j] := k;
       arr2[i, j] := k;
       inc(k);
     end;
   end;

   for i := 0 to SIZEH - 1 do
   begin
     str := '';
     for j := 0 to SIZEW - 1 do
     begin
       str := str + ' ' + IntToStr(arr2[i, j]);
     end;
     memo(str);
   end;

var
ptr:pointer;
begin
  try
    ptr:=GetMemory(600*1024*1024); //600MBytes!!
  finally
    FreeMemory(ptr);
  end;

メモ：  GetMemory は、GetMem の C++ 互換バージョンです。

var
 ptr:PByte;
 ms:TMemoryStream;
begin
 ms:=TMemoryStream.Create;
 ms.SetSize(256);
 ptr:=ms.Memory;
 ms.Free;

type TByteArray = array [0..32767] of Byte;

  FillChar(m_Buffer^,total_size,$FF);

 FillChar(Buffer[0],total_size,$FF);
 FillChar(Buffer[0],Length(Buffer),$FF);
 FillChar(PByte(Buffer)^,Length(Buffer),$FF);//これでもいける

var
src:TBytes;
dst:TBytes;
begin
dst := Copy(src);//動的配列はIndex,Size指定いらない

SysUtils.StrLCopy(Dest,Source,MaxLen)

 procedure Move(const Source; var Dest; Count: Integer);

 procedure TForm1.Button1Click(Sender: TObject);
 var
   Buffer: array of Byte;
   src_ptr,dst_ptr:PByte;
   i: integer;
 begin
   SetLength(Buffer, 256);
   for i := 0 to Length(Buffer) - 1 do
     Buffer[i] := i;

   memo('before');
   for i := 0 to 10 - 1 do
   begin
     memo(IntToStr(i) + '=' + IntToStr(Buffer[i]));
   end;

   src_ptr:=PByte(Buffer);
   dst_ptr:=PByte(Buffer);
   inc(src_ptr,4);
   Move(src_ptr^, dst_ptr^, 3);

   memo('after');
   for i := 0 to 10 - 1 do
   begin
     memo(IntToStr(i) + '=' + IntToStr(Buffer[i]));
   end;

   Move(Buffer[7], Buffer[0], 3);

   memo('after2');
   for i := 0 to 10 - 1 do
   begin
     memo(IntToStr(i) + '=' + IntToStr(Buffer[i]));
   end;
 end;

 before
 0=0
 1=1
 2=2
 3=3
 4=4
 5=5
 6=6
 7=7
 8=8
 9=9
 after
 0=4
 1=5
 2=6
 3=3
 4=4
 5=5
 6=6
 7=7
 8=8
 9=9
 after2
 0=7
 1=8
 2=9
 3=3
 4=4
 5=5
 6=6
 7=7
 8=8
 9=9

procedure TForm1.Button2Click(Sender: TObject);
var
  buf1: array of Byte;
  buf2: array of Byte;
  i: integer;
begin
  SetLength(buf1, 8);
  SetLength(buf2, 8);

  for i := 0 to High(buf1) do
    buf1[i] := i;

  for i := 0 to High(buf2) do
    buf2[i] := 0;

  memo('--- before ---');
  for i := 0 to High(buf1) do
    memo('buf1[' + IntToStr(i) + ']=' + IntToStr(buf1[i]));

  for i := 0 to High(buf2) do
    memo('buf2[' + IntToStr(i) + ']=' + IntToStr(buf2[i]));

  Move(PByte(buf1)^, PByte(buf2)^, Length(buf1));

  memo('--- after ---');
  for i := 0 to High(buf1) do
    memo('buf1[' + IntToStr(i) + ']=' + IntToStr(buf1[i]));

  for i := 0 to High(buf2) do
    memo('buf2[' + IntToStr(i) + ']=' + IntToStr(buf2[i]));
end;

--- before ---
buf1[0]=0
buf1[1]=1
buf1[2]=2
buf1[3]=3
buf1[4]=4
buf1[5]=5
buf1[6]=6
buf1[7]=7
buf2[0]=0
buf2[1]=0
buf2[2]=0
buf2[3]=0
buf2[4]=0
buf2[5]=0
buf2[6]=0
buf2[7]=0
--- after ---
buf1[0]=0
buf1[1]=1
buf1[2]=2
buf1[3]=3
buf1[4]=4
buf1[5]=5
buf1[6]=6
buf1[7]=7
buf2[0]=0
buf2[1]=1
buf2[2]=2
buf2[3]=3
buf2[4]=4
buf2[5]=5
buf2[6]=6
buf2[7]=7

var
  barr: TByteArray;
  darr: array of Integer;
  ms: TMemoryStream;
  fs: TFileStream;
  wptr: PWord;
begin
fs := TFileStream.Create('test.bin', fmCreate);
try

  barr[0] := 1;
  barr[1] := 2;
  barr[2] := 3;
  barr[3] := 4;
  fs.Write(barr, 4);

  SetLength(darr, 4);
  darr[0] := $12345670 + 1;
  darr[1] := $12345670 + 2;
  darr[2] := $12345670 + 3;
  darr[3] := $12345670 + 4;
  fs.Write(@darr[0], 4 * sizeof(Integer));//バッファがTBytesの時は変数名をそのまま書く

  ms := TMemoryStream.Create;
  try
    ms.SetSize(4 * sizeof(Word));
    wptr := ms.Memory;
    wptr^ := $89A0+ 1;
    inc(wptr);
    wptr^ := $89A0 + 2;
    inc(wptr);
    wptr^ := $89A0 + 3;
    inc(wptr);
    wptr^ := $89A0 + 4;
    fs.Write(ms.Memory, ms.Size)
  finally
    ms.Free;
  end;

finally
  fs.Free;
end;

{$M minstacksize,maxstacksize} {$MINSTACKSIZE number} {$MAXSTACKSIZE number}
{$M 16384,1048576}

FillChar
Move

procedure TForm1.btnStringStreamDecodeClick(Sender: TObject);
var
  ss: TStringStream;
  i: integer;
  ptr: PByte;
 begin
  ss:=TStringStream.Create('012', TEncoding.ANSI);
  try
    ptr := ss.Memory;
    for i := 0 to ss.Size - 1 do
    begin
      Memo1.Lines.Add('$' + IntToHex(ptr^, 2));
      inc(ptr);
    end;

  finally
    ss.Free;
  end;
end;

procedure TForm1.btnStringStreamEncodeClick(Sender: TObject);
var
  ss: TStringStream;
  arr: array of Byte;
begin
  SetLength(arr, 9);
  arr[0] := $82;
  arr[1] := $A0;
  arr[2] := $82;
  arr[3] := $A2;
  arr[4] := $82;
  arr[5] := $A4;
  arr[6] := $30;
  arr[7] := $31;
  arr[8] := $32;

  ss := TStringStream.Create('', TEncoding.ANSI);
  try
    ss.WriteData(arr, High(arr) + 1);
    Memo1.Lines.Add(ss.DataString);
  finally
    ss.Free;
  end;
end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   static_arr: array [0 .. 12] of Byte;
   dyn_arr: array of Byte;
   buffer: PByte;
   str: string;
   procedure dump(ptr: PByte; len: integer);
   var
     i: integer;
     tmp: string;
   begin
     tmp := '';
     for i := 0 to len - 1 do
     begin
       tmp := tmp + IntToHex(ptr^, 2) + ' ';
       inc(ptr);
     end;
     Memo1.Lines.Add(tmp)
   end;

 begin
   // -----------------------------------------
   Memo1.Lines.Add('文字列をバイト列に変換(静的配列)');
   Memo1.Lines.Add('Length(static_arr)=' + IntToStr(Length(static_arr)));
   str := '01234567';
   Memo1.Lines.Add(str);
   FillChar(static_arr, sizeof(static_arr), 1);
   dump(@static_arr, sizeof(static_arr));
   StrLCopy(PAnsiChar(@static_arr), PAnsiChar(AnsiString(str)), Length(static_arr) - 1); // ok
   dump(@static_arr, sizeof(static_arr));

   // -----------------------------------------
   Memo1.Lines.Add('文字列をバイト列に変換(動的配列)');
   str := '76543210';
   Memo1.Lines.Add(str);
   SetLength(dyn_arr, 16);
   Memo1.Lines.Add('Length(dyn_arr)=' + IntToStr(Length(dyn_arr)));
   FillChar(dyn_arr[0], Length(dyn_arr), 2);
   dump(PByte(dyn_arr), Length(dyn_arr));
   StrLCopy(PAnsiChar(dyn_arr), PAnsiChar(AnsiString(str)), Length(dyn_arr) - 1);
   dump(PByte(dyn_arr), Length(dyn_arr));

   // -----------------------------------------
   Memo1.Lines.Add('文字列をバイト列に変換(動的メモリ)');
   buffer := GetMemory(20);
   try
     str := '01234567';
     Memo1.Lines.Add(str);
     FillChar(buffer^, 20, 3);
     dump(PByte(buffer), 20);
     StrLCopy(PAnsiChar(buffer), PAnsiChar(AnsiString(str)), 22 - 1);
     dump(PByte(buffer), 20);

   finally
     FreeMemory(buffer);
   end;

 end;

 Memo1
 文字列をバイト列に変換(静的配列)
 Length(static_arr)=13
 01234567
 01 01 01 01 01 01 01 01 01 01 01 01 01
 30 31 32 33 34 35 36 37 00 01 01 01 01
 文字列をバイト列に変換(動的配列)
 76543210
 Length(dyn_arr)=16
 02 02 02 02 02 02 02 02 02 02 02 02 02 02 02 02
 37 36 35 34 33 32 31 30 00 02 02 02 02 02 02 02
 文字列をバイト列に変換(動的メモリ)
 01234567
 03 03 03 03 03 03 03 03 03 03 03 03 03 03 03 03 03 03 03 03
 30 31 32 33 34 35 36 37 00 03 03 03 03 03 03 03 03 03 03 03

var
  strarr: TBytes;
  str: string;
begin
  SetLength(strarr, 8);
  strarr[0] := $30;
      str := TEncoding.ANSI.GetString(strarr, 0, 1);

var
byte_buf:array[0..15]of Byte;
begin
  byte_buf[bytebuf_wr]:=0;//ヌル終端
  str:=String(PAnsiChar(@byte_buf));

 var
 static_arr:array [0..8] of Byte;
 begin
   StrLCopy(@static_arr,AnsiString('1234'),Length(static_arr)-1);
   Memo1.Lines.Add(String(PAnsiChar(@static_arr)));
   Memo1.Lines.Add(String(PAnsiChar(@static_arr[1])));
 end;

1234
234

var
buf:Pointer;
ptr:PByte;
begin
  buf:=AllocMem(16);//AllocMemは領域を0クリアする
  try
    ptr:=PByte(buf);
    ptr^:=$30;
    inc(ptr);
    ptr^:=$31;
    Memo1.Lines.Add(string(PAnsiChar(buf)));
  finally
    FreeMem(buf);
  end;

var
  serialnumber_buf: array [0 .. 63] of AnsiChar;
  FillChar(serialnumber_buf[0], 64, 0);

 serialnumber_buf[0]:=適当な値
 serialnumber_buf[1]:=適当な値

SerialNumber := String(AnsiString(serialnumber_buf));

 procedure TForm1.btnAnsiCharClick(Sender: TObject);
 var
 arr:array [0..2] of AnsiChar;
 str:String;
 begin
   arr[0]:=AnsiChar($82);
   arr[1]:=AnsiChar($A0);
   arr[2]:=AnsiChar(0);
   str:=arr;
   Memo1.Lines.Add('AnsiChar配列に「あ」$82$A0を入れた場合');
   Memo1.Lines.Add(str);
 end;

 procedure TForm1.btnCharClick(Sender: TObject);
 var
 arr:array [0..2] of Char;
 str:String;
 begin
   arr[0]:=Char($82);
   arr[1]:=Char($A0);
   arr[2]:=Char(0);
   str:=arr;
   Memo1.Lines.Add('Char配列に「あ」$82$A0を入れた場合');
   Memo1.Lines.Add(str);
 end;

AnsiChar配列に「あ」$82$A0を入れた場合
あ
Char配列に「あ」$82$A0を入れた場合
□

Format('%.2d',[value]); // 00 数値を2桁で0埋め有り

 FormatFloat('0##.0', value); // 000.0 必ず整数部3桁小数部1桁を表示

uses System.Types, System.StrUtils;
var
sda:TStringDynArray;
begin
sda:=SplitString('abc def ghi', ' ');

 uses SysUtils
 function SameStr(S1: string; S2: string): Boolean;//大文字小文字区別する
 function SameText(S1: string; S2: string): Boolean;//大文字小文字区別しない

 uses System
 function Pos(const Substr: string; const S: string): Integer;

 uses System
 function Copy(S:string;Index:Integer;Count:Integer):string;

 uses System.StrUtils
 ReplaceStr(const AText:string;const AFromText:string;const AToText:string):string; 大文字小文字区別
 ReplaceText(const AText:string;const AFromText:string;const AToText:string):string; 大文字小文字区別しない
 StringReplace AnsiString用

uses System.RegularExpressions;
procedure TForm1.btnTestRegularexpressionClick(Sender: TObject);
var
  match: TMatch;
  input_str: string;
  pattern_str: string;
  i: Integer;
begin
  input_str := 'abcd123.scn';
  pattern_str := '(\d+)\.';
  input_str := 'aaabb(COM12)';
  pattern_str := '\(COM(\d+)\)$';
  match := TRegEx.match(input_str, pattern_str);
  if match.Success then
  begin
    Memo('success');
    Memo('Input=' + input_str);
    Memo('Pattern=' + pattern_str);
    Memo('match.Value=' + match.Value);
    Memo('match.Groups.Count=' + match.Groups.Count.ToString);
    for i := 0 to match.Groups.Count - 1 do
    begin
      Memo('match.Groups.Item[' + IntToStr(i) + '].Value=' + match.Groups.Item[i].Value);
    end;
  end
  else
  begin
    Memo('fail');
  end;
end;

success
Input=aaabb(COM12)
Pattern=\(COM(\d+)\)$
match.Value=(COM12)
match.Groups.Count=2
match.Groups.Item[0].Value=(COM12)
match.Groups.Item[1].Value=12

success
Input=abcd123.scn
Pattern=(\d+)\.
match.Value=123.
match.Groups.Count=2
match.Groups.Item[0].Value=123.
match.Groups.Item[1].Value=123

function get_file_head(fname: string): string;
var
  head: string;
  match: TMatch;
begin
  head := ExtractFileName(fname);
  head := ChangeFileExt(head, '');
  match := TRegEx.match(head, '([^0123456789])+');
  if match.Success then
  begin
    Result := match.Value;
  end
  else
  begin
    Result := '';
    raise Exception.Create('ファイル名の解析に失敗 TIxViewObjectFrames.get_file_head');
  end;
end;

uses System.RegularExpressions, System.StrUtils;
function TForm1.ReplaceCount(const Match: TMatch): string;
var
  valstr: string;
  vallen: Integer;
  val: Integer;
begin
  if Match.Success then
  begin
    valstr := Match.Groups.Item[1].Value;
    vallen := Length(valstr);
    val := StrToInt(valstr);
    inc(val);
    Result := RightStr('000000' + IntToStr(val), vallen) + Match.Groups.Item[2].Value;
  end
  else
    Result := '';
end;

procedure TForm1.btnTestRegExReplaceClick(Sender: TObject);
var
  regex: TRegEx;
  myEval: TMatchEvaluator;
  input_str: string;
  i: Integer;
begin
  input_str := 'abcd000123.scn';
  regex.Create('(\d+)(\.)');
  myEval := ReplaceCount;
  for i := 0 to 4 do
  begin
    if regex.Match(input_str).Success then
    begin
      Memo('Match=' + input_str);
      input_str := regex.Replace(input_str, myEval);
      Memo('next=' + input_str);
    end
    else
    begin
      Memo('Match fail');
      break;
    end;
  end;
end;

abcd000124.scn
abcd000125.scn
abcd000126.scn
abcd000127.scn
abcd000128.scn

uses System.StrUtils;
str = DupeString('hello!',3);

var
csv:TStringList;
begin
csv:=TStringList.Create;
csv.CommaText:='aa,bb,c'
Memo1.Lines.Add(csv.Strings[0]);

uses System.Types, System.StrUtils;
var
  sda: TStringDynArray;
  prms: TStringDynArray;
begin
  sda := SplitString(line, ' ');
  if Length(sda) = 2 then
  begin
    memo('------> APPL ' + sda[1]);
    prms := SplitString(sda[1], ',');
    if Length(prms) >= 1 then
    begin
      voltage := StrToFloat(prms[0]);

uses Data.FMTBcd;

procedure TForm1.Button1Click(Sender: TObject);
var
  hour, min, sec, msec: Word;
  year, month, day: Word;
  yyyy: TBcd;
  mm: TBcd;
  dd: TBcd;
  hh: TBcd;
  nn: TBcd;
  ss: TBcd;
  dt: TDateTime;
  str: string;
begin
  dt := Now;

  DateTimeToString(str, 'yyyy-mm-dd hh:nn:ss', dt);
  Memo1.Lines.Add(str);

  DecodeDate(dt, year, month, day);
  DecodeTime(dt, hour, min, sec, msec);
  yyyy := CurrencyToBcd(year);
  mm := CurrencyToBcd(month);
  dd := CurrencyToBcd(day);
  hh := CurrencyToBcd(hour);
  nn := CurrencyToBcd(min);
  ss := CurrencyToBcd(sec);
  Memo1.Lines.Add('yyyy.Fraction[0]=' + IntToHex(yyyy.Fraction[0], 2));
  Memo1.Lines.Add('yyyy.Fraction[1]=' + IntToHex(yyyy.Fraction[1], 2));
  Memo1.Lines.Add('mm.Fraction[0]=' + IntToHex(mm.Fraction[0], 2));
  Memo1.Lines.Add('dd.Fraction[0]=' + IntToHex(dd.Fraction[0], 2));
  Memo1.Lines.Add('hh.Fraction[0]=' + IntToHex(hh.Fraction[0], 2));
  Memo1.Lines.Add('nn.Fraction[0]=' + IntToHex(nn.Fraction[0], 2));
  Memo1.Lines.Add('ss.Fraction[0]=' + IntToHex(ss.Fraction[0], 2));
end;

 2023-07-23 12:01:22
 yyyy.Fraction[0]=20
 yyyy.Fraction[1]=23
 mm.Fraction[0]=70 ←1桁なのでMSBによっている
 dd.Fraction[0]=23
 hh.Fraction[0]=12
 nn.Fraction[0]=10
 ss.Fraction[0]=22

var
  uid:integer;
implementation
  :
  :
initialization
  uid:=0;
end.

finalization

procedure test;
label
exit_success;
begin
  goto exit_success;
   :
   :
exit_success:
   :
end;

function Getvalues(index: integer): string;
procedure Setvalues(index: integer; const Value: string);
property values[index:integer]:string read Getvalues write Setvalues;

 type
   TSampleEvent = procedure (const Value: string) of object;

 type
   TTestEventProperty = class(TObject)
   private
     FOnSample: TSampleEvent;
   public
     property OnSampleEvent: TSampleEvent read FOnSample write FOnSample;
   end;


 type
   TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
   private
     procedure testfunc(const Value: string);
     { Private 宣言 }
   public
     { Public 宣言 }
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 procedure TForm1.testfunc(const Value: string);
 begin
   ShowMessage(Value);
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
 sample:TTestEventProperty;
 begin
   sample:=TTestEventProperty.Create;
   try
     sample.OnSampleEvent:=testfunc;
     sample.OnSampleEvent('syokun!');

   finally
     sample.Free;
   end;
 end;

uses SysUtils;
raise Exception.Create('Error!!');

uses SysUtils;
  Memo1.Lines.Add(FloatToStrF(12.3456, ffFixed, 15, 3));//15が精度、3が小数の桁数
  Memo1.Lines.Add(FloatToStrF(12.345, ffFixed, 15, 3));//15が精度、3が小数の桁数
  Memo1.Lines.Add(FloatToStrF(12.345, ffFixed, 15, 2));//15が精度、2が小数の桁数
//出力
12.346
12.345
12.35

uses SysUtils;
FormatFloat('00',12);

 f:=0.000012345678;
 memo(FloatToStrF(f,ffExponent,4,1));
 memo(FloatToStrF(f,ffExponent,4,2));
 memo(FloatToStrF(f,ffExponent,3,2));
//出力
1.235E-5
1.235E-05
1.23E-05

var
  hour, min, sec, msec: Word;
  year, month, day: Word;
begin
  DecodeDate(dt, year, month, day);
  DecodeTime(dt, hour, min, sec, msec);

StrToDateTimeDef(Value, 0.0);

uses SysUtils;
 dt := EncodeDateTime(2012,8,29,0,0,0,0);

uses SysUtils;
  Memo1.Lines.Add(DateTimeToStr(Now));

2009/01/29 20:28:12

uses SysUtils;
var
str:string;
fname:string;
begin
  DateTimeToString(str,'yymmdd_hhnnss',Now);
  fname:=ExtractFilePath(Application.ExeName)+str+'.csv';
  Memo1.Lines.Add(fname);
end;

070127_112913
070127_112914

  DatetimeToString(str, 'mm/dd hh:nn:ss zzz : ', Now);

uses DateUtils;
DayOfTheWeek(dt)

DayMonday

uses DateUtils;
DaysBetween(ANow:TDateTime,ATHen:TDateTime):integer;

uses System.DateUtils;

RecodeMilliSecond
RecodeSecond
RecodeHour
RecodeDay
RecodeMonth
RecodeYear

uses System.DateUtils;
cur_time := RecodeMilliSecond(Now, 0);

 function get_file_date(fname: string): integer;
 var
   FileHnd: integer;
 begin
   { ファイルのハンドルを取得 }
   FileHnd := FileOpen(fname, fmOpenRead);
   try
     { ファイルのタイムスタンプを取得 }
     Result := FileGetDate(FileHnd);
     { タイムスタンプを日付型に変換 }
   finally
     FileClose(FileHnd);
   end;
 end;

 var
   fs: TFileStream;
   ptr: PByte;
 begin
   GetMem(ptr, BUFFER_SIZE);
   try
     fs := TFileStream.Create(filename, fmOpenRead);
     try
       fs.Read(ptr^, BUFFER_SIZE);
     finally
       fs.Free
     end;
   finally
     FreeMem(ptr);
   end;
 end;

 var
 fs:TFileStream;
 size:integer;
 chunk_size:integer;
 read_size:integer;
 fname:string;
 arr:TLongwordArray;
 i:integer;
 begin
   fname:='sample.bin';
   fs:=TFileStream.Create(fname,fmOpenRead or fmShareDenyWrite);
     try
     size:=fs.Size;
     chunk_size:=4096;
     read_size:=chunk_size;

     while size>0 do
       begin
       if read_size>size then
         read_size:=size;

       fs.Read(arr,read_size);

       for i := 0 to (read_size div 4) - 1 do
       begin
         //arr[i]
       end;

       size:=size-read_size;
       end;

     finally
       fs.Free;
     end;
 end;

 var
   fs: TFileStream;
   header: TIxANIPOVRomHeaderV5;
 begin
   fs := TFileStream.Create(fname, fmOpenRead);
   try
     fs.Read(header,sizeof(header));
   finally
     fs.Free;
   end;
 end;

• 読み書きサイズ大きいとエラーになる。

 procedure TForm1.btnRefClick(Sender: TObject);
 var
 fs:TFileStream;
 fname:string;
 begin
   if OpenDialog1.Execute then
   begin
     fname:=OpenDialog1.FileName;
     edFname.Text:=fname;
     fs:=TFileStream.Create(fname,fmOpenRead or fmShareDenyNone);
     try
       edSize.Text:=IntToStr(fs.Size);
     finally
       fs.Free;
     end;
   end;
 end;

 procedure TIxAnipov2RomGen.SaveToFile(fname: string);
 var
   fs: TFileStream;
   slave_data_chunk: array of Byte;
 begin
   if EnalbeSlaveChunk then
   begin
     // Chunkヘッダ
     SetLength(slave_data_chunk, 8);
     slave_data_chunk[0] := $53; // S
     slave_data_chunk[1] := $4C; // L
     slave_data_chunk[2] := $41; // A
     slave_data_chunk[3] := $56; // V
     slave_data_chunk[4] := 0;
     slave_data_chunk[5] := 1;
     slave_data_chunk[6] := 2;
     slave_data_chunk[7] := 3;
   end;

   // ROMデータそのもの
   fs := TFileStream.Create(fname, fmCreate);
   try
     fs.Write(slave_data_chunk[0], 8);
   finally
     fs.Free;
   end;
 end;

Buffer: array of UInt16;
SetLength(Buffer, 1024);
fs.Write(Pointer(Buffer)^, 10); //write_sizeはバイト数

 procedure TIxAnipov2RomGen.gen_sd_file(frame_interval: integer; rom_fname: string);
 var
   fname: string;
   sd_file_header: TByteArray;
 begin
   num_of_slave := fnames.Count;

   sd_file_header[0] := $46; // F
   sd_file_header[1] := $4B; // K
   sd_file_header[2] := $42; // B
   sd_file_header[3] := $4D; // M
   sd_file_header[4] := 8; // chunk size(4byte)
   sd_file_header[5] := 0;
   sd_file_header[6] := 0;
   sd_file_header[7] := 0;
   sd_file_header[8] := num_of_slave; // num of slave(2byte)
   sd_file_header[9] := 0;
   sd_file_header[10] := frame_interval; // frame interval(2byte)
   sd_file_header[11] := 0;
   sd_file_header[12] := $FF; // reserved
   sd_file_header[13] := $FF; // reserved
   sd_file_header[14] := $FF; // reserved
   sd_file_header[15] := $FF; // reserved

   dst := TFileStream.Create(rom_fname, fmCreate);
   try
     // write header
     dst.Write(sd_file_header, 16);
   finally
     dst.Free;
   end;
 end;

procedure WriteBuffer(buf: Pointer; write_size: integer);
begin
  fs.Write(buf^, write_size);

  m_Buffer:PChar;
  GetMem(m_Buffer,LARGE_BUF_SIZE);
 var
 fs:TFileStream;
 begin
   acc_size:=READ_MEMORY_SIZE;
   remain:=readsize;

   fs:=TFileStream.Create(fname,fmCreate);
   try
     while remain>0 do
     begin
       fs.Write(PChar(m_Buffer + SizeOf(SH4USBIF_HEADER)+SizeOf(SH_TO_NOTE))^,acc_size);
     end;

   finally
     fs.Free
   end;
 end;

 var
    fout: TextFile;
 begin
   FileMode := fmOpenWrite or fmShareDenyWrite; // 共有モード:他のアプリケーションは読み込み用に開く事が出来る。書き込み用に開く事は出来ない。
   AssignFile(fout, file_name);
   try
     if FileExists(file_name) then
       Append(fout)
     else
       ReWrite(fout);
     WriteLn(fout, csv_val);
   finally
     CloseFile(fout)
   end;

 procedure TForm1.load_from_file(fname: string);
 var
   fs: TStreamReader;
   line: string;
 begin
   fs := TStreamReader.Create(fname);
   try
     while not fs.EndOfStream do
     begin
       line := fs.ReadLine;
     end;
   finally
     fs.Free;
   end;
 end;

uses System.IOUtils;
TFile.Copy(src,dst);

 uses System.Zip;
procedure TForm1.btnDecompZipClick(Sender: TObject);
var
  ZipFileName: string;
  ZippedFileIndex: Integer;
  ZipFile: TZipFile;
  DownloadedStream, DecompressionStream: TStream;
  LocalHeader: TZipHeader;
  bmp: TBitmap;
  strlist: TStringList;
begin
  ZipFileName := 'genzip.zip';
  ZippedFileIndex := 0;

  DownloadedStream := TFileStream.Create(ZipFileName, fmOpenRead);
  try
    ZipFile := TZipFile.Create;
    try
      ZipFile.Open(DownloadedStream, zmRead);
      ZipFile.Read(ZippedFileIndex, DecompressionStream, LocalHeader);

      try
        bmp := TBitmap.Create;
        try
          bmp.LoadFromStream(DecompressionStream);
        finally
          bmp.SaveToFile('zip1.bmp');
          bmp.Free;
          Image1.Picture.LoadFromFile('zip1.bmp');
        end;
      finally
        DecompressionStream.Free;
      end;

      ZipFile.Read('2/zip2.bmp', DecompressionStream, LocalHeader);
      try
        bmp := TBitmap.Create;
        try
          bmp.LoadFromStream(DecompressionStream);
        finally
          bmp.SaveToFile('2_zip2.bmp');
          bmp.Free;
          Image2.Picture.LoadFromFile('2_zip2.bmp');
        end;
      finally
        DecompressionStream.Free;
      end;

      ZipFile.Read('readme.txt', DecompressionStream, LocalHeader);
      try
        strlist := TStringList.Create;
        try
          strlist.LoadFromStream(DecompressionStream);
        finally
          strlist.SaveToFile('dst.txt');
          strlist.Free;
          Memo1.Lines.LoadFromFile('dst.txt');
        end;
      finally
        DecompressionStream.Free;
      end;

    finally
      ZipFile.Free;
    end;
  finally
    DownloadedStream.Free;
  end;

end;

procedure TForm1.btnGenZipClick(Sender: TObject);
var
  ZipFile: TZipFile;
  UploadStream: TStream;
  fs: TFileStream;
begin
  UploadStream := TFileStream.Create('genzip.zip', fmCreate);
  try

    ZipFile := TZipFile.Create;
    try

      // src1.bmpをzip1.bmpとして追加
      ZipFile.Open(UploadStream, zmWrite);
      fs := TFileStream.Create('src1.BMP', fmOpenRead);
      try
        ZipFile.Add(fs, 'zip1.bmp');
      finally
        fs.Free;
      end;

      // src2.bmpを2/zip2.bmpとして追加
      fs := TFileStream.Create('src2.BMP', fmOpenRead);
      try
        ZipFile.Add(fs, '2/zip2.bmp');
      finally
        fs.Free;
      end;

      // src.txtをreadme.txtとして追加
      fs := TFileStream.Create('src.txt', fmOpenRead);
      try
        ZipFile.Add(fs, 'readme.txt');
      finally
        fs.Free;
      end;

    finally
      ZipFile.Free;
    end;

  finally
    UploadStream.Free;
  end;
end;

 procedure TfrmMain.ImageViewMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   memo('mouse down');
   MouseCapture:=True;
 end;

 procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
 begin
   memo('main mouse move');
 end;

 procedure TfrmMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   memo('main mouse up');
   MouseCapture:=False;
 end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  tx, ty: Integer;
begin
  tx := X div Zoom;
  ty := Y div Zoom;
  if Button = mbLeft then
    Image.Canvas.Pixels[tx, ty] := clBlack
  else if Button = mbRight then
    Image.Canvas.Pixels[tx, ty] := clWhite;

  PaintBox1.Refresh;
end;

 uses VclTee.Series;
procedure TForm1.Button1Click(Sender: TObject);
var
  t: integer;
  total_t: integer;
  series: TLineSeries;
begin
  Chart1.SeriesList.Clear;
  series := TLineSeries.Create(Chart1);
  total_t := 48000;
  for t := 0 to total_t - 1 do
  begin
    series.AddXY(t, cos(2 * pi * (double(t) / double(total_t))));
  end;
  Chart1.AddSeries(series);
end;

var
  ser: TLineSeries;
begin
  ser := TLineSeries.Create(Chart1);
  ser.Legend.Text:='cos';

  Chart1.Legend.CheckBoxes := not Chart1.Legend.CheckBoxes;

    TLineSeries.Pointer.Style:=TSeriesPointerStyle(cmbPointerStyle.ItemIndex);
    TLineSeries.Pointer.Visible:=chkPointerVisible.Checked;

  Series1.Pointer.Style:=psCircle;
  Series1.Pointer.Visible:=True;

  Series1.AddBar(10000, '1', clRed);
  Series1.AddBar(20000, '2', clRed);
  Series1.AddBar(30000, '3', clRed);

  Series1.YValue[0]:=5000;

      Series1.VertAxis := aRightAxis;

 c:TChar;
 c.IsDigit
 c.IsControl

procedure TForm1.add_series(val: double);
begin
  Series1.AddXY(graph_x_count, val);
  inc(graph_x_count);
  if Series1.Count > 1000 then
    Series1.Delete(0);
end;

 uses Vcl.Imaging.pngimage;
 procedure TForm1.Button5Click(Sender: TObject);
 var
   fname: string;
   png: TPngImage;
   bmp:TBitmap;
 begin
   png := TPngImage.Create;
   try
     fname := 'test ChartTemp.bmp';
     bmp:=ChartTemp.TeeCreateBitmap;
     png.Assign(bmp);
     png.SaveToFile(ChangeFileExt(fname, '.png'));
   finally
     bmp.Free;
     png.Free;
   end;
 end;

 Chart1.AutoRepaint := false; // 自動更新を停止して描画速度を上げる
 ：
 チャートの更新処理
 ：
 Chart1.AutoRepaint := true; // 自動更新再開
 Chart1.Invalidate; // 自動更新を再開しただけだと今回の更新がきかないので明示的に再描画

   Chart1.Axes.Bottom.LabelsAngle := 90; // ラベルの角度指定
   Chart1.BottomAxis.DateTimeFormat := 'hh:mm:ss'; // 日付時刻の書式

 var
   tgtser: TLineSeries;
 begin
       tgtser := TLineSeries.Create(Chart1);
       tgtser.Pointer.Visible := true;
       tgtser.Pointer.Style := psCircle;
       tgtser.XValues.DateTime := true; //これで日付時刻にする

 ShellExecute(Application.Handle,'open',PChar(cmd),PChar(option),nil,SW_NORMAL);

uses Windows,WinApi.SHELLAPI;

 function TForm1.shell_exec(cmd:string;option:string):DWORD;
 var
 sei:SHELLEXECUTEINFO;
 begin
 	ZeroMemory(@sei, sizeof(SHELLEXECUTEINFO));

 	//構造体のサイズ
 	sei.cbSize := sizeof(SHELLEXECUTEINFO);

 	//起動側のウインドウハンドル
 	sei.Wnd := Handle;

 	//起動後の表示状態
 	sei.nShow := SW_SHOWNORMAL;

 	//このパラメータが重要で、セットしないとSHELLEXECUTEINFO構造体のhProcessメンバがセットされない。
 	sei.fMask := SEE_MASK_NOCLOSEPROCESS;

 	//起動プログラム
 	sei.lpFile := PChar(cmd);
 	sei.lpParameters := PChar(option);

 	//プロセス起動
 	if not ShellExecuteEx(@sei) then//shell32.lib必須
 		exit;

 	//エラー?
 	if sei.hInstApp <= 32 then
 		exit;

 	//終了を待つ
 	WaitForSingleObject( sei.hProcess, INFINITE ) ;

 	//戻り値を取得
 	GetExitCodeProcess(sei.hProcess, Result);
 end;

*.txt

procedure TForm1.DropTarget1DragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
begin
  memo(Data.Files[0]);
end;

 type
 　TForm1 = class(TForm)
 　private
 { Private 宣言 }
 　　procedure WMDropFiles(var Msg: TWMDropFiles); Message WM_DropFiles;
 　end;

 implementation

 uses WinApi.ShellApi;★忘れずに

 {$R *.dfm}

 { TForm1 }

 procedure TForm1.FormCreate(Sender: TObject);
 begin
   DragAcceptFiles(Handle,True);
 end;

 procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
 var
 num_files:integer;
 i:integer;
 FileName: Array[0..MAX_PATH] of Char;
 begin
   num_files := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
   for i := 0 to num_files - 1 do
   begin
     DragQueryFile(Msg.Drop, i, FileName, SizeOf(FileName));
     Memo1.Lines.Add(String(FileName));
   end;

   DragFinish(Msg.Drop);
 end;

procedure TForm1.btnComm1CreateClick(Sender: TObject);
begin
  comm1:=TComm.Create(self);
  comm1.BaudRate:=9600;
  comm1.ByteSize:=cbs8;
  comm1.ParityBits:=cpbNone;
  comm1.StopBits:=csb1;
  comm1.FlowControls:=[];
  comm1.Port:=1;
  comm1.OnCommReceive:=Comm1CommReceive;

  comm1.Open;
end;

procedure TForm1.Comm1CommReceive(Sender: TObject; Size: Word);
begin

end;

Application.ShowMainForm:=False;

GetEnvironmentVariable('OS')

    procedure WMNCHITTEST(var Msg: TWMNCHITTEST); message WM_NCHITTEST;
    procedure WMNCLButtonDBLCLK(var msg :TWMNCHitMessage); message WM_NCLBUTTONDBLCLK;

 procedure TFormHusen.WMNCHITTEST(var Msg: TWMNCHITTEST);
 var
 Pt:TPoint;
 begin
   //マウス座標を取得
   GetCursorPos(Pt);
   //フォーム上の座標に変換
   Pt := ScreenToClient(Pt);
     if GetAsyncKeyState(VK_LBUTTON) < 0 then
       //ウィンドウズにタイトル バーで発生することを示すHTCAPTIONを返す
       Msg.Result := HTCAPTION
     else
       Msg.Result := HTCLIENT;
 end;

 //WMNCHITTESTで小細工しているので、ダブルクリックをFormのイベントで検出出来ない
 procedure TFormHusen.WMNCLButtonDBLCLK(var msg: TWMNCHitMessage);
 begin
 end;

 unit IkCustomList;

 interface

 uses Classes;

 type
   TIkDoubleList = class(TList)
     Protected
       procedure Notify(Ptr: Pointer; Action: TListNotification); override;
       function GetItem(Index: Integer): Double;
       procedure SetItem(Index: Integer; const Value: Double);
     public
       procedure Clear; override;
       function Add(Value: Double): Integer;
       property Items[Index: Integer]: Double read GetItem write SetItem; default;
   end;

 function CompareDouble(item1,item2:Pointer):Integer;

 implementation

 //Sort用比較関数
 function CompareDouble(item1, item2: Pointer): Integer;
 begin
   if PDouble(item1)^ < PDouble(item2)^ then
     Result:=-1
   else if PDouble(item1)^ > PDouble(item2)^ then
     Result:=1
   else
     Result:=0

 end;

 { TIkDoubleList }

 function TIkDoubleList.Add(Value: Double): Integer;
 var
 p:PDouble;
 begin
   New(p);
   p^:=Value;
   Result:=Inherited Add(p)
 end;

 //この方法だと、Extractの戻り値が使えなくなる。が、実害はなさそう。
 procedure TIkDoubleList.Notify(Ptr: Pointer; Action: TListNotification);
 begin
   if Action = lnDeleted then
   begin
       Dispose(Ptr);
   end;

   inherited Notify(Ptr, Action);
 end;

 procedure TIkDoubleList.Clear;
 var
 i:integer;
 begin
   for i := 0 to Count - 1 do
     Delete(0);//ClearはTListでは要素の解放をしない。ちなみにDestroyではClear呼出しが存在する。

   inherited Clear;
 end;

 function TIkDoubleList.GetItem(Index: Integer): Double;
 begin
   Result:= PDouble(inherited Items[index])^;
   //Items[index]をアクセスすると、TList.Getが呼ばれる
   //TList.Getはポインタを返す。
   //ポインタを逆参照して値を返す。
 end;

 procedure TIkDoubleList.SetItem(Index: Integer; const Value: Double);
 begin
   PDouble(inherited Items[index])^:=Value;
   //Items[index]をアクセスすると、TList.Getが呼ばれる
   //TList.Getはポインタを返す。
   //ポインタを逆参照して値を入れる。
 end;

 end.

 unit Unit1;

 interface

 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls,IkCustomList;

 type
   TForm1 = class(TForm)
     Button1: TButton;
     Memo1: TMemo;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.dfm}

 procedure TForm1.Button1Click(Sender: TObject);
 var
 dlist:TIkDoubleList;
 i:integer;
 begin
   dlist:=TIkDoubleList.Create;

   try
     for i := 0 to 100 do
       dlist.Add(Random()*100);

     dlist.Sort(@CompareDouble);

     for i := 0 to 100 do
       Memo1.Lines.Add( FloatToStr(dlist.Items[i]));
   finally
     dlist.Free;
   end;

 end;

 end.

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdUDPClient1.Send(Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdUDPClient1.Host := '127.0.0.1';
  IdUDPClient1.Port := 55555;
  IdUDPClient1.Active := true;

  IdUDPServer1.DefaultPort := 55555;
  IdUDPServer1.Active := true;
end;

procedure TForm1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle);
var
  str: string;
begin
  str := TEncoding.ASCII.GetString(AData);
  Memo1.Lines.Add('UDPRead = ' + str);
end;

procedure TForm1.btnStartClick(Sender: TObject);
var
portno:UInt16;
begin
  portno:=5555;

  // Client
  IdUDPClient1.Host := '127.0.0.1';
  IdUDPClient1.Port := portno;
  IdUDPClient1.Active := true;

  // Server
  IdUDPServer1.DefaultPort := portno;
  IdUDPServer1.Active := true;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
  data: TIdBytes;
begin
  SetLength(data, 4);
  for var i := Low(data) to High(data) do
    data[i] := i;

  IdUDPClient1.SendBuffer(data);
end;

procedure TForm1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread; const AData: TIdBytes; ABinding: TIdSocketHandle);
var
  str: string;
begin
  Memo1.Lines.Add('Length(AData)=' + Length(AData).ToString);
  str := '';
  for var i := Low(AData) to High(AData) do
  begin
    str := str + IntToHex(AData[i], 2) + ' ';
  end;
  Memo1.Lines.Add('AData = ' + str);
end;

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, Vcl.StdCtrls, Vcl.ExtCtrls,
  IdCustomTCPServer, IdTCPServer, IdCmdTCPServer, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdCmdTCPClient;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    IdTCPClient1: TIdTCPClient;
    IdTCPServer1: TIdTCPServer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure memo(str: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPClient1.Host := '127.0.0.1';
  IdTCPClient1.Port := 2268;

  IdTCPServer1.DefaultPort := 2268;
  IdTCPServer1.Active := true;

  memo('ServerPort = ' + IdTCPServer1.DefaultPort.ToString);
  IdTCPClient1.Connect;
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  IdTCPClient1.IOHandler.WriteLn('hello'); // 送信する
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  text: String;
begin
  text := IdTCPClient1.IOHandler.ReadLn;
  memo(text);
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  text: string;
begin
  text := AContext.Connection.IOHandler.ReadLn; // 受信する
  memo(text);
  AContext.Connection.IOHandler.WriteLn('hi [' + text + ']'); // 応答を返す
END;

procedure TForm1.memo(str: string);
begin
  Memo1.Lines.Add(str);
end;

end.

uses IdAllFTPListParsers

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
begin
  memo(AContext.Binding.Port.toString);

memo(IntToStr(IDTCPServer1.Contexts.Count));

C:\Program Files\Common Files\CodeGear Shared\Images\glyFX
C:\Program Files\Common Files\Borland Shared\Images\glyFX

  if Key = Char(VK_RETURN) then

library testdll1;

uses
  System.SysUtils,
  System.Classes;

{$R *.res}

procedure func1(path: PAnsiChar; opt: LongWord); stdcall;
var
strlist:TStringList;
begin
  strlist:=TStringList.Create;
  try
    strlist.Add(path);
    strlist.SaveToFile('d:\testdll1.txt');
  finally
    strlist.Free;
  end;
end;

exports
  func1;

begin

end.

procedure func1(path: PAnsiChar; opt: LongWord); stdcall; external 'testdll1.dll';

procedure TForm1.Button1Click(Sender: TObject);
var
  str: AnsiString;
begin
  str := AnsiString(Edit1.Text);
  func1(PAnsiChar(str), 1);
end;

uses FileCtrl;
var
path:string;
begin
if SelectDirectory('Caption','',path) then //真ん中は初期パス
   exec_proc(path);
end;

var
strlist:TStringList;
begin
strlist:=TStringList.Create;
strlist.Add('あいう');
strlist.WriteBOM:=false;
strlist.SaveToFile('tmp.txt', TEncoding.UTF8);

var
rc:TGridRect;
begin
rc:=StringGrid1.Selection;

uses Windows;
color:TColor;
r,g,b:Byte;
color:=RGB(255,128,64);
r = GetRValue(color);
g = GetGValue(color);
b = GetBValue(color);
color := RGB(r,g,b);

  if MessageDlg('実行しますか？', TMsgDlgType.mtConfirmation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo], 0) <> mrYes
    Exit;
end;

uses FMX.DialogService.Sync;
  if TDialogServiceSync.MessageDialog('ファイルの先頭から検索を始めますか', TmsgDlgType.mtConfirmation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo],
    TMsgDlgBtn.mbYes, 0) = mrYes then
  begin
    //
  end;

 uses GUITestRunner

  GUITestRunner.RunRegisteredTests;

  Application.MainFormOnTaskbar := True;

  if not DirectoryExists('xyz') then
    MkDir('xyz');

uses System.IOUtils
 TFile.Copy
 TFile.Move
 TFile.Delete
 TFile.Exists //FileExistsと同じ?

procedure get_file_list(items: TStrings; find_str: string); // 1階層のみ
var
  SearchRec: TSearchRec;
begin
  // FindFirst が成功した場合のみ FindClose を呼ぶ必要がある
  if 0 = FindFirst(find_str, faAnyFile, SearchRec) then
  begin
    try
      repeat
        if (SearchRec.Attr and faDirectory) = 0 then
        begin
          // ファイル
          items.Add(SearchRec.Name)
        end;
      until 0 <> FindNext(SearchRec);
    finally
      FindClose(SearchRec);
    end;
  end;
end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   path: string;
 begin
   path := tmp_path;
   if DirectoryExists(path) then
   begin
     memo('Exists ' + path);
   end
   else
   begin
     memo('not exists ' + path);

     ForceDirectories(path); // 絶対パス・複数ディレクトリ

     memo('ForceDirectories ' + path);
   end;

   if DirectoryExists(path) then
   begin
     memo('Exists ' + path);
   end
   else
   begin
     memo('not exists ' + path);
     ForceDirectories(path);
   end;
 end;

 procedure TForm1.Button2Click(Sender: TObject);
 begin
   RemoveDir(tmp_path); // SysUtils
 end;

 procedure TForm1.memo(str: string);
 begin
   Memo1.Lines.Add(str);
 end;

 function TForm1.tmp_path: string;
 begin
   Result := ExtractFilePath(Application.ExeName) + 'tmp';
 end;

 // 似た様な処理を行う関数
 // Sysutils.CreateDir
 // System.MkDir
 // System.RmDir

uses System.Diagnostics
var
sw:TStopWatch;
begin
sw:=TStopWatch.StartNew;
//処理色々
//:
//:
sw.Stop;
memo(sw.ElapsedMilliseconds.ToString);
//swはrecordなので、Freeしなくても良い

 uses System.Diagnostics;
 var
   sw: TStopWatch;
   tm: Double;
 begin
   sw := TStopWatch.StartNew;
   sleep(100);
   sw.Stop;
   Memo1.Lines.Add('sw.ElapsedMilliseconds=' + sw.ElapsedMilliseconds.ToString);
   Memo1.Lines.Add('sw.ElapsedTicks=' + sw.ElapsedTicks.ToString);
   Memo1.Lines.Add('sw.Frequency=' + sw.Frequency.ToString);
   tm := (1.0 / sw.Frequency) * sw.ElapsedTicks;
   Memo1.Lines.Add('高精度時間(sec)=' + FloatToStr(tm));
 end;

 sw.ElapsedMilliseconds=111
 sw.ElapsedTicks=1113758
 sw.Frequency=10000000
 高精度時間(sec)=0.1113758

type
  IxAddNewFunc = procedure (caption:String) of Object;

type
  IxTest = class(TObject)
    protected
      FAddNew:IxNewFunc;
    public
      property AddNew:IxAddNewTabFunc read FAddNew write FAddNew;
  end;
----
    procedure add_new(caption: string);
----
var
  tst:IxTest;
begin
  tst:=IxTest.Create;
  tst.AddNew := add_new;

 var
 strlist:TStringList;
 begin
   strlist:=TStringList.Create;
   try
     strlist.CommaText:='a=1,b=2,c=3';
     memo('---- Strings[] ----');
     memo(strlist.Strings[0]);
     memo(strlist.Strings[1]);
     memo(strlist.Strings[2]);

     memo('---- Values[] ----');
     memo(strlist.Values['a']);
     memo(strlist.Values['b']);
     memo(strlist.Values['c']);
     memo(strlist.Values['d']);//エラーにはならない
   finally
     strlist.Free;
   end;
 end;

 procedure TfrmSettings.Edit2KeyPress(Sender: TObject; var Key: Char);
 begin
   if Ord(Key) = VK_RETURN then
   begin
     memo('hit return');
   end;
 end;

1. ジェネリクスを使っている為、スレッド処理の戻り値を指定可能
2. 終了処理は、通常の終了と、例外の2種類を記述可能
3. 終了処理は、TThread.OnTerminateから呼び出されるので、Synchronizeがいらない。System.Classes.TThread.OnTerminate
4. メイン中に記述すれば、受け渡しの変数を作成しなくても済む とかかなー。便利そう。
   

type
  TForm1 = class(TForm)
  private
    master_counter: integer;
    run_model_thread: boolean;
    procedure ModelThread;
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

// *************************************************************************
procedure TForm1.FormCreate(Sender: TObject);
begin
  master_counter := 0;
end;

// *************************************************************************
procedure TForm1.btnStartClick(Sender: TObject);
begin
  run_model_thread := true;
  TThread.CreateAnonymousThread(ModelThread).Start; // スレッド開始
end;

// *************************************************************************
procedure TForm1.btnStopClick(Sender: TObject);
begin
  run_model_thread := false; // スレッド停止
end;

// *************************************************************************
procedure TForm1.ModelThread;
var
  i: integer;
begin
  i := 0;
  while run_model_thread do
  begin
    sleep(10);
    inc(i);
    if i >= 10 then
    begin
      i := 0;
      inc(master_counter);
    end;
  end;
end;

unit IxNamedEventThread;
interface
uses
  System.Classes, System.SyncObjs;

type
  TIxNamedEventThread = class(TThread)
  protected
    event: TEvent;
    procedure Execute; override;
  end;

implementation
uses Unit1;

procedure TIxNamedEventThread.Execute;
begin
  event := TEvent.Create(nil, false, false, EVENT_NAME_SAMPLE);
  while not Terminated do
  begin
    if event.WaitFor(200) = wrSignaled then
    begin
      Break;
    end;
  end;
end;

end.

unit Unit1;

const
  EVENT_NAME_SAMPLE = '{BBCF957F-05C4-460C-9EE1-00FA6184E57F}';

var
  event_named: TEvent;
    event_thread: TIxEventThread;

procedure TForm1.FormCreate(Sender: TObject);
begin
  event_named := TEvent.Create(nil, false, false, EVENT_NAME_SAMPLE);
  named_event_thread := TIxNamedEventThread.Create;
end;

procedure TForm1.btnNamedEventEndClick(Sender: TObject);
begin
  event_named.SetEvent;
end;

uses System.SyncObjs;
var
FLock:TCriticalSection;
:
  FLock := TCriticalSection.Create;
:
     FLock.Acquire;
     try
        //競合する処理
      finally
        FLock.Release;
      end;

type
  TIxDataThread = class(TThread)
  protected
  public
    ViewManager: TIxViewManager;
    constructor Create;
    procedure OnTerminateExecute(Sender: TObject);

  end;

implementation

{ IxDataThread }

constructor TIxDataThread.Create;
begin
  ViewManager := TIxViewManager.Create;
  OnTerminate := OnTerminateExecute;

  inherited Create(true); // true:生成時停止(Startで開始) false:生成時即実行
  FreeOnTerminate := true; // 終了時解放
end;

procedure TIxDataThread.OnTerminateExecute(Sender: TObject);
begin
  ViewManager.Free;
end;

• TThreadedQueue 受け渡しにロック操作不要
• TThreadList 追加・削除にロック操作不要、Listアクセス時ロック

• メソッド PushItem,PopPItem
• キュー内の個数は不明
• PushItem,PopItemにタイムアウト設定可能(INFINITEも有り)
• DoShutdownでロック解放

var
    Queue: TThreadedQueue<TIxRawData>; // 実体 生データが入る。Executeで待つ

constructor TIxThreadDataPacker.Create;
begin
  Queue := TThreadedQueue<TIxRawData>.Create(1000, INFINITE, 100); // Depth, PushTimeout, PopTimeout
end;

procedure xyz;
var
  data: TIxRawData;
  wr: TWaitResult;
begin
  while true do
  begin
    // 待ち
    wr := Queue.PopItem(data);
    if (wr = TWaitResult.wrSignaled) and (data <> nil) then //★キューをdoShutdownした時、wrSignaledでdata=nilになる
    begin
      // Signaledの時はデータ有効
    end
    else
    begin
      break;
    end;

• メソッド Add,Remove,Clear
• プロパティ Dupulicates※dupAcceptしないと遅い(そうだよね)
• アイテム個数は不明
• LockList,UnlockListでTListを取得してアイテムにアクセス

uses System.SyncObjs;

 var
   DataLock:TCriticalSection;

procedure TFormMain.FormCreate(Sender: TObject);
begin
   DataLock := TCriticalSection.Create;
end;

 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
   DataLock.Free;
 end;

 procedure TFormMain.lamp_red_on;
 var
   str: string;
 begin
   DataLock.Acquire;
   try
     memo('ランプ点灯');
   finally
     DataLock.Release;
   end;
 end;

 uses Windows;
 OutputDebugString(PWideChar(index+' '+IntToStr(ofs)+' = '+Result));

{$IFDEF DEBUG}
{$ENDIF}
{$IFDEF RELEASE}
{$ENDIF}

{$REGION 'コメント'}
{$ENDREGION}

uses Data.DBXJSON, //これ追加
 Data.DBXPlatform; //for in do 使うのにこれあった方が良い

procedure TForm1.Button1Click(Sender: TObject);
var
  json_obj: TJSONObject;
begin
  json_obj := TJSONObject.Create;
  try
    json_obj.AddPair('key1', 'val1');
    json_obj.AddPair('key2', 'val2');
    Memo1.Lines.Add(json_obj.ToString);
  finally
    json_obj.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  json_obj: TJSONObject;
  pair: TJSONPair;
begin
  json_obj := TJSONObject.ParseJSONValue('{"key1": "val1", "key2": 123}') as TJSONObject; // パース失敗するとnil
  try
    for pair in json_obj do
    begin
      Memo1.Lines.Add(pair.JsonString.Value + '->' + pair.JsonValue.Value);
    end;
  finally
    json_obj.Free;
  end;
end;

{"key1":"val1","key2":"val2"}

key1->val1
key2->123

[dcc32 ヒント] Unit1.pas(51): H2443 インライン関数 'TJSONPairEnumerator.GetCurrent' はユニット 'Data.DBXPlatform' が USES リストで指定されていないため展開されません

1. paserverをインストール
2. paserverを実行
3. 接続プロファイルを作成

C:\Program Files\Embarcadero\RAD Studio\n.n\PAServer\setup_paserver.exe
n.n はリリース バージョン（XE5 では 12.0）を表します。

C:\Program Files\Embarcadero\RADPAServer\n.n\paserver.exe
n.n はリリース バージョン（XE5 では 12.0）を表します。

FastMM4\Replacement BorlndMM DLL\Delphi

• FastMMDebugSupport.pas

program testFastMM;

uses
  ShareMem,★追加
  System.StartUpCopy,
  FMX.Forms,
  Unit1 in 'Unit1.pas', {Form1}
  FastMMDebugSupport in 'FastMMDebugSupport.pas';★追加

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

• BorlndMM.dll
• FastMM_FullDebugMode.dll

procedure TForm1.Button1Click(Sender: TObject);
begin
  TObject.Create;
end;

begin
  ReportMemoryLeaksOnShutdown := True;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

program test_fastmm;

uses
  ShareMem,
  Vcl.Forms,

ReportMemoryLeaksOnShutdown := True

uses Windows;
 ShowCursor(false);

 bmp.Canvas.Brush.Color := clWhite;
 bmp.Canvas.Brush.Style := bsSolid;
 bmp.Canvas.FillRect(Rect(grad_hi, 0, bmp.Width, bmp.Height));

var
  lSaveCW: Word;
begin
  lSaveCW := Default8087CW;
  Set8087CW(Default8087CW or $3f);
  try
    myReport.Print;
  finally
    Set8087CW(lSaveCW);
  end;
end;

var
  guid: TGUID;
begin
  if CreateGUID(guid) = S_OK then
  begin
    memo(GUIDToString(guid));
  end
  else
  begin
    memo('GUIDの生成に失敗。');
  end;

{$REGION 'コメント'}
 :
{$ENDREGION}

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStringList;
  Stream: TResourceStream;
begin
  Stream := TResourceStream.Create(HInstance, 'Resource_1', RT_RCDATA);
  try
    List := TStringList.Create;
    try
      List.LoadFromStream(Stream);
      Memo1.Text := List.Text;
    finally
      List.Free;
    end;
  finally
    Stream.Free;
  end;
end;

 import os
 from delphifmx import *

 class Form1(Form):

     def __init__(self, owner):
         self.Panel1 = None
         self.Button1 = None
         self.Edit1 = None
         self.ListBox1 = None
         self.CheckBox1 = None
         self.GroupBox1 = None
         self.RadioButton1 = None
         self.RadioButton2 = None
         self.RadioButton3 = None
         self.CheckBox2 = None
         self.AniIndicator1 = None
         self.Button2 = None
         self.Button3 = None
         self.Splitter1 = None
         self.Memo1 = None
         self.OpenDialog1 = None
         self.SaveDialog1 = None
         self.Calendar1 = None
         self.LoadProps(os.path.join(os.path.dirname(os.path.abspath(__file__)), "Unit1.pyfmx"))

     def Button1Click(self, Sender):
         str = self.Edit1.Text
         self.Edit1.Text = ""
         self.ListBox1.Items.Add(str)
         self.Memo1.Lines.Add(str)

     def CheckBox1Change(self, Sender):
         self.AniIndicator1.Enabled = not self.AniIndicator1.Enabled

     def Button2Click(self, Sender):
         self.Memo1.Lines.SaveToFile('test.txt');

     def Button3Click(self, Sender):
         self.Memo1.Lines.LoadFromFile('test.txt');

 def main():
     Application.Initialize()
     Application.Title = 'Form1'
     Application.MainForm = Form1(Application)
     Application.MainForm.Show()
     Application.Run()
     Application.MainForm.Destroy()

 if __name__ == '__main__':
     main()

.\$(Platform)\$(Config)