Many people complain that Delphi does not provide a control that can put arbitrary data into the database. Although it is not difficult to implement it with code, it is more convenient to have a control. This time I finally took the time to make such a control. You can drag and drop directly. It supports writing any data type to the database, it can also be read from the database to stream, or directly saved as a file. In addition, I added some processing of commonly used images, saving images in jpg or gif format is very convenient, and can be displayed directly on the image.
unit RaDBOLE;
interface
uses
SysUtils, Classes, DB, DBTables, JPEG, ExtCtrls, GIFCtrl;
type
TImageType=(itBMP, itJPG, itGIF, itOther);
TOnSaveData=procedure(Sender: TObject) of object;
TOnLoadData=procedure(Sender: TObject) of object;
TOnShowImage=procedure(Sender: TObject; ImageType: TImageType) of object;
type
TRaDBOLE=class(TComponent)
private
fDataSet: TDataSource;
fDataField: string;
fImage: TImage;
fGifImage: TRxGIFAnimator;
fOnSaveData: TOnSaveData;
fOnLoadData: TOnLoadData;
fOnShowImage: TOnShowImage;
protected
public
constructor Create(AOwner: TComponent); override;
{Save to database}
function SaveToDatabase(AFileName: string): boolean;
{Append to database}
function AppendToDatabase(AFileName: string): boolean;
{Read from database to stream}
function LoadToStream(var AStream: TStream): boolean;
{Read from database to file}
function LoadToFile(AFileName: string): boolean;
{Read picture}
procedure GetImage;
published
property DataSet: TDataSource read fDataSet write fDataSet;
property DataField: string read fDataField write fDataField;
property Image: TImage read fImage write fImage;
property GifImage: TRxGIFAnimator read fGifImage write fGifImage;
property OnSaveData: TOnSaveData read fOnSaveData write fOnSaveData;
property OnLoadData: TOnLoadData read fOnLoadData write fOnLoadData;
property OnShowImage: TOnShowImage read fOnShowImage write fOnShowImage;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rarnu Components', [TRaDBOLE]);
end;
{ TRaDBOLE }
function TRaDBOLE.AppendToDatabase(AFileName: string): boolean;
where
mm: tmemorystream;
begin
result :=True;
mm :=tmemorystream.Create;
mm.LoadFromFile(AFileName);
mm.Position :=0;
try
fDataSet.DataSet.Append;
tblobfield(fDataSet.DataSet.FieldByName(fDataField)).LoadFromStream(mm);
fDataSet.DataSet.Post;
except
result :=False;
end;
mm.Free;
if Assigned(OnSaveData) then
OnSaveData(Self);
end;
constructor TRaDBOLE.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fDataSet: = nil;
fDataField :='';
fImage: = nil;
end;
procedure TRaDBOLE.GetImage;
where
ww: tmemorystream;
JPEG: TJPEGImage;
IT: TImageType;
begin
if fImage=nil then Exit;
ww :=tmemorystream.Create;
tblobfield(fDataSet.DataSet.FieldByName(fDataField)).SaveToStream(ww);
try
fImage.Picture.Assign(fDataSet.DataSet.FieldByName(fDataField));
IT :=itBMP;
except
try
JPEG :=TJPEGImage.Create;
JPEG.Assign(fDataSet.DataSet.FieldByName(fDataField));
fImage.Picture.Assign(JPEG);
IT :=itJPG;
except
try
if fGifImage=nil then Exit;
fGifImage.Image.Assign(fDataSet.DataSet.FieldByName(fDataField));
IT :=itGIF;
except
IT :=itOther;
end;
end;
end;
//fImage.Picture.Graphic.LoadFromStream(ww);
ww.Free;
if Assigned(OnShowImage) then
OnShowImage(Self, IT);
end;
function TRaDBOLE.LoadToFile(AFileName: string): boolean;
where
tt: tmemorystream;
begin
result :=True;
tt :=tmemorystream.Create;
try
tblobfield(fDataSet.DataSet.FieldByName(fDataField)).SaveToStream(tt);
tt.Position :=0;
tt.SaveToFile(AFileName);
except
result :=False;
end;
tt.Free;
if Assigned(OnLoadData) then
OnLoadData(Self);
end;
function TRaDBOLE.LoadToStream(var AStream: TStream): boolean;
where
tt: tmemorystream;
begin
result :=True;
tt :=tmemorystream.Create;
try
tblobfield(fDataSet.DataSet.FieldByName(fDataField)).SaveToStream(tt);
tt.Position :=0;
AStream :=tt;
except
result :=False;
end;
tt.Free;
if Assigned(OnLoadData) then
OnLoadData(Self);
end;
function TRaDBOLE.SaveToDatabase(AFileName: string): boolean;
where
mm: tmemorystream;
begin
result :=True;
mm :=tmemorystream.Create;
mm.LoadFromFile(AFileName);
mm.Position :=0;
try
fDataSet.Edit;
tblobfield(fDataSet.DataSet.FieldByName(fDataField)).LoadFromStream(mm);
fDataSet.DataSet.Post;
except
result :=False;
end;
mm.Free;
if Assigned(OnSaveData) then
OnSaveData(Self);
end;
end.
---------------------
Author: breeze rhyme
Source: CSDN
Original: https://blog.csdn.net/ttpage/article/details/9161695
Copyright Statement: This article is an original blogger article, please attach a link to the blog post when reprinting!