27 replies to this topic

[egostar]

Hola, este hilo lo he pensado para publicar pequeñas rutinas que a veces pasan desapercibidas pero que pueden llegar a ser un tanto útiles, los invito a colocar las que ustedes tengan por ahi en el abandono

Salud OS

[egostar]

"Traducir" un mes numérico a su nombre equivalente.

delphi

const
  meses : Array [1..12] Of String =
                           ('Enero','Febrero','Marzo','Abril','Mayo','Junio',
                            'Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre');
 
 
procedure TLector.BitBtn1Click(Sender: TObject);
var
  dia,mes,anio,fecha : string;
begin
  dia := '01';
  mes := '01';
  anio := '2009';
  fecha := dia + '/' + meses[strtoint(mes)] + '/' + anio; 
  showmessage(fecha);
end;

Salud OS

[eduarcol]

si quieres qe esa rutina te incluya el dia de la semana, por ejemplo: Jueves, 15 de enero de 2009

delphi

fecha := FormatDateTime('dddddd', Date);
 showmessage(fecha);

esa función la descubri por error, yo acostumbraba hacerlo según tu metodo, pero un dia tratando de hacer el formato ddmmyy por error lo rellene todo de d y me salio la fecha.

Los nombres salen segun la configuracion regional de la maquina en que se ejecute.

[egostar]

, pues claro, creo que mi rutina la has enviado al hilo de codigo inútil jajajaja

Salud OS

PD, era para ver si estaban atentos

[enecumene]

La rutina de Egostar me acaba de servir a un problema que tenía, y era convertir un número entre 1..12 en el mes del año en Letra, así:

delphi

const meses : Array [1..12] Of String =
               ('Enero','Febrero','Marzo','Abril','Mayo','Junio',
                'Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre');
Var
  Mes: Integer;
begin
Mes := ZCta_Mesesmes.AsInteger; //Campo de un Query
 
ShowMessage(Meses[Mes]);
 
end;

Saludos.

[eduarcol]

ni tan inutil, porque cuando no quiero que salga el dia de la semana me toca hacerla asi, pero en menos lineas:

delphi

Fecha := FormatFloat('00', Dayof(Date)) + ' de ' + meses[Monthof(Date)] + ' de ' + FormatFloat('0000', Yearof(Date));

otras opciones del format date time:

Specifier Displays
c Displays the date using the format given by the ShortDateFormat global variable, followed by the time using the format given by the LongTimeFormat global variable. The time is not displayed if the date-time value indicates midnight precisely.
d Displays the day as a number without a leading zero (1-31).
dd Displays the day as a number with a leading zero (01-31).
ddd Displays the day as an abbreviation (Sun-Sat) using the strings given by the ShortDayNames global variable.
dddd Displays the day as a full name (Sunday-Saturday) using the strings given by the LongDayNames global variable.
ddddd Displays the date using the format given by the ShortDateFormat global variable.
dddddd Displays the date using the format given by the LongDateFormat global variable.
e (Windows only) Displays the year in the current period/era as a number without a leading zero (Japanese, Korean and Taiwanese locales only).
ee (Windows only) Displays the year in the current period/era as a number with a leading zero (Japanese, Korean and Taiwanese locales only).
g (Windows only) Displays the period/era as an abbreviation (Japanese and Taiwanese locales only).
gg (Windows only) Displays the period/era as a full name. (Japanese and Taiwanese locales only).
m Displays the month as a number without a leading zero (1-12). If the m specifier immediately follows an h or hh specifier, the minute rather than the month is displayed.
mm Displays the month as a number with a leading zero (01-12). If the mm specifier immediately follows an h or hh specifier, the minute rather than the month is displayed.
mmm Displays the month as an abbreviation (Jan-Dec) using the strings given by the ShortMonthNames global variable.
mmmm Displays the month as a full name (January-December) using the strings given by the LongMonthNames global variable.
yy Displays the year as a two-digit number (00-99).
yyyy Displays the year as a four-digit number (0000-9999).
h Displays the hour without a leading zero (0-23).
hh Displays the hour with a leading zero (00-23).
n Displays the minute without a leading zero (0-59).
nn Displays the minute with a leading zero (00-59).
s Displays the second without a leading zero (0-59).
ss Displays the second with a leading zero (00-59).
z Displays the millisecond without a leading zero (0-999).
zzz Displays the millisecond with a leading zero (000-999).
t Displays the time using the format given by the ShortTimeFormat global variable.
tt Displays the time using the format given by the LongTimeFormat global variable.
am/pm Uses the 12-hour clock for the preceding h or hh specifier, and displays 'am' for any hour before noon, and 'pm' for any hour after noon. The am/pm specifier can use lower, upper, or mixed case, and the result is displayed accordingly.
a/p Uses the 12-hour clock for the preceding h or hh specifier, and displays 'a' for any hour before noon, and 'p' for any hour after noon. The a/p specifier can use lower, upper, or mixed case, and the result is displayed accordingly.
ampm Uses the 12-hour clock for the preceding h or hh specifier, and displays the contents of the TimeAMString global variable for any hour before noon, and the contents of the TimePMString global variable for any hour after noon.
/ Displays the date separator character given by the DateSeparator global variable.
: Displays the time separator character given by the TimeSeparator global variable.
'xx'/"xx" Characters enclosed in single or double quotes are displayed as-is, and do not affect formatting.

[eduarcol]

ejem. para todos los gusto da la vcl

delphi

begin
 
ShowMessage(FormatDateTime('mmm', encodedate(2009,ZCta_Mesesmes.AsInteger, 01)));
ShowMessage(FormatDateTime('mmmm', encodedate(2009,ZCta_Mesesmes.AsInteger, 01)));
 
end;

[enecumene]

  :-#

[seoane]

Ya veo que queréis hacerle la competencia a mi código inútil 

[eduarcol]

Ya veo que queréis hacerle la competencia a mi código inútil 

no hombre como crees, no te llegamos ni de cerquita... jejeje

[egostar]

Ya veo que queréis hacerle la competencia a mi código inútil 

No amigo seoane, el código inutil es algo mas sofisticado, estas son solo rutinas, funciones, etc.... que de alguna forma se nos van de la mente.

Aunque eduarcol de inmediato mando mi portento de rutina a ser inutil

Salud OS

[eduarcol]

pero no fui yo, yo no cree la dateutils 

[seoane]

Pues ahí van unas cuantas:

Fecha de modificación de un archivo:

delphi

function GetFileModifyDate(FileName: string): TDateTime;
var
  SearchRec: TSearchRec;
begin
  Result:= 0;
  if FindFirst(Filename,faAnyFile,SearchRec) = 0 then
  begin
    Result:= FileDateToDateTime(SearchRec.Time);
  end;
  FindClose(SearchRec);
end;

Guardar un copia de un archivo (se puede usar para llevar un histórico):

delphi

function GuardarCopia(Archivo: String): Boolean;
var
  Ruta, Nombre: String;
begin
  Result:= FALSE;
  Ruta:= 'c:\Historico\';
  if ForceDirectories(Ruta) then
  begin
    Nombre:= FormatDateTime('yyyymmddhhmmss',Now) + '_'
      + ExtractFileName(Archivo);
    while FileExists(Ruta + Nombre) do
    begin
      Sleep(100);
      Nombre:= FormatDateTime('yyyymmddhhmmss',Now) + '_'
        + ExtractFileName(Archivo);
    end;
    if CopyFile(PChar(Archivo), PChar(Ruta + Nombre),TRUE) then
      Result:= TRUE;
  end;
end;

Muestra un mensaje, pero sin estar en ingles como ShowMessage:

delphi

procedure MostrarMensaje(Titulo,Mensaje: String);
begin
  if Mensaje <> EmptyStr then
    MessageBox(0,PChar(Mensaje),PChar(Titulo),
      MB_OK or MB_SETFOREGROUND or MB_TASKMODAL);
end;

Algunos directorios:

delphi

function TempDir: String;
var
  Buffer: Array[0..MAX_PATH] of Char;
begin
  FillChar(Buffer,Sizeof(Buffer),#0);
  if GetTempPath(Sizeof(Buffer)-1,@Buffer) <> 0 then
    Result:= IncludeTrailingPathDelimiter(String(PChar(@Buffer)))
  else
    Result:= EmptyStr;
end;
 
function WindowsDir: String;
var
  Buffer: Array[0..MAX_PATH] of Char;
begin
  FillChar(Buffer,Sizeof(Buffer),#0);
  if GetWindowsDirectory(@Buffer,Sizeof(Buffer)-1) <> 0 then
    Result:= IncludeTrailingPathDelimiter(String(PChar(@Buffer)))
  else
    Result:= EmptyStr;
end;

Nombre corto de un fichero:

delphi

function ShortPath(Path: String): String;
var
  Buffer: Array[0..MAX_PATH] of Char;
begin
  FillChar(Buffer,Sizeof(Buffer),#0);
  if GetShortPathName(PChar(Path),@Buffer,Sizeof(Buffer)-1) <> 0 then
    Result:= String(PChar(@Buffer))
  else
    Result:= EmptyStr;
end;

Tamaño de un fichero:

delphi

function TamanhoFichero(FileName: String): Integer;
var
  SearchRec: TSearchRec;
begin
  Result:= 0;
  if FindFirst(Filename,faAnyFile,SearchRec) = 0 then
    Result:= SearchRec.Size;
  FindClose(SearchRec);
end;

[enecumene]

¡Vaya!, son interesantes los códigos .

[Ayla]

Algunas que uso a menudo.

-Comprueba si una string está vacia o nula.

delphi

function fVacio(nom: string) : boolean;
begin
    nom := Trim(nom);
    if (nom = '') or (nom = null) then
        Result:= True
    else
        Result:= False;
end;

-Devuelve el path del directorio de windows.

delphi

function GetWindowsDirectory : String;
var
  pcWindowsDirectory : PChar;
  dwWDSize           : DWORD;
begin
  dwWDSize := MAX_PATH + 1;
  GetMem( pcWindowsDirectory, dwWDSize );
  try
    if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then
        Result := pcWindowsDirectory;
    finally
        FreeMem( pcWindowsDirectory );
  end;
end;

-Según en que máquina trabajes tiene un separador decimal (. o ,) . Está función detecta el separador decimal y si procede te lo cambia.

delphi

function fSepDecimal(tecla: char) : char;
begin
  if DECIMALSEPARATOR = ',' then begin
     if tecla = '.' then Result:= ','
     else Result := tecla;
  end
  else begin
     if tecla = ',' then Result:= '.'
     else Result := tecla;
  end;
end;

[Ayla]

Esta función la utilizo normalmente cuando tengo que generar ficheros de texto. Donde cada campo tiene que tener cierta longitud y puede que algún carácter de relleno. La hice hace un montón de tiempo, se puede mejorar  :$  pero me funciona de perlas y no tengo tiempo de cambiarla.

Rellena una string con un carácter de relleno y justificación izquierda, derecha, o centrada y con posibilidad de pasarlo a mayúsculas o a minúsculas.
txt - string a rellenar y dar formato
ljr - string de parámetros separados por comas "len,jus,rel"  donde :
      len : longitud de salida, <= 0 longitud de txt.
      jus : justificación y formato 'CDRUL'
              jus -> U para Upcase, L para Lowcase,
                      C para ajuste centrado,
                      R/D para ajuste a la derecha,
                      resto de valores ajuste a la izquierda.
      rel : carácter de relleno
             

delphi

function fPad(txt : String; l : smallint; j: string; r : string) : String;
var
  l1, l2, len : smallint;
  jus,t : string;
  rel : char;
  longi : integer;
begin
   len := l;
   rel := r[1];
   jus := j;
   l1  := 0;  l2 := 0;
 
   SetLength(t,len);
   FillChar(t[1],len,' ');
   if txt = null then 
     txt := '';
   if (len = null) or (len < 0) then 
     len := 0;
   if jus = 'U' then 
     txt := UpperCase(txt);
 
   if jus = 'L' then 
    txt := LowerCase(txt);
   longi := Length(txt);
   
   if (len > 0) and (len <> longi) then begin
      if rel = null then rel := ' ';
      if jus = 'C' then begin
        //* justificación Centrada. *//
        l1 := len div 2;
        l2 := longi div 2;
        if longi > len then
          txt := copy(txt,l2,len)
        else begin
          SetLength(txt,len);
          FillChar(t[1],(l1-l2),rel);
          txt := Trim(t) + txt;
          longi := Length(Trim(txt));
          FillChar(txt[longi+1],l2,rel);
        end;
      end;
      if jus = 'D' then begin
        //* justifico a la derecha - Ajusta a la derecha y rellena por la izquierda.*//
        //* Para utilizar AddChar tienes que tener instaladas las RX. Unit rxStrUtils.* //
        txt :=  AddChar(rel,txt,len);
      {*  Sino se utiza las librerías RX, esto debería funcionar 
       if longi > len then
          txt:= copy(txt,(len-longi),len)
        else begin
          SetLength(txt,len);
          FillChar(t[1],(len-longi),rel) ;
          txt := Trim(t) + txt;
        end;}
      end;
      if jus = 'I' then begin
        //* justifico a la izquierda - Ajusta a la izquierda y rellena por la derecha. *//
        //* Para utilizar AddChar tienes que tener instaladas las RX. Unit rxStrUtils. *//
        txt:= AddCharR(rel,txt,len);
        {Sino se utiza las librerías RX,
        if longi > len then
          txt:= copy(txt,1,len)
        else begin
          SetLength(txt,len);
          FillChar(txt[longi + 1],(len-longi),rel);
        end;}
      end;
   end;
   FPad := txt;
end;

[egostar]

Hace algunos años, tenia el problema de llenar con ceros una cadena que contenía un campo numérico, por ejemplo para mostrar un consecutivo de facturas o de recibos, afortunadamente existe la función format() la cual se encarga de hacer esto por nosotros.

Supongamos que debo imprimir el consecutivo de una factura en un campo de 6 dígitos pero con ceros a la izquierda. Pues es tan simple como esto:

delphi

  Consecutivo := 56;
  Cadena := Format('%.*d',[6,Consecutivo+1])

El resultado es '000057', espero que les sea de utilidad.

Salud OS

[cadetill]

Hola Ayla, qué tal?

Sólo una cosa referente a tu función fVacio. Veo que lo que recibe es una variable de tipo string, la cual, por definición, no puede ser nunca null (la única variable en Delphi que puede ser null es Variant). Por tanto, la comparación con null no tiene sentido ya que nunca lo será

Nos leemos

Vsss

[Ayla]

Hola Xavi,

Mira va ser que por esta vez tienes razón 

Al principio digo, no puede ser, si me funciona siempre incluso con nulos. Pero he revisado mi código y es cierto, nunca le paso nulos. Porque llamo a una función que me lee los datos de la tabla y siempre devuelvo el dato como una string, osea que si es nulo me devuelve '', con lo cual nunca es nulo.

Gracias por la puntualización