sybgrid.pas

sybase大全

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]<col_widths[i] then
          colwidths[i]:=col_widths[i];
      end;
    end;

  end;
  if max_rows_return = succeed then
    setrowsreturned(true)
  else
    setrowsreturned(false);

end;

function tsybgrid.colindex(value:string):smallint;
var i   :smallint;
begin
  for i:=1 to colcount-1 do
  begin
    if value=heading(i) then
    begin
      result:=i;
      exit;
    end;
  end;
end;

procedure tsybgrid.LoadSqlFromFile(FileName :string);
begin
  clearsql;
  sql:=sybase_components.LoadFromFile(FileName);
end;

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

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

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

function tsybgrid.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