お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"dBASEの動的フィールドコンポ生成" 


この発言に対し以下のコメントが寄せられています

#01268　高田　浩        さん　RE:dBASEの動的フィールドコンポ生成





こんにちは、高田浩です。

現在、xBase.pas なる xBASE言語ライク環境の開発中なのですが、
その中からの紹介です。

TTable のデータ、計算項目、参照フィールドのコンポーネントを
動的に生成するものです。データフィールドだけが予め項目エディ
タで作成されていてもいなくても使えるようにしています。

TQuery を使えば簡単なのですが、これはあえて TTable にて行っ
ています。先の xBROWSE と併せて手直しをすると、フォームを用
意せずともコードだけでブラウザが出来上がる可能性があります。

良く似たルーチンが並んでいますが、あえて合体させずに紹介し
ます。サンプルの Unit1(Form1) でご確認ください。

Paradox の場合も手直しすれば使えると思うのですが、、。




-------------------------------------------------------------
unit xBaseSub;
interface
uses Classes,SysUtils,Dialogs,DB,DBTables;
  {Forms,ExtCtrls,DBGrids,DBCtrls,Controls; xBrowse用}

procedure xSetTablStruFields(Sender: TComponent);
procedure xSetCalcField(fType: TFieldType;fName: string;
              fSize: integer;Sender: TComponent);
procedure xSetCalcFieldEvent(fEvent: TDataSetNotifyEvent;
              Sender: TComponent);
procedure xSetLookupField(fType: TFieldType;fName: string;
              fSize: integer;fLTable: TTable;fLKey: string;
              fLName: string;Sender: TComponent);
var
  Alias : TTable;

implementation

procedure xSetTablStruFields(
  Sender  : TComponent   // フィールド・コンポを作成する場所
  );
var
  fldCnt  : integer;     // Field数
  i       : integer;     // カウンタ
  Fld     : TField;
begin with Alias do begin
  Fld:=nil;
  if Active then Close;
  // 静的に項目が取得されているかのチェック
  if FieldCount > 0 then Exit;
  try
    fldCnt:=FieldDefs.Count;
    for i := 0 to fldCnt - 1 do begin
      case TFieldType(FieldDefs.Items[i].DataType) of
        ftString   : Fld:=TStringField.Create(Sender);
        ftSmallInt : Fld:=TSmallIntField.Create(Sender);
        ftBoolean  : Fld:=TBooleanField.Create(Sender);
        ftFloat    : Fld:=TFloatField.Create(Sender);
        ftDate     : Fld:=TDateField.Create(Sender);
        ftMemo     : Fld:=TMemoField.Create(Sender);
      end;
      with Fld do begin
        FieldKind := fkData;
        FieldName := FieldDefs.Items[i].Name;
        Name      := Alias.Name + IntToStr(i);
        if FieldDefs.Items[i].DataType = ftString
                         then Size := FieldDefs.Items[i].Size
                         else Size := 0;
        DataSet   := Alias;
        Fld       := nil;
      end;
    end;
    Open;
  finally
    Fld.Free;
  end;
end;end;

procedure xSetCalcField(
  fType   : TFieldType;  // 計算項目のフィールド型
  fName   : string;      // 計算項目のフィールド名
  fSize   : integer;     // 計算項目のフィールド幅
  Sender  : TComponent   // フィールド・コンポを作成する場所
  );
var
  Fld: TField;
  i  : integer;
begin with Alias do begin
  Fld := nil;
  try
    if not Active then Open; // OpenしないとFieldCountが取得できない
    i := FieldCount;   // 直前までのフィールド・コンポ数の取得
    Close;
    case fType of
      ftString   : Fld:=TStringField.Create(Sender);
      ftSmallInt : Fld:=TSmallIntField.Create(Sender);
      ftBoolean  : Fld:=TBooleanField.Create(Sender);
      ftFloat    : Fld:=TFloatField.Create(Sender);
      ftDate     : Fld:=TDateField.Create(Sender);
      ftMemo     : Fld:=TMemoField.Create(Sender);
    end;
    with Fld do begin
      FieldKind := fkCalculated;
      Name      := Alias.Name+IntToStr(i);
      FieldName := fName;
      Size      := fSize;
      DataSet   := Alias;
      Fld       := nil; // 一応です。
    end;
    Open;
  finally
    Fld.Free;
  end;
end;end;

procedure xSetLookupField(
  fType   : TFieldType;  // 参照項目のフィールド型
  fName   : string;      // 参照項目のフィールド名
  fSize   : integer;     // 参照項目のフィールド幅
  fLTable : TTable;      // 参照元のテーブル名
  fLKey   : string;      // 参照するためのキーフィールド
  fLName  : string;      // 参照する参照先のフィールド
  Sender  : TComponent   // フィールド・オブジェクトを作成する場所
  );
var
  Fld: TField;
  i  : integer;
begin with Alias do begin
  Fld := nil;
  try
    if not Active then Open; // OpenしないとFieldCountが取得できない
    i := FieldCount;   // 直前までのフィールド・コンポ数の取得
    Close;
    case fType of
      ftString   : Fld:=TStringField.Create(Sender);
      ftSmallInt : Fld:=TSmallIntField.Create(Sender);
      ftBoolean  : Fld:=TBooleanField.Create(Sender);
      ftFloat    : Fld:=TFloatField.Create(Sender);
      ftDate     : Fld:=TDateField.Create(Sender);
      ftMemo     : Fld:=TMemoField.Create(Sender);
    end;
    with Fld do begin
      FieldKind := fkLookup;
      Name      := Alias.Name+IntToStr(i);
      FieldName := fName;
      Size      := fSize;
      KeyFields := fLKey;
      LookupCache       := true;
      LookupDataSet     := fLTable;
      LookupKeyFields   := fLKey;
      LookupResultField := fLName;
      DataSet   := Alias;
      Index     := Alias.FieldByName(fLKey).Index + 1 ;
        // ここで KeyFields の隣に参照フィールドを持ってきてます。
      Fld       := nil; // 一応です。
    end;
    Open;
  finally
    Fld.Free;
  end;
end;end;

procedure xSetCalcFieldEvent(
   fEvent     : TDataSetNotifyEvent;
   Sender     : TComponent
   );
begin with Alias do begin
  Close;
  OnCalcFields := fEvent;
  Open;
end;end;

end.
-------------------------------------------------------------
【使用例】
フォームに TTable と TButton を２つづつ、DataSource,DBGrid
を１つづつ貼り、各 Button の OnClick を結びつければ動作しま
す。(1)(2)のテーブルは各自自由に設定ください。
使用例では計算項目を２つ参照を１つ設定して DBGrid に表示し
ます。

unit Unit1;

interface

uses Forms,SysUtils,Dialogs,DBGrids, Db, DBTables, Controls,
     Grids, Classes, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    DataSource1: TDataSource;
    Table1: TTable;
    DBGrid1: TDBGrid;
    Table2: TTable;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Table1MyCalc(DataSet: TDataSet);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1  : TForm1;
implementation

uses xBaseSub ;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  DataSource1.DataSet:=Table1;
  DBGrid1.DataSource:=DataSource1;
  // メインテーブル
  Table1.TableName := 'C:\DOS\AP\DBASE\SAMPLES\商品.DBF';(1)
  Table1.TableType := ttDBase;
  Table1.Open;
  // メインテーブルから参照されるテーブル
  Table2.TableName :=  'C:\DOS\AP\DBASE\SAMPLES\発注先.DBF';(2)
  Yable2.TableType := ttDBase;
  Table2.Open;
  // 広域TTable変数Aliasに関連付ける
  Alias := Table1;
end;

procedure TForm1.Table1MyCalc(DataSet: TDataSet);
  // Table1 の OnCalc に結びつけるプロシージャを記述
begin with Table1 do begin

  FieldByName('請求').AsFloat :=
     FieldByName('単価').AsInteger *
     FieldByName('発注数').AsInteger ;

  FieldByName('おまけ').AsString :=
     FieldByName('商品ｺｰﾄﾞ').AsString +
     FieldByName('商品名').AsString ;

end;end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  // データフィールドの追加
  xSetTablStruFields(Self);
  // 計算項目フィールドの追加１と２
  xSetCalcField(ftFloat,'請求',0,Self);
  xSetCalcField(ftString,'おまけ',40,Self);
  // 計算項目のOnCalcを結びつけるプロシージャの設定
  xSetCalcFieldEvent(Table1MyCalc,Self);
  // 参照フィールドの追加
  xSetLookupField(ftString,'発注先名称だよ',20,Table2,
                        '発注先ｺｰﾄﾞ','発注先名',Self);
  // 先日ULした xBrowse の実行などする手も考えられる
  // フォームを用意せずして（アプリ起動は速くなる）
  // 必要な場面に自動生成して行うのもいいではないか。

end;

procedure TForm1.Button2Click(Sender: TObject);
  // フィールド名、コンポーネント名、幅の表示
  // TStringList を使わずに #13入りの String で処理
  // データフィールドが項目エディタで設定されている場合と
  // いない場合で是非開いてもらいたい。
var
  i:integer;
  fList:string;
begin with Table1 do begin
  fList:=TableName+#13#13;
  for i :=0 to FieldCount-1 do
    fList := fList
       +' [ '+Fields.Fields[i].FieldName+' ] '
       +' [ '+Fields.Fields[i].Name+' ]'
       +' [ '+IntToStr(Fields.Fields[i].Size)+' ] '
       +#13;
  ShowMessage(fList);
end;end;

end.
-----------------------------------------------------------

追伸：ソースを改良したレスを下さる方は、それが xBase.pas に
　　　組み込まれることをご了解ください。

SBORLAND (4)dBASE 会議室にばんざぁぁぁぁぁい！(;;)

_/dBASE3-4形式_/VdB7&Delphi4pro_/_/KFE06073_/_/高田浩_/_/
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/02/03 -

Original document by 高田　浩        氏 ID:(KFE06073)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum