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

📄 expgenerate_frm.pas

📁 sybase大全
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit expgenerate_frm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,ToolIntf,ExptIntf,IStreams,editintf,extctrls,
  sybase_components,sybdatabase,u_generate1,u_generate2,u_generate3,u_generate4,u_generate25,u_generate5,u_generate27,
  sybnavigator,sybtable,sybquery, syblistbox;

const top_of_first_field = 30;
      left_of_first_field = 30;

type
  SybObjectname = string[30];

type
  Tf_exp = class(TForm)
    btn_next: TButton;
    MemoSource: TMemo;
    MemoForm: TMemo;
    btn_cancel1: TButton;
    btn_help1: TButton;
    exp_db: TSybDatabase;
    lb_exp_tables: TSybListBox;
    Image1: TImage;
    Label1: TLabel;
    btn_connect: TButton;
    Label2: TLabel;
    procedure btn_nextClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure lb_exp_tablesDblClick(Sender: TObject);
    procedure get_detail;
    procedure create_table_component;
    function iskey(name :string):boolean;
    procedure btn_cancel1Click(Sender: TObject);
    procedure create_sproc(sproc_type:integer;procname:sybobjectname);
    procedure cleanup;
    procedure lb_exp_tablesClick(Sender: TObject);
    procedure btn_connectClick(Sender: TObject);
  private
    formname,unitident,
    unitfilename          :string;
    dbproc                :integer;
    temp_form             :tform;
    procedure create_text;
    procedure get_datatypes;
    procedure create_fields;
    function no_under(col:string):string;
  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;
     dbindex                   :smallint;
     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;
     database                  :tsybdatabase;
     query                     :tsybquery;
     pan_top,pan_main          :tpanel;
     scbox_main                :tscrollbox;
     first_pos                 :integer;

  public
    { Public declarations }
  end;

var
  f_exp: Tf_exp;
  StrBin, StrTxt: TMemoryStream;

implementation
uses sybcheckbox,
     sybedit,
     sybmemo,
     sybsproc;

{$R *.DFM}

procedure Tf_exp.btn_nextClick(Sender: TObject);
var unitistream, formistream :timemorystream;
    formstream,unitstream :tmemorystream;
    formtextstream        :tmemorystream;

begin
  if dbindex<0 then
  begin
    showmessage('Select at least one Database!');
    exit;
  end;


  toolservices.GetNewModuleName(unitident,unitfilename);
  formname:='Form' + copy(unitident,5,length(unitident)-4);

  temp_form:=tform.create(application);
  temp_form.caption:=formname;
  temp_form.name:=formname;
  temp_form.position:=poScreenCenter;
  temp_form.left:=200;
  temp_form.top:=150;
  temp_form.width:=450;

  get_detail;
  if (f_form1.action=3) then
  begin
    cleanup;
    exit;
  end;

  if (f_form1.action=1) then
  begin
    cleanup;
    exit;
  end;

  create_text;

  formstream:=tmemorystream.create;
  formtextstream:=tmemorystream.create;
  unitstream:=tmemorystream.create;
  memosource.lines[0]:='unit ' + unitident + ';';
  memoform.lines[0]:='object ' + formname + ': T' + formname;
  memoform.lines[0]:='object ' + formname + ': T' + formname;
  memoform.lines[13]:=memoform.lines[13] + #13 + '  OnActivate = FormActivate';

  memoform.lines.SaveToStream(formtextstream);
  memosource.lines.SaveToStream(unitstream);
  formtextstream.position:=0;
  ObjectTextToResource(FormTextStream,FormStream);

  formstream.position:=0;
  unitstream.position:=0;

  formistream:=timemorystream.create(formstream);
  unitistream:=timemorystream.create(unitstream);

  toolservices.CreateModule(unitfilename,unitistream,formistream,[cmshowsource,cmshowform,cmunnamed,cmmarkmodified,cmaddtoproject]);
  formtextstream.Free;

  cleanup;
  close;

end;

procedure Tf_exp.create_text;
var i                     :integer;

begin

  with MemoSource.Lines do
  begin
    BeginUpdate;
    Add ('unit ' + unitident);
    Add ('');
    Add ('interface');
    Add ('');
    Add ('uses');
    Add ('  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,');
    Add ('  Forms, Dialogs, ExtCtrls;');
    Add ('');
    Add ('type');
    Add ('  T' + temp_form.Caption + ' = class (TForm)');

    // add each component
    for I := 0 to temp_form.ComponentCount - 1 do
    begin
      Add ('    ' + temp_form.Components[I].Name +
        ': ' + temp_form.Components[I].ClassName + ';');
    end;
    Add ('    procedure FormActivate(Sender: TObject);');

    Add ('  private');
    Add ('    { Private declarations }');
    Add ('  public');
    Add ('    { Public declarations }');
    Add ('  end;');
    Add ('');
    Add ('var');
    Add ('  '+ temp_form.Caption +
      ': T' + temp_form.Caption + ';');
    Add ('');
    Add ('implementation');
    Add ('');
    Add ('{$R *.DFM}');
    Add ('');


    Add ('procedure T' + temp_form.Caption +
      '.FormActivate(Sender: TObject);');
    Add ('begin');
    Add ('  ' + database.name + '.connect;');
    Add ('  if not ' + database.name + '.connected then');
    Add ('  begin');
    Add ('    close;');
    Add ('  end;');
    Add ('  ' + table.name + '.sqlexec;');
    Add ('  ' + table.name + '.nextrow;');
    Add ('end;');
    Add ('');
    Add ('end.');
    EndUpdate;
  end;

  {copy the form textual description to the second memo}
  StrBin := TMemoryStream.Create;
  StrTxt := TMemoryStream.Create;
  try
    // write the form to a memory stream
    StrBin.WriteComponentRes (
      temp_form.Name,temp_form);
    // go back the the beginning
    StrBin.Position := 0;
    // convert the form to text
    ObjectResourceToText (StrBin, StrTxt);
    // go back at the beginning
    StrTxt.Position := 0;
    // load the text
    MemoForm.Lines.LoadFromStream (StrTxt);

    // delete the form
{    temp_form.Free;
    temp_form:= nil;}
  finally
{    StrBin.Free;
    StrTxt.Free;}
  end;

end;

procedure Tf_exp.FormActivate(Sender: TObject);
begin
  dbindex:=-1;
  exp_db.connect;
  if not exp_db.connected then
  begin
    btn_connect.Enabled:=true;
    exit;
  end;
  btn_connect.Enabled:=false;
  dbproc:=exp_db.dbproc;
  lb_exp_tables.sqlexec;
  lb_exp_tables.ItemIndex:=0;
end;

procedure Tf_exp.lb_exp_tablesDblClick(Sender: TObject);
begin
  exp_db.DBName:=lb_exp_tables.Items[lb_exp_tables.itemindex];
  dbindex:=lb_exp_tables.itemindex;
  btn_nextClick(self);
end;


procedure Tf_exp.get_detail;
var i            :integer;
begin
  database:=tsybdatabase.create(temp_form);
  database.DBName:=exp_db.DBName;
  database.name:='db_' + exp_db.DBName;
  database.ServerName:=exp_db.ServerName; 
  
  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:=exp_db.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 = 1) or (f_form1.action=3) then
  begin
    exit;
  end;

  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;

{  cleanup;}
end;

procedure Tf_exp.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

⌨️ 快捷键说明

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