Pascal Newsletter #11 - Free ezine for Delphi (and Kylix) programmers

Pascal Newsletter #11
The full source code examples of this issue are available for download.
Pascal Newsletter #11 - 27-NOV-2000

INDEX

1. A FEW WORDS FROM THE EDITOR
2. STORING AND RETRIEVING JPEG IMAGES IN A TABLE FIELD
3. GETTING THE VOLUME SERIAL NUMBER
4. LINKS

________________________________________________________________________


1. A FEW WORDS FROM THE EDITOR


I would like to thank Alirio Gavidia for contributing the article
"Post-it. Sizable windows without borders or title" that we published
in the last newsletter and that received good critics. I would like to
encourage once again the gurus and advanced programmers that are
subscribed to this newsletter to contribute articles, tips and tricks
to this newsletter. Hope to hear from you soon.

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. STORING AND RETRIEVING JPEG IMAGES IN A TABLE FIELD


To begin with, the Graphic field is designed to work only with bitmaps,
icons and metafiles, and the DBImage control is designed to be linked
to a Graphic field, so we can't use either of the two.

To store JPEG images we have to use a Blob field instead of a Graphic
field, and we can use a code like the following:

  uses jpeg;

  procedure TForm1.Button1Click(Sender: TObject);
  var
    Jpg: TJpegImage;
    Stream: TMemoryStream;
  begin
    Jpg := nil;
    Stream := nil;
    try

      // Create a JPEG image and load it from a file

      Jpg := TJpegImage.Create;
      Jpg.LoadFromFile('test.jpg');

      // Create a stream and save the image to the stream

      Stream := TMemoryStream.Create;
      Jpg.SaveToStream(Stream);
      Stream.Position := 0;
      Table1.Append;

      // Load the Blob field from the stream

      TBlobField(Table1.FieldByName('Graph')).LoadFromStream(Stream);

      Table1.Post;
    except
      jpg.Free;
      Stream.Free;
      raise;
    end;
    jpg.Free;
    Stream.Free;
  end;

To display a JPEG image stored in a Blob field in a TImage control, we
can use a code like the following for example in an AfterScroll event:

  procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
  var
    Stream: TMemoryStream;
    Jpg: TJpegImage;
  begin
    Jpg := nil;
    Stream := nil;
    try

      // Create a stream and load the contents of the Blob field

      Stream := TMemoryStream.Create;
      TBlobField(Table1.FieldByName('Graph')).SaveToStream(Stream);
      if Stream.Size > 0 then begin

        // Create a JPEG image and load it from the stream

        Jpg := TJpegImage.Create;
        Stream.Position := 0;
        Jpg.LoadFromStream(Stream);

        // Assign the JEPG image to the Picture property of an Image

        Image1.Picture.Assign(Jpg);

      end else
        Image1.Picture.Assign(nil);
    except
      Image1.Picture.Assign(nil);
    end;
    jpg.Free;
    Stream.Free;
  end;

If you want to be able to store different images types (bitmaps, icons,
metafiles and jpegs) in a field, we can add a byte at the beginning of
the stream to indicate the image kind, and then we have to read this
byte first to know how to load and display the image appropriately. We
designed a full example to show how to do it.

1) Place the following components on a form and set their properties:

  Table1: TTable
    TableName = 'GraphTest.DB'
    FieldDefs =
      Field1
        Name = 'Graph'
        DataType = ftBlob
        Size = 1
    StoreDefs = True

  DataSource1: TDataSource
    DataSet = Table1

  DBNavigator1: TDBNavigator
    DataSource = DataSource1
    Align = alBottom

  PopupMenu1: TPopupMenu
    Items =
      mnuLoad: TMenuItem
        Caption = '&Load...'
      mnuClear: TMenuItem
        Caption = '&Clear'

  Image1: TImage
    PopupMenu = PopupMenu1

  dlgOpenPicture: TOpenPictureDialog
    Options = [ofReadOnly, ofHideReadOnly, ofPathMustExist,
               ofFileMustExist, ofNoTestFileCreate, ofEnableSizing]

2) Add "jpeg" to the uses clause:

  uses
    ..., jpeg;

3) Add the following type declaration to the unit:

  type
    TGraphType = (gtBitmap, gtIcon, gtMetafile, gtJpeg);

4) Generate the following events:

  procedure TForm1.FormCreate(Sender: TObject);
  begin
    if Not FileExists('GraphTest.DB') then
      Table1.CreateTable;
    Table1.Open;
  end;

  procedure TForm1.mnuLoadClick(Sender: TObject);
  var
    Jpg: TJpegImage;
    Stream: TMemoryStream;
    FileExt: string;
    GraphType: TGraphType;
  begin
    if dlgOpenPicture.Execute then begin
      Jpg := nil;
      Stream := nil;
      try
        Stream := TMemoryStream.Create;
        FileExt := LowerCase(ExtractFileExt(dlgOpenPicture.FileName));
        if (FileExt = '.bmp') or (FileExt = '.dib') then begin
          GraphType := gtBitmap;
          Stream.Write(GraphType, 1);
          with Image1.Picture.Bitmap do begin
            LoadFromFile(dlgOpenPicture.FileName);
            Image1.Picture.Bitmap.SaveToStream(Stream);
          end;
        end else if (FileExt = '.ico') then begin
          GraphType := gtIcon;
          Stream.Write(GraphType, 1);
          with Image1.Picture.Icon do begin
            LoadFromFile(dlgOpenPicture.FileName);
            Image1.Picture.Bitmap.SaveToStream(Stream);
          end;
        end else if (FileExt = '.emf') or (FileExt = '.wmf') then begin
          GraphType := gtMetafile;
          Stream.Write(GraphType, 1);
          with Image1.Picture.Metafile do begin
            LoadFromFile(dlgOpenPicture.FileName);
            Image1.Picture.Bitmap.SaveToStream(Stream);
          end;
        end else if (FileExt = '.jpg') or (FileExt = '.jpeg')
           or (FileExt = '.jpe') then begin
          Jpg := TJpegImage.Create;
          Jpg.LoadFromFile(dlgOpenPicture.FileName);
          Image1.Picture.Assign(Jpg);
          GraphType := gtJpeg;
          Stream.Write(GraphType, 1);
          Jpg.SaveToStream(Stream);
        end;
        if (Table1.State <> dsEdit) and (Table1.State <> dsInsert) then
          Table1.Edit;
        Stream.Position := 0;
        TBlobField(Table1.FieldByName('Graph')).LoadFromStream(Stream);
      except
        jpg.Free;
        Stream.Free;
        raise;
      end;
      jpg.Free;
      Stream.Free;
    end;
  end;

  procedure TForm1.mnuClearClick(Sender: TObject);
  begin
    Image1.Picture.Assign(nil);
    if (Table1.State <> dsEdit) and (Table1.State <> dsInsert) then
      Table1.Edit;
    Table1.FieldByName('Graph').Assign(nil);  // Clear the field
  end;

  procedure TForm1.Table1AfterScroll(DataSet: TDataSet);
  var
    Stream: TMemoryStream;
    Jpg: TJpegImage;
    GraphType: TGraphType;
  begin
    Jpg := nil;
    Stream := nil;
    try
      Stream := TMemoryStream.Create;
      TBlobField(Table1.FieldByName('Graph')).SaveToStream(Stream);
      if Stream.Size > 0 then begin
        Stream.Position := 0;
        Stream.Read(GraphType, 1);
        case GraphType of
        gtBitmap:   Image1.Picture.Bitmap.LoadFromStream(Stream);
        gtIcon:     Image1.Picture.Icon.LoadFromStream(Stream);
        gtMetafile: Image1.Picture.Metafile.LoadFromStream(Stream);
        gtJpeg:   begin
                    Jpg := TJpegImage.Create;
                    Jpg.LoadFromStream(Stream);
                    Image1.Picture.Assign(Jpg);
        end else
          Image1.Picture.Assign(nil);  // Clear the image
        end;
      end else
        Image1.Picture.Assign(nil);
    except
      Image1.Picture.Assign(nil);
    end;
    jpg.Free;
    Stream.Free;
  end;

________________________________________________________________________


3. GETTING THE VOLUME SERIAL NUMBER


When a disk/diskette is formatted, Windows stores a serial number in the
boot sector. This number is calculated using the system time and is not
guaranteed to be unique, but it is quite unlikely that two disks taken
at random have the same serial number.

You can use this number for a copy protection mechanism, to insure an
application can only be run from the hard disk where you originally
installed it. For example you can store the serial number in the Windows
Registry and compare it with the disk serial number every time the
application starts. We leave this part up to you.

To obtain the serial number you have to call the GetVolumeInformation
API function declared in the Windows unit. Notice you can also call
this function to obtain the volume label, the maximum length of a
filename, the file system type (for example 'FAT32') and the file system
options (like disk/file compression and case sensitivity and character
set of file names).

The following function is a wrapper for the GetVolumeInformation API and
returns the serial number of the drive passed as parameter:

  function GetVolumeSerialNumber(const drive: TFilename): longword;
  var
    VolumeName, FileSystemName: array[0..MAX_PATH-1] of char;
    VolumeSerialNumber, MaxFilenameLength, FileSystemFlags: longword;
  begin
    GetVolumeInformation(PChar(IncludeTrailingBackslash(drive)),
      VolumeName, MAX_PATH, @VolumeSerialNumber, MaxFilenameLength,
      FileSystemFlags, FileSystemName, MAX_PATH);
    Result := VolumeSerialNumber;
  end;

Sample call:

  procedure TForm1.Button1Click(Sender: TObject);
  var
    serial: longword;
  begin
    serial := GetVolumeSerialNumber('C:\');
    ShowMessage(IntToHex(HiWord(serial), 4)
        + '-' + IntToHex(LoWord(serial), 4));
  end;

________________________________________________________________________


4. LINKS


* The Delphi Programming Source CodeWeb Site
  http://www.sandbrooksoftware.com/DPSC/index.shtml

* Just Delphi Jobs
  http://www.JustDelphiJobs.com

________________________________________________________________________


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/p0011.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.
________________________________________________________________________
The full source code examples of this issue are available for download.
Errors? Omissions? Comments? Please contact us!