www.pudn.com > sybase_dblib4.zip > SybEntity.pas
unit SybEntity;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,Grids, SizePanel,sybase_components,DsgnIntf,
Entities;
type TGridClickEvent = procedure (Sender: TObject) of object;
type TGridDblClickEvent = procedure (Sender: TObject) of object;
type TGridEnterEvent = procedure (Sender: TObject) of object;
type TGridExitEvent = procedure (Sender: TObject) of object;
type TGridMouseDownEvent = procedure (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
type TGridMouseUpEvent = procedure (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
type TGridMouseMoveEvent = procedure (Sender: TObject; Shift: TShiftState; X, Y: Integer) of object;
type TGridSelectCellEvent = procedure (Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean) of object;
type TGridKeyDownEvent = procedure (Sender: TObject; var Key: Word; Shift: TShiftState) of object;
type TGridKeyUpEvent = procedure (Sender: TObject; var Key: Word; Shift: TShiftState) of object;
type TGridKeyPressEvent = procedure (Sender: TObject; var Key :Char) of object;
type
SybObjectname = string[30];
type TOldLinks = class(TObject)
public
From_Entity :SybObjectname;
From_X :Integer;
From_Y :Integer;
To_Entity :SybObjectname;
To_X :Integer;
To_Y :Integer;
end;
type
Tsybobjectproperty = class(TStringProperty)
public
procedure GetValues(TheProc: TGetStrProc); override;
function getattributes:Tpropertyattributes; override;
end;
type
TSybEntity = class(TSizePanel)
private
the_x,the_y :integer;
Old_Links :TList;
FDbname :SybObjectname;
FAutoDbProc :boolean;
FDbProc :integer;
FTablename :SybObjectname;
column_names :array[1..255] of SybObjectname;
column_types :array[1..255] of SybObjectname;
column_count :integer;
FOnGridEnter :TGridEnterEvent;
FOnGridExit :TGridExitEvent;
FOnGridClick :TGridClickEvent;
FOnGridDblClick :TGridDblClickEvent;
FOnGridMouseDown:TGridMouseDownEvent;
FOnGridMouseUp :TGridMouseUpEvent;
FOnGridMouseMove:TGridMouseMoveEvent;
FOnGridSelectCell:TGridSelectCellEvent;
FOnGridKeyDown :TGridKeyDownEvent;
FOnGridKeyUp :TGridKeyUpEvent;
FOnGridKeyPress :TGridKeyPressEvent;
procedure GridKeyPress(Sender: TObject; var Key: Char);
procedure GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure GridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
procedure GridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure GridEnter(Sender: TObject);
procedure GridExit(Sender: TObject);
procedure GridClick(Sender: TObject);
procedure GridDblClick(Sender: TObject);
procedure Settablename(Value :SybObjectname);
procedure SetDbName(Value :SybObjectname);
procedure SetDbProc(Value :integer);
procedure SetAutoDbProc(Value :boolean);
protected
function Entity(From_Entity :SybObjectname):TSybEntity;
procedure draw_links;
procedure clear_links;
procedure get_dbproc;
procedure set_grid_size;
procedure paint; override;
procedure setname(const NewName:Tcomponentname); override;
function Old_Link(index:integer):TOldLinks;
public
Links :TList;
ColumnGrid :TStringGrid;
function Link(index:integer):TLinks;
procedure Refresh_Grid;
procedure Add_Column(Column_Name :SybObjectname;
Column_Type :SybObjectname);
constructor Create (AOwner: TComponent); override;
destructor destroy; override;
procedure 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);
procedure 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);
function SqlExec:integer;
published
property DbName :SybObjectname read FDbName write setDbname;
property DbProc:integer read FDbproc write SetDbProc default 0;
property AutoDbProc:boolean read FAutoDbProc write SetAutoDbProc default true;
property TableName :SybObjectname read FTableName write settablename;
property OnGridClick : TGridClickEvent read FOnGridClick write FOnGridClick;
property OnGridExit : TGridExitEvent read FOnGridExit write FOnGridExit;
property OnGridEnter : TGridEnterEvent read FOnGridEnter write FOnGridEnter;
property OnGridDblClick : TGridDblClickEvent read FOnGridDblClick write FOnGridDblClick;
property OnGridMouseDown : TGridMouseDownEvent read FOnGridMouseDown write FOnGridMouseDown;
property OnGridMouseUp : TGridMouseUpEvent read FOnGridMouseUp write FOnGridMouseUp;
property OnGridMouseMove : TGridMouseMoveEvent read FOnGridMouseMove write FOnGridMouseMove;
property OnGridSelectCell : TGridSelectCellEvent read FOnGridSelectCell write FOnGridSelectCell;
property OnGridKeyDown : TGridkeyDownEvent read FOnGridKeyDown write FOnGridKeyDown;
property OnGridKeyUp : TGridkeyUpEvent read FOnGridKeyUp write FOnGridKeyUp;
property OnGridKeyPress : TGridkeyPressEvent read FOnGridKeyPress write FOnGridKeyPress;
end;
procedure Register;
implementation
uses sybase32,
sybdatabase,
sybtable,
sybquery;
procedure Register;
begin
RegisterComponents('Sybase DBLIB', [TSybEntity]);
RegisterPropertyEditor(TypeInfo(SybObjectname),tsybentity,'',Tsybobjectproperty);
end;
constructor TSybEntity.Create (AOwner: TComponent);
begin
inherited create(AOwner);
height:=110;
width:=100;
Fautodbproc:=true;
column_count:=0;
ColumnGrid:=TStringGrid.create(self);
ColumnGrid.Options:=[goFixedVertLine,goFixedHorzLine,goVertLine,goHorzLine,goRowSelect];
ColumnGrid.colcount:=1;
ColumnGrid.rowcount:=4;
ColumnGrid.OnClick:=GridClick;
ColumnGrid.OnDblClick:=GridDblClick;
ColumnGrid.OnEnter:=GridEnter;
ColumnGrid.OnExit:=GridExit;
ColumnGrid.OnMouseDown:=GridMouseDown;
ColumnGrid.OnMouseUp:=GridMouseUp;
ColumnGrid.OnMouseMove:=GridMouseMove;
ColumnGrid.OnSelectCell:=GridSelectCell;
ColumnGrid.OnKeyDown:=GridKeyDown;
ColumnGrid.OnKeyUp:=GridKeyUp;
ColumnGrid.OnKeyPress:=GridKeyPress;
set_grid_size;
Links:=TList.Create;
Old_Links:=TList.Create;
if First_Entity = 0 then
begin
linking:=false;
EntityList:=TList.Create;
First_Entity:=1;
end;
end;
destructor TSybEntity.destroy;
var i :integer;
begin
ColumnGrid.Destroy;
for i:=0 to Links.Count-1 do
TLinks(Links[i]).destroy;
Links.Destroy;
entitylist.remove(self);
inherited destroy;
end;
// *********** Grid Events ******************************************
procedure TSybEntity.GridClick(Sender: TObject);
begin
if assigned(FOnGridClick) then
FOnGridClick(self);
end;
procedure TSybEntity.GridDblClick(Sender: TObject);
var c,r :longint;
begin
columngrid.MouseToCell(the_x,the_y,c,r);
if r =-1 then
exit;
if not linking then
begin
lnk_from_entity :=name;
// columngrid.MouseToCell(the_x,the_y,c,r);
lnk_from_field :=columngrid.Cells[c,r];
lnk_from_X :=the_x;
lnk_from_Y :=the_y+20;
linking:=true;
end
else
begin
columngrid.MouseToCell(the_x,the_y,c,r);
if r =-1 then
exit;
lnk_to_entity :=name;
if lnk_to_entity <> lnk_from_entity then
begin
// columngrid.MouseToCell(the_x,the_y,c,r);
lnk_to_field :=columngrid.Cells[c,r];
lnk_to_X :=the_x;
lnk_to_Y :=the_y+ 20;
add_link(lnk_from_entity,
lnk_from_field,
lnk_from_x,
lnk_from_y,
lnk_to_entity,
lnk_to_field,
lnk_to_x,
lnk_to_y);
linking:=false;
draw_links;
end;
end;
if assigned(FOnGridDblClick) then
FOnGridDblClick(self);
end;
procedure TSybEntity.GridEnter(Sender: TObject);
begin
if assigned(FOnGridEnter) then
FOnGridEnter(self);
end;
procedure TSybEntity.GridExit(Sender: TObject);
begin
if assigned(FOnGridExit) then
FOnGridExit(self);
end;
procedure TSybEntity.GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
the_x:=x;
the_y:=y;
if assigned(FOnGridMouseDown) then
FOnGridMouseDown(self,Button,Shift,X,Y);
end;
procedure TSybEntity.GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if assigned(FOnGridMouseUp) then
FOnGridMouseUp(self,Button,Shift,X,Y);
end;
procedure TSybEntity.GridMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if assigned(FOnGridMouseMove) then
FOnGridMouseMove(self,Shift,X,Y);
end;
procedure TSybEntity.GridSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
if assigned(FOnGridSelectCell) then
FOnGridSelectCell(self,ACol,ARow,CanSelect);
end;
procedure TSybEntity.GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if assigned(FOnGridKeyDown) then
FOnGridKeyDown(self,Key, Shift);
end;
procedure TSybEntity.GridKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if assigned(FOnGridKeyUp) then
FOnGridKeyUp(self,Key, Shift);
end;
procedure TSybEntity.GridKeyPress(Sender: TObject; var Key: Char);
begin
if assigned(FOnGridKeyPress) then
FOnGridKeyPress(self,Key);
end;
// ******************************************************************
procedure TSybEntity.SetDbname(Value :SybObjectname);
begin
FDbname:=value;
get_dbproc;
end;
procedure TSybEntity.set_grid_size;
begin
ColumnGrid.left:=2;
ColumnGrid.top:=20;
ColumnGrid.width:=width-4;
ColumnGrid.height:=height-22;
ColumnGrid.defaultcolwidth:=ColumnGrid.width-4;
ColumnGrid.defaultrowheight:=15;
ColumnGrid.fixedcols:=0;
ColumnGrid.fixedrows:=0;
ColumnGrid.parent:=self;
end;
procedure TSybEntity.setname(const NewName:Tcomponentname);
begin
inherited setname(NewName);
if entitylist.indexof(self) = -1 then
entitylist.add(self)
else
begin
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.