R-Tree 主要用于三维空间的搜索, 据说这种搜索算法非常之快, 哪怕百万条记录也是眨眼间的事!

SQLite 支持 1-5 维, FireDAC 也提供了 TFDSQLiteRTree 控件以方便定义回调函数. 为了简单, 我用二维表进行了成功的测试.

建立 R-Tree 表(索引)时需要使用特定语法, 譬如:

FDConnection1.ExecSQL('CREATE VIRTUAL TABLE MyRTreeTable USING rtree(Id, minX, maxX, minY, maxY)');
//必须是 VIRTUAL 表
//USING rtree, 是必须的; 也可以是 USING rtree_i32
//Id, minX, maxX, minY, maxY; 这是 ID 与二维空间的数据, 这里无需指定参数类型; 因为参数类型是内定的: Id 是 64 位无符号整形(且是主键), 后面的数据是 32 位浮点
//如果使用 rtree_i32 定义, 后面的数据则都是 32 为整形; 另外如果指定了 SQLITE_RTREE_INT_ONLY 参数, 无论怎么定义, 内部都用整形计算.

为此我做了两个例子, 第一个例子先没有使用 TFDSQLiteRTree(也就是没用回调).

本例除了使用 TFDConnection, TFDPhysSQLiteDriverLink, TFDGUIxWaitCursor, TDataSource, TDBGrid 外, 还有一个 TPaintBox, 用于绘图和点击测试, 用到它的 OnPaint 和 OnMouseUp 事件.

可把下面代码直接贴在空白窗体上, 以快速完成窗体设计:

object PaintBox1: TPaintBox
Left = 408
Top = 16
Width = 617
Height = 473
OnMouseUp = PaintBox1MouseUp
OnPaint = PaintBox1Paint
end
object DBGrid1: TDBGrid
Left = 0
Top = 0
Width = 393
Height = 503
Align = alLeft
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object FDConnection1: TFDConnection
Left = 34
Top = 24
end
object FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink
Left = 143
Top = 24
end
object FDGUIxWaitCursor1: TFDGUIxWaitCursor
Provider = 'Forms'
Left = 260
Top = 24
end
object FDQuery1: TFDQuery
Connection = FDConnection1
Left = 32
Top = 88
end
object DataSource1: TDataSource
DataSet = FDQuery1
Left = 132
Top = 88
end
object FDSQLiteRTree1: TFDSQLiteRTree
DriverLink = FDPhysSQLiteDriverLink1
Left = 256
Top = 96
end


代码:

var VBitmap: TBitmap; //当做内存画布

procedure TForm1.FormCreate(Sender: TObject);
const
W = 50; H = 30;
var
i,x,y,x1,x2,y1,y2: Integer;
begin
FDConnection1.Params.Add('DriverID=SQLite');
FDConnection1.ExecSQL('CREATE VIRTUAL TABLE MyRTreeTable USING rtree(Id, minX, maxX, minY, maxY)'); //建表
FDConnection1.Connected := True; {为数据库添加模拟数据}
FDConnection1.StartTransaction;
try
for i := 0 to 100 do
begin
x := Random(PaintBox1.Width);
y := Random(PaintBox1.Height);
FDConnection1.ExecSQL('INSERT INTO MyRTreeTable VALUES(:id, :x1, :x2, :y1, :y2)', [i, x, x+W, y, y+H]);
end;
FDConnection1.Commit;
except
FDConnection1.Rollback;
end; {呈现}
FDQuery1.Open('SELECT * FROM MyRTreeTable ORDER BY Id');
for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66; //默认的网格列太宽了, 处理一下 {根据刚刚添加的数据绘制一张内存图片}
VBitmap := TBitmap.Create;
VBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
VBitmap.Canvas.Brush.Color := clWhite;
VBitmap.Canvas.FillRect(Rect(0, 0, VBitmap.Width, VBitmap.Height)); FDQuery1.First;
while not FDQuery1.Eof do
begin
x1 := FDQuery1.Fields[1].AsInteger;
x2 := FDQuery1.Fields[2].AsInteger;
y1 := FDQuery1.Fields[3].AsInteger;
y2 := FDQuery1.Fields[4].AsInteger;
VBitmap.Canvas.Brush.Color := Random($EEEEEE);
VBitmap.Canvas.FillRect(Rect(x1, y1, x2, y2));
FDQuery1.Next;
end;
end; {在 OnMouseUp 事件中执行了 R-Tree 搜索}
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
Caption := Format('%d, %d', [X, Y]);
FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE minX :X AND minY :Y', [X,Y]); //[X,X,Y,Y] ?
for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66; //这行只为缩小列宽
end; {呈现前面绘制的内存图片}
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0, 0, VBitmap);
end; procedure TForm1.FormDestroy(Sender: TObject);
begin
VBitmap.Free;
end;

测试效果图:


第二个例子效果同上, 但使用了 TFDSQLiteRTree, 它除了设定几个参数外, 主要是使用其 OnCalculate, 该事件对应 SQLite 内部的相关回调函数.


var VBitmap: TBitmap;

{这是 FDSQLiteRTree1 的 OnCalculate 事件}
procedure TForm1.FDSQLiteRTree1Calculate(ARTree: TSQLiteRTreeData; const AParams, AColumns: TSQLiteRTreeDoubleArray; var AResult: Boolean);
begin
AResult := PtInRect( //换成了 WinAPI.PtInRect
Rect(Trunc(AColumns[0]), Trunc(AColumns[2]), Trunc(AColumns[1]), Trunc(AColumns[3])), //是出 Id 外的空间的数据
Point(Trunc(AParams[0]), Trunc(AParams[1])) //AParams 是 MyRTreeCallback 函数的参数
);
end; procedure TForm1.FormCreate(Sender: TObject);
const
W = 50; H = 30;
var
i,x,y,x1,x2,y1,y2: Integer;
begin
{添加了下面四行来设定 FDSQLiteRTree1 的参数, 这些参数一般可以在设计时指定}
FDSQLiteRTree1.DriverLink := FDPhysSQLiteDriverLink1;
FDSQLiteRTree1.RTreeName := 'MyRTreeCallback'; //这是后面 SQL 语句中使用的函数名
// FDSQLiteRTree1.OnCalculate := FDSQLiteRTree1Calculate; //事件已在设计时指定
FDSQLiteRTree1.Active := True; FDConnection1.Params.Add('DriverID=SQLite');
FDConnection1.ExecSQL('CREATE VIRTUAL TABLE MyRTreeTable USING rtree(Id, minX, maxX, minY, maxY)'); //这行有改变
FDConnection1.Connected := True; FDConnection1.StartTransaction;
try
for i := 0 to 100 do
begin
x := Random(PaintBox1.Width);
y := Random(PaintBox1.Height);
FDConnection1.ExecSQL('INSERT INTO MyRTreeTable VALUES(:id, :x1, :x2, :y1, :y2)', [i, x, x+W, y, y+H]);
end;
FDConnection1.Commit;
except
FDConnection1.Rollback;
end; FDQuery1.Open('SELECT * FROM MyRTreeTable ORDER BY Id');
for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66; VBitmap := TBitmap.Create;
VBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
VBitmap.Canvas.Brush.Color := clWhite;
VBitmap.Canvas.FillRect(Rect(0, 0, VBitmap.Width, VBitmap.Height)); FDQuery1.First;
while not FDQuery1.Eof do
begin
x1 := FDQuery1.Fields[1].AsInteger;
x2 := FDQuery1.Fields[2].AsInteger;
y1 := FDQuery1.Fields[3].AsInteger;
y2 := FDQuery1.Fields[4].AsInteger;
VBitmap.Canvas.Brush.Color := Random($EEEEEE);
VBitmap.Canvas.FillRect(Rect(x1, y1, x2, y2));
FDQuery1.Next;
end;
end; procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: Integer;
begin
Caption := Format('%d, %d', [X, Y]);
// FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE minX :X AND minY :Y', [X,Y]);
FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE Id MATCH MyRTreeCallback(:X, :Y)', [X,Y]); // MyRTreeCallback 是通过 FDSQLiteRTree1.RTreeName 指定的
for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66;
end; procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0, 0, VBitmap);
end; procedure TForm1.FormDestroy(Sender: TObject);
begin
VBitmap.Free;
end;

FireDAC 下的 Sqlite [10] - 使用 R-Tree 搜索的更多相关文章

  1. FireDAC 下的 Sqlite [3] - 获取数据库的基本信息

    在空白窗体上添加: TFDConnection, TFDPhysSQLiteDriverLink, TFDGUIxWaitCursor, TMemo procedure TForm1.FormCrea ...

  2. FireDAC 下的 Sqlite [6] - 加密

    主要就是设置 TFDConnection 的两个链接参数: Password, NewPassword, 非常简单. const dbPath = 'C:\Temp\SQLiteTest.sdb'; ...

  3. FireDAC 下的 Sqlite [9] - 关于排序

    SQLite 内部是按二进制排序, 可以支持 ANSI; FrieDAC 通过 TFDSQLiteCollation 支持了 Unicode 排序, 并可通过其 OnCompare 事件自定义排序. ...

  4. FireDAC 下的 Sqlite [8] - 自定义函数

    Sqlite 本身没有这个功能, FireDAC 通过 TFDSQLiteFunction 增加了该功能; 尽管通过某些 SQL 语句或通过视图也可以达到类似效果, 但函数会更灵活些. 本例先建了一个 ...

  5. FireDAC 下的 Sqlite [4] - 创建数据库

    建立数据库的代码: {建立内存数据库的一般代码:} begin FDConnection1.DriverName := 'SQLite'; //同 FDConnection1.Params.Add(' ...

  6. FireDAC 下的 Sqlite [11] - 关于批量提交 SQL 命令的测试

    可把下面代码直接贴在空白窗体上, 以快速完成窗体设计: object DBGrid1: TDBGrid Left = 0 Top = 0 Width = 265 Height = 338 Align ...

  7. FireDAC 下的 Sqlite [2] - 第一个例子

    为了方便测试, 我把官方提供的 C:\Users\Public\Documents\Embarcadero\Studio\14.0\Samples\data\FDDemo.sdb 复制了一份到 C:\ ...

  8. FireDAC 下的 Sqlite [1] - 前言

    很长时间没静下心来写博客了, 现在回来, 是 Delphi 不断地进步让我感动.振奋. Delphi XE5 并入了 FireDAC, 第一印象非常好, 恐怕 dbExpress 等等都要靠边站了. ...

  9. FireDAC 下的 Sqlite [5] - 数据的插入、更新、删除

    先在空白窗体上添加: TFDConnection.TFDPhysSQLiteDriverLink.TFDGUIxWaitCursor.TFDQuery.TDataSource.TDBGrid(并在设计 ...

随机推荐

  1. JavaScript 删除 ASP.NET 设置的多值 Cookie 的方法

    需要注意HttpOnly,Path等属性.完整的测试代码: ASPX 代码<%@ Page Language="C#" %> <!DOCTYPE html PUB ...

  2. Linux 网络操作

    Linux 基础网路操作  ifconfig eth0 down # 禁用网卡 ifconfig eth0 up # 启用网卡 ifup eth0: # 启用网卡 mii-tool em1 # 查看网 ...

  3. vue路由DEMO

    index.js,index.vue,course.vue,master.vue等 import Vue from 'vue' import Router from 'vue-router' impo ...

  4. CSS3设置内容超过一定长度后自动折行

    在用编辑器保存的数据到数据库的时候经常是在我们的内容前后加一个P标签,但是出来之后是一行,有时候会超过边框的宽度,所以研究了如何折行,如下代码: <!DOCTYPE html> <h ...

  5. 在Docker中运行EOS(MAC版)

    在Docker中运行EOS(MAC版) 在Docker中也可以简单快速的构建EOS.IO.笔者在Mac平台下参考官方文档躺了一次河.记录如下: 安装依赖 Docker 版本 17.05或者更高 tes ...

  6. dataframe 差集

    >>>data_a={'state':[1,1,2],'pop':['a','b','c']}>>>data_b={'state':[1,2,3],'pop':[' ...

  7. Linux入门——文件系统目录结构

    不同操作系统对于文件系统的组织是不一样的,当前主流的两大类操作系统windows和Linux它们在文件系统组织方式上有很大差别.windows的文件系统是以驱动器盘符为基础,这样文件是挂载在分区上的, ...

  8. redis配置文件redis.conf翻译、解释以及常用注意事项(持续更新中...)

    # Redis configuration file example. #Redis 配置文件的示例 #如何利用配置文件启动Redis # Note that in order to read the ...

  9. 全键盘操作Windows

    计算机机用户在使用计算机的时候,是用键盘多一点?还是用鼠标多一点?如果是专业打字员,应该会说他使用键盘多一点,除此之外,多数人都会告诉你,他已经离不开鼠标了,没有鼠标,就不会操作电脑.   如果某一天 ...

  10. Hanoi Factorys

    题面 思路 这道题看似难的一匹,实际上也难的一批还好,甚至n^2 DP都有50分呢. 原谅我一失手成千古恨. 50分思路 就是sort后根据条件DP if (LIS[i].b>LIS[j].a) ...