Boletín Pascal #12 - 15-DEC-2000
INDICE
1. UNAS PALABRAS DEL EDITOR
2. RECORTANDO UNA IMAGEN
3. OBTENIENDO LA VERSION DE UN EJECUTABLE O UNA BIBLIOTECA
4. OBTENIENDO EL TAMAÑO DE ARCHIVOS GRANDES
5. MOSTRANDO AYUDAS DE HERRAMIENTAS (HINTS) EN UNA BARRA DE ESTADO
________________________________________________________________________
1. UNAS PALABRAS DEL EDITOR
En el próximo número publicaremos otro artículo de Alirio Gavidia que
nos enseñará como hacer formularios no rectangulares y nos mostrará
como hacer un reloj analógico redondo.
Saludos,
Ernesto De Spirito
eds2008 @ latiumsoftware.com
________________________________________________________________________
JfControls Lib. Multilenguaje. Multiapariencia. Skins. Privilegios. Más
de 40 componentes integrados y personalizables. Múltiples problemas de
programación resueltos. Administración centralizada de recursos. Para
Delphi 3-2006 y C++ Builder 3-6. http://www.jfactivesoft.com/spindex.htm
________________________________________________________________________
2. RECORTANDO UNA IMAGEN
Este artículo le mostrará como seleccionar una región rectangular de una
imagen con el ratón y luego como recortar esa parte de la imagen.
Cuando el usuario presiona el botón del ratón sobre la imagen tenemos
que comenzar a dibujar el rectángulo de selección. Cada vez que el
usuario mueva el ratón con el botón presionado, tenemos que borrar el
rectángulo (restaurando la imagen que estaba detrás) y volver a dibujar
el rectángulo nuevamente. Cuando el usuario suelta el botón tenemos que
dejar de dibujar.
El problema principal tal vez sea como limpiar el rectángulo restaurando
la imagen que estaba detrás. Una forma de hacerlo es dibujando el
rectángulo con una pluma ("pen") XOR, que invierte los bits de color.
Dibujando el rectángulo una segunda vez en la misma posición, los bits
de color de vuelven a invertir nuevamente y consiguientemente sus
valores originales son restaurados.
Para probar esto, cree una aplicación nueva y genere el evento OnCreate
del formulario:
procedure TForm1.FormCreate(Sender: TObject);
begin
with Image1.Canvas.Pen do begin
Style := psDot;
Mode := pmXor;
end;
end;
Luego coloque una imagen (Image) en el formulario y en el Inspector de
Objetos establezca la propiedad Align a alClient, y luego genere los
eventos OnMouseDown, OnMouseMove y OnMouseUp:
procedure TForm1.Image1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if RectVisible then DrawRectangle;
p1.x := X;
p1.y := Y;
p2.x := X;
p2.y := Y;
DrawRectangle;
Drawing := True;
RectVisible := True;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if Drawing then begin
DrawRectangle;
p2.x := X;
p2.y := Y;
DrawRectangle;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Drawing := False;
end;
Como puede ver, hemos usado cuatro variables y un procedimientos que
necesitamos declarar, por ejemplo en la sección privada del formulario:
type
TForm1 = class(TForm)
...
private
{ Private declarations }
RectVisible: boolean; // ¿El rectángulo está visible?
Drawing: boolean; // ¿Estamos dibujando el rectángulo?
p1, p2: TPoint; // Esquina del rectángulo de selección
procedure DrawRectangle;
public
{ Public declarations }
end;
Implementamos DrawRectangle como sigue:
procedure TForm1.DrawRectangle;
var
p: array [0..4] of TPoint;
begin
p[0] := p1;
p[1].x := p2.x;
p[1].y := p1.y;
p[2] := p2;
p[3].x := p1.x;
p[3].y := p2.y;
p[4] := p1;
Image1.Canvas.Polyline(p);
end;
Hemos elegido dibujar el rectángulo usando Polyline porque usa el estilo
(Style) de la pluma (Pen) del lienzo (Canvas).
Puede probar esta primera parte del ejemplo para ver como puede dibujar
un rectángulo arrastrando el ratón sobre la imagen.
Para la segunda parte del ejemplo, agregue un OpenPictureDialog y
establezca sus propiedades como sigue:
Name = dlgOpenPicture
Filter =
All (*.jpg;*.jpeg;*.jpe;*.bmp;*.dib) *.jpg;*.jpeg;*.jpe;*.bmp;*.dib
JPEG Image File (*.jpg) *.jpg;*.jpeg;*.jpe
Bitmaps (*.bmp;*.dib) *.bmp;*.dib
Options =
ofReadOnly = True
ofHideReadOnly = True
ofPathMustExist = True
ofFileMustExist = True
ofNoTestFileCreate = True
ofEnableSizing = True
Luego agregue un Menú Principal (MainMenu) al formulario con los
siguientes elementos (Items):
Name = mnuLoad
Caption = '&Cargar'
Name = mnuClear
Caption = '&Limpiar'
Name = mnuCrop
Caption = '&Recortar'
Y luego genera sus respectivos eventos OnClick:
procedure TForm1.mnuLoadClick(Sender: TObject);
// Carga una imagen de un archivo
var
Jpg: TJpegImage;
FileExt: string;
begin
if dlgOpenPicture.Execute then begin
ClearRectangle;
Jpg := nil;
try
FileExt := LowerCase(ExtractFileExt(dlgOpenPicture.FileName));
if (FileExt = '.bmp') or (FileExt = '.dib') then
Image1.Picture.Bitmap.LoadFromFile(dlgOpenPicture.FileName)
else if (FileExt = '.jpg') or (FileExt = '.jpeg') or
(FileExt = '.jpe') then begin
Jpg := TJpegImage.Create;
Jpg.LoadFromFile(dlgOpenPicture.FileName);
Image1.Picture.Bitmap.Assign(Jpg);
end;
finally
jpg.Free;
with Image1.Canvas.Pen do begin
Style := psDot;
Mode := pmXor;
end;
end;
end;
end;
procedure TForm1.mnuClearClick(Sender: TObject);
// Limpia (borra) la imagen
begin
ClearRectangle;
Image1.Picture.Assign(nil);
with Image1.Canvas.Pen do begin
Style := psDot;
Mode := pmXor;
end;
end;
procedure TForm1.mnuCropClick(Sender: TObject);
// Recorta la imagen
var
m: longint;
bitmap: TBitmap;
SrcRect, DstRect: TRect;
begin
if not RectVisible then exit;
if (p1.x = p2.x) and (p1.y = p2.y) then exit;
// Remueve el rectángulo de selección
DrawRectangle;
RectVisible := False;
Drawing := False;
// Aseguramos que p1 sea la esquina superior izquierda
// y que p2 se la esquina inferior derecha
if p2.x < p1.x then begin
m := p1.x;
p1.x := p2.x;
p2.x := m;
end;
if p2.y < p1.y then begin
m := p1.y;
p1.y := p2.y;
p2.y := m;
end;
with Image1.Picture.Bitmap do begin
// Controlamos que las coordenadas estén dentro de la imagen
if p1.x >= Width then exit;
if p1.y >= Height then exit;
// Ajustamos las coordenadas si es necesario
if p2.x >= Width then p2.x := Width - 1;
if p2.y >= Width then p2.y := Height - 1;
end;
// Rectángulo de origen
SrcRect.TopLeft := p1;
SrcRect.BottomRight := p2;
// Rectángulo destino
DstRect.Left := 0;
DstRect.Right := p2.x - p1.x + 1;
DstRect.Top := 0;
DstRect.Bottom := p2.y - p1.y + 1;
// Creamos un bitmap temporal
bitmap := nil;
try
bitmap := TBitmap.Create;
bitmap.Width := DstRect.Right;
bitmap.Height := DstRect.Bottom;
// Copiamos la parte seleccionada de la imagen
bitmap.Canvas.CopyRect(DstRect, Image1.Canvas, SrcRect);
// Copiamos la parte a la imagen principal
Image1.Picture.Bitmap.Assign(bitmap);
with Image1.Canvas.Pen do begin
Style := psDot;
Mode := pmXor;
end;
finally
bitmap.Free;
end;
end;
Finalmente necesitamos declarar y definir (implementar) el procedimiento
ClearRectangle que detiene el dibujo del rectángulo y lo borra si está
visible:
type
TForm1 = class(TForm)
...
private
...
procedure ClearRectangle;
public
...
end;
implementation
procedure TForm1.ClearRectangle;
begin
Drawing := False;
if RectVisible then begin
DrawRectangle; // Remueve el rectángulo
RectVisible := False;
end;
end;
________________________________________________________________________
3. OBTENIENDO LA VERSION DE UN EJECUTABLE O UNA BIBLIOTECA
Para obtener los números de versión de un ejecutable o biblioteca puede
usar la siguiente función que devuelve True si los números de versión se
obtuvieron correctamente, y False si fracasó.
uses Windows, SysUtils;
function GetFileVersion(const FileName: TFileName;
var Major, Minor, Release, Build: word): boolean;
// Devuevelve True si tuvo éxito y False en caso contrario.
var
size, len: longword;
handle: THandle;
buffer: pchar;
pinfo: ^VS_FIXEDFILEINFO;
begin
Result := False;
size := GetFileVersionInfoSize(Pointer(FileName), handle);
if size > 0 then begin
GetMem(buffer, size);
if GetFileVersionInfo(Pointer(FileName), 0, size, buffer)
then
if VerQueryValue(buffer, '\', pointer(pinfo), len) then begin
Major := HiWord(pinfo.dwFileVersionMS);
Minor := LoWord(pinfo.dwFileVersionMS);
Release := HiWord(pinfo.dwFileVersionLS);
Build := LoWord(pinfo.dwFileVersionLS);
Result := True;
end;
FreeMem(buffer);
end;
end;
Puede usar esta función para obtener el número de versión de su
aplicación como se muestra aquí:
procedure TForm1.Button1Click(Sender: TObject);
var
Major, Minor, Release, Build: word;
begin
if GetFileVersion(Application.ExeName,
Major, Minor, Release, Build) then
ShowMessage(Format('Version %d.%d.%d.%d',
[Major, Minor, Release, Build]))
else
ShowMessage('Información de versión no disponible');
end;
Para incluir información de versión en su aplicación tiene que abrir el
diálogo Project Options, hacer clic en la solapa Version Info, y marcar
"Include version information in project".
________________________________________________________________________
4. OBTENIENDO EL TAMAÑO DE ARCHIVOS GRANDES
El campo Size de un registro TSearchRec y la propiedad Size de una
Stream (corriente) son enteros de 32 bits que pueden representar un
tamaño de archivo de hasta 4 GB, y por lo tanto no son útiles para
archivos que sobrepasan ese límite.
Para obtener el tamaño de esos archivos correctamente puede usar los
campos nFileSizeHigh y nFileSizeLow del campo FindData de TSearchRec
para "componer" el valor correcto. Por ejemplo, la siguiente función
devuelve el tamaño del archivo como un entero de 64 bits:
uses SysUtils, Windows;
function GetHugeFileSize(const Filename: TFileName): Int64;
var
SearchRec: TSearchRec;
begin
if FindFirst(Filename, faAnyFile, SearchRec) = 0 then begin
Result := (Int64(SearchRec.FindData.nFileSizeHigh) shl 32)
or SearchRec.FindData.nFileSizeLow;
FindClose(SearchRec);
end else
Result := 0;
end;
Creo que el tipo Int64 no está disponible en todas las versiones de
Delphi. Si no lo tiene, puede usar Double, Extended o Currency como se
muestra aquí:
function GetHugeFileSize2(const Filename: TFileName): Double;
var
SearchRec: TSearchRec;
begin
if FindFirst(Filename, faAnyFile, SearchRec) = 0 then begin
Result := MAXDWORD;
Result := (SearchRec.FindData.nFileSizeHigh * (Result + 1))
+ SearchRec.FindData.nFileSizeLow;
FindClose(SearchRec);
end else
Result := 0;
end;
En el caso de archivos abiertos, puede usar la API de Windows
GetFileSize para obtener el tamaño. La siguiente función compone un
valor Int64 de una manera diferente:
function GetHugeFileSize3(Handle: THandle): Int64;
var
i64: record
LoDWord: LongWord;
HiDWord: LongWord;
end;
begin
i64.LoDWord := GetFileSize(Handle, @i64.HiDWord);
if (i64.LoDWord = MAXDWORD) and (GetLastError <> 0) then
Result := 0
else
Result := PInt64(@i64)^;
end;
Sabiendo que en un valor Int64 la LongWord menos significativa se guarda
primero, declaramos un registro para contener las dwords baja y alta en
ese orden, mapeando el tipo Int64. Para obtener el resultado, primero
obtenemos la dirección del registro (con el operador @) y luego
convertimos ese puntero a PInt64 (un puntero a Int64) y finalmente
obtenemos el valor usando el operador de derreferencia (^).
Para llamar a esta función debemos proveer un manejador de archivo
válido. Por ejemplo:
procedure TForm1.Button1Click(Sender: TObject);
var
Stream: TFileStream;
begin
Stream := nil;
try
Stream := TFileStream.Create(Application.ExeName,
fmOpenRead or fmShareDenyNone);
ShowMessage(IntToStr(GetHugeFileSize3(Stream.Handle)));
finally
Stream.Free;
end;
end;
También podemos usar Double en vez de Int64:
function GetHugeFileSize4(Handle: THandle): Double;
var
LoDWord, HiDWord: LongWord;
begin
LoDWord := GetFileSize(Handle, @HiDWord);
if (LoDWord = MAXDWORD) and (GetLastError <> 0) then
Result := 0
else begin
Result := MAXDWORD;
Result := (HiDWord * (Result + 1)) + LoDWord;
end;
end;
________________________________________________________________________
5. MOSTRANDO AYUDAS DE HERRAMIENTAS (HINTS) EN UNA BARRA DE ESTADO
Cuando establece la propiedad Hint de un control, esa ayuda se muestra
en una pequeña ventanita, pero puede capturar el evento OnShowHint del
objeto Application para hacer lo que quiera, por ejemplo mostrar la
ayuda en una barra de estado. Para probarlo, cree una nueva aplicación
y agregue un botón y una barra de estado (StatusBar) al formulario, y
establezca las siguientes propiedades:
Form:
ShowHint = True
Button:
Hint = No haga clic en este botón
StatusBar:
SimplePanel = True
Luego declaramos y definimos el método que será llamado cuando ocurra el
evento ShowHint:
type
TForm1 = class(TForm)
...
private
{ Private declarations }
procedure ApplicationShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
public
{ Public declarations }
end;
...
implementation
...
procedure TForm1.ApplicationShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
begin
if HintInfo.HintControl = StatusBar1 then exit;
StatusBar1.SimpleText := HintStr;
CanShow := False;
end;
Lo primero que hacemos es verificar que el control que gatilla el evento
no sea la misma barra de estado. Luego establecemos el texto a mostrar
en la barra de estado y finalmente establecemos CanShow en False para
indicar que no queremos que aparezca la ventanita de la ayuda.
Por último, tenemos que decirle a la aplicación que llame este método
cuando ocurra el evento ShowHint, cosa que hacemos asignando la
propiedad OnShowHint del objeto Application, por ejemplo en el evento
Activate del formulario:
procedure TForm1.FormActivate(Sender: TObject);
begin
Application.HintPause := 250; // Demora de la ayuda en milisegundos
Application.OnShowHint := ApplicationShowHint;
end;
Puede probar el ejemplo para verlo funcionar. Mueva el ratón sobre el
botón para ver lo que sucede: en vez de mostrar la ayuda en una ventana,
debería ver el texto en la barra de estado.
Con unos pocos cambios al método ApplicationShowHint podemos agregar un
efecto interesante:
procedure TForm1.ApplicationShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
var
i: integer;
begin
if HintInfo.HintControl = StatusBar1 then exit;
StatusBar1.SimpleText := '';
for i := 1 to Length(HintStr) do begin
StatusBar1.SimpleText := Copy(HintStr, 1, i);
Application.ProcessMessages;
Sleep(10);
end;
CanShow := False;
end;
El código es simple y directo, pero no procesa correctamente algunos
eventos mientras está mostrando una ayuda. Por ejemplo no puede cerrar
el formulario hasta que termine el ciclo for..do, y el evento ShowHint
de otro control sería ignorado. Puede resolver estos problemas usando
un temporizador (Timer).
Agregue un temporizador al formulario y establezca las siguientes
propiedades:
Timer:
Enabled = False
Interval = 10
Declare las siguientes variables:
implementation
{$R *.DFM}
var
HintTxt: string;
HintLen, HintCnt: integer;
Genere el evento Timer del temporizador:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if HintCnt > HintLen then
Timer1.Enabled := False
else begin
StatusBar1.SimpleText := Copy(HintTxt, 1, HintCnt);
Inc(HintCnt);
end;
end;
Y finalmente modifique el método ApplicationShowHint:
procedure TForm1.ApplicationShowHint(var HintStr: String;
var CanShow: Boolean; var HintInfo: THintInfo);
begin
if HintInfo.HintControl = StatusBar1 then exit;
Timer1.Enabled := False;
StatusBar1.SimpleText := '';
HintLen := Length(HintStr);
if HintLen > 0 then begin
HintTxt := HintStr;
HintCnt := 1;
Timer1.Enabled := True;
end;
CanShow := False;
end;
________________________________________________________________________
Si no has recibido el archivo con el código fuente completo de los
ejemplos que se presentan en este boletín, puedes descargarlo de la
siguiente dirección: http://www.latiumsoftware.com/es/file.php?id=p12
________________________________________________________________________
Página principal: http://www.latiumsoftware.com/es/pascal/index.php
Página del grupo: http://espanol.groups.yahoo.com/group/boletin-pascal/
Para suscribirse / apuntarse: boletin-pascal-subscribe@gruposyahoo.com
Para cancelar / removerse: boletin-pascal-unsubscribe@gruposyahoo.com
Para reportar problemas con la suscripción: eds2008 @ latiumsoftware.com
________________________________________________________________________
Este boletín se provee "TAL Y COMO ESTA", sin garantía de ninguna clase.
Su uso implica la aceptación de nuestros términos de licencia y de la
ausencia de garantía que puedes leer en nuestro sitio web. Allí también
encontrarás una nota sobre marcas registradas. Te animamos a que redis-
tribuyas este boletín, siempre y cuando lo hagas en forma completa
(incluyendo la información de copyright), sin modificaciones y de manera
gratuita. Los artículos son copyright de sus respectivos autores y se
reproducen aquí con el permiso de los mismos.
________________________________________________________________________
Latium Software http://www.latiumsoftware.com/es/index.php
Copyright (c) 2000 por Ernesto De Spirito. Todos los derechos reservados
________________________________________________________________________
|
