Component for incremental search

[tomzambrano]

greetings;

I was developing a component that incorporates embed the way a DBGrid DBEdit and to perform an incremental search. I need help from experts to improve that component and make it more efficient.
Then leave the code the same, so I revicen and can give me their advice to improve it.

Code: [Select]

unit Zambusqueda;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls, db,
  DBGrids, StdCtrls;

type
  TZambusqueda = class(TCustomControl)
  private
    { Private declarations }
    FFuenteDatos: TDataSource;
    FCampoDatos: String;

    FBusquedaDatos: TDataSource;
    FCampoBusqueda: String;

    FDBedit: TDBEdit;
    FDBGrid: TDBGrid;

    function GetFuenteDeDatos: TDataSource;
    procedure SetFuenteDeDatos(Value: TDataSource);

    function GetCampoDatos: string;
    procedure SetCampoDatos(const Value: string);

    function GetFuenteDeDatos2: TDataSource;
    procedure SetFuenteDeDatos2(Value: TDataSource);

    function GetCampoDatos2: string;
    procedure SetCampoDatos2(const Value: string);

    procedure DBEditChange(Sender: TObject);
    procedure DBGridCellClick(Column: TColumn);

    procedure DSStateChange(Sender: TObject);
  protected
    { Protected declarations }
     property Edit: TDBEdit read FDBEdit write FDBEdit;
     property DBGrid: TDBGrid read FDBGrid write FDBGrid;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property FuenteDatos: TDataSource read GetFuenteDeDatos write SetFuenteDeDatos;
    //property CampoDatos: String read GetCampoDatos write SetCampoDatos;
    property CampoDatos: String read FCampoDatos write SetCampoDatos;

    property BusquedaDatos: TDataSource read GetFuenteDeDatos2 write SetFuenteDeDatos2;
    //property CampoBusqueda: String read GetCampoDatos2 write SetCampoDatos2;
    property CampoBusqueda: String read FCampoBusqueda write SetCampoDatos2;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Zambrano Controls',[TZambusqueda]);
end;

procedure TZambusqueda.DSStateChange(Sender: TObject);
begin
   FDBGrid.Visible:= (FDBEdit.DataSource.State in dsEditModes) and FDBedit.Focused;
   inherited;
end;

constructor TZambusqueda.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  with GetControlClassDefaultSize do SetInitialBounds(0,0,150,150);

  FDBEdit := TDBEdit.Create(Self);
  FDBEdit.Caption := '';
  FDBEdit.Text    := '';
  FDBEdit.Visible  := True;
  FDBedit.CharCase := ecUppercase;
  FDBEdit.Parent   := Self;
  FDBedit.SetSubComponent(True); //Indica al IDE almacenar las propiedades modificadas
  FDBedit.ControlStyle := FDBedit.ControlStyle - [csNoDesignSelectable];
  FDBEdit.Align    := alTop;
  FDBEdit.OnChange := @DBEditChange;

  FDBGrid := TDBGrid.Create(Self);
  FDBGrid.Visible := False;
  FDBGrid.Parent  := Self;
  FDBGrid.Left := 0;
  FDBGrid.Options    := [dgTabs,dgAlwaysShowSelection,dgConfirmDelete,dgCancelOnExit];
  FDBGrid.ScrollBars := ssAutoVertical;
  FDBGrid.Top   := FDBedit.Height+2;
  FDBGrid.Anchors := [akTop,akLeft,akRight,akBottom];
  FDBGrid.Align := alBottom;
  FDBGrid.SetSubComponent(True);
  FDBGrid.ControlStyle := FDBGrid.ControlStyle - [csNoDesignSelectable];
  FDBGrid.OnCellClick:=@DBGridCellClick;
end;

destructor TZambusqueda.Destroy;
begin
  FDBedit.Destroy;
  FDBGrid.Destroy;
  inherited Destroy;
end;


function TZambusqueda.GetFuenteDeDatos: TDataSource;
begin
  Result := FFuenteDatos;
end;

procedure TZambusqueda.SetFuenteDeDatos(Value: TDataSource);
begin
    if Value=nil then SetCampoDatos('');

    FFuenteDatos := Value;
    FDBedit.DataSource := FFuenteDatos;
    FDBEdit.DataSource.OnStateChange:=@DSStateChange;
end;

function TZambusqueda.GetCampoDatos: string;
begin
  Result := FCampoDatos;
end;

procedure TZambusqueda.SetCampoDatos(const Value: string);
begin
  FCampoDatos := Value;
  FDBEdit.DataField := Value;
end;

procedure TZambusqueda.DBEditChange(Sender: TObject);
var
  Filtro: String;
begin
   FDBGrid.DataSource.DataSet.FilterOptions :=[foCaseInsensitive];
   FDBGrid.DataSource.DataSet.Filtered      :=False;
   if (Length(FDBEdit.Text)>0) and (FDBedit.DataSource.DataSet.State in dsWriteModes)
   then begin
     FDBGrid.Visible:=True;
     Filtro:=FCampoBusqueda + ' like ' + QuotedStr('*'+Trim(FDBEdit.Text)+'*');
     FDBGrid.DataSource.DataSet.Filter   := Filtro;
     FDBGrid.DataSource.DataSet.Filtered := true;
   end
   else begin
     FDBGrid.Visible:=False;
   end;
   inherited;
end;

procedure TZambusqueda.DBGridCellClick(Column: TColumn);
begin
  if not Assigned(FFuenteDatos) then exit;
  if not (FDBedit.DataSource.DataSet.State in dsWriteModes) then Exit;
  FDBEdit.Field.AsString := Trim(FDBGrid.Columns.Items[0].Field.Text);
  FDBGrid.Visible:=false;
end;

function TZambusqueda.GetFuenteDeDatos2: TDataSource;
begin
  Result := FBusquedaDatos;
end;

procedure TZambusqueda.SetFuenteDeDatos2(Value: TDataSource);
begin
    if Value=nil
    then begin
         SetCampoDatos2('');
    end;

    FBusquedaDatos := Value;
    FDBGrid.DataSource := FBusquedaDatos;
end;

function TZambusqueda.GetCampoDatos2: string;
begin
  Result := FCampoBusqueda;
end;

procedure TZambusqueda.SetCampoDatos2(const Value: string);
begin
  FCampoBusqueda := Value;
end;

end.


[BigChimp]

Interesting, thanks a lot - and welcome to the forum

I'm not that much of a GUI guy, but one suggestion I'd make would be to translate the class/function/property names to English if possible...

[exdatis]

Interesting, thanks a lot - and welcome to the forum

The same from me,
Regards!

[tomzambrano]

The problem is that the derivative of a component TCustomControl, so I embed the two components, a DBEdit and DBGrid. when I set the visible property of the DBGrid equal to false the components under TCustomControl derivative component are not because there are overlapping with this. Any suggestions or solution. I add some pictures that show the situation.

[tomzambrano]

I managed to solve the problem by adding a procedure

Code: [Select]

procedure TZambusqueda.SetVisibleDBGrid(const Value:Boolean);
begin
  if (not Value)
  then SetInitialBounds(Left,Top,Width,FDBedit.Height+4)
  else SetInitialBounds(Left,Top,Width,105);

  FDBGrid.Visible := Value;
end; 

And making one other change in the code. Here I give you the full code. In addition the package in a compressed file. Desire serve them useful for you and your projects. Do not forget to author recognition.

Code: [Select]

unit Zambusqueda;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DbCtrls, db,
  DBGrids, StdCtrls, LMessages, LCLType;

type
  TZambusqueda = class(TCustomControl)
  private
    { Declaraciones privadas }
    FDBedit: TDBEdit;       //component embeded
    FDBGrid: TDBGrid;       //component embeded
    FOnExit: TNotifyEvent;

    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetFieldSearch: TField;
    function GetDataSearchSource: TDataSource;
    function GetDataFieldSearchSource: string;

    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetDataSearchSource(const Value: TDataSource);
    procedure SetDataFieldSearchSource(const Value: string);

    procedure DBEditChange(Sender: TObject);
    procedure DBGridCellClick(Column: TColumn);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: char);
    procedure EditingChange(Sender: TObject);

    procedure SetVisibleDBGrid(const Value:Boolean);


  protected
    { Declaraciones protegidas }
    FDataLink: TFieldDataLink;
    FSourceLink: TFieldDataLink;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
    procedure CMExit(var Message: TLMessage); message CM_EXIT;

    procedure Click; override;
    Procedure Paint; Override;

  public
    { Declaraciones publicas }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property Field: TField read GetField;
    property FieldSearch: TField read GetFieldSearch;
    property DBEdit: TDBEdit read FDBEdit write FDBEdit;
    property DBGrid: TDBGrid read FDBGrid write FDBGrid;

    function GetVisibleDBGrid:Boolean;

  published
    { Declaraciones publicadas }
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;

    property DataFieldSearchSource: string read GetDataFieldSearchSource write SetDataFieldSearchSource;
    property DataSearchSource: TDataSource read GetDataSearchSource write SetDataSearchSource;

    property OnExit: TNotifyEvent read FOnExit write FOnExit;

    property Align;
    property Enabled;
    property TabOrder;
    property TabStop;
    property Visible;

  end;


procedure Register;
procedure ChangeDataSource(AControl: TControl; Link: TDataLink; NewDataSource: TDataSource);

implementation

procedure Register;
begin
  RegisterComponents('Zambrano Controls',[TZambusqueda]);
end;

procedure ChangeDataSource(AControl: TControl; Link: TDataLink;
  NewDataSource: TDataSource);
begin
  if Link.DataSource=NewDataSource then exit;
  if Link.DataSource<>nil then
    Link.DataSource.RemoveFreeNotification(AControl);
  Link.DataSource:=NewDataSource;
  if Link.DataSource<>nil then
    Link.DataSource.FreeNotification(AControl);
end;

function TZambusqueda.GetVisibleDBGrid:Boolean;
begin
  Result := FDBGrid.Visible;
end;


procedure TZambusqueda.SetVisibleDBGrid(const Value:Boolean);
begin
  if (not Value)
  then SetInitialBounds(Left,Top,Width,FDBedit.Height+4)
  else SetInitialBounds(Left,Top,Width,105);

  FDBGrid.Visible := Value;
end;

procedure TZambusqueda.EditingChange(Sender: TObject);
begin
  if not FDataLink.Editing then SetVisibleDBGrid(False);
  if FDataLink.Editing and FDBedit.Focused then SetVisibleDBGrid(True);
end;

procedure TZambusqueda.Click;
begin
  inherited;
  Self.SetFocus;
end;

procedure TZambusqueda.Paint;
begin
  inherited Paint;
end;

function TZambusqueda.GetDataFieldSearchSource: string;
begin
  Result := FSourceLink.FieldName;
end;

procedure TZambusqueda.SetDataFieldSearchSource(const Value: string);
begin
    FSourceLink.FieldName := Value;
end;

function TZambusqueda.GetDataSearchSource: TDataSource;
begin
  Result := FSourceLink.DataSource;
end;

procedure TZambusqueda.SetDataSearchSource(const Value: TDataSource);
begin
  ChangeDataSource(Self,FSourceLink,Value);
  FDBGrid.DataSource := Value;
end;

function TZambusqueda.GetField: TField;
begin
  Result := FDataLink.Field;
end;

function TZambusqueda.GetFieldSearch: TField;
begin
  Result := FSourceLink.Field;
end;

procedure TZambusqueda.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) then begin
    if (FDataLink<>nil) and (AComponent=DataSource) then
      DataSource:=nil;
    if (FSourceLink<>nil) and (AComponent=DataSearchSource) then
      DataSearchSource:=nil;
  end;
end;

function TZambusqueda.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TZambusqueda.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
  FDBedit.DataField   := Value;
end;

function TZambusqueda.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TZambusqueda.SetDataSource(Value: TDataSource);
begin
  ChangeDataSource(Self,FDataLink,Value);
  FDBedit.DataSource := Value;
end;

constructor TZambusqueda.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Self.ControlStyle:=Self.controlStyle-[csReplicatable, csOpaque, csAcceptsControls];
  TabStop:=False;

  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnEditingChange:=@EditingChange;

  FSourceLink := TFieldDataLink.Create;
  FSourceLink.Control := Self;

  FDBEdit := TDBEdit.Create(Self);
  FDBEdit.Parent  := Self;
  FDBedit.Width   := 150;
  FDBEdit.Caption := '';
  FDBEdit.Text    := '';
  FDBEdit.Visible  := True;
  FDBedit.CharCase := ecUppercase;
  FDBedit.SetSubComponent(True); //Indica al IDE almacenar las propiedades modificadas
  FDBedit.ControlStyle := FDBedit.ControlStyle - [csNoDesignSelectable];
  FDBEdit.Align    := alTop;
  FDBedit.TabStop:=False;
  FDBEdit.OnChange := @DBEditChange;
 
  with GetControlClassDefaultSize do
  begin
     if csDesigning in ComponentState
     then SetInitialBounds(0,0,150,105)
//     else SetInitialBounds(Left,Top, Width,FDBedit.Height+4);
  end;

  FDBGrid := TDBGrid.Create(Self);
  FDBGrid.Parent  := Self;
  FDBGrid.Visible := False;
  FDBGrid.Left := 0;
  FDBGrid.Options    := [dgTabs,dgAlwaysShowSelection,dgConfirmDelete,dgCancelOnExit];
  FDBGrid.ScrollBars := ssAutoVertical;
  FDBGrid.Top   := FDBedit.Height+4;
  FDBGrid.Height:= 85;
  FDBGrid.Width := 150;
  FDBGrid.Anchors := [akTop,akLeft,akRight,akBottom];
  FDBGrid.Align := alBottom;
  FDBGrid.SetSubComponent(True);
  FDBGrid.ControlStyle := FDBGrid.ControlStyle - [csNoDesignSelectable];
  FDBGrid.TabStop:=False;
  FDBGrid.OnCellClick:=@DBGridCellClick;
  FDBGrid.OnKeyPress:=@DBGrid1KeyPress;;

end;

procedure TZambusqueda.CMGetDataLink(var Message: TLMessage);
begin
  Message.Result := PtrUInt(FDataLink);
end;

procedure TZambusqueda.CMExit(var Message: TLMessage);
begin
  inherited;
  if Assigned(FOnExit) then FOnExit(Self);
  SetVisibleDBGrid(False);
  Invalidate;
end;

procedure TZambusqueda.WMKillFocus(var Message: TLMKillFocus);
begin
  inherited;
  if (FDataLink.Editing) and (FDBGrid.Visible)
  then
    SetVisibleDBGrid(False);
  Invalidate;
end;

procedure TZambusqueda.WMSetFocus(var Message: TLMSetFocus);
begin
  inherited;
  if (FDataLink.Editing) and (FDBedit.Focused)
  then
    SetVisibleDBGrid(True);
  FDBedit.SetFocus;
  Invalidate;
end;

destructor TZambusqueda.Destroy;
begin
  FDBedit.Destroy;
  FDBGrid.Destroy;
  FSourceLink.Destroy;
  FDataLink.Destroy;

  inherited Destroy;
end;


procedure TZambusqueda.DBEditChange(Sender: TObject);
var
  Filtro: String;
begin
  if not Assigned(DataSearchSource) then exit;
   FDBGrid.DataSource.DataSet.FilterOptions :=[foCaseInsensitive];
   FDBGrid.DataSource.DataSet.Filtered      :=False;
   if (Length(FDBEdit.Text)>0) and (FDBedit.DataSource.DataSet.State in dsEditModes)
   then begin
     SetVisibleDBGrid(True);
     Filtro:=DataFieldSearchSource + ' like ' + QuotedStr('*'+Trim(FDBEdit.Text)+'*');
     FDBGrid.DataSource.DataSet.Filter   := Filtro;
     FDBGrid.DataSource.DataSet.Filtered := true;
   end
   else begin
     SetVisibleDBGrid(False);
   end;
   inherited;
end;

procedure TZambusqueda.DBGridCellClick(Column: TColumn);
begin
  if not Assigned(DataSearchSource) then exit;
  if not (DataSource.State in dsEditModes) then Exit;
  FDBEdit.Field.AsString := Trim(FDBGrid.Columns.Items[0].Field.Text);
  SetVisibleDBGrid(False);
end;

procedure TZambusqueda.DBGrid1KeyPress(Sender: TObject; var Key: char);
begin
  if Key=#13 //Key Return
  then begin
    if not Assigned(DataSearchSource) then exit;
    if not (DataSource.State in dsEditModes) then Exit;
    FDBEdit.Field.AsString := Trim(FDBGrid.Columns.Items[0].Field.Text);
    SetVisibleDBGrid(False);
  end;
end;

end.


[bill0287]

Hi, can you post a sample app which shows how to setup and use this component?

[tomzambrano]

Hi, can you post a sample app which shows how to setup and use this component?

To install it you have to open Lazarus, go to the menu and click on install package package file (. Lpk), then select the file zambrano_paquete.lpk, compile and install.

[bill0287]

Hi. I got the component to install, but when I tried to use it I got an index error. I am using the latest Lazaurs and DBF as the database.

I was hoping you had a small project which showed how to use this component or maybe some documentation that would help. I would like to try it out for you and give some feedback.

[tomzambrano]

Hi. I got the component to install, but when I tried to use it I got an index error. I am using the latest Lazaurs and DBF as the database.

I was hoping you had a small project which showed how to use this component or maybe some documentation that would help. I would like to try it out for you and give some feedback.

Hi, thanks for your interest. The component does not work properly with DBF. Because DBF does not support SQL statements I use to access the databases Zeos components that work well with managers as Postgres database, MySQL and others that have extensive support for managing SQL.

I will post a sample script to create a simple database in MySQL's an example of using the component as soon as possible. I've been busy with work issues that have not given me a chance to develop. Example features you need as soon as I find less work to do.

But I will put thier mini project I was using for testing in the development of the component. There you will see some things where I can guide you and use Zeos components.