dbimageenvect.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

(*
Copyright (c) 1998-2007 by HiComponents. All rights reserved.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

HiComponents grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial,
shareware or freeware libraries or components.

email: [e-mail]

http://www.hicomponents.com
*)

unit dbimageenvect;

{$R-}
{$Q-}

{$I ie.inc}

{$IFDEF IEINCLUDEDB}

interface

uses Windows, Messages, classes, Graphics, Db, dbctrls, ImageEnView, ImageEnio, dbimageen, ievect, hyiedefs, hyieutils;

type

{!!
<FS>TImageEnDBVect

<FM>Description<FN>
TImageEnDBVect is a descendant of <A TImageEnVect>, but it can connected to a TDataset object to store/load images (BMP, PCX, GIF, JPEG, TIFF, PNG and others) and vectorial objects in Blob field.

It is similar to the TDBImage component of Delphi.
You can specify particular file format parameters through <A TImageEnDBVect.IOParams> property, or executing <A TImageEnDBVect.DoIOPreview> method.
You can attach a <A TImageEnProc> component for image processing the image contained in the Blob.

<FM>Properties<FN>

  <A TImageEnDBVect.AbsolutePath>
  <A TImageEnDBVect.AutoDisplay>
  <A TImageEnDBVect.DataField>
  <A TImageEnDBVect.DataFieldImageFormat>
  <A TImageEnDBVect.DataSource>
  <A TImageEnDBVect.Field>
  <A TImageEnDBVect.IOParams>
  <A TImageEnDBVect.IOPreviewsParams>
  <A TImageEnDBVect.JpegQuality>
  <A TImageEnDBVect.PreviewFont>
  <A TImageEnDBVect.ReadOnly>

<FM>Methods<FN>

  <A TImageEnDBVect.DoIOPreview>
  <A TImageEnDBVect.LoadedFieldImageFormat>
  <A TImageEnDBVect.LoadPicture>

<Fm>Events<FN>
  <A TImageEnDBVect.OnUnableToLoadImage>

!!}
  TImageEnDBVect = class(TImageEnVect)
  private
    FAutoDisplay: Boolean;
    FDataLink: TFieldDataLink;
    FPictureLoaded: Boolean;
    fDataFieldImageFormat: TDataFieldImageFormat;
    fDoImageChange: boolean; // se true viene eseguita ImageChange
    fAbsolutePath: string;
    fIsInsideDbCtrl: boolean;
    fOnUnableToLoadImage:TUnableToLoadImageEvent;
    procedure SetAutoDisplay(Value: Boolean);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure SetJPegQuality(q: integer);
    function GetJPegQuality: integer;
    function GetIOParams: TIOParamsVals;
    function GetIOPreviewsParams: TIOPreviewsParams;
    procedure SetIOPreviewsParams(v: TIOPreviewsParams);
    procedure SetPreviewFont(f: TFont);
    function GetPreviewFont: TFont;
    procedure SetAbsolutePath(const v: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DataChange(Sender: TObject); virtual;
    procedure UpdateData(Sender: TObject); virtual;
    function GetDataFieldImageFormat: TDataFieldImageFormat; virtual;
    procedure SetDataFieldImageFormat(v: TDataFieldImageFormat); virtual;
    procedure LoadPictureEx(ffImageEnIO: TImageEnIO);
    procedure DoVectorialChanged; override;
    function InsideDBCtrl: boolean; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PaintToEx(ABitmap: TIEBitmap; ABitmapScanline: ppointerarray; UpdRect: PRect; drawBackground:boolean; drawGadgets:boolean); override;
    procedure Paint; override;
    procedure ImageChange; override;
    property Field: TField read GetField;
    procedure LoadPicture; virtual;
    function LoadedFieldImageFormat: TDataFieldImageFormat; virtual;
    property IOParams: TIOParamsVals read GetIOParams;
{$IFDEF IEINCLUDEDIALOGIO}
    function DoIOPreview: boolean;
{$ENDIF}
    property PictureLoaded: boolean read fPictureLoaded;
    property AbsolutePath: string read fAbsolutePath write SetAbsolutePath;
  published

{!!
<FS>TImageEnDBVect.AutoDisplay

<FM>Declaration<FC>
property AutoDisplay: Boolean;

<FM>Description<FN>
AutoDisplay determines whether to automatically display the contents of a graphic BLOB in the database image control.

If AutoDisplay is True (the default value), the image automatically displays new data when the underlying BLOB field changes (such as when moving to a new record).
If AutoDisplay is False, the image clears whenever the underlying BLOB field changes. To display the data, the user can double-click on the control or select it and press Enter. In addition, calling the LoadPicture method ensures that the control is showing data.
Change the value of AutoDisplay to False if the automatic loading of BLOB fields seems to take too long.
!!}
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;

    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property DataFieldImageFormat: TDataFieldImageFormat read GetDataFieldImageFormat write SetDataFieldImageFormat default ifBitmap;
    property JpegQuality: integer read GetJpegQuality write SetJpegQuality default 80;
    property IOPreviewsParams: TIOPreviewsParams read GetIOPreviewsParams write SetIOPreviewsParams default [];
    property PreviewFont: TFont read GetPreviewFont write SetPreviewFont;
    property IsInsideDbCtrl: boolean read fIsInsideDbCtrl write fIsInsideDbCtrl default false;

{!!
<FS>TImageEnDBVect.OnUnableToLoadImage

<FM>Declaration<FC>
property OnUnableToLoadImage:<A TUnableToLoadImageEvent>;

<FM>Description<FN>
This event occurs when TImageEnDBVect or TImageEnDBView fails to load image from blob field.
!!}
    property OnUnableToLoadImage:TUnableToLoadImageEvent read fOnUnableToLoadImage write fOnUnableToLoadImage;

  end;


implementation

uses dbtables, controls, giffilter, ImageEn, sysutils;

{$R-}

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then
      LoadPicture;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////

constructor TImageEnDBVect.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  GetImageEnIO; // creates fImageEnIO;
  fAbsolutePath := '';
  fDataFieldImageFormat := ifBitmap;
  FAutoDisplay := True;
  fDoImageChange := true;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  SetJpegQuality(80);
  fIsInsideDbCtrl := false;
  fOnUnableToLoadImage:=nil;
end;

/////////////////////////////////////////////////////////////////////////////////////

destructor TImageEnDBVect.Destroy;
begin
  FreeAndNil(FDataLink);
  inherited Destroy;
end;

/////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnDBVect.DataSource

<FM>Declaration<FC>
property DataSource: TDataSource;

<FM>Description<FN>
DataSource links the image control to a dataset.

Use DataSource to link the image control to a dataset in which the data can be found. To fully specify a database field for the image control, both the dataset and a field within that dataset must be defined. Use the DataField property to specify the particular field within the dataset.
!!}
function TImageEnDBVect.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

/////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnDBVect.DataField

<FM>Declaration<FC>
property DataField: string;

<FM>Description<FN>
DataField specifies the field from which the database image displays data.

Use DataField to bind the image control to a field in the dataset. To fully specify a database field, both the dataset and the field within that dataset must be defined. The DataSource property of the image control specifies the dataset which contains the DataField. DataField should specify a graphic field.
!!}
function TImageEnDBVect.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

/////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnDBVect.ReadOnly

<FM>Declaration<FC>
property ReadOnly: Boolean;

<FM>Description<FN>
ReadOnly determines whether the user can change the contents of the field using the image control. 

!!}
function TImageEnDBVect.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

/////////////////////////////////////////////////////////////////////////////////////

{!!
<FS>TImageEnDBVect.Field

<FM>Declaration<FC>
property Field: TField;

<FM>Description<FN>
Field is the TField component the database image is linked to.

Read-only

!!}
function TImageEnDBVect.GetField: TField;
begin
  Result := FDataLink.Field;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then
    DataSource := nil;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.DataChange(Sender: TObject);
begin
  Clear;
  RemoveAllObjects;
  FPictureLoaded := False;
  if (not assigned(fDataLink.DataSource)) or (not assigned(FDataLink.DataSource.DataSet)) or (not FDataLink.DataSource.DataSet.Active) then
    exit;
  if FAutoDisplay then
    LoadPicture;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  LoadPicture;
  inherited;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.ImageChange;
begin
  inherited;
  if fDoImageChange then
  begin
    FDataLink.Modified;
    FPictureLoaded := True;
    Invalidate;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.DoVectorialChanged;
begin
  ImageChange;
end;

/////////////////////////////////////////////////////////////////////////////////////

procedure TImageEnDBVect.SetDataFieldImageFormat(v: TDataFieldImageFormat);
begin
  fDataFieldImageFormat := v;
  ImageChange;
end;

/////////////////////////////////////////////////////////////////////////////////////
// save the image

procedure TImageEnDBVect.UpdateData(Sender: TObject);
var
  ms: tmemorystream;
  ss: string;
begin
  if FDataLink.Field is TBlobField then
  begin
    fImageEnIO.StreamHeaders := true;
    ms := tmemorystream.create;
    try
      case fDataFieldImageFormat of
        ifBitmap: fImageEnIO.SaveToStreamBMP(ms);
        ifJpeg: fImageEnIO.SaveToStreamJpeg(ms);
        ifGIF: fImageEnIO.SaveToStreamGIF(ms);
        ifPCX: fImageEnIO.SaveToStreamPCX(ms);
        ifTIFF: fImageEnIO.SaveToStreamTIFF(ms);
{$IFDEF IEINCLUDEPNG}
        ifPNG: fImageEnIO.SaveToStreamPNG(ms);
{$ENDIF}
        ifTGA: fImageEnIO.SaveToStreamTGA(ms);
        ifPXM: fImageEnIO.SaveToStreamPXM(ms);
        ifICO: fImageEnIO.SaveToStreamICO(ms);
{$IFDEF IEINCLUDEJPEG2000}
        ifJP2: fImageEnIO.SaveToStreamJP2(ms);
        ifJ2K: fImageEnIO.SaveToStreamJ2K(ms);
{$ENDIF}
        ifWBMP: fImageEnIO.SaveToStreamWBMP(ms);
      end;
      SaveToStreamIEV(ms);
      ms.position := 0;
      (fdatalink.field as tblobfield).loadfromstream(ms);
    finally
      FreeAndNil(ms);
    end;
  end
  else if FDataLink.Field is TStringField then
  begin
    // path
    fImageEnIO.StreamHeaders := false;
    ss := TStringField(FDataLink.Field).Value;
    if (ss <> '') then
    begin
      ss := fAbsolutePath + ss;
      case fDataFieldImageFormat of
        ifBitmap: fImageEnIO.SaveToFileBMP(ss);
        ifJpeg: fImageEnIO.SaveToFileJpeg(ss);
        ifGIF: fImageEnIO.SaveToFileGIF(ss);
        ifPCX: fImageEnIO.SaveToFilePCX(ss);
        ifTIFF: fImageEnIO.SaveToFileTIFF(ss);
{$IFDEF IEINCLUDEPNG}
        ifPNG: fImageEnIO.SaveToFilePNG(ss);
{$ENDIF}
        ifTGA: fImageEnIO.SaveToFileTGA(ss);
        ifPXM: fImageEnIO.SaveToFilePXM(ss);
        ifICO: fImageEnIO.SaveToFileICO(ss);
{$IFDEF IEINCLUDEJPEG2000}
        ifJP2: fImageEnIO.SaveToFileJP2(ss);
        ifJ2K: fImageEnIO.SaveToFileJ2K(ss);
{$ENDIF}
        ifWBMP: fImageEnIO.SaveToFileWBMP(ss);
      end;
      SaveToFileIEV(ss + '.iev');
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// Carica immagine da fdatalink.field senza controllare fPictureLoaded
// non assegna fDataFieldImageFormat

procedure TImageEnDBVect.LoadPictureEx(ffImageEnIO: TImageEnIO);
var
  ms: tmemorystream;
  ifm: TDataFieldImageFormat;
  bg: THYIEGraphicHeader;
  ss: string;
  success:boolean;
begin
  success:=false;
  try
  if (FDataLink.Field is TBlobField) and ((FDataLink.Field as TBlobField).BlobSize > 0) then
  begin
    ffImageEnIO.StreamHeaders := true;
    fDoImageChange := false;
    ifm := LoadedFieldImageFormat;