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
eds2004 @ 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-7 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/descarga/p0012.zip
________________________________________________________________________

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: eds2004 @ 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
________________________________________________________________________