www.pudn.com > sybase_dblib4.zip > Sybgrid.pas

unit sybgrid; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  Grids,DsgnIntf,sybase_components,u_cancel_query; 
 
const opt = [goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,goRangeSelect,goDrawFocusSelected,goColSizing,goTabs,goThumbTracking]; 
 
type 
  SybObjectname = string[30]; 
 
type 
  Tsybobjectproperty = class(TStringProperty) 
  public 
    procedure GetValues(TheProc: TGetStrProc); override; 
    function getattributes:Tpropertyattributes; override; 
  end; 
 
type 
  Tstringsproperty = class(TPropertyEditor) 
  public 
    function getvalue:string; override; 
    procedure setvalue(const value :string); override; 
    procedure edit;override; 
    function getattributes:Tpropertyattributes; override; 
  end; 
 
type 
  TSybGrid = class; 
  Threadgrid = class(TThread) 
  private 
    { Private declarations } 
    fparent        :tsybgrid; 
    f_cancel_query :Tf_cancel_query; 
  protected 
    constructor create(b:boolean;AOwner:tsybgrid); virtual; 
    procedure Execute; override; 
  end; 
 
  tsybgrid = class(TStringGrid) 
  private 
    { Private declarations } 
    FSql           :ansistring; 
    FDbname        :SybObjectname; 
    FDesignActive  :boolean; 
    FRowsReturned  :boolean; 
    FColumnCount   :integer; 
    FAutoDbProc    :boolean; 
    FDbProc        :integer; 
    FBackground    :boolean; 
    fShowLineNum   :boolean; 
    fShowRowCount  :boolean; 
    sql_buffer     :tstrings; 
    procedure setshowlinenum(Value:boolean); 
    procedure setshowrowcount(Value:boolean); 
    procedure setbackground(Value:boolean); 
    procedure SetDbProc(Value :integer); 
    procedure SetAutoDbProc(Value :boolean); 
    procedure SetSql(Value :ansistring); 
    procedure SetDbName(Value :SybObjectname); 
    procedure SetDesignActive(Value :boolean); 
    procedure SetRowsReturned(Value :boolean); 
    function GetTerminated:boolean; 
    procedure get_sql_commands; 
  protected 
    { Protected declarations } 
     procdict: tstringlist; 
     linenum    :integer; 
     procedure get_dbproc; 
  public 
    { Public declarations } 
    thread         :Threadgrid; 
    Login,Retcode,retcode2,nocols,col:integer; 
    dbprocc:integer; 
    fontsize,numcols      :integer; 
    sql_commands          :tstrings; 
    constructor create(AOwner:TComponent); override; 
    destructor Destroy; override; 
    procedure addsql(Value :ansistring); 
    procedure clearsql; 
    function sqlexec:integer; 
    function heading(index:byte):string; 
    function coltype(index:byte):string; 
    function collength(index:byte):integer; 
    function ischar(index:byte):boolean; 
    function colindex(value:string):smallint; 
  published 
    { Published declarations } 
    procedure LoadSqlFromFile(FileName :string); 
    property Terminated:boolean read GetTerminated; 
    property DbName :SybObjectname read FDbName write setDbname; 
    property Sql :ansistring read FSql write SetSql; 
    property DesignActive:boolean read fdesignactive write setdesignactive stored false; 
    property ShowLineNum:boolean read fshowlinenum write setshowlinenum stored true; 
    property ShowRowCount:boolean read fshowrowcount write setshowrowcount stored true; 
    property RowsReturned:boolean read fRowsReturned write setRowsReturned default false; 
    property AutoDbProc:boolean read FAutoDbProc write SetAutoDbProc default true; 
    property Background:boolean read FBackground write SetBackground default false; 
    property ColumnCount :integer read FColumnCount; 
    property DbProc:integer read FDbproc write SetDbProc default 0; 
  end; 
 
procedure Register; 
 
implementation 
uses sybase32, 
     objectlistdlg, 
     ansistringedit, 
     sybdatabase, 
     sybquery; 
 
procedure Register; 
begin 
  RegisterPropertyEditor(TypeInfo(SybObjectname),tsybgrid,'',Tsybobjectproperty); 
  RegisterPropertyEditor(TypeInfo(AnsiString),tsybgrid,'Sql',TstringsProperty); 
  RegisterComponents('Sybase DBLIB', [tsybgrid]); 
end; 
 
constructor tsybgrid.create(AOwner:TComponent); 
begin 
  inherited create(AOwner); 
  Fdesignactive:=false; 
  Fautodbproc:=true; 
  FBackground:=false; 
  Fdbproc:=0; 
  Fshowlinenum:=true; 
  Fshowrowcount:=true; 
  Defaultrowheight:=20; 
  rowcount:=2; 
  colcount:=2; 
  font.name:='Courier'; 
  font.size:=9; 
  fontsize:=font.size; 
  numcols:=font.size; 
  options:=opt; 
  fixedrows:=1; 
  sql_commands:=tstringlist.create; 
end; 
 
destructor tsybgrid.Destroy; 
begin 
  sql_commands.Free; 
  inherited destroy; 
end; 
 
procedure tsybgrid.SetAutoDbPRoc(Value :boolean); 
begin 
  FAutoDbProc:=value; 
end; 
 
function tsybgrid.GetTerminated:boolean; 
begin 
  if thread <> nil then 
    result:=thread.terminated; 
end; 
 
procedure tsybgrid.SetBackground(Value :boolean); 
begin 
  FBackground:=value; 
end; 
 
procedure tsybgrid.SetShowLineNum(Value :boolean); 
begin 
  FShowLineNum:=value; 
end; 
 
procedure tsybgrid.SetShowRowCount(Value :boolean); 
begin 
  FShowRowCount:=value; 
end; 
 
procedure tsybgrid.SetDbProc(Value :integer); 
begin 
  FDbproc:=Value; 
  Dbprocc:=Value; 
end; 
 
procedure tsybgrid.SetSql(Value :ansistring); 
begin 
  FSql:=Value; 
end; 
 
procedure tsybgrid.Setdesignactive(Value :boolean); 
begin 
  if value then 
  begin 
    get_dbproc; 
    if (length(sql) > 1) then 
    sqlexec; 
  end; 
  Fdesignactive:=Value; 
end; 
 
procedure tsybgrid.SetRowsReturned(Value:boolean); 
begin 
  FRowsReturned:=value; 
end; 
 
procedure tsybgrid.addsql(Value :ansistring); 
begin 
  FSql:=FSql + Value; 
end; 
 
procedure tsybgrid.clearsql; 
begin 
  FSql:=''; 
end; 
 
procedure tsybgrid.SetDbname(Value :SybObjectname); 
begin 
  FDbname:=value; 
  get_dbproc; 
end; 
 
function tsybgrid.sqlexec:integer; 
var value             :string[255]; 
    i,j,nc            :integer; 
    p                 :pchar; 
    rows,first        :integer; 
    sql_count         :integer; 
    max_numcols       :integer; 
    max_rows_return   :integer; 
    col_widths        :array[1..300] of smallint; 
 
begin 
  get_dbproc; 
  if dbproc = 0 then 
    exit; 
  for i:=1 to 300 do 
    col_widths[i]:=10; 
  get_sql_commands; 
  if FBackground then 
  begin 
    thread:=Threadgrid.create(false,self); 
    exit; 
  end; 
 
  for j:=1 to rowcount do 
    for i:=1 to numcols do 
    begin 
      cells[i,j]:=''; 
    end; 
 
  rowcount:=2; 
  colcount:=2; 
  fixedrows:=1; 
  Retcode := Dbcanquery(dbProc); 
 
  max_numcols:=1; 
  refresh; 
  retcode2:=0; 
  linenum:=1; 
  first:=1; 
  max_rows_return:=fail; 
 
  for sql_count:=0 to sql_commands.count-1 do 
  begin 
    p:=pchar(sql_commands[sql_count]); 
    Retcode:=dbcmd(dbProc,p); 
    Retcode:=dbsqlexec(dbProc); 
    Retcode:=dbresults(dbProc); 
    rows:=dbcmdrow(dbProc); 
    Result:=retcode; 
 
    if rows = fail then 
    begin 
    end 
    else 
    begin 
      max_rows_return:=succeed; 
    end; 
 
    numcols:=dbnumcols(dbProc); 
    if numcols > max_numcols then 
      max_numcols:=numcols; 
    nc:=numcols; 
    FColumncount:=max_numcols; 
    colcount:=max_numcols + 1; 
 
    while (retcode <> No_more_results) and (retcode <> Fail) do 
    begin 
      if retcode = Succeed then 
      begin 
        rows:=dbrows(dbProc); 
        if rows <> fail then 
        begin 
          cells[0,linenum]:=' '; 
          if showlinenum then 
            if linenum > 0 then 
              cells[0,linenum]:=inttostr(linenum); 
          for i:=1 to numcols do 
          begin 
            if (length(strpas(dbcolname(dbProc,i))) * fontsize > colwidths[i]) then 
              colwidths[i]:=length(strpas(dbcolname(dbProc,i))) * fontsize; 
            cells[i,linenum]:=dbcolname(dbProc,i); 
            col_widths[i]:=colwidths[i]; 
          end; 
          rowcount:=rowcount + 1; 
          inc(linenum); 
        end; 
 
        retcode2 := dbnextrow(dbProc); 
 
        while retcode2 <> No_More_Rows do 
        Begin 
          if first = 0 then 
            rowcount:=rowcount + 1 
          else 
            first:=0; 
 
          cells[0,linenum]:=' '; 
          if showlinenum then 
            if linenum > 0 then 
              cells[0,linenum]:=inttostr(linenum); 
          colwidths[0]:=length(cells[0,linenum]) * fontsize + 5; 
 
          if not showlinenum then 
            colwidths[0]:=13; 
 
          for i:=1 to numcols do 
          begin 
            if (length(strpas(dbvalue(dbProc,i))) * fontsize > colwidths[i]) then 
              colwidths[i]:=length(strpas(dbvalue(dbProc,i))) * fontsize; 
            cells[i,linenum]:=dbvalue(dbProc,i); 
            if length(cells[i,linenum])=0 then 
              cells[i,linenum]:=' '; 
            col_widths[i]:=colwidths[i]; 
          end; 
          inc(linenum); 
          retcode2 := dbnextrow(dbProc); 
          result:=retcode2; 
        end; 
      end; 
      Retcode := dbresults(dbproc); 
 
      rows:=dbrows(dbProc); 
      if rows = fail then 
      begin 
      end 
      else 
      begin 
        max_rows_return:=succeed; 
      end; 
 
      numcols:=dbnumcols(dbProc); 
      if numcols > max_numcols then 
        max_numcols:=numcols; 
 
      colcount:=max_numcols + 1; 
 
      for i:=1 to max_numcols do 
      begin 
        if colwidths[i] nil then 
      for i:=0 to (sybase_components.databaseslist.count-1) do 
      begin 
        adatabase:=databaseslist[i]; 
        theproc(adatabase.name); 
      end; 
  end 
end; 
 
function Tsybobjectproperty.getattributes:Tpropertyattributes; 
begin 
  Result := [paValueList,paAutoUpdate,paMultiSelect]; 
end; 
 
procedure tsybgrid.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; 
 
constructor Threadgrid.create(b:boolean;AOwner:tsybgrid); 
begin 
   fparent:=AOwner; 
   inherited create(b); 
   fparent:=AOwner; 
 
{   f_cancel_query:=Tf_cancel_query.create(fparent); 
   f_cancel_query.show; 
   f_cancel_query.close; 
   f_cancel_query.free;} 
end; 
 
procedure Threadgrid.Execute; 
var value             :string[255]; 
    i,j,nc    :integer; 
    p                 :pchar; 
    rows,first        :integer; 
    RetCode,retcode2  :integer; 
    max_rows_return   :integer; 
    max_numcols       :integer; 
    sql_count         :integer; 
    col_widths        :array[1..300] of smallint; 
 
begin 
 
  freeonterminate:=true; 
  for j:=1 to fparent.rowcount do 
    for i:=1 to fparent.numcols do 
    begin 
      if terminated then 
      begin 
        fparent.thread.destroy; 
        exit; 
      end; 
      fparent.cells[i,j]:=''; 
    end; 
  fparent.rowcount:=2; 
  fparent.fixedrows:=1; 
  fparent.colcount:=2; 
  for i:=1 to 300 do 
    col_widths[i]:=10; 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
  Retcode := Dbcanquery(fparent.dbProc); 
  max_numcols:=1; 
 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
 
  fparent.linenum:=1;  {XX} 
  first:=1; 
  for sql_count:=0 to fparent.sql_commands.count-1 do 
  begin 
 
  p:=pchar(fparent.sql_commands[sql_count]); 
 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
  Retcode:=dbcmd(fparent.dbProc,p); 
  if terminated then 
  begin 
    destroy; 
    fparent.thread.destroy; 
    exit; 
  end; 
  Retcode:=dbsqlexec(fparent.dbProc); 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
  Retcode:=dbresults(fparent.dbProc); 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
 
  rows:=dbrows(fparent.dbProc); 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
  if rows = fail then 
  begin 
  end 
  else 
  begin 
    max_rows_return:=succeed; 
  end; 
   
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
 
{  Result:=retcode;} 
 
  fparent.numcols:=dbnumcols(fparent.dbProc); 
  if fparent.numcols> max_numcols then 
    max_numcols:=fparent.numcols; 
 
  nc:=fparent.numcols; 
  fparent.FColumncount:=max_numcols; 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
 
  fparent.colcount:=max_numcols + 1; 
 
  if terminated then 
  begin 
    fparent.thread.destroy; 
    exit; 
  end; 
 
  while (retcode <> No_more_results) and (retcode <> Fail) do 
  begin 
    if terminated then 
    begin 
      fparent.thread.destroy; 
      exit; 
    end; 
    if retcode = Succeed then 
    begin 
      if terminated then 
      begin 
        fparent.thread.destroy; 
        exit; 
      end; 
 
      rows:=dbrows(fparent.dbProc); 
      if rows <> fail then 
      begin 
        fparent.cells[0,fparent.linenum]:=' '; 
        if fparent.showlinenum then 
          if fparent.linenum > 0 then 
            fparent.cells[0,fparent.linenum]:=inttostr(fparent.linenum); 
        for i:=1 to fparent.numcols do 
        begin 
          if terminated then 
          begin 
            fparent.thread.destroy; 
            exit; 
          end; 
          fparent.cells[i,fparent.linenum]:=dbcolname(fparent.dbProc,i); 
          if (length(strpas(dbcolname(fparent.dbProc,i))) * fparent.fontsize > fparent.colwidths[i]) then 
            fparent.colwidths[i]:=length(strpas(dbcolname(fparent.dbProc,i))) * fparent.fontsize; 
          col_widths[i]:=fparent.colwidths[i]; 
        end; 
        fparent.rowcount:=fparent.rowcount + 1; 
        inc(fparent.linenum); 
      end; 
 
      retcode2 := dbnextrow(fparent.dbProc); 
      while retcode2 <> No_More_Rows do 
      Begin 
        if terminated then 
        begin 
          fparent.thread.destroy; 
          exit; 
        end; 
 
        if first = 0 then 
          fparent.rowcount:=fparent.rowcount + 1 
        else 
          first:=0; 
 
        fparent.cells[0,fparent.linenum]:=' '; 
        if fparent.showlinenum then 
          if fparent.linenum > 0 then 
            fparent.cells[0,fparent.linenum]:=inttostr(fparent.linenum); 
        fparent.colwidths[0]:=length(fparent.cells[0,fparent.linenum]) * fparent.fontsize + 5; 
        if not fparent.showlinenum then 
          fparent.colwidths[0]:=13; 
        for i:=1 to fparent.numcols do 
        begin 
          if terminated then 
          begin 
            fparent.thread.destroy; 
            exit; 
          end; 
          if (length(strpas(dbvalue(fparent.dbProc,i))) * fparent.fontsize > fparent.colwidths[i]) then 
            fparent.colwidths[i]:=length(strpas(dbvalue(fparent.dbProc,i))) * fparent.fontsize; 
          fparent.cells[i,fparent.linenum]:=dbvalue(fparent.dbProc,i); 
          if length(fparent.cells[i,fparent.linenum])=0 then 
            fparent.cells[i,fparent.linenum]:=' '; 
          col_widths[i]:=fparent.colwidths[i]; 
        end; 
        if terminated then 
        begin 
          fparent.thread.destroy; 
          exit; 
        end; 
        inc(fparent.linenum); 
        retcode2 := dbnextrow(fparent.dbProc); 
{        result:=retcode2;} 
      end; 
    end; 
    if terminated then 
    begin 
      fparent.thread.destroy; 
      exit; 
    end; 
    Retcode := dbresults(fparent.dbproc); 
    fparent.numcols:=dbnumcols(fparent.dbProc); 
    if fparent.numcols > max_numcols then 
      max_numcols:=fparent.numcols; 
    fparent.colcount:=max_numcols + 1; 
 
    for i:=1 to max_numcols do 
    begin 
      if fparent.colwidths[i] length(sql_comm) then 
      begin 
        l:=copy(sql_comm,lastfound,length(sql_comm)-lastfound+1); 
        if length(trim(l))>0 then 
        begin 
          sql_commands.add(l); 
          if ShowRowCount then 
          begin 
            sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"'); 
          end; 
        end; 
      end; 
      if sql_commands.Count=1 then 
         sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"'); 
      exit; 
    end; 
    if iFoundPosit > 0 then 
    begin 
      ifCurrentpos:=iFoundPosit+char_indx+1; 
      char_indx:=ifCurrentpos-1; 
      l:=copy(sql_comm,lastfound,ifCurrentpos-lastfound-length(sFindText)); 
      sql_commands.add(l); 
      if ShowRowCount then 
      begin 
        sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"'); 
      end; 
      l:=''; 
      lastfound:=ifCurrentpos + length(sFindText)-1; 
      inc(go_count); 
    end; 
  end; 
  if sql_commands.Count=1 then 
     sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"'); 
end; 
 
end.