Archivo

Entradas Etiquetadas ‘Delphi’

Sistema de PlugIns en Delphi – Parte 2

viernes, 13 de noviembre de 2009 19 comentarios
Share Button

Pues ha llovido mucho desde la primera parte de este «articulillo»; Por lo que he visto en los fuentes del ejemplo, lo empecé hace aproximadamente hace 2 años, así que eso es lo que lleva de retardo… ;-)

En ese primer artículo se daba una visión general de lo que podía ser un sistema de PlugIns. Unas ideas generales y algo de código para empezar. Quedaba en el tintero profundizar un poco más en el tema y ver un ejemplo un poco más «práctico» que pudiera servir en una aplicación real. Eso es lo que he intentado tratar en esta segunda parte, centrandome en un sistema de «PlugIns Homogéneos«, con carga bajo petición (por parte del usuario).

TIPOS DE PLUGINS

Como ya vimos en la primera entrega, podemos dividir los plugIns en dos tipos según las tareas que desempeñan en una aplicación. Así podemos hablar de plugIns o grupos de ellos y catalogarlos como homogéneos si la tarea que realizan es similar o catalogarlos como heterogéneos (no-agrupados) si las tareas que desarrollan son independientes y no “agrupables” según su funcionalidad.

  • Grupos homogéneos de PlugIns
  • PlugIns heterogéneos

Esta división no sólo es conceptual en función de las características y desempeños de cada uno, sino que afecta directamente a la estructura con que se diseñarán estos elementos. Así, los PlugIns que pertenezcan a un grupo homogéneo tendrán estructura similar y un punto de entrada común (formulario base o procedimiento de ejecución). Mientras que los heterogéneos posiblemente no tengan una estructura común y la forma se ejecutarlos sea más “tosca” y menos “integrada” que los anteriores.

PLUGINS HOMOGENEOS

En este artículo vamos a tratar más profundamente esta variante de plugIns. Como ya hemos comentado se trata de plugIns con una estructura similar, aunque con variaciones en su funcionalidad. Tal vez con un ejemplo se vea más claro.

Tomemos como grupo homogéneo de PlugIns; Los efectos aplicables a una imagen dentro de un programa de diseño. A partir de una imagen podemos desarrollar plugIns que efectúen un determinado “cambio” de forma que la imagen resultante sea diferente a la original. La estructura y los parámetros de todos ellos parece claro que serán similares o idénticos. Todos ellos toman una imagen inicial y a partir de unos parámetros la modifican, para devolver una imagen de salida.

ESTRUCTURA FÍSICA

Para trabajar con esta estructura de plugins, utilizaremos un sistema de carga dinámica. Los plugins de programarán utilizando packages (BPL) con una estructura común y dependiendo de un package principal que contiene la Clase Base. Todos los plugins derivarán (heredarán) de una clase base que estará programada en el package principal.

Al cargar la aplicación se carga (puesto que está linkado de forma estática -utilizando la clausula USES-) también el package correspondiente a la clase Base. Esto da acceso a todos los métodos que estén definidos en la clase base (y en los derivados) desde el programa principal.

El resto de packages se cargan de forma dinámica y todos deben derivar (sus clases) de la Clase Base programada en el package Base.

PROTOTIPO

El prototipo que vamos a realizar para ilustrar el artículo simula un programa para realizar gráficos y diagramas simples. El programa utilizará un sistema de plugIns para añadir bibliotecas de objetos que puedan añadirse a los gráficos. Cada pluging (BPL) añade una nueva categoría de elementos y cada categoría implementa uno o varios objetos.

Todos los objetos que implementa una categoría derivan de una Clase Base (TShapeExBase) y esta clase base se implementa en un package que está linkado estáticamente a la aplicación principal (se carga siempre al arrancar la aplicación) y es obligatorio que exista, de otra forma la aplicación fallaría al ejecutarse.

En la imagen que se ve ala derecha, vemos la ventana correspondiente al Plugin de «Arrows»; Aquí implementa la clase TShapeExArrow (que deriva de TShapeExBase) y en esta clase se han programado los objetos que se ven en la imagen.

En nuestro ejemplo para este artículo se cargan los plugIns bajo petición. Es decir, en una primera pasada la aplicación revisa la existencia de PlugIns y detecta todos los ficheros presentes. Muestra una ventana con los plugns disponibles y la descripción de cada uno de ellos y a medida que el usuario los selecciona se cargan de forma dinámica. Imagen de la derecha.

El código de la carga es el siguiente:

...
  // Comprobación
  if not FileExists(AName) then begin
    _mens(Format('No se ha podido cargar el package <%s>;' +
        'No existe en disco.',[AName]));
    Exit;
  end;
 
  // Cargar
  hndl := LoadPackage(AName);
  desc := GetPackageDescription(PChar(AName));
  Result := hndl;
 
  // Acceder a la clase del menu
  pName := ChangeFileExt(ExtractFileName(AName), '');
  b := ExClassList.Find(pName, i);
  // Encontrada?
  if (b) then begin
    AClass := TPersistentClass(ExClassList.Objects[i]);
  end;

CLASE BASE (TShapeExBase)

La clase base para nuestro sistema de plugins se llama TShapeExBase. Esta clase sirve como punto de partida para todas las demás. Además de contener los métodos comunes a todos los plugins nos permitirá acceder desde la aplicación principal a todas las funciones de los plugins. Para ello los métodos importantes estarán definidos en esta clase y luego sobreescritos (override) en las clases derivadas.

{: Clase base lapa las clases implementadas en los plugins.}
  TShapeExBase = class(TShape)
  private
    FShapeEx: string;
 
    // Marca el tipo de Shape
    procedure SetShapeEx(const Value: string); virtual;
 
  protected
    W, H, S: Integer;
    X, Y:Integer;
    XW, YH:Integer;
    W2, H2, W3, H3, H4, W4, H8, W8, W16, H16:Integer;
 
    // Método de pintado
    procedure Paint; override;
    procedure CalculateData();
 
    // PROCEDIMIENTOS DE INFORMACION
    //············································
    // Autor del package
    function Autor():string; virtual; abstract;
    // Versión del Package
    function Version():string; virtual; abstract;
    // Fecha de creación
    function FechaCreacion():TDate; virtual; abstract;
 
  public
    // constructor de la clase
    constructor Create(AOwner: TComponent); override;
    // destructor de la clase
    destructor Destroy; override;
 
  published
    // Tipo de Shape
    property ShapeEx: string read FShapeEx write SetShapeEx;
  end;

En nuestro caso es una clase sencilla. La función implementa el dibujo de componentes derivados de un TShape en pantalla.

La propiedad ShapeEx es la más importante, e indica el tipo (identificador) de la figura. Equivalente a lo que en los TShape son los valores stRectangle, stEllipse, stSquare,…

En nuestra clase no puede ser un elemento tipificado como lo es en TShape, puesto que los nuevos plugins irán añadiendo elementos a esta propiedad que a priori no conocemos.

Se añaden también procedimientos de información acerca del plugin como pueden ser el Autor, la fecha de creación o la versión.

El método Paint, que para la clase base está vacío, en las clases derivadas será donde se implementen las instrucciones de pintado para cada uno de los elementos.

Finalmente la clase Base implementa el procedimiento CalculateData y al utiliza algunas variables en la parte protected, que precalculan datos y los ponen a disposición de las clases derivadas (protected), para facilitar la implementación del método Paint y dar acceso a medidas ya precalculadas.

En la clase Base además se definen dos Listas (TStringList) que nos servirán de apoyo a la hora de acceder a los diferentes objetos de los plugIns; Tanto para las clases, como para los Shapes definidos en cada clase.

  //: Lista de clases registradas en los packages dinámicos
  ExClassList:TStringList;
  //: Lista de objetos registrados en una clase (tipos de Shapes)
  ExShapeList:TStringList;

En la primera añadiremos la referencia a la Clase y el String correspondiente al nombre del package y en la segunda, para cada Shape implementado en la Clase, su valor de la propiedad ShapeEx (comentada anteriormente) y el apuntador a su clase.

De esta forma, por ejemplo, el PlugIn que implementa la clase TshapeExArrow que corresponde a la imagen que se ve más arriba, añadirá en las lista los siguientes valores:

 // Registrar los tipos
  ExShapeList.AddObject('stArrorRight', Pointer(TShapeExArrow));
  ExShapeList.AddObject('stArrorRightW', Pointer(TShapeExArrow));
  ...
  // registrar la clase
  ExClassList.AddObject('PlugArrows', Pointer(TShapeExArrow));

En las líneas anteriores podemos ver que el plugIn PlugArrow (1) tiene implementada la clase TShapeExArrow (1), y que dentro de esta clase hay 6 objetos diferentes de tipo ShapeEx; Cuyos identificadores son: stArrorRight, stArrorRight, stArrorRightM, stArrorLeft, stArrorUp y stArrorDown.

CLASES DERIVADAS

Tal y como está diseñada la estructura, las clases derivadas de la clase Base (TShapeExBase) deben redefinir el método Paint para definir cómo se define cada uno de los objetos de esa clase.

SISTEMA DE CARGA/DESCARGA

El sistema de carga es simple y lo único que hace de especial en este caso es comprobar primero si el package ya ha sido cargado, y si no es así llama a la función CargarPackage del formulario principal, utilizando el nombre del fichero.

Podemos ver por pasos y comentar qué hace esta función:

  // Cargar
  hndl := LoadPackage(AName);
  desc := GetPackageDescription(PChar(AName));
  Result := hndl;

En primer lugar (una vez hemos comprobado que el fichero existe) cargamos el package a partir de su nombre. Una vez cargado obtenemos la Descripción. Para ello se llama a la función GetPackageDescription que se encuentra en la Unidad SysUtils.pas y que develve el valor almacenado en el DPK junto a la directiva {$DESCRIPTION} o {$D} que permite almacenar hasta 255 caracteres.

Todos los packages cuentan con una sección de INITIALIZATION donde añaden a las lista de clases (ExClassList) y a la lista de Shapes (ExShapeList) los elementos que ese package implementa. Estas dos clases son importantes puesto que nos facilitan mucho el trabajo a la hora de realizar todo tipo de operaciones con los elementos de cada packages. Además se registra la clase utilizando el método RegisterClass de Delphi. Por ejemplo, el package de “Arrows” contiene esta sección de INITIALIZATION:

//===================================================================
//
// I N I T I A L I Z A T I O N
//
//===================================================================
initialization
  // Registrar la clase del form
  RegisterClass(TShapeExArrow);
  // Registrar los tipos
  ExShapeList.AddObject('stArrorRight', Pointer(TShapeExArrow));
  ExShapeList.AddObject('stArrorRightW', Pointer(TShapeExArrow));
  ExShapeList.AddObject('stArrorRightM', Pointer(TShapeExArrow));
  ExShapeList.AddObject('stArrorLeft', Pointer(TShapeExArrow));
  ExShapeList.AddObject('stArrorUp', Pointer(TShapeExArrow));
  ExShapeList.AddObject('stArrorDown', Pointer(TShapeExArrow));
  // registrar la clase
  ExClassList.AddObject('PlugArrows', Pointer(TShapeExArrow));
//===================================================================

Lo siguiente que vamos necesitamos, una vez que tenemos cargado el package, es crear la clase que se implementa en el package; Una vez hecho esto ya tendremos total acceso a los métodos que necesitemos y realmente ya habremos conseguido nuestro objetivo.

Para crear la clase utilizamos la lista de clases (ExClassList) que hemos comentado en el párrafo anterior y que hemos rellenado en la sección de inicialización; Otra opción también viable es utilizar GetClass de Delphi mediante RTTI junto con el nombre de la clase registrada (TShapeExArrow). También funcionaría, aunque en este caso, por comodidad, hemos utilizado estas listas auxiliares.

// Crear la clase
  b := ExClassList.Find(pName, i);
  // encontrada?
  if (b) then begin
    AClass := TPersistentClass(ExClassList.Objects[i]);
 
    // OTRA OPCIÓN:
    BClass := GetClass('TShapeExArrow');
  end;

Para finalizar y después de haber realizado unas comprobaciones, llamamos al método CargarCategoria, que crea de forma dinámica la ventana asociada a esa categoría (con la descripción) y también crea el elemento individual asociada a cada Shape implementado en esa clase.

En este punto ya hemos hecho uso de todo lo implementado en ese package, puesto que ya hemos creado un objeto de todos los implementados.

      // Cargar los objetos de ese plugIn
      CargarCategoria(AClass, desc);

En este ejemplo, no descargamos los packages, puesto que los necesitamos para seguir trabajando con los objetos que tenemos en pantalla, lo que hacemos realmente es ocultar la ventana. Si la operación que desempeña el package no necesita que posteriormente esté cargado, bastaría con descargarlo utilizando UnloadPackage.

Hasta aquí las descripción de todo el proceso. Junto con el artículo os adjunto el ejemplo completo y bastante comentado. Es sencillo, pero muestra a la perfección el manejo práctico de este tipo de ficheros.

Espero que haya quedado claro y si hay comentarios o sugerencias, ya sabéis. ¡¡Disparad!!  ;-D

Imagen del programa de ejemplo.

El código del ejemplo se puede descargar desde aquí y los binarios (EXE + BPL’s) desde aquí.

<DESCARGAR CÓDIGO>

<DESCARGAR BINARIOS>

Tal como me comenta Salvador, en el proyecto no se incluyen las dos BPL’s de Dephi (de la VCL) que ne necesitan para ejecutar el proyecto. Si no tenéis Delphi 6 instalado, las necesitaréis para ejecutar. Os coloco los links, con el proyecto (binarios incluyendo las BPLs) y un fichero sólo con los dos ficheros (VCL60.BPL y RTL60.BPL).

<DESCARGAR BINARIOS (Incluyendo VCL60.BPL y RTL60.BPL)>

<FICHEROS VCL60.BPL y RTL60.BPL>

(Google Maps – API) Codificación Geográfica – I

martes, 5 de mayo de 2009 17 comentarios
Share Button

Codificación Geográfica Se conoce como Codificación Geográfica, al proceso o sistema de transformar una dirección «o similar» en coordenadas geográficas de Longitud y Latitud, para posteriormente ser utilizadas en sistemas de posicionamiento (por ejemplo).

El API de Google incluye este servicio, que es el que se utiliza cuando buscamos una dirección desde Google Maps.

Normalmente este acceso se hace desde una página web con peticiones HTTP; Lo que vamos a ver es cómo integrar este servicio en un programa Delphi.

Un poco más arriba he comentado que la codificación geográfica se basa en dar una entrada (dirección) para obtener unas coordenadas. También he añadido el «similar», puesto que en el caso de Google Maps, podemos dar como entrada otras cosas que expresamente no son una dirección.

Así, podemos utilizar como dirección:

  • 08901,Spain
  • c/Balmes,214,Barcelona,Spain
  • Sevilla,Spain
  • Alhambra,Granada,Spain

Para hacer una prueba de lo que podemos obtener, basta con utilizar un componente TidHTTP de las Indy para realizar la petición. Coloca un componente TidHTTP en un formulario y un botón con el siguiente código:

procedure TForm1.btn1Click(Sender: TObject);
const
  STR_WEB = 'http://maps.google.com/maps/geo?q=';
  STR_OUT = '&amp;output=csv';    // formato de salida
var
  Stream: TStringStream;
  Str, res:string;
begin
  // ini
  Stream := TStringStream.Create('');
  // proteccion para liberar
  try
    Str := STR_WEB + edt1.Text + STR_OUT;
    idhttp2.Get(Str, Stream);
    edt2.Text := Stream.DataString;
  finally
    FreeAndNil(Stream);
  end;
end;

Una imagen de lo que obtenemos  una vez realizada la petición es la siguiente:

Se puede descargar el código completo de este ejemplo desde aquí.

Y lo que obtenemos como respuesta en este caso es:

200,8,41.3979638,2.1515206

Los dos últimos parámetros son los que buscabamos y nos indican las coordenadas de ese punto (latitud y longitud).

Para comprobar que so correctas, basta con ir a la web de Google Maps, copiar estas dos coordenadas en el cuadro de búsqueda y pulsar sobre el botón de <Buscar en el Mapa>.

A parte de esto, Google Maps nos devuelve, en este caso, dos números más; El primero corresponde al un «código de Estado» o «código de retorno» de la consulta que hemos realizado; En él se devuelve información por parte del servidor. Y el segundo es lo que se conoce como «Accuracy» o «Exactitud», que corresponde justamente a eso; Al nivel de exactitud que Google asigna a la respuesta, segun la dirección que le hemos dado.

El código de retorno, en este caso, es un 200, que corresponde a la constante «G_GEO_SUCCESS» (consulta correcta).

El nivel de exactitud, en este caso, es un 8 (máxima precisión).

Los niveles de exactitud con lo que trabaja Google Maps son los siguientes:

  • 0:  Ubicación desconocida.
  • 1:  Precisión a nivel de país.
  • 2:  Precisión a nivel de región.
  • 3: Precisión a nivel de subregión.
  • 4: Precisión a nivel de ciudad o pueblo.
  • 5: Precisión a nivel de código postal.
  • 6: Precisión a nivel de calle.
  • 7: Precisión a nivel de intersección.
  • 8: Precisión a nivel de dirección.

Así en el ejemplo que hemos visto antes obteníamos una Exactitud de 8 (a nivel de dirección), mientras que si íntroducimos una dirección del tipo;

<08905,Barcelona,Spain>

Obtendremos un código 5 (a nivel de C.P.)

NOTA: La descripción detallada de los «códigos de precisión» se puede encontrar aquí; Y la descripción detallada de todos los «códigos de retorno» se puede encontrar aquí.


Redimensionar una imagen (Antialiasing)

lunes, 9 de marzo de 2009 13 comentarios
Share Button

Hace unos días nos encontramos con el problema (no muy grande ;-D ) de añadir a una aplicación delphi existente la posibilidad de incluir una imagen seleccionada por el usuario. A priori la imagen era un JPG,  de la cual se debía crear una miniatura (thumbnail) a unas dimensiones determinadas (180 x 115) y ambas debían subir a un directorio determinado. Ningun problema.  Aquí mismo había un par de procedimientos de Domingo Seoane para redimensdionar una imagen.
En concreto modificando un poco el procedimiento Proporcional conseguí lo que necesitaba. Que si la imagen original no era exactamente de las mismas proporciones que la que necesitaba (miniatura) esta rellenara con un color «neutro» (en este caso el blanco) los bordes laterales.

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
// Esta otra mantiene la relacion entre alto y ancho
procedure Proporcional(Imagen: TGraphic; Ancho, Alto: Integer);
var
  Bitmap: TBitmap;
  Rect:TRect;
begin
  Bitmap:= TBitmap.Create;
  try
    Bitmap.Width:= Ancho;
    Bitmap.Height:= Alto;
 
    /// Calculos para que quede proporcional
    if  (Ancho/Imagen.Width) &lt; (Alto/Imagen.Height) then  begin
      Alto:= Trunc((Ancho*Imagen.Height)/Imagen.Width);
    end
    else begin
      Ancho:= Trunc((Imagen.Width*Alto)/Imagen.Height);
    end;
 
    // posición nueva
    // Hay que centarla para que queden márgenes iguales a ambos lados
    Rect.Left := ((Bitmap.Width - Ancho) div 2);
    Rect.Top := ((Bitmap.Height - Alto) div 2);
    Rect.Right:= Rect.Left + Ancho;
    Rect.Bottom := Rect.Top + Alto;
 
    // Color neutro para márgenes
    Bitmap.Canvas.Brush.Color := clRed;
    // copiar
    Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
    Bitmap.Canvas.StretchDraw(Rect,Imagen);
    Imagen.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

Hice un par de pruebas con imágenes y el resultado no fue exactamente lo que yo esperaba. El procedimiento era correcto, y funcionaba bien, pero las imagenes en minuatura presentaban Aliasing. Y siendo las miniaturas bastante pequeñas el efecto se notaba bastante.

Reducir tamaño de una imagen

Imagen generada

Ampliando un poco la imagen y comparándola con una generada con cualquier programa sencillo de retoque fotográfico se apreciaba bastante la diferencia entre ambas.

Comparación de las imágenes
Esto es lo que se conoce como aliasing. Se pueden encontrar múltiples definiciones y explicaciones de este problema en Internet (wiki), así que no explicaré aquí de que se trata.


APLICAR ANTIALIASING

La teoría dice que esto se soluciona aplicando algoritmos de altializasing, así me he puesto a hacer unas pruebas a ver qué resultado obtenía.Mi idea es modificar el color de cada uno de los pixels de la imagen teniendo en cuenta en color de los pixels que hay a su alrededor.

Qué pixels seleccionemos para ello y cuantos (distancia) determinará que el resultado sea más o menos satisfactorio, pero también afectará al tiempo de cálculo. Por lo que he leído esto es lo que se conoce como Supersampling/Multisampling.
Un ejemplo de diferentes selecciones de pixels se puede ver en la imagen siguiente:

En cada uno de estos casos se variará el color del pixel central teniendo en cuenta los colores de los pixels que hay a su alrededor.

Tipos de selección

A partir de aquí me he propuesto hacer algunas pruebas (sencillas) para comprobar si en los resultados se notaban cambios a simple vista.


PRUEBAS DE ALGORITMOS

Para los ejemplos he realizado una imagen sencilla, con varias líneas inclinadas, donde se aprecian bastantes «dientes de sierra» y algunas circunferencias. La imagen inicial es la que se ve en la figura siguiente con un tamaño inicial de 457 x 273 pixels.

La idea es reducir el tamaño de esa imagen hasta la mitad (más o menos) y a una cuarta parte aplicando antes un algoritmo de antialiasing sencillo escogiendo diferentes puntos para modificar el color de los pixels.

Para la reducción de tamaño, he utilizado un procedimiento estandard para reducir el tamaño de imágenes BPL utilizando (StretchDraw), pero en este caso, antes de hacer la reducción he probado a aplicar los algoritmos de AntiAliasing.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
// Esta cambia el alto y ancho, estirando la imagen si es necesario
procedure Redimensionar(Imagen:TBitmap; Ancho, Alto: Integer);
var
  Bitmap: TBitmap;
begin
 
  Bitmap:= TBitmap.Create;
 
  // Aplicamos antialiasing
  Antialiasing(Imagen, Bitmap);
  Imagen.Assign(Bitmap);
 
  // reducir
  try
    Bitmap.Width:= Ancho;
    Bitmap.Height:= Alto;
    Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect, Imagen);
    Imagen.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

Para modificar el color lo que he probado es a sumar los colores de los puntos escogidos al del pixel actual y luego hacer la media para obtener un color resultante; Así por ejemplo, para calcular el nuevo color de un pixel teniendo en cuenta el pixel superior y el inferior de la misma columna, utilizo un código como este:

1
2
3
4
5
6
  // R1 es el componente Red del pixel actual y R2 y R3 los del sup. e inferior.
  R1:=Round(R1 + R2 + R3 ) div 3;
  G1:=Round(G1 + G2 + R3 ) div 3;
  B1:=Round(B1 + B2 + b3 ) div 3;
  // color resultante
  Result := RGB(R1,G1,B1);

Lo que he hecho en las pruebas es aplicar a la imagen, esta mismo procedimiento, pero teniendo en cuenta diferentes selecciones de puntos.

  1. Seleccionando 2 puntos; Superior e inferior.
  2. Seleccionando 4 puntos; Superior, inferior, izquierda y derecha.
  3. Seleccionando 8 puntos. Los 8 puntos que hay alrededor del pixels actual.
  4. Seleccionando 8 puntos y aplicando ponderación al actual. Utilizar los 8 pixels que hay alrededor del actual, pero aplicando más peso (más valor) al pixels actual (a su color) que a los del resto. En mi caso el pisel actual tiene un peso de 4, mientras que el resto queda con un pero 1.

En un primer ejemplo he aplicado los dos primeros (2 y 4 pixels), pensando que no habría grandes cambios y la verdad es qe me ha sorprendido, ya que tomando tan sólo 2 puntos ya se notan algunos cambios y tomando 4 las dioferencias ya son bastante apreciables.

Descargar ejemplo 1

El resultado obtenido por este ejemplo es el siguiente:

La imagen superior es el original (redimensionado tal como lo hace delphi), y las dos inferiores son a las que se les ha aplicado el procedimiento de Antialiasing antes de redimensionarlas. En una escogiendo 2 los pixels laterales y en la otra los 4 pixels que rodean al del cálculo. Superior, inferior,  izquierdo y derecho.

Como se puede ver, con dos pixels únicamente, ya hay zonas (1, 3 y 5) donde se aprecian diferencias. Seguramente en estas más que en otras porque la selección de pixels no es homogénea (de ahí que en las líneas horizontales se aprecie más mejora).

Cuando se aplica el algoritmo teniendo en cuenta los 4 pixels de alrededor, se aprecia (2, 3, 4 y 5) ya bastantes diferencias.

En el segundo ejemplo he aplicado los 4 casos comentados antes.

Descargar ejemplo 2

El resultado de este segundo ejemplo es el siguiente:

En este caso entre los dos últimos no se aprecia diferencia visible, pero sí entre escoger 4 puntos y 8 puntos. Ver los puntos marcados como 1 y 3.

Dado que no se aprecian grandes diferencias entre los dos últimos, he integrado en un último ejemplo el redimensionado y el procedimiento de Antialiasing, de forma que este segundo se realice de forma automática.

Descargar el ejemplo 3

CONSIDERACIONES FINALES

Aunque el ejemplo que se ha desarrallo aquí y el procedimiento parece que funcionan de manera aceptable, hay que tener en cuenta otros factores a la hora de realizar un algoritmo más completo.

En nuestro caso la distancia de pixel utilizada (muestreo) es una distancia 1; es decir, hemos seleccionado los pixels que hay más cercanos al que vamos a modificar. Podemos seleccionar pixels de distancias mayores (2 y 3); De esta forma el resultado puede ser más correcto, aunque esto también tiene que ver con el porcentaje de reducción del tamaño.

No es lo mismo reducir una imagen a la mitad de su tamaño, que al 10% del tamaño original.  Segun el caso el resultado puede ser mejor o peor si seleccionamos pixels a distancias 1,2 y 3 del pixels a calcular.

El procedimiento final para BMP’s quedaría así:

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
59
60
61
62
63
64
65
66
67
68
type
  TRGBTripleArray = array[0..32767] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;
...
// Esta cambia el alto y ancho, estirando la imagen si es necesario
procedure Redimensionar(Imagen:TBitmap; Ancho, Alto: Integer);
var
  Bitmap: TBitmap;
  //····························································
  // Procedimiento de Antialiasing con Distancia=1
  procedure Antialiasing(bmp1, bmp2:TBitmap);
  var
    r1,g1,b1:Integer;
    Y, X, j:integer;
    SL1, SL2, SL3: PRGBTripleArray;
  begin
 
    // Tamaño del bitmap destino
    bmp2.Height := bmp1.Height;
    bmp2.Width := bmp1.Width;
    // SCANLINE
    SL1 := bmp1.ScanLine[0];
    SL2 := bmp1.ScanLine[1];
    SL3 := bmp1.ScanLine[2];
 
    // reorrido para todos los pixels
    for Y := 1 to (bmp1.Height - 2) do begin
      for X := 1 to (bmp1.Width - 2) do begin
        R1 := 0;  G1 := 0; B1 := 0;
        // los 9 pixels a tener en cuenta
        for j := -1 to 1 do begin
          // FIla anterior
          R1 := R1 + SL1[X+j].rgbtRed    + SL2[X+j].rgbtRed    + SL3[X+j].rgbtRed;
          G1 := G1 + SL1[X+j].rgbtGreen  + SL2[X+j].rgbtGreen  + SL3[X+j].rgbtGreen;
          B1 := B1 + SL1[X+j].rgbtBlue   + SL2[X+j].rgbtBlue   + SL3[X+j].rgbtBlue;
        end;
        // Nuevo color
        R1:=Round(R1 div 9);
        G1:=Round(G1 div 9);
        B1:=Round(B1 div 9);
        // Asignar el nuevo
        bmp2.Canvas.Pixels[X, Y] := RGB(R1,G1,B1);
      end;
      // Siguientes...
      SL1 := SL2;
      SL2 := SL3;
      SL3 := bmp1.ScanLine[Y+1];
    end;
  end;
  //····························································  
begin
 
  Bitmap:= TBitmap.Create;
 
  // Aplicamos antialiasing
  Antialiasing(Imagen, Bitmap);
  Imagen.Assign(Bitmap);
 
  // reducir
  try
    Bitmap.Width:= Ancho;
    Bitmap.Height:= Alto;
    Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect, Imagen);
    Imagen.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

Ordenar un TStringGrid por una determinada columna

jueves, 9 de octubre de 2008 2 comentarios
Share Button

Procedimiento que muestra cómo ordenar un TStringGrid a partir de los datos de una columna. El texto está basado en esta página Web donde hay un algoritmo de ordenación. El problema es que sólo es para datos numéricos. En este truco he añadido un par de parámetros para poder definir columnas de otro tipo (u ordenación de otro tipo) y además marcar si que quiere de forma Ascendente o Descendente (que tampoco está en el truco original).

Yo he añadido métodos para ordenar por enteros y Float, aunque ampliando se pueden añadir para alguno más.

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
59
60
61
62
// Ordena un TStringGrid.
procedure SortStringGrid(var GenStrGrid: TStringGrid;
    ThatCol: Integer;
    ColData:TGridData=gdString;
    SortOrder:TSortOrder=soASC);
const
  TheSeparator = '@';
var
  CountItem, I, J, K, ThePosition: integer;
  MyList: TStringList;
  MyString, TempString: string;
  str:string;
  vali:Integer;
  valf:Double;
begin
  CountItem := GenStrGrid.RowCount;
  MyList := TStringList.Create;
  MyList.Sorted := False;
  try
    begin
      for I := 1 to (CountItem - 1) do begin
        Str := GenStrGrid.Rows[I].Strings[ThatCol];
        if (ColData = gdInteger) then begin
          vali := StrToIntDef(Str, 0);
          Str := Format('%*d', [15,vali]);
        end;
        if (ColData = gdFloat) then begin
          valf := StrToFloat(Str);
          Str := Format('%15.2f',[valf]);
        end;
        MyList.Add(Str + TheSeparator + GenStrGrid.Rows[I].Text);
      end;
      Mylist.Sort;
 
      for K := 1 to Mylist.Count do begin
        MyString := MyList.Strings[(K - 1)];
        ThePosition := Pos(TheSeparator, MyString);
        TempString := '';
        {Eliminate the Text of the column on which we have
          sorted the StringGrid}
        TempString := Copy(MyString, (ThePosition + 1), Length(MyString));
        MyList.Strings[(K - 1)] := '';
        MyList.Strings[(K - 1)] := TempString;
      end;
 
      if (SortOrder = soASC) then begin
        for J := 1 to (CountItem - 1) do begin
            GenStrGrid.Rows[J].Text := MyList.Strings[(J - 1)];
        end;
      end
      else begin
        for J := 1 to (CountItem - 1) do begin
          I := (CountItem - J);
          GenStrGrid.Rows[I].Text := MyList.Strings[(J - 1)];
        end;
      end;
    end;
 
  finally
    MyList.Free;
  end;
end;

AÑADO: Me falta una cosa.
Además habrá que definir en la unit los dos tipos que se utilizan para la ordenación:

1
2
3
4
5
Type
  //: Tipo de Dat de la columna por la que queremos ordenar.
  TGridData = (gdString, gdInteger, gdFloat);
  //: Tipos de ordenación.
  TSortOrder = (soASC, soDESC);

Sistema de Plug-ins utilizando packages dinámicos

domingo, 24 de febrero de 2008 1 comentario
Share Button

Sencillo ejemplo que muestra cómo utilizar packages dinámicos en una aplicación para obtener caraterísticas de plug-ins.
Los packages (BPL’s) con diferentes funcionalidades se crean de forma independiente y el programa se encarga de cargarlos al inicio y «colgarlos» o añadirlos a un menú en la aplicación principal.

Imagen del ejemplo.

Download Descargar ejemplo

Categories: Delphi, Ejemplos Tags: , , ,

Convertir un Menu en un TreeView

domingo, 24 de febrero de 2008 3 comentarios
Share Button

En este ejemplo se muestra de forma sencilla cómo «pasar» o convertir un Menu existente (componente TMainMenu) en un TTreeView; Conservando la jerarquía de los elementos y asignando las imágenes que ya existan en el ejemplo.

Imagen del ejemplo

Download Descargar ejemplo

Categories: Delphi, Ejemplos Tags: , ,

Ejemplo sobre Threads ampliado (v. 2)

martes, 8 de enero de 2008 Sin comentarios
Share Button

Se ha ampliado el ejemplo anterior sobre threads, para mostrar cómo se puede configurar el número de threads que se deseen para ejecutar una tarea concreta. Se puede definir un número máximo (por el usuario) y se muestra cómo se van ejecutando threads.
A medida que los primeros van acabando, se lanzan nuevos hasta completar todo el proceso.

Imagen del ejemplo

Download Descargar ejemplo

Categories: Difícil, Ejemplos 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: , , ,

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