sybgenerate.pas

sybase大全

unit sybgenerate;

interface

uses
  stdctrls,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sybase_components,dsgnintf,sybdatabase,
  u_generate1,u_generate2,u_generate3,u_generate4,u_generate25,u_generate5,u_generate27,
  sybnavigator,sybtable,extctrls,sybquery;

const top_of_first_field = 30;
      left_of_first_field = 30;

type
  SybObjectname = string[30];

type
  Tsybobjectproperty = class(TStringProperty)
  public
    procedure GetValues(TheProc: TGetStrProc); override;
    function getattributes:Tpropertyattributes; override;
  end;

type
  TSybGenerate = class(TComponent)
  private
    { Private declarations }
    FDbname      :SybObjectname;
    FDesignActive:boolean;
    FDbProc      :integer;
    fparent      :tcomponent;
    procedure SetDbProc(Value :integer);
    procedure SetDbName(Value :SybObjectname);
    procedure SetDesignActive(Value :boolean);
    procedure get_datatypes;
    procedure create_fields;
    procedure create_table_component;
    procedure create_sproc(sproc_type:integer;procname:sybobjectname);
    function no_under(col:string):string;
    function iskey(name :string):boolean;
    function is_table(name   :SybObjectname):boolean;
  protected
     r_simple,r_masterdetail,
     r_horizontal,r_vertical,r_grid,
     r_left,r_top,
     r_form_only,r_form_procs  :boolean;
     r_table,r_query           :boolean;
     c_form                    :boolean;
     chk_sprocs                :boolean;
     dataset                   :string;
     update_sproc,
     insert_sproc,
     delete_sproc              :SybObjectname;
     field_names               :array[1..100] of string[30];
     field_datatypes           :array[1..100] of string[30];
     field_lengths             :array[1..100] of integer;
     fieldscount               :integer;
     navigator                 :tsybnavigator;
     table                     :tsybtable;
     query                     :tsybquery;
     pan_top,pan_main          :tpanel;
     scbox_main                :tscrollbox;
     first_pos                 :integer;

     procedure get_dbproc;
  public
    dbprocc:integer;
    constructor create(AOwner:TComponent); override;
  published
    { Published declarations }
    property DbName :SybObjectname read FDbName write setDbname;
    property DesignActive:boolean read fdesignactive write setdesignactive stored false;
    property DbProc:integer read FDbproc write SetDbProc default 0;
  end;

procedure Register;

implementation
uses sybcheckbox,
     sybedit,
     sybmemo,
     sybsproc;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(SybObjectname),TSybGenerate,'',Tsybobjectproperty);
  RegisterComponents('Sybase DBLIB', [TSybGenerate]);
end;

constructor Tsybgenerate.create(AOwner:TComponent);
begin
  inherited create(AOwner);
  fparent:=aowner;
  Fdesignactive:=false;
  Fdbproc:=0;
  first_pos:=524550;
end;

procedure Tsybgenerate.SetDbname(Value :SybObjectname);
begin
  FDbname:=value;
  if navigator <> nil then
    navigator.dbname:=value;
  if table <> nil then
    table.dbname:=value;
  if query <> nil then  
    query.dbname:=value;
  get_dbproc;
end;

procedure tsybgenerate.SetDbProc(Value :integer);
begin
  FDbproc:=Value;
  Dbprocc:=Value;
end;

procedure Tsybgenerate.Setdesignactive(Value :boolean);
var frm  :tform;
    i    :integer;
begin
  if value then
  begin
    get_dbproc;
  end;
  Fdesignactive:=Value;
  if FDesignActive then
  begin
    f_form1:=tf_form1.create(nil);
    f_form2:=tf_form2.create(nil);
    f_form25:=tf_form25.create(nil);
    f_form27:=tf_form27.create(nil);
    f_form3:=tf_form3.create(nil);
    f_form4:=tf_form4.create(nil);
    f_form5:=tf_form5.create(nil);
    f_form2.l_tablenames.dbname:=dbname;
    f_form2.l_tablenames.dbproc:=dbproc;
    f_form25.l_allfields.dbproc:=dbproc;
    f_form5.com_update_sproc.dbproc:=dbproc;
    f_form5.com_insert_sproc.dbproc:=dbproc;
    f_form5.com_delete_sproc.dbproc:=dbproc;
    f_form2.l_tablenames.sqlexec;
    f_form5.com_update_sproc.sqlexec;
    f_form5.com_insert_sproc.sqlexec;
    f_form5.com_delete_sproc.sqlexec;
    f_form1.showmodal;

    if f_form1.action = 4 then
    begin
      r_simple:=f_form1.r_simple.checked;
      r_masterdetail:=f_form1.r_masterdetail.checked;
      r_horizontal:=f_form3.r_horizontal.checked;
      r_vertical:=f_form3.r_vertical.checked;
      r_grid:=f_form3.r_grid.checked;
      r_left:=f_form4.r_left.checked;
      r_top:=f_form4.r_top.checked;
      r_form_only:=f_form5.r_form_only.checked;
      r_table:=f_form5.r_table.checked;
      r_query:=f_form5.r_query.checked;
      r_form_procs:=f_form5.r_form_procs.checked;
      chk_sprocs:=f_form5.chk_sprocs.checked;
      c_form:=f_form5.c_form.checked;
      dataset:=f_form2.e_tablename.text;

      fieldscount:=f_form25.l_thefields.items.count;
      for i:=0 to fieldscount-1 do
        field_names[i+1]:=f_form25.l_thefields.items[i];

      if r_form_procs then
      begin

        create_table_component;
        if chk_sprocs then
        begin
          if f_form5.chk_update.checked then
          begin
            update_sproc:=f_form5.com_update_sproc.text;
            create_sproc(1,update_sproc);
          end;
          if f_form5.chk_insert.checked then
          begin
            insert_sproc:=f_form5.com_insert_sproc.text;
            create_sproc(2,insert_sproc);
          end;
          if f_form5.chk_delete.checked then
          begin
            delete_sproc:=f_form5.com_delete_sproc.text;
            create_sproc(3,delete_sproc);
          end;
        end;
      end;
      get_datatypes;
      create_fields;
    end;

    f_form1.free;
    f_form2.free;
    f_form25.free;
    f_form27.free;
    f_form3.free;
    f_form4.free;
    f_form5.free;

    Fdesignactive:=false;
  end;
  destroy;
end;

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

procedure Tsybobjectproperty.GetValues(TheProc: TGetStrProc);
var
  dbname    :SybObjectname;
  adatabase :tsybdatabase;
  i         :integer;
begin
  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
end;

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

procedure Tsybgenerate.get_datatypes;
var query  :tsybquery;
    i      :integer;
    foundq :boolean;

begin
  query:=tsybquery.create(nil);
  query.dbproc:=dbproc;

  foundq:=false;
  for i:=0 to querylist.count-1 do
  begin
    if tsybquery(querylist[i]).name=dataset then
    begin
      query.sql:=tsybquery(querylist[i]).designsql;
      foundq:=true;
      break;
    end;
  end;
  if not foundq then
  begin
    query.sql:='select ';
    for i:=1 to fieldscount-1 do
      query.sql:=query.sql + field_names[i] + ',';
    query.addsql(field_names[fieldscount] + ' from ' + dataset + ' where 1=2');
  end;
  query.sqlexec;

  for i:=1 to fieldscount do
  begin
    field_datatypes[i]:=query.coltype(i);
    field_lengths[i]:=query.collength(i);
  end;
end;

procedure Tsybgenerate.create_fields;
var edit       :tsybedit;
    check      :tsybcheckbox;
    memo       :tsybmemo;
    lab        :tlabel;
    i,topp,
    maxwidth,
    lft,j      :integer;
    s          :string;

begin

  for i:=fparent.componentcount-1  downto 0 do
  begin
    if fparent.components[i].tag >= 100 then
    begin
      fparent.components[i].destroy;
    end;
  end;

  pan_top:=tpanel.create(fparent);
  pan_top.align:=altop;
  pan_top.alignment:=tacenter;
  pan_top.name:='pan_top';
  pan_top.tag:=100;
  pan_top.caption:='';
  pan_top.parent:=twincontrol(fparent);

  navigator:=tsybnavigator.create(fparent);
  navigator.name:='nav_' + dataset;
  navigator.left:=8;
  navigator.top:=8;
  navigator.dbname:=dbname;
  navigator.dataset:='ds_' + dataset;
  navigator.parent:=twincontrol(pan_top);

  pan_main:=tpanel.create(fparent);
  pan_main.align:=alclient;
  pan_main.alignment:=tacenter;
  pan_main.bevelinner:=bvlowered;
  pan_main.bevelouter:=bvraised;
  pan_main.name:='pan_main';
  pan_main.caption:='';
  pan_main.tag:=100;
  pan_main.parent:=twincontrol(fparent);

  scbox_main:=tscrollbox.create(fparent);
  scbox_main.align:=alclient;
  scbox_main.name:='scbox_main';
  scbox_main.tag:=100;
  scbox_main.parent:=twincontrol(pan_main);

  topp:=top_of_first_field;
  lft:=left_of_first_field;
  maxwidth:=0;
  if (r_vertical) then
  begin
    if r_left then
    begin
    for i:=1 to fieldscount do
      begin
        lab:=tlabel.create(fparent);
        lab.left:=lft;
        lab.tag:=105;
        lab.name:='lab_' + field_names[i];
        lab.caption:=no_under(field_names[i]);
        lab.top:=topp;
        if lab.width > maxwidth then
          maxwidth:=lab.width;
         if (field_datatypes[i] = 'text') then
          topp:=topp + 90
        else
          topp:=topp + 22;
        lab.parent:=twincontrol(scbox_main);
      end;
      topp:=top_of_first_field;
      lft:=(left_of_first_field + 10) + maxwidth;
    end
    else
      lft:=left_of_first_field + 10;
    for i:=1 to fieldscount do
    begin
      if (r_top) then
      begin
        lab:=tlabel.create(fparent);
        lab.left:=lft;
        lab.tag:=105;
        lab.name:='lab_' + field_names[i];
        lab.caption:=no_under(field_names[i]);
        lab.top:=topp;
        if (field_datatypes[i] = 'text') then
          topp:=topp + 90
        else
          topp:=topp + 22;
        lab.parent:=twincontrol(scbox_main);
      end;

      if (field_datatypes[i] <> 'bit')
        and (field_datatypes[i] <> 'text') then
      begin
        edit:=tsybedit.create(fparent);
        edit.isprimarykey:=iskey(field_names[i]);
        edit.dataset:='ds_' + dataset;
        edit.name:='e_' + field_names[i];
        edit.text:='';
        edit.datafield:=field_names[i];
        edit.top:=topp;
        edit.left:=lft;
        if (r_top) then
          topp:=topp + 25
        else
          topp:=topp + 22;
        edit.tag:=110;
        if field_datatypes[i] = 'char' then
        begin
          edit.width:=(field_lengths[i]+1)* (tform(fparent).font.size);
          edit.maxlength:=field_lengths[i];
          edit.length:=field_lengths[i];
        end;

        if (field_datatypes[i] = 'datetime')
          or (field_datatypes[i] = 'smalldatetime') then
        edit.datatype:='datetime';

        if (field_datatypes[i] = 'float')
          or (field_datatypes[i] = 'money')
          or (field_datatypes[i] = 'real') then
        edit.datatype:='float';

        if (field_datatypes[i] = 'int')
          or (field_datatypes[i] = 'smallint')
          or (field_datatypes[i] = 'tinyint') then
        edit.datatype:='int';

        if (field_datatypes[i] = 'char') then
          edit.datatype:='char';

        edit.tag:=105;
        edit.parent:=twincontrol(scbox_main);
      end;
      if (field_datatypes[i] = 'bit') then
      begin
        check:=tsybcheckbox.create(fparent);
{        if table <> nil then
          check.tablename:=table.name;}
        check.dataset:='ds_' + dataset;
        check.name:='chk_' + field_names[i];
        check.caption:='';
        check.datafield:=field_names[i];
        check.datatype:='bit';
        check.top:=topp;
        check.left:=lft;
        if (r_top) then
          topp:=topp + 25
        else
        topp:=topp + 22;
        check.tag:=115;
        check.parent:=twincontrol(scbox_main);
      end;
      if (field_datatypes[i] = 'text') then
      begin
        memo:=tsybmemo.create(fparent);
{        if table <> nil then
        memo.tablename:=table.name;}
        memo.dataset:='ds_' + dataset;
        memo.name:='mem_' + field_names[i];
        memo.datafield:=field_names[i];
        memo.datatype:='text';
        memo.top:=topp;
        memo.left:=lft;
        memo.tag:=120;
        memo.text:='';
        topp:=topp + memo.height;
        memo.parent:=twincontrol(scbox_main);
      end;
    end;

  end;
end;

function Tsybgenerate.no_under(col :string):string;
var i,j  :integer;
    s    :string;
    c    :string[1];
begin
  i:=1;
  c:=col[i];
  if c<> '_' then
    s:=s + upcase(col[i]);
  while i < length(col) do
  begin
    inc(i);
    c:=col[i];
    if c <> '_' then
      s:=s + c;
    if c='_' then
    begin
      inc(i);
      c:=upcase(col[i]);
      s:=s + ' ' + c;
    end;
  end;
  result:=s;
end;

procedure Tsybgenerate.create_table_component;
var i,j  :integer;
begin
  if r_table then
  begin
    table:=tsybtable.create(fparent);
    table.designinfo:=first_pos;
    table.name:='ds_' + dataset;
    table.tablename:=dataset;
    table.dbname:=dbname;
    table.dbproc:=dbproc;
  end
  else
  begin
    query:=tsybquery.create(fparent);
    query.designinfo:=first_pos;
    query.name:='ds_' + dataset;

    for i:=0 to querylist.count-1 do
    begin
      if tsybquery(querylist[i]).name='ds_' + dataset then
      begin
        query.sql:='select ';
        for j:=1 to fieldscount-1 do
          query.sql:=query.sql + field_names[j] + ',';
        query.addsql(field_names[fieldscount] + ' from ' + dataset);
        break;
      end;
    end;
    query.dbname:=dbname;
    query.dbproc:=dbproc;
  end

end;

function Tsybgenerate.iskey(name :string):boolean;
var i  :integer;
begin
  result:=false;
  for i:=0 to f_form27.l_primarykeys.items.count-1 do
    if (f_form27.l_primarykeys.selected[i]) and (f_form27.l_primarykeys.items[i]=name) then
    begin
      result:=true;
      exit;
    end;
end;

procedure Tsybgenerate.create_sproc(sproc_type:integer;procname:sybobjectname);
var sproc  :tsybsproc;
begin
  first_pos:=first_pos + 30;
  sproc:=tsybsproc.create(fparent);
  sproc.designinfo:=first_pos;
  case sproc_type of
    1:  sproc.name:='sp_u_' + procname;
    2:  sproc.name:='sp_i_' + procname;
    3:  sproc.name:='sp_d_' + procname;
  end;
  sproc.sprocname:=procname;
  sproc.dbname:=dbname;
  sproc.dbproc:=dbproc;
  sproc.designactive:=true;
end;

function Tsybgenerate.is_table(name   :SybObjectname):boolean;
var i   :integer;
begin
  result:=false;
  for i:=0 to tablelist.count-1 do
  begin
    if tsybtable(tablelist[i]).name=dataset then
    begin
      result:=true;
      break;
    end;
  end;
end;

end.