-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathGSDBIndex.pas
143 lines (116 loc) · 3.6 KB
/
GSDBIndex.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
//-----------------------------------------------------------------------
// Summary
// TGlobe SpatialDatabase index base classes
//
// Description
// Provides a base class for spatial indexing.
//
// Author
// Graham Knight ([email protected])
//-----------------------------------------------------------------------
{$I GLOBE5.INC}
unit GSDBIndex;
interface
Uses Classes, GSDBCache, GSDBTables, GClasses, GSysUtils;
type
TGSpatialIndex = class( TGSDBObject )
public
function Count : Cardinal; virtual; abstract;
function IndexMER : TGMER; virtual; abstract;
procedure Insert( const mer : TGMER; objPK : TGPrimaryKey ); virtual; abstract;
procedure Delete( const mer : TGMER; objPK : TGPrimaryKey ); virtual; abstract;
procedure Search( const searchMER : TGMER; minSize: integer; resultList : TList ); overload; virtual; abstract;
procedure Search( const searchMER : TGMER; minSize: integer; callback : TGSearchCallback ); overload; virtual; abstract;
end;
TGMemoryIndexRec = record
MER : TGMER;
objPK : TGPrimaryKey;
end;
TGMemoryIndex = class( TGSpatialIndex )
private
FCount : integer;
FIndexArray : array of TGMemoryIndexRec;
protected
procedure InternalLoad( aStream : TMemoryStream ); override;
procedure InternalSave( aStream : TMemoryStream ); override;
public
function Count : Cardinal; override;
function IndexMER : TGMER; override;
procedure Clear; override;
procedure Insert( const mer : TGMER; objPK : TGPrimaryKey ); override;
procedure Delete( const mer : TGMER; objPK : TGPrimaryKey ); override;
procedure Search( const searchMER : TGMER; minSize: integer; resultList : TList ); override;
procedure Search( const searchMER : TGMER; minSize: integer; callback : TGSearchCallback ); override;
end;
implementation
function TGMemoryIndex.Count: Cardinal;
begin
Result := FCount;
end;
procedure TGMemoryIndex.Clear;
begin
FCount := 0;
SetLength( FIndexArray, 0 );
end;
procedure TGMemoryIndex.Delete(const mer: TGMER; objPK: TGPrimaryKey);
var
idx : integer;
begin
for idx := 0 to FCount - 1 do
if FIndexArray[idx].objPK = objPK then
begin
if ( FCount - idx ) > 1 then
Move( FIndexArray[idx + 1], FIndexArray[idx], SizeOf(TGMemoryIndexRec) * (FCount - idx - 1 ));
Dec( FCount );
Exit;
end;
end;
function TGMemoryIndex.IndexMER: TGMER;
var
idx : integer;
begin
MER_Empty( Result );
for idx := 0 to FCount - 1 do
Result := MER_Union(Result, FIndexArray[idx].MER);
end;
procedure TGMemoryIndex.Insert(const mer: TGMER; objPK: TGPrimaryKey);
begin
if FCount = Length( FIndexArray ) then
SetLength( FIndexArray, Length( FIndexArray ) + 256 );
FIndexArray[FCount].MER := mer;
FIndexArray[FCount].objPK := objPK;
Inc( FCount );
end;
procedure TGMemoryIndex.Search( const searchMER: TGMER; minSize: integer; resultList: TList);
var
idx : integer;
begin
resultList.Clear;
for idx := 0 to FCount - 1 do
if MER_Intersect( searchMER, FIndexArray[idx].MER ) then
resultList.Add( Pointer(FIndexArray[idx].objPK) );
end;
procedure TGMemoryIndex.InternalLoad(aStream: TMemoryStream);
begin
// Does nothing
end;
procedure TGMemoryIndex.InternalSave(aStream: TMemoryStream);
begin
// Does nothing
end;
procedure TGMemoryIndex.Search( const searchMER: TGMER; minSize: integer;
callback: TGSearchCallback);
var
idx : integer;
abort : Boolean;
begin
abort := false;
for idx := 0 to FCount - 1 do
if MER_Intersect( searchMER, FIndexArray[idx].MER ) then
begin
callback( FIndexArray[idx].objPK, abort );
if abort then
Exit;
end;
end;
end.