Pascal Newsletter #12 - 15-DEC-2000

INDEX

1. A FEW WORDS FROM THE EDITOR
2. CROPPING AN IMAGE
3. GETTING THE VERSION OF AN EXECUTABLE OR LIBRARY
4. GETTING THE SIZE OF HUGE FILES
5. SHOWING HINTS IN A STATUS BAR

________________________________________________________________________


1. A FEW WORDS FROM THE EDITOR


In the next issue we will publish another article of Alirio Gavidia that
will teach us how to make non rectangular forms and will show us how to
make a round analog clock.

Regards,

Ernesto De Spirito
eds2004 @ latiumsoftware.com

________________________________________________________________________

JfControls Library. Multi-language. Multi-appearance. Skins. Privileges.
More than  40  integrated  and customizable components.  Impressive GUI.
Centralized  resources  administration.  Multiple  programming  problems
solved. For Delphi 3-7 and C++ Builder 3-6. http://www.jfactivesoft.com/
________________________________________________________________________


2. CROPPING AN IMAGE


This article will show you how to select a rectangular region of an
image with the mouse and then how to crop that part of the image.

When the user presses the mouse button over the image we have to start
drawing the selection rectangle. Every time the user moves the mouse
with the button pressed, we have to erase the rectangle (restoring the
image that was behind) and then draw the rectangle again. When the user
releases the button we have to stop drawing.

The main problem may be how to clear the rectangle restoring the image
that was behind. One way to do this is drawing the rectangle with a
XOR pen, that inverts the color bits. By drawing the rectangle for a
second time in the same position, the color bits are inverted again and
consequently their original values are restored.

To test this, create a new application and generate the OnCreate event
for the form:

  procedure TForm1.FormCreate(Sender: TObject);
  begin
    with Image1.Canvas.Pen do begin
      Style := psDot;
      Mode := pmXor;
    end;
  end;

Then place an Image on the form and in the Object Inspector set the
Align property to alClient, and generate the OnMouseDown, OnMouseMove
and OnMouseUp events:

  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;

As you can see, we used four variables and a procedure that we need to
declare, for example in the private section of the form:

  type

    TForm1 = class(TForm)
      ...
    private
      { Private declarations }
      RectVisible: boolean;     // Is the rectangle visible?
      Drawing: boolean;         // Are we drawing the rectangle?
      p1, p2: TPoint;           // Corners of the selection rectangle
      procedure DrawRectangle;
    public
      { Public declarations }
    end;

We implemented DrawRectangle as follows:

  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;

We chose drawing the rectangle using Polyline because it uses the style
of the Canvas' Pen property.

You can test the first part of the example to see how you can draw a
rectangle dragging the mouse over the image.

For the second part of the example, add an OpenPictureDialog and set its
properties as follows:

  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

Then add a MainMenu to the form with the following Items:

      Name = mnuLoad
      Caption = '&Load'

      Name = mnuClear
      Caption = '&Clear'

      Name = mnuCrop
      Caption = 'C&rop'

And then generate the OnClick events for them:

  procedure TForm1.mnuLoadClick(Sender: TObject);
  // Loads an image from a file
  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);
  // Clears the image
  begin
    ClearRectangle;
    Image1.Picture.Assign(nil);
    with Image1.Canvas.Pen do begin
      Style := psDot;
      Mode := pmXor;
    end;
  end;

  procedure TForm1.mnuCropClick(Sender: TObject);
  // Crops the image
  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;
    // Remove the selection rectangle
    DrawRectangle;
    RectVisible := False;
    Drawing := False;
    // Make p1 the upper-left corner and p2 the lower-left corner
    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
      // Check the coordinates are inside the image
      if p1.x >= Width then exit;
      if p1.y >= Height then exit;
      // Adjust the coordinates if necessary
      if p2.x >= Width then p2.x := Width - 1;
      if p2.y >= Width then p2.y := Height - 1;
    end;
    // Source rectangle
    SrcRect.TopLeft := p1;
    SrcRect.BottomRight := p2;
    // Destination rectangle
    DstRect.Left := 0;
    DstRect.Right := p2.x - p1.x + 1;
    DstRect.Top := 0;
    DstRect.Bottom := p2.y - p1.y + 1;
    // Create temporary bitmap
    bitmap := nil;
    try
      bitmap := TBitmap.Create;
      bitmap.Width := DstRect.Right;
      bitmap.Height := DstRect.Bottom;
      // Copy the selected part of the image
      bitmap.Canvas.CopyRect(DstRect, Image1.Canvas, SrcRect);
      // Copy the part to the main image
      Image1.Picture.Bitmap.Assign(bitmap);
      with Image1.Canvas.Pen do begin
        Style := psDot;
        Mode := pmXor;
      end;
    finally
      bitmap.Free;
    end;
  end;

Finally we need to declare and define the ClearRectangle procedure that
stops drawing the rectangle and clears it if it's visible:

  type

    TForm1 = class(TForm)
      ...
    private
      ...
      procedure ClearRectangle;
    public
      ...
    end;

  implementation

  procedure TForm1.ClearRectangle;
  begin
    Drawing := False;
    if RectVisible then begin
      DrawRectangle;             // Removes the rectangle
      RectVisible := False;
    end;
  end;

________________________________________________________________________


3. GETTING THE VERSION OF AN EXECUTABLE OR LIBRARY


To get the version number of an executable or library, you can use the
following function that returns True if the version numbers were
retrieved correctly, and False if it fails.

  uses Windows, SysUtils;

  function GetFileVersion(const FileName: TFileName;
     var Major, Minor, Release, Build: word): boolean;
  // Returns True on success and False on failure.
  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;

You can use this function to get the version number of your application,
as shown below:

  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('Version information not available');
  end;

To include version information in your application you have to open the
Project Options dialog, click the Version Info tab, and check "Include
version information in project".


________________________________________________________________________


4. GETTING THE SIZE OF HUGE FILES


The Size field of a TSearchRec record and the Size property of a Stream
are 32-bit integers and can represent a file size of up to 4 GB, and
therefore are not useful for files that surpass that limit.

To get the size of a such files correctly, you can use the nFileSizeHigh
and nFileSizeLow fields of the FindData field of TSearchRec to "compose"
the right value. For example, the following function returns the size of
a file as 64-bit integer:

	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;

I think the Int64 type isn't available in all Delphi versions. If you
don't have it, you can use Double, Extended or Currency as shown below:

  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;

In the case of open files, you can use the GetFileSize Windows API to
get the size. The following function composes an Int64 value in a
different way:

  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;

Knowing that in an Int64 value the least significant LongWord is stored
first, we declared a record to hold the low and high dwords in that
order, mapping an Int64 type. To obtain the result, first we get the
address of the record (with the @ operator) and then we cast that
pointer to PInt64 (a pointer to Int64) and finally we get the value
using the dereference operator (^).

To call this function, we have to provide a valid file handle. For
example:

  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;

We could also have used Double instead of 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. SHOWING HINTS IN A STATUS BAR


When you set the Hint property of a control, that hint is shown in a
little window, but you can capture the OnShowHint event of the
Application object to do what you want, for example showing the hint in
a status bar. To try it, start a new application and add a button and
a status bar to the form, and set the following properties:

   Form:
     ShowHint = True

   Button:
     Hint = Don't click this button

   StatusBar:
     SimplePanel = True

Then we declare and define the method that will be called when the
ShowHint event happens:

  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;

The first thing we do is check that the control that triggers the event
is not the status bar. Then we set the text to display in the status bar
and finally we set CanShow to False to indicate that we don't want the
hint window to appear.

Lastly, we have to tell the application to call this method when the
ShowHint event occurs, and we do so by assigning the OnShowHint
property of the Application object, for example in the Activate event
of the form:

  procedure TForm1.FormActivate(Sender: TObject);
  begin
    Application.HintPause := 250;  // hint delay in miliseconds
    Application.OnShowHint := ApplicationShowHint;
  end;

You can now test the example to see it working. Move the mouse over the
button to see what happens: instead of displaying the hint in a window,
you should see the text in the status bar.

With a few changes to the ApplicationShowHint method we can add an
interesting effect:

  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;

The code is simple and straight-forward, but it doesn't process
correctly some events while it is displaying a hint. For example, you
can't close the form until the for..do finishes, and the ShowHint of
another control would be ignored. You can solve these problems using a
Timer.

Add a timer to the form and set the following properties:

    Timer:
      Enabled = False
      Interval = 10

Declare the following variables:

  implementation

  {$R *.DFM}

  var
    HintTxt: string;
    HintLen, HintCnt: integer;


Generate the Timer event of the Timer:

  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;


And finally modify the ApplicationShowHint method:

  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;

________________________________________________________________________


YOU CAN HELP US


We need your help to keep this newsletter going and growing. You can
help by referring the newsletter to your colleagues:

  http://www.latiumsoftware.com/en/pascal/delphi-newsletter.php

Or you can help by voting for us in some or all of these rankings to
give more visibility to our web site and thus increase the number of
subscriptions to this newsletter:

http://www.sandbrooksoftware.com/cgi-bin/TopSite2/rankem.cgi?id=latium
http://news.optimax.com/delphi/links/links.exe/click?id=70C517ECAE6E
http://www.programmingpages.com/?r=latiumsoftwarecomenpascal
http://www.top219.org/cgi-bin/vote.cgi?delphi&83
http://top100borland.com/in.php?who=20
http://top200.jazarsoft.com/delphi/rank.php3?id=latium
http://213.65.224.200/cgi-bin/toplist.cgi/hits?Id=80

It's just a few seconds for you that REALLY mean a lot to us.

________________________________________________________________________

If you haven't  received the full  source code examples  for this issue,
you can  get them from  http://www.latiumsoftware.com/download/p0012.zip
________________________________________________________________________

This newsletter  is provided "AS IS"  without warranty of any kind.  Its
use implies  the acceptance  of our  licensing terms  and  disclaimer of
warranty  you  can  read  at  http://www.latiumsoftware.com/en/legal.php
where  you will also find  a note about  legal trademarks.  Articles are
copyright of their respective authors  and they are reproduced here with
their permission. You can redistribute this newsletter as long as you do
it in full (including copyright notices), without changes, and gratis.
________________________________________________________________________

Main page: http://www.latiumsoftware.com/en/pascal/delphi-newsletter.php
Group home page:   http://groups.yahoo.com/group/pascal-newsletter/
Subscribe/join:    pascal-newsletter-subscribe@yahoogroups.com
Unsubscribe/leave: pascal-newsletter-unsubscribe@yahoogroups.com
Problems with your subscription? eds2004 @ latiumsoftware.com
________________________________________________________________________

     Latium Software     http://www.latiumsoftware.com/en/index.php

     Copyright (c) 2000 by Ernesto De Spirito. All rights reserved.
________________________________________________________________________