sybentity.pas

sybase大全

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