caldbgrid.pas

p2pdbanywhere 可以通过之udp方式远程连接数据库的组件,这个组件非常好,是Delphi7,9,2006能够使用,包含源码.

unit CalDbGrid;

interface

uses
  SysUtils, Classes, Controls, Grids, DBGridEh,dialogs,remotedataset,db,dbclient,
  adodb,CalExpression,sndkey32,Variants,tools,RemoteUdpConnection,RemoteHttpConnection,
  SynDataBase;

type
  TCalType=(CTSelectDatabase,CTCalExpression);

  TCalDbGrid = class;
  TCalItem= class(TCollectionItem)
  private 
    FCalFieldName:string;
    FCalType:TCalType;
    FSQL:Tstrings;
    FCalExpression:Tstrings;
    FRemoteDataSet:TRemoteDataSet;
    FADOQuery:TADOQuery;
    //数据同步
    FADOConnection:TADOConnection;
    FRemoteHttpConnection:TRemoteHttpConnection;
    FRemoteUdpConnection:TRemoteUdpConnection;
    FCanSyn:boolean;
    FSynTableName:string;
    procedure setcalfieldname(value:string);
    procedure setcaltype(value:TCalType);
    procedure setsql(value:Tstrings);
    procedure setcalexpression(value:Tstrings);
    procedure setremotedataset(value:TRemoteDataSet);
    procedure setadoquery(value:TADOQuery);
    procedure setSetupHttpParent(value:TRemoteHttpConnection);
    procedure setSetupUdpParent(value:TRemoteUdpConnection);
    procedure setAdoConnection(value:TADOConnection);
    procedure setcansyn(value:boolean);
    procedure settable(value:string);
  protected
    { Protected declarations }
  public
    constructor Create(Collection: TCollection);override;
    destructor Destroy; override;
    { Public declarations }
  published
    property CalFieldName:string read FCalFieldName write setcalfieldname;
    property CalType:TcalType read FCalType write setcaltype;
    property SQL:Tstrings read FSQL write setsql;
    property RemoteDataSet:TRemotedataSet read FRemoteDataSet write setremotedataset;
    property CalExpression:Tstrings read FCalExpression write setcalexpression;
    property ADOQuery:TADOQuery read FADOQuery write setadoquery;
    property RemoteHttpConnection: TRemoteHttpConnection read FRemoteHttpConnection write setSetupHttpParent;
    property RemoteUdpConnection: TRemoteUdpConnection read FRemoteUdpConnection write setSetupUdpParent;
    property ADOConnection: TADOConnection read FADOConnection write setADoConnection;
    property CanSyn:boolean read FCanSyn write setcansyn;
    property SynTableName:string read FSynTableName write settable;
    { Published declarations }
  end;
  TCalItemClass = class of TCalItem;
  TCalItems = class(TCollection)
  private
    FCalDbGrid:TCalDbGrid;
    function GetcalItem(Index:integer):TCalItem;
    procedure setcalItem(Index:integer;Value:TCalItem);
    { Private declarations }
  protected
    { Protected declarations }
  public
    constructor Create(CalDbGrid: TCalDbGrid; CalItemClass: TCalItemClass);
    property Items[Index: Integer]: TCalItem read GetCalItem write setCalItem; default;
    { Public declarations }
  published

    { Published declarations }
  end;
  TCalDbGrid = class(TDBGridEh)
  private
    FCE:TCalExpression;
    FCalItems:TCalItems;
    FCalValue:variant;
    cur_index:integer;
    FSyn:TSynDataBase;
    procedure setCalitems(value:TCalItems);
    { Private declarations }
  protected
    procedure calculate;
    procedure colenter;override;
    procedure colexit;override;
    procedure keypress(var Key: Char);override;
    //procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    //procedure DataChange(Sender: TObject; Field: TField);
    procedure DataChange(Sender: TObject);
    procedure afterScroll(DataSet: TDataSet);
    function  CreatecalItems: TCalItems; dynamic;
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }
  published
    property CalItems:TCalItems read FCalItems write setcalitems;
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DbAnyWhere', [TCalDbGrid]);
end;
///////////////////////////////////////////////
constructor Tcalitems.Create(CalDbGrid: TCalDbGrid; CalItemClass: TCalItemClass);
begin
  inherited Create(CalItemClass);
  FCalDbGrid:=CalDbGrid;
end;
function TCalItems.GeTCalItem(Index:integer):TCalItem;
begin
  Result:= TCalItem(inherited Items[Index]);
end;
procedure TCalItems.SeTCalItem(Index:integer;Value:TCalItem);
begin
  Items[Index].Assign(Value);
end;
procedure TCalDbGrid.setCalitems(value:TCalItems);
var
   i:integer;
begin
  FCalitems.Clear;
  for i:=0 to value.Count-1 do
  begin
    fCalitems.Add;
  end;
end;
function  TCalDbGrid.CreateCalItems: TCalItems;
begin
  Result := TCalItems.Create(Self, TCalItem);
end;
constructor TCalItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FCalExpression:=Tstringlist.Create;
  FSQL:=Tstringlist.Create;
  self.FCalType:=CTCalExpression;  
end;
destructor TCalItem.Destroy;
begin
  inherited Destroy;
  Freeandnil(FCalExpression);
  freeandnil(fsql);
end;
procedure TCalItem.setcalfieldname(value:string);
begin
  FcalFieldName:=value;
end;
procedure TCalItem.setcaltype(value:TCalType);
begin
  FCalType:=value;
end;
procedure TCalItem.setsql(value:Tstrings);
begin
  FSQL.Assign(value);
end;
procedure TCalItem.setcalexpression(value:Tstrings);
begin
  FCalExpression.Assign(value);
end;
procedure TCalItem.setremotedataset(value:TRemoteDataSet);
begin
  FRemoteDataSet:=value;
end;
procedure TCalItem.settable(value:string);
begin
  self.FSynTableName:=value;
end;
procedure TCalItem.setadoquery(value:TADOQuery);
begin
  FADOQuery:=value;
end;
procedure TCalItem.setSetupHttpParent(value:TRemoteHttpConnection);
begin
  FRemoteUdpConnection:=nil;
  FRemoteHttpConnection:=value;
end;
procedure TCalItem.setSetupUdpParent(value:TRemoteUdpConnection);
begin
  FRemoteHttpConnection:=nil;
  FRemoteUdpConnection:=value;
end;
procedure TCalItem.setAdoConnection(value:TADOConnection);
begin
  FADOConnection:=value;
end;
procedure TCalItem.setcansyn(value:boolean);
begin
  FCanSyn:=value;
end;
///////////////////////////////////////////////
constructor TCalDbGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCalItems:=self.CreatecalItems;
  FCE:=TCalExpression.Create(nil);
  FCalValue:=null;
  cur_index:=0;
  FSyn:=TSynDataBase.Create(nil);
end;
destructor TCalDbGrid.Destroy;
begin
  inherited Destroy;
  Freeandnil(FCalItems);
  freeandnil(Fce);
  freeandnil(Fsyn);
end;
procedure TCalDbGrid.calculate;
var
  i,j,k,h:integer;
  expression:string;
  temp_sql:string;
begin
  if self.ReadOnly then exit;
  temp_sql:='';
  if self.SelectedField.IsNull then exit;
  self.DataSource.Edit;
  //判断
  for i:=0 to self.FCalItems.Count-1 do
  begin
    if length(trim(self.FCalItems[i].FCalExpression.Text))=0 then
    begin
      showmessage('['+self.FCalItems[i].FCalFieldName+']计算公式不能够为空！');
      exit;
    end;
    if length(trim(self.FCalItems[i].FCalFieldName))=0 then
    begin
      showmessage('第'+inttostr(i)+'项没有字段名！');
      exit;
    end;
    if self.FCalItems[i].FCalType=CTSelectDatabase then
    begin
      if (self.FCalItems[i].FRemoteDataSet=nil)and
         (self.FCalItems[i].FADOQuery=nil) then
      begin
        showmessage('['+self.FCalItems[i].FCalFieldName+']没有设置执行组件！');
        exit;
      end;
      if length(trim(self.FCalItems[i].FSQL.Text))=0 then
      begin
        showmessage('['+self.FCalItems[i].FCalFieldName+']缺少SQl语句！');
        exit;
      end;
    end;
  end;
  for i:=0 to self.FCalItems.Count-1 do
  begin
    //寻找对应的字段
    if self.FCalItems[i].FCalFieldName=self.SelectedField.FieldName then