FireDAC 下的 Sqlite [10]

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 maxX > :X AND minY <= :Y AND maxY > :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 maxX > :X AND minY <= :Y AND maxY > :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;

---