• 型
• Generics
• 仮想メソッドと動的メソッド
• オーバーライドと隠蔽
• 抽象メソッド
• クラスフィールド
• GDI+
  • GDI+DelphiXE2
  • GDI+Delphi2009
• デバッグ出力
• 配列
  • 動的配列
  • 多次元動的配列
  • 動的メモリ
  • AllocMemとGetMem
  • フィル
  • コピー
    • move例1
    • move例2
  • スタックサイズ
• 文字列・バイト配列
  • 文字(配列)操作
  • 文字列からバイト列に変換 Delphi2010
  • バイト配列からStringに変換 Delphi2010
    • 例1
    • 例2
  • Pointerからstringに変換 Delphi2010
  • 文字列を数値に変換する
  • 文字列処理とUnicode(Delphi2009以降)
• 文字列処理
  • 比較
  • 検索
  • 切り出し
  • 置換
• 初期化 initialization
• ラベルとgoto
• プロパティで配列
• プロパティで関数
• 例外
• 浮動小数点(double,float)を文字列に変換
• 日付時刻
  • EncodeDateTime 年月日から日付時刻を生成
  • DateTimeToStr 日付時刻を文字列に変換
  • DateTimeToString 日付時刻を文字列に変換
  • TDateTimeから曜日を取得
  • TDateTime演算
  • ファイルの日付取得
• 列挙型
• 集合
• 構造体,Record
• TFileStream,ファイルサイズ,共有モード
  • read GetMemして読み込み
  • read 配列に読み込み
  • write
  • 注意点
• TImage上でマウスドラッグ
• TChart(TeeChart)
  • TChartのヘルプ
  • TChartの情報
  • PointerのStyle
• 終了コード
• 別のexe実行
  • ShellExecute
  • ShellExecuteEX
  • CreateProcess
• エクスプローラからドラッグドロップ
• コンポーネントを動的に生成
• タスクバーに表示しない
• 環境変数
• ファイルとフォルダの有無確認
• タイトルバーの無いフォームの移動(WM_NCHITTEST)
• TListView
  • 選択されたアイテムを取得する方法。
• TListを継承して独自のリストを作成。ついでにソートもしてみる。
  • 実装
  • 使い方
• Indy10 IdFTP
• コンポーネントのインストール方法
• インストール
  • Delphi2007
• glyFXはどこー？
• グローバル変数、ローカルな変数
• 色定数
• KeyPressイベント
• DLL
• DLL呼び出し
• DLLの遅延ロード
• ディレクトリ選択ダイアログ
• 第16回エンバカデロ・デベロッパーキャンプ
  • Delphi2010での文字列処理
• TStringGrid
• TColorとRGB
• ダイアログ
• 乱数
• DUnit
• TFlowPanel
• Formの重なり順序
• ファイル名操作
• ディレクトリ操作
• 便利なTStringList
• Editでキーイベント
• コンパイラ指令
• ショートカットキー
• メモリリーク検出
• OSXで動的読み込み可能ライブラリ(dylib)を遅延読み込みできない
• リンク

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;

 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
     { TODO -oUser -cConsole メイン : ここにコードを記述してください }
     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;

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;

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

colors:array of TColor;

SetLength(colors,5);
for i=0 to High(colors) do
  colors[i]

 const
   SIZEW = 4;
   SIZEH = 10;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   arr1: array [0 .. SIZEW - 1] of array [0 .. SIZEH - 1] of integer;
   arr2: array of array of integer;
   i, j, k: integer;
   str: string;
 begin
   SetLength(arr2, SIZEW);
   for i := 0 to SIZEW - 1 do
   begin
     SetLength(arr2[i], SIZEH);
   end;

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

   for i := 0 to SIZEW - 1 do
   begin
     str := '';
     for j := 0 to SIZEH - 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++ 互換バージョンです。

  FillChar(m_Buffer^,total_size,$FF);

 FillChar(Buffer[0],total_size,$FF);

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

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

FillChar
Move

 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
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;

 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を入れた場合
□

 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 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用

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

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;
FloatToStrF(Tick/1000,ffFixed,15,3);

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

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

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

uses DateUtils;
DayOfTheWeek(dt)

DayMonday

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

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

type
  TGohan = (ghAsaGohan,ghHiruGohan,ghBanGohan);

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

 if ghAsaGohan in gohan then
   nattou.mazemaze;

 type
   PNS_HEAD = ^NOTE_TO_SH;
   NOTE_TO_SH = record
     lMitei2Size:Longint;
     lVerUpStartAddress:Longword;
     cYobi:array[0..31] of char;
   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;
 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;

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

 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 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;

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

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

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

 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;

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

 implementation

 uses 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')

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

    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.

uses IdAllFTPListParsers

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
rc:TGridRect;
begin
rc:=StringGrid1.Selection;

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('確認して下さい',mtConfirmation,[mbRetry,mbAbort],0)<>mrRetry then
    Exit;
end;

 uses GUITestRunner

  GUITestRunner.RunRegisteredTests;

  Application.MainFormOnTaskbar := True;

 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

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;

ReportMemoryLeaksOnShutdown := True