Delphiッこ倶楽部東京出張所: 9月 2010

2010年9月23日木曜日

SQL Server のデータベースのテーブルとフィールド名を表示する。（その2)

Sql Server 2005以上であれば、システムカタログに対してクエリを発行することで
テーブル名とフィールド名のリストの取得ができます。
(詳細は、システムカタログのクエリのQandAページを参照)

クエリを発行できるということは、

程度の画面であればマスターリンクを使ってノンコーディング
（クエリーは組む必要はありますが）でテーブルとフィールドのリストを表示できます。

このへんがDelphiのすごいところですね。

以下、フォーム表示をテキスト表示したもの

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 535
  ClientWidth = 727
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object PageControl1: TPageControl
   Left = 0
   Top = 0
   Width = 727
   Height = 535
   ActivePage = TabSheet2
   Align = alClient
   TabOrder = 0
   object TabSheet1: TTabSheet
   Caption = 'TabSheet1'
   object Label1: TLabel
   Left = 192
   Top = 88
   Width = 56
   Height = 13
   Caption = #12501#12451#12540#12523#12489#21517
   end
   object Label2: TLabel
   Left = 16
   Top = 88
   Width = 50
   Height = 13
   Caption = #12486#12540#12502#12523#21517
   end
   object Label3: TLabel
   Left = 552
   Top = 88
   Width = 56
   Height = 13
   Caption = #12501#12451#12540#12523#12489#21517
   end
   object Label4: TLabel
   Left = 376
   Top = 88
   Width = 50
   Height = 13
   Caption = #12486#12540#12502#12523#21517
   end
   object Button1: TButton
   Left = 96
   Top = 16
   Width = 169
   Height = 33
   Caption = 'dbGo'#12398#12513#12477#12483#12489#12434#20351#29992
   TabOrder = 0
   OnClick = Button1Click
   end
   object ListBox1: TListBox
   Left = 16
   Top = 106
   Width = 169
   Height = 401
   ItemHeight = 13
   TabOrder = 1
   OnClick = ListBox1Click
   end
   object ListBox2: TListBox
   Left = 191
   Top = 106
   Width = 169
   Height = 401
   ItemHeight = 13
   TabOrder = 2
   end
   object ListBox3: TListBox
   Left = 376
   Top = 106
   Width = 169
   Height = 401
   ItemHeight = 13
   TabOrder = 3
   OnClick = ListBox3Click
   end
   object ListBox4: TListBox
   Left = 550
   Top = 106
   Width = 169
   Height = 401
   ItemHeight = 13
   TabOrder = 4
   end
   object Button2: TButton
   Left = 472
   Top = 16
   Width = 169
   Height = 33
   Caption = 'DbExpress'#12398#12513#12477#12483#12489#12434#20351#29992
   TabOrder = 5
   OnClick = Button2Click
   end
   end
   object TabSheet2: TTabSheet
   Caption = 'TabSheet2'
   ImageIndex = 1
   object DBGrid1: TDBGrid
   Left = 0
   Top = 0
   Width = 145
   Height = 507
   Align = alLeft
   DataSource = DataSource1
   TabOrder = 0
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = 'Tahoma'
   TitleFont.Style = []
   Columns = <
   item
   Expanded = False
   FieldName = 'Name'
   Visible = True
   end>
   end
   object DBGrid2: TDBGrid
   Left = 145
   Top = 0
   Width = 160
   Height = 507
   Align = alLeft
   DataSource = DataSource2
   TabOrder = 1
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = 'Tahoma'
   TitleFont.Style = []
   Columns = <
   item
   Expanded = False
   FieldName = 'NAME'
   Visible = True
   end>
   end
   end
   object TabSheet3: TTabSheet
   Caption = 'TabSheet3'
   ImageIndex = 2
   object DBGrid3: TDBGrid
   Left = 0
   Top = 0
   Width = 177
   Height = 507
   Align = alLeft
   DataSource = DataSource3
   TabOrder = 0
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = 'Tahoma'
   TitleFont.Style = []
   Columns = <
   item
   Expanded = False
   FieldName = 'Name'
   Visible = True
   end>
   end
   object DBGrid4: TDBGrid
   Left = 177
   Top = 0
   Width = 184
   Height = 507
   Align = alLeft
   DataSource = DataSource4
   TabOrder = 1
   TitleFont.Charset = DEFAULT_CHARSET
   TitleFont.Color = clWindowText
   TitleFont.Height = -11
   TitleFont.Name = 'Tahoma'
   TitleFont.Style = []
   Columns = <
   item
   Expanded = False
   FieldName = 'NAME'
   Visible = True
   end>
   end
   end
  end
  object ADOConnection1: TADOConnection
   Connected = True
   ConnectionString =
   'Provider=SQLNCLI10.1;Integrated Security="";Persist Security Inf' +
   'o=False;User ID=sa;Initial Catalog=AdventureWorks;Data Source=SA' +
   'KANOTE-PC\SqlExpress;Initial File Name="";Server SPN=""'
   LoginPrompt = False
   Provider = 'SQLNCLI10.1'
   Left = 16
   Top = 456
  end
  object SQLConnection1: TSQLConnection
   ConnectionName = 'MSSQLConnection'
   DriverName = 'MSSQL'
   GetDriverFunc = 'getSQLDriverMSSQL'
   LibraryName = 'dbxmss.dll'
   LoginPrompt = False
   Params.Strings = (
   'SchemaOverride=%.dbo'
   'DriverUnit=DBXMSSQL'

   'DriverPackageLoader=TDBXDynalinkDriverLoader,DBXCommonDriver150.' +
   'bpl'

   'DriverAssemblyLoader=Borland.Data.TDBXDynalinkDriverLoader,Borla' +
   'nd.Data.DbxCommonDriver,Version=15.0.0.0,Culture=neutral,PublicK' +
   'eyToken=91d62ebb5b0d1b1b'

   'MetaDataPackageLoader=TDBXMsSqlMetaDataCommandFactory,DbxMSSQLDr' +
   'iver150.bpl'

   'MetaDataAssemblyLoader=Borland.Data.TDBXMsSqlMetaDataCommandFact' +
   'ory,Borland.Data.DbxMSSQLDriver,Version=15.0.0.0,Culture=neutral' +
   ',PublicKeyToken=91d62ebb5b0d1b1b'
   'GetDriverFunc=getSQLDriverMSSQL'
   'LibraryName=dbxmss.dll'
   'VendorLib=sqlncli10.dll'
   'MaxBlobSize=-1'
   'OSAuthentication=False'
   'PrepareSQL=True'
   'DriverName=MSSQL'
   'HostName=SAKANOTE-PC\SQLEXPRESS'
   'Database=AdventureWorks'
   'User_Name=sa'
   'Password=sysdba'
   'BlobSize=-1'
   'ErrorResourceFile='
   'LocaleCode=0000'
   'IsolationLevel=ReadCommitted'
   'OS Authentication=False'
   'Prepare SQL=False'
   'ConnectTimeout=60'
   'Mars_Connection=False')
   VendorLib = 'sqlncli10.dll'
   Connected = True
   Left = 464
   Top = 56
  end
  object ADOQuery1: TADOQuery
   Connection = ADOConnection1
   CursorType = ctStatic
   Parameters = <>
   SQL.Strings = (
   'SELECT Object_ID, Name FROM SYS.TABLES')
   Left = 16
   Top = 488
  end
  object DataSetProvider1: TDataSetProvider
   DataSet = ADOQuery1
   Left = 56
   Top = 504
  end
  object ClientDataSet1: TClientDataSet
   Active = True
   Aggregates = <>
   Params = <>
   ProviderName = 'DataSetProvider1'
   Left = 88
   Top = 504
  end
  object DataSource1: TDataSource
   DataSet = ClientDataSet1
   Left = 24
   Top = 184
  end
  object ADOQuery2: TADOQuery
   Connection = ADOConnection1
   CursorType = ctStatic
   Parameters = <
   item
   Name = 'Object_ID'
   DataType = ftInteger
   Value = 14623095
   end>
   SQL.Strings = (
   'SELECT Object_ID , NAME FROM sys.columns')
   Left = 144
   Top = 504
  end
  object ClientDataSet2: TClientDataSet
   Active = True
   Aggregates = <>
   IndexFieldNames = 'Object_ID'
   MasterFields = 'Object_ID'
   MasterSource = DataSource1
   PacketRecords = 0
   Params = <>
   ProviderName = 'DataSetProvider2'
   Left = 208
   Top = 504
  end
  object DataSetProvider2: TDataSetProvider
   DataSet = ADOQuery2
   Left = 176
   Top = 504
  end
  object DataSource2: TDataSource
   DataSet = ClientDataSet2
   Left = 96
   Top = 176
  end
  object ClientDataSet3: TClientDataSet
   Active = True
   Aggregates = <>
   Params = <>
   ProviderName = 'DataSetProvider3'
   Left = 464
   Top = 112
  end
  object DataSetProvider3: TDataSetProvider
   DataSet = SQLQuery1
   Left = 464
   Top = 168
  end
  object SQLQuery1: TSQLQuery
   MaxBlobSize = -1
   Params = <>
   SQL.Strings = (
   'SELECT Object_ID, Name FROM SYS.TABLES')
   SQLConnection = SQLConnection1
   Left = 464
   Top = 216
  end
  object DataSource3: TDataSource
   DataSet = ClientDataSet3
   Left = 456
   Top = 280
  end
  object DataSetProvider4: TDataSetProvider
   DataSet = SQLQuery2
   Left = 600
   Top = 176
  end
  object ClientDataSet4: TClientDataSet
   Active = True
   Aggregates = <>
   IndexFieldNames = 'Object_ID'
   MasterFields = 'Object_ID'
   MasterSource = DataSource3
   PacketRecords = 0
   Params = <>
   ProviderName = 'DataSetProvider4'
   Left = 592
   Top = 104
  end
  object DataSource4: TDataSource
   DataSet = ClientDataSet4
   Left = 576
   Top = 280
  end
  object SQLQuery2: TSQLQuery
   MaxBlobSize = -1
   Params = <
   item
   DataType = ftInteger
   Name = 'Object_ID'
   ParamType = ptInput
   Value = 14623095
   end>
   SQL.Strings = (
   'SELECT Object_ID , NAME FROM sys.columns')
   SQLConnection = SQLConnection1
   Left = 584
   Top = 240
  end
end

SQL Server のデータベースのテーブルとフィールド名を表示する。（その1)

仕事でSql Serverのテーブルリストを表示する必要があったので・・・

DelphiでSQl Srerverのテーブルリストを表示する方法をいくつか

1. dbGOのConnectionのGetTableNamesメソッドとGetFieldNamesメソッドを利用する。

dbGoのGetTableNamesを利用すればInitial_Catalogで指定したデータベースの
テーブルリストを取得できます。

また、GetFieldNamesを利用すれば、指定したテーブルのフィールドのリストを表示できます。

ソースは、こんな感じ・・・
（ボタンをクリックするとテーブルのリストを表示し、リストの中のテーブルをクリックすると
クリックしたテーブルのリストを表示します。）

view plain print ?

procedure TForm1.Button1Click(Sender: TObject);
begin
ADOConnection1.Connected := true;
ADOConnection1.GetTableNames(ListBox1.Items,false);
ADOConnection1.Connected := false;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
TableName : String;
begin
if ListBox1.Items.Count > 0 then
begin
TableName := ListBox1.Items[ListBox1.ItemIndex];
if Length(TableName) > 0 then
begin
ADOConnection1.Connected := true;
ADOConnection1.GetFieldNames(TableName,ListBox2.Items);
ADOConnection1.Connected := false;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOConnection1.Connected := true;
  ADOConnection1.GetTableNames(ListBox1.Items,false);
  ADOConnection1.Connected := false;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  TableName : String;
begin
   if ListBox1.Items.Count > 0 then
   begin
      TableName := ListBox1.Items[ListBox1.ItemIndex];
      if Length(TableName) > 0 then
      begin
        ADOConnection1.Connected := true;
        ADOConnection1.GetFieldNames(TableName,ListBox2.Items);
        ADOConnection1.Connected := false;
      end;
   end;
end;

2. DbExpressを利用する。

DbExpressのSQLConnectionにもGetTableNamesメソッドとGetFieldNamesがあるので
dbGOと同様に処理できます。

ただし、試した中では、DbExpressでは、スキーマを指定しないとdboスキーマのテーブル
しか取得しないようなので、GetSchemaNamesでスキーマ名のリストを取得したうえで
スキーマ毎にテーブルを取得する必要がありました。

でソースはこんな感じ。スキーマ名を取得してる関係でちょっと複雑です。

view plain print ?

procedure TForm1.Button1Click(Sender: TObject);
procedure TForm1.Button2Click(Sender: TObject);
var
GetSchemaNames : TStringList;
TableNames : TStringList;
i,j : Integer;
begin
ListBox3.Items.Clear;
SQLConnection1.Connected := true;
GetSchemaNames := TStringList.Create;
try
SQLConnection1.GetSchemaNames(GetSchemaNames);
for i := 0 to GetSchemaNames.Count -1 do
begin
TableNames := TStringList.Create;
try
SQLConnection1.GetTableNames(TableNames,GetSchemaNames.Strings[i],false);
for j := 0 to TableNames.Count-1 do
begin
ListBox3.Items.Add(GetSchemaNames.Strings[i] + '.' + TableNames.Strings[j]);
end;
finally
TableNames.Free;
end;
end;
finally
GetSchemaNames.Free;
end;
SQLConnection1.Connected := false;
end;
procedure TForm1.ListBox3Click(Sender: TObject);
var
TableName : String;
begin
if ListBox1.Items.Count > 0 then
begin
TableName := ListBox3.Items[ListBox3.ItemIndex];
if Length(TableName) > 0 then
begin
SQLConnection1.Connected := true;
SQLConnection1.GetFieldNames(TableName,ListBox4.Items);
SQLConnection1.Connected := false;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);

procedure TForm1.Button2Click(Sender: TObject);
var
  GetSchemaNames : TStringList;
  TableNames : TStringList;
  i,j : Integer;
begin
  ListBox3.Items.Clear;
  SQLConnection1.Connected := true;
  GetSchemaNames := TStringList.Create;
  try
    SQLConnection1.GetSchemaNames(GetSchemaNames);
    for i := 0 to GetSchemaNames.Count -1 do
    begin
      TableNames := TStringList.Create;
      try
        SQLConnection1.GetTableNames(TableNames,GetSchemaNames.Strings[i],false);
        for j := 0 to TableNames.Count-1 do
        begin
          ListBox3.Items.Add(GetSchemaNames.Strings[i] + '.' + TableNames.Strings[j]);
        end;
      finally
        TableNames.Free;
      end;
    end;
  finally
    GetSchemaNames.Free;
  end;
  SQLConnection1.Connected := false;
end;

procedure TForm1.ListBox3Click(Sender: TObject);
var
  TableName : String;
begin
   if ListBox1.Items.Count > 0 then
   begin
      TableName := ListBox3.Items[ListBox3.ItemIndex];
      if Length(TableName) > 0 then
      begin
        SQLConnection1.Connected := true;
        SQLConnection1.GetFieldNames(TableName,ListBox4.Items);
        SQLConnection1.Connected := false;
      end;

   end;
end;

2010年9月12日日曜日

JoinStringはないの？（その２）

Delフサさんから指摘を受けましたので、オープン配列版のJoinString関数を
作成してみました。(Delフサ様ご指摘ありがとうございます。）

でついでに、文字列の最後にDelemeterを付加するかどうかを指定できる
オーバーロード関数をも作ってみました。

以下、ソースコード

view plain print ?

unit VbLikeStringUtil;
interface
uses
StrUtils,Types;
function JoinString(AStrings : Array of String; Delemeter: String) : String overload;
function JoinString(AStrings : Array of String; Delemeter: String; AddLastDelemeter : Boolean) : String overload;
implementation
uses
SysUtils;
function JoinString(AStrings : Array of String; Delemeter: String) : String overload;
begin
Result := JoinString(AStrings,Delemeter,false);
end;
function JoinString(AStrings : Array of String; Delemeter: String; AddLastDelemeter : Boolean) : String overload;
var
i : Longint;
begin
Result := '';
if (Length(AStrings) > 0) then
begin
//最後の
for i := low(AStrings) to high(AStrings)-1 do
begin
Result := Result + AStrings[i] + Delemeter;
end;
//文字配列の最後の要素
Result := Result + AStrings[high(AStrings)];
//最後にデリミターを付加する場合
if AddLastDelemeter then
begin
Result := Result + Delemeter;
end;
end;
end;

unit VbLikeStringUtil;

interface

uses
  StrUtils,Types;

  function JoinString(AStrings : Array of String; Delemeter: String) : String overload;
  function JoinString(AStrings : Array of String; Delemeter: String; AddLastDelemeter : Boolean) : String overload;


implementation

uses
  SysUtils;


function JoinString(AStrings : Array of String; Delemeter: String) : String overload;
begin
  Result := JoinString(AStrings,Delemeter,false);
end;

function JoinString(AStrings : Array of String; Delemeter: String; AddLastDelemeter : Boolean) : String overload;
var
  i : Longint;
begin

  Result := '';
  if (Length(AStrings) > 0) then
  begin

    //最後の
    for i := low(AStrings) to high(AStrings)-1 do
    begin
      Result := Result + AStrings[i] + Delemeter;
    end;

    //文字配列の最後の要素
    Result := Result + AStrings[high(AStrings)];

    //最後にデリミターを付加する場合
    if AddLastDelemeter then
    begin
      Result := Result + Delemeter;
    end;

  end;
end;

でテストコードはこんな感じ。

view plain print ?

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
StrUtils,Types, VbLikeStringUtil;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
JoinItems : TStringDynArray;
begin
SetLength(JoinItems,5);
JoinItems[0] := 'イージス';
JoinItems[1] := 'ジャスティス';
JoinItems[2] := 'ザク';
JoinItems[3] := 'セイバー';
JoinItems[4] := 'グフ';
Assert('イージス|ジャスティス|ザク|セイバー|グフ'=JoinString(JoinItems,'|'));
Label1.Caption := JoinString(JoinItems,'|');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
//空配列の場合は空文字を返す
Assert(''=JoinString([],'|'));
//通常の場合
Assert('ミリアリア|キラ|メイリン|バルトフェルド'
= JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|'));
//オプションの第３引数にTrueを指定すると文字列の最後にデリミタを付加します。
Assert('ミリアリア|キラ|メイリン|バルトフェルド|'
= JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|',true));
Label1.Caption := JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|',true);
end;
end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  StrUtils,Types, VbLikeStringUtil;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  JoinItems : TStringDynArray;
begin


  SetLength(JoinItems,5);

  JoinItems[0] := 'イージス';
  JoinItems[1] := 'ジャスティス';
  JoinItems[2] := 'ザク';
  JoinItems[3] := 'セイバー';
  JoinItems[4] := 'グフ';

  Assert('イージス|ジャスティス|ザク|セイバー|グフ'=JoinString(JoinItems,'|'));

  Label1.Caption := JoinString(JoinItems,'|');



end;

procedure TForm1.Button2Click(Sender: TObject);
begin

  //空配列の場合は空文字を返す
  Assert(''=JoinString([],'|'));

  //通常の場合
  Assert('ミリアリア|キラ|メイリン|バルトフェルド'
     = JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|'));

  //オプションの第３引数にTrueを指定すると文字列の最後にデリミタを付加します。
  Assert('ミリアリア|キラ|メイリン|バルトフェルド|'
     = JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|',true));

  Label1.Caption := JoinString(['ミリアリア','キラ','メイリン','バルトフェルド'],'|',true);
end;

end.

ちなみに、今回の文字列は、Seedの自分の好きなキャラシリーズです。

2010年9月5日日曜日

JoinStringはないの？

VB6のJoin関数および.Net FrameworkのString.Joinメソッドは、
XEで追加されたほどSplitString使用頻度は多くないがたまに必要に
なることがある。

Help,ソースをざっくり見たところなさそうだったので実装してみた。
（といっても文字列を連結しただけですが・・・)

以下、ソースコード

view plain print ?

unit VbLikeStringUtil;
interface
uses
StrUtils,Types;
function JoinString(AStrings: TStringDynArray; Delemeter : String) : String;
implementation
uses
SysUtils;
function JoinString(AStrings: TStringDynArray; Delemeter : String) : String;
var
i : Longint;
begin
Result := '';
for i := low(AStrings) to high(AStrings) do
begin
Result := Result + AStrings[i];
if i < high(AStrings) then Result := Result + Delemeter;
end;
end;
end.

unit VbLikeStringUtil;

interface

uses
  StrUtils,Types;

  function JoinString(AStrings: TStringDynArray; Delemeter : String) : String;

implementation

uses
  SysUtils;

function JoinString(AStrings: TStringDynArray; Delemeter : String) : String;
var
  i : Longint;
begin

  Result := '';
  for i := low(AStrings) to high(AStrings) do
  begin
    Result := Result + AStrings[i];
    if i < high(AStrings) then Result := Result + Delemeter;
  end;


end;

end.

実際の使用方法のサンプルは、こんな感じ

view plain print ?

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
StrUtils,Types, VbLikeStringUtil;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
JoinItems : TStringDynArray;
begin
SetLength(JoinItems,5);
JoinItems[0] := 'イージス';
JoinItems[1] := 'ジャスティス';
JoinItems[2] := 'ザク';
JoinItems[3] := 'セイバー';
JoinItems[4] := 'グフ';
Label1.Caption := JoinString(JoinItems,'|');
end;
end.

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses
  StrUtils,Types, VbLikeStringUtil;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  JoinItems : TStringDynArray;
begin


  SetLength(JoinItems,5);

  JoinItems[0] := 'イージス';
  JoinItems[1] := 'ジャスティス';
  JoinItems[2] := 'ザク';
  JoinItems[3] := 'セイバー';
  JoinItems[4] := 'グフ';


  Label1.Caption := JoinString(JoinItems,'|');


end;

end.

2010年9月3日金曜日

SplitStringを試してみる。

Delphi XEでSplitString関数が追加された。VBにあって、Delphiになかった関数で
個人的には気になってた関数です。（欲しかった関数です。）

で、ちょっとためしてみた。

以下、ソースコード

view plain print ?

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
StrUtils,Types;
procedure TForm1.Button1Click(Sender: TObject);
var
TestString : String;
SplitResult:TStringDynArray;
begin
TestString := 'フリーダム,ジャスティス,デストロイ,セイバー';
SplitResult := SplitString(TestString,',');
Label1.Caption := TestString;
for TestString in SplitResult do begin
ListBox1.Items.Add(TestString);
end;
end;
end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  StrUtils,Types;

procedure TForm1.Button1Click(Sender: TObject);
var
  TestString : String;
  SplitResult:TStringDynArray;
begin
  TestString := 'フリーダム,ジャスティス,デストロイ,セイバー';
  SplitResult := SplitString(TestString,',');
  Label1.Caption := TestString;

  for TestString in SplitResult do begin
    ListBox1.Items.Add(TestString);
  end;

end;

end.

Visual Basicライクで非常に簡単に使えます。

内部的には、FindDelimiter関数を使ってDelemeterをみつけ
Copy関数で部分文字列を切り出してます。

これなら、下位バージョンでも実装できそうですね。

ところでFindDelimiter関数は、いつから存在したのでしょうか？
個人的には、Delphiにはまだまだ知らない便利な関数が一杯ありそうです。

2010.09.10 山本隆の開発日記で紹介して頂いたので
調子にのってC++ Builderで書いてみました。
(C++は自信がないので、役に立つかどうかわかりませんが・・・)

view plain print ?

//---------------------------------------------------------------------------
#include <vcl.h>
#include <strutils.hpp>
#pragma hdrstop
#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
: TForm(Owner)
{
}
//---------------------------------------------------------------------------
void __fastcall TForm1::Button1Click(TObject *Sender)
{
UnicodeString TestString = "イージス|バスター|デュエル|ブリッツ|ストライク";
LabeledEdit1->Text = TestString;
TStringDynArray SplitResult = SplitString(TestString,"|");
for (int i = 0; i < SplitResult.Length; i ++) {
ListBox1->Items->Add(SplitResult[i]);
}
SplitResult.set_length(0);
}
//---------------------------------------------------------------------------
</strutils.hpp></vcl.h>

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

#include 
#include 
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
 : TForm(Owner)
{

}
//---------------------------------------------------------------------------
void __fastcall TForm1::Button1Click(TObject *Sender)
{

 UnicodeString TestString = "イージス|バスター|デュエル|ブリッツ|ストライク";

 LabeledEdit1->Text = TestString;

 TStringDynArray SplitResult = SplitString(TestString,"|");

 for (int i = 0; i < SplitResult.Length; i ++) {
  ListBox1->Items->Add(SplitResult[i]);
 }

 SplitResult.set_length(0);

}
//---------------------------------------------------------------------------

登録: 投稿 (Atom)

Delphiッこ倶楽部東京出張所

2010年9月23日木曜日

SQL Server のデータベースのテーブルとフィールド名を表示する。（その2)

SQL Server のデータベースのテーブルとフィールド名を表示する。（その1)

2010年9月12日日曜日

JoinStringはないの？（その２）

2010年9月5日日曜日

JoinStringはないの？

2010年9月3日金曜日

SplitStringを試してみる。

Blogspot Syntax Highlighter

Google Analytics