dbimageen.pas

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

  ifm: TDataFieldImageFormat;
  bg: THYIEGraphicHeader;
  ss: string;
  success:boolean;
begin
  success:=false;
  try
  ffImageEnIO.StreamHeaders := fStreamHeaders;
  if (FDataLink.Field is TBlobField) and ((FDataLink.Field as TBlobField).BlobSize > 0) then
  begin
    fDoImageChange := false;
    ifm := LoadedFieldImageFormat;
    ms := tmemorystream.create;
    try
      (fdatalink.field as tblobfield).savetostream(ms);
      ms.position := 0;
      if ifm = ifUnknown then
      begin
        // try paradox graphic
        ms.read(bg, sizeof(THYIEGraphicHeader));
        if (bg.Count = 1) and (bg.HType = $0100) then
          ifm := ifBitmap
        else
          ms.position := 0;
      end;
      case ifm of
        ifBitmap: ffImageEnIO.LoadFromStreamBMP(ms);
        ifJpeg: ffImageEnIO.LoadFromStreamJpeg(ms);
        ifGIF: ffImageEnIO.LoadFromStreamGIF(ms);
        ifPCX: ffImageEnIO.LoadFromStreamPCX(ms);
        ifTIFF: ffImageEnIO.LoadFromStreamTIFF(ms);
{$IFDEF IEINCLUDEPNG}
        ifPNG: ffImageEnIO.LoadFromStreamPNG(ms);
{$ENDIF}
        ifTGA: ffImageEnIO.LoadFromStreamTGA(ms);
        ifPXM: ffImageEnIO.LoadFromStreamPXM(ms);
        ifICO: ffImageEnIO.LoadFromStreamICO(ms);
{$IFDEF IEINCLUDEJPEG2000}
        ifJP2: ffImageEnIO.LoadFromStreamJP2(ms);
        ifJ2K: ffImageEnIO.LoadFromStreamJ2K(ms);
{$ENDIF}
        ifWBMP: ffImageEnIO.LoadFromStreamWBMP(ms);
        else
          Clear;
      end;
      success:=not ffImageEnIO.Aborting;
    finally
      FreeAndNil(ms);
      fDoImageChange := true;
    end;
  end
  else if (FDataLink.Field is TStringField) then
  begin
    ss := TStringField(FDataLink.Field).Value;
    if (ss <> '') and (fileexists(fAbsolutePath + ss)) then
    begin
      ss := fAbsolutePath + ss;
      ifm := LoadedFieldImageFormat;
      case ifm of
        ifBitmap: ffImageEnIO.LoadFromFileBMP(ss);
        ifJpeg: ffImageEnIO.LoadFromFileJpeg(ss);
        ifGIF: ffImageEnIO.LoadFromFileGIF(ss);
        ifPCX: ffImageEnIO.LoadFromFilePCX(ss);
        ifTIFF: ffImageEnIO.LoadFromFileTIFF(ss);
{$IFDEF IEINCLUDEPNG}
        ifPNG: ffImageEnIO.LoadFromFilePNG(ss);
{$ENDIF}
        ifTGA: ffImageEnIO.LoadFromFileTGA(ss);
        ifPXM: ffImageEnIO.LoadFromFilePXM(ss);
        ifICO: ffImageEnIO.LoadFromFileICO(ss);
{$IFDEF IEINCLUDEJPEG2000}
        ifJP2: ffImageEnIO.LoadFromFileJP2(ss);
        ifJ2K: ffImageEnIO.LoadFromFileJ2K(ss);
{$ENDIF}
        ifWBMP: ffImageEnIO.LoadFromFileWBMP(ss);
        else
          Clear;
      end;
      success:=not ffImageEnIO.Aborting;
      fDoImageChange := true;
    end;
  end;
  except
    success:=false;
  end;
  if (not success) and assigned(fOnUnableToLoadImage) then
    fOnUnableToLoadImage(self,FDataLink.Field);
end;

/////////////////////////////////////////////////////////////////////////////////////
// Carica immagine da fdatalink.field

{!!
<FS>TImageEnDBView.LoadPicture

<FM>Declaration<FC>
procedure LoadPicture;

<FM>Description<FN>
LoadPicture loads the image stored in the field into the database image control.

!!}
procedure TImageEnDBView.LoadPicture;
begin
  if (not FPictureLoaded) and
    (((FDataLink.Field is TBlobField) and ((FDataLink.Field as TBlobField).BlobSize > 0)) or
    (FDataLink.Field is TStringField)) then
  begin
    LoadPictureEx(fImageEnIO);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// restituisce il formato dell'immagine memorizzata in fDataLink.Field

{!!
<FS>TImageEnDBView.LoadedFieldImageFormat

<FM>Declaration<FC>
function LoadedFieldImageFormat: <A TDataFieldImageFormat>;

<FM>Description<FN>
LoadedFieldImageFormat gets the image format stored in the Blob field (load directly from blob).

If you change <A TImageEnDBView.DataFieldImageFormat>, to store as several image formats, LoadedFieldImageFormat maintains the original value.

!!}
function TImageEnDBView.LoadedFieldImageFormat: TDataFieldImageFormat;
var
  ms: tmemorystream;
  ss: string;
begin
  result := ifUnknown;
  if not FAutoDisplay then
    exit;
  if FDataLink.Field is TBlobField then
  begin
    ms := tmemorystream.create;
    try
      (fdatalink.field as tblobfield).savetostream(ms);
      ms.position := 0;
      case FindStreamFormat(ms) of
        ioBMP: result := ifBitmap;
        ioJPEG: result := ifJpeg;
        ioGIF: result := ifGIF;
        ioPCX: result := ifPCX;
        ioTIFF: result := ifTIFF;
{$IFDEF IEINCLUDEPNG}
        ioPNG: result := ifPNG;
{$ENDIF}
        ioTGA: result := ifTGA;
        ioPXM: result := ifPXM;
        ioICO: result := ifICO;
{$IFDEF IEINCLUDEJPEG2000}
        ioJP2: result := ifJP2;
        ioJ2K: result := ifJ2K;
{$ENDIF}
        ioWBMP: result := ifWBMP;
      end;
    finally
      FreeAndNil(ms);
    end;
  end
  else if FDataLink.Field is TStringField then
  begin
    ss := TStringField(FDataLink.Field).Value;
    if (ss <> '') and (fileexists(fAbsolutePath + ss)) then
    begin
      case FindFileFormat(fAbsolutePath + ss, false) of
        ioBMP: result := ifBitmap;
        ioJPEG: result := ifJpeg;
        ioGIF: result := ifGIF;
        ioPCX: result := ifPCX;
        ioTIFF: result := ifTIFF;
{$IFDEF IEINCLUDEPNG}
        ioPNG: result := ifPNG;
{$ENDIF}
        ioTGA: result := ifTGA;
        ioPXM: result := ifPXM;
        ioICO: result := ifICO;
{$IFDEF IEINCLUDEJPEG2000}
        ioJP2: result := ifJP2;
        ioJ2K: result := ifJ2K;
{$ENDIF}
        ioWBMP: result := ifWBMP;
      end;
    end;
  end;
end;

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

procedure TImageEnDBView.SetJPegQuality(q: integer);
begin
  IOParams.JPEG_Quality := q;
end;

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

{!!
<FS>TImageEnDBView.JpegQuality

<FM>Declaration<FC>
property JpegQuality: integer;

<FM>Description<FN>
JpegQuality sets the quality factor, from 1 to 100. The higher the value, the better the image quality and the larger resultant memory needed.

This is the example of IOParams.JPEG_Quality.

!!}
function TImageEnDBView.GetJPegQuality: integer;
begin
  result := IOParams.JPEG_Quality;
end;

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

{!!
<FS>TImageEnDBView.IOParams

<FM>Declaration<FC>
property IOParams: <A TIOParamsVals>;

<FM>Description<FN>
IOParams allow you to set or get all file format parameters such as bits per pixel or type of compression.

Read-only


<FM>Example<FC>

Table1.Edit;
ImageEnDBView1.IOParams.BMP_Compression:=ioBMP_RLE;
Table1.Post;
!!}
function TImageEnDBView.GetIOParams: TIOParamsVals;
begin
  result := fImageEnIO.Params;
end;

/////////////////////////////////////////////////////////////////////////////////////
{$IFDEF IEINCLUDEDIALOGIO}

{!!
<FS>TImageEnDBView.DoIOPreview

<FM>Declaration<FC>
function DoIOPreview: boolean;

<FM>Description<FN>
This function executes the IOPreviews dialog. This dialog gets/sets the parameters of image file formats.
The dialog shown depends on the DataFielImageFormat property. 

!!}
function TImageEnDBView.DoIOPreview: boolean;
var
  pp: TPreviewParams;
begin
  case fDataFieldImageFormat of
    ifBitmap: pp := [ppBMP];
    ifJpeg: pp := [ppJPEG];
    ifGIF: pp := [ppGIF];
    ifPCX: pp := [ppPCX];
    ifTIFF: pp := [ppTIFF];
    ifPNG: pp := [ppPNG];
    ifTGA: pp := [ppTGA];
  else
    begin
      result := false;
      exit;
    end;
  end;
  result := fImageEnIO.DoPreviews(pp);
end;
{$ENDIF}

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

procedure TImageEnDBView.SetIOPreviewsParams(v: TIOPreviewsParams);
begin
  fImageEnIO.PreviewsParams := v;
end;

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

{!!
<FS>TImageEnDBView.IOPreviewsParams

<FM>Declaration<FC>
property IOPreviewsParams:<A TIOPreviewsParams>;

<FM>Description<FN>
This property contains some features that the input/output preview dialog will have.
!!}
function TImageEnDBView.GetIOPreviewsParams: TIOPreviewsParams;
begin
  result := fImageEnIO.PreviewsParams;
end;

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

procedure TImageEnDBView.SetPreviewFont(f: TFont);
begin
  fImageEnIO.PreviewFont := f;
end;

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

{!!
<FS>TImageEnDBView.PreviewFont

<FM>Declaration<FC>
property PreviewFont: TFont;

<FM>Description<FN>
PreviewFont contains the font used in the IOPreviews dialog. Make sure the size of font matches the labels length.


<FM>Example<FC>

ImageEnDBView1.PreviewFont.Name:='MS Times New Roman';
ImageEnDBView1.DoPreviews([peAll]);
!!}
function TImageEnDBView.GetPreviewFont: TFont;
begin
  result := fImageEnIO.PreviewFont;
end;

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

{!!
<FS>TImageEnDBView.DataFieldImageFormat

<FM>Declaration<FC>
property DataFieldImageFormat: <A TDataFieldImageFormat>;

<FM>Description<FN>
Sets the image format to save in the Blob field or path reference.

Look at <A TImageEnDBView.IOParams> property for specific image format parameters.

!!}
function TImageEnDBView.GetDataFieldImageFormat: TDataFieldImageFormat;
begin
  result := fDataFieldImageFormat;
end;

function TImageEnDBView.InsideDBCtrl: boolean;
var
  parent: TControl;
begin
  result := false;
  parent := self;
  while (parent <> nil) do
  begin
    if parent.ClassName = 'TDBCtrlGrid' then
    begin
      result := true;
      break;
    end;
    if parent = parent.parent then
      break;
    parent := parent.parent;
  end;
end;

procedure TImageEnDBView.PaintToEx(ABitmap: TIEBitmap; ABitmapScanline: ppointerarray; UpdRect: PRect; drawBackground:boolean; drawGadgets:boolean);
var
  ie: TImageEnView;
  bmp: TIEBitmap;
begin
  if (not (csDesigning in ComponentState)) and assigned(fDataLink.DataSource) and assigned(fDataLink.DataSource.DataSet) and
    FDataLink.DataSource.DataSet.Active and (fIsInsideDBCtrl or InsideDbCtrl) then
  begin
    // we are inside TDBGrid
    (*
    ie:=TImageEnView.Create(owner);
    ie.visible:=false;
    ie.Parent:=parent;
    ie.AutoFit:=AutoFit;
    ie.Center:=Center;
    ie.Background:=Background;
    ie.Width:=Width;
    ie.Height:=Height;
    ie.BorderStyle:=BorderStyle;
    ie.BackgroundStyle:=BackgroundStyle;
    ie.EnableAlphaChannel:=EnableAlphaChannel;
    ie.ZoomFilter:=ZoomFilter;
    fUpdateInvalidate:=false;
    LoadPictureEx(ie.IO);
    fUpdateInvalidate:=true;
    ie.PaintToEx(ABitmap,ABitmapScanline,UpdRect);
    ie.free;
    //*)
    //(*
    bmp := TIEBitmap.Create;
    bmp.assign(IEBitmap);
    fUpdateInvalidate := false;
    ie := TImageEnView.Create(nil);
    LoadPictureEx(ie.IO);
    if (ie.IEBitmap.Width = 0) or (ie.IEBitmap.Height = 0) then
    begin
      IEBitmap.Resize(1, 1, Background, 255, iehLeft, ievTop);
      IEBitmap.Fill(Background);
    end
    else
      IEBitmap.Assign(ie.IEBitmap);
    Update;
    inherited;
    IEBitmap.Assign(bmp);
    FreeAndNil(ie);
    FreeAndNil(bmp);
    fUpdateInvalidate := true;
    //*)
  end
  else
    inherited;
end;

procedure TImageEnDBView.Paint;
begin
  fDBToDraw := true;
  inherited;
end;

{!!
<FS>TImageEnDBView.AbsolutePath

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

<FM>Description<FN>
The AbsolutePath property sets/gets the base path where the stored images are when <A TImageEnDBView.DataField> points to a string field.

The final path is calculated by concatenation of AbsolutePath and string field.

The default value is an empty string. If the AbsolutePath property is empty, then the string field should be an absolute path.
!!}
procedure TImageEnDBView.SetAbsolutePath(const v: string);
begin
  fAbsolutePath := v;
  FPictureLoaded := false;
  LoadPicture;
end;

{$ELSE} // {$ifdef IEINCLUDEDB}

interface
implementation

{$ENDIF}

end.