Ver Mensaje Individual
  #5  
Antiguo 16-08-2010
Kandorf Kandorf is offline
Miembro
 
Registrado: may 2007
Posts: 38
Reputación: 0
Kandorf Va por buen camino
Hola, la duda me surgió porque quise poder pasar fechas escritas a mano a TDate, tales como "1/4/2010", "1-4-99" o "2 de junio de 2009", para ello he utilizado estas librerías y he creado la siguiente función, se podrá mejorar seguro, pero a mí por ahora me satisface.

Código Delphi [-]
// Pasa una fecha escrita a mano a TDate
function FechaAMano(Fecha: String): TDate;
var
  Expresión: TRegExpr;
  Pos: Integer;
  NuevaFecha: String;
begin
  Expresión:=TRegExpr.Create;

  Expresión.Expression:='\d\d*.*(ENERO|FEBRERO|MARZO|ABRIL|MAYO|JUNIO|JULIO|AGOSTO|SEP?TIEMBRE|OBTUBRE  |NOVIEMBRE|DICIEMBRE).*\d{2}';
  Fecha:=UpperCase(Fecha);
  Fecha:=ReplaceStr(Fecha,'SETIEMBRE','SEPTIEMBRE');
  if Expresión.Exec(Fecha) then begin
    Expresión.Expression:='\d\d*';
    Expresión.Exec(Fecha);
    NuevaFecha:=Copy(Fecha,Expresión.MatchPos[0],Expresión.MatchLen[0])+'/';

    Expresión.Expression:='(ENERO|FEBRERO|MARZO|ABRIL|MAYO|JUNIO|JULIO|AGOSTO|SEP?TIEMBRE|OBTUBRE|NOVIEM  BRE|DICIEMBRE)';
    Expresión.Exec(Fecha);
    NuevaFecha := NuevaFecha+IntToStr(StringToCaseSelect(Copy(Fecha,Expresión.MatchPos[0],Expresión.MatchLen[0]),['ENERO','FEBRERO','MARZO','ABRIL','MAYO','JUNIO','JULIO','AGOSTO','SEPTIEMBRE','OBTUBRE','NOVIEMBRE'  ,'DICIEMBRE'])+1)+'/';

    Fecha:=Copy(Fecha,Expresión.MatchPos[0]+Expresión.MatchLen[0],Length(Fecha));
    Expresión.Expression:='\d\d*'; // Si aquí pongo sólo '\d*' no funciona, así que lo pongo así...
    Expresión.Exec(Fecha);
    NuevaFecha:=NuevaFecha+Copy(Fecha,Expresión.MatchPos[0],Expresión.MatchLen[0]);

    Result:=StrToDate(NuevaFecha);
  end else begin
    Expresión.Expression:='(\d{1}|\d{2})(-|/)(\d{1}|\d{2})(-|/)\d{2}';
    if Expresión.Exec(Fecha) then begin
      Fecha:=ReplaceStr(Fecha,'-','/');

      Result:=StrToDate(Fecha);
    end else
      Result:=0;
  end;

  Expresión.Free;
end;

// Dejo también el código de StringToCaseSelect, ya que la utiliza
// Permite usar Strings con una sentencia CASE
function StringToCaseSelect(Selector: String; Opciones: array of String): Integer;
var
    i: Integer;
begin
    Result:=-1;
    for i:=0 to Length(Opciones)-1 do
    begin
        if CompareText(Selector,Opciones[i]) = 0 then
        begin
            Result:=i;
            break;
        end;
    end;
end;
Saludos, espero que resulte últil a alguien.
Responder Con Cita