FireDAC 下的 Sqlite [10] - 使用 R-Tree 搜索
发布时间:2020-12-12 19:43:08 所属栏目:百科 来源:网络整理
导读:R-Tree 主要用于三维空间的搜索,据说这种搜索算法非常之快,哪怕百万条记录也是眨眼间的事! SQLite 支持 1-5 维,FireDAC 也提供了 TFDSQLiteRTree 控件以方便定义回调函数. 为了简单,我用二维表进行了成功的测试. 建立 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,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; (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |