我写的控件,适用于TTable, TQuery, TStoredProc
对了,注册代码自己写一下。
unit CcDBImg;interfaceuses
Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, DB, DBCtrls,
Jpeg, DBTables;type
THashJpg = class(TJPEGImage)
end;
TCcDBImage = class(TImage)
private
{ Private declarations }
FDataLink: TFieldDataLink;
FStream: TStream;
FJpeg: THashJpg;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
function GetField: TField;
protected
{ Protected declarations }
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
{ Published declarations }
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;implementation{ TCcDBImage }procedure TCcDBImage.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;constructor TCcDBImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner); FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FJpeg := THashJpg.Create;
end;procedure TCcDBImage.DataChange(Sender: TObject);
begin
if Assigned(FDataLink.Field) then
if not FDataLink.Field.IsNull then begin
FStream := TBlobStream.Create(TBlobField(FDataLink.Field), bmRead);
try
FJpeg.LoadFromStream(FStream);
Picture.Assign(FJpeg.Bitmap);
finally
FStream.Free
end
end
else
Picture.Assign(nil)
end;destructor TCcDBImage.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FJpeg.Free; inherited Destroy
end;function TCcDBImage.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;function TCcDBImage.GetDataField: string;
begin
Result := FDataLink.FieldName
end;function TCcDBImage.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource
end;function TCcDBImage.GetField: TField;
begin
Result := FDataLink.Field;
end;procedure TCcDBImage.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;procedure TCcDBImage.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;procedure TCcDBImage.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value
end;procedure TCcDBImage.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Assigned(Value) then
Value.FreeNotification(Self)
end;function TCcDBImage.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;function TCcDBImage.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;end.
对了,注册代码自己写一下。
unit CcDBImg;interfaceuses
Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, DB, DBCtrls,
Jpeg, DBTables;type
THashJpg = class(TJPEGImage)
end;
TCcDBImage = class(TImage)
private
{ Private declarations }
FDataLink: TFieldDataLink;
FStream: TStream;
FJpeg: THashJpg;
procedure DataChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
function GetField: TField;
protected
{ Protected declarations }
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
function UseRightToLeftAlignment: Boolean; override;
property Field: TField read GetField;
published
{ Published declarations }
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
end;implementation{ TCcDBImage }procedure TCcDBImage.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;constructor TCcDBImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner); FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FJpeg := THashJpg.Create;
end;procedure TCcDBImage.DataChange(Sender: TObject);
begin
if Assigned(FDataLink.Field) then
if not FDataLink.Field.IsNull then begin
FStream := TBlobStream.Create(TBlobField(FDataLink.Field), bmRead);
try
FJpeg.LoadFromStream(FStream);
Picture.Assign(FJpeg.Bitmap);
finally
FStream.Free
end
end
else
Picture.Assign(nil)
end;destructor TCcDBImage.Destroy;
begin
FDataLink.Free;
FDataLink := nil;
FJpeg.Free; inherited Destroy
end;function TCcDBImage.ExecuteAction(Action: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
FDataLink.ExecuteAction(Action);
end;function TCcDBImage.GetDataField: string;
begin
Result := FDataLink.FieldName
end;function TCcDBImage.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource
end;function TCcDBImage.GetField: TField;
begin
Result := FDataLink.Field;
end;procedure TCcDBImage.Loaded;
begin
inherited Loaded;
if (csDesigning in ComponentState) then DataChange(Self);
end;procedure TCcDBImage.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;procedure TCcDBImage.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value
end;procedure TCcDBImage.SetDataSource(const Value: TDataSource);
begin
if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
FDataLink.DataSource := Value;
if Assigned(Value) then
Value.FreeNotification(Self)
end;function TCcDBImage.UpdateAction(Action: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
FDataLink.UpdateAction(Action);
end;function TCcDBImage.UseRightToLeftAlignment: Boolean;
begin
Result := DBUseRightToLeftAlignment(Self, Field);
end;end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货