⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sybtable.pas

📁 sybase大全
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      -2 :begin
            if first_flag then
            begin
              navigator.btnfirst.enabled:=false;
              navigator.btnprior.enabled:=false;
              navigator.btnnext.enabled:=false;
              navigator.btnlast.enabled:=false;
            end;
          end;
    end;
    currrownum:=dbcurrow(dbProc);
    if currrownum > lastrownum then
      lastrownum:=currrownum;
  end
  else
    result:=No_More_Rows;
end;

function Tsybtable.prevrow:integer;
var value :string[255];
    retcode3:integer;
begin
  result:=0;
  if (retcode = Succeed) then
  begin
    currrownum:=dbcurrow(dbProc);
    if currrownum > 1 then
      dec(currrownum);
    retcode3 := dbgetrow(dbproc,currrownum);
    if fupdatefields then
      update_fields;
    if currrownum = 1 then
    begin
      navigator.btnfirst.enabled:=false;
      navigator.btnprior.enabled:=false;
      navigator.btnnext.enabled:=true;
      navigator.btnlast.enabled:=true;
    end
    else
    begin
      navigator.btnfirst.enabled:=true;
      navigator.btnprior.enabled:=true;
      navigator.btnnext.enabled:=true;
      navigator.btnlast.enabled:=true;
    end;
    Result:=retcode3;
  end
  else
  begin
    retcode:=No_More_Rows;
    result:=No_More_Rows;
  end;
end;


function Tsybtable.firstrow:integer;
var value :string[255];
    retcode3:integer;
begin

  result:=0;
  if (retcode = Succeed) then
  begin
    retcode3 := dbgetrow(dbproc,firstrownum);
    Result:=retcode3;
    if fupdatefields then
      update_fields;
    navigator.btnfirst.enabled:=false;
    navigator.btnprior.enabled:=false;
    navigator.btnnext.enabled:=true;
    navigator.btnlast.enabled:=true;
  end
  else
    result:=No_More_Rows;
end;

function Tsybtable.lastrow:integer;
var value :string[255];
    retcode3:integer;
begin
  result:=0;
  if (retcode = Succeed) then
  begin
    retcode3 := dbgetrow(dbproc,dblastrow(dbProc));
    Result:=retcode3;
    if fupdatefields then
      update_fields;
    navigator.btnfirst.enabled:=true;
    navigator.btnprior.enabled:=true;
    navigator.btnnext.enabled:=false;
    navigator.btnlast.enabled:=false;
  end
  else
    result:=No_More_Rows;
end;

function Tsybtable.column(index:byte):string;
begin
  result:=strpas(dbvalue(dbproc,index))
end;

function Tsybtable.heading(index:byte):string;
begin
  result:=strpas(dbcolname(dbproc,index))
end;

function Tsybtable.coltype(index:byte):string;
begin
  result:=strpas(dbprtype(dbcoltype(dbproc,index)))
end;

function Tsybtable.collength(index:byte):integer;
begin
  result:=dbcollen(dbproc,index)
end;

function Tsybtable.ischar(index:byte):boolean;
var colltyp  :string;
begin
  result:=false;
  if (coltype(index)='char')
    or (coltype(index)='text')
    or (coltype(index)='datetime')
    or (coltype(index)='smalldatetime') then
  begin
    result:=true;
    exit;
  end;
  if (coltype(index)='binary')
    or (coltype(index)='tinyint')
    or (coltype(index)='smallint')
    or (coltype(index)='int')
    or (coltype(index)='float')
    or (coltype(index)='real')
    or (coltype(index)='numeric')
    or (coltype(index)='decimal')
    or (coltype(index)='bit')
    or (coltype(index)='money')
    or (coltype(index)='smallmoney')
    or (coltype(index)='sum')
    or (coltype(index)='avg')
    or (coltype(index)='count')
    or (coltype(index)='min')
    or (coltype(index)='max') then
  begin
    result:=false;
  end;
end;

procedure Tsybobjectproperty.GetValues(TheProc: TGetStrProc);
var
  Login,Retcode,retcode2,i:integer;
  dbname :SybObjectname;
  s      :string;
  tslist:Tsybtable;
  SqlCommand :sqlstring;
  adatabase :tsybdatabase;
  asproc    :tsybsproc;
begin
  tslist:=Tsybtable(getcomponent(0));

{  if getname='FieldsLst' then
  begin
    for i:=0 to tslist.ffields_list.count-1 do
      theproc(tslist.ffields_list[i]);
  end;}

  if getname = 'DbName' then
  begin
    if databaseslist <> nil then
      for i:=0 to (sybase_components.databaseslist.count-1) do
      begin
        adatabase:=databaseslist[i];
        theproc(adatabase.name);
      end;
  end
  else
  if (getname = 'SProcUpdate')
    or (getname = 'SProcInsert')
    or (getname = 'SProcDelete') then
  begin
    if sybase_components.sproclist <> nil then
      for i:=0 to (sybase_components.sproclist.count-1) do
      begin
        asproc:=sproclist[i];
        theproc(asproc.name);
      end;
  end
  else
  if tslist.dbproc > 40 then
  begin
    if getname = 'TableName' then
    begin
      strpcopy(Sqlcommand,'select name from sysobjects where type in ("U","S") order by name');

      Retcode := dbcmd(tslist.dbProc,@Sqlcommand);
      Retcode := Dbsqlexec(tslist.dbProc);
      Retcode := dbresults(tslist.dbProc);
      retcode2:=0;
      while (retcode <> No_more_results) and (retcode <> Fail) do
      begin
        if retcode = Succeed then
        begin
          retcode2 := dbnextrow(tslist.dbProc);
          while retcode2 <> No_More_Rows do
          Begin
            theproc(strpas(dbvalue(tslist.dbproc,1)));
            retcode2 := dbnextrow(tslist.dbProc);
          end;
        end;
        Retcode := dbresults(tslist.dbproc);
      end;
    end;
{    ServList.add(copy(l,2,length(l)-2));}


  end
  else
  showmessage('Not connected to database !');
end;

function Tsybobjectproperty.getattributes:Tpropertyattributes;
begin
  Result := [paValueList,paAutoUpdate,paMultiSelect];
end;

procedure tsybtable.get_dbproc;
var i         :integer;
    adatabase :tsybdatabase;
begin
  if not autodbproc then
    exit;
  if databaseslist <> nil then
    for i:=0 to (sybase_components.databaseslist.count-1) do
    begin
      adatabase:=databaseslist[i];
      if FDbName = adatabase.name then
      begin
        setdbproc(adatabase.dbproc);
        break;
      end;
    end;
end;

function Tstringsproperty.getvalue:string;
begin
  result:=getstrvalue;
end;

procedure Tstringsproperty.setvalue(const value:string);
begin
  setstrvalue(value);
end;

procedure Tstringsproperty.edit;
var
  OKBottomDlg: TOKBottomDlg;
begin
  OKBottomDlg:=TOKBottomDlg.create(nil);
  OKBottomDlg.memo.text:=getstrvalue;
  OKBottomDlg.showmodal;
  if OKBottomDlg.modalresult = mrok then
  begin
    setstrvalue(OKBottomDlg.memo.text);
  end;
end;

function Tstringsproperty.getattributes:Tpropertyattributes;
begin
  result:=[padialog];
end;

procedure tsybtable.addfield(value:SybObjectname);
var i  :smallint;
begin
  for i:=1 to fieldscount do
  begin
    if fields[i]=value then
      exit;
  end;
  inc(fieldscount);
  fields[fieldscount]:=value;
end;

procedure tsybtable.deletefield(value:SybObjectname);
var i,j  :smallint;
    newfields:array[1..100] of SybObjectname;
begin
  j:=0;
  for i:=1 to fieldscount do
  begin
    if fields[i] <> value then
    begin
      inc(j);
      newfields[j]:=fields[i];
    end;
  end;
  fieldscount:=j;
  for i:=1 to fieldscount do
    fields[i]:=newfields[i];
end;

procedure tsybtable.get_databasefields;
var tmpquery :tsybquery;
begin
  if FDesignActive then
  begin
    get_dbproc;
    tmpquery:=tsybquery.create(nil);
    tmpquery.dbname:=dbname;
    tmpquery.dbproc:=dbproc;
    tmpquery.sql:='select name from syscolumns where id = object_id("' + tablename + '") order by colid';
    datafieldscount:=0;
    tmpquery.sqlexec;
    if (tmpquery.nextrow=-1) or (tmpquery.nextrow=1) then
    begin
      inc(datafieldscount);
      datafields[datafieldscount]:=tmpquery.column(1);
{      fldslist.add(datafields[datafieldscount]);}
      while tmpquery.nextrow = -1 do
      begin
        inc(datafieldscount);
        datafields[datafieldscount]:=tmpquery.column(1);
{        fldslist.add(datafields[datafieldscount]);}
      end;
    end;
    tmpquery.free;
  end;

end;

function TSybTable.insert_record:integer;
var i       :integer;
begin
  showmessage(inttostr(sybase_components.fieldslist.count));
  for i:=1 to fieldscount do
  begin
    showmessage(fields[i] + ' = ' + tsybfield(fieldslist.items[i-1]).value);
  end;
end;

function TSybTable.update_record:integer;
begin
  {}
end;

function TSybTable.delete_record:integer;
begin
  {}
end;

procedure TSybTable.update_fields;
var i,j    :integer;
    field  :tsybfield;
begin
  for i:=1 to numcols do
  begin

    if fieldslist <> nil then
    begin
      for j:=0 to fieldslist.count-1 do
      begin
        if (lowercase(tcomponent(fieldslist.items[j]).classname)='tsybedit') then
        begin
          if (tsybfield(fieldslist[j]).dataset = name)
           and (tsybfield(fieldslist[j]).datafield = heading(i)) then
          tsybfield(fieldslist[j]).value:=column(i);
        end
        else
        if (lowercase(tcomponent(fieldslist.items[j]).classname)='tsybmemo') then
        begin
          if (tsybmemo(fieldslist[j]).dataset = name)
           and (tsybmemo(fieldslist[j]).datafield = heading(i)) then
           tsybmemo(fieldslist[j]).value:=column(i);
        end
        else
        if (lowercase(tcomponent(fieldslist.items[j]).classname)='tsybcheckbox') then
        begin
          if (tsybcheckbox(fieldslist[j]).dataset = name)
           and (tsybcheckbox(fieldslist[j]).datafield = heading(i)) then
          tsybcheckbox(fieldslist[j]).value:=column(i);
        end
        else
        if (lowercase(tcomponent(fieldslist.items[j]).classname)='tsybradiobutton') then
        begin
          if (tsybradiobutton(fieldslist[j]).tablename = name)
           and (tsybradiobutton(fieldslist[j]).datafield = heading(i)) then
          tsybradiobutton(fieldslist[j]).value:=column(i);
        end;
      end;
    end;

  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -