unit Ffactwin;
////////////////////////////////////////////////////////////////////////////////
// //
// Project: TGIFImage demo application. //
// Description: Store and retrieve GIF (and other formats) to/from a database.//
// Copyright: Portions (c) 1995,99 Inprise Corporation. //
// (c) 1997-99 Anders Melander. //
// All rights reserved. //
// Formatting: 2 space indent, 8 space tabs, 80 columns. //
// //
////////////////////////////////////////////////////////////////////////////////
// This application shows how to display Paradox style memo and graphic
// fields in a form. Table1's DatabaseName property should point to the
// Delphi sample database. Table1's TableName property should be set to
// the BIOLIFE table.
////////////////////////////////////////////////////////////////////////////////
// This application is an adaption of Borland's FishFacts database demo.
// It has been modified to support multiple image formats, unlike the original
// application which only supported TBitmaps.
////////////////////////////////////////////////////////////////////////////////
// Please note that once you have converted an image from bitmap to some other
// format, the original FishFact application will not be able to display the
// image.
// I suggest that you either make a backup copy of the BIOLIFE table files
// before running this demo or convert the images back to bitmap format once
// you are done testing this demo.
////////////////////////////////////////////////////////////////////////////////interfaceuses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, StdCtrls, DBCtrls, DBGrids, DB, DBTables, Buttons, Grids, ExtCtrls,
Menus, ExtDlgs, Dialogs;type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
DBLabel1: TDBText;
DBMemo1: TDBMemo;
DataSource1: TDataSource;
Table1: TTable;
Table1Common_Name: TStringField;
Table1Graphic: TBlobField;
DBGrid1: TDBGrid;
BitBtn1: TBitBtn;
Table1Category: TStringField;
Table1SpeciesName: TStringField;
Table1Lengthcm: TFloatField;
Table1Length_In: TFloatField;
Table1Notes: TMemoField;
ImageFish: TImage;
PopupMenuImage: TPopupMenu;
MenuImageLoad: TMenuItem;
N2: TMenuItem;
MenuImageConvertBitmap: TMenuItem;
MenuImageConvertGIF: TMenuItem;
MenuImageConvertJPEG: TMenuItem;
OpenPictureDialog: TOpenPictureDialog;
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure MenuImageConvertBitmapClick(Sender: TObject);
procedure MenuImageConvertGIFClick(Sender: TObject);
procedure MenuImageConvertJPEGClick(Sender: TObject);
procedure MenuImageLoadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure UpdateField(Graphic: TGraphic);
public
end;var
Form1: TForm1;implementation{$R *.DFM}uses
GIFImage,
JPEG,
ClipBrd;{ Paradox graphic BLOB header - from db.pas }type
TGraphicHeader = record
Count: Word; { Fixed at 1 }
HType: Word; { Fixed at $0100 }
Size: Longint; { Size not including header }
end; TGraphicHack = class(TGraphic);
TGraphicHackClass = class of TGraphicHack; TImageSignature = record
ImageType: TGraphicClass;
Name: string;
Signature: string;
end;const
Signatures: array[0..2] of TImageSignature
= ((ImageType: TBitmap; Name: 'Bitmap'; Signature: 'BM'),
(ImageType: TGIFImage; Name: 'GIF'; Signature: 'GIF'),
(ImageType: TJPEGImage; Name: 'JPEG';
Signature: chr($FF)+chr($D8)+chr($FF)+chr($E0)+chr($00)+chr($10)+'JFIF'));procedure TForm1.FormCreate(Sender: TObject);
begin
Table1.Open;
end;procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
var
Stream : TStream;
Size : integer;
Header : TGraphicHeader;
Signature : pointer;
i : integer;
Image : TGraphic;
Name : string;
begin
if ((Field <> nil) and (Field <> Table1Graphic)) or
(Table1Graphic.DataSet.State <> dsBrowse) then
exit; Image := nil; // Database cursor has moved - Update image
Stream := Table1Graphic.DataSet.CreateBlobStream(Table1Graphic, bmRead);
try
// Skip paradox image header
Size := Stream.Size;
if (Size >= SizeOf(TGraphicHeader)) then
begin
Stream.Read(Header, SizeOf(Header));
if (Header.Count <> 1) or (Header.HType <> $0100) or
(Header.Size <> Size - SizeOf(Header)) then
Stream.Seek(-SizeOf(Header), soFromCurrent);
end; try
// Determine image type from file signature
for i := low(Signatures) to high(Signatures) do
begin
if (length(Signatures[i].Signature) > Size) then
continue;
// Read signature
GetMem(Signature, length(Signatures[i].Signature));
try
Stream.Read(Signature^, length(Signatures[i].Signature));
// Reposition stream cursor
Stream.Seek(-length(Signatures[i].Signature), soFromCurrent);
// Compare signatures
if (CompareMem(Signature, @Signatures[i].Signature[1], length(Signatures[i].Signature))) then
begin
Image := TGraphicHackClass(Signatures[i].ImageType).Create;
Name := Signatures[i].Name;
break;
end;
finally
Freemem(Signature);
end;
end; // Force TImage to desired graphic type
ImageFish.Picture.Graphic := Image; // Load image from stream
if (ImageFish.Picture.Graphic <> nil) then
begin
ImageFish.Picture.Graphic.LoadFromStream(Stream);
Caption := format('FISH FACTS - %s image, %d bytes', [Name, Size]);
end else
Caption := 'FISH FACTS'; finally
Image.Free;
end;
finally
Stream.Free;
end;
end;// Write the specified image to the BLOB field
procedure TForm1.UpdateField(Graphic: TGraphic);
var
Stream : TStream;
Header : TGraphicHeader;
begin
Table1Graphic.DataSet.Edit;
Stream := Table1Graphic.DataSet.CreateBlobStream(Table1Graphic, bmWrite);
try
// TBitmaps are saved in a special format which is compatible with
// the TDBImage component...
if (Graphic is TBitmap) and
((Table1Graphic.DataType = ftGraphic) or (Table1Graphic.DataType = ftTypedBinary)) then
begin
Stream.Write(Header, SizeOf(Header));
Graphic.SaveToStream(Stream);
Header.Count := 1;
Header.HType := $0100;
Header.Size := Stream.Position - SizeOf(Header);
Stream.Position := 0;
Stream.Write(Header, SizeOf(Header));
end else
// ...all other image formats are just saved to the BLOB stream
Graphic.SaveToStream(Stream);
finally
Stream.Free;
end;
Table1Graphic.DataSet.Refresh;
end;procedure TForm1.MenuImageConvertBitmapClick(Sender: TObject);
var
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(ImageFish.Picture.Graphic);
UpdateField(Bitmap);
finally
Bitmap.Free;
end;
end;procedure TForm1.MenuImageConvertGIFClick(Sender: TObject);
var
GIF : TGIFImage;
begin
GIF := TGIFImage.Create;
try
GIF.ColorReduction := rmQuantize;
GIF.DitherMode := dmFloydSteinberg;
GIF.Assign(ImageFish.Picture.Graphic);
UpdateField(GIF);
finally
GIF.Free;
end;
end;procedure TForm1.MenuImageConvertJPEGClick(Sender: TObject);
var
JPEG : TJPEGImage;
Bitmap : TBitmap;
begin
JPEG := TJPEGImage.Create;
try
// TJPEGImage can only assign from TBitmap and TJPEGImage, so we
// need to convert the TGIFImage to a TBitmap before it can be
// converted to a TJPEGImage
if (ImageFish.Picture.Graphic is TGIFImage) then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(ImageFish.Picture.Graphic);
JPEG.Assign(Bitmap);
finally
Bitmap.Free;
end;
end else
JPEG.Assign(ImageFish.Picture.Graphic);
JPEG.CompressionQuality := 80;
JPEG.Compress;
UpdateField(JPEG);
finally
JPEG.Free;
end;
end;procedure TForm1.MenuImageLoadClick(Sender: TObject);
begin
if (OpenPictureDialog.Execute) then
begin
ImageFish.Picture.LoadFromFile(OpenPictureDialog.FileName);
UpdateField(ImageFish.Picture.Graphic);
end;
end;end.
////////////////////////////////////////////////////////////////////////////////
// //
// Project: TGIFImage demo application. //
// Description: Store and retrieve GIF (and other formats) to/from a database.//
// Copyright: Portions (c) 1995,99 Inprise Corporation. //
// (c) 1997-99 Anders Melander. //
// All rights reserved. //
// Formatting: 2 space indent, 8 space tabs, 80 columns. //
// //
////////////////////////////////////////////////////////////////////////////////
// This application shows how to display Paradox style memo and graphic
// fields in a form. Table1's DatabaseName property should point to the
// Delphi sample database. Table1's TableName property should be set to
// the BIOLIFE table.
////////////////////////////////////////////////////////////////////////////////
// This application is an adaption of Borland's FishFacts database demo.
// It has been modified to support multiple image formats, unlike the original
// application which only supported TBitmaps.
////////////////////////////////////////////////////////////////////////////////
// Please note that once you have converted an image from bitmap to some other
// format, the original FishFact application will not be able to display the
// image.
// I suggest that you either make a backup copy of the BIOLIFE table files
// before running this demo or convert the images back to bitmap format once
// you are done testing this demo.
////////////////////////////////////////////////////////////////////////////////interfaceuses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, StdCtrls, DBCtrls, DBGrids, DB, DBTables, Buttons, Grids, ExtCtrls,
Menus, ExtDlgs, Dialogs;type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
DBLabel1: TDBText;
DBMemo1: TDBMemo;
DataSource1: TDataSource;
Table1: TTable;
Table1Common_Name: TStringField;
Table1Graphic: TBlobField;
DBGrid1: TDBGrid;
BitBtn1: TBitBtn;
Table1Category: TStringField;
Table1SpeciesName: TStringField;
Table1Lengthcm: TFloatField;
Table1Length_In: TFloatField;
Table1Notes: TMemoField;
ImageFish: TImage;
PopupMenuImage: TPopupMenu;
MenuImageLoad: TMenuItem;
N2: TMenuItem;
MenuImageConvertBitmap: TMenuItem;
MenuImageConvertGIF: TMenuItem;
MenuImageConvertJPEG: TMenuItem;
OpenPictureDialog: TOpenPictureDialog;
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure MenuImageConvertBitmapClick(Sender: TObject);
procedure MenuImageConvertGIFClick(Sender: TObject);
procedure MenuImageConvertJPEGClick(Sender: TObject);
procedure MenuImageLoadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure UpdateField(Graphic: TGraphic);
public
end;var
Form1: TForm1;implementation{$R *.DFM}uses
GIFImage,
JPEG,
ClipBrd;{ Paradox graphic BLOB header - from db.pas }type
TGraphicHeader = record
Count: Word; { Fixed at 1 }
HType: Word; { Fixed at $0100 }
Size: Longint; { Size not including header }
end; TGraphicHack = class(TGraphic);
TGraphicHackClass = class of TGraphicHack; TImageSignature = record
ImageType: TGraphicClass;
Name: string;
Signature: string;
end;const
Signatures: array[0..2] of TImageSignature
= ((ImageType: TBitmap; Name: 'Bitmap'; Signature: 'BM'),
(ImageType: TGIFImage; Name: 'GIF'; Signature: 'GIF'),
(ImageType: TJPEGImage; Name: 'JPEG';
Signature: chr($FF)+chr($D8)+chr($FF)+chr($E0)+chr($00)+chr($10)+'JFIF'));procedure TForm1.FormCreate(Sender: TObject);
begin
Table1.Open;
end;procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
var
Stream : TStream;
Size : integer;
Header : TGraphicHeader;
Signature : pointer;
i : integer;
Image : TGraphic;
Name : string;
begin
if ((Field <> nil) and (Field <> Table1Graphic)) or
(Table1Graphic.DataSet.State <> dsBrowse) then
exit; Image := nil; // Database cursor has moved - Update image
Stream := Table1Graphic.DataSet.CreateBlobStream(Table1Graphic, bmRead);
try
// Skip paradox image header
Size := Stream.Size;
if (Size >= SizeOf(TGraphicHeader)) then
begin
Stream.Read(Header, SizeOf(Header));
if (Header.Count <> 1) or (Header.HType <> $0100) or
(Header.Size <> Size - SizeOf(Header)) then
Stream.Seek(-SizeOf(Header), soFromCurrent);
end; try
// Determine image type from file signature
for i := low(Signatures) to high(Signatures) do
begin
if (length(Signatures[i].Signature) > Size) then
continue;
// Read signature
GetMem(Signature, length(Signatures[i].Signature));
try
Stream.Read(Signature^, length(Signatures[i].Signature));
// Reposition stream cursor
Stream.Seek(-length(Signatures[i].Signature), soFromCurrent);
// Compare signatures
if (CompareMem(Signature, @Signatures[i].Signature[1], length(Signatures[i].Signature))) then
begin
Image := TGraphicHackClass(Signatures[i].ImageType).Create;
Name := Signatures[i].Name;
break;
end;
finally
Freemem(Signature);
end;
end; // Force TImage to desired graphic type
ImageFish.Picture.Graphic := Image; // Load image from stream
if (ImageFish.Picture.Graphic <> nil) then
begin
ImageFish.Picture.Graphic.LoadFromStream(Stream);
Caption := format('FISH FACTS - %s image, %d bytes', [Name, Size]);
end else
Caption := 'FISH FACTS'; finally
Image.Free;
end;
finally
Stream.Free;
end;
end;// Write the specified image to the BLOB field
procedure TForm1.UpdateField(Graphic: TGraphic);
var
Stream : TStream;
Header : TGraphicHeader;
begin
Table1Graphic.DataSet.Edit;
Stream := Table1Graphic.DataSet.CreateBlobStream(Table1Graphic, bmWrite);
try
// TBitmaps are saved in a special format which is compatible with
// the TDBImage component...
if (Graphic is TBitmap) and
((Table1Graphic.DataType = ftGraphic) or (Table1Graphic.DataType = ftTypedBinary)) then
begin
Stream.Write(Header, SizeOf(Header));
Graphic.SaveToStream(Stream);
Header.Count := 1;
Header.HType := $0100;
Header.Size := Stream.Position - SizeOf(Header);
Stream.Position := 0;
Stream.Write(Header, SizeOf(Header));
end else
// ...all other image formats are just saved to the BLOB stream
Graphic.SaveToStream(Stream);
finally
Stream.Free;
end;
Table1Graphic.DataSet.Refresh;
end;procedure TForm1.MenuImageConvertBitmapClick(Sender: TObject);
var
Bitmap : TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(ImageFish.Picture.Graphic);
UpdateField(Bitmap);
finally
Bitmap.Free;
end;
end;procedure TForm1.MenuImageConvertGIFClick(Sender: TObject);
var
GIF : TGIFImage;
begin
GIF := TGIFImage.Create;
try
GIF.ColorReduction := rmQuantize;
GIF.DitherMode := dmFloydSteinberg;
GIF.Assign(ImageFish.Picture.Graphic);
UpdateField(GIF);
finally
GIF.Free;
end;
end;procedure TForm1.MenuImageConvertJPEGClick(Sender: TObject);
var
JPEG : TJPEGImage;
Bitmap : TBitmap;
begin
JPEG := TJPEGImage.Create;
try
// TJPEGImage can only assign from TBitmap and TJPEGImage, so we
// need to convert the TGIFImage to a TBitmap before it can be
// converted to a TJPEGImage
if (ImageFish.Picture.Graphic is TGIFImage) then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Assign(ImageFish.Picture.Graphic);
JPEG.Assign(Bitmap);
finally
Bitmap.Free;
end;
end else
JPEG.Assign(ImageFish.Picture.Graphic);
JPEG.CompressionQuality := 80;
JPEG.Compress;
UpdateField(JPEG);
finally
JPEG.Free;
end;
end;procedure TForm1.MenuImageLoadClick(Sender: TObject);
begin
if (OpenPictureDialog.Execute) then
begin
ImageFish.Picture.LoadFromFile(OpenPictureDialog.FileName);
UpdateField(ImageFish.Picture.Graphic);
end;
end;end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货