程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> FireDAC 下的 Sqlite [10]

FireDAC 下的 Sqlite [10]

編輯：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 事件.

可把下面代碼直接貼在空白窗體上, 以快速完成窗體設計:

代碼:

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]);
  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;