好多人都抱怨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
版权声明:本文为博主原创文章,转载请附上博文链接!

delphi的万能数据库操作的更多相关文章

  1. DELPHI XE MYSQL数据库操作类 MYSQLHELPER

    注: 无需odbc配置 {* * MySQL Helper v1.0 * 2015.6.19 * 说明: * 这是一个操作MySQL的类,该类必须和libmysql.dll,dbxmys.dll两个文 ...

  2. DELPHI 数据库操作

    DELPHI 把数据库中的数据转换成XML格式 function ReplaceString(AString: string): string; begin Result := StringRepla ...

  3. 数据库操作API 或万能的双下划线

    数据库操作API: 类型 描述 exact 精确匹配: polls.get_object(id__exact=14). iexact 忽略大小写的精确匹配: polls.objects.filter( ...

  4. Delphi的注册表操作

    转帖:Delphi的注册表操作 2009-12-21 11:12:52 分类: Delphi的注册表操作 32位Delphi程序中可利用TRegistry对象来存取注册表文件中的信息.     一.创 ...

  5. 《万能数据库查询分析器》实现使用SQL语句直接高效地访问文本文件

    <万能数据库查询分析器>实现使用SQL语句直接高效地访问文本文件 马根峰 (广东联合电子服务股份有限公司, 广州 510300) 摘要    用SQL语句来直接访问文本文件?是在做梦吗? ...

  6. “万能数据库查询分析器” 5.03发布,访问EXCEL将自动为表名前后加上中括弧

        "万能数据库查询分析器" 5.03发布,访问EXCEL将自动为表名前后加上中括弧 1          引言    中国本土程序员马根峰推出的个人作品----万能数据库查询 ...

  7. Python学习笔记:sqlite3(sqlite数据库操作)

    对于数据库的操作,Python中可以通过下载一些对应的三方插件和对应的数据库来实现数据库的操作,但是这样不免使得Python程序变得更加复杂了.如果只是想要使用数据库,又不想下载一些不必要的插件和辅助 ...

  8. [转帖]万能数据库的使用【DbVisualizer软件,连接不同类型的数据库】

    万能数据库的使用[DbVisualizer软件,连接不同类型的数据库] https://www.cnblogs.com/FanSunny/p/4874572.html 自己就是用这个工具进行处理的. ...

  9. MySQL数据库操作:“增删改查”,忘记密码重置等。

    [注] 数据库的“增删查改”,参考原作者Wid:http://www.cnblogs.com/mr-wid/archive/2013/05/09/3068229.html#d11.感谢大佬们的技术分享 ...

随机推荐

  1. Canal使用报错解决办法

    1. [destination = test_cancal , address = /127.0.0.1:3306 , EventParser] WARN c.a.o.s.a.i.setl.zooke ...

  2. LeetCode(100) Same Tree

    题目 Given two binary trees, write a function to check if they are equal or not. Two binary trees are ...

  3. 洛谷P4779 Dijkstra 模板

    这道题很久之前做过 今天复习(复读)一遍 有疑问的就是pair的专属头文件#include<utility> 但是据说iostream和vector等已经包含了这个 #include< ...

  4. Couchbase III(Python Library)

    Couchbase III(Python Library) 第一步 安装 使用pip安装: >pip install couchbase --quiet 确认是否安装成功: >python ...

  5. ssm依赖

    <project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/20 ...

  6. Pychorm提示Unresolved reference 导入模块报错

    最近使用Pychorm编写Python时,每次要引入自定义模块,就会报错,提示“Unresolved reference” Unresolved reference 'LoginClass' more ...

  7. 【转】关于大型网站技术演进的思考(二十)--网站静态化处理—web前端优化—中(12)

    Web前端很多优化原则都是从如何提升网络通讯效率的角度提出的,但是这些原则使用的时候还是有很多陷阱在里面,如果我们不能深入理解这些优化原则背后所隐藏的技术原理,很有可能掉进这些陷阱里,最终没有达到最佳 ...

  8. POJ 1386 单词接龙问题

    题目大意: 给一堆字母,让它们进行接龙,要头对尾能够接的上,问有没有一种方法让所有成语都完成接龙 这道题实际上是在考虑是否存在一条欧拉通路,每个单词产生一条有向线段,由第一个字母指向最后一个字母 这道 ...

  9. [luoguP1168]中位数(主席树+离散化)

    传送门 模板题一道,1A. ——代码 #include <cstdio> #include <algorithm> #define ls son[now][0], l, mid ...

  10. 积累js里有用的函数库

    一.兼容地获取非行间样式(兼容火狐,ie,chrome) function getStyle(obj,name) { if(obj.currentStyle){ return obj.currentS ...