⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dbimageen.pas

📁 ·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式
💻 PAS
📖 第 1 页 / 共 2 页
字号:
(*
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: support@hicomponents.com

http://www.hicomponents.com
*)

unit dbimageen;

{$R-}
{$Q-}

{$I ie.inc}

{$IFDEF IEINCLUDEDB}

interface

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

type

{!!
<FS>TDataFieldImageFormat

<FM>Declaration<FC>
}
  TDataFieldImageFormat = (ifBitmap, ifJpeg, ifGIF, ifPCX, ifTIFF, ifPNG, ifTGA, ifPXM, ifICO, ifJP2, ifJ2K, ifWBMP, ifUnknown);
{!!}

{!!
<FS>TUnableToLoadImageEvent

<FM>Declaration<FN>
TUnableToLoadImageEvent = procedure(Sender:TObject; Field:TField) of object;
}
  TUnableToLoadImageEvent = procedure(Sender:TObject; Field:TField) of object;
{!!}

{!!
<FS>TImageEnDBView

<FM>Description<FN>
TImageEnDBView is a descendant of <A TImageEnView>, but it can be connected to a TDataset object to store/load images (BMP, PCX, GIF, JPEG, TIFF, PNG, PXM and others) into Blob fields or into path reference (string) fields.

TImageEnDBView works simialrly to Delphi TDBImage components.

You can specify particular file format parameters through <A TImageEnDBView.IOParams> property, or by executing the <A TImageEnDBView.DoIOPreview> method.

You can attach a <A TImageEnProc> component for processing the image contained in the Blob.

See also <A TImageEnView>

<FM>Properties<FN>

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

<FM>Methods<FN>

  <A TImageEnDBView.DoIOPreview>
  <A TImageEnDBView.LoadedFieldImageFormat>
  <A TImageEnDBView.LoadPicture>

<FM>Events<FN>
  <A TImageEnDBView.OnUnableToLoadImage>
!!}
  TImageEnDBView = class(TImageEnView)
  private
    FAutoDisplay: Boolean;
    FDataLink: TFieldDataLink;
    FPictureLoaded: Boolean;
    fDataFieldImageFormat: TDataFieldImageFormat;
    fStreamHeaders: boolean; // enable/disable load and save of file formats headers
    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);
    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
    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;

{!!
<FS>TImageEnDBView.StreamHeaders

<FM>Declaration<FC>
property StreamHeaders:boolean

<FM>Description<FN>
If True (default), TImageEnDBView adds an additional header before standard image format.

To read older ImageEn data fields, leave this property as True (default value).
To read data field from other programs, set this property to False.
!!}
    property StreamHeaders: boolean read fStreamHeaders write fStreamHeaders default false;

    property IsInsideDbCtrl: boolean read fIsInsideDbCtrl write fIsInsideDbCtrl default false;

{!!
<FS>TImageEnDBView.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-}

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

{!!
<FS>TImageEnDBView.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.
!!}
procedure TImageEnDBView.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then
      LoadPicture;
  end;
end;

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

constructor TImageEnDBView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  GetImageEnIO; // creates fImageEnIO;
  fAbsolutePath := '';
  fStreamHeaders := false;
  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 TImageEnDBView.Destroy;
begin
  FreeAndNil(FDataLink);
  inherited Destroy;
end;

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

{!!
<FS>TImageEnDBView.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 TImageEnDBView.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

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

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

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

{!!
<FS>TImageEnDBView.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 TImageEnDBView.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

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

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

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

{!!
<FS>TImageEnDBView.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 TImageEnDBView.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

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

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

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

{!!
<FS>TImageEnDBView.Field

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

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

Read-only

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

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

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

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

procedure TImageEnDBView.DataChange(Sender: TObject);
begin
  Clear;
  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 TImageEnDBView.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  LoadPicture;
  inherited;
end;

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

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

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

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

/////////////////////////////////////////////////////////////////////////////////////
// Save the image

procedure TImageEnDBView.UpdateData(Sender: TObject);
var
  ms: tmemorystream;
  ss: string;
begin
  fImageEnIO.StreamHeaders := fStreamHeaders;
  if FDataLink.Field is TBlobField then
  begin
    // blob
    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;
      ms.position := 0;
      (fdatalink.field as tblobfield).loadfromstream(ms);
    finally
      FreeAndNil(ms);
    end;
  end
  else if FDataLink.Field is TStringField then
  begin
    // path
    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;
    end;
  end;
end;

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

procedure TImageEnDBView.LoadPictureEx(ffImageEnIO: TImageEnIO);
var
  ms: tmemorystream;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -