📄 sybentity.pas
字号:
entitylist.items[entitylist.indexof(self)]:=self;
end;
end;
procedure TSybEntity.paint;
begin
inherited paint;
set_grid_size;
canvas.brush.Color:=clinactivecaption;
canvas.Rectangle(2,2,width-4,18);
canvas.Font.Color:=clwhite;
canvas.textout(3,3,caption);
draw_links;
end;
procedure TSybEntity.Settablename(Value :SybObjectname);
begin
Ftablename:=value;
{ get_databasefields;}
end;
procedure TSybEntity.SetDbProc(Value :integer);
begin
FDbproc:=Value;
end;
procedure TSybEntity.SetAutoDbPRoc(Value :boolean);
begin
FAutoDbProc:=value;
end;
function TSybEntity.sqlexec:integer;
var retcode,i :integer;
aquery :tsybquery;
begin
if length(tablename)= 0 then
begin
MessageBox(GetActiveWindow,'Invalid Table Name','Exec error',mb_ok+mb_iconexclamation);
exit;
end;
get_dbproc;
if dbproc = 0 then
exit;
aquery:=tsybquery.create(nil);
aquery.DbName:=dbname;
aquery.dbproc:=dbproc;
aquery.sql:='select * from ' + tablename + ' where 1=2';
if aquery.sqlexec = 1 then
caption:=tablename;
while aquery.nextrow=-1 do;
for i:=1 to aquery.numcols do
add_column(aquery.heading(i),aquery.coltype(i));
aquery.destroy;
refresh_grid;
end;
procedure TSybEntity.Delete_Link(From_Entity :SybObjectname;
From_Field :SybObjectname;
From_X :Integer;
From_Y :Integer;
To_Entity :SybObjectname;
To_Field :SybObjectname;
To_X :Integer;
To_Y :Integer);
var ALink :TLinks;
i :integer;
begin
ALink:=TLinks.Create;
end;
function TSybEntity.Link(index:integer):TLinks;
begin
result:=linklist[index];
end;
function TSybEntity.Old_Link(index:integer):TOldLinks;
begin
result:=OldLinklist[index];
end;
procedure TSybEntity.Add_Link(From_Entity :SybObjectname;
From_Field :SybObjectname;
From_X :Integer;
From_Y :Integer;
To_Entity :SybObjectname;
To_Field :SybObjectname;
To_X :Integer;
To_Y :Integer);
var ALink :TLinks;
aoldlink :TOldLinks;
i :integer;
p1,p2 :tpoint;
begin
ALink:=TLinks.Create;
ALink.From_Entity:=From_Entity;
ALink.From_Field:=From_Field;
ALink.From_X:=From_X;
ALink.From_Y:=From_Y;
ALink.To_Entity:=To_Entity;
ALink.To_Field:=To_Field;
ALink.To_X:=To_X;
ALink.To_Y:=To_Y;
Links.Add(ALink);
aoldlink:=TOldLinks.Create;
aoldlink.From_Entity:=From_Entity;
aoldlink.To_Entity:=To_Entity;
aoldlink.From_X:=From_X;
aoldlink.From_Y:=From_Y;
aoldlink.To_X:=To_X;
aoldlink.To_Y:=To_Y;
if first_link = 0 then
begin
linklist:=TList.Create;
oldlinklist:=TList.Create;
first_link:=1;
end;
if linklist.indexof(aLink) = -1 then
begin
linklist.add(aLink);
oldlinklist.add(aoldlink)
end
else
begin
linklist.items[linklist.indexof(aLink)]:=aLink;
oldlinklist.items[oldlinklist.indexof(aLink)]:=aLink;
end;
end;
procedure TSybEntity.add_column(column_name :SybObjectname; column_type :SybObjectname);
begin
inc(column_count);
column_names[column_count]:=column_name;
column_types[column_count]:=column_type;
end;
procedure TSybEntity.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;
procedure TSybEntity.refresh_grid;
var i,j :integer;
begin
for i:=1 to ColumnGrid.rowcount-1 do
begin
for j:=1 to ColumnGrid.colcount-1 do
begin
ColumnGrid.Cells[j,i]:='';
end;
end;
ColumnGrid.RowCount:=column_count;
ColumnGrid.ColCount:=1;
for i:=1 to column_count do
begin
ColumnGrid.Cells[0,i-1]:=column_names[i]
end;
end;
function TSybEntity.Entity(From_Entity :SybObjectname):TSybEntity;
var i :integer;
begin
for i:=0 to entitylist.count-1 do
begin
if (tsybentity(entitylist[i]).name=From_Entity) then
result:=tsybentity(entitylist[i]);
end;
end;
// ********************** Draw Links *****************************
procedure TSybEntity.draw_links;
var i :integer;
ALink :TOldLinks;
from_x,from_y,
to_x,to_y :integer;
begin
if linklist = nil then
exit;
clear_links;
for i:=0 to linklist.count-1 do
begin
from_x:=entity(TLinks(linklist[i]).from_entity).left + TLinks(linklist[i]).From_X + 1;
from_y:=entity(TLinks(linklist[i]).from_entity).top + TLinks(linklist[i]).From_Y;
to_x:=entity(TLinks(linklist[i]).to_Entity).left + TLinks(linklist[i]).To_X - 1;
to_y:=entity(TLinks(linklist[i]).to_Entity).top + TLinks(linklist[i]).To_Y;
if to_x > from_x then
begin
from_x:=entity(TLinks(linklist[i]).from_Entity).left + entity(TLinks(linklist[i]).from_Entity).width + 1;
end;
if from_x > to_x then
begin
to_x:=entity(TLinks(linklist[i]).to_Entity).left + entity(TLinks(linklist[i]).to_Entity).width - 1;
end;
TLinks(linklist[i]).real_from_x:=from_x;
TLinks(linklist[i]).real_from_y:=from_y;
TLinks(linklist[i]).real_to_x:=to_x;
TLinks(linklist[i]).real_to_y:=to_y;
tform(parent).canvas.MoveTo(from_x,from_y);
tform(parent).canvas.LineTo(to_x,to_y);
toldlinks(oldlinklist[i]).From_X:=from_x;
toldlinks(oldlinklist[i]).From_Y:=from_y;
toldlinks(oldlinklist[i]).To_X:=to_x;
toldlinks(oldlinklist[i]).To_Y:=to_y;
end;
end;
procedure TSybEntity.clear_links;
var i :integer;
from_x,from_y,
to_x,to_y :integer;
begin
tform(parent).canvas.Pen.Color:=clBtnFace;
for i:=0 to oldlinklist.count-1 do
begin
from_x:=TOldLinks(oldlinklist[i]).From_X;
from_y:=TOldLinks(oldlinklist[i]).From_Y;
to_x:=TOldLinks(oldlinklist[i]).To_X;
to_y:=TOldLinks(oldlinklist[i]).To_Y;
tform(parent).canvas.MoveTo(from_x,from_y);
tform(parent).canvas.LineTo(to_x,to_y);
end;
tform(parent).canvas.Pen.Color:=clBlue;
end;
// ***************************************************************
procedure Tsybobjectproperty.GetValues(TheProc: TGetStrProc);
var
Login,
Retcode,
retcode2,
i :integer;
dbname :SybObjectname;
s :string;
tslist :Tsybentity;
SqlCommand :sqlstring;
adatabase :tsybdatabase;
begin
tslist:=Tsybentity(getcomponent(0));
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
else
if tslist.dbproc > 40 then
begin
if getname = 'TableName' then
begin
strpcopy(Sqlcommand,'select name from sysobjects where type in ("U","S") order by name');
Retcode := dbcmd(tslist.dbProc,@Sqlcommand);
Retcode := Dbsqlexec(tslist.dbProc);
Retcode := dbresults(tslist.dbProc);
retcode2:=0;
while (retcode <> No_more_results) and (retcode <> Fail) do
begin
if retcode = Succeed then
begin
retcode2 := dbnextrow(tslist.dbProc);
while retcode2 <> No_More_Rows do
Begin
theproc(strpas(dbvalue(tslist.dbproc,1)));
retcode2 := dbnextrow(tslist.dbProc);
end;
end;
Retcode := dbresults(tslist.dbproc);
end;
end;
end
else
showmessage('Not connected to database !');
end;
function Tsybobjectproperty.getattributes:Tpropertyattributes;
begin
Result := [paValueList,paAutoUpdate,paMultiSelect];
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -