unit MyAuto;
interface
uses OleAuto,forms,windows,controls,messages,sysutils,classes;
type
TMyAuto = class(TAutoObject)
private
FMyProp: string;
function GetMyProp: string;
procedure SetMyProp(S: string);
public
constructor Create; override;
automated
procedure querytool(s:string); // 你自己定义的对象名
property MyProp: string read GetMyProp write SetMyProp;
end;
implementation
uses
Dialogs;
constructor TMyAuto.Create;
begin
inherited Create;
end;
procedure TMyAuto.SetMyProp(S: string);
begin
FMyProp := S;
end;
procedure TMyAuto.querytool(s:string);
begin
fgdmain.searchpoint(s); //Delphi程序中调用的函数名
end;
function TMyAuto.GetMyProp: string;
begin
Result := FMyProp;
end;
procedure RegisterMyAuto;
const
AutoClassInfo: TAutoClassInfo = (
AutoClass: TMyAuto;
ProgID: 'AUTOPROJ.MyAuto';
ClassID: '{FE67CF61-2EDD-11CF-B536-0080C72EFD43}';
Description: 'Sam';
Instancing: acInternal);
begin
Automation.RegisterClass(AutoClassInfo);
end;
initialization
RegisterMyAuto;
end.
{以下是在Delphi应用程序中调用,因程序太长,我就不全盘copy了}:
procedure Tform1.FormCreate(Sender: TObject);
var myauto1:tmyauto; mi,miresp:variant;
begin
mi:=createOleObject('mapinfo.application');
myauto1:=Tmyauto.create;
miresp:=myauto1.oleobject;
mi.do('set application window '+ intTostr(handle));
mi.setcallback (miresp); //在mbapplication中只有setcallback调用OLE对象
mi.do('Create Buttonpad "Callback" As Toolbutton ID 2001 Cursor 138 Calling OLE "QueryTool"'); //此处ID号你可任意指定。
end;
procedure Tfgdmain.searchPoint(s:string);//你自己定义的完成某种mapinfo 功能的函数,其中s 是你在图形上点击以后产生的包含x、y坐标信息的字符串。
var x,y,cmd : string;
i:integer;
mi_obj,mi_rid:string;
begin
delete(s,1,3);
i:=pos(',',s);
x:=copy(s,1,i-1);
delete(s,1,i);
i:=pos(',',s);
y:=copy(s,1,i-1);
cmd:='searchPoint( frontWindow() , ' + x + ' , ' +y+ ' )';
id:=mi.eval(cmd);
mi_obj:=mi.eval('searchinfo(1,1)');
if mi_obj='sctq_gx' then
begin
mi_rid:=mi.eval('searchinfo(1,2)');
mi.do('fetch rec '+mi_rid+' from '+mi_obj) ;
id:=mi.eval(mi_obj+'.col1');
popupmenu1.Popup(300,200);
end;
end;