Modificar propiedades de controles en ejecución utilizando RTTI

miércoles, 5 de diciembre de 2007 2 comentarios
Share Button

A veces durante la ejecución de código necesitamos modificar una determinada propiedad de diferentes tipos de controles. Para la explicación podemos pensar por ejemplo en como desactivar (Enabled=False) todos los controles de un formulario; Una primera opción podría ser un código como éste:

// recorrer los controles
for i := 0 to (Self.ComponentCount - 1) do begin
 
   // Es un Edit
   if (Components[i] is TEdit) then
   TEdit(Components[i]).Enabled := False;
   // Es un LAbel
   if (Components[i] is TLabel) then
   TLabel(Components[i]).Enabled := False;
   // Es un ListBox
   if (Components[i] is TListBox) then
   TListBox(Components[i]).Enabled := False;
   ...
end;

Una implementación como ésta tiene muchos problemas e inconvenientes; Los más claros podrían ser:* Es poco «ortodoxa», por decirlo así;

  • Es un código repetitivo y nada eficiente.
  • Es por definición incompleta, ya que el número de componentes que podemos tener en un form es inmenso y de muchas clases (yo sólo las básicas que trae Delphi).
  • Es poco flexible.
  • …

Utilizando RTTI podemos de forma relativamente sencilla modificar todos los componentes utilizando una única instrucción.
Podemos utilizar un procedimiento como éste:

{:Asigna valor a una propiedad a través del Nombre (RTTI). }
function SetPropAsString(AObj: TObject; const PropName, Value: String):Boolean;
var
   PInfo: PPropInfo;
begin
   // Intentamos acceder (con un puntero) a la info. de la propiedad
   PInfo := GetPropInfo(AObj.ClassInfo, PropName);
   Result := PInfo <> nil;
   // Se ha obtenido la información...
   if (Result) then begin
      // Se ha encontrado la propiedad con éste nombre; Chequear el tipo...
      if (PInfo^.Proptype^.Kind = tkString) or
          (PInfo^.Proptype^.Kind = tkLString) then begin
        // Asignar el valor de tipo String
        SetStrProp(AObj, PInfo, Value);
      end
      else if (PInfo^.Proptype^.Kind = tkInteger) then begin
        // Asignar el valor...
        if (PInfo^.PropType^.Name = 'TColor') then begin
          SetOrdProp(AObj, PInfo, StringToColor(Value));
        end
      else if (PInfo^.PropType^.Name = 'TCursor') then begin
        SetOrdProp(AObj, PInfo, StringToCursor(Value));
      end
      else begin
        SetOrdProp(AObj, PInfo, StrToInt(Value));
      end;
   end
   else if (PInfo^.Proptype^.Kind = tkEnumeration) then begin
    // Bloque de proteccion
    try
      if (PInfo^.PropType^ = TypeInfo(System.Boolean)) then begin
        SetOrdProp(AObj, PInfo, StrToInt(Value));
      end
      else begin
        SetOrdProp(AObj, PInfo, StrToInt(Value));
      end;
    except
      raise;
    end;
   end
   else begin
    Result := False;
   end;
  end
  else begin
    // No se ha encontrado la propiedad con ese nombre
    Result := False;
  end;
end;

Su utilización es muy sencilla, y en el ejemplo anterior el código utilizado pasaría a ser similar a éste:

NOTA: Añadir la unit TypInfo al USES.

NOTA2: (Gracias Arsenio por comentarmelo) Se deben añadir al uses también las units Graphics y Controls ya que son usados por StringToColor y StringToCursor respectivamente.

// recorrer los controles
for i := 0 to (Self.ComponentCount - 1) do begin
   SetPropAsString(Components[i], 'Enabled', '0'{FALSE});
end;
// Otros ejemplos
SetPropAsString(Components[i], 'Left', '10');
SetPropAsString(Components[i], 'Color', 'clRed');
...
Categories: Delphi, Trucos Tags: , , ,

«Pasar» uno o varios ítems de un menú a la parte derecha

sábado, 1 de diciembre de 2007 Sin comentarios
Share Button

A veces es interesante poder situar una o varias opciones de un menú a la parte derecha, como una forma de diferenciarlas de las demás o por una característica púramente estética.
Utilizando el siguiente procedimiento se pueden mover uno o varios ítems.

Definimos un menú y sus ítems de la forma estandard en Delphi. Llamamos a éste procedimiento (en el OnShow del formulario por ejemplo) con el menú como parámetro y en índice del elemento que queremos «mover» a la parte derecha; ese y los siguiente serán desplazados a la parte derecha de la zona del título.

Ej: Total Commander, por ejempo, utiliza ésta característica con el menú ade ayuda:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

{:Pasa un item de menú a la derecha de la pantalla.
Pasa un item de menú y todos los que hay a su derecha a la parte "derecha" de
la barra de menús del formulario.}
procedure MenuItemAtRight (MainMenu:TMainMenu; Position:Integer);
var
   Handle:HMENU;
   MenuItemInfo:TMenuItemInfo;
   Buffer: array[0..79] of char;
begin
   // Coger el handle del menu principal
   Handle := MainMenu.Handle;
 
   // Rellenar estructura
   FillChar (MenuItemInfo, SizeOf(TMenuItemInfo), 0);
   MenuItemInfo.cbSize := SizeOf(TMenuItemInfo);
   MenuItemInfo.fMask := MIIM_TYPE;
   MenuItemInfo.dwTypeData := Buffer;
   MenuItemInfo.cch := SizeOf(Buffer);
 
   // No se puede obtener la informacion del item del menú ?
   if not GetMenuItemInfo(Handle, Position, True, MenuItemInfo) then begin
    // salir
    Exit;
   end;
 
   // Modificar el tipo de menú para ponerlo a la derecha
   MenuItemInfo.fType := MenuItemInfo.fType or MF_RIGHTJUSTIFY;
 
   // No se puede establecer informacion del item de menú
   if not SetMenuItemInfo (Handle, Position, True, MenuItemInfo) then begin
     Exit;
   end;
end;

Puedes llamar a ésta funcioón de la siguiente forma:

1
2
3
4
5

// Para poner el tercer eleento y los siguientes:
MenuItemAtRight(Self.MainMenu1, 3);
// Para poner el último elemento:
MenuItemAtRight(Self.MainMenu1,
Windows.GetMenuItemCount(Self.MainMenu1.Handle)-1);
Categories: Delphi, Trucos Tags: , , ,

Ventana que no se pueda mover (teclado y ratón)

miércoles, 28 de noviembre de 2007 2 comentarios
Share Button

Con este truco se intenta mostrar cómo hacer que un formulario estandard de delphi no se pueda mover utilizando el menú de sistema que aparece en la parte izquierda superior del formulario, ni arrastrandolo utilizando el ratón sobre la ventana de tútilo.
No se impide que el formulario pueda redimensionarse, aunque capturando los mensajes adecuados también sería posible impedirlo.

Para ello definimos un procedimiento privado al formulario e interceptamos los mensajes adecuados (SC_MOVE y HTCAPTION)

Definimos el procedimiento en la parte privada:

1
2
3

private
   //: Definimos el prcedimiento para capturar el mensaje
   procedure _InternalNoMove(var Message: TWMChar); message WM_SYSCOMMAND;

En la implementración colocamos esto:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

//: Definimos el prcedimiento para capturar el mensaje
procedure TForm1._InternalNoMove (var Message: TWMChar);
begin
  // Mensajes que interceptamos...
  if (Message.Charcode = SC_MOVE or HTCAPTION) or
     (Message.Charcode = SC_MOVE) then begin
    // No hacemos nada || Nothing to do
 end
 else begin
   // Se deben procesar el resto de mensajes ||
   // Process messages  normally
   inherited;
 end;
end;

A partir de los sistemas Windows 2000 en adelante se puede utilizar el procedimiento GetLastInputInfo que se encuentra en la Unit Windows.pas y que puede utilizarse para calcular/obtener el tiempo total de inactividad a nivel de sistema (no de aplicación).
Con una simple llamada pueden obtenerse los segundos de inactividad.

1
2
3
4
5
6
7
8
9
10

// Devuelve los segundos de inactividad
// ejemplo vía "DelphiAbout"
function InactivitySystemSeconds(): DWord;
var
   liInfo: TLastInputInfo;
begin
   liInfo.cbSize := SizeOf(TLastInputInfo) ;
   GetLastInputInfo(liInfo) ;
   Result := (GetTickCount - liInfo.dwTime) DIV 1000;
end;
Categories: Delphi, Programación, Trucos Tags: , , ,

Acceder a las propiedades de un componente vía RTTI

jueves, 8 de noviembre de 2007 Sin comentarios
Share Button

Éste truco aparece debido a la necesidad de obtener vía RTTI la siguiente información: Lista de todas las propiedades de un componente.

Valor de una propiedad de un componente sin utilizar el método siguiente (*).
Una primera aproximación para obtener la propiedad (Left, por ejemplo) de un componente del que a priori no conocemos el tipo, es utilizar una estructura IF o CASE (método 1) similar a la siguiente:

1
2
3
4
5
6
7
8

// Metodo 1 (*)
// Segun el tipo de componente...
if (comp is TEdit) then
  Result := TEdit(comp).Left;
else if (comp is TLabel) then
  Result := TLabel(comp).Left;
else if (comp is TButton) then
  Result := TButton(comp).Left;

Está claro que éste método es poco eficiente, poco flexible (siempre podemos dejarnos algún tipo de componente) y poco ortodoxo.
¿Cómo debe hacerlo Delphi para mostrar las propiedades de un componente en el inspector de objetos (por ejemplo)?

La respuesta es RTTI. Se puede acceder a las propiedades de un componente (a partir de la clase) y del nombre de la propiedad, utilizando la siguiente función (he añadido un parámetro nuevo para obtener en la misma llamada la lista de todas las propiedades -TStrings-).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

{:Obtener la información de una propiedad a partir de la clase y el nombre;
Ademas devuelve la lista de todas las porpiedades de ese control.}
function GetRTTIControlInfo(AControl: TPersistent;
         propList:TStrings;  AProperty: string): PPropInfo;
var
   i: integer;
   props: PPropList;
   tData: PTypeData;
begin
   // Inicial
   Result := nil;
   // No asignado el control ==> Salimos
   if (AControl = nil) or (AControl.ClassInfo = nil) then begin
      Exit;
   end;
   // Obtener la información
   tData := GetTypeData(AControl.ClassInfo);
   // Tipo desconocido o sin propiedades ==> Salimos
   if (tData = nil) or (tData^.PropCount = 0) then
   	Exit;
    GetMem(props, tData^.PropCount * SizeOf(Pointer));
    try
   	GetPropInfos(AControl.ClassInfo, props);
 	for i := 0 to tData^.PropCount - 1 do begin
   		propList.Add(Props^[i]^.Name);
   		with Props^[i]^ do begin
    		  if (Name = AProperty) then begin
		   	result := Props^[i];
	   	  end;
   	        end;
   	end;
   finally
      FreeMem(props);
   end;
end;

Un ejemplo de utilización podría ser el siguiente:
(basta con un formulario que tenga un TButton y un TMemo)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

procedure TForm1.Button1Click(Sender: TObject);
var
  pInfo: PPropInfo;
  propList:TStrings;
  PStr:String;
begin
 // Crear la lista
 propList := TStringList.Create();
 // protección para liberar
 try
 
  // Acceder a la info de la propiedad
  pInfo := GetRTTIControlInfo(Button1, propList, 'Left');
  // La prop. encontrada es de tipo integer (debería ser, ya que es la
  // prop. Left)
  if (pInfo.PropType^^.Kind in [tkInteger]) then begin
    // Obtener
    PStr:= 'Left' + ' = ' + Format('%d', [GetOrdProp(Button1, pInfo)]);
    // Mostrar
    MessageDlg(PStr, mtInformation, [mbOK], 0);
  end;
  // Rellenar la lista de propiedades
  Memo1.Lines.Assign(propList);
 finally
    FreeAndNil(propList);
 end;
end;
Categories: Delphi, Trucos Tags: , , ,

Crear campos en una tabla (Access) por código, utilizando ADOX

jueves, 8 de noviembre de 2007 Sin comentarios
Share Button

En este ejemplo vamos a crear un par de campos de tipo String, una clave primaria y un campo de tipo entero y Autonumérico (Autoincremental) para probar las propiedades de ADOX:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

var
   Catalog : _Catalog;
   Table : _Table;
   BaseName : String;
   DS : String;
   col : _Column;
   key : _Key;
begin
   // Nombre de la Base de Datos
   BaseName := 'C:\Temp\MiBaseDatos.mdb';
   // Create a Catalog Object
   Catalog := CreateCOMObject(StringToGUID('ADOX.Catalog')) 
                  as  _Catalog;
   // Set the Connection String
   DS := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+BaseName;
   // Check if we already have such a file and delete it
   if FileExists(BaseName) Then begin
      DeleteFile(BaseName);
   end;
   // Create new Access database
   Catalog.Create(DS);
   // Create a Table Object
   Table := CreateCOMObject(StringToGUID('ADOX.Table')) as _Table;
   // Set the name of a table
   Table.Name := 'MiTabla';
   // Append Table into the base
   Catalog.Tables.Append(Table);
   // Now add two columns (fields) into the table
   // Both are Text fields up to 128 characters
   Table.Columns.Append('Nombre', adVarWChar, 128);
   Table.Columns.Append('Apellido', adVarWChar, 128);
   // Creamos el objeto columna para el autoIncremental
   col := CoColumn.Create;
   // BD a la que pertenece
   col.ParentCatalog := Catalog;
   col.Name := 'Auntoincremental';
   // Tipo del campo
   col.Type_ := adInteger;
   // Asignamos que es un AutoIncremental
   col.Properties['AutoIncrement'].Value := True;
   // Añadimos la columna
   Table.Columns.Append(col, adInteger, col.DefinedSize);
   // Columna para la clave primaria
   col := CoColumn.Create;
   // BD a la que pertenece
   col.ParentCatalog := Catalog;
   col.Name := 'ClavePrimaria';
   col.Type_ := adInteger;
   // Añadirla
   Table.Columns.Append(col, adInteger, col.DefinedSize);
   // Creamos la clave primaria
   Key := CoKey.Create;
   Key.Name := 'ClavePrimaria';
   Key.Type_ := adKeyPrimary;
   // Columna que forma parte de la PK
   Key.Columns.Append('ClavePrimaria', adInteger, 0 );
   // Añadirla a la tabla
   Table.Keys.Append(Key, 0, EmptyParam, Unassigned, Unassigned);

Primero se crea la tabla, posteriormente se crean los objetos columna (coColumn) y se modifican sus propiedades, para finalmente añadirlo a la tabla. Finalmente se crea el objeto coKey para definir la clave primaria, se añade la columna que la compone y este objeto se añade también a la tabla creada.

Categories: Delphi, Trucos Tags: , , , , ,

Eliminar los «saltos de línea» de un TStrings

viernes, 2 de noviembre de 2007 8 comentarios
Share Button

A veces es interesante poder acceder al contenido de un TStrings (de un TMemo, por ejemplo) como un único string o cadena.
Para eso, Delphi ha dotado a la clase TStrings del método Text, que devuelve el contenido del TStrings como una cadena simple. El inconveniente, es que dentro del resultado van incluídos los caractreres de «Salto de línea» y «Retorno de carro». ¿Cómo eliminarlos?

Con ésta sencilla función se pueden eliminar y/o susituir por otro caracter (espacio,…).

1
2
3
4
5
6
7
8
9
10

{:Elimina los saltos de línea (caracteres #10 y #13; salto de linea y salto
de carro) de un TStrings.}
function QuitarSaltosLinea(Strs: TStrings;  
                          CharReplace:String=STR_EMPTY):String;
var
   Str:string;
begin
   Str := AnsiReplaceStr(Strs.Text, #10, CharReplace);
   Result := AnsiReplaceStr(Str, #13, CharReplace);
end
Categories: Difícil, Trucos Tags: , , ,

Crear un fichero MDB (MS Access), por código

lunes, 8 de octubre de 2007 2 comentarios
Share Button

Para hacer ésto hay que importar primera la librería de ADO desde Delphi, que nos permita generar el fichero ADOX_TLB, que necesitamos para crear el fichero MDB.

Para importar la librería seguimos los pasos:

  1. Menu Project/Import Type Library.
  2. Buscar la librería: «Microsoft ADO Ext. 2.X for DDL and Security».
  3. Pulsa «Create Unit».

Una vez generador el fichero, utilizar el siguiente código:

const
  DATABASENAME = 'c:\temp\BaseDatosNueva.mdb';
var
  Catalog: _Catalog;
  ConnectionString:String;
begin
  // Create a Catalog Object
  Catalog := CreateCOMObject(StringToGUID('ADOX.Catalog')) as _Catalog;
  // Set the Connection String
  ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' +
                              'Data Source=' + DATABASENAME;
  try
    // Create new Access database
    Catalog.Create(ConnectionString);
  except
    on E:EOLEException do begin
      // Levantamos la excepción
      MessageDlg('Error al crear la Base de Datos; Mensaje:' +
      E.Message, mtError, [mbOK], 0);
    end;
  end;
Categories: Trucos Tags: , , ,

Desplegar por código el menú de sistema de una ventana

martes, 25 de septiembre de 2007 Sin comentarios
Share Button

Programar en cualquier componente que se desee que responda al click el siguiente código en el evento MouseDown.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

procedure TForm1.Image1MouseDown(Sender: TObject; 
                        Button: TMouseButton;
	                Shift: TShiftState; X, Y: Integer);
var
   h: HMENU;
   p:TPoint;
begin
  // El componente que llama deriva de TControl?
  if (Sender is TControl) then begin
    // Posicion del click
    p.X := x;
    p.Y := y;
    // Calculamos las coordenadas relativas
    P := Self.ScreenToClient(TControl(Sender).ClientToScreen(P));
    // Mostrar el menú
    h := GetSystemMenu(handle, false);
    TrackPopupMenu(h, TPM_LEFTALIGN or TPM_LEFTBUTTON,
    ClientOrigin.X + p.X ,
    ClientOrigin.Y + p.y, 0, handle, nil);
  end;
end;
Categories: Delphi, Trucos Tags: , , ,

Realizar un scroll horizontal en un DBGrid manualmente

jueves, 5 de julio de 2007 Sin comentarios
Share Button

Se puede realizar un scroll horizontal en un DBGrid (columna por columna) de forma nanual enviando los mensajes correspondientes al DbGrid. De forma similar se puede realizar scroll vertical pero utilizando el mensaje WM_HSCROLL.

1
2
3

// Mensaje de desplazamiento a la derecha
// (1 columna hacia la derecha)
SendMessage(DBGrid1.Handle, WM_HSCROLL, SB_PAGERIGHT, 0);

Se pueden utilizar otros valores para el mensaje como: SB_RIGHT, SB_LINEUP,… (Unit Messages.pas)

Categories: Delphi, Trucos Tags: , , ,

Seleccionar Shapes visualmente

lunes, 1 de enero de 2007 Sin comentarios
Share Button

La idea de éste ejemplo era realizar unas pruebas para simular en ejecución, la selección de objetos, como normalmente se hace en el IDE de Delphi; Hice pruebas con dos métodos de selección; Uno utilizando las típicas marcas que aparecen el los vértives de un componente y otro con una outline -linea en la parte exterior del control-.

Seleccionar shapes

Hay implementados dos tipos de selección; Una es modificando las propiedades del propieo control (en este caso el Borde de los TShapes -aunque con otros controles puede hacerse algo similar-) y la otra añadiendo una marcas en ejecución alrededor del Componente; Este segundo caso parece que podría ser más estandard si es necesario hacerlo con diferentes tipos de componentes.

Download Descargar ejemplo

Categories: Delphi, Ejemplos Tags: , ,