Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 11-06-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
filtro inteligente

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
    { Private declarations }
  public
    { Public declarations }
    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;    // S'ha d'alliberar exteriorment!

        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;      // Pasem punter...s'allibera desde fora.
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
          // Cadena
          txt := Memo1.Lines[i];
          // Cadena sense operador (per conversions)
          txt_s := StringReplace(txt,'<','',[rfReplaceAll,rfIgnoreCase]);
          txt_s := StringReplace(txt_s,'>','',[rfReplaceAll,rfIgnoreCase]);
          txt_s := StringReplace(txt_s,'#','',[rfReplaceAll,rfIgnoreCase]);

          // Numero
          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;

          //Data
          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'); // el primero es el nombre del campo
     _edSQL.Proc_ordenar := Ordenar; // Procedimiento a llamar para ejecutar el SQL
     _edSQL.Enllazos(@SQL_Texte, @Caption_Texte); // string destino del SQL y otro string donde se mostrara lo del edit de _edSQL
     _edSQL.Requerir_filtre(dm.qFCT, 'FACTURES', 'no id'); 
// query destino; caption de _edSQL;filtro para campos numericos
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;

Responder Con Cita
  #2  
Antiguo 11-06-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
si bien no creo que os sirva asi tal cual, es facilmente customizalbe y os puede dar ideas o resolver alguna que otra duda.

saludos.
Responder Con Cita
  #3  
Antiguo 11-06-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
customizable ^
Responder Con Cita
  #4  
Antiguo 11-06-2008
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
PD: _filtresql es una instancia de _edsql. X)
Responder Con Cita
  #5  
Antiguo 05-01-2009
Avatar de ingabraham
ingabraham ingabraham is offline
Miembro
 
Registrado: ago 2007
Posts: 614
Poder: 18
ingabraham Va por buen camino
sera filtro bien largo, jeje
Responder Con Cita
  #6  
Antiguo 05-01-2009
[coso] coso is offline
Miembro Premium
 
Registrado: may 2008
Ubicación: Girona
Posts: 1.678
Poder: 0
coso Va por buen camino
la verdad es que si X) se puede optimizar (y asi lo uso ahora, mas optimizado) pero bueno, ya lo dejo como faena para quien lo quiera usar
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 01:18:00.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi