１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"データベース上複写機能"
◆解説
DBGridで編集中に、手前のレコードの内容を「上複写」する機能が
欲しくて作成した関数です。
関数（関数名が長すぎるかなぁ(^^;）
function GetFieldValueFromRelativeRecord(BDEDataSet: TBDEDataSet;
PosOffset: Integer; Field: TField;
var RetVal: Variant): Boolean;
処理内容
BDEDataSetのカレントレコードに対して、
PosOffsetで指定した相対位置のレコードから、
Fieldに対応したフィールド値を RetValに取得します。
入力パラメータ
BDEDataSet: TBDEDataSet
Table1や Query1などを指定する
CachedUpdatesモードにも対応している（と思う）
PosOffset: Integer
カレントレコードからの相対位置を指定する
-1で手前のレコード, 1で次のレコード
もちろん -2,-3 といった指定も可能
Field: TField
BDEDataSetパラメータに指定したDataSet内の
TFieldオブジェクトを指定する
※このオブジェクトのValue値が変更されることはない
var RetVal: Variant
目的のフィールド値を受け取る Varinat型変数
戻り値
False: 指定の相対位置のレコードがない（BOF or EOF）
True: フィールド値の取得に成功
var RetVal: Variantに値が代入されている
※BOF, EOF以外のエラーが発生した場合には、例外が発生する
◆動作確認
Delphi3.1 + Win95a + Paradox形式のデータベースファイル
◆例
(1) Form1に Table1, DataSource1, DBGrid1, SpeedButton1を置く
DBGrid1 DataSource ← DataSource1
DataSource1 DataSet ← Table1
Table1 DatabaseName ← DBDEMOS
TableName ← BIOLIFE.DB
Active ← True
(2) uses に BDE, DBCommon を追加する
----- ここから -----
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, Grids, DBGrids, Db, DBTables,
BDE, DBCommon;
type
TForm1 = class(TForm)
...省略
implementation
{$R *.DFM}
//-------------------- キリトリ線 --------------------
//uses
// SysUtils, BDE, Db, DBTables, DBCommon が必要
//
//↓このtype宣言が必要
type
TMyBDEDataSet = class(TBDEDataSet);
function GetFieldValueFromRelativeRecord(BDEDataSet: TBDEDataSet;
PosOffset: Integer; Field: TField;
var RetVal: Variant): Boolean;
var
CursorProps: CurProps;
SaveBookmark: String;
RecBuf: PChar;
ARecProps: RecProps;
FieldData: String;
rc: DBIResult;
IsBlank: LongBool;
BlobSize, BlobReadSize: Longint;
P,dstP: Pointer;
CurValue: Currency;
TimeStamp: TTimeStamp;
begin
Result := True;
RetVal := Null;
if not BDEDataSet.Active then
raise Exception.Create(BDEDataSet.Name+'がOpenされていない');
if Field.FieldKind <> fkData then
raise Exception.Create('FieldKindが fkDataでない');
//カーソルをカレントレコードに移動
BDEDataSet.UpdateCursorPos;
//DbiGetBookMark によりカーソル位置を保存
Check(DbiGetCursorProps(BDEDataSet.Handle, CursorProps));
SetLength(SaveBookmark, CursorProps.iRecBufSize);
Check(DbiGetBookMark(BDEDataSet.Handle, PChar(SaveBookmark)));
try //レコードバッファ確保
RecBuf := TMyBDEDataSet(BDEDataSet).AllocRecordBuffer;
try //PosOffset位置のレコードを読み込む
rc := DbiGetRelativeRecord(BDEDataSet.Handle, PosOffset,
dbiNOLOCK, RecBuf, @ARecProps);
if rc <> DBIERR_NONE then begin
Result := False; //読み込みエラー
if (rc = DBIERR_BOF) or (rc = DBIERR_EOF) then Exit;
Check(rc);
end;
Check(DbiGetField(BDEDataSet.Handle, Field.FieldNo,
RecBuf, nil, IsBlank));
if IsBlank then Exit; //指定Recordの指定Fieldが NULL値だった
//フィールド値の読み込み＆代入
if not Field.IsBlob then begin
//BLOBでない場合
SetLength(FieldData, Field.DataSize);
Check(DbiGetField(BDEDataSet.Handle, Field.FieldNo,
RecBuf, PChar(FieldData), IsBlank));
P := PChar(FieldData);
case Field.DataType of
ftBytes, //固定長バイト型項目 (バイナリ格納)
ftVarBytes: //可変長バイト型項目 (バイナリ格納)
begin
RetVal := VarArrayCreate([0, Field.DataSize - 1], varByte);
dstP := VarArrayLock(RetVal);
try
Move(P^, dstP^, Field.DataSize);
finally
VarArrayUnlock(RetVal);
end;
end;
ftString: RetVal := StrPas(P);
ftWord: RetVal := Word(P^);
ftSmallint:RetVal := Smallint(P^);
ftInteger,
ftAutoInc: RetVal := Integer(P^);
ftBoolean: RetVal := WordBool(P^);
ftFloat: RetVal := Double(P^);
ftCurrency:RetVal := Currency(P^);
ftBCD: begin
FMTBCDToCurr(FMTBcd(P^), CurValue);
RetVal := CurValue;
end;
ftTime: begin
TimeStamp.Time := LongInt(P^);
TimeStamp.Date := DateDelta;
RetVal := TimeStampToDateTime(TimeStamp);
end;
ftDate: begin
TimeStamp.Time := 0;
TimeStamp.Date := Integer(P^);
RetVal := TimeStampToDateTime(TimeStamp);
end;
ftDateTime:RetVal := TimeStampToDateTime(
MSecsToTimeStamp(Double(P^)));
end;
end else begin
//BLOB項目の場合 //BLOBハンドル取得
Check(DbiOpenBlob(BDEDataSet.Handle,
RecBuf, Field.FieldNo, dbiReadOnly));
try //BLOBデータの取得
Check(DbiGetBlobSize(BDEDataSet.Handle,
RecBuf, Field.FieldNo, BlobSize));
SetLength(FieldData, BlobSize);
Check(DbiGetBlob(BDEDataSet.Handle, RecBuf, Field.FieldNo,
0, BlobSize, PChar(FieldData), BlobReadSize));
RetVal := FieldData;
finally //BLOBハンドル解放
Check(DbiFreeBlob(BDEDataSet.Handle, RecBuf, Field.FieldNo));
end;
end;
finally //レコードバッファ解放
TMyBDEDataSet(BDEDataSet).FreeRecordBuffer(RecBuf);
end;
finally
//DbiSetToBookMark によりカーソルをもとの位置に戻す
Check(DbiSetToBookMark(BDEDataSet.Handle, PChar(SaveBookmark)));
end;
end;
//-------------------- キリトリ線 --------------------
//-------------------- ↓使 用 例 --------------------
//SppeButton1 OnClickイベント
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
Value: Variant;
begin
if not GetFieldValueFromRelativeRecord
(Table1, -1, DBGrid1.SelectedField, Value) then begin
ShowMessage('手前のレコードがありません');
end else begin
//上複写する
if not(Table1.State in [dsInsert, dsEdit]) then Table1.Edit;
DBGrid1.SelectedField.AsVariant := Value;
end;
end;
----- ここまで -----
実行して、DBGrid1で編集作業中に SpeedButton1をクリックすると、
「上複写」が行われます。
※キリトリ線の内側を別ユニットに分離しておくと、何かと便利かも？
◆注意点その１
指定された相対位置のレコードを読み、その中のフィールド値を返す、
という関数であるため、計算項目や参照項目などの TFieldを指定する
と例外が発生します。
◆注意点２
Fieldの DataTypeが ftString, ftInteger, ftFloat, ftDateTime で
ある場合はとりあえず正常に取得できます。
また、:DBDEMOS:BIOLIFE.DBにより ftMemo, ftGraphic型の取得も正常
に行えることを確認しました。
その他の項目タイプは動作未確認です。(^^;
特に ftBytes 固定長バイト型項目 (バイナリ格納)
ftVarBytes 可変長バイト型項目 (バイナリ格納)
これらの項目タイプの RetValへの代入ルーチンは、正しいのかどうか？
不安がいっぱいです...（（((;^^)
◆注意点３
動作を確認したのは、Paradox形式のデータベースのみです。
Paradox以外の形式のデータベースでも正常に機能するのか？
私にはわからないです。m(_`_)m
◆その他
BDE APIを直接呼び出すプログラムは、ほとんど作ったことが無いので
間違いがあるようでしたら指摘していただけると幸いです。
98/11/21(土) 01:05 Satobe(JCG00336)
Original document by Satobe 氏 ID:(JCG00336)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。