好多人都抱怨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. 
---------------------
作者:清风古韵
来源:CSDN
原文:https://blog.csdn.net/ttpage/article/details/9161695
版权声明:本文为博主原创文章,转载请附上博文链接!

最新文章

  1. 在linux中减小和增大LV的过程与思考
  2. jquery.min.map 404 (Not Found)出错的原因及解决办法
  3. AIX 环境下遇到Device Busy问题
  4. requirejs+angularjs搭建SPA页面应用
  5. 在Xcode中想要清屏该怎么实现
  6. JS,分页
  7. JavaScript密码复杂度
  8. HipChat上传文件报未知错误解决方案
  9. jQuery 元素遍历
  10. Charles --- Mac 抓包工具
  11. const类型变量的详细解读
  12. LeetCode(41)-Rectangle Area
  13. JDBC 初识
  14. 【转】深入分析 Parquet 列式存储格式
  15. 页面适配的小栗子 - github
  16. Item 17: 理解特殊成员函数的生成规则
  17. 自行实现高性能MVC
  18. linux删除指定创建时间文件(文件夹)脚本
  19. 据库分库分表(sharding)系列(一) 拆分实施策略和示例演示
  20. bootstrap-datepicker 与bootstrapValidator同时使用时,选择日期后,无法正常触发校验

热门文章

  1. Python处理PDF-通过关键词定位-截取PDF中的图表
  2. PROPAGATION_REQUIRED,ISOLATION_DEFAULT; '',-java.lang.Exception
  3. tiles介绍
  4. 【三种负载均衡器的优缺点】LVS Nginx HAProxy
  5. 校第十六届大学生程序设计竞赛暨2016省赛集训队选拔赛(Problem E)
  6. android L版本AAL新架构
  7. BZOJ2097: [Usaco2010 Dec]Exercise 奶牛健美操
  8. c/s程序版本自动升级的问题,如何判断client端版本号是否最新,然后从指定ftp服务器down
  9. HDU 1669 二分图多重匹配+二分
  10. Oracle 10g 升级至10.2.0.4