dbimageenvect.pas

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

    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;
      RemoveAllObjects;
      LoadFromStreamIEV(ms);
    finally
      FreeAndNil(ms);
      fDoImageChange := true;
    end;
  end
  else if (FDataLink.Field is TStringField) then
  begin
    ffImageEnIO.StreamHeaders := false;
    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;
      RemoveAllObjects;
      if fileexists(ss + '.iev') then
        LoadFromFileIEV(ss + '.iev');
      fDoImageChange := true;
    end;
  end;
  except
    success:=false;
  end;
  if (not success) and assigned(fOnUnableToLoadImage) then
    fOnUnableToLoadImage(self,FDataLink.Field);
end;

{!!
<FS>TImageEnDBVect.LoadPicture

<FM>Declaration<FC>
procedure LoadPicture;

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

!!}
procedure TImageEnDBVect.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;

{!!
<FS>TImageEnDBVect.LoadedFieldImageFormat

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

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

If you change DataFieldImageFormat, to store a several image formats, LoadedFieldImageFormat maintains the original value.

!!}
function TImageEnDBVect.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 TImageEnDBVect.SetJPegQuality(q: integer);
begin
  IOParams.JPEG_Quality := q;
end;

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

{!!
<FS>TImageEnDBVect.JpegQuality

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

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

This is the same as TIOParamsVas.<A TIOParamsVals.JPEG_Quality>.

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

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

{!!
<FS>TImageEnDBVect.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 TImageEnDBVect.GetIOParams: TIOParamsVals;
begin
  result := fImageEnIO.Params;
end;

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

{!!
<FS>TImageEnDBVect.DoIOPreview

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

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

!!}
function TImageEnDBVect.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 TImageEnDBVect.SetIOPreviewsParams(v: TIOPreviewsParams);
begin
  fImageEnIO.PreviewsParams := v;
end;

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

{!!
<FS>TImageEnDBVect.IOPreviewsParams

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

<FM>Description<FN>
The IOPreviewsParams property contains some features that input/output preview dialogs will present. Currently only ioppDefaultLockPreview is allowed.

Set ioppDefaultLockPreview to set down the "Lock preview" button when the dialog is showed.

!!}
function TImageEnDBVect.GetIOPreviewsParams: TIOPreviewsParams;
begin
  result := fImageEnIO.PreviewsParams;
end;

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

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

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

{!!
<FS>TImageEnDBVect.PreviewFont

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

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

<FM>Example<FC>

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

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

{!!
<FS>TImageEnDBVect.DataFieldImageFormat

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

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

Look at <A TImageEnDBVect.IOParams> property for specific image format parameters.
!!}
function TImageEnDBVect.GetDataFieldImageFormat: TDataFieldImageFormat;
begin
  result := fDataFieldImageFormat;
end;

function TImageEnDBVect.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 TImageEnDBVect.PaintToEx(ABitmap: TIEBitmap; ABitmapScanline: ppointerarray; UpdRect: PRect; drawBackground:boolean; drawGadgets:boolean);
var
  ie: TImageEnVect;
  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 in TDBGrid
      (*
      fImageEnIO:=TImageEnIO.Create(self);
  fImageEnVect:=TImageEnVect.Create(self);
      fImageEnVect.visible:=false;
      fImageEnVect.Parent:=Parent;
      fImageEnVect.AutoFit:=AutoFit;
      fImageEnVect.Center:=Center;
      fImageEnVect.Background:=Background;
      fImageEnVect.Width:=Width;
      fImageEnVect.Height:=Height;
      fImageEnVect.BorderStyle:=BorderStyle;
      fImageEnVect.BackgroundStyle:=BackgroundStyle;
      fUpdateInvalidate:=false;
      fImageEnIO.AttachedImageEn:=fImageEnVect;
      LoadPictureEx(fImageEnIO);
  fImageEnIO.AttachedImageEn:=nil;
      fUpdateInvalidate:=true;
      fImageEnVect.PaintToEx(ABitmap,ABitmapScanline,UpdRect);
  fImageEnVect.free;
      fImageEnIO.free;
      *)
      //(*
    bmp := TIEBitmap.Create;
    bmp.assign(IEBitmap);
    fUpdateInvalidate := false;
    ie := TImageEnVect.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 TImageEnDBVect.Paint;
begin
  fDBToDraw := true;
  inherited;
end;

{!!
<FS>TImageEnDBVect.AbsolutePath

<FM>Declaration<FC>
procedure SetAbsolutePath(const v: string);

<FM>Description<FN>
The AbsolutePath property sets/gets the base path where the stored images are when <A TImageEnDBVect.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 TImageEnDBVect.SetAbsolutePath(const v: string);
begin
  fAbsolutePath := v;
  FPictureLoaded := false;
  LoadPicture;
end;

{$ELSE} // {$ifdef IEINCLUDEDB}

interface
implementation

{$ENDIF}

end.