?? dbimageen.pas
字號:
(*
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 + -