ib_ezudfsu.pas

很管用的GIS控件

unit ib_ezudfsu;

interface

uses SysUtils, Classes;

function IB_ezsearch_init( var x1, y1, x2, y2: integer): integer; cdecl; export;
function IB_ezsearch_find( var procid, zone, pid: integer;
  leaf, entries: pChar; var fullentries: integer ): integer; cdecl; export;
function IB_ezsearch_first( var procid : integer ): integer; cdecl; export;
function IB_ezsearch_next( var procid : integer ): integer; cdecl; export;
function IB_ezsearch_finish( var procid: integer ): integer; cdecl; export;

implementation

uses
  math;

type

  TStackRecord = Record
    pid: integer;
    icount: integer;
  End;

  TSearcher = Class(TObject)
  Private
    { datos iniciales de busqueda }
    Fx1, Fy1, Fx2, Fy2: integer;
    { datos necesitados }
    Ficount: integer;
    { esto debe ser dimensionado a la profundidad del arbol
      es casi imposible que un arbol tenga una profundidad de 50 }
    Fstacktable: array[1..50] of TStackRecord;
    Fstackcount: integer;
    FResultList: TList;
  Public
    Constructor Create( x1, y1, x2, y2: integer );
    Destructor Destroy; Override;
    function ReEntry( zone, pid: Integer;
      leaf: boolean; const entries: string; fullentries: integer ): integer;
    function First: integer;
    function Next: integer;
  End;

Function Overlaps_rect( r1_x1, r1_y1, r1_x2, r1_y2, r2_x1, r2_y1, r2_x2, r2_y2: integer ): boolean;
Begin
  If math.max( r2_x1, r1_x1 ) > math.min( r2_x2, r1_x2 ) Then
  Begin
    result := false;
    exit;
  End;
  If math.max( r2_y1, r1_y1 ) > math.min( r2_y2, r1_y2 ) Then
  Begin
    result := false;
    exit;
  End;
  result := true;
End;

function IB_ezsearch_init( var x1, y1, x2, y2: integer): integer; cdecl; export;
var
  Searcher: TSearcher;
begin
  Searcher:= TSearcher.Create( x1, y1, x2, y2 );
  Result:= Longint( Searcher );
end;

function IB_ezsearch_find( var procid, zone, pid: integer;
  leaf, entries: pChar; var fullentries: integer ): integer; cdecl; export;
var
  aleaf,aentries: string;
  //s:string;
begin
  //s:=format('procid=%d,zone=%d,pid=%d,leaf=%s,entries=%s,fullentries=%d',
  //  [procid,zone,pid,string(leaf),string(entries),fullentries]);

  { falta convertir a string lo que se recibe }
  aleaf := String( leaf );
  if length(aleaf) > 1 then aleaf := copy(aleaf,1,1);
  aentries := String( entries );
  result:= TSearcher( procid ).ReEntry( zone, pid, aleaf='Y', aentries, fullentries );
end;

function IB_ezsearch_first( var procid : integer ): integer; cdecl; export;
begin
  result:= TSearcher( procid ).first;
end;

function IB_ezsearch_next( var procid : integer ): integer; cdecl; export;
begin
  result:= TSearcher( procid ).next;
end;

function IB_ezsearch_finish( var procid: integer ): integer; cdecl; export;
begin
  TSearcher( procid ).free;
  result:= 0;
end;

{ TEzSearcher }

Constructor TSearcher.Create( x1, y1, x2, y2: integer );
Begin
  Inherited Create;
  Fx1:= x1;
  Fy1:= y1;
  Fx2:= x2;
  Fy2:= y2;
  FResultList:= TList.create;
End;

Destructor TSearcher.Destroy;
begin
  FResultList.free;
  inherited;
end;

function TSearcher.ReEntry( zone, pid: Integer;
  leaf: boolean; const entries: string; fullentries: integer ): integer;
label
  page_loop, return_entry ;
Var
  rchild, rx1, ry1, rx2, ry2: integer;
begin

  if fullentries = 0 then
  begin
    result:= 0;
    exit;
  end;

  if zone = 1 then goto return_entry ;

  Ficount := 0 ;
page_loop:
  rx1:= StrToInt( TrimRight(copy(entries, Ficount*60+1,12)) );
  ry1:= StrToInt( TrimRight(copy(entries, Ficount*60+13,12)) );
  rx2:= StrToInt( TrimRight(copy(entries, Ficount*60+25,12)) );
  ry2:= StrToInt( TrimRight(copy(entries, Ficount*60+37,12)) );
  rchild:= StrToInt( TrimRight(copy(entries, Ficount*60+49,12)) );
  if leaf then
  begin
    if overlaps_rect (Fx1, Fy1, Fx2, Fy2, rx1, ry1, rx2, ry2 ) then
    begin
      { acumula a los encontrados }
      FResultList.Add( Pointer( rchild ) );
    end;
    Inc( Ficount );
    if (Ficount < fullentries) then
      goto page_loop ;
  end
  else
  begin
    if overlaps_rect (Fx1, Fy1, Fx2, Fy2, rx1, ry1, rx2, ry2 ) then
    begin
      Inc( Fstackcount ) ;
      Fstacktable[Fstackcount].pid := pid ;
      Fstacktable[Fstackcount].icount := Ficount ;
      Result := rchild ;  { +++ positivo indica que de aqui se llamo +++ }
      Exit;
    end
    else
    begin
return_entry:
      Inc( Ficount ) ;
      if (Ficount < fullentries) then
        goto page_loop ;
    end;
  end;
  if Fstackcount > 0 then
  begin
    Result := -Fstacktable[Fstackcount].pid;     { +++ negativo indica que se llamo de aqui +++}
    Ficount:= Fstacktable[Fstackcount].icount;
    Dec( Fstackcount ) ;
    Exit;
  end;
  { se acabo el proceso }
  Result:= 0;
end;

function TSearcher.First: integer;
begin
  if FResultList.Count = 0 then
  begin
    Result:= 0;
    exit;
  end;
  Ficount:= 0;
  Result:= Longint( FResultList[0] );
end;

function TSearcher.Next: integer;
begin
  Inc( Ficount );
  if Ficount > FResultList.Count-1 then
  begin
    Result:= 0;
    exit;
  end;
  Result:= Longint(FResultList[Ficount]);
end;

end.