www.pudn.com > sybase_dblib4.zip > expgenerate_frm.pas
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
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 Tf_exp.create_fields;
var edit :tsybedit;
check :tsybcheckbox;
memo :tsybmemo;
lab :tlabel;
i,topp,
maxwidth,
lft,j :integer;
s :string;
begin
for i:=temp_form.componentcount-1 downto 0 do
begin
if temp_form.components[i].tag >= 100 then
begin
temp_form.components[i].destroy;
end;
end;
pan_top:=tpanel.create(temp_form);
pan_top.align:=altop;
pan_top.alignment:=tacenter;
pan_top.name:='pan_top';
pan_top.tag:=100;
pan_top.caption:='';
pan_top.parent:=temp_form;
navigator:=tsybnavigator.create(temp_form);
navigator.name:='nav_' + dataset;
navigator.left:=8;
navigator.top:=8;
navigator.dbname:=database.name;
navigator.dataset:='ds_' + dataset;
navigator.parent:=pan_top;
pan_main:=tpanel.create(temp_form);
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:=temp_form;
scbox_main:=tscrollbox.create(temp_form);
scbox_main.align:=alclient;
scbox_main.name:='scbox_main';
scbox_main.tag:=100;
scbox_main.parent:=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(temp_form);
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:=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(temp_form);
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:=scbox_main;
end;
if (field_datatypes[i] <> 'bit')
and (field_datatypes[i] <> 'text') then
begin
edit:=tsybedit.create(temp_form);
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(temp_form).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:=scbox_main;
end;
if (field_datatypes[i] = 'bit') then
begin
check:=tsybcheckbox.create(temp_form);
{ 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:=scbox_main;
end;
if (field_datatypes[i] = 'text') then
begin
memo:=tsybmemo.create(temp_form);
{ 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:=scbox_main;
end;
end;
end;
end;
procedure Tf_exp.create_table_component;
var i,j :integer;
begin
if r_table then
begin
table:=tsybtable.create(temp_form);
table.designinfo:=first_pos;
table.name:='ds_' + dataset;
table.tablename:=dataset;
table.dbname:=database.name;
table.dbproc:=dbproc;
end
else
begin
query:=tsybquery.create(temp_form);
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:=exp_db.dbname;
query.dbproc:=dbproc;
end;
end;
function Tf_exp.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;
function Tf_exp.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 Tf_exp.btn_cancel1Click(Sender: TObject);
begin
exp_db.disconnect;
cleanup;
modalresult:=mrcancel;
end;
procedure Tf_exp.create_sproc(sproc_type:integer;procname:sybobjectname);
var sproc :tsybsproc;
begin
first_pos:=first_pos + 30;
sproc:=tsybsproc.create(temp_form);
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:=exp_db.dbname;
sproc.dbproc:=dbproc;
sproc.designactive:=true;
end;
procedure Tf_exp.cleanup;
begin
if temp_form <> nil then
begin
temp_form.free;
temp_form:=nil;
end;
if f_form1 <> nil then
begin
f_form1.free;
f_form1:=nil;
end;
if f_form2 <> nil then
begin
f_form2.free;
f_form2:=nil;
end;
if f_form25 <> nil then
begin
f_form25.free;
f_form25:=nil;
end;
if f_form27 <> nil then
begin
f_form27.free;
f_form27:=nil;
end;
if f_form3 <> nil then
begin
f_form3.free;
f_form3:=nil;
end;
if f_form4 <> nil then
begin
f_form4.free;
f_form4:=nil;
end;
if f_form5 <> nil then
begin
f_form5.free;
f_form5:=nil;
end;
end;
procedure Tf_exp.lb_exp_tablesClick(Sender: TObject);
begin
exp_db.DBName:=lb_exp_tables.Items[lb_exp_tables.itemindex];
dbindex:=lb_exp_tables.itemindex;
end;
procedure Tf_exp.btn_connectClick(Sender: TObject);
begin
FormActivate(Self);
end;
end.