05 junio 2009

Los Hilos de Ejecución (3)

En la tercera parte de este artículo vamos a ver como establecer la prioridad en los hilos de ejecución así como controlar su comportamiento mediante objetos Event y Mutex.

LA PRIORIDAD EN LA EJECUCIÓN DE LOS HILOS

Aparte de poder controlar nosotros mismos la velocidad de hilo dentro del procedimiento Execute utilizando la función Sleep, GetTickCount o TimeGetTime también podemos establecer la prioridad que Windows le va a dar a nuestro hilo respecto al resto de aplicaciones.

Esto se hace utilizando la propiedad Priority que puede contener estos valores:

type
TThreadPriority = (
tpIdle, // El hilo sólo se ejecuta cuando el procesador está desocupado
tpLowest, // Prioridad más baja
tpLower, // Prioridad baja.
tpNormal, // Prioridad normal
tpHigher, // Prioridad alta
tpHighest, // Prioridad muy alta
tpTimeCritical // Obliga a ejecutarlo en tiempo real
);

No deberíamos abusar de las prioridades tpHigher, tpHighest y tpTimeCritical a menos que sea estrictamente necesario, ya que podían restar velocidad a otras tareas críticas de Windows (como nuestro querido Emule).

Vamos a ver un ejemplo en el que voy a crear tres hilos de ejecución que actualizarán cada uno una barra de progreso cada 100 milisegundos:


Esta sería la definición del hilo:

THilo = class(TThread)
Progreso: TProgressBar;
procedure Execute; override;
procedure ActualizarProgreso;
end;

Y su implementación:

{ THilo }

procedure THilo.ActualizarProgreso;
begin
Progreso.StepIt;
end;

procedure THilo.Execute;
begin
inherited;
FreeOnTerminate := True;
while not Terminated do
begin
Synchronize(ActualizarProgreso);
Sleep(100);
end;
end;

Su única misión es incrementar la barra de progreso que le toca y esperar 100 milisegundos. Al pulsar el botón Comenzar hacemos esto:

procedure TFTresHilos.BComenzarClick(Sender: TObject);
begin
Progreso1.Position := 0;
Progreso2.Position := 0;
Progreso3.Position := 0;
Hilo1 := THilo.Create(True);
Hilo2 := THilo.Create(True);
Hilo3 := THilo.Create(True);
Hilo1.Progreso := Progreso1;
Hilo2.Progreso := Progreso2;
Hilo3.Progreso := Progreso3;
Hilo1.Resume;
Hilo2.Resume;
Hilo3.Resume;
end;

Al ejecutarlo los tres hilos van exactamente iguales:


Pero ahora supongamos que hago esto antes de ejecutarlos:

Hilo1.Priority := tpTimeCritical;
Hilo2.Priority := tpLowest;
Hilo3.Priority := tpHighest;

Al ejecutarlo nos ponemos a navegar con Firefox o nuestro navegador preferido en páginas que den caña al procesador y al observar nuestros hilos veremos que se han desincronizado según su prioridad:


No es que sea una diferencia muy significativa pero a largo plazo se nota como Windows para repartiendo el trabajo. Esto puede venir muy bien para llamar a rutinas que procesen datos en segundo plano (tpIdle) o bien enviar comandos a máquinas conectadas al PC por puerto serie, paralelo o USB que necesiten ir como reloj suizo (tpTimeCritical).

CONTROLANDO LOS HILOS CON EVENTOS DE WINDOWS

Los hilos de ejecución también permiten comenzar su ejecución o detenerse dependiendo de un evento externo que o bien puede ser controlado por el hilo primario de nuestra aplicación o bien por otro hilo.

Los eventos son objetos definidos en la API de Windows que permiten tener dos estados: señalizados y no señalizados.

Para crear un evento se utiliza esta función de la API de Windows:

CreateEvent(
lpEventAttributes, // atributos de seguridad
bManualReset, // si está a True significa que nosotros nos encargamos de señalizarlo
bInitialState, // Señalizado o no señalizado
lpName // Nombre el evento
): THandle;

Los atributos de seguridad vienen definidos en la API de Windows (en C) del siguiente modo:

typedef struct _SECURITY_ATTRIBUTES {
DWORD nLength;
LPVOID lpSecurityDescriptor;
BOOL bInheritHandle;
} SECURITY_ATTRIBUTES;

Si le ponemos nil le asignará los atributos por defecto que tenemos como usuario en el sistema operativo Windows. Este parámetro sólo sirve para los sistemas operativos Windows NT, XP y Vista. En los Windows 9X no hará nada.

¿Para que podemos utilizar los eventos? Pues podemos crear uno que le diga a los hilos cuando deben comenzar, detenerse o esperar cierto tiempo. Hay que procurar que el nombre del evento (lpName) sea original para que no colisione con otro nombre de otra aplicación. Para averiguar si un evento ha producido un error podemos llamar a la función:

function GetLastError: DWord;

Si devuelve un cero es que todo ha ido bien. Los objetos Event también pueden ser creados sin nombre, enviando como último parámetro el valor nil.

Para crear un evento voy a crear una variable global en la implementación con el Handle del evento que vamos a crear:

implementation

var
Evento: THandle;

Antes de crear los hilos y ejecutarlos creo el evento señalizado:

procedure TFTresHilos.BComenzarClick(Sender: TObject);
begin
Evento := CreateEvent(nil, True, True, 'MiEvento');
...

Entonces modifico el procedimiento Execute para que haga cada ciclo si el evento está señalizado y si no es así, que espere indefinidamente:

procedure THilo.Execute;
begin
inherited;
FreeOnTerminate := True;
while not Terminated do
begin
Synchronize(ActualizarProgreso);
Sleep(100);
WaitForSingleObject(Evento, INFINITE);
end;
end;

La función WaitForSingleObject espera a que el evento que le pasamos como primer parámetro esté señalizado para seguir, en caso contrario seguirá esperando indefinidadamente (INFINITE). También podíamos haber hecho que esperara un segundo:

WaitForSingleObject(Evento, 1000);

Para señalizar o no los eventos he añadido al formulario dos componentes RadioButton:


Para señalizarlo llamo a la función SetEvent:

procedure TFTresHilos.SenalizadoClick(Sender: TObject);
begin
SetEvent(Evento);
end;

Y para no señalizarlo utilizo PulseEvent:

procedure TFTresHilos.NoSenalizadoClick(Sender: TObject);
begin
PulseEvent(Evento);
end;

Tenemos dos funciones para no señalizar un evento:

PulseEvent: no señaliza el evento inmediatamente.

ResetEvent: no señaliza el evento la próxima vez que pase por WaitForSingleObject.

Y lo mejor de todo esto que no sólo podemos activar y desactivar hilos de ejecución dentro de la misma aplicación sino que además podemos hacerlo entre distintas aplicaciones que se están ejecutando a la vez.

En mi ejemplo he abierto dos instancias de la misma aplicación y no he señalizado en la primera un evento, con lo que se han detenido las dos:


Esto nos da mucha potencia para sincronizar distintas aplicaciones simultáneamente.

LOS OBJETOS MUTEX

La API de Windows también nos trae otro tipo de objetos llamados Mutex, también conocidos como semáforos binarios que funcionan de manera similar a los eventos pero que además permite asignarles un dueño. La misión de los objetos Mutex es evitar que varios hilos accedan a la vez a los mismos recursos, al estilo del procedimiento Synchronize.

Al contrario de los objetos Event donde todos los hilos podían esperar o no al evento en cuestión, con los objetos Mutex podemos hacer que solo uno de los hilos pueda trabajar a la vez y que los otros se esperen hasta nuevo aviso. Lo veremos más claro con un ejemplo.

Para crear un objeto Mutex utilizamos esta función:

function CreateMutex(lpMutexAttributes, bInitialOwer, lpName);

Al igual que con los eventos, el parámetro lpMutexAttributes sirve para establecer los atributos de seguridad. El parámetro bInitialOwer que se encarga de decir si el hilo que llama a CreateMutex es el propietario de este Mutex o por el contrario si queremos que el primer hilo que espere al Mutex es el dueño del mismo.

En el ejemplo que vimos anteriormente con las tres barras de progreso, supongamos que cada vez que se incrementa la barra no queremos que las otras barran lo hagan también. Esto puede ser muy útil cuando hay varios hilos que intentan acceder al mismo recurso (grabar en CD-ROM, enviar señales por un puerto, etc.).

Al contrario del ejemplo de los eventos que me interesaba que se activaran o desactivaran todos a la vez, aquí con los Mutex me interesa que mientras a un hilo le toca trabajar, los otros hilos tienen que esperarse a que termine (100 ms).

Al igual que hice con el objeto Event voy a crear una variable global con el handle del Mutex:

implementation

var
Mutex: THandle;

Ahora creo el Mutex al pulsar el botón Comenzar:

procedure TFTresHilos.BComenzarClick(Sender: TObject);
begin
Mutex := CreateMutex(nil, True, 'Mutex1');
Progreso1.Position := 0;
Progreso2.Position := 0;
Progreso3.Position := 0;
Hilo1 := THilo.Create(True);
Hilo2 := THilo.Create(True);
Hilo3 := THilo.Create(True);
Hilo1.Progreso := Progreso1;
Hilo2.Progreso := Progreso2;
Hilo3.Progreso := Progreso3;
Hilo1.Resume;
Hilo2.Resume;
Hilo3.Resume;
ReleaseMutex(Mutex);
end;

Para que un hilo no se lance antes que otro cuando ejecuto Resume, lo que hago es que no suelto el Mutex hasta que los tres hilos están en ejecución (como en una carrera).

Después solo tengo que ir ejecutando cada uno haciendo esperar a los demás hasta que termine:

procedure THilo.Execute;
begin
inherited;
FreeOnTerminate := True;
while not Terminated do
begin
WaitForSingleObject(Mutex, INFINITE); // captura el mutex (los demás a esperar)
Synchronize(ActualizarProgreso);
Sleep(100);
ReleaseMutex(Mutex); // mutex liberado hasta que lo capture otro hilo
end;
end;

Entre las líneas WaitForSingleObject y ReleaseMutex, lo demás hilos quedan parados hasta que termine. De este modo creamos un cuello de botella que impide que varios hilos accedan simultáneamente a los mismos recursos.

Al ejecutarlo este es el resultado:


En la foto no se aprecia pero cuando se ve en movimiento vemos que van escalonados, de trozo en trozo en vez de píxel a píxel.

También podíamos haber creado dos objetos Mutex que hagan que un hilo no comience a ejecutarse hasta que otro hilo le active su Mutex correspondiente. Las combinaciones que se pueden hacer con Mutex y Event son infinitas.

En el próximo artículo veremos como crear variables de tipo ThreadVar y otros asuntos interesantes.

Pruebas realizadas en RAD Studio 2007.

22 mayo 2009

Los Hilos de Ejecución (2)

En el artículo anterior vimos un sencillo ejemplo de cómo crear un contador utilizando un hilo de ejecución, pero hay un pequeño inconveniente que tenemos que arreglar.

Dentro de un hilo de ejecución podemos actualizar la pantalla (los formularios y componentes) siempre y cuando la actualización sea muy esporádica y el trabajo a realizar sea muy rápido (entrar y salir). Pero si durante el evento Execute de un hilo intentamos dibujar o actualizar los componentes VCL más de lo normal, puede provocar una excepción de este tipo:


También suele ocurrir si dos hilos ejecutándose en paralelo intentan actualizar el mismo componente VCL.

Esto se debe a que la librería VCL no ha sido diseñada para trabajar con problemas de concurrencia en múltiples hilos de ejecución.

SINCRONIZANDO CÓDIGO ENTRE HILOS

Para evitar este problema vamos a utilizar el procedimiento Synchronice que permite que un hilo llame a un procedimiento definido dentro del mismo pero en el contexto del hilo primario, es decir, el hilo principal de nuestro programa ejecuta el procedimiento que el hilo le manda como parámetro utilizando Synchronice. Es como si el hilo le dijera al hilo principal: ejecútame esto que a mi me da la risa.

De este modo ya podemos manipular los componentes VCL sin preocupación.

Modificamos la definición de la clase:

type
TContador = class(TThread)
dwTiempo: DWord;
iSegundos: Integer;
Etiqueta: TLabel;
constructor Create; reintroduce; overload;
procedure Execute; override;
procedure ActualizarPantalla;
end;

Y la implementación de ActualizarPantalla es la siguiente:

procedure TContador.ActualizarPantalla;
begin
Etiqueta.Caption := IntToStr(iSegundos);
end;

Entonces sólo hay que sincronizar el hilo con la VCL en el procedimiento Execute:

procedure TContador.Execute;
begin
inherited;
OnTerminate := Terminar;

// Contamos hasta 10 segundos
while (iSegundos < 10) and not Terminated do
begin
// ¿Han pasado 1000 milisegundos?
if GetTickCount - dwTiempo > 1000 then
begin
// Incrementamos el contador de segundos y
// actualizamos la etiqueta
Inc(iSegundos);
Synchronize(ActualizarPantalla);
dwTiempo := GetTickCount;
end;
end;
end;

Llamamos al procedimiento ActualizarPantalla utilizando Synchronize. Y no sólo podemos utilizar este método para sincronizarnos con los componentes VCL sino que también con variables globales.

Ahora vamos otro caso de dos hilos incrementando paralelamente una misma variable que hace de contador. Tenemos este formulario:

Tenemos dos listas (TListBox) que nos van a mostrar el valor de la variable global i que van a incrementar dos hilos a la vez cuya clase es la siguiente:

type
THilo = class(TThread)
Lista: TListBox;
procedure Execute; override;
procedure MostrarContador;
end;

Y esta sería su implementación:

{ THilo }

procedure THilo.Execute;
begin
inherited;
FreeOnTerminate := True;
while not Terminated do
begin
i := i + 1;
Synchronize(MostrarContador);
Sleep(1000);
end;
end;

El procedimiento Execute incrementa la variable entera global i, la muestra por pantalla en su lista correspondiente y espera un segundo. Luego tenemos el procedimiento que muestra el valor de la variable i según el hilo:

procedure THilo.MostrarContador;
begin
Lista.Items.Add('i='+IntToStr(i));
end;

Cuando pulsemos el botón Comenzar, ponemos el contador i a cero, creamos los dos hilos, les asignamos su lista correspondiente y los ponemos en marcha:

procedure TFDosHilos.BComenzarClick(Sender: TObject);
begin
i := 0;
Hilo1 := THilo.Create(False);
Hilo2 := THilo.Create(False);
Hilo1.Lista := Lista1;
Hilo2.Lista := Lista2;
Hilo1.Resume;
Hilo2.Resume;
end;

En cualquier momento podemos detener la ejecución de ambos hilos pulsando el botón Detener:

procedure TFDosHilos.BDetenerClick(Sender: TObject);
begin
Hilo1.Terminate;
Hilo2.Terminate;
end;

Al ejecutarlo conforme está ahora mismo este sería el resultado:


Aquí hay algo que no encaja. Si los dos hilos incrementan una vez la variable i sólo deberían verse números pares o todo caso el valor de un hilo debería ser distinto al del otro, pero eso es lo que pasa cuando no van sincronizados los incrementos de la variable i.

Sin tocar el código fuente, vuelvo a ejecutar el programa y me da este otro resultado:


¿Qué está pasando? Pues que el hilo 2 puede incrementar la variable i justo después de que la incremente el hilo 1 o bien pueden hacerlo los dos a la vez, provocando un retraso en el contador.

Esto podemos solucionarlo sincronizando el incremento de la variable i dentro de un nuevo procedimiento que podemos añadir a la clase THilo:

THilo = class(TThread)
Lista: TListBox;
procedure Execute; override;
procedure MostrarContador;
procedure IncrementarContador;
end;

El procedimiento IncrementarContador sólo hace esto:

procedure THilo.IncrementarContador;
begin
i := i + 1;
end;

Luego hacemos que el procedimiento Execute sincronice el incremento de la variable i:

procedure THilo.Execute;
begin
inherited;
FreeOnTerminate := True;
while not Terminated do
begin
Synchronize(IncrementarContador);
Synchronize(MostrarContador);
Sleep(1000);
end;
end;

Este sería el resultado al ejecutarlo:


Vemos ahora que los incrementos de la variable i son de dos en dos y evitamos que un hilo estropee el incremento de otro. Aunque esto no soluciona a la perfección la sincronización ya que si por ejemplo tenemos otra aplicación (como el navegador Firefox) que ralentiza el funcionamiento de Windows, podría provocar que se relentice uno de los hilos respecto al otro y provoque de nuevo la descoordinación en los incrementos. Eso veremos como solucionarlo en el siguiente artículo mediante semáforos y eventos.

PARAR, REANUDAR, DETENER O ESPERAR LA EJECUCIÓN DEL HILO

Siguiendo con el primer ejemplo (la clase TContador), una vez el hilo está en marcha podemos suspenderlo (manteniendo su estado) utilizando el método Suspend:

Contador.Suspend;

Para que continúe sólo hay que volver a llamar al procedimiento Resume:

Contador.Resume;

En cualquier momento podemos saber si está suspendido el hilo mediante la propiedad:

if contador.Suspended then
...

Si queremos detener definitivamente la ejecución del hilo entonces deberíamos añadirle al bucle principal de nuestro procedimiento Execute esta comprobación:

// Contamos hasta 10 segundos
while (iSegundos < 10) and not Terminated do
begin
...

Entonces podíamos añadir al formulario un botón llamado Detener que al pulsarlo haga esto:

Contador.Terminate;

Lo que hace realmente el procedimiento Terminate no es terminar el hilo de ejecución, sino poner la propiedad Terminated a True para que nosotros salgamos lo antes posible del bucle infinito en el que está sumergido nuestro hilo. Lo que nunca hay que intentar es hacer esto para terminar un hilo:

Contador.Free;

Lo que es terminar, seguro que termina, pero la explosión la tenemos asegurada. Para cerrar el hilo inmediatamente podemos llamar a una función de la API de Windows llamada TerminateThread:

TerminateThread(Contador.Handle, 0);

El primer parámetro es el Handle del hilo que queremos detener y el según parámetro es el código de salida que puede ser leído posteriormente por la función GetExitCodeThread. Recomiendo no utilizar la función TerminateThread a menos que sea estrictamente necesario. Es mejor utilizar el procedimiento Terminate y procurar salir limpiamente del bucle del hilo cerrando los asuntos que tengamos a medio (cerrando ficheros abiertos, liberando memoria de objetos creados, etc.).

Por otro lado tenemos el procedimiento DoTerminate que no termina el hilo de ejecución, sino que provoca el evento OnTerminate en el cual podemos colocar todo lo que necesitamos para terminar nuestro hilo. Por ejemplo, podemos poner al comienzo de nuestro procedimiento Execute:

procedure TContador.Execute;
begin
inherited;
OnTerminate := Terminar;
...

Y luego definimos dentro de nuestra clase TContador el evento Terminar:

procedure TContador.Terminar(Sender: TObject);
begin
// Escribimos aquí el código que necesitamos
// para liberar los recursos del hilo y luego
// le mandamos una señal para que termine el bucle principal
Terminate;
end;

También podemos hacer que el hilo principal de la aplicación espere a que termine la ejecución de un hilo antes de seguir ejecutando código. Esto se consigue con el procedimiento WaitFor:

Contador.WaitFor;

Aunque esto puede ser algo peligroso porque no permite que Windows procese los mensajes de nuestra ventana. Podría utilizarse por ejemplo para ejecutar un programa externo (de MSDOS) y esperar a que termine su ejecución.

En el siguiente artículo veremos como podemos controlar las esperas entre el hilo principal y los hilos secundarios para que se coordinen en sus trabajos.

Pruebas realizadas en RAD Studio 2007.

08 mayo 2009

Los Hilos de Ejecución (1)

Hace tiempo escribí un pequeño post sobre como crear hilos de ejecución:

Cómo crear un hilo de ejecución

Pero debido a que últimamente los procesadores multinúcleo van tomando más relevancia y que algunos lectores de este blog han pedido que me extienda en el tema, voy a meterme de lleno en el apasionante y peligroso mundo de las aplicaciones multihilo.

Cuando manejamos Windows creemos que es un sistema operativo robusto que puede ejecutar gran cantidad de tareas a la vez. Eso es lo que parece externamente, pero realmente sólo tiene dos hilos de ejecución en los últimos procesadores de doble núcleo. Y en procesadores Pentium 4 e inferiores sólo contiene un solo hilo de ejecución (dos mediante el disimulado HyperThreading que tantos problemas nos dio con Interbase 6).

Entonces, ¿Cómo puede ejecutar varias tareas a la vez? (Emule, Bittorrent, MSN, reproductor multimedia, etc.). Primero tenemos que ver lo que significa un proceso.

LOS PROCESOS

Un proceso (un programa EXE o un servicio de Windows) contiene como mínimo un hilo, llamado hilo primario. Si queremos que nuestro proceso tenga más hilos, se lo tenemos que pedir al sistema operativo. Estos nuevos hilos pueden ejecutarse paralelamente al hilo primario y ser independientes.

Un proceso se compone principalmente de estas tres áreas:

AREA DE CÓDIGO: Es una zona de memoria de sólo lectura donde está compilado nuestro programa en código objeto (binario).

HEAP (MONTÓN): Es en esta zona de memoria de lectura/escritura donde se suelen guardar las variables globales que creamos así como las instancias de los objetos que se van creando en memoria.

PILA: Aquí se guardan temporalmente los parámetros que se pasan entre funciones así como las direcciones de llamada y retorno de procedimientos y funciones. Todos los datos que se introducen en la pila tienen que salir mediante el método LIFO (lo último que entra es lo primero que tiene que salir) porque si no provoca un desbordamiento del puntero del procesador que hace que retorne a otra zona de memoria provocando el error Access Violation 000000 o FFFFFF, es decir, intenta salirse del segmento de memoria de nuestra aplicación.

Estas tres zonas se encuentran herméticamente separadas las unas de las otras y si por error un comando de nuestro programa intenta acceder fuera del heap o de la pila provocará el conocido mensaje que tanto nos gusta: Access Violation. Suele ocurrir al intentar acceder a un objeto que no ha sido creado en el heap (dirección 000000 = nil), etc.

El conjunto de estas tres zonas de memoria es el proceso. Ahora bien, si creamos un nuevo hilo de ejecución dentro del proceso, éste tendrá su propia pila, aunque compartirá la misma zona de datos (heap).

EL PROCESO MULTITAREA

Windows realiza la multitarea cediendo un pequeño tiempo de procesador a cada proceso, de modo que en un solo segundo pueden ejecutarse ciertos de procesos simultáneos. Para los viejos roqueros que estudiamos ensamblador vimos que antes de cambiar de tarea Windows guarda el estado de todos los registros en la pila:

PUSH EAX
PUSH EBX
...

Para luego restaurarlos y seguir su marcha:

...
POP EBX
POP EAX

No está de más adquirir unos pequeños conocimientos de ensamblados de x86 para conocer a fondo las tripas de la máquina.

Cuando Windows para el control de un proceso, memoriza el estado de los registros del procesador y la pila y pasa al siguiente proceso hasta que finalice su tiempo. Realmente, este cambio de procesos no lo realiza Windows, sino el mismo procesador que trae esta característica por hardware (desde el 80386. Hasta el procesador 80286 tenía este modo multitarea aunque sólo en 16 bits).

Pero lo que vamos a ver es este artículo es un cambio de ejecución entre hilos del mismo proceso, algo que consume muchos menos recursos que el cambio entre procesos.

Por ejemplo, los navegadores webs modernos actuales como Firefox o Chrome ejecutan cada web dentro del mismo proceso pero en hilos diferentes (incluso Chrome lo hace en distintos procesos), de modo que si una página web se queda colgada no afecta a otra situada en la siguiente pestaña (lo que no se es si llamarán al sistema de hilos de Windows y tendrán su propio núcleo duro de ejecución, su propio sistema multitarea).

Pero programar hilos de ejecución no está exento de problemas. ¿Qué pasaría si dos hilos acceden a la vez a la misma variable de memoria? O peor aún, ¿Y si intentan escribir a la vez en una unidad de CD-ROM? Las excepciones que pueden ocurrir pueden ser catastróficas, aunque afortunadamente a partir de Windows NT y XP se controlan muy bien todos estos problemas de concurrencia.

Lo que si es realmente difícil es intentar depurar dos hilos de ejecución que utilizan los mismos recursos del proceso. De ahí a que sólo hay que recurrir a los hilos en casos estrictamente necesarios.

LA CLASE TTHREAD

Toda la complejidad de los hilos de ejecución que se programan en la API de Windows quedan encapsulados en Delphi en esta sencilla clase. Para crear un hilo de ejecución basta heredar de la clase TThread y sobrecargar el método Execute:

type
THilo = class(TThread)
procedure Execute; override;
end;

En la implementación del procedimiento Execute es donde hay que introducir el código que queremos ejecutar cuando arranque nuestro hilo de ejecución:

{ THilo }

procedure THilo.Execute;
begin
inherited;

end;

Veamos un ejemplo sencillo de un hilo de ejecución con un contador de 10 segundos.

CREANDO UN CONTADOR DE SEGUNDOS

Voy a crear un nuevo proyecto con un formulario en el que sólo va a haber una etiqueta (TLabel) llamada EContador con el contador de segundos:


A este formulario lo he llamado FPrincipal. En la interfaz del mismo voy a definir la clase TContador que va a heredar de un hilo TThread:

type
TContador = class(TThread)
dwTiempo: DWord;
iSegundos: Integer;
Etiqueta: TLabel;
constructor Create; reintroduce; overload;
procedure Execute; override;
end;

He sobrecargado el constructor para que inicialice mis contadores de tiempo y segundos:

constructor TContador.Create;
begin
inherited Create(True); // llamamos al constructor del padre (TThread)
dwTiempo := GetTickCount;
iSegundos := 0;
end;

La función GetTickCount nos devuelve un número entero que representa el número de milisegundos que han pasado desde que encendimos nuestro PC. Si queréis más precisión podéis utilizar la función TimeGetTime declarada en la unidad MMSystem (sobre todo si vais a programar videojuegos).

Siguiendo con la implementación de nuestra clase TContador, la variable dwTiempo la voy a utilizar para controlar el número de milisegundos que van pasando desde que ejecutamos el hilo. Y la variable iSegundos es un contador de segundos de 0 a 10. También he añadido una referencia a una Etiqueta de tipo TLabel que se la daremos al crear una instancia del hilo en el evento OnCreate del formulario principal:

procedure TFPrincipal.FormCreate(Sender: TObject);
begin
Contador := TContador.Create(True);
Contador.Etiqueta := EContador;
Contador.FreeOnTerminate := True;
Contador.Resume;
end;

Después de crear el hilo le pasamos la etiqueta que tiene que actualizar y le decimos mediante la propiedad FreeOnTerminate que se libere de memoria automáticamente al terminar la ejecución del hilo.

Después llamamos al método Resume que lo que hace internamente es ejecutar el procedimiento Execute de la clase TThread que tendrá este código:

procedure TContador.Execute;
begin
inherited;

// Contamos hasta 10 segundos
while iSegundos < 10 do
// ¿Han pasado 1000 milisegundos?
if GetTickCount - dwTiempo > 1000 then
begin
// Incrementamos el contador de segundos y actualizamos la etiqueta
Inc(iSegundos);
Etiqueta.Caption := IntToStr(iSegundos);
dwTiempo := GetTickCount;
end;
end;

Creamos un bucle cerrado que va contando de 1000 en 1000 milisegundos e incrementando el contador de segundos. Cuando se salga de este bucle se terminará la ejecución del hilo automáticamente. También se podía haber utilizado procedimiento Sleep, pero nunca me ha gustado mucho esta función porque miestras se está ejecutando no podemos hacer absolutamente nada.

Eso ocurrirá al ejecutar el programa y cuando llegue el contador a 10:


Podemos ver como va la ejecución del hilo en la ventana inferior de Delphi si estamos ejecutando el programa en modo depuración:


Como puede verse en las líneas en rojo, el hilo que hemos creado tiene el ID 3736 que no tiene nada que ver con el hilo primario:


En el siguiente artículo seguiremos profundizando un poco más en los hilos de ejecución a través de otros ejemplos.

Pruebas realizadas en RAD Studio 2007.

17 abril 2009

Crea tu propio editor de informes (y V)

Voy a cerrar esta serie de artículos dedicada a la creación de nuestro propio editor de informes añadiendo la posibilidad de guardar y cargar los informes que hemos diseñado.

Hay diversas maneras de poder hacerlo: en bases de datos, en archivos de texto, en archivos binarios (con records) y también en XML.

Voy a elegir el lenguaje XML porque es más flexible para futuras ampliaciones.

GUARDANDO TODO EL INFORME EN XML

Para poder guardar y cargar informes necesitamos añadir en el formulario principal el componente de la clase TXMLDocument que se encuentra en la sección Internet:


Le vamos a poner de nombre XML para simplificar y ponemos su propiedad Active a True. También vamos a necesitar el componente TSaveDialog que se encuentra en la sección Dialogs. A este componente lo he llamado GuardarXML.

Vamos a ver en partes como sería guardar todo el documento en XML. Lo primero que hago es comprobar si hay algún informe abierto (una ventana hija MDI de la clase TFInforme) y si no es así saco una advertencia:

procedure TFPrincipal.GuardarComoClick(Sender: TObject);
var
NInforme, NConfig, NBanda, NComponente: IXMLNode; // nodos del XML
FBuscaInforme: TFInforme;
i, j: Integer;
Banda: TQRBand;
Etiqueta: TQRLabel;
Figura: TQRShape;
Campo: TQRDBText;
begin
if ActiveMDIChild is TFInforme then
FBuscaInforme := ActiveMDIChild as TFInforme
else
begin
Application.MessageBox('No hay ningún informe para guardar.',
'Proceso cancelado', MB_ICONSTOP);
Exit;
end;

Después limpio todo el componente XML (por si grabamos por segunda vez) y creo un primer nodo llamado Informe del que van a colgar todos los demás. También guardo un nodo de configuración donde meto la conexión a la base de datos y la tabla:

XML.ChildNodes.Clear;

// Creamos el nodo principal
NInforme := XML.AddChild('Informe');

// Añadimos el nodo de configuración
NConfig := NInforme.AddChild('Configuracion');
NConfig.Attributes['BaseDatos'] := FBuscaInforme.BaseDatos.DatabaseName;
NConfig.Attributes['Tabla'] := FBuscaInforme.Tabla.TableName;

Ahora viene la parte más pesada de este procedimiento. Tengo que recorrer todos los componentes del informe en busca de una banda y cuando la encuentra la grabo en el XML:

// Recorremos todos los componentes del informe y los vamos guardando
for i := 0 to FBuscaInforme.Informe.ComponentCount-1 do
begin
// ¿Hemos encontrado una banda?
if FBuscaInforme.Informe.Components[i] is TQRBand then
begin
Banda := FBuscaInforme.Informe.Components[i] as TQRBand;
NBanda := NInforme.AddChild('Banda');
NBanda.Text := Banda.Name;
NBanda.Attributes['Alto'] := Banda.Height;
NBanda.Attributes['Tipo'] := Ord(Banda.BandType);

Después vuelvo a recorrer con otro bucle todos los componentes pertenecientes a esa banda y los voy guardando:

// Recorremos todos los componentes de la banda
for j := 0 to Banda.ComponentCount-1 do
begin
// ¿Es una etiqueta?
if Banda.Components[j] is TQRLabel then
begin
Etiqueta := Banda.Components[j] as TQRLabel;
NComponente := NBanda.AddChild('Etiqueta');
NComponente.Attributes['Nombre'] := Etiqueta.Name;
NComponente.Attributes['ID'] := Etiqueta.Tag;
NComponente.Attributes['x'] := Etiqueta.Left;
NComponente.Attributes['y'] := Etiqueta.Top;
NComponente.Attributes['Ancho'] := Etiqueta.Width;
NComponente.Attributes['Alto'] := Etiqueta.Height;
NComponente.Attributes['Texto'] := Etiqueta.Caption;
end;

// ¿Es una figura?
if Banda.Components[j] is TQRShape then
begin
Figura := Banda.Components[j] as TQRShape;
NComponente := NBanda.AddChild('Figura');
NComponente.Attributes['Nombre'] := Figura.Name;
NComponente.Attributes['ID'] := Figura.Tag;
NComponente.Attributes['x'] := Figura.Left;
NComponente.Attributes['y'] := Figura.Top;
NComponente.Attributes['Ancho'] := Figura.Width;
NComponente.Attributes['Alto'] := Figura.Height;
end;

// ¿Es un campo?
if Banda.Components[j] is TQRDBText then
begin
Campo := Banda.Components[j] as TQRDBText;
NComponente := NBanda.AddChild('Campo');
NComponente.Attributes['Nombre'] := Campo.Name;
NComponente.Attributes['ID'] := Campo.Tag;
NComponente.Attributes['x'] := Campo.Left;
NComponente.Attributes['y'] := Campo.Top;
NComponente.Attributes['Ancho'] := Campo.Width;
NComponente.Attributes['Alto'] := Campo.Height;
NComponente.Attributes['Campo'] := Campo.DataField;
end;
end;
end;
end;

Cuando termine vuelco todo el XML a un archivo preguntándole el nombre al usuario:

if GuardarXML.Execute then
XML.SaveToFile(GuardarXML.FileName);

Así quedaría después de guardarlo:


Como puede apreciarse en la imagen (hacer clic para ampliar), la libertad que nos da un archivo XML para guardar una información jerárquica es mucho más flexible que con cualquier otro tipo de archivo.

CARGARDO EL INFORME DESDE UN ARCHIVO XML

Para cargar el informe vamos a necesitar el componente TOpenDialog en el formulario principal y que llamaremos AbrirXML. Veamos paso a paso el proceso de carga.

Abrimos el documento XML y comenzamos a recorrer todos los nodos en busca del archivo de configuración:

procedure TFPrincipal.AbrirClick(Sender: TObject);
var
FNuevoInforme: TFInforme;
i, j: Integer;
NBanda, NComponente: IXMLNode; // nodos del XML
Etiqueta: TQRLabel;
Figura: TQRShape;
Campo: TQRDBText;
begin
if not AbrirXML.Execute then
Exit;

XML.LoadFromFile(AbrirXML.FileName);

// Creamos un nuevo informe
FNuevoInforme := TFInforme.Create(Self);

// Recorremos todos los nodos del XML
for i := 0 to XML.ChildNodes[0].ChildNodes.Count-1 do
begin
// ¿Es el archivo de configuración?
if XML.ChildNodes[0].ChildNodes[i].NodeName = 'Configuracion' then
begin
FNuevoInforme.BaseDatos.DatabaseName :=
XML.ChildNodes[0].ChildNodes[i].Attributes['BaseDatos'];

FNuevoInforme.Tabla.TableName :=
XML.ChildNodes[0].ChildNodes[i].Attributes['Tabla'];
end;

He creado el formulario hijo FNuevoInforme de la clase TFInforme para ir creando en tiempo real los componentes que vamos leyendo del XML. Como podéis ver en el código, parto directamente del primer nodo XML.ChildNodes[0] ya que se con seguridad que el primero nodo se llama Informe y que todo lo demás cuelga del mismo.

Después vamos en busca de la banda y la creamos:

// ¿Es una banda?
if XML.ChildNodes[0].ChildNodes[i].NodeName = 'Banda' then
begin
NBanda := XML.ChildNodes[0].ChildNodes[i];
FNuevoInforme.BandaActual := TQRBand.Create(FNuevoInforme.Informe);

with FNuevoInforme.BandaActual do
begin
Parent := FNuevoInforme.Informe;
Height := NBanda.Attributes['Alto'];
BandType := NBanda.Attributes['Tipo'];
end;

Luego voy recorriendo todos los componentes de la banda y los voy metiendo en el informe con sus respectivas propiedades:

// Recorremos todos sus componentes
for j := 0 to NBanda.ChildNodes.Count-1 do
begin
// ¿Es una etiqueta?
if NBanda.ChildNodes[j].NodeName = 'Etiqueta' then
begin
NComponente := NBanda.ChildNodes[j];
Etiqueta := TQRLabel.Create(FNuevoInforme.BandaActual);
Etiqueta.Parent := FNuevoInforme.BandaActual;
Etiqueta.Name := NComponente.Attributes['Nombre'];
Etiqueta.Tag := NComponente.Attributes['ID'];
Etiqueta.Left := NComponente.Attributes['x'];
Etiqueta.Top := NComponente.Attributes['y'];
Etiqueta.Width := NComponente.Attributes['Ancho'];
Etiqueta.Height := NComponente.Attributes['Alto'];
Etiqueta.Caption := NComponente.Attributes['Texto'];
end;

// ¿Es una figura?
if NBanda.ChildNodes[j].NodeName = 'Figura' then
begin
NComponente := NBanda.ChildNodes[j];
Figura := TQRShape.Create(FNuevoInforme.BandaActual);
Figura.Parent := FNuevoInforme.BandaActual;
Figura.Name := NComponente.Attributes['Nombre'];
Figura.Tag := NComponente.Attributes['ID'];
Figura.Left := NComponente.Attributes['x'];
Figura.Top := NComponente.Attributes['y'];
Figura.Width := NComponente.Attributes['Ancho'];
Figura.Height := NComponente.Attributes['Alto'];
end;

// ¿Es una campo?
if NBanda.ChildNodes[j].NodeName = 'Campo' then
begin
NComponente := NBanda.ChildNodes[j];
Campo := TQRDBText.Create(FNuevoInforme.BandaActual);
Campo.Autosize := False;
Campo.Parent := FNuevoInforme.BandaActual;
Campo.Tag := NComponente.Attributes['ID'];
Campo.DataField := NComponente.Attributes['Campo'];
Campo.Left := NComponente.Attributes['x'];
Campo.Top := NComponente.Attributes['y'];
Campo.Width := NComponente.Attributes['Ancho'];
Campo.Height := NComponente.Attributes['Alto'];
Campo.Name := NComponente.Attributes['Nombre'];

if Campo.DataField <> '' then
Campo.Caption := Campo.DataField
else
Campo.Caption := NComponente.Attributes['Nombre'];

Campo.DataSet := FNuevoInforme.Tabla;
end;
end;
end;
end;

Por último, seleccionamos la banda actual:

FNuevoInforme.SeleccionarBandaActual;

Al final tiene que quedarse igual que el informe original:


Me gustaría haber dejado el editor algo más pulido con características tales como la opción de Guardar (creando un procedimiento común para Guardar y Guardar como), poder seleccionar el tipo de banda, o añadir otros componentes de QuickReport. Pero por falta de tiempo no ha podido ser.

De todas formas, creo que con este material podéis ver lo duro que tiene que ser crear un editor de informes profesional y si alguien se anima a continuar a partir de aquí pues mucha suerte y paciencia. Lo que más se aprende con estos temas es a manipular componentes VCL en tiempo real y a crear nuestro propio editor visual.

DESCARGAR EL PROYECTO

Rapidshare:

http://rapidshare.com/files/223134561/EditorInformes5Final_DelphiAlLimite.zip.html

Megaupload:

http://www.megaupload.com/?d=3MUEMUUD



Pruebas realizadas en RAD Studio 2007.

03 abril 2009

Crea tu propio editor de informes (IV)

En el artículo de hoy voy a añadir al editor la funcionalidad de añadir conectarse a una base de datos Interbase/Firebird para añadir los campos de las tablas.

AÑADIENDO MÁS COMPONENTES AL INFORME

Para poder conectar con la base de datos necesitamos añadir tres componentes al formulario FInforme:

1º Un componente TIBDatabase que se encuentra en la sección Interbase y que vamos a llamar BaseDatos:


Modificamos su propiedad LoginPrompt a False y no hay que olvidarse de darle el usuario SYSDBA y la contraseña masterkey al hacer doble clic sobre el mismo.

2º Un componente TIBTransaction que también se encuentra en Interbase y le ponemos el nombre Transaccion:


También debemos vincular la transacción a la base de datos mediante la propiedad DefaultTransaction.

3º Y un componente de la clase TIBTable para traernos los campos de la tabla al hacer la vista previa.

CREANDO EL FORMULARIO DE CONFIGURACION

Creamos un nuevo formulario llamado FConfiguracion con lo siguiente:


Es un formulario de tipo diálogo que contiene una etiqueta, un componente TEdit llamado Ruta y un botón llamado BExaminar que al pulsarlo utiliza al componente TOpenDialog para elegir una base de datos local:

procedure TFConfiguracion.BExaminarClick(Sender: TObject);
begin
Abrir.Filter := 'Interbase/Firebird|*.gdb;*.fdb';

if Abrir.Execute then
Ruta.Text := Abrir.FileName;
end;

Si la base de datos fuera remota el botón Examinar no sirve de nada ya que la ruta sería una unidad real del servidor.

Para poder realizar un test de la conexión lo que hacemos es pasarle a este formulario la base de datos con la que vamos a conectar. Para ello creamos esta variable pública:

public
{ Public declarations }
BaseDatos: TIBDatabase;

Para poder compilar este componente debemos añadir a la sección uses la unidad IBDatabase. Entonces en el botón de comprobar la conexión hacemos esto:

procedure TFConfiguracion.BConectarClick(Sender: TObject);
begin
if BaseDatos.Connected then
BaseDatos.Close;

BaseDatos.DatabaseName := IP.Text + ':' + Ruta.Text;

try
BaseDatos.Open;
except
raise;
end;

Application.MessageBox( 'Conexión realizada correctamente.',
'Conectado', MB_ICONINFORMATION );
end;

Ahora nos vamos al formulario FInforme y añadimos una nueva opción al menú contextual:


Al pinchar sobre esta opción abrimos el formulario de configuración:

procedure TFInforme.ConfiguracionClick(Sender: TObject);
begin
Application.CreateForm( TFConfiguracion, FConfiguracion );
FConfiguracion.BaseDatos := BaseDatos;
FConfiguracion.ShowModal;
end;

Una vez conectados a la base de datos ya podemos crear añadir campos de bases de datos TQRDBText.

AÑADIENDO LOS COMPONENTES TDBTEXT

Aquí no voy a enrollarme mucho ya que el modo insertar los campos TQRDBText va a ser el mismo que he utilizado para los componentes TQRLabel o TQRShape.

Lo primero que he hecho es añadir la opción Campo a nuestro menú contextual:


Cuya implementación es la siguiente:

procedure TFInforme.CampoClick(Sender: TObject);
begin
if BandaActual = nil then
begin
Application.MessageBox( 'Debe crear una banda.',
'Acceso denegado', MB_ICONSTOP );
Exit;
end;

QuitarSeleccionados;
with TQRDBText.Create(BandaActual) do
begin
Parent := BandaActual;
Left := 10;
Top := 10;
Inc(UltimoID);
Tag := UltimoID;
Caption := 'Campo' + IntToStr(UltimoID);
Name := Caption;
end;
end;

Después he modificado el procedimiento SeleccionarComponente:

procedure TFInforme.SeleccionarComponente;

...

// ¿Ha pinchado una etiqueta, una figura o un campo?
if (Seleccionado is TQRLabel) or (Seleccionado is TQRShape) or
(Seleccionado is TQRDBText) then

...


Luego he modificado el procedimiento MoverRatonPulsado:

procedure TFInforme.MoverRatonPulsado;

...

// ¿Estamos moviendo una etiqueta, una figura o un campo?
if (Seleccionado is TQRLabel) or (Seleccionado is TQRShape) or
(Seleccionado is TQRDBText) then
begin

...

También he ampliado los procedimientos ComprobarSeleccionComponentes, MoverOtrosSeleccionados, AmpliarComponenes, etc., es decir, en todo lo referente a la selección y movimiento de componentes (ya lo veréis en el proyecto).

CONFIGURANDO LA TABLA Y EL CAMPO

Una vez insertados los campos en el informe debemos dar la posibilidad al usuario de especificar el nombre del campo y de la tabla al que pertenece. Para ello voy a crear un nuevo formulario llamado FCampo con lo siguiente:


Para poder traernos los campos y tablas de la base de datos le he creado estas tres variables públicas:

public
{ Public declarations }
Campo: TQRDBText;
Tabla: TIBTable;
BaseDatos: TIBDatabase;

Estas variables nos las va a pasar el formulario FInforme cuando el usuario haga clic sobre un campo con la tecla SHIFT pulsada. He intentado asignarle un menú contextual a los objeto TQRDBText pero como no tienen la propiedad Popup no hay manera.

Así que en el procedimiento SeleccionarComponente compruebo si el usuario mantienen el botón SHIFT pulsado para abrir el formulario FCampo:

if (Seleccionado is TQRDBText) and
(HiWord(GetAsyncKeyState(VK_LSHIFT)) <> 0) then
ConfigurarCampo(Seleccionado as TQRDBText);

El procedimiento ConfigurarCampo le envía al formulario FCampo lo que necesita para trabajar:

procedure TFInforme.ConfigurarCampo(Campo: TQRDBText);
begin
// si no está conectado con la base de datos no hacemos nada
if not BaseDatos.Connected then
begin
Application.MessageBox('Conecte primero con la base de datos.',
'Acceso denegado', MB_ICONSTOP);
Exit;
end;

Application.CreateForm(TFCampo, FCampo);
FCampo.BaseDatos := BaseDatos;
FCampo.Campo := Campo;
FCampo.Tabla := Tabla;
FCampo.ShowModal;
end;

También comprueba si previamente hemos conectado con la base de datos. Dentro del formulario FCampo utilizo el evento OnShow para pedirle a la base de datos el nombre de las tablas:

procedure TFCampo.FormShow(Sender: TObject);
begin
// Nos traemos el nombre de todas las tablas
BaseDatos.GetTableNames(SelecTabla.Items, False);
end;

Cuando el usuario seleccione una tabla activando con el ComboBox SelecTabla el evento OnChange entonces vuelo a pedirle a la base de datos el nombre de los campos de la tabla seleccionada:

procedure TFCampo.SelecTablaChange(Sender: TObject);
begin
// Si no ha seleccionado ninguna tabla no hacemos nada
if SelecTabla.ItemIndex = -1 then
Exit;

// Le pedimos a la base de datos que nos de los campos de la tabla
BaseDatos.GetFieldNames(SelecTabla.Text, SelecCampo.Items);
end;

Una vez pulsamos el botón Aceptar le envío al objeto TQRDBText el campo y la tabla a la que pertenece:

procedure TFCampo.BAceptarClick(Sender: TObject);
begin
if SelecTabla.ItemIndex = -1 then
begin
Application.MessageBox('Debe seleccionar una tabla.',
'Atención', MB_ICONSTOP);
Exit;
end;

if SelecCampo.ItemIndex = -1 then
begin
Application.MessageBox('Debe seleccionar un campo.',
'Atención', MB_ICONSTOP);
Exit;
end;

Campo.DataField := SelecCampo.Text;
Tabla.TableName := SelecTabla.Text;
Campo.DataSet := Tabla;
Close;
end;

MODIFICANDO LA VISTA PREVIA

Cuando hagamos una vista previa del documento entonces debemos abrir la tabla de la base de datos antes de imprimir:

procedure TFInforme.VistaPreviaClick(Sender: TObject);
begin
// ¿Ha elegido el usuario una tabla?
if Tabla.TableName <> '' then
begin
// Entonces se la asignamos al informe
Informe.DataSet := Tabla;
Tabla.Close;
Tabla.Open;
end;

Informe.Preview;
end;

CAMBIAR EL NOMBRE DE LAS ETIQUETAS

Vamos a hacer una pequeña modificación más para poder cambiar el nombre de las etiquetas. Para ello volvemos a modificar el procedimiento SeleccionarComponente para que nos pida el nombre de la etiqueta al pincharla con el botón SHIFT pulsado:

if (Seleccionado is TQRLabel) and (HiWord(GetAsyncKeyState(VK_LSHIFT)) <> 0) then
begin
EtiSel := Seleccionado as TQRLabel;
sNombre := InputBox('Cambiar nombre etiqueta', 'Nombre:', '');
if sNombre <> '' then
EtiSel.Caption := sNombre;
end;

Con todo esto que he montado se puede hacer un pequeño informe a una banda con la ficha de un cliente:


Esta sería su vista previa:



EL PROYECTO

Aquí va el proyecto comprimido en RapidShare y Megaupload:

http://rapidshare.com/files/216858597/EditorInformes4_DelphiAlLimite.rar.html

http://www.megaupload.com/?d=AKDT45NN

También he incluido una base de datos creada con Firebird 2.0 con la tabla de CLIENTES. En el próximo artículo voy a finalizar esta serie dedicada a nuestro propio editor de informes añadiendo la posibilidad de grabar y cargar plantillas de informes.

Pruebas realizadas en RAD Studio 2007.

13 marzo 2009

Crea tu propio editor de informes (III)

Hoy vamos a perfeccionar la función de mover varios componentes seleccionados a la vez. También veremos como añadir figuras gráficas al informe y como cambiar sus dimensiones.

Al igual que en artículos anteriores daré al final del mismo el enlace para descargar todo el proyecto.

MOVIENDO VARIOS COMPONENTES CON EL RATÓN

Una vez hemos conseguido mover dos o más componentes a la vez mediante el teclado tenemos que hacer lo mismo con el ratón, ya que si tenemos tres etiquetas seleccionadas e intentamos moverlas (cogiendo una) veremos que sólo se mueve esta última.

Para ello hay que modificar la primera parte del procedimiento MoverRatonPulsado:

procedure TFInforme.MoverRatonPulsado;
var
dx, dy, xAnterior, yAnterior: Integer;
Seleccion: TShape;
begin
// ¿Ha movido el ratón estándo el botón izquierdo pulsado?
if ( ( x <> Cursor.X ) or ( y <> Cursor.Y ) ) and ( Seleccionado <> nil ) then
begin
// ¿Estamos moviendo una etiqueta o una banda?
if (Seleccionado is TQRLabel) or (Seleccionado is TQRShape) then
begin
// Movemos el componente seleccionado
dx := Cursor.X - x;
dy := Cursor.Y - y;
xAnterior := Seleccionado.Left;
yAnterior := Seleccionado.Top;
Seleccionado.Left := xInicial + dx;
Seleccionado.Top := yInicial + dy;

// Movemos la selección
Seleccion := BuscarSeleccion(Seleccionado.Tag);
if Seleccion <> nil then
begin
Seleccion.Left := xInicial+dx-1;
Seleccion.Top := yInicial+dy-1;
end;

MoverOtrosSeleccionados(Seleccionado.Tag, Seleccionado.Left,
Seleccionado.Top, xAnterior, yAnterior);
end;

...


Sólo he añadido tres cosas:

1º He añadido al principio del procedimiento las variables xAnterior e yAnterior que van a encargarse de guardar la coordenada original de la etiqueta que estoy movimendo.

2º Antes de mover la etiqueta guardo sus coordenadas originales:

xAnterior := Seleccionado.Left;
yAnterior := Seleccionado.Top;
Seleccionado.Left := xInicial + dx;
Seleccionado.Top := yInicial + dy;

3º Llamo al procedimiento MoverOtrosSeleccionados que se encargará de arrastrar el resto de etiquetas seleccionadas:

MoverOtrosSeleccionados(Seleccionado.Tag, Seleccionado.Left,
Seleccionado.Top, xAnterior, yAnterior);

Le paso como parámetro el ID de la etiqueta actual (para excluirla), la nueva posición y la anterior. Este sería el procedimiento al que llamamos:

procedure TFInforme.MoverOtrosSeleccionados( ID, x, y, xAnterior, yAnterior: Integer );
var
i, dx2, dy2: Integer;
Etiqueta: TQRLabel;
Seleccion: TShape;
begin
for i := 0 to BandaActual.ComponentCount - 1 do
begin
// ¿Es una etiqueta?
if (BandaActual.Components[i] is TQRLabel) then
begin
Etiqueta := BandaActual.Components[i] as TQRLabel;

// ¿Es distinta a la etiqueta original y está seleccionada?
if (Etiqueta.Tag <> ID) and (Etiqueta.Hint <> '' ) then
begin
dx2 := x - xAnterior;
dy2 := y - yAnterior;
Etiqueta.Left := Etiqueta.Left + dx2;
Etiqueta.Top := Etiqueta.Top + dy2;

// Movemos la selección
Seleccion := BuscarSeleccion(Etiqueta.Tag);
if Seleccion <> nil then
begin
Seleccion.Left := Etiqueta.Left-1;
Seleccion.Top := Etiqueta.Top-1;
end;
end;
end;
end;
end;

Lo que hace es recorrer todas las etiquetas de la banda actual (menos la seleccionada) y las arrastra según lo que se ha movido la etiqueta original:


Si movemos la etiqueta 3 entonces tienen que venirse detrás las etiquetas 1 y 2.

CREANDO FIGURAS GRÁFICAS

Otro elemento que se hace imprescindible en todo editor de informes son las figuras gráficas (líneas y rectángulos). Vamos a seguir la misma filosofía que para crear etiquetas.

Primero añadimos la opción Figura a nuestro menú contextual:


Su implementación sería esta:

procedure TFInforme.FiguraClick(Sender: TObject);
begin
if BandaActual = nil then
begin
Application.MessageBox( 'Debe crear una banda.',
'Acceso denegado', MB_ICONSTOP );
Exit;
end;

QuitarSeleccionados;
with TQRShape.Create(BandaActual) do
begin
Parent := BandaActual;
Left := 10;
Top := 10;
Inc(UltimoID);
Tag := UltimoID;
Name := 'Figura' + IntToStr(UltimoID);
end;
end;

Al igual que con las etiquetas, creamos un objeto TQRShape y le damos el siguiente ID que le corresponda.

Si ejecutamos el programa y creamos una nueva figura, aparecerá en la parte superior izquierda de la banda con borde negro y fondo blanco:


SELECCIONANDO LAS FIGURAS

Ahora tenemos que modificar las rutinas de selección para que se adapten a nuestro nuevo objeto TQRShape. Empezamos por el procedimiento SeleccionarComponente:

procedure TFInforme.SeleccionarComponente;
var
Punto: TPoint;
begin
bPulsado := True;
x := Cursor.X;
y := Cursor.Y;

// ¿Ha pinchado una etiqueta o una figura?
if (Seleccionado is TQRLabel) or (Seleccionado is TQRShape) then
begin
xInicial := Seleccionado.Left;
yInicial := Seleccionado.Top;

if Seleccionado.Hint = '' then
begin
// ¿No esta pulsado la tacla control?
if HiWord(GetAsyncKeyState(VK_LCONTROL)) = 0 then
QuitarSeleccionados;

Seleccionado.Hint := 'X';
end;
end;
...

Realmente sólo he cambiado esta línea:

if (Seleccionado is TQRLabel) or (Seleccionado is TQRShape) then

ya que no afecta a lo demás. Lo que si hay que ampliar bien es el procedimiento encargado de dibujar los componentes seleccionados:

procedure TFInforme.DibujarSeleccionados;
var
i: Integer;
Seleccion: TShape;
Etiqueta: TQRLabel;
Figura: TQRShape;
begin
if BandaActual = nil then
Exit;

for i := 0 to BandaActual.ComponentCount-1 do
begin
// ¿Es una etiqueta?
if BandaActual.Components[i] is TQRLabel then
begin
Etiqueta := BandaActual.Components[i] as TQRLabel;

if Etiqueta.Hint <> '' then
begin
// Antes de crearla comprobamos si ya tiene selección
Seleccion := BuscarSeleccion(Etiqueta.Tag);

if Seleccion = nil then
begin
Seleccion := TShape.Create(BandaActual);
Seleccion.Parent := BandaActual;
Seleccion.Pen.Color := clRed;
Seleccion.Width := Etiqueta.Width+2;
Seleccion.Height := Etiqueta.Height+2;
Seleccion.Tag := Etiqueta.Tag;
Seleccion.Name := 'Seleccion' + IntToStr(Etiqueta.Tag);
end;

Seleccion.Left := Etiqueta.Left-1;
Seleccion.Top := Etiqueta.Top-1;
end;
end;

// ¿Es una figura?
if BandaActual.Components[i] is TQRShape then
begin
Figura := BandaActual.Components[i] as TQRShape;

if Figura.Hint <> '' then
begin
// Antes de crearla comprobamos si ya tiene selección
Seleccion := BuscarSeleccion(Figura.Tag);

if Seleccion = nil then
begin
Seleccion := TShape.Create(BandaActual);
Seleccion.Parent := BandaActual;
Seleccion.Pen.Color := clRed;
Seleccion.Width := Figura.Width+2;
Seleccion.Height := Figura.Height+2;
Seleccion.Tag := Figura.Tag;
Seleccion.Name := 'Seleccion' + IntToStr(Figura.Tag);
end;

Seleccion.Left := Figura.Left-1;
Seleccion.Top := Figura.Top-1;
end;
end;
end;
end;

Comprobamos que si es una figura creamos una selección para la misma también de color rojo. Aunque estos dos componentes podíamos haberlos metido en una sólo bloque de código, conviene dejarlos separados para futuras ampliaciones en cada uno de ellos.

Igualmente tenemos que contemplar también las figuras a la hora de quitar los seleccionados:

procedure TFInforme.QuitarSeleccionados;
var
i: Integer;
begin
if BandaActual = nil then
Exit;

// Le quitamos la selección a los componentes
for i := 0 to BandaActual.ComponentCount-1 do
begin
if BandaActual.Components[i] is TQRLabel then
(BandaActual.Components[i] as TQRLabel).Hint := '';

if BandaActual.Components[i] is TQRShape then
(BandaActual.Components[i] as TQRShape).Hint := '';
end;

...


MOVIENDO LAS FIGURAS

Otra cosa que también tenemos hacer es cambiar el procedimiento encargado de arrastrar los componentes para que pueda hacer lo mismo con las figuras:

procedure TFInforme.MoverRatonPulsado;
var
dx, dy, xAnterior, yAnterior: Integer;
Seleccion: TShape;
begin
// ¿Ha movido el ratón estándo el botón izquierdo pulsado?
if ( ( x <> Cursor.X ) or ( y <> Cursor.Y ) ) and ( Seleccionado <> nil ) then
begin
// ¿Estamos moviendo una etiqueta o una figura?
if (Seleccionado is TQRLabel) or (Seleccionado is TQRShape) then
begin
...


Igualmente tenemos que ampliar el procedimiento encargado de seleccionar varios componentes:

procedure TFInforme.MoverOtrosSeleccionados(ID, x, y, xAnterior, yAnterior: Integer);
var
i, dx2, dy2: Integer;
Etiqueta: TQRLabel;
Figura: TQRShape;
Seleccion: TShape;
begin
for i := 0 to BandaActual.ComponentCount - 1 do
begin
// ¿Es una etiqueta?
if (BandaActual.Components[i] is TQRLabel) then
begin
Etiqueta := BandaActual.Components[i] as TQRLabel;

// ¿Es distinta a la etiqueta original y está seleccionada?
if (Etiqueta.Tag <> ID) and (Etiqueta.Hint <> '') then
begin
dx2 := x - xAnterior;
dy2 := y - yAnterior;
Etiqueta.Left := Etiqueta.Left + dx2;
Etiqueta.Top := Etiqueta.Top + dy2;

// Movemos la selección
Seleccion := BuscarSeleccion(Etiqueta.Tag);
if Seleccion <> nil then
begin
Seleccion.Left := Etiqueta.Left-1;
Seleccion.Top := Etiqueta.Top-1;
end;
end;
end;

// ¿Es una figura?
if (BandaActual.Components[i] is TQRShape) then
begin
Figura := BandaActual.Components[i] as TQRShape;

// ¿Es distinta a la Figura original y está seleccionada?
if (Figura.Tag <> ID) and (Figura.Hint <> '' ) then
begin
dx2 := x - xAnterior;
dy2 := y - yAnterior;
Figura.Left := Figura.Left + dx2;
Figura.Top := Figura.Top + dy2;

// Movemos la selección
Seleccion := BuscarSeleccion(Figura.Tag);
if Seleccion <> nil then
begin
Seleccion.Left := Figura.Left-1;
Seleccion.Top := Figura.Top-1;
end;
end;
end;
end;
end;

Y como no, hay que modificar la selección de varios componentes con el rectángulo azul. Eso estaba en el procedimiento ComprobarSeleccionComponetes:

procedure TFInforme.ComprobarSeleccionComponentes;
var
Sel: TShape; // Rectángulo azul de selección
i: Integer;
Eti: TQRLabel;
Fig: TQRShape;
begin
if BandaActual = nil then
Exit;

// ¿Hemos abierto una selección azul?
Sel := BandaActual.FindComponent('Seleccionar') as TShape;

if Sel <> nil then
begin
// Recorremos todas las etiquetas de esta banda en busca
// las cuales están dentro de nuestro rectángulo de selección
for i := 0 to BandaActual.ComponentCount-1 do
begin
// ¿Es una etiqueta?
if BandaActual.Components[i] is TQRLabel then
begin
Eti := BandaActual.Components[i] as TQRLabel;

// ¿Está dentro de nuestro rectángulo azul de selección?
if ( Eti.Left >= Sel.Left ) and
( Eti.Top >= Sel.Top ) and
( Eti.Left+Eti.Width <= Sel.Left+Sel.Width ) and
( Eti.Top+Eti.Height <= Sel.Top+Sel.Height ) then
Eti.Hint := 'X';
end;

// ¿Es una figura?
if BandaActual.Components[i] is TQRShape then
begin
Fig := BandaActual.Components[i] as TQRShape;

// ¿Está dentro de nuestro rectángulo azul de selección?
if ( Fig.Left >= Sel.Left ) and
( Fig.Top >= Sel.Top ) and
( Fig.Left+Fig.Width <= Sel.Left+Sel.Width ) and
( Fig.Top+Fig.Height <= Sel.Top+Sel.Height ) then
Fig.Hint := 'X';
end;
end;

DibujarSeleccionados;
FreeAndNil(Sel); // Eliminamos la selección
end;
end;


El mismo rollo he tenido que hacer en el procedimiento MoverComponentes (el que movía los componentes con el teclado). De este modo podemos seleccionar y arrastrar a la vez tanto etiquetas como figuras:


REDIMENSIONANDO EL TAMAÑO DE LOS COMPONENTES

Ya tenemos hecho que si el usuario tiene seleccionado uno o más componentes y pulsa los cursores entonces mueve los componentes. Ahora vamos a hacer que si pulsa también la tecla SHIFT entonces lo que hace es redimensionarlos. Esto los controlamos en el evento FormKeyDown:

procedure TFInforme.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// ¿Está pulsada la tecla SHIFT?
if ssShift in Shift then
begin
// Redimensionamos el tamaño de los componentes
case key of
VK_RIGHT: AmpliarComponentes( 1, 0 );
VK_LEFT: AmpliarComponentes( -1, 0 );
VK_UP: AmpliarComponentes( 0, -1 );
VK_DOWN: AmpliarComponentes( 0, 1 );
end;
end
else
begin
// Los movemos
case key of
VK_RIGHT: MoverComponentes( 1, 0 );
VK_LEFT: MoverComponentes( -1, 0 );
VK_UP: MoverComponentes( 0, -1 );
VK_DOWN: MoverComponentes( 0, 1 );
end;
end;
end;

El procedimiento AmpliarComponentes es similar al de moverlos:

procedure TFInforme.AmpliarComponentes(x, y: Integer);
var
i: Integer;
Etiqueta: TQRLabel;
Figura: TQRShape;
Seleccion: TShape;
begin
if BandaActual = nil then
Exit;

// Recorremos todos los componentes
for i := 0 to BandaActual.ComponentCount-1 do
begin
// ¿Es una etiqueta?
if BandaActual.Components[i] is TQRLabel then
begin
Etiqueta := BandaActual.Components[i] as TQRLabel;

// ¿Está seleccionada?
if Etiqueta.Hint <> '' then
begin
// Movemos la etiqueta
Etiqueta.Width := Etiqueta.Width + x;
Etiqueta.Height := Etiqueta.Height + y;

// Movemos su selección
Seleccion := BandaActual.FindComponent('Seleccion'+IntToStr(Etiqueta.Tag)) as TShape;
Seleccion.Width := Etiqueta.Width+2;
Seleccion.Height := Etiqueta.Height+2;
end;
end;

// ¿Es una figura?
if BandaActual.Components[i] is TQRShape then
begin
Figura := BandaActual.Components[i] as TQRShape;

// ¿Está seleccionada?
if Figura.Hint <> '' then
begin
// Movemos la Figura
Figura.Width := Figura.Width + x;
Figura.Height := Figura.Height + y;

// Movemos su selección
Seleccion := BandaActual.FindComponent('Seleccion'+IntToStr(Figura.Tag)) as TShape;
Seleccion.Width := Figura.Width+2;
Seleccion.Height := Figura.Height+2;
end;
end;
end;
end;

También se podría haber hecho con el ratón cogiendo las esquinas del componente y estirándolas, pero me llevaría un artículo sólo para eso (y la vaca no da para más).

Ya veis la movida que hay que hacer para hacer un simple editor de informes. En el próximo artículo vamos a añadir el componente TQRDBText para conectarnos con bases de datos Internase/Firebird.

DESCARGA DEL PROYECTO

Aquí van los enlaces para bajarse todo el proyecto en RapidShare y Megaupload:

http://rapidshare.com/files/208654755/EditorInformes3_DelphiAlLimite.rar.html

http://www.megaupload.com/?d=3BPPEI7H


Pruebas realizadas en RAD Studio 2007.

Publicidad