| |
| Save and load metafiles in a BLOB field without using DBImage |
 |
How can I save and load metafiles in a BLOB field without using the DBImage component?
The following example demonstrates saving metafile images to a database as they exist on the disk, preserving any Placeable metafile headers that may be present in the Metafile. The image is displayed from the database in a TImage component.
Example:
unit Unit ;
interface
{$IFDEF WIN32}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, Db,
DBTables;
{$ELSE}
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DBTables, DB, Grids, DBGrids, ExtCtrls, StdCtrls;
{$ENDIF}
type
TForm = class(TForm)
Table : TTable;
DataSource : TDataSource;
DBGrid : TDBGrid;
Image : TImage;
Button : TButton;
Table Name: TStringField;
Table WMF: TBlobField;
OpenDialog : TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button Click(Sender: TObject);
procedure DataSource DataChange(Sender: TObject; Field: TField);
private
{ Private declarations }
FileName : string; {Used to hold a temp file name}
procedure LoadWMFFromDatabase; {loads a WMF from the database}
public
{ Public declarations }
end;
var
Form : TForm ;
implementation
{$R *.DFM}
procedure TForm .FormCreate(Sender: TObject);
begin
{Used for loading metafiles}
OpenDialog .Filter := 'Metafiles (*.wmf)|*.wmf';
OpenDialog .Options := [ofHideReadOnly, ofNoChangeDir];
Image .Stretch := true;
end;
procedure TForm .FormDestroy(Sender: TObject);
begin
{Erase the temp file if it exists}
if FileName <> '' then
DeleteFile(FileName);
end;
{This function gets a temporary file name form the system}
function GetTemporaryFileName : string;
{$IFNDEF WIN32}
const MAX_PATH = 44;
{$ENDIF}
var
{$IFDEF WIN32}
lpPathBuffer : PChar;
{$ENDIF}
lpbuffer : PChar;
begin
{Get the file name buffer}
GetMem(lpBuffer, MAX_PATH);
{$IFDEF WIN32}
{Get the temp path buffer}
GetMem(lpPathBuffer, MAX_PATH);
{Get the temp path}
GetTempPath(MAX_PATH, lpPathBuffer);
{Get the temp file name}
GetTempFileName(lpPathBuffer,
'tmp',
0,
lpBuffer);
{Free the temp path buffer}
FreeMem(lpPathBuffer, MAX_PATH);
{$ELSE}
{Get the temp file name}
GetTempFileName(GetTempDrive('C'),
'tmp',
0,
lpBuffer);
{$ENDIF}
{Create a pascal string containg}
{the temp file name and return it}
result := StrPas(lpBuffer);
{Free the file name buffer}
FreeMem(lpBuffer, MAX_PATH);
end;
procedure TForm .LoadWMFFromDatabase;
var
FileStream: TFileStream; {a temp file}
BlobStream: TBlobStream; {the WMF Blob}
begin
Image .Picture.Metafile.Assign(nil);
{Create a blob stream for the WMF blob}
BlobStream := TBlobStream.Create(Table WMF, bmRead);
if BlobStream.Size = 0 then begin
BlobStream.Free;
Exit;
end;
{if we have a temp file then erase it}
if FileName <> '' then
DeleteFile(FileName);
{Get a temp file name}
FileName := GetTemporaryFileName;
{Create a temp file stream}
FileStream := TFileStream.Create(FileName,
fmCreate or fmOpenWrite);
{Copy the blob to the temp file}
FileStream.CopyFrom(BlobStream, BlobStream.Size);
{Free the streams}
FileStream.Free;
BlobStream.Free;
{Dispaly the image}
Image .Picture.Metafile.LoadFromFile(FileName);
end;
{Save a wmf file to the database}
procedure TForm .Button Click(Sender: TObject);
var
FileStream: TFileStream; {to load the wmf file}
BlobStream: TBlobStream; {to save to the blob}
begin
{Allow the button to repaint}
Application.ProcessMessages;
if OpenDialog .Execute then begin
{Turn off the button}
Button .Enabled := false;
{Assign the avi file name to read}
FileStream := TFileStream.Create(OpenDialog .FileName,
fmOpenRead);
Table .Edit;
{Create a BlobStream for the field Table WMF}
BlobStream := TBlobStream.Create(Table WMF, bmReadWrite);
{Seek to the Begginning of the stream}
BlobStream.Seek(0, soFromBeginning);
{Delete any data that may be there}
BlobStream.Truncate;
{Copy from the FileStream to the BlobStream}
BlobStream.CopyFrom(FileStream, FileStream.Size);
{Free the streams}
FileStream.Free;
BlobStream.Free;
{Post the record}
Table .Post;
{Load the metafile in to a TImage}
LoadWMFFromDatabase;
{Enable the button}
Button .Enabled := true;
end;
end;
procedure TForm .DataSource DataChange(Sender: TObject; Field: TField);
begin
if (Sender as TDataSource).State = dsBrowse then
LoadWMFFromDatabase;
end;
end.
|
|
| Hits/month |
2,500,000+ |
Downloads (Since May 2000) |
7,393,709 |
| Total Files |
6,023 |
| Forum msgs |
7,670 |
| Articles/FAQs |
70+/900+ |
Top Selling Software at Amazon
|