Ir al contenido


Foto

Rutinas pequeñas que pueden ayudar


  • Por favor identifícate para responder
27 respuestas en este tema

#1 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 15 enero 2009 - 12:33

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
  • 0

#2 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 15 enero 2009 - 12:38

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



delphi
  1. const
  2.   meses : Array [1..12] Of String =
  3.                           ('Enero','Febrero','Marzo','Abril','Mayo','Junio',
  4.                             'Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre');
  5.  
  6.  
  7. procedure TLector.BitBtn1Click(Sender: TObject);
  8. var
  9.   dia,mes,anio,fecha : string;
  10. begin
  11.   dia := '01';
  12.   mes := '01';
  13.   anio := '2009';
  14.   fecha := dia + '/' + meses[strtoint(mes)] + '/' + anio;
  15.   showmessage(fecha);
  16. end;



Salud OS
  • 0

#3 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 15 enero 2009 - 12:51

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



delphi
  1. fecha := FormatDateTime('dddddd', Date);
  2. 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.
  • 0

#4 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 15 enero 2009 - 12:56

:D :D :D, 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 :D :D :D :p
  • 0

#5 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 15 enero 2009 - 12:59

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
  1. const meses : Array [1..12] Of String =
  2.               ('Enero','Febrero','Marzo','Abril','Mayo','Junio',
  3.                 'Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre');
  4. Var
  5.   Mes: Integer;
  6. begin
  7. Mes := ZCta_Mesesmes.AsInteger; //Campo de un Query
  8.  
  9. ShowMessage(Meses[Mes]);
  10.  
  11. end;



Saludos.

  • 0

#6 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 15 enero 2009 - 01:02

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



delphi
  1. 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.


  • 0

#7 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 15 enero 2009 - 01:06

ejem. para todos los gusto da la vcl


delphi
  1. begin
  2.  
  3. ShowMessage(FormatDateTime('mmm', encodedate(2009,ZCta_Mesesmes.AsInteger, 01)));
  4. ShowMessage(FormatDateTime('mmmm', encodedate(2009,ZCta_Mesesmes.AsInteger, 01)));
  5.  
  6. end;


  • 0

#8 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 15 enero 2009 - 01:08

:o  :-#
  • 0

#9 seoane

seoane

    Advanced Member

  • Administrador
  • 1.259 mensajes
  • LocationEspaña

Escrito 15 enero 2009 - 01:20

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

#10 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 15 enero 2009 - 01:20

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
  • 0

#11 Guest_Jose Fco_*

Guest_Jose Fco_*
  • Visitante

Escrito 15 enero 2009 - 03:32

:D :D :D, 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 :D :D :D :p


eso lo escuche antes. :D :D :D

Un Saludo.

PD:Interesante codigo. ;)

#12 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 15 enero 2009 - 04:00

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 :( :p

Salud OS
  • 0

#13 eduarcol

eduarcol

    Advanced Member

  • Administrador
  • 4.483 mensajes
  • LocationVenezuela

Escrito 15 enero 2009 - 04:02

pero no fui yo, yo no cree la dateutils  (h)
  • 0

#14 seoane

seoane

    Advanced Member

  • Administrador
  • 1.259 mensajes
  • LocationEspaña

Escrito 18 enero 2009 - 02:14

Pues ahí van unas cuantas:

Fecha de modificación de un archivo:


delphi
  1. function GetFileModifyDate(FileName: string): TDateTime;
  2. var
  3.   SearchRec: TSearchRec;
  4. begin
  5.   Result:= 0;
  6.   if FindFirst(Filename,faAnyFile,SearchRec) = 0 then
  7.   begin
  8.     Result:= FileDateToDateTime(SearchRec.Time);
  9.   end;
  10.   FindClose(SearchRec);
  11. end;



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


delphi
  1. function GuardarCopia(Archivo: String): Boolean;
  2. var
  3.   Ruta, Nombre: String;
  4. begin
  5.   Result:= FALSE;
  6.   Ruta:= 'c:\Historico\';
  7.   if ForceDirectories(Ruta) then
  8.   begin
  9.     Nombre:= FormatDateTime('yyyymmddhhmmss',Now) + '_'
  10.       + ExtractFileName(Archivo);
  11.     while FileExists(Ruta + Nombre) do
  12.     begin
  13.       Sleep(100);
  14.       Nombre:= FormatDateTime('yyyymmddhhmmss',Now) + '_'
  15.         + ExtractFileName(Archivo);
  16.     end;
  17.     if CopyFile(PChar(Archivo), PChar(Ruta + Nombre),TRUE) then
  18.       Result:= TRUE;
  19.   end;
  20. end;



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


delphi
  1. procedure MostrarMensaje(Titulo,Mensaje: String);
  2. begin
  3.   if Mensaje <> EmptyStr then
  4.     MessageBox(0,PChar(Mensaje),PChar(Titulo),
  5.       MB_OK or MB_SETFOREGROUND or MB_TASKMODAL);
  6. end;



Algunos directorios:


delphi
  1. function TempDir: String;
  2. var
  3.   Buffer: Array[0..MAX_PATH] of Char;
  4. begin
  5.   FillChar(Buffer,Sizeof(Buffer),#0);
  6.   if GetTempPath(Sizeof(Buffer)-1,@Buffer) <> 0 then
  7.     Result:= IncludeTrailingPathDelimiter(String(PChar(@Buffer)))
  8.   else
  9.     Result:= EmptyStr;
  10. end;
  11.  
  12. function WindowsDir: String;
  13. var
  14.   Buffer: Array[0..MAX_PATH] of Char;
  15. begin
  16.   FillChar(Buffer,Sizeof(Buffer),#0);
  17.   if GetWindowsDirectory(@Buffer,Sizeof(Buffer)-1) <> 0 then
  18.     Result:= IncludeTrailingPathDelimiter(String(PChar(@Buffer)))
  19.   else
  20.     Result:= EmptyStr;
  21. end;



Nombre corto de un fichero:


delphi
  1. function ShortPath(Path: String): String;
  2. var
  3.   Buffer: Array[0..MAX_PATH] of Char;
  4. begin
  5.   FillChar(Buffer,Sizeof(Buffer),#0);
  6.   if GetShortPathName(PChar(Path),@Buffer,Sizeof(Buffer)-1) <> 0 then
  7.     Result:= String(PChar(@Buffer))
  8.   else
  9.     Result:= EmptyStr;
  10. end;




Tamaño de un fichero:


delphi
  1. function TamanhoFichero(FileName: String): Integer;
  2. var
  3.   SearchRec: TSearchRec;
  4. begin
  5.   Result:= 0;
  6.   if FindFirst(Filename,faAnyFile,SearchRec) = 0 then
  7.     Result:= SearchRec.Size;
  8.   FindClose(SearchRec);
  9. end;


  • 0

#15 enecumene

enecumene

    Webmaster

  • Administrador
  • 7.419 mensajes
  • LocationRepública Dominicana

Escrito 18 enero 2009 - 02:17

:o ¡Vaya!, son interesantes los códigos (y).
  • 0

#16 Ayla

Ayla

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 98 mensajes

Escrito 03 febrero 2009 - 05:35


Algunas que uso a menudo.

-Comprueba si una string está vacia o nula.



delphi
  1. function fVacio(nom: string) : boolean;
  2. begin
  3.     nom := Trim(nom);
  4.     if (nom = '') or (nom = null) then
  5.         Result:= True
  6.     else
  7.         Result:= False;
  8. end;



-Devuelve el path del directorio de windows.



delphi
  1. function GetWindowsDirectory : String;
  2. var
  3.   pcWindowsDirectory : PChar;
  4.   dwWDSize          : DWORD;
  5. begin
  6.   dwWDSize := MAX_PATH + 1;
  7.   GetMem( pcWindowsDirectory, dwWDSize );
  8.   try
  9.     if Windows.GetWindowsDirectory( pcWindowsDirectory, dwWDSize ) <> 0 then
  10.         Result := pcWindowsDirectory;
  11.     finally
  12.         FreeMem( pcWindowsDirectory );
  13.   end;
  14. 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
  1. function fSepDecimal(tecla: char) : char;
  2. begin
  3.   if DECIMALSEPARATOR = ',' then begin
  4.     if tecla = '.' then Result:= ','
  5.     else Result := tecla;
  6.   end
  7.   else begin
  8.     if tecla = ',' then Result:= '.'
  9.     else Result := tecla;
  10.   end;
  11. end;



  • 0

#17 Ayla

Ayla

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 98 mensajes

Escrito 03 febrero 2009 - 06:17

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
  1. function fPad(txt : String; l : smallint; j: string; r : string) : String;
  2. var
  3.   l1, l2, len : smallint;
  4.   jus,t : string;
  5.   rel : char;
  6.   longi : integer;
  7. begin
  8.   len := l;
  9.   rel := r[1];
  10.   jus := j;
  11.   l1  := 0;  l2 := 0;
  12.  
  13.   SetLength(t,len);
  14.   FillChar(t[1],len,' ');
  15.   if txt = null then
  16.     txt := '';
  17.   if (len = null) or (len < 0) then
  18.     len := 0;
  19.   if jus = 'U' then
  20.     txt := UpperCase(txt);
  21.  
  22.   if jus = 'L' then
  23.     txt := LowerCase(txt);
  24.   longi := Length(txt);
  25.  
  26.   if (len > 0) and (len <> longi) then begin
  27.       if rel = null then rel := ' ';
  28.       if jus = 'C' then begin
  29.         //* justificación Centrada. *//
  30.         l1 := len div 2;
  31.         l2 := longi div 2;
  32.         if longi > len then
  33.           txt := copy(txt,l2,len)
  34.         else begin
  35.           SetLength(txt,len);
  36.           FillChar(t[1],(l1-l2),rel);
  37.           txt := Trim(t) + txt;
  38.           longi := Length(Trim(txt));
  39.           FillChar(txt[longi+1],l2,rel);
  40.         end;
  41.       end;
  42.       if jus = 'D' then begin
  43.         //* justifico a la derecha - Ajusta a la derecha y rellena por la izquierda.*//
  44.         //* Para utilizar AddChar tienes que tener instaladas las RX. Unit rxStrUtils.* //
  45.         txt :=  AddChar(rel,txt,len);
  46.       {*  Sino se utiza las librerías RX, esto debería funcionar
  47.       if longi > len then
  48.           txt:= copy(txt,(len-longi),len)
  49.         else begin
  50.           SetLength(txt,len);
  51.           FillChar(t[1],(len-longi),rel) ;
  52.           txt := Trim(t) + txt;
  53.         end;}
  54.       end;
  55.       if jus = 'I' then begin
  56.         //* justifico a la izquierda - Ajusta a la izquierda y rellena por la derecha. *//
  57.         //* Para utilizar AddChar tienes que tener instaladas las RX. Unit rxStrUtils. *//
  58.         txt:= AddCharR(rel,txt,len);
  59.         {Sino se utiza las librerías RX,
  60.         if longi > len then
  61.           txt:= copy(txt,1,len)
  62.         else begin
  63.           SetLength(txt,len);
  64.           FillChar(txt[longi + 1],(len-longi),rel);
  65.         end;}
  66.       end;
  67.   end;
  68.   FPad := txt;
  69. end;


  • 0

#18 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.446 mensajes
  • LocationMéxico

Escrito 03 febrero 2009 - 04:51

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
  1.   Consecutivo := 56;
  2.   Cadena := Format('%.*d',[6,Consecutivo+1])



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

Salud OS
  • 0

#19 cadetill

cadetill

    Advanced Member

  • Moderadores
  • PipPipPip
  • 994 mensajes
  • LocationEspaña

Escrito 06 febrero 2009 - 06:57

Hola Ayla, qué tal? :p

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

  • 0

#20 Ayla

Ayla

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 98 mensajes

Escrito 09 febrero 2009 - 03:20


Hola Xavi,

Mira va ser que por esta vez tienes razón  :p :D

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  ;)




  • 0




IP.Board spam blocked by CleanTalk.