程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi FireDAC 下的 Sqlite（十）使用 R-Tree 搜索

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

編輯：Delphi

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;