Delphi FireDAC 下的 Sqlite（十） 使用 R-Tree 搜尋

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;  tryfor i := 0to100dobegin  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;  exceptFDConnection1.Rollback;  end;  {呈現}  FDQuery1.Open('SELECT * FROM MyRTreeTable ORDER BY Id');  for i := 0to DBGrid1.Columns.Count - 1do 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;  whilenot FDQuery1.Eof do  beginx1 := 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 := 0to DBGrid1.Columns.Count - 1do 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;

測試效果圖: