【发布控件—附图】1、ADO可实现多表更新，视图多表关联可更新控件ADOUpdateSQL；2、数据项选择对话框控件 ( 积分: 50 )

[Red]1、从BDE的UpdateSQL改装而来的ADO可实现多表可更新视图的控件，很好用
左边为改装后的ADOUpdateSQL控件，右边为BDE的原装UpdateSQL控件[/red]


[Red]2、数据项选择对话框控件SelectItem，确定后可填充至相应的DBEdit或DBGrid中，很不错的过滤查找对话框[/red]


[brown]很好用的两个控件
以后想用ADO操作SQL Server的视图，再也不用写多余的触发器或SQL语句了，有了ADOUpdateSql，一个控件顶五个，颈不酸了，头不晕了……

数据项选择对话框控件，过滤很好用，不用再去下拉对话框找了，有了这个参照对话框，特快，飞一般的感觉……

是我同事给我的，他技术不错，相信他会看到我发的帖的，感谢他，不过我只有DCU，他不给我PAS(还望他有CnPack的开源精神，相信他[])，还望DFW的兄弟姐妹们可以提供寻找PAS的线索，如果想要DCU的，留下关于此控件的信息，并留下你的E-Mail，我发给大家，谢谢[/brown]

留下你的qq我帮你取出原码来[]

为什么这样子，还是喜欢CnPack的大度风格

刚网站找到的，己经提交到盒子了.

{***************************************************************
*
* Unit Name: ADOUpdateSQL
* Purpose :
* Author : Fred Schetterer
* History : 12-Mar-2000 - Created
*
* Copyright ?1994-2000 by FreDsterWare ComputerTools Ltd.
*
****************************************************************}

unit ADOUpdateSQL;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, ADOInt, ADODB;

type
TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError; UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
TADOUpdateSQL = class;

TADOUpdDataSet = class(TADODataSet)
private
{ Private declarations }
FUpdateObject: TADOUpdateSQL;
FOnUpdateRecord: TUpdateRecordEvent;
fOnUpdateError: TUpdateErrorEvent;
procedure SetUpdateObject(Value: TADOUpdateSQL);
function UpdatePending(var UpdateKind: TUpdateKind): boolean;
protected
{ Protected declarations }
procedure ApplyUpdates(AffectRecords: TAffectRecords);
public
{ Public declarations }
procedure UpdateBatch(AffectRecords: TAffectRecords = arAll); reintroduce;
published
{ Published declarations }
property UpdateObject: TADOUpdateSQL read FUpdateObject write SetUpdateObject;
{ Events }
//property OnUpdateRecord: TUpdateRecordEvent read FOnUpdateRecord write FOnUpdateRecord;
property OnUpdateError: TUpdateErrorEvent read fOnUpdateError write fOnUpdateError;
end;

TADOUpdateSQL = class(TComponent)
private
{ Private declarations }
FDataSet: TADOUpdDataSet;
FQueries: array[TUpdateKind] of TADOQuery;
FSQLText: array[TUpdateKind] of TStrings;
function GetQuery(UpdateKind: TUpdateKind): TADOQuery;
function GetSQL(UpdateKind: TUpdateKind): TStrings;
function GetSQLIndex(Index: Integer): TStrings;
procedure SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
procedure SetSQLIndex(Index: Integer; Value: TStrings);
protected
{ Protected declarations }
function GetDataSet: TADOUpdDataSet;
procedure SetDataSet(ADataSet: TADOUpdDataSet);
procedure SQLChanged(Sender: TObject);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property DataSet: TADOUpdDataSet read GetDataSet write SetDataSet;
procedure Apply(UpdateKind: TUpdateKind);
procedure ExecSQL(UpdateKind: TUpdateKind);
procedure SetParams(UpdateKind: TUpdateKind);
property Query[UpdateKind: TUpdateKind]: TADOQuery read GetQuery;
property SQL[UpdateKind: TUpdateKind]: TStrings read GetSQL write SetSQL;
published
{ Published declarations }
property ModifySQL: TStrings index 0 read GetSQLIndex write SetSQLIndex;
property InsertSQL: TStrings index 1 read GetSQLIndex write SetSQLIndex;
property DeleteSQL: TStrings index 2 read GetSQLIndex write SetSQLIndex;
end;

procedure Register;

implementation

resourcestring
rsUpdateFailed = 'Update failed';

procedure Register;
begin
RegisterComponents('FreDsterWare', [TADOUpdDataSet, TADOUpdateSQL]);
end;

{ TADOUpdDataSet }

{-----------------------------------------------------
TADOUpdDataSet.SetUpdateObject

* Purpose : Set the UpdateObject
If another dataset already references this updateobject, then remove the reference
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdDataSet.SetUpdateObject(Value: TADOUpdateSQL);
begin
if Value <> FUpdateObject then
begin
if Assigned(FUpdateObject) and (FUpdateObject.DataSet = Self) then
FUpdateObject.DataSet := nil;
FUpdateObject := Value;
if Assigned(FUpdateObject) then
begin
if Assigned(FUpdateObject.DataSet) and
(FUpdateObject.DataSet <> Self) then
FUpdateObject.DataSet.UpdateObject := nil;
FUpdateObject.DataSet := Self;
end;
end;
end;
{-----------------------------------------------------
TADOUpdDataSet.UpdateBatch

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdDataSet.UpdateBatch(AffectRecords: TAffectRecords);
begin
if Assigned(FUpdateObject)
or Assigned(FOnUpdateRecord) then
ApplyUpdates(AffectRecords)
else
inherited UpdateBatch(AffectRecords);
end;
{-----------------------------------------------------
TADOUpdDataSet.ApplyUpdates

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdDataSet.ApplyUpdates(AffectRecords: TAffectRecords);
var
UpdateAction : TUpdateAction;
UpdateKind : TUpdateKind;
SavedFilter : string;
SavedFilterGroup : TFilterGroup;
wasFiltered : Boolean;

RequeryNeeded : Boolean;
begin

SavedFilter := Filter;
SavedFilterGroup := FilterGroup;
wasFiltered := Filtered;
FilterGroup := fgNone;
RequeryNeeded := False;

CheckBrowseMode;
if not isEmpty then
begin
DisableControls;
try
UpdateCursorPos;
if not (RecordSet.EOF and RecordSet.BOF) then
begin
RecordSet.Filter := adFilterPendingRecords;
if not (RecordSet.EOF and RecordSet.BOF) then
begin
RecordSet.MoveFirst;
while not RecordSet.Eof do
begin
if (Recordset.Status and adRecDeleted) = adRecDeleted then
begin
UpdateAction := uaFail;
UpdateKind := ukDelete;
try
RequeryNeeded := True;
Recordset.CancelBatch(adAffectCurrent);
FUpdateObject.Apply(UpdateKind);
except
on E: EDatabaseError do
if Assigned(OnUpdateError) then
OnUpdateError(Self, E, UpdateKind, UpdateAction)
end;
end;
RecordSet.MoveNext;
end;
end;
RecordSet.Filter := adFilterPendingRecords;
end;

FilterGroup := fgPendingRecords;
Filtered := true;
if not (EOF and BOF) then
begin
First;
while not Eof do
begin
UpdateCursorPos;
if UpdatePending(UpdateKind) then
begin
RequeryNeeded := RequeryNeeded or (UpdateKind <> ukModify);
UpdateAction := uaFail;
if Assigned(FOnUpdateRecord) then
FOnUpdateRecord(self, UpdateKind, UpdateAction)
else
begin
try
FUpdateObject.Apply(UpdateKind);
except
on E: EDatabaseError do
if Assigned(OnUpdateError) then
OnUpdateError(Self, E, UpdateKind, UpdateAction)
end;
Recordset.CancelBatch(adAffectCurrent);
end;
end;
Next;
end;
end;
finally
FilterGroup := fgNone;
FilterGroup := SavedFilterGroup;
Filter := SavedFilter;
Filtered := wasFiltered;

if RequeryNeeded then
Requery
else
Refresh;
EnableControls;
end;
end;
end;
{-----------------------------------------------------
TADOUpdDataSet.UpdatePending

* Purpose : Map UpdateStatus to UpdateKind
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

function TADOUpdDataSet.UpdatePending(var UpdateKind: TUpdateKind): boolean;
var
AUpdateStatus : TUpdateStatus;
begin
AUpdateStatus := UpdateStatus;
Result := (AUpdateStatus <> usUnmodified);
if Result then
UpdateKind := TUpdateKind(Ord(AUpdateStatus) - 1);
end;

{ TADOUpdateSQL }

{-----------------------------------------------------
TADOUpdateSQL.Apply

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.Apply(UpdateKind: TUpdateKind);
begin
SetParams(UpdateKind);
ExecSQL(UpdateKind);
end;
{-----------------------------------------------------
TADOUpdateSQL.Create

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

constructor TADOUpdateSQL.Create(AOwner: TComponent);
var
UpdateKind : TUpdateKind;
begin
inherited Create(AOwner);
for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
begin
FSQLText[UpdateKind] := TStringList.Create;
TStringList(FSQLText[UpdateKind]).OnChange := SQLChanged;
end;

{$IFDEF UNREGISTERED}
if not (csDesigning in ComponentState) then { running outside IDE}
if (FindWindowEx(0, 0, 'TAppBuilder', nil) = 0) then
begin { Delphi not found}
Application.NormalizeTopMosts;
ShowMessage(Self.ClassName + ' is NOT a public domain product, if you find it usefull then please register it..');
Application.RestoreTopMosts;
end;
{$ENDIF}

end;

{-----------------------------------------------------
TADOUpdateSQL.Destroy

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

destructor TADOUpdateSQL.Destroy;
var
UpdateKind : TUpdateKind;
begin
if Assigned(FDataSet) and (FDataSet.UpdateObject = Self) then
FDataSet.UpdateObject := nil;
for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
FSQLText[UpdateKind].Free;
inherited Destroy;
end;
{-----------------------------------------------------
TADOUpdateSQL.ExecSQL

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.ExecSQL(UpdateKind: TUpdateKind);
begin
with Query[UpdateKind] do
begin
Prepared := True;
ExecSQL;
if (RowsAffected = 0) then
DatabaseError(rsUpdateFailed);
end;
end;

{-----------------------------------------------------
TADOUpdateSQL.GetQuery

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

function TADOUpdateSQL.GetQuery(UpdateKind: TUpdateKind): TADOQuery;
begin
if not Assigned(FQueries[UpdateKind]) then
begin
FQueries[UpdateKind] := TADOQuery.Create(Self);
FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
if Assigned(FDataSet.Connection) then
FQueries[UpdateKind].Connection := FDataSet.Connection
else
FQueries[UpdateKind].ConnectionString := FDataSet.ConnectionString;
end;
Result := FQueries[UpdateKind];
end;

{-----------------------------------------------------
TADOUpdateSQL.GetSQL

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

function TADOUpdateSQL.GetSQL(UpdateKind: TUpdateKind): TStrings;
begin
Result := FSQLText[UpdateKind];
end;
{-----------------------------------------------------
TADOUpdateSQL.GetSQLIndex

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

function TADOUpdateSQL.GetSQLIndex(Index: Integer): TStrings;
begin
Result := FSQLText[TUpdateKind(Index)];
end;
{-----------------------------------------------------
TADOUpdateSQL.GetDataSet

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

function TADOUpdateSQL.GetDataSet: TADOUpdDataSet;
begin
Result := FDataSet;
end;
{-----------------------------------------------------
TADOUpdateSQL.SetDataSet

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.SetDataSet(ADataSet: TADOUpdDataSet);
begin
FDataSet := ADataSet;
end;

{-----------------------------------------------------
TADOUpdateSQL.SetParams

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.SetParams(UpdateKind: TUpdateKind);
var
I : Integer;
isOld : Boolean;
Parameter : TParameter;
ParameterName : string;
AValue : Variant;
ADOField : OleVariant;
begin
if not Assigned(FDataSet) then Exit;

with Query[UpdateKind] do
begin
Parameters.ParseSQL(SQL.Text, True);
for I := 0 to Parameters.Count - 1 do
begin
Parameter := Parameters.Items;
ParameterName := Parameter.Name;
isOld := CompareText(Copy(ParameterName, 1, 4), 'OLD_') = 0;
if isOld then
System.Delete(ParameterName, 1, 4);
if not Assigned(FDataSet.FindField(ParameterName)) then
Continue;

ADOField := FDataSet.Recordset.Fields[ParameterName];
if isOld then
AValue := ADOField.OriginalValue
else
if VarIsEmpty(ADOField.Value) or VarIsNull(ADOField.Value) then
begin
Parameter.ParameterObject.Type_ := FDataSet.Recordset.Fields[ParameterName].Type_;
AValue := NULL;
end
else
AValue := ADOField.Value;
Parameter.Value := AValue;
end;
end;

end;

{-----------------------------------------------------
TADOUpdateSQL.SetSQL

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.SetSQL(UpdateKind: TUpdateKind; Value: TStrings);
begin
FSQLText[UpdateKind].Assign(Value);
end;
{-----------------------------------------------------
TADOUpdateSQL.SetSQLIndex

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.SetSQLIndex(Index: Integer; Value: TStrings);
begin
SetSQL(TUpdateKind(Index), Value);
end;
{-----------------------------------------------------
TADOUpdateSQL.SQLChanged

* Purpose :
* Author : Fred Schetterer
* History :
12-Mar-2000 - Created
--------------------------------------------------------}

procedure TADOUpdateSQL.SQLChanged(Sender: TObject);
var
UpdateKind : TUpdateKind;
begin
for UpdateKind := Low(TUpdateKind) to High(TUpdateKind) do
if Sender = FSQLText[UpdateKind] then
begin
if Assigned(FQueries[UpdateKind]) then
begin
FQueries[UpdateKind].Parameters.Clear;
FQueries[UpdateKind].SQL.Assign(FSQLText[UpdateKind]);
end;
Break;
end;
end;

end.

呵呵，楼上提供的这个代码好象就是楼主的控件哦。

有两位反向工程的高手，解决了第一个控件了，得到了Pas了[]，感谢他们！
hxy2002的这个控件非常好，很相似，谢谢
正在等待第二个控件的pas……

接受答案了.