[[José Luis Garcí]]

Seguimos con las funciones

De mi archivo Fun.pas

Código Delphi [-]
//-----------------------------------------------------------------------------
//**********************************************************[ ActQuerry ]******
//  20/11/2010  JLGT  Para modificar la sentencia de un querry
//-----------------------------------------------------------------------------
//  Estudiando como poder hacer mi código mas corto se me ocurrio esta función
//  para usar un los IBQerry, para mi base de datos Firebird.
//  El tema es que cada vez que utilizo un querry y lo modifico tengo que
//  escribir unas 20 lineas y mediante este sistema, logro reducirlo a una sola
//  ya que es un, código repetitivo y soló varia el nombre del query y la
//  sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
// [QRY]              Tibquery a actualizar
// [TxtSql]           Cadena de texto con sentencia SQL
// [MostrarMEnsaje]   Si muestra el mensaje de la Exception
// [RetornarMEnsaje]  Si retorna la cadena Sql que da el Error
// [RetornarQuerry]   Si retorna El querry a la cadena sql de antes del error
//-----------------------------------------------------------------------------
//  Base de datos a usar CLIENTES
//   if ActQuerry(IBQuerry1,'Select * form Clientex')=true then
//                   showmessage('Existe la base de datos')
//   else showmessage('No existe la base de datos');
//-----------------------------------------------------------------------------
Function ActQuery(QRY:TIBQuery; TxtSql:string; MostrarMensaje:boolean=VMiLogico;Retornarmensaje:boolean=VMiLogico; RetornarQuerry:boolean=VMiLogico): Boolean;
var AntSql:string;
begin
    try
      try
        AntSql:=QRY.SQL.Text;
        QRY.Active:=false;
        QRY.SQL.Clear;
        QRY.SQL.Text:=TxtSql;
        QRY.Active:=true;
        Result:=true;
      except
        on E: Exception do
        begin
           if MostrarMensaje=true then
           begin
             ShowMessage('Se ha producido un error: ' + Chr(13) + Chr(13)
                       + 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
                       + 'Mensaje del error: ' + E.Message+ Chr(13) + Chr(13)
                       +'  '+ Chr(13) + Chr(13)
                       +'Se volvera al estado anterior');
           end;
        Result:=false;
        end;
      end;
    finally
      if Result=false then
      begin
         if Retornarmensaje=true then  ShowMessage('Sentencia Sql que ha dado Error' + Chr(13) + Chr(13)+ QRY.SQL.Text);
         if RetornarQuerry=true then
         begin
            QRY.Active:=false;
            QRY.SQL.Clear;
            QRY.SQL.Text:=AntSql;
            QRY.Active:=true;
         end;
      end;
    end;
end;

//-----------------------------------------------------------------------------
//******************************************[ ActIBDataset ]******
//  15/02/2011  JLGT  Para modificar la sentencia de un TIbdataset
//-----------------------------------------------------------------------------
//  Estudiando como poder hacer mi código mas corto se me ocurrió esta función
//  para usar un los Tibdataset basada en mi otra función ActQuerry, para mi base
//  de datos Firebird.
//  El tema es que cada vez que utilizo un Ibdtatset y lo modifico tengo que
//  escribir unas 4 lineas y mediante este sistema, logro reducirlo a una sola
//  ya que es un, código repetitivo y soló varia el nombre del Ibdtaset y la
//  sentencia Sql, cree esta función
//-----------------------------------------------------------------------------
//  Base de datos a usar CLIENTES //El error podría ser otro pero es un ejemplo
//   if ActIbdataset(IBDataset,'Select * form Clientex')=true then  showmessage('Existe la base de datos')
//                                                                              else showmessage('No existe la base de datos');
//-----------------------------------------------------------------------------
function ActIbdataset(ibdata: TIBDataSet; SQL:string):Boolean;
var VPorsiacaso:string;
begin
  VPorsiacaso:=ibdata.SelectSQL.Text;  //Por si falla
  try
    try
      ibdata.Active:=False;
      ibdata.SelectSQL.Clear;
      ibdata.SelectSQL.Add(SQL);
      ibdata.Active:=True;
      Result:=true
    except
      on E: Exception do
      begin
           ShowMessage('Se ha producido un error: ' + Chr(13) + Chr(13)
                     + 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
                     + 'Mensaje del error: ' + E.Message+ Chr(13) + Chr(13)
                     +'  '+ Chr(13) + Chr(13)
                     +'Se volvera al estado anterior');
        Result:=false;
      end;
    end;
  finally
     if Result=false then
     begin
        ibdata.Active:=false;
        ibdata.SelectSQL.Clear;
        ibdata.SelectSQL.Add(VPorsiacaso);
        ibdata.Active:=true;
     end;
  end;
end;

//-----------------------------------------------------------------------------
//********************************************[ QuerryOC ]******
//  07/10/2011  JLGT  Para comprobar y cerrar o abrir un querry
//-----------------------------------------------------------------------------
//  Para evitar tener que repetir el mismo código una y otra vez, abreviando lo
//  considerablemente
//-----------------------------------------------------------------------------
// [QRY]              Tibquery a actualizar
// [OpenClose]        Valor Bolean True, comprueba si no esta activo y lo activa
//                                 False, hace todo lo Contrario, por defecto False
//-----------------------------------------------------------------------------
//  Querry a usar CLIENTES
//  QuerryOC(Clientes);  //Es igual que if Cliente.active=true then Clientes.active=false;
//  y QuerryOC(Clientes,True); // igual que Cliente.active=False then Clientes.active=True;
//-----------------------------------------------------------------------------
Function QuerryOC(QRY:TIBQuery; OpenClose:boolean=False): Boolean;
begin
  if OpenClose=true then
  begin
    if QRY.Active=false then QRY.Active:=true;
    Result:=True;
  end else
  begin
    if QRY.Active=true then  QRY.Active:=False;
    Result:=False;
  end;
end;


//------------------------------------------------------------------------------
//*********************************************[ SoloInteger ]****
// 14/07/2012 JLGT nos devuelve un número entero, aunque la cadena tenga letras
// en caso de no tener ninguno devuelve 0
// Nace con la idea de usarlo para las numeraciones de Documentos, así aunque tenga
// letras, nos da un numero al que podemos incrementar o usar en el método deseado
//------------------------------------------------------------------------------
// [Cadena]     String     Cadena a pasar
//------------------------------------------------------------------------------
//---Ejemplo--------------------------------------------------------------------
//  SoloInteger('A1fa120 eco89');  //=112089
//------------------------------------------------------------------------------
function SoloInteger(cadena:string):Integer;
var VarSCadena,VarSCaracter:String;
    VarIContadorFor:Integer;
begin
    VarSCadena:='';
    for VarIContadorFor := 1 to Length(cadena) do
    begin
      VarSCaracter:=Copy(cadena,VarIContadorFor,1);
      if VarSCaracter='0' then VarSCadena:=VarSCadena+'0';
      if VarSCaracter='1' then VarSCadena:=VarSCadena+'1';
      if VarSCaracter='2' then VarSCadena:=VarSCadena+'2';
      if VarSCaracter='3' then VarSCadena:=VarSCadena+'3';
      if VarSCaracter='4' then VarSCadena:=VarSCadena+'4';
      if VarSCaracter='5' then VarSCadena:=VarSCadena+'5';
      if VarSCaracter='6' then VarSCadena:=VarSCadena+'6';
      if VarSCaracter='7' then VarSCadena:=VarSCadena+'7';
      if VarSCaracter='8' then VarSCadena:=VarSCadena+'8';
      if VarSCaracter='9' then VarSCadena:=VarSCadena+'9';
    end;
    if VarSCadena='' then VarSCadena:='0';
    Result:=StrToInt(VarSCadena);
end;

Si veis que se me ha pasado poner alguna función por favor decidme lo.