Trucos Delphiraq

 

 

 

 

 

Vamos a ver una recopilacion de los mejores trucos para programar en Delphi. Si quieres que te incluyamos algun otro no dudes en enviarnoslo, entre todos podremos hacer un mundo mejor.

 

AÑADIR LOS PUNTOS DE MILES A UN NÚMERO

 

Como puedes observar el truco está en dar un formato de salida distinto al habitual

 

   procedure TForm1.Button2Click(Sender: TObject);

   var

      i:integer;

   begin

     i:=2538456;

     Label1.Caption:=FormatFloat('#,',i);

   end;

 
 

 

 

 

 

 

 

 

 

 

 


CALCULAR LA LETRA DEL NIF SEGÚN EL NÚMERO DEL DNI

function NIF(DNI: String): Char;

begin

  Result := Copy('TRWAGMYFPDXBNJZSQVHLCKET',StrToInt(DNI) mod 23+1,1)[1];

end;

 
 

 

 

 

 

 

 

 

 

 

 


COMPROBAR SI UN STRING TIENE UN NÚMERO

 

Intentamos convertir un String a un Entero, si no ocurre nada en el flujo de ejecución del programa, el String contiene un número, sino es asi salta la excepción y devolvemos false.

 

      function IsStrANumber(NumStr : string) : boolean;

      begin

        result := true;

        try

          StrToInt(NumStr);

        except

          result := false;

        end;

      end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 


AGILIZAR LA CARGA DE TUS PROGRAMAS

 

No crees todos los forms de golpe, crea sólo el inicial, y desde el crea dinámicamente los que vayas a utilizar, sólo cuando los vayas a utilizar.

Es decir, en el IDE, en Project-Options tienes dos ventanas, una la de 'Autocreate forms' y otra, la de 'Available forms'. Pues pon sólo la principal en 'Autocreate forms'. Después, en el uses de la primera form, añades las units del resto de forms, y en el var de la primera form, declaras las variables TForm del resto de forms que vayas a crear.

 

Un ejemplo de Form1 que crea una Form2:

 

El uses de Form1:

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  StdCtrls, Unit2;

 

 
 

 

 

 

 

 

El var de Form1:

 

var

  Form1: TForm1;

  Form2: TForm2;

 
 

 

 

 

 

 

 

Y cuando quieras llamar a la Form2 desde Form1 usa:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  Form2:=TForm2.Create(self);

  Form2.Show;

end;

 

 
 

 

 

 

 

 

 

 

 

Si tras hacer todo esto, te sigue tardando mucho en cargar el primer form, puedes ponerle una Splash Screen (una pantalla inicial) en la que le pones el típico mensaje de 'cargando'.

 

DAR MAYOR PRIORIDAD A TU APLICACIÓN

 

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

 
 

 

 

 

 


RESTAURAR LA PRIORIDAD A TU APLICACIÓN

 

  SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS);

  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);

 
 

 

 

 

 

 

 


CAPTURAR LAS PROPIAS HOT-KEYS

 

Primero, pon la propiedad KeyPreview de la form a True. Entonces, haz algo como esto:

     procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

       Shift: TShiftState);

     begin

       if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then

         ShowMessage('Ctrl-A');

     end;

 
 

 

 

 

 

 

 

 

 

 

 

En el ejemplo, capturamos el Ctrl-A

 

CERRAR OTRA APLICACIÓN DESDE LA TUYA

 

Es fácil: envianadole un mensaje WM_CLOSE.

Por ejemplo, cerrar la calculadora de Windows:

 

 

procedure TForm1.Button1Click(Sender: TObject);

var

   Mango:integer;

begin

  Mango:=FindWindow(nil,'Calculadora');

  if mango=0

    then ShowMessage('No encuentro esa aplicacion')

    else SendMessage(Mango,WM_CLOSE,0,0);

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

Para cerrar cualquier otra aplicacion, deberias saber o bien su ClassName o bien el titulo de la ventana. Este invento te dirá ambos de todas las aplicaciones que tengas rulando:

 

            -Crea una form y pon un TMemo (Memo1) y un TButton (Button1) en ella.

            -En el private de la declaracion de la form pon:

 

  private

    { Private declarations }

    WindowList1 : TList;

 

 
 

 

 

 

 

            -Y en el OnCLick del Button1 pon este código:

 

procedure TForm1.Button2Click(Sender: TObject);

var

 TopWindow   : HWND;

 WinName,

 WinClass    : array[0..80] of Char;

 x           : Integer;

 NoError     : Boolean;

 function GetAllWindows(Handle: HWND;

          NotUsed: Pointer): Boolean; stdcall;

 begin

   Result := True;

   Form1.WindowList1.Add(Pointer(Handle));

 end;

begin

  TopWindow   := Handle;

  WindowList1 := TList.Create;

            try

              NoError := EnumWindows(@GetAllWindows,

                                     Longint(@TopWindow));

 

              if not NoError then

                Exit;

 

              for x := 0 to WindowList1.Count - 1 do

              begin

 

                GetWindowText(HWND(WindowList1[x]),

                              WinName,

                              SizeOf(WinName) - 1);

 

                GetClassName(HWND(WindowList1[x]),

                             WinClass,

                             SizeOf(WinName) - 1);

 

                memo1.Lines.add('Titulo:'+Winname+'-Clase:'+WinClass);

              end;

            finally

              WindowList1.Free;

            end;

end;

 

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Y tendras una lista de las tareas ejecutandose, con su titulo y nombre de clase.

 

 

CERRAR UNA APLICACIÓN SABIENDO EL NOMBRE DE SU EJECUTABLE

 

Añade TLHelp32 en el uses de tu form

 

procedure TForm1.Button2Click(Sender: TObject);

 

  function CierraExe (FicheroExe:string):boolean;

 

    function SacaExe(MangoW:HWND):string;

    {Obtiene el EXE de una tarea}

    {get EXE of a task}

    var

      Datos    :TProcessEntry32;

      hID       :DWord;

      Snap    : Integer;

    begin

      GetWindowThreadProcessId(MangoW,@hID);

      Snap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);

      try

        Datos.dwSize:=SizeOf(Datos);

        if(Process32First(Snap,Datos))then

        begin

          repeat

            if Datos.th32ProcessID=hID then

            begin

              Result:=StrPas(Datos.szExeFile);

              Break;

            end;

          until not(Process32Next(Snap,Datos));

        end;

      finally

        Windows.CloseHandle(Snap);

      end;

    end;

 

 

   function ObtieneVentanas(Mango: HWND;

            ACerrar: Pointer): Boolean; stdcall;

   begin

     Result := True;

     {Mango es el handle de la tarea encontrada}

     {Si es el .EXE buscado, lo cierra}

     if SacaExe(Mango)=UpperCase( String(ACerrar^) )then

     begin

       SendMessage(Mango,WM_Close,0,0);

       String(Acerrar^):='CERRADO';

     end;

   end;

 

 

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

begin

    EnumWindows( @ObtieneVentanas, Integer(@FicheroExe) );

    Result:=(FicheroExe='CERRADO');

  end;

 

begin

 if CierraExe('C:\WINDOWS\NOTEPAD.EXE')

   then ShowMessage ('Cerrado/Closed')

   else ShowMessage ('No Encontrado/not Found');

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Cambiado la definición de tipo de hID de integer a DWord.

 

HACER QUE UN ENTER FUNCIONE COMO UN TABULADOR

 

Coloca este código en el evento OnKeyPress de tu form:

begin

  if Key = #13 then                          

   begin

      Key := #0;                                

      Perform(WM_NEXTDLGCTL, 0, 0);             

  end

end;

 

 
 

 

 

 

 

 

 

 

 

 

 

Esto hará que te muevas entre los Edits, botones, etc con el ENTER además de con el

TAB. Si tu form SI tiene un control DBGrid, igual te guste más éste codigo:

{ Este es el manejador de evento de OnKeyPress de tu form }

{ Debes poner la propiedad KeyPreview de la form a true}

 

begin

  if Key = #13 then                                                 { if it's an enter key }

    if not (ActiveControl is TDBGrid) then begin       { if not on a TDBGrid }

      Key := #0;                                                        { eat enter key }

      Perform(WM_NEXTDLGCTL, 0, 0);                 { move to next control }

    end

    else if (ActiveControl is TDBGrid) then                { if it is a TDBGrid }

 

      with TDBGrid(ActiveControl) do

        if selectedindex < (fieldcount -1) then             { increment the field }

          selectedindex := selectedindex +1

        else

          selectedindex := 0;

end;

 

 
 


 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

En ambos casos, recuerda poner la propiedad KeyPreview de la form a true.

 

HINTS CON UN COLOR DISTINTO (CUADROS DE AYUDA)

 

Para conseguirlo, crearemos nuestro propio descendiente de THintWindow, en el que

añadiremos algo al método Create para que cambie el font a nuestro gusto.

Vamos con el código:

 

-Definimos nuestro descendiente de THintWindow, es decir, ponemos esto en el

implementation de la form:

 

 

implementation

 

{$R *.DFM}

 

type

  THintConFont = Class (THintWindow)

    constructor Create (AOwner: TComponent); override;

    end;

 

constructor THintConFont.Create (AOwner: TComponent);

begin

  inherited

    Create (Aowner);

  Canvas.Font.Name := 'Times New Roman';

  Canvas.Font.Size := 18;

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

-Y ahora, asignamos nuestro invento al HintWindowClass de nuestra form. Lo haremos

en el evento OnCreate de la propia form:

 

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  Application.ShowHint := False;

  HintWindowClass := THintConFont;

  Application.ShowHint := True;

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

INICIAR TU APLICACIÓN ICONIZADA

 

-Pon la propiedad WindowState de tu form a wsMinimized

-En la sección Private de la declaración de la form pon esto:

 

procedure WMQueryOpen(VAR Msg : TWMQueryOpen);

 message WM_QUERYOPEN;

 
 

 

     

 

 

 

 

 

MANTENER EL SPLASH SCREEN MAS TIEMPO AL CARGAR TU APLICACIÓN

 

En otro de los trucos tienes un ejemplo de 'Splash Screen'. Este es una ampliación para

hacer que la Splash Screen desaparezca unos segundos después de que la form principal

se haya hecho visible.

 

En tu form principal, declara una variable pública llamada SplashScreenHandle:

 

var

     SplashScreenHandle:integer;

 
 

 

 

 

 

 

En el fuente del projecto, añade una sección var como la siguiente:

 

var

     SplashScreen:TSplashScreen;

 
 

 

 

 

 

 

Dentro de la sección begin-end, añade el siguiente código al principio:

 

begin

    {Mostramos la Splash Screen}

    {Show the splash screen}

    SplashScreen:=TSplashScreen.Create(Application);

    Splashscreen.show;

    SplashScreen.update;

    {Creamos la form principal}

    {Create the main form}

    Application.createform(MainForm,MainFormUnit);

    MainFormUnit.SplashScreenHandle:=SplashScreen.handle;

    {Aqui el resto de tu projecto...}

    {rest of your code goes here....}

end.

 

 
 


 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Entonces, en tu form principal, mediante un timer, ejecutamos éste código para cerrar la

Splash Screen:

 

SendMessage(SplashScreenHandle,WM_CLOSE,0,0);

 
 

 

   

 

 

METER BITMAPS, ICONOS Y CURSORES EN TU EJECUTABLE

 

Lo mejor es incluirlos en el ejecutable mediante un archivo de recursos. Mediante el

Image Editor crea un nuevo fichero de recursos (File-New-ResFile) y después le añades

los bitmaps o iconos que desees (Resource-New-Bitmap etc...). Si tienes hecho ya el

bitmap, puedes traerlo a través del portapapeles.

 

Una vez tengas el fichero RES, p.ej. "DIBUJOS.RES", pon {$R DIBUJOS.RES} en tu

código para incluir ese fichero en el ejecutable.

 

Para usar cualquiera de estos recursos, p.ej. un bitmap en un TImage, bastará con:

Image1.Picture.Bitmap.Handle := LoadBitmap(HInstance, 'nombre');

 
 

 

 

       

 

donde 'nombre' es una cadena con el nombre que le hayas dado al bitmap en el fichero

de recursos (en el image editor, con Resource-Rename...)

 

Recuerda que los recursos tomados por LoadBitmap tienen que liberarse con

DeleteObject.

 

 

MINIMIZAR UNA APLICACIÓN DESDE LA TUYA

 

Primero has de hallar su handle (Mira el truco 'Cerrar otra aplicacion desde la tuya') y

luego enviarle el mensaje SW_MINIMIZE:

ShowWindow(hWnd, SW_MINIMIZE);

 
 

 

 

 

 

OCULTAR TU APLICACIÓN DE LA BARRA DE TAREAS

 

Para ocultarla:

ShowWindow(Application.Handle, SW_HIDE);

 
 

 

 

 para mostrarla:

 

ShowWindow(Application.Handle, SW_SHOW);

 
 

 

 

 

 

ABORTAR UNA CONSULA QUE TARDA MUCHO EN EJECUTARSE

 

A veces, es interesante poder parar una consulta que tarde demasiado una vez hecho el

Query1.Open o Query1.ExecSQL

 

Podemos hacerlo con el evento OnServerYield del Query:

 

-Crea una form (Form1) con una TQuery (Query1) y dos TButtons (Button1 y Button2)

-Crea una variable global a la form de tipo Boolean (metela en el var de la form) llamada

'Abortar'

-En el OnClick del Button1 pon Abortar:=FALSE; y añade el código que inicia la consulta

-En el evento OnServerYield del Query1 pon esto:

procedure TForm1.Query1ServerYield(DataSet: TDataSet;

   var AbortQuery: Boolean);

begin

   AbortQuery:=Abortar;

   Application.processmessages;

end;

 
 

 

 

 

 

 

 

 

 

 

-y por fín, en el OnClick del Button2 pon Abortar:=TRUE; . Usa Button1 para comenzar la consulta y Button2 para abortarla

 

NOTA: Segun la ayuda del TQuery: Solo Sybase ejecuta el OnServerYield

 

AÑADIR UN ÍNDICE INVERSO A LA TABLA EN RUNTIME

 

Table1.AddIndex('NewIndex', 'CustNo;CustName', [ixDescending]);

 
 


            

 

 

 

AÑADIR UN PASSWORD A UNA TABLA PARADOX EN RUNTIME

 

Hay un truco en el que indicamos como proteger con password una tabla Paradox

mediante el Database Desktop.

Aqui tienes la forma de hacerlo mediante código:

procedure TForm1.Button1Click(Sender: TObject);

 

procedure PonClave(Const ADatabase, ATable:string; Clave:DbiName);

var

  ADB       :TDataBase;

  SaveKC    : Boolean;

  PdxStruct : CRTblDesc;

begin

 

with TTable.Create(nil) do

  try

   DatabaseName := ADatabase;

    TableName := ATable;

    Exclusive := True;

    Open;

    ADB := DAtabase;

    SaveKC := ADB.KeepConnection;

    ADB.KeepConnection := True;

    try

     Close;

      FillChar(PdxStruct,SizeOF(PdxStruct),0);

      StrPCopy(PdxStruct.szTblName,ATable);

      PdxStruct.bPack := False;

      PdxStruct.bProtected:= TRUE;

      {Esta es la clave que se pondrá en la tabla}

      PdxStruct.szPassword:=Clave;

      Check(DbiDoRestructure(ADB.Handle,1,

        @PdxStruct,nil,nil,nil,False));

    finally

     ADB.KeepConnection := SaveKC;

    end;

  finally

   Free;

  end;

end;

 

begin

  PonClave('DBDEMOS','BIOLIFE.DB','MiPassword');

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

BUSQUEDAS BLANDAS PARA TABLAS DBASE

 

No sirve para Paradox, pues se necesita Expression Index.

 

 

REQUISITOS:

-Table1 debe estar cerrada en diseño.

-Poner un Button1 para iniciar la búsqueda.

 

 

SUPONEMOS: (para este ejemplo)

-Table1NOMBRE es el campo donde quieres buscar (Debes poner tu campo)

-Edit1 es donde vas a poner el contenido de búsqueda.

-NOMBLAN es el índice que te va a crear (puedes poner el nombre que quieras)

 

A TENER EN CUENTA:

-La búsqueda distingue entre mayúsculas y minúsculas

-También los acentos.

-Sólo campos String.

 

EL CODIGO:

 

procedure TForm1.Button1Click(Sender: TObject);

var i:integer;

begin

  Table1.IndexDefs.Update;

  Table1.Close;

  for i:=0 to Table1.IndexDefs.Count-1 do

    if Table1.IndexDefs.Items[i].Name = 'NOMBLAN' then Table1.DeleteIndex('NOMBLAN');

  Table1.AddIndex('NOMBLAN','iif(at("'+Edit1.text+'",NOMBRE)>0,1,-1)',[ixExpression]);

  Table1.IndexName := 'NOMBLAN';

  Table1.Open;

  Table1.SetRangeStart;

  Table1.FieldByName('NOMBRE').AsString := Edit1.Text;

  Table1.SetRangeEnd;

  Table1.FieldByName('NOMBRE').AsString := Edit1.Text;

  Table1.ApplyRange;

end;

 

{No olvidar:}

{Don't forget}

procedure TForm1.FormCreate(Sender: TObject);

begin

   Table1.Open;

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

BORRAR LOS REGISTROS FÍSICAMENTE

 

No sé si te habrás dado cuenta, pero cuando borras registros en una tabla, en realidad

no desaparecen físicamente del fichero, sino que el BDE los marca como borrados.

Esto puede traer consecuencias fatales en determinadas aplicaciones en las que se

borren muchos registros en una tabla.

Para hacer desaparecer dichos registros marcados para borrar necesitaremos compactar

la tabla.

 

 

Aqui tienes un ejemplo de como se hace:

 

-Incluye 'bde' en el uses de tu form

-y utiliza esta funcion para compactarla:

procedure PackDBF(Tabla: TTable);

begin

    Check(DbiPackTable(Tabla.DBHandle, Tabla.Handle, nil, szDBASE, True))

end;

 
 

 

 

               

 

 

 

Pero cuidado, para poder compactar la tabla, ésta debera estar abierta en modo exclusivo

 

Ejemplo:

 

 {Cerramos la tabla/Close table}

 Table1.Close;

 {En Modo exclusivo/Exclusive mode}

 Table1.Exclusive:=True;

 {Abrimos tabla/Open table}

 Table1.Open;

 {Compactar/pack}

 PackDBF(Table1);

 

 {Reabrir tabla/reopen table}

 Table1.Close;

 Table1.Exclusive:=False;

 Table1.Open;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Compactar tablas DBF con una función:

 

 

procedure PackDBF(Const ADatabase, ATable : String);

begin

with TTable.Create(nil) do

  try

   DatabaseName := ADataBase;

    TableName := ATable;

    Exclusive := True;

    Open;

    Check(DbiPackTable(Database.Handle,Handle,'','',True));

  finally

   Free;

  end;

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Ejemplo de llamada:

PackDBF('Alias','Table1');

 
 

 

              

 

 

 

Para tablas Paradox:

 

procedure PackParadox(Const ADatabase, ATable : String);

var

 ADB :TDataBase;

  SaveKC : Boolean;

  PdxStruct : CRTblDesc;

begin

with TTable.Create(nil) do

  try

   DatabaseName := ADatabase;

    TableName := ATable;

    Exclusive := True;

    Open;

    ADB := DAtabase;

    SaveKC := ADB.KeepConnection;

    ADB.KeepConnection := True;

    try

     Close;

      FillChar(PdxStruct,SizeOF(PdxStruct),0);

      StrPCopy(PdxStruct.szTblName,ATable);

      PdxStruct.bPack := True;

      Check(DbiDoRestructure(ADB.Handle,1,

@PdxStruct,nil,nil,nil,False));

    finally

     ADB.KeepConnection := SaveKC;

    end;

  finally

   Free;

  end;

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Ejemplo de llamada:

PackParadox('Alias','Table1');

 
 

 

 

              

 

MOVER REGISTROS DE UNA TABLA A OTRA DIFERENTE

 

Este procedimiento agrega registros de una tabla 'fuente' a una tabla 'destino' haciendo

comparaciones por el nombre de los campos. La tabla 'destino' queda en modo de

edición. Ademas esta rutina solo funciona para los campos asociados con el objeto

TField. Estos los puedes incluir utilizando el inspector de objetos.

 

procedure AppendFrom;

var

  i : integer;

  fldDest, fldSource : TField;

begin

  with tblDest do begin

    Append;

    for i := 0 to FieldCount - 1 do

    begin

      fldDest := Fields[i];

      if not (fldDest.ReadOnly or fldDest.Calculated) then

      begin

        fldSource := tblSource.FindField(fldDest.FieldName);

        if assigned(fldSource) then

        begin

          fldDest.DataSet.Edit;

          fldDest.AsString := fldSource.AsString

        end

      end

    end;

  {Post}

  end

end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Esta otra procedure, hace lo mismo que la anterior, pero en lugar de manejar los campos

TField, usa todos los campos de la tabla. Los campos son comparados por nombre entre

la tabla origen y la destino.

 

 

procedure AppendFromAllFields;

var

  i : integer;

  fldDest, fldSource : TField;

  tblSource, tblDest : TTable;

begin

  tblSource := nil;

  tblDest := nil;

  try

    tblSource := TTable.Create(nil);

    tblDest := TTable.Create(nil);

    tblSource.DatabaseName := tblS.DatabaseName;

    tblSource.TableName := tblS.TableName;

    tblDest.DatabaseName := tblD.DatabaseName;

    tblDest.TableName := tblD.TableName;

    tblDest.Open;

    tblSource.Open;

    with tblDest do

    begin

      Append;

      for i := 0 to FieldCount - 1 do

      begin

        fldDest := Fields[i];

        if fldDest.AsString = '' then

        begin

          fldSource := tblSource.FindField(fldDest.FieldName);

          if assigned(fldSource) then

            fldDest.AsString := fldSource.AsString;

        end;

      end;

      Post;

    end;

  finally

    tblDest.Free;

    tblSource.Free;

  end;

end;

 

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

SABER EL PATH DE UNA BASE DE DATOS SEGÚN EL ALIAS

 

   uses BDE;

   .....

   procedure ShowDatabaseDesc(DBName: String);

   const

      DescStr = 'Driver Name: %s'#13#10'AliasName: %s'#13#10 +

                'Text: %s'#13#10'Physical Name/Path: %s';

   var

     dbDes: DBDesc;

   begin

      dbiGetDatabaseDesc(PChar(DBName), @dbDes);

      with dbDes do

        ShowMessage(Format(DescStr, [szDbType, szName, szText, szPhyName]));

   end;

 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


DESABILITAR EL BOTÓN CERRAR DE UNA FORM

 

Pon un TButton (Button1) en tu form y pon este codigo dentro del evento OnClick:

 

procedure TForm1.Button1Click(Sender: TObject);

var

  hMenuHandle : HMENU;

begin

   hMenuHandle := GetSystemMenu(Form1.Handle, FALSE);

   if (hMenuHandle <> 0) then

     DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);

End;

 
 


 

 

 

 

 

 

 

 

 

 

 

EVITAR QUE CIERREN LA FORM CON ALT+F4

 

Basta con que pongas en el evento OnCloseQuery de tu form el siguiente código:

 

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

     CanClose:=FALSE;

end;

 
 

 

 

 

 

 

 

 

FORM SIN CAPTION PERO CON CUALQUIER TIPO DE BORDE

 

Añade esta linea en el private de la declaracion tu form:

 

procedure CreateParams(var Params: TCreateParams); override;

 
 

 

    

 

Y en la implementation, pon la procedure:

 

procedure TForm1.CreateParams(var Params: TCreateParams);

    begin

         inherited CreateParams(Params);

         with Params do

            Style := (Style or WS_POPUP) and not WS_DLGFRAME;

    end;

 
 

 

 

 

 

 

 

 

 

 

 

BORRAR UN TIMAGE

Image1.Picture := nil.

 
 

 

 

 

 

 


ENCONTRAR TEXTO EN UN TMEMO CON FINDDIALOG

 

-Pon un TMemo (Memo1), un FindDialog (FD1) y un TButton (Button1) en tu form

-Pon este código dentro del OnClick de Button1:

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
begin 
  FD1.Execute;
end; 
 

 

 

 

 

 

 

 

 

-Y en el evento OnFind de FD1, pon este otro código:

 

Cuadro de texto: procedure TForm1.FD1Find(Sender: TObject);
var 
   sTemp:string;
   itemp:integer;
begin 
  sTemp:=Copy(Memo1.Text,
              2+Memo1.SelStart,
              Length(Memo1.Text)-Memo1.SelStart);
 
  iTemp:=Pos(UpperCase(FD1.FindText),UpperCase(sTemp));
 
  if iTemp<>0 then 
  begin 
    Memo1.SetFocus;
    Memo1.SelStart:=Memo1.SelStart+iTemp;
    Memo1.SelLength:=Length(FD1.FindText);
  end 
    else 
      {If don't find the searched text...}
      ShowMessage('No encuentro '+FD1.FindText);
end;
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

INSERTAR UN FICHERO EN LA POSICION ACTUAL DE UN TMEMO

 

Usando un TMemoryStream para leer el fichero y el método SetSelTextBuf del TMemo

para insertarlo.

 

Cuadro de texto:            var 
             TheMStream : TMemoryStream;
           begin      
             TheMStream := TMemoryStream.Create;      
             TheMStream.LoadFromFile('C:\AUTOEXEC.BAT');      
             TheMStream.Seek(0, soFromEnd);      
             {Null terminate the buffer}
             {Terminamos el buffer con null}
             TheMStream.Write(#0, 1);      
             TheMStream.Seek(0, soFromBeginning);      
             Memo1.SetSelTextBuf(TheMStream.Memory);      
             TheMStream.Free;      
           end;    
Un Ejemplo:

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

MOSTRAR LAS ÚLTIMAS LINEAS DE UN TMEMO

 

Util si cargamos un Memo desde un fichero, o tenemos un memo que ya tiene un monton

de lineas al arrancar nuestra aplicación, y queremos que se vean las últimas lineas, no

las primeras.

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
begin 
  Memo1.SelStart:=Length(Memo1.Lines.Text);
  Memo1.SelLength:=0;
end; 
 

 

 

 

 

 

 

 

 

PONER EL CURSOS EN CUALQUIER SITIO DE UN TMEMO (COMO EN WORD 2000)

 

Con SelStart:

 

Cuadro de texto: Memo1.SelStart:=30; 

 

    

 

Pero hay un gran problema:

 

En un TMemo, sólo podemos poner el cursor sobre una linea que contenga algún

caracter

Puedes comprobar esto fácilmente: pon un Memo vacio en tu form y comprueba que no

puedes mover el cursor hasta que escribas algo...

En definitiva: si la linea está vacia, no puedes poner el cursor allí.

 

 

Entonces, nosotros podemos calcular el SelText a usar, acumulando el numero de

caracteres de cada linea antes de la fila en donde queremos poner el cursor.

El siguiente código de ejemplo, coloca el cursor en una fila/columna dada, pero sólo si

esa posición existe en el memo:

 

-Pon un TMemo (Memo1) y un TButton (Button1) en tu form

-Pon el siguiente código dentro del OnClick de Button1:

 

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
var 
   Row,Col:integer;
   i:integer;
   Cuenta:integer;
begin 
  LockWindowUpdate(Memo1.Handle);
  Row:=15;
  Col:=5;
  Cuenta:=0;
  if row <= Memo1.Lines.Count then 
  begin 
    i:=0;
    while i < row do 
    begin 
     Inc(Cuenta,2+Length(Memo1.Lines[i]));
     Inc(i);
     Memo1.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end; 
    if Col <= Length(Memo1.Lines[i]) then 
    begin 
      Inc(Cuenta,Col);
      Memo1.SelStart:=Cuenta;
    end; 
  end; 
  LockWindowUpdate(0);
  Memo1.Refresh;
  Memo1.SetFocus;
end; 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Otro método mucho más rápido:

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
 
procedure GoXYMemo(Memo:TMemo;Linea,Columna:integer);
begin 
 with Memo do 
 begin 
  SelStart:=0;
  SelLength:=0;
  SelStart := Columna+Memo.Perform(EM_LINEINDEX, Linea, 0);
  SelLength:=0;
  SetFocus;
 end; 
end; 
 
begin 
  GoXYMemo(Memo1,700,2);
end; 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

PONER OPCIONES DE DESHACER EN UN TMEMO

 

Basta con ejecutar esto:

 

Cuadro de texto: Memo1.Perform(EM_UNDO, 0, 0);

 

    

 

 

 

CARGAR UN TEXTO DOS SIN QUE SE EXTROPEEN LOS ACENTOS

 

Utiliza el siguiente código, que traduce lo que hay que leer mediante la funcion

OemToAnsiBuff:

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
   var 
     i: integer;
     linea: PChar;
     txt: TStringList;
   begin 
     txt := TStringList.Create;
     try
        txt.LoadFromFile('c:\Fichero\a\leer.txt');
        for i := 0 to txt.Count - 1 do 
        begin 
           linea := PChar(txt.strings[i]);
           OemToAnsiBuff(linea, linea, strlen(linea));
        end; 
        RichEdit1.Lines.AddStrings(txt);
     finally
        txt.Free;
     end; 
   end; 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

NOTA: OemToAnsiBuff es obsoleta en Win32, pero funciona. Mirate la ayuda.

 

CAMBIAR LOS GLYPS DE LOS BOTONES DE UN TDBNAVIGATOR

 

En este ejemplo, copiaremos el Glyph de un SpeedButton (SpeedButton1) en el boton

'Anterior' del Navigator. Es sólo un ejemplo. En realidad no haría falta usar un

SpeedButton, podriamos hacer todo mediante código, pero para el ejemplo es más

cómodo.

 

-Pon un TDBNavigator (DBNavigator1) y un SpeedButton (SpeedButton1) en tu form

-Carga un Glyph en el SpeedButton1

-Mete este código en el OnCreate de la form:

 

 

Cuadro de texto: procedure TForm1.FormCreate(Sender: TObject);
var 
  c: Integer;
begin 
  with DBNavigator1 do 
  begin 
    for c := 0 to ControlCount -1 do 
      if Controls[c] is TNavButton then 
        with TNavButton(Controls[c]) do 
        begin 
          case Index of 
            nbPrior: Glyph := SpeedButton1.Glyph;
          end; 
        end; 
  end; 
end;
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

CREAR COMPONENTES CON EVENTOS ONENTER ONEXIT

 

A veces se echa de menos estos eventos. El TPanel dispone de ellos. Sirven para

detectar cuando el cursor del ratón entra o sale de nuestro control, para cambiar su

aspecto, por ejemplo. Este truco te enseña a añadir estos eventos a tus componentes. En

el ejemplo crearemos un nuevo TButton con estos dos eventos. Usaremos Delphi3, en el

reesto de versiones supongo que el procedimiento será parecido.

 

Creamos un nuevo componente mediante el IDE de Delphi: Component-New Component.

Como Ancestor Type, seleccionamos TButton.

Metemos el nombre del nuevo componente, por ejemplo TSEButton (Salir y Entrar) y en

qué paleta de componentes queremos que aparezca

Todo esto creará un esqueleto de código que podremos retocar a nuestro gusto.

 

 

Ahora, tenemos que añadir los dos manejadores de eventos y capturar los mensajes

CMMouseEnter y CMMouseLeave que Windows envia al control para indicarle si el

ratón ha entrado o ha salido del control.

Añadimos estas dos lineas en la parte private:

Now, we have to add the two events handlers and to capture the messages

CMMouseEnter and CMMouseLeave that Windows sends to the control to indicate him

if the mouse has entered or it has left the control.

Add these two lines in the private part:

 

Cuadro de texto: FOnEnter: TNotifyEvent;
FOnExit: TNotifyEvent;
 

 

         

 

 

 Tambien añadimos estas dos declaraciones, que sirven para capturar los mensajes

CM_MOUSEENTER y CM_MOUSELEAVE:

 Cuadro de texto: procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
 

 

 

 

 

 

En la parte published, pondremos estas otras lineas, que declararán las propiedades

para manejar los eventos:

property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;

property OnExit: TNotifyEvent read FOnExit write FOnExit;

 
 

 

 

        

 

 

 

Finalmente, añadimos en la implementation las procedures que hemos declarado:

 

Cuadro de texto:  
    procedure TACButton.CMMouseEnter(var Msg:TMessage);
    begin 
      inherited;
      if Assigned (FOnEnter) then 
        FOnEnter(Self);
    end; 
 
    procedure TACButton.CMMouseLeave(var Msg:TMessage);
    begin 
      inherited;
      if Assigned (FonExit) then 
        FonExit(Self);
    end; 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Que lo unico que hacen es invocar los eventos, siempre y cuando los hayamos definido.

 

Ten en cuenta que esto es sólo un ejemplo. Puedes repetir la operación con otros tipos

de controles en los que necesites estos dos eventos.

 

PONER PRIMERA LETRA EN MAYÚSCULAS

 

Pon este código dentro del evento OnKeyPress del TEdit:

 

Cuadro de texto:   procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  begin 
     with Sender as TEdit do 
        if (Text = '')
        or (Text[SelStart] = ' ')
        or (SelLength = Length(Text)) then 
           if Key in ['a'..'z'] then  Key := UpCase(Key);
  end; 
 

 

 

 

 

 

 

 

 

 

 

 

COPIAR FICHEROS CON BARRA DE PROGRESO

 

A veces interesa indicar el progreso de copia de un fichero.

Si usamos una función de alto nivel como CopyFile, nos simplificaremos mucho la vida,

pero no podremos usar nuestra ProgressBar...

La solucion que proponemos es la siguiente:

 

-Abrir el fichero Origen y crear el Destino

-Leer un bloque de datos del fichero Origen

-Actualizas la barra de progreso

-Grabas el bloque leido en el fichero Destino

 

Y repetimos el proceso hasta que hayas leido y grabado el fichero completo.

 

 

El ejemplo:

Nota: No he puesto ninguna comprobación de errores, eso te lo dejo a tí, ya sabes,

testear si el fichero Origen existe, dar fallo si no hay espacio en el disco para grabar el

fichero, o comprobar si el fichero destino ya existe y dar un aviso de que vas a

machacarlo y todos los errores que se te ocurran.

 

-Pon una ProgressBar (PB1) en tu form

-Pon un TButton y mete este código en su evento OnClick:

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
var 
   Origen,
   Destino  :file of byte;
   Buffer   :array[0..4096] of char;
   Leidos   :integer;
   Longitud :longint;
begin 
  {Abrimos fichero Origen y Destino}
  AssignFile(Origen,'c:\kk\uno.exe');
  reset(Origen);
  AssignFile(Destino,'c:\kk\dos.exe');
  rewrite(Destino);
  {Hallamos la longitud del fichero a copiar}
  Longitud:=FileSize(Origen);
  {Actualizamos limites de la ProgressBar}
  PB1.Max:=Longitud;
  PB1.Min:=0;
  while Longitud >0 do 
  begin 
    BlockRead(Origen,Buffer[0],SizeOf(Buffer),Leidos);
    Longitud:=Longitud-Leidos;
    BlockWrite(Destino,Buffer[0],Leidos);
    PB1.Position:=PB1.Position+Leidos;
  end; 
  CloseFile(Origen);
  CloseFile(Destino);
end; 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

El ejemplo usa un buffer de 2048 bytes. Cuando mayor sea el buffer más velocidad te

dará la rutina.

Bueno, en realidad, el rendimiento óptimo lo tendrías si igualas el tamaño del buffer al

tamaño de los clusters del disco... (o en múltiplos de éste) pero no te preocupes, tampoco

es tan crítica la ganancia de velocidad, siempre que no bajes mucho el tamaño del buffer.

 

OBTENER EL DIRECTORIO DE WINDOWS

 

Pon un Tlabel (Label1) y pon esthe código dentro del onClick de un boton:

 

Cuadro de texto: procedure TForm1.Button5Click(Sender: TObject);
  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; 
begin 
   Label1.Caption:=GetWindowsDirectory;
end; 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

OBTENER EL DIRECTORIO EN CURSO

 

Pon un tLabel (Label1) y en el OnClick de un boton, mete este código:

 

Cuadro de texto: procedure TForm1.Button7Click(Sender: TObject);
  function GetCurrentDirectory: String;
  var 
     nBufferLength : DWORD;
     lpBuffer   : PChar;
  begin 
     nBufferLength := MAX_PATH + 1;
     GetMem( lpBuffer, nBufferLength );
     try
        if Windows.GetCurrentDirectory( nBufferLength, lpBuffer ) > 0 then 
           Result := lpBuffer;
     finally
        FreeMem( lpBuffer );
     end; 
  end; 
begin 
  Label1.Caption:=GetCurrentDirectory;
end; 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

OBTENER EL PATH HACIA EL EXLORADOR WEB INSTALADO POR DEFECTO

 

- Añade 'Registry' en la clausula uses de tu form

- Crea una form con un TLabel (Label1) y un TButton (Button1)

- En el evento OnClick del TButton pon este código:

 

Cuadro de texto: procedure TForm1.Button1Click(Sender: TObject);
   {se debe hacer un uses de la unit Registry} 
    var 
       Registro : TRegistry; 
       KeyName: String; 
       ValueStr: String; 
    begin 
     Registro := TRegistry.Create; 
     try 
     Registro.RootKey := HKEY_CLASSES_ROOT; 
     KeyName := 'htmlfile\shell\open\command'; 
     if Registro.OpenKey(KeyName, False) then 
     begin 
       ValueStr := Registro.ReadString(''); 
       {En ValueStr se recibe la ruta completa del navegador 
       predeterminado, si le añadimos una URL o un fichero 
       HTML local nos abrirá el navegador con esa página} 
       Registro.CloseKey;
       Label1.Caption:=ValueStr;
       {Sigue el enlace para ver la funciónWinExecNoWait32} 
     end 
     else 
       ShowMessage('No posee explorador de HTML predeterminado'); 
     finally
       Registro.Free; 
     end; 
end; 
 
 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Y el Label 1 te mostrará el path hacia el explorador web predeterminado de tu sistema.

 

EJECUTAR EL EXPLORADOR WEB POR DEFECTO

 

Incluye 'ShellApi' en el uses de tu fom y ejecuta esto:

 

Cuadro de texto: ShellExecute(Form1.Handle,nil,PChar('index.html'),'','',SW_SHOWNORMAL);