Hola, os pongo aqui una unit que uso para crear un filtro SQL. La form correspondiente usa un TEdit y 3 TMemos (no visibles, y que pueden sustituirse por TStringList perfectamente). Lo que hace esta form es:
- filtra por el texto puesto
- filtra por fechas : si incluyes una fecha, filtra por esa fecha, si incluyes varias (con operadores) filtra entre esas. Si pones hoy / ayer, te filtra los q tienen campos datetime en hoy/ayer
- por numeros : con operadores...(para buscar igualdad en campo numerico, poniendo antes #)
- campos boolean, los cuales pueden tener sinonimos (p.ej, nombre de campo : cobrada; sinonimos->pagada, pagado, cobrado, cbr,etc...)
Código Delphi
[-]
unit edSQL;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls, StdCtrls, dbtables;
type
T_edsql = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
procedure FormActivate(Sender: TObject);
procedure Sustituir_sinonims;
procedure Enllazos(sql : PString;cap : PString);
procedure Aplicar_Proc_Ordenar;
procedure Fer_Cadena_SQL;
function Fer_Cadena_Texte: string;
function Fer_Cadena_Nombres: string;
function Fer_Cadena_Dates : string;
function Fer_cadena_Boolean : string;
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Requerir_filtre(q : TQuery; t, id : string);
procedure Discriminar_texte;
function FormatejaData(dt: string): string;
function Camps_de_(s : string; q : TQuery) : TStringList;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
texte_del_edit : string;
sinonims : TStringList;
taula : string;
query : TQuery;
id_comp : string;
SQL_Texte : string;
proc_ordenar : procedure of object;
extern_sql_txt : Pstring;
extern_caption_txt : PString;
fmt_dates_SQL : string;
Comod_SQL : string;
end;
var
_edsql: T_edsql;
implementation
uses db;
{$R *.DFM}
procedure T_edsql.Enllazos(sql : PString;cap : PString);
begin
extern_sql_txt := sql;
extern_caption_txt := cap;
end;
procedure T_edsql.Requerir_filtre(q : TQuery; t : string; id : string);
begin
query := q;
taula := t;
id_comp := id;
_Filtresql.Show;
end;
procedure T_edsql.FormActivate(Sender: TObject);
begin
Edit1.Text := '';
comod_SQL := '%';
fmt_dates_SQL := '"#"mm"/"dd"/"yyyy"#"';
Edit1.Top := (Panel1.Height - Edit1.height) div 2;
Edit1.Left := (Panel1.Width - Edit1.Width) div 2;
caption := 'Filtrar ' + Lowercase(taula);
end;
procedure T_edsql.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = 27 then begin Edit1.Text := ''; close; end;
if (Key = 13) then
begin
Sustituir_sinonims;
Discriminar_texte;
Fer_Cadena_SQL;
Aplicar_Proc_Ordenar;
Edit1.SelectAll;
Edit1.SetFocus;
end;
end;
procedure T_edsql.Aplicar_Proc_Ordenar;
begin
extern_caption_txt^ := texte_del_edit;
extern_sql_txt^ := SQL_texte;
Proc_ordenar;
end;
procedure T_edsql.Sustituir_sinonims;
var
i,r : integer;
j,p : integer;
cmp : TStringList;
txt : string;
begin
cmp := TStringList.Create;
txt := ' ' + Edit1.Text + ' ';
txt := StringReplace(txt,' ',' ',[rfReplaceAll]);
r := sinonims.Count;
for i := 0 to r - 1 do
begin
cmp.CommaText := sinonims[i];
p := cmp.Count;
for j := 1 to p - 1 do
txt := StringReplace(txt,' '+cmp[j]+' ',' '+cmp[0]+' ',[rfReplaceAll,rfIgnoreCase]);
end;
txt := StringReplace(txt,' ',' ',[rfReplaceAll]);
texte_del_edit := txt;
cmp.Free;
end;
procedure T_edsql.Fer_Cadena_SQL;
var
cadena_txt : string;
cadena_num : string;
cadena_dat : string;
cadena_bol : string;
begin
SQL_texte := '';
cadena_bol := Fer_Cadena_Boolean;
cadena_num := Fer_Cadena_Nombres;
cadena_txt := Fer_Cadena_texte;
cadena_dat := Fer_Cadena_Dates;
if cadena_num <> '' then SQL_texte := SQL_texte + cadena_num;
if cadena_txt <> '' then
begin
if SQL_texte <> '' then SQL_texte := SQL_texte + ' or ';
SQL_texte := SQL_texte + cadena_txt;
end;
if cadena_dat <> '' then
begin
if SQL_texte <> '' then SQL_texte := SQL_texte + ' and ';
SQL_texte := SQL_texte + cadena_dat;
end;
if cadena_bol <> '' then
begin
if SQL_texte <> '' then SQL_texte := SQL_texte + ' and ';
SQL_texte := SQL_texte + cadena_bol;
end;
if SQL_texte <> '' then SQL_texte := ' where ' + SQL_Texte;
end;
function T_edsql.Fer_cadena_Boolean : string;
var
i,r : integer;
camps_de_boolean : TStringList;
txt : string;
s : string;
begin
txt := '';
camps_de_boolean := Camps_de_('boolean',query);
if camps_de_boolean.Count = 0 then
begin
camps_de_boolean.Free;
Fer_cadena_boolean := '';
exit;
end;
r := Memo1.Lines.Count;
for i := 0 to r - 1 do
begin
s := uppercase(Memo1.Lines[i]);
if StrPos(PChar(Uppercase(camps_de_boolean.Text)),PChar(s)) <> nil then
begin
if txt = '' then txt := Uppercase(s) + ' = true' else txt := txt + ' and ' + UpperCase(s) + ' = true';
Memo1.Lines.Delete(i);
end;
end;
camps_de_boolean.Free;
Fer_cadena_boolean := txt;
end;
function T_edsql.Fer_Cadena_Dates : string;
var
i,r : integer;
txt : string;
camps_de_dates : TStringList;
en_valors : string;
operadors : string;
val_s : string;
val_min : TDateTime;
val_max : TDateTime;
val : TDateTime;
begin
txt := '';
r := memo3.Lines.Count;
val_min := strtodate('1/1/1899');
val_max := strtodate('31/12/9999');
camps_de_dates := Camps_de_('datetime',query);
if camps_de_dates.Count = 0 then
begin
camps_de_dates.Free;
Fer_Cadena_Dates := '';
exit;
end;
for i := 0 to r - 1 do
begin
val_s := StringReplace(Memo3.Lines[i],'<','',[rfReplaceAll,rfIgnoreCase]);
val_s := StringReplace(val_s,'>','',[rfReplaceAll,rfIgnoreCase]);
val := strtodate(val_s);
if (StrPos(PChar(memo3.lines[i]),'<')<> nil) then
begin
if val < val_max then val_max := val;
end
else
if (StrPos(PChar(memo3.lines[i]),'>') <> nil) then
begin
if val > val_min then val_min := val;
end
else
begin
if en_valors <> '' then en_valors := en_valors + ',' + FormatejaData(datetostr(val)) else
en_valors := '(' + FormatejaData(datetostr(Val));
end;
end;
operadors := '';
if (val_min > strtodate('1/1/1899')) and (val_max < strtodate('31/12/9999')) then
begin
operadors := ' between ' + FormatejaData(datetostr(val_min)) + ' and ' + FormatejaData(datetostr(val_max));
end
else
begin
if val_min > strtodate('1/1/1899') then
operadors := ' >' + FormatejaData(datetostr(val_min));
if val_max < strtodate('31/12/9999') then
operadors := ' <' + FormatejaData(datetostr(val_max));
end;
if en_valors <> '' then en_valors := en_valors + ')';
txt := '';
r := camps_de_dates.Count;
for i := 0 to r - 1 do
begin
if en_valors <> '' then
begin
if txt <> '' then txt := txt + ' or ';
txt := txt + '(' + camps_de_dates[i] + ' in ' + en_valors + ')';
end;
if operadors <> '' then
begin
if txt <> '' then txt := txt + ' or ';
txt := txt + '(' + camps_de_dates[i] + operadors + ')';
end;
end;
camps_de_dates.Free;
Fer_cadena_dates := txt;
end;
function T_edsql.FormatejaData(dt: string): string;
begin
fmt_dates_SQL := '"#"mm"/"dd"/"yyyy"#"';
FormatejaData := FormatDateTime(fmt_dates_SQL, strtodate(dt));
end;
function T_edsql.Fer_Cadena_nombres : string;
var
i,r : integer;
txt : string;
camps_de_nombres : TStringList;
en_valors : string;
operadors : string;
val_s : string;
val_min : double;
val_max : double;
val : double;
begin
txt := '';
r := memo2.Lines.Count;
val_min := -99999999;
val_max := 99999999;
camps_de_nombres := Camps_de_('nombres',query);
if camps_de_nombres.Count = 0 then
begin
camps_de_nombres.Free;
Fer_cadena_nombres := '';
exit;
end;
for i := 0 to r - 1 do
begin
val_s := StringReplace(Memo2.Lines[i],'<','',[rfReplaceAll,rfIgnoreCase]);
val_s := StringReplace(val_s,'>','',[rfReplaceAll,rfIgnoreCase]);
val := strtofloat(val_s);
if (StrPos(PChar(memo2.lines[i]),'<')<> nil) then
begin
if val < val_max then val_max := val;
end
else
if (StrPos(PChar(memo2.lines[i]),'>') <> nil) then
begin
if val > val_min then val_min := val;
end
else
begin
if en_valors <> '' then en_valors := en_valors + ',' + Memo2.Lines[i] else
en_valors := '(' + Memo2.Lines[i];
end;
end;
operadors := '';
if (val_min > -99999999) and (val_max < 99999999) then
begin
operadors := ' between ' + inttostr(Round(val_min)) + ' and ' + inttostr(Round(val_max));
end
else
begin
if val_min > -99999999 then
operadors := ' >' + inttostr(Round(val_min));
if val_max < 99999999 then
operadors := ' <' + inttostr(Round(val_max));
end;
if en_valors <> '' then en_valors := en_valors + ')';
txt := '';
r := camps_de_nombres.Count;
for i := 0 to r - 1 do
begin
if en_valors <> '' then
begin
if txt <> '' then txt := txt + ' or ';
txt := txt + '(' + camps_de_nombres[i] + ' in ' + en_valors + ')';
end;
if operadors <> '' then
begin
if txt <> '' then txt := txt + ' or ';
txt := txt + '(' + camps_de_nombres[i] + operadors + ')';
end;
end;
Fer_cadena_nombres := txt;
camps_de_nombres.Free;
end;
function T_edsql.Fer_Cadena_Texte : string;
var
i,r : integer;
txt : string;
camps_txt : string;
camps_de_texte : TStringList;
begin
txt := '';
camps_txt := '(';
camps_de_texte := Camps_de_('texte',Query);
if camps_de_texte.Count = 0 then
begin
camps_de_texte.Free;
Fer_cadena_texte := '';
exit;
end;
r := camps_de_texte.Count;
for i := 0 to r - 1 do
begin
if camps_txt <> '(' then camps_txt := camps_txt + '+'' ''+';
camps_txt := camps_txt + 'IIF('+Camps_de_texte[i] + ',' + Camps_de_texte[i] + ',''0'')';
end;
r := Memo1.Lines.Count;
for i := 0 to r - 1 do
begin
if txt <> '' then txt := txt + ' and ';
txt := txt + camps_txt + ' like '''+Comod_SQL +Memo1.Lines[i]+Comod_SQL + ''')';
end;
Camps_de_texte.Free;
Fer_cadena_texte := txt;
end;
function T_edsql.Camps_de_(s : string; q : TQuery) : TStringList;
var
i,r : integer;
camp_data_type : TFieldType;
ret : TStringList;
no_buscar_a_id : boolean;
begin
s := Lowercase(s);
r := Query.FieldCount;
ret := TStringList.Create;
if (id_comp = 'nomes id') and ((s = 'nombres') or (s = 'enters')) then
begin
ret.Add('id');
camps_de_ := ret;
exit;
end;
no_buscar_a_id := lowercase(id_comp) = 'no id';
for i := 0 to r-1 do
begin
if (no_buscar_a_id) and (Query.Fields[i].FieldName = 'id') then continue;
camp_data_type := Query.Fields[i].DataType;
if s = 'texte' then
begin
if (camp_data_type = ftString) or
(camp_data_type = ftMemo) or
(camp_data_type = ftFmtMemo) or
(camp_data_type = ftFixedChar) or
(camp_data_type = ftWideString) then
ret.Add(Query.Fields[i].FieldName);
end
else
if (s = 'nombres') then
begin
if (camp_data_type = ftSmallInt) or
(camp_data_type = ftInteger) or
(camp_data_type = ftWord) or
(camp_data_type = ftAutoInc) or
(camp_data_type = ftLargeInt) or
(camp_data_type = ftFloat) or
(camp_data_type = ftCurrency) then
ret.Add(Query.Fields[i].FieldName);
end
else
if (s = 'enters') then
begin
if (camp_data_type = ftSmallInt) or
(camp_data_type = ftInteger) or
(camp_data_type = ftWord) or
(camp_data_type = ftAutoInc) or
(camp_data_type = ftLargeInt) then
ret.Add(Query.Fields[i].FieldName);
end
else
if (s = 'floats') then
begin
if (camp_data_type = ftFloat) or
(camp_data_type = ftCurrency) then
ret.Add(Query.Fields[i].FieldName);
end
else
if (s = 'datetime') then
begin
if (camp_data_type = ftDateTime) or
(camp_data_type = ftDate) or
(camp_data_type = ftTime) then
ret.Add(Query.Fields[i].FieldName);
end
else
if (s = 'memos') then
begin
if (camp_data_type = ftMemo) or
(camp_data_type = ftFmtMemo) then
ret.Add(Query.Fields[i].FieldName);
end
else
if (s = 'boolean') then
begin
if (camp_data_type = ftBoolean) then
ret.Add(Query.Fields[i].FieldName);
end;
end;
Camps_de_ := ret; end;
procedure T_edsql.Discriminar_texte;
var
i,cnt : integer;
txt,txt_s : string;
begin
Memo1.Lines.Commatext := Uppercase(texte_del_edit);
memo2.Lines.Clear;
Memo3.Lines.Clear;
cnt := Memo1.Lines.Count;
i := 0;
while (i < cnt) do
begin
txt := Memo1.Lines[i];
txt_s := StringReplace(txt,'<','',[rfReplaceAll,rfIgnoreCase]);
txt_s := StringReplace(txt_s,'>','',[rfReplaceAll,rfIgnoreCase]);
txt_s := StringReplace(txt_s,'#','',[rfReplaceAll,rfIgnoreCase]);
if (txt <> txt_s) then
try
strtofloat(txt_s);
txt := StringReplace(txt,'#','',[rfReplaceAll,rfIgnoreCase]);
Memo2.Lines.Add(txt);
Memo1.Lines.Delete(i);
cnt := cnt - 1;
dec(i);
except
end;
try
strtodate(txt_s);
Memo3.Lines.Add(txt);
Memo1.Lines.Delete(i);
cnt := cnt - 1;
dec(i);
except
end;
txt_s := uppercase(txt);
if (txt_s = 'AVUI') or
(txt_s = 'HOY') then
begin
Memo3.Lines.Add(datetostr(Date));
Memo1.Lines.Delete(i);
cnt := cnt - 1;
dec(i);
end
else
if (txt_s = 'AHIR') or
(txt_s = 'AYER') then
begin
Memo3.Lines.Add(datetostr(Date - 1));
Memo1.Lines.Delete(i);
cnt := cnt - 1;
dec(i);
end;
inc(i);
end;
end;
procedure T_edsql.FormCreate(Sender: TObject);
begin
Sinonims := TStringList.Create;
getmem(extern_sql_txt,sizeof(PString));
getmem(extern_caption_txt,sizeof(PString));
end;
procedure T_edsql.FormDestroy(Sender: TObject);
begin
Sinonims.Free;
end;
end.
un pequeño ejemplo.
Código Delphi
[-]
procedure T_lfact.Filtrar1Click(Sender : TObject);
begin
_edSQL.Sinonims.Clear;
_edSQL.Sinonims.Add('COBRADA PAGADA COBRADO PAGADO'); _edSQL.Proc_ordenar := Ordenar; _edSQL.Enllazos(@SQL_Texte, @Caption_Texte); _edSQL.Requerir_filtre(dm.qFCT, 'FACTURES', 'no id');
end;
procedure T_lfact.Ordenar;
var
id : longint;
begin
id := dm.qFCT.FieldByName('id').Asinteger;
dm.qFCT.SQL.Text := 'select * from tFACT ' + SQL_texte + ' order by ' +
Panel1.Caption;
dm.qFCT.ExecSQL;
dm.qFCT.Active := true;
dm.qFCT.Locate('id', id, []);
Posa_caption;
end;