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
eds2008 @ 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-2006 & 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.programmingpages.com/?r=latiumsoftwarecomenpascal
http://top100borland.com/in.php?who=20
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/en/file.php?id=p11
________________________________________________________________________
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? eds2008 @ latiumsoftware.com
________________________________________________________________________
Latium Software http://www.latiumsoftware.com/en/index.php
Copyright (c) 2000 by Ernesto De Spirito. All rights reserved.
________________________________________________________________________
|