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.