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,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,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+W,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,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 maxX > :X AND minY <= :Y AND maxY > :Y',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,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,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,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,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,y2)); FDQuery1.Next; end; end; procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y]); // FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE minX <= :X AND maxX > :X AND minY <= :Y AND maxY > :Y',Y]); FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE Id MATCH MyRTreeCallback(:X,:Y)',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,VBitmap); end; procedure TForm1.FormDestroy(Sender: TObject); begin VBitmap.Free; end;