03 agosto 2007

El tipo Variant

Las variables de tipo Variant dan una gran flexibilidad a Delphi permitiendo el almacenamiento de cualquier tipo de dato básico dentro de las mismas.

Estas variables son muy útiles cuando se necesitan procesar muchos datos en tiempo de ejecución antes de saber su tipo, pero debido a los errores que puede causar hay que tener cuidado al utilizarlas.

Lo que no pueden contener es ninguna estructura de datos, objetos ni punteros. Por ejemplo, no se puede hacer:

var
Variable: Variant;
begin
Variable := nil;

Ya que provocaría un error al compilar. Pero si se puede hacer:

Variable := NULL;

Y mucho ojo porque no es lo mismo una variable Nula que una variable Vacia. Cuando se crea una variable Variant y no se hace nada con ella sigue siendo una variable Vacia, pero no nula. Será Nula si nosotros se lo decimos como hemos visto anteriormente.

¿Pero como sabemos que tipo tipo de dato contiene una variable Variant? Pues para eso tenemos la función VarType que nos devuelve el tipo de dato que contiene una variable Variant. Aquí tenemos una función que nos devuelve el tipo de dato de un Variant:

function TipoVariable( Variable: Variant ): String;
var iTipo: Integer;
begin
iTipo := VarType( Variable );

case iTipo of
varEmpty : Result := 'Vacía';
varNull : Result := 'Nula';
varSmallInt : Result := 'SmallInt';
varInteger : Result := 'Integer';
varSingle : Result := 'Single';
varDouble : Result := 'Double';
varCurrency : Result := 'Currency';
varDate : Result := 'Date';
varOleStr : Result := 'OleStr';
varDispatch : Result := 'Dispatch';
varError : Result := 'Error';
varBoolean : Result := 'Boolean';
varVariant : Result := 'Variant';
varUnknown : Result := 'Desconocida';
varByte : Result := 'Byte';
varWord : Result := 'Word';
varLongWord : Result := 'LongWord';
varInt64 : Result := 'Int64';
varStrArg : Result := 'StrArg';
varString : Result := 'String';
varAny : Result := 'Any';
end;

Result := 'Tipo ' + Result;
end;

Veamos un ejemplo de su utilización volcando el contenido en un Memo:

var
Variable: Variant;
begin
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := NULL;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 125;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 1250;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 125000;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := -1800;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := -1900000;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := 'Cadena de texto';
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );
Variable := True;
Memo.Lines.Add( 'Variable=' + VarToStr( Variable ) );
Memo.Lines.Add( TipoVariable( Variable ) );

El resultado que mostrará en pantalla será el siguiente:

Variable=
Tipo Vacía
Variable=
Tipo Nula
Variable=125
Tipo Byte
Variable=1250
Tipo Word
Variable=125000
Tipo LongWord
Variable=-1800
Tipo SmallInt
Variable=-1900000
Tipo Integer
Variable=Cadena de texto
Tipo String
Variable=True
Tipo Boolean

Como vemos según el dato que guardamos en la variable va adaptándose de un tipo a otro.

Pruebas realizadas en Delphi 7.

02 agosto 2007

Conversiones entre unidades de medida

Delphi incorpora una librería interesante encargada de realizar conversiones entre unidades de tiempo, volumen, distancia, etc. Para ello hay que añadir las unidades ConvUtils y StdConvs:

uses
Windows, Messages, ..., ConvUtils, StdConvs;

La función encargada de realizar conversiones es la siguiente:

Convert( ValorAConvertir: Double; DesdeUnidad, HastaUnidad: TConvType): Double;

Veamos algunos ejemplos mostrando el resultado en un campo Memo.
Para convertir de millas a kilómetros:

var dMillas, dKilometros: Double;
begin
dMillas := 15;
dKilometros := Convert( dMillas, duMiles, duKilometers );
Memo.Lines.Add( Format( '%8.4f Millas = %8.4f Kilometros', [dMillas, dKilometros] ) );

Esta otra convierte de pulgadas de área a centímetros de area:

var dPulgadas, dCentimetros: Double;
begin
dPulgadas := 21;
dCentimetros := Convert( dPulgadas, auSquareInches, auSquareCentimeters );
Memo.Lines.Add( Format( '%8.4f Pulgadas de área = %8.4f Centímetros de área', [dPulgadas, dCentimetros] ) );

Y si queremos convertir libras en kilogramos:

var dLibras, dKilos: Double;
begin
dLibras := 60;
dKilos := Convert( dLibras, muPounds, muKilograms );
Memo.Lines.Add( Format( '%8.4f Libras = %8.4f Kilos', [dLibras, dKilos] ) );

También podemos convertir unidades de temperatura:

var dFahrenheit, dCelsius: Double;
begin
dFahrenheit := 84;
dCelsius := Convert( dFahrenheit, tuFahrenheit, tuCelsius );
Memo.Lines.Add( Format( '%8.4fº Fahrenheit = %8.4fº Celsius', [dFahrenheit, dCelsius] ) );

Así como conversión entre unidades de volumen:

var dMetrosCubicos, dLitros: Double;
begin
dMetrosCubicos := 43;
dLitros := Convert( dMetrosCubicos, vuCubicMeters, vuLiters );
Memo.Lines.Add( Format( '%8.4f Metros cúbicos = %8.4fº Litros', [dMetrosCubicos, dLitros] ) );

Ahora vamos a ver todos los tipos de conversión según las unidades de medida.
Para convertir entre unidades de área tenemos:

auSquareMillimeters
auSquareCentimeters
auSquareDecimeters
auSquareMeters
auSquareDecameters
auSquareHectometers
auSquareKilometers
auSquareInches
auSquareFeet
auSquareYards
auSquareMiles
auAcres
auCentares
auAres
auHectares
auSquareRods

Convertir entre unidades de distancia:

duMicromicrons
duAngstroms
duMillimicrons
duMicrons
duMillimeters
duCentimeters
duDecimeters
duMeters
duDecameters
duHectometers
duKilometers
duMegameters
duGigameters
duInches
duFeet
duYards
duMiles
duNauticalMiles
duAstronomicalUnits
duLightYears
duParsecs
duCubits
duFathoms
duFurlongs
duHands
duPaces
duRods
duChains
duLinks
duPicas
duPoints

Convertir entre unidades de masa:

muNanograms
muMicrograms
muMilligrams
muCentigrams
muDecigrams
muGrams
muDecagrams
muHectograms
muKilograms
muMetricTons
muDrams
muGrains
muLongTons
muTons
muOunces
muPounds
muStones

Convertir entre unidades de temperatura:

tuCelsius
tuKelvin
tuFahrenheit
tuRankine
tuReamur

Convertir entre unidades de tiempo:

tuMilliSeconds
tuSeconds
tuMinutes
tuHours
tuDays
tuWeeks
tuFortnights
tuMonths
tuYears
tuDecades
tuCenturies
tuMillennia
tuDateTime
tuJulianDate
tuModifiedJulianDate

Convertir entre unidades de volumen:

vuCubicMillimeters
vuCubicCentimeters
vuCubicDecimeters
vuCubicMeters
vuCubicDecameters
vuCubicHectometers
vuCubicKilometers
vuCubicInches
vuCubicFeet
vuCubicYards
vuCubicMiles
vuMilliLiters
vuCentiLiters
vuDeciLiters
vuLiters
vuDecaLiters
vuHectoLiters
vuKiloLiters
vuAcreFeet
vuAcreInches
vuCords
vuCordFeet
vuDecisteres
vuSteres
vuDecasteres
vuFluidGallons
vuFluidQuarts
vuFluidPints
vuFluidCups
vuFluidGills
vuFluidOunces
vuFluidTablespoons
vuFluidTeaspoons
vuDryGallons
vuDryQuarts
vuDryPints
vuDryPecks
vuDryBuckets
vuDryBushels
vuUKGallons
vuUKPottles
vuUKQuarts
vuUKPints
vuUKGills
vuUKOunces
vuUKPecks
vuUKBuckets
vuUKBushels

Pruebas realizadas en Delphi 7.

01 agosto 2007

Tipos de puntero

Pointer:

- Es un tipo general de puntero hacia cualquier objeto o variable en memoria.
- Al no ser de ningún tipo suele ser bastante peligroso si provoca desbordamientos de memoria.

PAnsiChar:

- Es un tipo de puntero hacia un valor AnsiChar.
- También puede ser utilizado para apuntar a caracteres dentro de una cadena AnsiString.
- Al igual que otros punteros permite la aritmética, es decir, los procedimientos Inc y Dec pueden utilizarse para mover el puntero en memoria.

PAnsiString:

- Apunta hacia una cadena AnsiString.
- Debido a que AnsiString ya es un puntero hacia si misma, el puntero PAnsiString no suele utilizarse mucho.

PChar:

- Es un tipo de puntero hacia un valor Char.
- Puede ser utilizado para apuntar a caracteres dentro de una cadena string.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.
- Suele utilizarse mucho para procesar cadenas de caracteres terminadas en cero, tal como las utilizadas en el lenguaje C/C++.
- Los caracteres Char son idénticos a los de las variables AnsiChar, siendo de 8 bits de tamaño.

PCurrency:

- Apunta hacia un valor Currency.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PDateTime:

- Apunta hacia un valor TDateTime.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PExtended:

- Apunta hacia un valor Extended.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PInt64:

- Apunta hacia un valor Int64.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PShortString:

- Apunta hacia una cadena ShortString.
- Debido a que las variables ShortString difieren de las variables string,
para apuntar a una variable ShortString es necesario utilizar la función Addr.

PString:

- Apunta hacia una cadena String.
- Al ser la cadena String un puntero en si misma no suele utilizarse mucho este puntero.

PVariant:

- Apunta hacia un valor Variant.
- Al ser Variant un tipo genérico y variable hay que extremar la precaución en el manejo de este puntero.

PWideChar:

- Apunta hacia un valor WideChar.
- Puede ser utilizado para apuntar a caracteres dentro de una cadena WideString.
- Permite aritmética de punteros mediante los procedimientos Inc y Dec.

PWideString:

- Apunta hacia una cadena WideString.
- Al ser ya cadena WideString un puntero en si misma no suele utilizarse mucho.

Pruebas realizadas en Delphi 7.

31 julio 2007

Tipos de variable para el manejo de caracteres

AnsiChar:

- Permite el almacenamiento de un carácter o un número entero.
- Valores comprendidos entre 0 y 255.
- Gasta un byte de memoria (8 bits).

AnsiString:

- Un tipo de dato que almacena una cadena de caracteres tipo AnsiChar.
- Cada carácter gasta un byte de memoria (8 bits), aunque la longitud de la cadena puede ser ilimitada.
- Al ser su contenido dinámico gastará tantos bytes como caracteres tenga la cadena en ese momento.
- El primer elemento comienza por [1].

ShortString:

- Variable para guardar un simple carácter o un número entero.
- Valores comprendidos entre 0 y 255.
- Al ser su contenido dinámico gastará tantos bytes como caracteres tenga la cadena en ese momento.
- Permite un máximo de 255 caracteres.
- El primer elemento comienza por [1].

String:

- Un tipo de dato que almacena una cadena de caracteres.
- Cuando se crea es tratado como AnsiString.
- La longitud es ilimitada siendo cada carácter de un byte (8 bits).
- El primer elemento comienza por [1].

WideChar:

- Almacena un carácter internacional.
- Puede guardar un carácter o un número entero entre 0 y 65535.
- Gasta 2 bytes de memoria (16 bits).

WideString:

- Un tipo de dato que almacena una cadena de caracteres tipo WideChar.
- Cada carácter gasta 2 bytes de memoria (16 bits), aunque la longitud de la cadena puede ser ilimitada.
- Al ser su contenido dinámico gastará tantos bytes como caracteres tenga la cadena en ese momento.
- El primer elemento comienza por [1].

Pruebas realizadas en Delphi 7.

30 julio 2007

Los tipos reales en Delphi

Currency:

- Tipo flotante de punto fijo con 4 decimales usado para valores financieros, minimizando así los errores de redondeo (recomendado para programas de gestión).
- Gasta 8 bytes de memoria (64 bits).

Double:

- Tipo flotante de uso general.
- Soporta hasta 15 dígitos de precisión.
- Gasta 8 bytes de memoria (64 bits).

Extended:

- Tipo flotante con alta capacidad y precisión.
- Soporta hasta 19 dígitos de precisión.
- Gasta 10 bytes de memoria (80 bits).

Real:

- Tipo flotante general obsoleto mantenido por compatibilidad hacia atrás (usar Double en su lugar).
- Soporta hasta 15 dígitos de precisión.
- Gasta 8 bytes de memoria (64 bits).

Real48:

- Tipo flotante general obsoleto mantenido por compatibilidad hacia atrás (usar Extended en su lugar).
- Soporta hasta 11 dígitos de precisión.
- Gasta 6 bytes de memoria (48 bits).

Single:

- El tipo flotante que tiene menos capacidad y precisión, aunque es el más rápido de procesar.
- Soporta hasta 7 dígitos de precisión.
- Gasta 4 bytes de memoria (32 bits).

Pruebas realizadas en Delphi 7.

27 julio 2007

Los tipos enteros en Delphi

Byte:

- Tipo entero que soporta valores entre 0 y 255.
- Gasta un byte de memoria (8 bits).

Cardinal:

- Tipo entero básico sin signo.
- Soporta valores entre 0 y 4294967295.
- Gasta 4 bytes de memoria (32 bits).

Integer:

- Tipo entero con signo.
- Soporta valores entre -2147483648 y 2147483647.
- Gasta 4 bytes de memoria (32 bits)

Int64:

- Tipo entero con signo.
- Alcanza valores desde -9223372036854775808 hasta 9223372036854775807.
- Gasta 8 bytes de memoria (64 bits).

LongInt:

- Tipo entero con signo.
- Valores comprendidos entre -2147483648 y 2147483647.
- Gasta 4 bytes de memoria (32 bits).
- Es un tipo fijo que no cambiará en futuras versiones de Delphi.

LongWord:

- Tipo entero sin signo.
- Valores comprendidos entre 0 y 4294967295.
- Gasta 4 bytes de memoria (32 bits).

DWord:

- Igual que LongWord;

ShortInt:

- Tipo entero con signo.
- Valores comprendidos entre -128 y 127.
- Gasta 1 byte de memoria (8 bits).

SmallInt:

- Tipo entero con signo.
- Valores comprendidos entre -32768 y 32767.
- Gasta 2 bytes de memoria (16 bits).

Word:

- Tipo entero sin signo.
- Valores comprendidos entre 0 y 65535.
- Gasta 2 bytes de memoria (16 bits).

Pruebas realizadas en Delphi 7.

26 julio 2007

Trabajando con arrays dinámicos

Una de las ventajas de los arrays dinámicos respecto a los estáticos es que pueden modificar su tamaño en tiempo de ejecución y no es necesaria la gestión de memoria para los mismos, ya que se liberan automáticamente al terminar el procedimiento, función o clase donde están alojados. También son ideales para enviar un número indeterminado de parámetros a funciones o procedimientos.

Para crear una array dinámico lo que hacemos es declarar el array pero sin especificar su tamaño:

public
Clientes: array of string;

Antes de meter un elemento al array hay que especificar su tamaño con la función SetLength. En este ejemplo creamos tres elementos:

SetLength( Clientes, 3 );

Y ahora introducimos los datos en el mismo:

Clientes[0] := 'JUAN';
Clientes[1] := 'CARLOS';
Clientes[2] := 'MARIA';

A diferencia de los arrays estáticos el primer elemento es el cero y no
el uno. Como he dicho antes no es necesario liberarlos de memoria, pero
si aún así deseamos hacerlo sólo es necesario hacer lo siguiente:

Clientes := nil;

con lo cual el array queda inicializado para que pueda volver a ser utilizado.

Pruebas realizadas en Delphi 7.

25 julio 2007

Clonar las propiedades de un control

Cuantas veces hemos deseado en tiempo de ejecución copiar las características de un control a otro según las acciones del usuario. Por ejemplo si tenemos nuestro propio editor de informes se podrían copiar las carácterísticas de las etiquetas seleccionas por el usuario al resto del formulario (font, color, width, etc.)

Para ello tenemos que añadir la unidad TypInfo:


uses
Windows, Dialogs, ..., TypInfo;

A esta función que voy a mostrar hay que pasarle el control origen y el destino (la copia) así como que propiedades deseamos copiar:

function ClonarPropiedades( Origen, Destino: TObject;
Propiedades: array of string ): Boolean;
var
i: Integer;
begin
Result := True;
try
for i := Low( Propiedades ) to High( Propiedades ) do
begin
// ¿Existe la propiedad en el control origen?
if not IsPublishedProp( Origen, Propiedades[I] ) then
Continue;

// ¿Existe la propiedad en el control destino?
if not IsPublishedProp( Destino, Propiedades[I] ) then
Continue;

// ¿Son del mismo tipo las dos propiedades?
if PropType( Origen, Propiedades[I]) <>
PropType( Destino, Propiedades[I] ) then
Continue;

// Copiamos la propiedad según si es variable o método
case PropType(Origen, Propiedades[i]) of
tkClass:
SetObjectProp( Destino, Propiedades[i],
GetObjectProp( Origen, Propiedades[i] ) );

tkMethod:
SetMethodProp( Destino, Propiedades[I],
GetMethodProp( Origen, Propiedades[I] ) );
else
SetPropValue( Destino, Propiedades[i],
GetPropValue( Origen, Propiedades[i] ) );
end;
end;
except
Result := False;
end;
end;

Para copiar las características principales de una etiqueta habría que llamar a la función de la siguiente manera:

ClonarPropiedades( Label1, Label2, ['Font', 'Color', 'Alignment',
'Width', 'Height', 'Layout'] );

También se pueden copiar eventos tales como OnClick, OnMouseDown, etc. permitiendo así abarcar muchos controles con un solo evento.

Pruebas realizadas en Delphi 7.

24 julio 2007

Aplicar antialiasing a una imagen

El algoritmo antialiasing se suele aplicar a una imagen para evitar los bordes dentados y los degradados bruscos de color. Lo que hace es suavizar toda la imagen.

En este caso el siguiente procedimiento toma un objeto TImage como primer parámetro y como segundo el porcentaje de antialiasing deseado, siendo normal no aplicar más del 10 o 20%:

procedure Antialiasing( Imagen: TImage; iPorcentaje: Integer );
type
TRGBTripleArray = array[0..32767] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
var
SL, SL2: PRGBTripleArray;
l, m, p: Integer;
R, G, B: TColor;
R1, R2, G1, G2, B1, B2: Byte;
begin
with Imagen.Canvas do
begin
Brush.Style := bsClear;
Pixels[1, 1] := Pixels[1, 1];

for l := 0 to Imagen.Height - 1 do
begin
SL := Imagen.Picture.Bitmap.ScanLine[l];

for p := 1 to Imagen.Width - 1 do
begin
R1 := SL[p].rgbtRed;
G1 := SL[p].rgbtGreen;
B1 := SL[p].rgbtBlue;

if (p < 1) then
m := Imagen.Width
else
m := p - 1;

R2 := SL[m].rgbtRed;
G2 := SL[m].rgbtGreen;
B2 := SL[m].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL[m].rgbtRed := R;
SL[m].rgbtGreen := G;
SL[m].rgbtBlue := B;
end;

if ( p > Imagen.Width - 2 ) then
m := 0
else
m := p + 1;

R2 := SL[m].rgbtRed;
G2 := SL[m].rgbtGreen;
B2 := SL[m].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL[m].rgbtRed := R;
SL[m].rgbtGreen := G;
SL[m].rgbtBlue := B;
end;

if ( l < 1 ) then
m := Imagen.Height - 1
else
m := l - 1;

SL2 := Imagen.Picture.Bitmap.ScanLine[m];
R2 := SL2[p].rgbtRed;
G2 := SL2[p].rgbtGreen;
B2 := SL2[p].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL2[p].rgbtRed := R;
SL2[p].rgbtGreen := G;
SL2[p].rgbtBlue := B;
end;

if ( l > Imagen.Height - 2 ) then
m := 0
else
m := l + 1;

SL2 := Imagen.Picture.Bitmap.ScanLine[m];
R2 := SL2[p].rgbtRed;
G2 := SL2[p].rgbtGreen;
B2 := SL2[p].rgbtBlue;

if ( R1 <> R2 ) or ( G1 <> G2 ) or ( B1 <> B2 ) then
begin
R := Round( R1 + ( R2 - R1 ) * 50 / ( iPorcentaje + 50 ) );
G := Round( G1 + ( G2 - G1 ) * 50 / ( iPorcentaje + 50 ) );
B := Round( B1 + ( B2 - B1 ) * 50 / ( iPorcentaje + 50 ) );
SL2[p].rgbtRed := R;
SL2[p].rgbtGreen := G;
SL2[p].rgbtBlue := B;
end;
end;
end;
end;
end;

Suponiendo que tengamos en un formulario un objeto TImage llamado Image1 llamaríamos a este procedimiento de la siguiente manera:

Antialiasing( Image1, 10 );

Pruebas realizadas en Delphi 7.

23 julio 2007

Dibujar varias columnas en un ComboBox

Vamos a ver un ejemplo de dibujar tres columnas al desplegar un ComboBox. El truco está en guardar el valor de las tres columnas en el mismo item pero separado por un punto y coma.

Después implementamos nuestra propia función de dibujado de columnas para que muestre las tres columnas. Para ello metemos en el evento OnDrawItem del ComboBox:

procedure TFormulario.ComboBoxDrawItem( Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState );
var
sValor, sTodo: string;
i, iPos: Integer;
rc: TRect;
AnchoColumna: array[0..3] of Integer;
begin
ComboBox.Canvas.Brush.Style := bsSolid;
ComboBox.Canvas.FillRect( Rect );

// Las columnas deben ir separadas por un ;
sTodo := ComboBox.Items[Index];

// Establecemos el ancho de las columnas
AnchoColumna[0] := 0;
AnchoColumna[1] := 100; // Ancho de la columna 1
AnchoColumna[2] := 200; // Ancho de la columna 2
AnchoColumna[3] := 300; // Ancho de la columna 3

// Leemos el texto de la primera columna
iPos := Pos( ';', sTodo );
sValor := Copy( sTodo, 1, iPos - 1 );

for i := 0 to 3 do
begin
// Dibujamos la primera columna
rc.Left := Rect.Left + AnchoColumna[i] + 2;
rc.Right := Rect.Left + AnchoColumna[i+1] - 2;
rc.Top := Rect.Top;
rc.Bottom := Rect.Bottom;

// Escribimos el texto
Combobox.Canvas.TextRect( rc, rc.Left, rc.Top, sValor );

// Dibujamos las líneas que separan las columnas
if i < 3 then
begin
Combobox.Canvas.MoveTo( rc.Right, rc.Top );
Combobox.Canvas.LineTo( rc.Right, rc.Bottom );
end;

// Leemos el texto de la segunda columna
sTodo := Copy( sTodo, iPos + 1, Length( sTodo ) - iPos );
iPos := Pos( ';', sTodo );
sValor := Copy( sTodo, 1, iPos - 1 );
end;
end;

Modificando el bucle y el array de enteros AnchoColumna podemos crear el número de columnas que queramos. Ahora sólo hay que meter los items en el ComboBox separados por punto y coma:

with Combobox.Items do
begin
Add( 'JOSE;SANCHEZ;GARCIA;' );
Add( 'MARIA;PEREZ;GOMEZ;' );
Add( 'ANDRES;MARTINEZ;RUIZ;' );
end;

Por último hay que decirle al ComboBox que la rutina de pintar los items corre por nuestra cuenta:

procedure TFormulario.FormCreate(Sender: TObject);
begin
// Le decimos al ComboBox que lo vamos a pintar nosotros
Combobox.Style := csOwnerDrawFixed;
end;

Pruebas realizadas en Delphi 7.

20 julio 2007

Generar claves aleatorias

El siguiente procedimiento que voy a mostrar genera una clave aleatoria según el número de sílabas y números que le indiquemos. Por ejemplo:

GenerarClave( 3, 2 )

puede devolver:

catamo56
dilema12
catoye97
...

Aquí tenemos el generador de claves:

function GenerarClave( iSilabas, iNumeros: Byte ): string;
const
Consonante: array [0..19] of Char = ( 'b', 'c', 'd', 'f', 'g', 'h', 'j',
'k', 'l', 'm', 'n', 'p', 'r', 's',
't', 'v', 'w', 'x', 'y', 'z' );

Vocal: array [0..4] of Char = ( 'a', 'e', 'i', 'o', 'u' );

function Repetir( sCaracter: String; iVeces: Integer ): string;
var
i: Integer;
begin
Result := '';
for i := 1 to iVeces do
Result := Result + sCaracter;
end;

var
i: Integer;
si, sf: Longint;
n: string;
begin
Result := '';
Randomize;

if iSilabas <> 0 then
for i := 1 to iSilabas do
begin
Result := Result + Consonante[Random(19)];
Result := Result + Vocal[Random(4)];
end;

if iNumeros = 1 then
Result := Result + IntToStr(Random(9))
else
if iNumeros >= 2 then
begin
if iNumeros > 9 then
iNumeros := 9;

si := StrToInt('1' + Repetir( '0', iNumeros - 1 ) );
sf := StrToInt( Repetir( '9', iNumeros ) );
n := FloatToStr( si + Random( sf ) );
Result := Result + Copy( n, 0, iNumeros );
end;
end;

Suele utilizarse en la creación de cuentas de usuario y departamentos en programas de gestión, dejando que posteriormente el usuario pueda cambiarse la clave.

Pruebas realizadas en Delphi 7.

19 julio 2007

Meter recursos dentro de un ejecutable

Una de las cosas que mas hacen engordar el tamaño de un ejecutable es meter los mismos botones con imagenes en distintos formularios. Si diseñamos nuestros propios botones Aceptar y Cancelar y los vamos replicando en cada formulario el tamaño de nuestro programa puede crecer considerablemente.

Para evitar esto lo que vamos a hacer es meter la imagen dentro de un recurso compilado y posteriormente accederemos a la misma dentro del programa. La ventaja de utilizar este método es que la imagen sólo esta una vez en el programa independientemente del número de formularios donde vaya a aparecer.

Supongamos que vamos a meter la imagen MiBoton.jpg dentro de nuestro programa. Creamos al lado de la misma el archivo imagenes.rc el cual contiene:

1 RCDATA MiBoton.jpg

Se pueden meter en un archivo de recursos tantas imagenes como se desee, así como otros tipos de archivo (sonidos, animaciones flash, etc.). Las siguientes líneas serían:

2 RCDATA imagen2.jpg
3 RCDATA imagen3.jpg
...

Ahora abrimos una ventana de símbolo del sistema dentro del mismo directorio donde este la imagen y compilamos el recurso:

c:\imagenes\brc32 -r -v imagenes.rc

Lo cual nos creará el archivo imagenes.res.

Ahora para utilizar el recurso dentro de nuestro programa hay que añadir debajo de implementation (del formulario principal de la aplicación) la directiva {$R imagenes.res}:

implementation

{$R *.dfm}
{$R imagenes.res}

Esto lo que hace es unir todos los recursos de imagenes.res con nuestro ejecutable. Para cargar la imagen dentro de un objeto TImage hacemos lo siguiente:

procedure TFPrincipal.FormCreate( Sender: TObject );
var
Recursos: TResourceStream;
Imagen: TJPegImage;
begin
Imagen := TJPegImage.Create;
Recursos := TResourceStream.Create( hInstance, '#1', RT_RCDATA );
Recursos.Seek( 0, soFromBeginning );
Imagen.LoadFromStream( Recursos );
Imagen1.Canvas.Draw( 0, 0, Imagen );
Recursos.Free;
Imagen.Free;
end;

Donde Imagen1 es un objeto TImage. Aunque pueda parecer algo molesto tiene las siguientes ventajas:

- Evita que un usuario cualquiera utilice nuestras imagenes (a menos claro que sepa utilizar un editor de recursos).

- Facilita la distribución de nuestro programa (va todo en el exe).

- Se puede añadir cualquier tipo de archivo o dato dentro del ejecutable.

- Ahorramos mucha memoria al cargar una sola vez el recurso.

Pruebas realizadas en Delphi 7.

18 julio 2007

Dibujar un gradiente en un formulario

Con un sencillo procedimiento podemos hacer que el fondo de nuestros formularios quede con un aspecto profesional con un degradado de color. Para ello escribimos en el evento OnPaint del formulario:

procedure TFormulario.FormPaint( Sender: TObject );
var
wFila, wVertical: Word;
iRojo: Integer;
begin
iRojo := 200;
wVertical := ( ClientHeight + 512 ) div 256;

for wFila := 0 to 512 do
begin
with Canvas do
begin
Brush.Color := RGB( iRojo, 0, wFila );
FillRect( Rect( 0, wFila * wVertical, ClientWidth, ( wFila + 1 ) * wVertical ) );
Dec( iRojo );
end;
end;
end;

Lo que hace es crear un barrido vertical según el ancho y alto de nuestro formulario y va restando de la paleta RGB el componente rojo. Si queremos cambiar el color sólo hay que jugar con los componentes RGB hasta conseguir el efecto deseado.

Al maximizar o cambiar el ancho y alto de la ventana se quedará el degradado cortado. Para evitar esto le decimos en el evento OnResize que vuelva a pintar la ventana:

procedure TFormulario.FormResize( Sender: TObject );
begin
Repaint;
end;

Este efecto suele utilizarse mucho instalaciones o en CD-ROM interactivos, catálogos, etc.

Pruebas realizadas en Delphi 7.

17 julio 2007

Trocear y unir archivos

Una de las utilidades más famosas que se han asociado a la descarga de archivos es el programa Hacha, el cual trocea archivos a un cierto tamaño para luego poder unirlos de nuevo.

El siguiente procedimiento parte un archivo a la longitud en bytes que le pasemos:

procedure TrocearArchivo( sArchivo: TFileName; iLongitudTrozo: Integer );
var
i: Word;
FS, Stream: TFileStream;
sArchivoPartido: String;
begin
FS := TFileStream.Create( sArchivo, fmOpenRead or fmShareDenyWrite );

try
for i := 1 to Trunc( FS.Size / iLongitudTrozo ) + 1 do
begin
sArchivoPartido := ChangeFileExt( sArchivo, '.' + FormatFloat( '000', i ) );
Stream := TFileStream.Create( sArchivoPartido, fmCreate or fmShareExclusive );

try
if fs.Size - fs.Position < iLongitudTrozo then
iLongitudTrozo := FS.Size - FS.Position;

Stream.CopyFrom( FS, iLongitudTrozo );
finally
Stream.Free;
end;
end;
finally
FS.Free;
end;
end;

Si por ejemplo le pasamos el archivo Documentos.zip creará los archivos:

Documentos.001
Documentos.002
....

Para volver a unirlo tenemos otro procedimiento donde le pasamos el primer trozo y el nombre del archivo original:

procedure UnirArchivo( sTrozo, sArchivoOriginal: TFileName );
var
i: integer;
FS, Stream: TFileStream;
begin
i := 1;
FS := TFileStream.Create( sArchivoOriginal, fmCreate or fmShareExclusive );

try
while FileExists( sTrozo ) do
begin
Stream := TFileStream.Create( sTrozo, fmOpenRead or fmShareDenyWrite );

try
FS.CopyFrom( Stream, 0 );
finally
Stream.Free;
end;

Inc(i);
sTrozo := ChangeFileExt( sTrozo, '.' + FormatFloat( '000', i ) );
end;
finally
FS.Free;
end;
end;

Una ampliación interesante a estos procedimientos sería meter el nombre del archivo original en el primer o último trozo, así como un hash (MD4, MD5, SHA, etc.) para saber si algún trozo está defectuoso.

Pruebas realizadas en Delphi 7.

16 julio 2007

Mover componentes en tiempo de ejecución

Para darle un toque profesional a un programa no esta mal añadir un editor que permita al usuario personalizar sus formularios, informes o listados. Por ejemplo en un programa de facturación sería interesante que el usuario pudiera personalizar el formato de su factura.

Antes de nada hay que crear en la sección private del formulario tres variables encargadas de guardar las coordenadas del componente que se esta moviendo así como una variable booleana que nos dice si en este momento se esta moviendo un componente:

private
{ Private declarations }
iComponenteX, iComponenteY: Integer;
bMoviendo: Boolean;

Creamos dentro de type la definición de un control movible:

type
TMovible = class( TControl );

Los siguientes procedimientos hay que asignarlos a un componente para que puedan ser movidos por todo el formulario al ejecutar el programa:

procedure TFPrincipal.ControlMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
iComponenteX := X;
iComponenteY := Y;
bMoviendo := True;
TMovible( Sender ).MouseCapture := True;
end;

procedure TFPrincipal.ControlMouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
begin
if bMoviendo then
with Sender as TControl do
begin
Left := X - iComponenteX + Left;
Top := Y - iComponenteY + Top;
end;
end;

procedure TFPrincipal.ControlMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
if bMoviendo then
begin
bMoviendo := False;
TMovible( Sender ).MouseCapture := False;
end;
end;

Por ejemplo, si queremos mover una etiqueta por el formulario habría que asignar los eventos:

Label1.OnMouseDown := ControlMouseDown;
Label1.OnMouseUp := ControlMouseUp;
Label1.OnMouseMove := ControlMouseMove;

Con esto ya podemos crear nuestro propio editor de formularios sin tener que utilizar las propiedades DragKing y DragMode de los formularios que resultan algo engorrosas.

Pruebas realizadas en Delphi 7.

13 julio 2007

Averiguar los datos del usuario de Windows

Una de las mejores cosas que se pueden hacer en un programa cuando da un error es que nos envíe automáticamente los datos por correo electrónico. Pero es importante saber que usuario ha enviado el error dentro de la red local.

A continuación vamos a ver cuatro procedimientos que nos van a dar el nombre del usuario de Windows, el nombre de su PC en la red, su IP local y su IP pública.

Lo primero como siempre es añadir las unidades:

uses
Windows, Messages, ..., WinSock, IdHttp, WinInet;

Esta función nos devuelve el nombre del usuario:

function LeerUsuarioWindows: string;
var
sNombreUsuario: String;
dwLongitudNombre: DWord;
begin
dwLongitudNombre := 255;
SetLength( sNombreUsuario, dwLongitudNombre );

if GetUserName( PChar( sNombreUsuario ), dwLongitudNombre ) Then
Result := Copy( sNombreUsuario, 1, dwLongitudNombre - 1 )
else
Result := 'Desconocido';
end;

Y esta otra nos da el nombre del PC en la red:

function LeerNombrePC: string;
var
Buffer: array[0..255] of char;
dwLongitud: DWord;
begin
dwLongitud := 256;

if GetComputerName( Buffer, dwLongitud ) then
Result := Buffer
else
Result := ''
end;

La siguiente nos da la IP Local en la red:

function IPLocal: String;
var
p: PHostEnt;
s: array[0..128] of char;
p2: pchar;
wVersionRequested: WORD;
wsaData: TWSAData;
begin
// Arranca la librería WinSock
wVersionRequested := MAKEWORD( 1, 1 );
WSAStartup( wVersionRequested, wsaData );

// Obtiene el nombre del PC
GetHostName( @s, 128 );
p := GetHostByName( @s );

// Obtiene la dirección IP y libera la librería WinSock
p2 := iNet_ntoa( PInAddr( p^.h_addr_list^ )^ );
Result := Result + p2;
WSACleanup;
end;

Y esta última lo que hace es decirnos nuestra IP pública conectando con el servidor dyndns.org y utiliza el componente Indy HTTP el cual leer el contenido del HTML:

function IP_Publica: string;

function EsNumerico( S: string ): Boolean;
begin
Result := false;
if ( Length( S ) > 0 ) then
case S[1] of
'0'..'9': Result := True;
end;
end;
var
HTMLBody: string;
i: Integer;
IdHTTP: TIdHTTP;
begin
Result := '';

// ¿Estamos conectados a Internet?
if WinInet.InternetGetConnectedState( nil, 0 ) then
begin
IdHTTP := TIdHTTP.Create( Application );

try
HTMLBody := IdHTTP.Get( 'http://checkip.dyndns.org/' );

for i := 0 to Length( HTMLBody ) - 1 do
begin
if EsNumerico( HTMLBody[i] ) or ( HTMLBody[i] = '.' ) then
Result := Result + HTMLBody[i];
end;

finally
IdHTTP.Free;
end;
end;
end;

Pruebas realizadas en Delphi 7.

12 julio 2007

Leer la cabecera PE de un programa

¿Queréis verle las tripas a un archivo EXE? El siguiente procedimiento que voy a mostrar lee la cabecera PE de los archivos ejecutables y nos informa del punto de entrada del programa, el estado de los registros, la pila, etc.

Un archivo ejecutable se compone de distintas cabeceras dentro del mismo, ya sea si se va a ejecutar dentro del antiguo sistema operativo MS-DOS o en cualquier versión de Windows.

El siguiente procedimiento toma como parámetro un archivo ejecutable y lo guarda en un supuesto campo memo llamado INFORMACION que se encuentra en el formulario FPrincipal:

procedure TFPrincipal.ExaminarEXE( sArchivo: String );
var
FS: TFilestream;
Firma: DWORD;
Cabecera_dos: IMAGE_DOS_HEADER;
Cabecera_pe: IMAGE_FILE_HEADER;
Cabecera_opc: IMAGE_OPTIONAL_HEADER;
begin
INFORMACION.Clear;

FS := TFilestream.Create( sArchivo, fmOpenread or fmShareDenyNone );

try
FS.Read( Cabecera_dos, SizeOf( Cabecera_dos ) );

if Cabecera_dos.e_magic <> IMAGE_DOS_SIGNATURE then
begin
INFORMACION.Lines.Add( 'Cabecera DOS inválida' );
Exit;
end;

LeerCabeceraDOS( Cabecera_dos, INFORMACION.Lines );

FS.Seek( Cabecera_dos._lfanew, soFromBeginning );
FS.Read( Firma, SizeOf( Firma ) );

if Firma <> IMAGE_NT_SIGNATURE then
begin
INFORMACION.Lines.Add( 'Cabecera PE inválida' );
Exit;
end;

FS.Read( Cabecera_pe, SizeOf( Cabecera_pe ) );
LeerCabeceraPE( Cabecera_pe, INFORMACION.Lines );

if Cabecera_pe.SizeOfOptionalHeader > 0 then
begin
FS.Read( Cabecera_opc, SizeOf( Cabecera_opc ) );
LeerCabeceraOpcional( Cabecera_opc, INFORMACION.Lines );
end;
finally
FS.Free;
end;
end;

Éste a su vez llama a cada uno de los procedimientos que leen las cabeceras DOS, PE y opcional dentro del mismo EXE:

procedure LeerCabeceraDOS( const h: IMAGE_DOS_HEADER; Memo: TStrings );
begin
Memo.Add( 'Cabecera DOS del archivo' );
Memo.Add( Format( 'Número mágico: %d', [h.e_magic] ) );
Memo.Add( Format( 'Byes de la última página del archivo: %d', [h.e_cblp] ) );
Memo.Add( Format( 'Páginas en archivo: %d', [h.e_cp] ) );
Memo.Add( Format( 'Relocalizaciones: %d', [h.e_crlc] ) );
Memo.Add( Format( 'Tamaño de la cabecera en párrafos: %d', [h.e_cparhdr] ) );
Memo.Add( Format( 'Mínimo número de párrafos que necesita: %d', [h.e_minalloc] ) );
Memo.Add( Format( 'Máximo número de párrafos que necesita: %d', [h.e_maxalloc] ) );
Memo.Add( Format( 'Valor inicial (relativo) SS: %d', [h.e_ss] ) );
Memo.Add( Format( 'Valor inicial SP: %d', [h.e_sp] ) );
Memo.Add( Format( 'Checksum: %d', [h.e_csum]));
Memo.Add( Format( 'Valor inicial IP: %d', [h.e_ip] ) );
Memo.Add( Format( 'Valor inicial (relativo) CS: %d', [h.e_cs] ) );
Memo.Add( Format( 'Dirección del archivo de la tabla de relocalización: %d', [h.e_lfarlc] ) );
Memo.Add( Format( 'Número overlay: %d', [h.e_ovno]));
Memo.Add( Format( 'Identificador OEM (para e_oeminfo): %d', [h.e_oemid] ) );
Memo.Add( Format( 'Información OEM; específico e_oemid: %d', [h.e_oeminfo] ) );
Memo.Add( Format( 'Dirección de la nueva cabecera exe: %d', [h._lfanew] ) );
Memo.Add( '' );
end;

procedure LeerCabeceraPE( const h: IMAGE_FILE_HEADER; Memo: TStrings );
var
Fecha: TDateTime;
begin
Memo.Add( 'Cabecera PE del archivo' );
Memo.Add( Format( 'Máquina: %4x', [h.Machine]));

case h.Machine of
IMAGE_FILE_MACHINE_UNKNOWN : Memo.Add(' Máquina desconocida ' );
IMAGE_FILE_MACHINE_I386: Memo.Add( ' Intel 386. ' );
IMAGE_FILE_MACHINE_R3000: Memo.Add( ' MIPS little-endian, 0x160 big-endian ' );
IMAGE_FILE_MACHINE_R4000: Memo.Add( ' MIPS little-endian ' );
IMAGE_FILE_MACHINE_R10000: Memo.Add( ' MIPS little-endian ' );
IMAGE_FILE_MACHINE_ALPHA: Memo.Add( ' Alpha_AXP ' );
IMAGE_FILE_MACHINE_POWERPC: Memo.Add( ' IBM PowerPC Little-Endian ' );
$14D: Memo.Add( ' Intel i860' );
$268: Memo.Add( ' Motorola 68000' );
$290: Memo.Add( ' PA RISC' );
else
Memo.Add( ' tipo de máquina desconocida' );
end;

Memo.Add( Format( 'Número de secciones: %d', [h.NumberOfSections] ) );
Memo.Add( Format( 'Fecha y hora: %d', [h.TimeDateStamp] ) );
Fecha := EncodeDate( 1970, 1, 1 ) + h.Timedatestamp / SecsPerDay;
Memo.Add( FormatDateTime( ' c', Fecha ) );

Memo.Add( Format( 'Puntero a la tabla de símbolos: %d', [h.PointerToSymbolTable] ) );
Memo.Add( Format( 'Número de símbolos: %d', [h.NumberOfSymbols] ) );
Memo.Add( Format( 'Tamaño de la cabecera opcional: %d', [h.SizeOfOptionalHeader] ) );
Memo.Add( Format( 'Características: %d', [h.Characteristics] ) );

if ( IMAGE_FILE_DLL and h.Characteristics ) <> 0 then
Memo.Add(' el archivo es una' )
else
if (IMAGE_FILE_EXECUTABLE_IMAGE and h.Characteristics) <> 0 then
Memo.Add(' el archivo es un programa' );

Memo.Add('');
end;

procedure LeerCabeceraOpcional( const h: IMAGE_OPTIONAL_HEADER; Memo: TStrings );
begin
Memo.Add( 'Información sobre la cabecera PE de un archivo ejecutable EXE' );
Memo.Add( Format( 'Magic: %d', [h.Magic] ) );

case h.Magic of
$107: Memo.Add( ' Imagen de ROM' );
$10b: Memo.Add( ' Imagen de ejecutable' );
else
Memo.Add( ' Tipo de imagen desconocido' );
end;

Memo.Add( Format( 'Versión mayor del enlazador: %d', [h.MajorLinkerVersion] ) );
Memo.Add( Format( 'Versión menor del enlazador: %d', [h.MinorLinkerVersion]));
Memo.Add( Format( 'Tamaño del código: %d', [h.SizeOfCode]));
Memo.Add( Format( 'Tamaño de los datos inicializados: %d', [h.SizeOfInitializedData]));
Memo.Add( Format( 'Tamaño de los datos sin inicializar: %d', [h.SizeOfUninitializedData]));
Memo.Add( Format( 'Dirección del punto de entrada: %d', [h.AddressOfEntryPoint]));
Memo.Add( Format( 'Base de código: %d', [h.BaseOfCode]));
Memo.Add( Format( 'Base de datos: %d', [h.BaseOfData]));
Memo.Add( Format( 'Imagen base: %d', [h.ImageBase]));
Memo.Add( Format( 'Alineamiento de la sección: %d', [h.SectionAlignment]));
Memo.Add( Format( 'Alineamiento del archivo: %d', [h.FileAlignment]));
Memo.Add( Format( 'Versión mayor del sistema operativo: %d', [h.MajorOperatingSystemVersion]));
Memo.Add( Format( 'Versión mayor del sistema operativo: %d', [h.MinorOperatingSystemVersion]));
Memo.Add( Format( 'Versión mayor de la imagen: %d', [h.MajorImageVersion]));
Memo.Add( Format( 'Versión menor de la imagen: %d', [h.MinorImageVersion]));
Memo.Add( Format( 'Versión mayor del subsistema: %d', [h.MajorSubsystemVersion]));
Memo.Add( Format( 'Versión menor del subsistema: %d', [h.MinorSubsystemVersion]));
Memo.Add( Format( 'Valor de la versión Win32: %d', [h.Win32VersionValue]));
Memo.Add( Format( 'Tamaño de la imagen: %d', [h.SizeOfImage]));
Memo.Add( Format( 'Tamaño de las cabeceras: %d', [h.SizeOfHeaders]));
Memo.Add( Format( 'CheckSum: %d', [h.CheckSum]));
Memo.Add( Format( 'Subsistema: %d', [h.Subsystem]));

case h.Subsystem of
IMAGE_SUBSYSTEM_NATIVE:
Memo.Add( ' La imagen no requiere un subsistema. ' );

IMAGE_SUBSYSTEM_WINDOWS_GUI:
Memo.Add( ' La imagen se corre en un subsistema GUI de Windows. ' );

IMAGE_SUBSYSTEM_WINDOWS_CUI:
Memo.Add( ' La imagen corre en un subsistema terminal de Windows. ' );

IMAGE_SUBSYSTEM_OS2_CUI:
Memo.Add( ' La imagen corre sobre un subsistema terminal de OS/2. ' );

IMAGE_SUBSYSTEM_POSIX_CUI:
Memo.Add( ' La imagen corre sobre un subsistema terminal Posix. ' );
else
Memo.Add( ' Subsistema desconocido.' )
end;

Memo.Add( Format( 'Características DLL: %d', [h.DllCharacteristics]) );
Memo.Add( Format( 'Tamaño de reserva de la pila: %d', [h.SizeOfStackReserve]) );
Memo.Add( Format( 'Tamaño de trabajo de la pila: %d', [h.SizeOfStackCommit]) );
Memo.Add( Format( 'Tamaño del Heap de reserva: %d', [h.SizeOfHeapReserve]) );
Memo.Add( Format( 'Tamaño de trabajo del Heap: %d', [h.SizeOfHeapCommit]) );
Memo.Add( Format( 'Banderas de carga: %d', [h.LoaderFlags] ) );
Memo.Add( Format( 'Numeros RVA y tamaño: %d', [h.NumberOfRvaAndSizes] ) );
end;

Espero que os sea de utilidad si os gusta programar herramientas de administración de sistemas operativos Windows.

Pruebas realizadas en Delphi 7.

11 julio 2007

Leer las dimensiones de imágenes JPG, PNG y GIF

Si estáis pensando en crear un visor de fotografías aquí os traigo tres procedimientos que leen al ancho y alto de imagenes con extensión JPG, PNG y GIF leyendo los bytes de su cabecera. No hay para BMP ya que se puede hacer con un componente TImage.

Antes de nada hay que incluir una función que lee los enteros almacenados en formato del procesador motorola, que guarda los formatos enteros en memoria al contrario de los procesadores Intel/AMD:

function LeerPalabraMotorola( F: TFileStream ): Word;
type
TPalabraMotorola = record
case Byte of
0: ( Value: Word );
1: ( Byte1, Byte2: Byte );
end;
var
MW: TPalabraMotorola;
begin
F.Read( MW.Byte2, SizeOf( Byte ) );
F.Read( MW.Byte1, SizeOf( Byte ) );
Result := MW.Value;
end;

El siguiente procedimiento toma como parámetros la ruta y nombre de una imagen JPG, y dos variales enteras donde se almacenará el ancho y alto de la imagen:

procedure DimensionJPG( sArchivo: string; var wAncho, wAlto: Word );
const
ValidSig: array[0..1] of Byte = ($FF, $D8);
Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
Sig: array[0..1] of byte;
F: TFileStream;
x: integer;
Seg: byte;
Dummy: array[0..15] of byte;
Len: word;
iLongitudLinea: LongInt;
begin
FillChar( Sig, SizeOf( Sig ), #0 );

F := TFileStream.Create( sArchivo, fmOpenRead );
try
iLongitudLinea := F.Read( Sig[0], SizeOf( Sig ) );

for x := Low( Sig ) to High( Sig ) do
if Sig[x] <> ValidSig[x] then
iLongitudLinea := 0;

if iLongitudLinea > 0 then
begin
iLongitudLinea := F.Read( Seg, 1 );

while ( Seg = $FF ) and ( iLongitudLinea > 0 ) do
begin
iLongitudLinea := F.Read( Seg, 1 );

if Seg <> $FF then
begin
if ( Seg = $C0 ) or ( Seg = $C1 ) then
begin
iLongitudLinea := F.Read( Dummy[0], 3 ); // Nos saltamos estos bytes
wAlto := LeerPalabraMotorola( F );
wAncho := LeerPalabraMotorola( F );
end
else
begin
if not ( Seg in Parameterless ) then
begin
Len := LeerPalabraMotorola( F );
F.Seek( Len - 2, 1 );
F.read( Seg, 1 );
end
else
Seg := $FF; { Fake it to keep looping. }
end;
end;
end;
end;
finally
F.Free;
end;
end;

Lo mismo para una imagen PNG:

procedure DimensionPNG( sArchivo: string; var wAncho, wAlto: Word );
type
TPNGSig = array[0..7] of Byte;
const
ValidSig: TPNGSig = (137,80,78,71,13,10,26,10);
var
Sig: TPNGSig;
F: TFileStream;
x: Integer;
begin
FillChar( Sig, SizeOf( Sig ), #0 );
F := TFileStream.Create( sArchivo, fmOpenRead );
try
F.read( Sig[0], SizeOf( Sig ) );

for x := Low( Sig ) to High( Sig ) do
if Sig[x] <> ValidSig[x] then
Exit;

F.Seek( 18, 0 );
wAncho := LeerPalabraMotorola( F );
F.Seek( 22, 0 );
wAlto := LeerPalabraMotorola( F );
finally
F.Free;
end;
end;

Y para una imagen GIF:

procedure DimensionGIF( sArchivo: string; var wAncho, wAlto: Word );
type
TCabeceraGIF = record
Sig: array[0..5] of char;
ScreenWidth, ScreenHeight: Word;
Flags, Background, Aspect: Byte;
end;

TBloqueImagenGIF = record
Left, Top, Width, Height: Word;
Flags: Byte;
end;
var
F: file;
Cabecera: TCabeceraGIF;
BloqueImagen: TBloqueImagenGIF;
iResultado: Integer;
x: Integer;
c: char;
bEncontradasDimensiones: Boolean;
begin
wAncho := 0;
wAlto := 0;

if sArchivo = '' then
Exit;

{$I-}
FileMode := 0; // Sólo lectura
AssignFile( F, sArchivo );
Reset( F, 1);
if IOResult <> 0 then
Exit;

// Lee la cabecera y se asegura de que sea un archivo válido
BlockRead( F, Cabecera, SizeOf( TCabeceraGIF ), iResultado );

if ( iResultado <> SizeOf( TCabeceraGIF ) ) or ( IOResult <> 0 ) or
( StrLComp( 'GIF', Cabecera.Sig, 3 ) <> 0 ) then
begin
Close( F );
Exit;
end;

{ Skip color map, if there is one }
if ( Cabecera.Flags and $80 ) > 0 then
begin
x := 3 * ( 1 shl ( ( Cabecera.Flags and 7 ) + 1 ) );
Seek( F, x );
if IOResult <> 0 then
begin
Close( F );
Exit;
end;
end;

bEncontradasDimensiones := False;
FillChar( BloqueImagen, SizeOf( TBloqueImagenGIF ), #0 );

BlockRead( F, c, 1, iResultado );
while ( not EOF( F ) ) and ( not bEncontradasDimensiones ) do
begin
case c of
',': // Encontrada imagen
begin
BlockRead( F, BloqueImagen, SizeOf( TBloqueImagenGIF ), iResultado );
if iResultado <> SizeOf( TBloqueImagenGIF ) then
begin
Close( F );
Exit;
end;

wAncho := BloqueImagen.Width;
wAlto := BloqueImagen.Height;
bEncontradasDimensiones := True;
end;

'ÿ': // esquivar esto
begin
// Nada
end;

// No hacer nada, ignorar
end;

BlockRead( F, c, 1, iResultado );
end;

Close( F );
{$I+}
end;

Así no será necesario cargar toda la imagen para averiguar sus dimensiones.

Pruebas realizadas en Delphi 7.

10 julio 2007

Descargar un archivo de Internet sin utilizar componentes

Añadiendo a nuestro formulario la librería WinINet se pueden descargar archivos por HTTP con la siguiente función:

function DescargarArchivo( sURL, sArchivoLocal: String ): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
LongitudBuffer: DWORD;
F: File;
sMiPrograma: String;
begin
sMiPrograma := ExtractFileName( Application.ExeName );
hSession := InternetOpen( PChar( sMiPrograma ), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0 );

try
hURL := InternetOpenURL( hSession, PChar( sURL ), nil, 0, 0, 0 );

try
AssignFile( F, sArchivoLocal );
Rewrite( F, 1 );

repeat
InternetReadFile( hURL, @Buffer, SizeOf( Buffer ), LongitudBuffer );
BlockWrite( F, Buffer, LongitudBuffer );
until LongitudBuffer = 0;

CloseFile( F );
Result := True;
finally
InternetCloseHandle( hURL );
end
finally
InternetCloseHandle( hSession );
end
end;

El primer parámetro es la URL completa del archivo a descargar y el segundo la ruta y nombre del archivo donde se va a guardar en nuestro disco duro. Un ejemplo de llamada a la función sería:

DescargarArchivo( 'http:\\miweb.com\imagen.jpg', 'C:\Mis documentos\imagen.jpg' );

Pruebas realizadas en Delphi 7.

09 julio 2007

Averiguar el nombre del procesador y su velocidad

El registro de Windows suele almacenar gran cantidad de información no sólo de la configuración de los programas instalados, sino también el estado real del hardware de nuestro PC.

En esta ocasión vamos a leer el nombre del procesador y su velocidad desde nuestro programa. Antes de nada añadimos a uses:

uses
Windows, Messages, ..., Registry;

La siguiente función nos devuelve el nombre del procesador:

function NombreProcesador: string;
var
Registro: TRegistry;
begin
Result := '';
Registro := TRegistry.Create;

try
Registro.RootKey := HKEY_LOCAL_MACHINE;

if Registro.OpenKey( '\Hardware\Description\System\CentralProcessor\0', False ) then
Result := Registro.ReadString( 'Identifier' );
finally
Registro.Free;
end;
end;

Y esta otra nos da su velocidad (según la BIOS y el fabricante):

function VelocidadProcesador: string;
var
Registro: TRegistry;
begin
Registro := TRegistry.Create;
try
Registro.RootKey := HKEY_LOCAL_MACHINE;

if Registro.OpenKey( 'Hardware\Description\System\CentralProcessor\0', False ) then
begin
Result := IntToStr( Registro.ReadInteger( '~MHz' ) ) + ' MHz';
Registro.CloseKey;
end;
finally
Registro.Free;
end;
end;

Hay veces que dependiendo del procesador y del multiplicador de la BIOS casi nunca coincide la velocidad real que nos da Windows con la de verdad (sobre todo en procesadores AMD). Aquí tenemos otra función que calcula en un segundo la velocidad real del procesador con una pequeña rutina en ensamblador:

function CalcularVelocidadProcesador: Double;
const
Retardo = 500;
var
TimerHi, TimerLo: DWORD;
ClasePrioridad, Prioridad: Integer;
begin
ClasePrioridad := GetPriorityClass( GetCurrentProcess );
Prioridad := GetThreadPriority( GetCurrentThread );

SetPriorityClass( GetCurrentProcess, REALTIME_PRIORITY_CLASS );
SetThreadPriority( GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL );

Sleep( 10 );

asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;

Sleep( Retardo );

asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;

SetThreadPriority( GetCurrentThread, Prioridad );
SetPriorityClass( GetCurrentProcess, ClasePrioridad );

Result := TimerLo / ( 1000 * Retardo );
end;

Nos devuelve el resultado en una variable double, donde que podríamos sacar la información en pantalla de la siguiente manera:

ShowMessage( Format( 'Velocidad calculada: %f MHz', [CalcularVelocidadProcesador] ) );

Pruebas realizadas en Delphi 7.

Publicidad