unit frameSelectUser;

interface

uses
  Winapi.Windows, Data.DB, Data.Win.ADODB, Vcl.DBCtrls, Vcl.StdCtrls, Vcl.Controls,
  Vcl.Buttons, System.Classes, System.SysUtils, Vcl.Forms, Variants, Comobj;

type
  TTestSelectUser = class(TFrame)
    GroupBox4: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    edtsearch: TEdit;
    cbShop: TDBLookupComboBox;
    cbUser: TDBLookupComboBox;
  private
    FCommand: TADOCommand;

    function  GetConnection: TADOConnection;
    procedure RefreshDBLookup(ADBL: TDBLookupControl);
    procedure SetConnection(const Value: TADOConnection);
  protected
    property Command: TADOCommand read FCommand;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy; override;

  published
    { Published declarations }
    property Connection:TADOConnection read GetConnection write SetConnection;
  end;

type
  TDBlk = class(TDBLookupControl)
  published
    property KeyValue;
    property ListSource;
  end;
  TCRADOConnection = class(TADOConnection)

  end;
  TCRADOCommand = class(TADOCommand)

  end;

procedure Register;

implementation

{$R *.dfm}

uses formSearchForUser, dmDB;

procedure Register;
begin
  RegisterComponents('Test', [TTestSelectUser]);
end;

{ TTestSelectUser }

constructor TTestSelectUser.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);

  FCommand := TADOCommand.Create(Self);
  TCRADOCommand(FCommand).ComponentRef := Self;

  DataModule2:=TDataModule2.Create(Self);
end;

procedure TTestSelectUser.CreateSearchForm(const AText: string='');
var
  f:TfrmSearchForUsers;
begin
  f:=TfrmSearchForUsers.Create(Self);
  try
    f.ShowModal;
  finally
    FreeAndNil(f);
  end;
end;

destructor TTestSelectUser.Destroy;
begin
  SetConnection(nil);
  FreeAndNil(FCommand);
  inherited Destroy;
end;

function TTestSelectUser.GetConnection: TADOConnection;
begin
  if Assigned(Command) then
    Result := Command.Connection 
  else
    Result := nil;
end;

procedure TTestSelectUser.RefreshDBLookup(ADBL: TDBLookupControl);
begin
  TDBlk(ADBL).ListSource.DataSet.DisableControls;
  try
    try
      TDBlk(ADBL).ListSource.DataSet.Close;
      TDBlk(ADBL).ListSource.DataSet.Open;

      TDBlk(ADBL).KeyValue:=Null;
    except
      on E: Exception do
        begin
          raise Exception.Create('RefreshDBLookup Error='+e.Message);
        end;
      on E: EOleException do
        begin
          raise Exception.Create('RefreshDBLookup OLE Error='+e.Message);
        end;
      on E: EDatabaseError do
        begin
          raise Exception.Create('RefreshDBLookup DB Error='+e.Message);
        end;
    end;
  finally
    TDBlk(ADBL).ListSource.DataSet.EnableControls;
  end;
end;

procedure TTestSelectUser.SetConnection(const Value: TADOConnection);
begin
  if Connection <> Value then
  begin
    if Assigned(Connection) then TCRADOConnection(Connection).UnregisterClient(Self);
    if Assigned(Command) then Command.Connection := Value;
  end;
  if Assigned(Value) then
  begin
    TCRADOConnection(Value).RegisterClient(Self);
  end;
end;

end.

unit uCMPCreate;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms,
  Data.DB, Data.Win.ADODB,
  Vcl.DBCtrls, Vcl.StdCtrls, Vcl.Buttons, Comobj, Variants;

const
  SQLShops=' select id_shop, shop_name '+
           ' from AllShops '+
           ' order by shop_name';

  TTestCMPCreate = class(TFrame)
    GroupBox4: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
  private
    { Private declarations }
    FADOQuery,
    aqShops:TADOQuery;

    function  GetConnection: TADOConnection;
    procedure SetConnection(const Value: TADOConnection);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Connection:TADOConnection read GetConnection write SetConnection;
  end;

procedure Register;

implementation

{$R *.dfm}

procedure Register;
begin
  RegisterComponents('Samples', [TTestCMPCreate]);
end;

{ TTestCMPCreate }

constructor TTestCMPCreate.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FADOQuery:=TADOQuery.Create(nil);
  FADOQuery.SetSubComponent(True);

  aqShops:=TADOQuery.Create(nil);
  aqShops.SetSubComponent(True);
  aqShops.SQL.Text:=SQLShops;
end;

destructor TTestCMPCreate.Destroy;
begin
  FreeAndNil(aqShops);
  FreeAndNil(FADOQuery);
  inherited Destroy;
end;

function TTestCMPCreate.GetConnection: TADOConnection;
begin
  if Assigned(FADOQuery.Connection) then
    Result := FADOQuery.Connection
  else
    Result:=nil;
end;

procedure TTestCMPCreate.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent,Operation);
  if (AComponent = FADOQuery) and (Operation = opRemove) then
    begin
      aqShops.Connection:=nil;
      FADOQuery.Connection := nil;
    end;
end;

procedure TTestCMPCreate.SetConnection(const Value: TADOConnection);
var
  ac:TADOConnection;
begin
  ac:=Connection;
  if ac <> Value then
    begin
      if ac<>nil then
        ac.RemoveFreeNotification(Self);

      FADOQuery.Connection := Value;
      aqShops.Connection:=FADOQuery.Connection;

      if Assigned(Value) then
        begin
          Value.FreeNotification(Self);
        end;
    end;
end;

end.