• 文字列処理
  • 比較
  • 検索
• 動的配列
• 動的メモリ
• 初期化 initialization
• ラベルとgoto
• プロパティで配列
• 例外
• 浮動小数点(double,float)を文字列に変換
• DateTimeToString 日付時刻を文字列に変換
• ポインタ
  • メモリフィル
• 列挙型
• 構造体,Record
• TFileStream,ファイルサイズ,共有モード
  • read
  • write
  • 注意点
• TImage上でマウスドラッグ
• TChart(TeeChart)
  • TChartのヘルプ
  • TChartの情報
  • PointerのStyle
• 終了コード
• 別のexe実行
  • ShellExecute
  • ShellExecuteEX
  • CreateProcess
• エクスプローラからドラッグドロップ
• コンポーネントを動的に生成
• タスクバーに表示しない
• 環境変数
• ファイルとフォルダの有無確認
• タイトルバーの無いフォームの移動(WM_NCHITTEST)
• TListView
  • 選択されたアイテムを取得する方法。
• TListを継承して独自のリストを作成。ついでにソートもしてみる。
  • 実装
  • 使い方
• コンポーネントのインストール方法
• リンク

colors:array of TColor;

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

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

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;

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

uses SysUtils;
FloatToStrF(Tick/1000,ffFixed,15,3);

uses SysUtils;
var
str:string;
begin
  DateTimeToString(str,'yymmdd_hhnnss',Now);
  Memo1.Lines.Add(str);
end;

070127_112913
070127_112914

  FillChar(m_Buffer^,total_size,$FF);

type
  TGohan = (ghAsaGohan,ghHiruGohan,ghBanGohan);

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

 var
 fs:TFileStream;
 acc_size:integer;
 m_Buffer:PChar;
 ptr:pchar;
 begin
   GetMem(m_Buffer,LARGE_BUF_SIZE);
   ptr = m_Buffer;

   fs:=TFileStream.Create(fname,fmOpenRead);
   try
     fs.Read(ptr^,acc_size);
   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;

 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.