Unified Interbaseコンポーネントをつかってみた（その３）

Unified Interbaseコンポーネントをつかってみた（その1）でUIBDataSet経由でDBグリッドに
データを表示した。

しかし、UIBDataSetはReadOnlyのデータセットなので、編集が不可となっています。
(前回のサンプルを実行してもグリッドに入力ができません。)

いくつか、実験をおこなった結果、UIBDataSetは、単方向データセットとして機能している
ようなので、ClientDataSetを経由で接続すれば、DbExpressドライバのように使えるはず
だと思い試してみた。

以下、試して確認できたことを備忘録代わりに記述

フォームにTClientDataSetコンポーネントとTDataSetProviderコンポーネントを配置し、
UIBDataset → DatasetProvieder → ClientDataset → DataSourceにリンク変更


ここで、ClientDataset をActiveにするとタイムスタンプがうまく処理できないようでエラーが
発生するので、ClinetDataSet、およびUIBDataSetのソースを調べた結果、以下のとおり
データ形式の不整合があった。

UIBDataSet -> TDatetime型
ClinetDataSet　→ 通算のミリ秒(ftDatetime指定時）

そこで、ClientDatasetと時刻データが正しく連携が取れるようUIBDataSetを拡張したコンポーネントで、接続した。
以下、ソース

view plainprint?

1. unit UIBCdsDataSet;  
2.   
3. interface  
4.   
5. uses  
6.   SysUtils, Classes, DB, uibdataset;  
7.   
8. type  
9.   TUIBCdsDataSet = class(TUIBDataSet)  
10.   private  
11.     { Private 宣言 }  
12.   protected  
13.     { Protected 宣言 }  
14.   public  
15.     { Public 宣言 }  
16.     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload;{$IFNDEF FPC} override; {$ENDIF}  
17.     {$IFNDEF FPC}  
18.     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;  
19.     {$ENDIF}  
20.   published  
21.     { Published 宣言 }  
22.   end;  
23.   
24. procedure Register;  
25.   
26. implementation  
27.   
28. uses uiblib;  
29.   
30. procedure Register;  
31. begin  
32.   RegisterComponents('UIB', [TUIBCdsDataSet]);  
33. end;  
34.   
35. { TUIBCdsDataSet }  
36.   
37. function TUIBCdsDataSet.GetFieldData(FieldNo: Integer;  
38.   Buffer: Pointer): Boolean;  
39. var  
40.   doubleBuf : TDateTime;  
41.   aFieldType: TUIBFieldType;  
42.   tsbuf : TTimeStamp;  
43. begin  
44.   
45.  Result := inherited GetFieldData(FieldNo, Buffer);  
46.   if not(Result) then Exit;  
47.   if Buffer = nil then Exit;  
48.   
49.   aFieldType := Self.InternalFields.FieldType[FieldNo -1];  
50.   
51.   if aFieldType = uftTimestamp then  
52.   begin  
53.    doubleBuf := TDateTime(Buffer^);  
54.     tsbuf := DateTimeToTimeStamp(doubleBuf);  
55.   
56.    Double(Buffer^) :=  TimeStampToMSecs(tsbuf);  
57.  end;  
58. end;  
59.   
60. function TUIBCdsDataSet.GetFieldData(Field: TField; Buffer: Pointer;  
61.   NativeFormat: Boolean): Boolean;  
62. var  
63.  //SF : TSQLResult;  
64.   doubleBuf : TDateTime;  
65.   aFieldType: TUIBFieldType;  
66.   tsbuf : TTimeStamp;  
67. begin  
68.   
69.   Result := inherited GetFieldData(Field, Buffer,NativeFormat);  
70.   if not(Result) then Exit;  
71.   if Buffer = nil then Exit;  
72.   
73.   //SF := Self.InternalFields;  
74.   aFieldType := Self.InternalFields.FieldType[Field.FieldNo-1];  
75.   
76.   if aFieldType = uftTimestamp then  
77.   begin  
78.    doubleBuf := TDateTime(Buffer^);  
79.     tsbuf := DateTimeToTimeStamp(doubleBuf);  
80.   
81.    Double(Buffer^) :=  TimeStampToMSecs(tsbuf);  
82.   end;  
83.   
84. end;  
85.   
86. end.  

unit UIBCdsDataSet;

interface

uses
  SysUtils, Classes, DB, uibdataset;

type
  TUIBCdsDataSet = class(TUIBDataSet)
  private
    { Private 宣言 }
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload;{$IFNDEF FPC} override; {$ENDIF}
    {$IFNDEF FPC}
    function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; override;
    {$ENDIF}
  published
    { Published 宣言 }
  end;

procedure Register;

implementation

uses uiblib;

procedure Register;
begin
  RegisterComponents('UIB', [TUIBCdsDataSet]);
end;

{ TUIBCdsDataSet }

function TUIBCdsDataSet.GetFieldData(FieldNo: Integer;
  Buffer: Pointer): Boolean;
var
  doubleBuf : TDateTime;
  aFieldType: TUIBFieldType;
  tsbuf : TTimeStamp;
begin

 Result := inherited GetFieldData(FieldNo, Buffer);
  if not(Result) then Exit;
  if Buffer = nil then Exit;

  aFieldType := Self.InternalFields.FieldType[FieldNo -1];

  if aFieldType = uftTimestamp then
  begin
   doubleBuf := TDateTime(Buffer^);
    tsbuf := DateTimeToTimeStamp(doubleBuf);

   Double(Buffer^) :=  TimeStampToMSecs(tsbuf);
 end;
end;

function TUIBCdsDataSet.GetFieldData(Field: TField; Buffer: Pointer;
  NativeFormat: Boolean): Boolean;
var
 //SF : TSQLResult;
  doubleBuf : TDateTime;
  aFieldType: TUIBFieldType;
  tsbuf : TTimeStamp;
begin

  Result := inherited GetFieldData(Field, Buffer,NativeFormat);
  if not(Result) then Exit;
  if Buffer = nil then Exit;

  //SF := Self.InternalFields;
  aFieldType := Self.InternalFields.FieldType[Field.FieldNo-1];

  if aFieldType = uftTimestamp then
  begin
   doubleBuf := TDateTime(Buffer^);
    tsbuf := DateTimeToTimeStamp(doubleBuf);

   Double(Buffer^) :=  TimeStampToMSecs(tsbuf);
  end;

end;

end.

これで時刻型のフィールドでエラーが発生することなく連携ができた。