請問TArrayField回傳問題?
小弟寫了一小段程式回傳TArrayField的函式,Compile及執行的都沒問題
但程式當要結束時就出現Access violation ....等錯誤訊息?
感謝回應!    unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    dbs: TDatabase;
    qWork: TQuery;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function myfun: TArrayField;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
  data: TArrayField;
  i : integer;
begin
  data := myfun;
  i := data.FieldCount;
  ShowMessage(IntToStr(i));
end;    function TForm1.myfun: TArrayField;
var
  myfd: TArrayField;
  i : Integer;
begin
   myfd := TArrayField.Create(self);
   qWork.Close;
   qWork.SQL.Clear;
   qWork.SQL.Add('select * from custom');
   qWork.Open;
   if not qWork.Eof then
       for i:= 0 to qWork.FieldCount -1 do
          myfd.Fields.Add(qWork.Fields.Fields[i]);
   Result := myfd;
end;
end.
 

Delphi Man

------
Delphi

引言:

 
請問TArrayField回傳問題?
小弟寫了一小段程式回傳TArrayField的函式,Compile及執行的都沒問題
但程式當要結束時就出現Access violation ....等錯誤訊息?
感謝回應!    unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    dbs: TDatabase;
    qWork: TQuery;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function myfun: TArrayField;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
  data: TArrayField;
  i : integer;
begin
  data := myfun;
  i := data.FieldCount;
  ShowMessage(IntToStr(i));
end;    function TForm1.myfun: TArrayField;
var
  myfd: TArrayField;
  i : Integer;
begin
   myfd := TArrayField.Create(nil);
   qWork.Close;
   qWork.SQL.Clear;
   qWork.SQL.Add('select * from custom');
   qWork.Open;
   if not qWork.Eof then
       for i:= 0 to qWork.FieldCount -1 do
          myfd.Fields.Add(qWork.Fields.Fields[i]);
   Result := myfd;
end;
end.
 

Delphi Man

修改紅色的部份即將myfd := TArrayField.Create(Self);改為myfd := TArrayField.Create(nil); ~小弟淺見，參考看看~

非常感謝! Delphi Man

------
Delphi

對不起, 純討論 src="http://delphi.ktop.com.tw/loadfile.php?TOPICID=9196579&CC=205681">

請問Mickey版主要如何處理比較好? Delphi Man

------
Delphi

用 TArrayField 去存 DataSet.Fields 資訊似乎不太恰當, Access violation Error 應是 qWork 與 Run-Time Created TArrayField 都會去 Free TFields, 結果造成 Form Close 時 error (因為 qWork / ArrayField owner 都是 Form1).    建議用 TStrings 去儲存 Fields 資訊 :

type
  TForm1 = class(TForm)
    qWork: TQuery;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FD : TStrings;
  public
    { Public declarations }
  end;    var
  Form1: TForm1;    implementation    {$R *.dfm}    procedure TForm1.FormCreate(Sender: TObject);
begin
  FD := TStringList.Create;
end;    procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FD<>nil then FD.Free;
end;    procedure TForm1.Button1Click(Sender: TObject);
var  i : Integer;
begin
  qWork.Close;
  qWork.SQL.Clear;
  qWork.SQL.Add('select * from customer');
  qWork.Open;
  if qWork.Active then
    for i:= 0 to qWork.FieldCount -1 do
      FD.AddObject(qWork.Fields.Fields[i].FieldName,qWork.Fields.Fields[i]);
    ShowMessage(IntToStr(FD.count));
end;    

取出時, 只需Cast : TField(FD.Objects[i]) 就可以了. 記得 ! 無須手動 FreeAndNil(FD.Objects[i]) 交給 qWork 就可以.

感謝版主解答! 此函式其目的是傳入鍵值 傳回Table的整筆Record. 例如傳入客戶編號及TableName 傳回客戶Table的整筆Record 用TArrayField回傳是希望用到Fieldname及FieldValue 這樣取出時就可直接指定Fieldname取出,而不用知道這欄位在第幾個序, 例如fd.fieldbyanme('cus_name').asstring 把這些動作包作函式,是希望解決每次都要用TDataSet下SQL的困擾! 小弟想把此函式實作在Multi-Tier的App Server端,不過好像無法用 TArrayField回傳,請問如果改VarArray實作Record用Variant回傳,要如何處理? 感謝回應! Delphi Man

------
Delphi

1. 剛剛試一下 TArrayField 應是 for Oracle VARRAY Object Datatype 的. 2. 只是要回傳 Variant ? qWork['Col1;Col2;Col3;...'] 是你要的嗎 ？ 發表人 - Mickey 於 2003/05/06 10:28:18

找到ccchen 大大以前的作品, 海量的他, 應該會海涵, 參考看看.

type
 RecBuf=class(TStringList)
  DataSet:TDataSet;
  constructor Create(vDataSet:TDataSet;const flds:array of string);
  Destructor Destroy;override;
  function  value(id:integer): variant;
  function  field(fldname: string): variant;
  procedure ClearFlds;
  procedure Gather(const flds:array of string);
  procedure Refresh;
  procedure Scatter(vDataSet:TDataSet);
  procedure Search;  // note: only [ftString, ftSmallint, ftInteger, ftFloat] are used
  function  isBufCurrent: boolean;  // check if buffer is same with Current Record
end;    constructor RecBuf.Create(vDataSet:TDataSet;const flds:array of string);
begin
  inherited create;
  DataSet := vDataSet;
  Gather(flds);
end;    procedure RecBuf.ClearFlds;
var i:integer;
begin
  for i := 0 to count-1 do begin
    if objects[i]<>nil then Dispose(pointer(objects[i]));
    objects[i] := nil;
  end;
  clear;
end;    Destructor RecBuf.Destroy;
begin
  ClearFlds;
  inherited;
end;    function RecBuf.value(id:integer): variant;
var p:^variant;
    s: string;
begin
  s := '';
  if ((id < 0) or (id > count)) then
    Result := varnull
  else begin
    p := pointer(objects[id]);
    if p^=null then
      result := s
    else
      result := p^;
  end;
end;    procedure RecBuf.Gather(const flds:array of string);
var p:^variant;
    i:integer;
    s: string;
begin
  Clearflds;
  with DataSet do begin
    if flds[0]='*' then begin
      for i := 0 to fieldcount-1 do begin
        new(p);
        p^ := Fields[i].value;
        addobject(Fields[i].fieldname,TObject(p));
      end;
    end
    else begin
      for i := 0 to High(flds) do begin
        s := flds[i];// a Delphi's bug here. if not doing this, i will be removed by compiler
        new(p);
        p^ := FieldByName(s).value;
        addobject(s,TObject(p));
      end;
    end;
  end;
end;    procedure RecBuf.Refresh;
var i:integer;
    p:^variant;
begin
  for i := 0 to count-1 do begin
    p := pointer(objects[i]);
    p^ := DataSet.FieldByName(strings[i]).value;
  end;
end;    procedure RecBuf.Scatter(vDataSet:TDataSet);
var i:integer;
    p:^variant;
begin
  for i := 0 to count-1 do
    if vDataSet.FieldByName(strings[i]) <> nil then begin
      p := pointer(objects[i]);
      vDataSet.FieldByName(strings[i]).value := p^;
    end;
end;    procedure RecBuf.Search;
var bufValues,p: Variant;
    i,j,n:integer;
    fldsname: string;
    fld:TField;
begin
  n := 0;
  for i := 0 to count-1 do begin
//    if value(i)<>null then begin
    p := value(i);
    if ( (not varisnull(p)) and (varastype(p,varstring) <>'')) then begin
      fld := DataSet.FieldByName(strings[i]);
      if fld.datatype in [ftString, ftSmallint, ftInteger, ftFloat] then
        if  ((not fld.Calculated) and (not fld.Lookup)) then begin
          if n<>0 then fldsname := fldsname  ';';
          fldsname := fldsname strings[i];
          n := n 1;
        end;
    end;
  end;      bufValues := VarArrayCreate([0, n-1], varVariant);
  j := 0;
  for i := 0 to count-1 do begin
    p := value(i);
    if ( (not varisnull(p)) and (varastype(p,varstring) <>'')) then begin
//    if value(i)<>null then begin
      fld := DataSet.FieldByName(strings[i]);
      if fld.datatype in [ftString, ftSmallint, ftInteger, ftFloat] then
        if  ((not fld.Calculated) and (not fld.Lookup)) then begin
          bufvalues[j] := value(i);
          j := j 1;
        end;
    end;
  end;
  if n= 1 then
    DataSet.locate(fldsname,bufvalues[0],[loPartialKey])
  else
    DataSet.locate(fldsname,bufvalues,[loPartialKey]);
end;    function RecBuf.isBufCurrent: boolean;  // check if buffer is same with Current Record
var i:integer;
begin
  Result := True;
  for i := 0 to count -1 do
    if DataSet[strings[i]] <> value(i) then begin
      result := False;
      Break;
    end;
end;    function RecBuf.field(fldname: string): variant;
var id:integer;
begin
  id := indexof(fldname);
  if ((id >=0) and (id < count)) then
    result := value(id);
end;

發表人 - Mickey 於 2003/05/06 11:00:04

    2.回傳資料型態為Variant的Record,假設Table有10個欄位
  在函式中先
var fd: Variant;
fd := VarArryCreate([1,10], varVariant);
for i:= 0 to fieldcount -1 do
begin
   fd[i][0] := qWork.field[i].fieldname; //String;
   fd[i][1] := qWork.field[i].value; //Variant;    
end;
傳回時取用 
fd[0][0] ==> fieldname
fd[0][1] ==> fieldvalue    感謝版主提供豐盛的程式碼!
因為小弟功力不足,有點困難看,麻煩介紹一下如何引用!
謝謝!

Delphi Man

------
Delphi

1. Form1 宣告一個 :   drecbuf:RecBuf; 2. Query1 AfterOpen :   if drecbuf <> nil then drecbuf.free;   drecbuf:=RecBuf.Create(Query1,['*']); // * 指所有欄位 3. 需要取值 drecbuf.Gather(['*']); 4. Query1.Afterclose :   if drecbuf <> nil then drecbuf.free; 其實該 RecBuf Class 並不難, 原理大致是以 TStringList 去紀錄 Field Values, Text 記 FieldName, Value 則 Cast 成 TObject 記入 TStringList.Objects.    你的問題解決就好, RecBuf 有空再看, 應該會有一些收穫.

不愧是版主!總能指點迷津

------
Delphi