好多人都抱怨delphi没有提供一个可以把任意数据放入数据库的控件，虽然说用代码实现也不难，但是有控件会更方便，这次我终于还是抽出空来做了 这么个控件，以后就可以直接拖放了。它支持把任意数据类型写入数据库，也可以从数据库读出到流，或是直接保存为文件。另外，我加了一些对常用图像的处理， 保存jpg或是gif格式的图像很方便，并且可以直接显示到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;
    {保存到数据库}
    function SaveToDatabase(AFileName: string): boolean;
    {追加到数据库}
    function AppendToDatabase(AFileName: string): boolean;
    {从数据库读出到流}
    function LoadToStream(var AStream: TStream): boolean;
    {从数据库读出到文件}
    function LoadToFile(AFileName: string): boolean;
    {读取图片}
    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;
var
  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;
var
  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;
var
  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;
var
  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;
var
  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.