maptips2.pas

校园GIS系统——介绍校园个部门

unit MapTips2;

interface

uses
 Windows, Classes, MapObjects2_TLB,ComObj,ExtCtrls,Stdctrls;

type
 TMapTips2 =class(TObject)
 private
  m_x : Integer;    // current x position
  m_y : Integer;     // current y position
  m_lastX :Integer;  // x position when timer starts
  m_lastY :Integer;  // y position when timer starts

  m_map :Tmap;
  m_timer :TTimer;
  m_edit :TEdit;

  m_layer : IMoMapLayer;  // layer to search
  m_field : string;   // field to get ToolTip text from
  m_recs  : IMoRecordset;

  procedure DoSearch;
  procedure showTipText(text :string);

 public
  constructor Create;
  procedure Initialize(map :TMap;tmr :TTimer;edit :Tedit);
  procedure MouseMove(x :Integer;y :Integer);
  procedure SetLayer(layer : IMoMapLayer;fld :string);
  procedure Timer;
 end;


 implementation

{*****************************************************************************}
 constructor TMapTips2.Create;
 begin
   inherited Create;
 end;


{*****************************************************************************}
 procedure TMapTips2.DoSearch;
 var
  pt : IMoPoint;
 begin
   pt := IMoPoint(CreateOleObject('MapObjects2.Point'));
   pt := m_map.ToMapPoint(m_x,m_y);
   if m_layer.ShapeType =23 then
    m_recs :=m_layer.SearchShape(pt,12,'')
   else
    m_recs :=m_layer.SearchByDistance(pt,m_map.ToMapDistance(10),'');
 end;


{*****************************************************************************}
 procedure TMapTips2.Initialize(map:TMap; tmr:TTimer; edit :Tedit);
 begin
   m_map :=map;
   m_timer :=tmr;
   m_edit :=edit;
   m_edit.visible :=false;
 end;


{*****************************************************************************}
 procedure TMapTips2.MouseMove(x :Integer;y :Integer);
 begin
  m_x :=x;
  m_y :=y;
  if m_timer.Interval =0 then //start the timer
   begin
    m_lastX :=x;
    m_lastY :=y;
    m_timer.Interval :=100;
   end
  else
   // hide the tooltip
   m_edit.visible :=false;
 end;


{*****************************************************************************}
 procedure TMapTips2.SetLayer(layer : IMoMapLayer;fld :string);
 begin
  m_layer :=layer;
  m_field :=fld;
 end;


{*****************************************************************************}
 procedure TMapTips2.ShowTipText(text :String);
 begin
  // set the caption
  m_edit.Text :=text;
  m_edit.visible :=true;
  m_edit.left :=m_map.left +m_x;
  m_edit.top :=m_map.top +m_y +20 ;
 end;


 {*****************************************************************************}
 procedure TMapTips2.Timer();
 var
    s : string;
    flds : IMoFields;
    fld  : IMoField;
 begin
 if (m_x=m_lastX) and (m_y=m_lastY) then
  begin
   // mouse didn't move
   m_timer.interval :=0;
   Dosearch;
   if m_recs.eof then
    //nothing at this location
    m_edit.visible :=False
   else
   begin
     //show the tool tip
    flds := m_recs.fields;
    fld := flds.item(m_field);
    s := fld.value;
    ShowTipText(s);
    //fld := UnAssigned;
    //flds := UnAssigned;
    end;
   end
   else
   begin
    m_lastX :=m_x;
    m_lastY :=m_y;
   end;
 end;

 end.