CALCULAR LA LETRA DEL D.N.I.

Extraido de las FAQ sobre Delphi 4, realizadas por José Ramón García.

function LetraNIF(DNI: String): Char;
begin
  Result := Copy('TRWAGMYFPDXBNJZSQVHLCKET', StrToInt(DNI) mod 23 + 1, 1)[1];
end;

REALIZAR UN PACK EN TABLAS PARADOX

Realizado por Julian Torres Sanchez,  julian@ctv.es ( www.ctv.es/USERS/julian )

Para hacer un Pack en tablas Paradox, se realiza a través de una llamada "DbiDoRestructure",

la interfaz de la función es:

function DbiDoRestructure(
  hDb			: hDBIDb;	{Database handle}
  iTblDescCount		: Word;	{Nº de desc. de tabla}
  pTblDesc         	: pCRTblDesc;{Array de desc.}
  pszSaveAs		: PChar;	        {Reestructurar a ...}
  pszKeyViolName	: PChar;		{Tabla de violac. de clave}
  pszProblemsName	: PChar;		{Nombre tabla problemas}
  bAnalyzeOnly		: Bool		{Analizar reestructura}
			): DBIResult;

NOTA: Para hacer un pack se requiere tener acceso exclusivo a la tabla.

Como se puede ver la función, además de realizar un pack, también sirve para reestructurar una tabla.

 Si lo que se persigue únicamente es realizar el Pack la llamada quedaría más o menos:

var
   TablaDescrip : pCRTblDesc;

[...]
New(TablaDescrip);
{rellenamos el array a 0 para no modificar los otros campos de la estructura CRTblDesc}
FillChar(TablaDescrip^, SizeOf(TablaDescrip^), 0);
with TablaDescrip^ do begin
   bPack := true;
   {realizamos el pack en una tabla con el mismo nombre}
   StrPCopy(szTblName, TableName);
   StrPCopy(szTblType, szParadox);
end;

Close; {de la tabla}

{TempDBHandle es el descriptor de la tabla que manejamos, por ejemplo,
TempDBHandle := DBHandle; cuando la tabla está abierta}

TempResult := DbiDoRestructure(TempDBHandle, 1,TablaDescrip, nil, nil, nil, false);
Dispose(TablaDescrip);

if TempResult <> DBIERR_NONE then
 {ha ocurrido algún error al intentar hacer el pack}

[...]

AHORRAR MEMORIA

Para ahorrar memoria, se puede descargar OLE si no se va a utilizar.

FreeLibrary(GetModuleHandle('OleAut32'));

Truco extraido de las paginas de ( www.clubdelphi.com ).

Cuando nuestra aplicación va creciendo, y vamos añadiendo Forms y más Forms, nos damos cuenta, si consultamos el código fuente del project (.DPR), que es allí donde se crea cada una de ellas.
Cada una de las lineas como: Application.CreateForm(TMiForm, MiForm), lo que hace es crear esa Form.
Esto que quiere decir ?, Pues que aunque no la estemos utilizando, la Form ocupa memoria. El motivo por el que no las vemos todavía, es que tienen la propiedad de Visible a falso.
Es interesante, (y digno), utilizar solamente aquella memoria que realmente nos haga falta en cada momento. Para conseguir esto, deberemos realizar un par de sencillos cambios en el código.

1.- En el Project (.DPR)

a.- Eliminar en la clausula 'Uses'. la unit a la cual pertenezca la Form.
b.- Eliminar la linea donde dice: Application.CreateForm(TMiForm, MiForm);

Otra opción, con el mismo cometido, y tal vez más elegante, nos propone José Andrés Lacarcel Benlloch, y es utilizando el Project Manager, entrando en Options, y pasando la Form de la lista de Auto-Create Forms, a la lista de Available Forms. Con esto, eliminaremos la llamada a CreateForm en el project (.DPR) sin tener que tocar el código a mano.

2.- En el código fuente de nuestra aplicación (.PAS)

Cuando necesitemos utilizar la Form, (donde habitualmente se pone: MiForm.ShowModal;), debemos no solo hacerla visible, si no, crearla (porque ahora no la tenemos creada). Es tan sencillo como sigue:

  Application.CreateForm(TMiForm, MiForm);	{ Creamos la Form }
  MiForm.ShowModal;			{ La hacemos visible }
  MiForm.Free;				{ Liberamos la memoria }

Una variante a esta, enviada por José Andrés L. B., es la siguiente:

  MiForm := TMiForm.Create(Application);	{ Creamos la Form }
  Try
    MiForm.ShowModal;			{ La hacemos visible }
  Finally
    MiForm.Free;				{ Liberamos la memoria, pase lo que pase }
  End;

Ambos ejemplos, son equivalentes, y la diferencia entre CreateForm y Create, es la siguiente:

CreateForm
Pertenece a TApplication. Su declaración es la siguiente:

procedure CreateForm(FormClass: TFormClass; var Reference);

Lo que hace, es llamar al procedimiento de Application, para que cree una Form. Por tanto, el Owner de la Form, es Application. Nos deja en Reference, la Form creada, ya que esta es pasada por referencia.

Create
Pertenece a TForm. Su declaración es la siguiente:

constructor Create(AOwner: TComponent);

Lo que hace, es llamar al constructor de la Form, y le pasamos nosotros el Owner, que es también Application.

Cabe destacar la observación hecha por José Andrés L.B., de utilizar el bloque try-finally-end, ya que en caso de producirse una excepción al crear la Form, sin el, no se liberaría la memoria asignada.

Observaciones:

Free, es un metodo que libera la memoria de un objeto. ( En este caso de una Form ). En el caso de que utilicemos asignación dinámica de memoria, (new(), etc...), deberemos liberarla a mano (dispose(), etc ...), antes de liberar la Form.
Free, libera la Form, y sus componentes, pero no los objetos que creamos nosotros manualmente. Los objetos que creamos nosotros manualmente, los debemos eliminar nosotros también manualmente.

NOTA IMPORTANTE

Hay que tener mucho cuidado, de no utilizar una Form, que no esté creada. Si lo hacemos, obtendriamos un error del tipo: GENERAL PROTECTION FAULT IN MODULE xxxx.
El ejemplo mostrado, nos funcionara en Forms, que utilicemos de forma modal. Es decir, las que abrimos con ShowModal. En el caso de abrirlas con el procedimiento Show, deberemos crearlas y destruirlas, de una forma mas cuidadosa.
Otra cosa a tener en cuenta, es que nuestra Form principal, SI QUE DEBE ESTAR CREADA EN EL PROJECT, ya que es alli, donde hace la llamada.

Dani Paschkes ( paschkes@bcn.servicom.es ).

SUMAR/RESTAR UN MES CON DIAS NATURALES

Función que resta o suma un mes comercial (30 dias) sobre fecha, devolviendo el resultado
en dias naturales. Si restamos 1 mes al 30 Marzo, devolvera 28 febrero.

Autor: (  uri@maptel.es )

Function RestaMes(fecha: TDateTime): TDateTime;
var
   Dia,mes,ano: Word;
   Dia2,mes2,ano2: Word;
begin
   DecodeDate(fecha,ano,mes,dia);
   Fecha := Fecha - 32; {Restem per canviar de mes segur}

   DecodeDate(fecha,ano2,mes2,dia2);
   While not((dia2 = dia) or (mes2 = mes)) do
   begin
         Fecha := Fecha + 1;
         DecodeDate(fecha,ano2,mes2,dia2);
   End;
   If mes2 = mes then Fecha := Fecha -1;
   Result := Fecha;
end;

Function SumaMes(fecha: TDateTime): TDateTime;
var
   Dia,mes,ano: Word;
   Dia2,mes2,ano2: Word;
begin
   DecodeDate(fecha,ano,mes,dia);
   Mes := Mes + 2;
   If mes > 12 then mes := mes - 12;
   Fecha := Fecha + 32; {Restem per canviar de mes segur}
   DecodeDate(fecha,ano2,mes2,dia2);
   While not((dia2 = dia) or (mes2 = mes)) do
   begin
         Fecha := Fecha - 1;
         DecodeDate(fecha,ano2,mes2,dia2);
   End;

   While mes2 = mes do
   begin
        Fecha := Fecha - 1;
        DecodeDate(fecha,ano2,mes2,dia2);
   end;

   Result := Fecha;
end;

SEPARAR UN TEXTO CON DELIMITADORES

Estas dos funciones utilizadas como pone el ejemplo, permiten desfragmentar o separar un 
texto con delimitadores(el que sea, y cualquier tamaño).
Un ejemplo seria el ; de windows que sirve para crear listas.

Autor: (  uri@maptel.es )

Ejemplo de uso:
	Texto:='aaaaa,bbbbb,ccccccccc,dddddd'
	For bucle:=0 to SeparaCount(Texto,',')
	do ShowMessage(Separa(Texto,',',bucle)  );

Function Separa(Linea: String; Separador: String; Indice: Integer): String;
var
   aa,ll: Integer;
   inici,conta: Integer;
begin
     ll:=length(separador);
     Result := '';
     conta:=0;
     // Treiem separadors del inici de la cadena
     if copy(linea,1,ll)=separador then linea:=copy(linea,2,length(linea));
     // Posem un separador al final si no es que hi sigui
     if not(copy(linea,length(linea)-ll+1,ll)=separador) then Linea:=Linea+Separador; 

     inici:=1;
     For aa:=1 to length(linea) do begin
         if copy(linea,aa,length(separador))=separador
         then begin
              conta:=conta+1;
              if conta=indice then begin
                 Result := copy(linea,inici,(aa)-inici);
                 Break;
              end;
              inici:=aa+ll;
         end;
     end;

end;

Function SeparaCount(Linea: String; Separador: String): Integer;
var
   aa: Integer;
begin
     if EsVuit(linea) then result:=0 else result:=1;
     For aa:=2 to length(linea)-1
     do if separador=copy(linea,aa,length(separador)) then result:=result+1;
end;

NUMEROS DELETREADOS

Esta función permite traducir un valor numerico a un string con el número en letras
(como en los recibos). Llamando a la función xIntToLletres(4000) te retornara un string
con el valor 'CUATRO MIL'.
El valor numerico viene expresado como entero (no hacepta decimales,ni floats).
Por defecto es un LongInt que no supere los 999 millones.

Autor: (  uri@maptel.es )

Function xIntToLletres(Numero:LongInt):String;
var
   Millions,mils,unitats: Longint;
   Linea : String;
begin
     {Inicializamos el string que contendra las letras segun el valor numerico}
     if numero=0 then Linea:='Cero'
     else if numero<0 then Linea:='MENOS '
          else if numero>0 then Linea:='';

     {Determinamos el Nº de millones, miles, i unidades de numero en positivo}
     Numero   := Abs(Numero);
     millions := numero div 1000000;
     mils     := (numero - (millions*1000000)) div 1000;
     unitats  := numero - ((millions*1000000)+(mils*1000));

     {Vamos poniendot en el string las cadenas de los numeros(llamando a subfuncion)}
     if millions=1 then Linea:= Linea + ' UN MILLON '
     else if millions>1 then Linea := Linea + xxIntToLletres(millions) + ' MILLONES ';

     if mils =1 then Linea:= Linea + ' MIL '
     else if mils>1 then Linea := Linea + xxIntToLletres(mils) + ' MIL ';

     if unitats >0 then Linea:=Linea+xxIntToLletres(unitats);

     xIntToLletres:=Linea;
end;

Function xxIntToLletres(Valor:LongInt):String;
const
 aUnitat : array[1..15] of String = ('UNA','DOS','TRES','CUATRO','CINCO','SEIS',
                                     'SIETE','OCHO','NUEVE','DIEZ','ONCE','DOCE',
                                     'TRECE','CATORCE','QUINCE');
 aCentena: array[1..9]  of String = ('CIENTO','DOSCIENTAS','TRESCIENTAS',
                                     'CUATROCIENTAS','QUINIENTAS','SEISCIENTAS',
                                     'SETECIENTAS','OCHOCIENTAS','NOVECIENTAS');
 aDecena : array[1..9]  of String = ('DIECI','VEINTI','TREINTA','CUARENTA','CINCUENTA',
                                     'SESENTA','SETENTA','OCHENTA','NOVENTA');
var
   Centena, Decena, Unitat, Doble: LongInt;
   Linea: String;
begin
   if valor=100 then Linea:=' CIEN ' {Maximo Valor sera 999, ejemplo con 123}
   else   begin
        Linea:='';
        Centena := Valor div 100;                         {1 }
        Doble   := Valor - (Centena*100);                 {23}
        Decena  := (Valor div 10) - (Centena*10);         {2 }
        Unitat  := Valor - (Decena*10) - (Centena*100);   {3 }

        if Centena>0 then Linea:=Linea+Acentena[centena]+' ';

        if Doble>0 then begin
           if Doble=20 then Linea:=Linea+' VEINTE '
          else  begin
               if doble<16 then Linea:=Linea+Aunitat[Doble]
               else  begin
                    Linea:=Linea+' '+Adecena[Decena];
                    if (Decena>2) and (Unitat<>0) then Linea:=Linea+' Y ';
                    if Unitat>0 then Linea:=Linea+Aunitat[Unitat];
               end;
          end;
        end;

   end;
   Result:=Linea;
end;

TECLA <Enter> COMO <Tab> EN UN TDBGRID

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); 
{ Manejador del evento OnKeyPress del Form } 
{ También hay que establecer la propiedad KeyPreview del Form a True } 
begin 
  if Key = #13 then                        { si es la tecla <enter> } 
    if not (ActiveControl is TDBGrid) then { si no es un TDBGrid } 
    begin 
      Key := #0;                           { nos comemos la tecla } 
      Perform(WM_NEXTDLGCTL, 0, 0);        { vamos al siguiente control } 
    end 
    else 
      if (ActiveControl is TDBGrid) then   { si es un TDBGrid } 
        with TDBGrid(ActiveControl) do 
          if selectedindex < (fieldcount -1) then 
            selectedindex := selectedindex +1 
          else 
            selectedindex := 0; 
end;

EJECUTAR APPLET PANEL CONTROL

Incluye la siguiente unidad en tus proyectos y llama a "RunControlPanelApplet()"
con el nombre del applet a abrir.
Ejemplo: RunControlPanelApplet( 'timedate.cpl' ); 

unit open_cpl;

interface

function RunControlPanelApplet(

 sAppletFileName : string) : integer;

implementation

uses Windows;

function RunControlPanelApplet(

 sAppletFileName : string) : integer;

begin

 Result :=
 WinExec(PChar('rundll32.exe shell32.dll,'+'Control_RunDLL '+sAppletFileName),SW_SHOWNORMAL);

end;

end.

Lista de applet del panel de control.

(Si tienes mas, solo tienes que buscar los ficheros que tienen extensión cpl en /windows.) 

Fichero	Descripción
access.cp	Propiedades accesibilidad
appwiz.cpl	Añadir/Borrar propiedades programas
desk.cpl	Propiedades Monitor
intl.cpl	Propiedades configuración regional
joy.cpl	Propiedades Joystick
main.cpl	Propiedades Mouse
mmsys.cpl	Propiedades Multimedia
modem.cpl	Propiedades Modems
sysdm.cpl	Propiedades Sistema
timedate.cpl	Propiedades Hora/Fecha

GESTION DE IMPRESORAS

uses Printers;

function GetDefaultPrinterName : string;
begin
  if(Printer.PrinterIndex > 0)then
  begin
    GetDefaultPrinterName :=
      Printer.Printers[
        Printer.PrinterIndex ];
  end else
  begin
    GetDefaultPrinterName := '';
  end;
end;
 

Si quieres visualizar una lista de las impresoras disponibles, usando un TComboBox:

ComboBox1.Items := Printer.Printers;
 

El cambio de la impresora actual se realiza a traves de la propiedad PrinterIndex.
Para usar la primera impresora listada en la propiedad "Printers", poner PrinterIndex=0
(1º impresora = 0, 2º impresora = 1, ...).

OBTENIENDO LA LISTA DE USUARIOS DE PARADOX

Articulo extraido de las paginas del Dr. Marteens ( www.marteens.com ).

Si quiere obtener la lista de usuarios que están utilizando Paradox en su red, utilice la función DbiOpenUserList, que abre un cursor virtual con registros del tipo USERDesc. Recuerde incluir las unidades BDE y DBTables, y que el BDE debe estar inicializado para que esta función pueda ejecutarse:

procedure GetUsers(UserList: TStrings);
var
TmpCursor: hDbiCur;
rslt: dbiResult;
UsrDesc: USERDesc;
begin
UserList.Clear;
Check(DbiOpenUserList(TmpCursor));
try
repeat
Rslt:= DbiGetNextRecord(TmpCursor, dbiNOLOCK, @UsrDesc, nil);
if Rslt <> DBIERR_EOF then
UserList.Add(UsrDesc.szUserName);
until Rslt <> DBIERR_NONE;
finally
Check(DbiCloseCursor(TmpCursor));
end;
end;