(* ImageEn Build 7.0.0.06.2637 @ 7-4-17 14:58:42.679 *) (* Copyright (c) 1998-2017 by Carlotta Calandra. All rights reserved. Copyright (c) 2011-2017 by Xequte Software. 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. Author grants you the right to include the component in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE. ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial, shareware or freeware libraries or components. www.ImageEn.com *) (* File version 1004 *) unit dbimageen; {$R-} {$Q-} {$I ie.inc} {$IFDEF IEINCLUDEDB} interface uses Windows, Messages, classes, Graphics, Db, dbctrls, ImageEnView, ImageEnio, hyiedefs, iexBitmaps, hyieutils; type {!! TDataFieldImageFormat Declaration TDataFieldImageFormat = (ifBitmap, ifJpeg, ifGIF, ifPCX, ifTIFF, ifTIFFwAnnot, ifPNG, ifTGA, ifPXM, ifICO, ifJP2, ifJ2K, ifWBMP, ifUnknown); Description Value Description ifBitmap BMP format ifJpeg Jpeg format ifGIF GIF format ifPCX PCX format ifTIFF TIFF format ifTIFFwAnnotTIFF format with embedded TImageEnVect annotations (works only with ). Doesn't use stream headers. ifPNG PNG format ifTGA TGA format ifPXM PXM format ifICO ICO format ifJP2 JPEG2000 format ifJ2K JPEG2000 format ifWBMP WBMP format ifUnknown Unknown format
!!} TDataFieldImageFormat = (ifBitmap, ifJpeg, ifGIF, ifPCX, ifTIFF, ifTIFFwAnnot, ifPNG, ifTGA, ifPXM, ifICO, ifJP2, ifJ2K, ifWBMP, ifUnknown); {!! TUnableToLoadImageEvent Declaration } TUnableToLoadImageEvent = procedure(Sender: TObject; Field: TField) of object; {!!} {!! TIEBeforeLoadImageEvent Declaration } TIEBeforeLoadImageEvent = procedure(Sender: TObject; Field: TField) of object; {!!} {!! TImageEnDBView Description TImageEnDBView is a descendant of , 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 similarly to Delphi TDBImage components. You can specify particular file format parameters through property, or by executing the method. You can attach a component for processing the image contained in the Blob. Also see methods and properties of . Methods and Properties Events !!} TImageEnDBView = class(TImageEnView, IIELoadPicture) 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; fOnBeforeLoadImage: TIEBeforeLoadImageEvent; fUseMemoryStream: boolean; 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: TIOParams; function GetIOPreviewsParams: TIOPreviewsParams; procedure SetIOPreviewsParams(v: TIOPreviewsParams); procedure SetPreviewFont(f: TFont); function GetPreviewFont: TFont; procedure SetPreviewFontEnabled(Value: Boolean); function GetPreviewFontEnabled: Boolean; 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; 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: TIOParams 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; property PreviewFontEnabled: Boolean read GetPreviewFontEnabled write SetPreviewFontEnabled default false; {!! TImageEnDBView.UseMemoryStream Declaration property UseMemoryStream: boolean Description If True (default), TImageEnDBView will use a temporary memory stream to retrieve data from blob stream. Otherwise will use CreateBlobStream. !!} property UseMemoryStream: boolean read fUseMemoryStream write fUseMemoryStream default true; {!! TImageEnDBView.StreamHeaders Declaration property StreamHeaders: boolean Description If True, TImageEnDBView adds an additional header before standard image format. To read older ImageEn data fields, leave this property as True. To read data field from other programs, set this property to False. Default: False !!} property StreamHeaders: boolean read fStreamHeaders write fStreamHeaders default false; property IsInsideDbCtrl: boolean read fIsInsideDbCtrl write fIsInsideDbCtrl default false; {!! TImageEnDBView.OnUnableToLoadImage Declaration property OnUnableToLoadImage: ; Description Occurs when or TImageEnDBView fails to load an image from blob field. !!} property OnUnableToLoadImage: TUnableToLoadImageEvent read fOnUnableToLoadImage write fOnUnableToLoadImage; {!! TImageEnDBView.OnBeforeLoadImage Declaration property OnBeforeLoadImage: ; Description Occurs immediately before an image is loaded. !!} property OnBeforeLoadImage: TIEBeforeLoadImageEvent read fOnBeforeLoadImage write fOnBeforeLoadImage; end; function IETDataFieldImageFormat_To_TIOFileType(imageformat: TDataFieldImageFormat): TIOFileType; function IETIOFileType_To_TDataFieldImageFormat(filetype: TIOFileType): TDataFieldImageFormat; implementation uses controls, giffilter, sysutils; {$R-} function IETDataFieldImageFormat_To_TIOFileType(imageformat: TDataFieldImageFormat): TIOFileType; const DATAFIELDIMAGEFORMAT_TO_TIOIMAGEFORMAT: array [TDataFieldImageFormat] of TIOFileType = (ioBMP, ioJPEG, ioGIF, ioPCX, ioTIFF, ioTIFF, ioPNG, ioTGA, ioPXM, ioICO, ioJP2, ioJ2K, ioWBMP, ioUnknown); begin result := DATAFIELDIMAGEFORMAT_TO_TIOIMAGEFORMAT[imageformat]; end; function IETIOFileType_To_TDataFieldImageFormat(filetype: TIOFileType): TDataFieldImageFormat; begin case filetype 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; else result := ifUnknown; end; end; {!! TImageEnDBView.AutoDisplay Declaration property AutoDisplay: Boolean; Description 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; fOnBeforeLoadImage := nil; fUseMemoryStream := true; end; destructor TImageEnDBView.Destroy; begin FreeAndNil(FDataLink); inherited Destroy; end; {!! TImageEnDBView.DataSource Declaration property DataSource: TDataSource; Description 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 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; {!! TImageEnDBView.DataField Declaration property DataField: string; Description 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 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; {!! TImageEnDBView.ReadOnly Declaration property ReadOnly: Boolean; Description 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; {!! TImageEnDBView.Field Declaration property Field: TField; Description 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 stream: TStream; ss: string; begin fImageEnIO.StreamHeaders := fStreamHeaders; if FDataLink.Field is TBlobField then begin // blob if fUseMemoryStream then begin // upload the full file using a temporary memory stream stream := TMemoryStream.create; try fImageEnIO.SaveToStream(stream, IETDataFieldImageFormat_To_TIOFileType(fDataFieldImageFormat)); stream.position := 0; (FDatalink.Field as TBlobField).LoadFromStream(stream); finally stream.Free(); end; end else begin // direct save using CreateBlobStream stream := FDatalink.DataSet.CreateBlobStream(FDatalink.Field, bmWrite); try fImageEnIO.SaveToStream(stream, IETDataFieldImageFormat_To_TIOFileType(fDataFieldImageFormat)); finally stream.Free(); end; end end else if FDataLink.Field is TStringField then begin // path ss := string(TStringField(FDataLink.Field).Value); if (ss <> '') then begin ss := fAbsolutePath + ss; fImageEnIO.SaveToFile(ss, IETDataFieldImageFormat_To_TIOFileType(fDataFieldImageFormat)); end; end; end; // Load image from fdatalink.field without check fPictureLoaded // Doesn't assign fDataFieldImageFormat procedure TImageEnDBView.LoadPictureEx(ffImageEnIO: TImageEnIO); var stream: TStream; ifm: TDataFieldImageFormat; bg: THYIEGraphicHeader; ss: string; success: boolean; begin if assigned(fOnBeforeLoadImage) then fOnBeforeLoadImage(self, FDataLink.Field); success := false; try ffImageEnIO.StreamHeaders := fStreamHeaders; if (FDataLink.Field is TBlobField) and ((FDataLink.Field as TBlobField).BlobSize > 0) then begin fDoImageChange := false; ifm := LoadedFieldImageFormat(); stream := nil; try if fUseMemoryStream then begin // download image into temporary memory stream stream := TMemoryStream.Create; (FDatalink.Field as TBlobField).SaveToStream(stream); stream.Position := 0; end else begin // directly download the image stream := FDatalink.DataSet.CreateBlobStream(FDatalink.Field, bmRead); end; if ifm = ifUnknown then begin // try paradox graphic stream.read(bg, sizeof(THYIEGraphicHeader)); if (bg.Count = 1) and (bg.HType = $0100) then ifm := ifBitmap else stream.position := 0; end; ffImageEnIO.LoadFromStream(stream, IETDataFieldImageFormat_To_TIOFileType(ifm)); if ffImageEnIO.Aborting then Clear(); success := not ffImageEnIO.Aborting; finally stream.Free(); fDoImageChange := true; end; end else if (FDataLink.Field is TStringField) then begin ss := string(TStringField(FDataLink.Field).Value); if (ss <> '') and (IEFileExists(fAbsolutePath + ss)) then begin ss := fAbsolutePath + ss; ifm := LoadedFieldImageFormat; ffImageEnIO.LoadFromFile(ss, IETDataFieldImageFormat_To_TIOFileType(ifm)); if ffImageEnIO.Aborting then Clear(); success := not ffImageEnIO.Aborting; fDoImageChange := true; end; end; except success := false; end; if (not success) and assigned(fOnUnableToLoadImage) then fOnUnableToLoadImage(self, FDataLink.Field); end; {!! TImageEnDBView.LoadPicture Declaration procedure LoadPicture; Description LoadPicture loads the image stored in the field into the database image control. !!} // Load image from fdatalink.field 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; {!! TImageEnDBView.LoadedFieldImageFormat Declaration function LoadedFieldImageFormat(): ; Description Returns the image format stored in the Blob field (load directly from blob). Note: If you change , to store as several image formats, LoadedFieldImageFormat maintains the original value. !!} function TImageEnDBView.LoadedFieldImageFormat(): TDataFieldImageFormat; var stream: TStream; ss: string; begin result := ifUnknown; if not FAutoDisplay then exit; if FDataLink.Field is TBlobField then begin stream := nil; try if fUseMemoryStream then begin stream := TMemoryStream.create; (FDatalink.Field as TBlobField).SaveToStream(stream); stream.Position := 0; end else stream := FDatalink.DataSet.CreateBlobStream(FDatalink.Field, bmRead); result := IETIOFileType_To_TDataFieldImageFormat( FindStreamFormat(stream) ); finally stream.Free(); end; end else if FDataLink.Field is TStringField then begin ss := string(TStringField(FDataLink.Field).Value); if (ss <> '') and (IEFileExists(fAbsolutePath + ss)) then result := IETIOFileType_To_TDataFieldImageFormat( FindFileFormat(fAbsolutePath + ss, ffContentOnly) ); end; end; procedure TImageEnDBView.SetJpegQuality(q: integer); begin IOParams.JPEG_Quality := q; end; {!! TImageEnDBView.JpegQuality Declaration property JpegQuality: integer; Description Specifies 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 .. !!} function TImageEnDBView.GetJpegQuality: integer; begin result := IOParams.JPEG_Quality; end; {!! TImageEnDBView.IOParams Declaration property IOParams: ; Description IOParams allow you to set or get all file format parameters such as bits per pixel or type of compression. Read-only Example Table1.Edit; ImageEnDBView1.IOParams.BMP_Compression := ioBMP_RLE; Table1.Post; !!} function TImageEnDBView.GetIOParams: TIOParams; begin result := fImageEnIO.Params; end; {$IFDEF IEINCLUDEDIALOGIO} {!! TImageEnDBView.DoIOPreview Declaration function DoIOPreview: boolean; Description Executes the IOPreviews dialog. This dialog gets/sets the parameters of image file formats. The dialog shown depends on the 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, ifTIFFwAnnot: 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; {!! TImageEnDBView.IOPreviewsParams Declaration property IOPreviewsParams: ; Description Specifies features of the input/output preview dialog. Example // Show preview by default ImageEnDBView1.IOPreviewsParams := ImageEnDBView1.IOPreviewsParams + [ ioppDefaultLockPreview ]; !!} function TImageEnDBView.GetIOPreviewsParams: TIOPreviewsParams; begin result := fImageEnIO.PreviewsParams; end; {!! TImageEnDBView.PreviewFont Declaration property PreviewFont: TFont; Description If is set to True then PreviewFont specifies the font used in the IOPreviews dialog. Ensure the size of font matches the labels length. Example ImageEnDBView1.PreviewFont.Name := 'MS Times New Roman'; ImageEnDBView1.PreviewFontEnabled := True; ImageEnDBView1.DoPreviews([peAll]); !!} function TImageEnDBView.GetPreviewFont: TFont; begin result := fImageEnIO.PreviewFont; end; procedure TImageEnDBView.SetPreviewFont(f: TFont); begin fImageEnIO.PreviewFont := f; end; {!! TImageEnDBView.PreviewFontEnabled Declaration property PreviewFontEnabled: TFont; Description By default (when PreviewFontEnabled = False) IO Preview dialogs are displayed using the system font (e.g. Tahoma or Segoe UI). If you set PreviewFontEnabled to True then you can use to specify a custom font for the IO Preview dialogs. Example ImageEnDBView1.PreviewFont.Name := 'MS Times New Roman'; ImageEnDBView1.PreviewFontEnabled := False; ImageEnDBView1.DoPreviews([peAll]); !!} function TImageEnDBView.GetPreviewFontEnabled: Boolean; begin result := fImageEnIO.PreviewFontEnabled; end; procedure TImageEnDBView.SetPreviewFontEnabled(value : Boolean); begin fImageEnIO.PreviewFontEnabled := value; end; {!! TImageEnDBView.DataFieldImageFormat Declaration property DataFieldImageFormat: ; Description Specifies the image format to save in the Blob field or path reference. See the 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; 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 bmp := TIEBitmap.Create; bmp.Assign(IEBitmap); fUpdateInvalidate := false; ie := TImageEnView.Create(nil); try 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); finally FreeAndNil(ie); FreeAndNil(bmp); end; fUpdateInvalidate := true; end else inherited; end; procedure TImageEnDBView.Paint; begin fUpdateBackBuffer := true; inherited; end; {!! TImageEnDBView.AbsolutePath Declaration property AbsolutePath: string; Description Specifies the base path where the stored images are when 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.