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

📄 sybentity.pas

📁 sybase大全
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    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 + -