Включите в uses модуль maputil
18.02.2021 15:52:18
Включите в uses модуль maputil
|
|
|
|
18.02.2021 23:23:00
//========================================================== // Найти объекты пересечений //========================================================== procedure TfrmOvl.btnFindCrossObjClick(Sender: TObject); const NameFunc = 'cntOverlapTest'; Var Asinhro : boolean; res : integer; NameObject : string; ExCode : integer; parm1 : TPROCESSPARM; hsitenew : HSITE; hDll : HMODULE; pFunc : Dll_cntOverlapTest; retfunc : integer; SquareObject : double; begin // Здесь должен быть цикл по газонам frmOvl.MapFind1.Active := false; frmOvl.MapFind1.FindPoint := false; frmOvl.MapFind1.MapSelect.Clear; frmOvl.MapFind1.MapObj.Style := OS_SELECT; frmOvl.MapFind1.MapSelect.Excode[-1,OL_SQUARE] := false; frmOvl.MapFind1.MapSelect.Excode[10000040,OL_SQUARE] := true; frmOvl.MapFind1.Active := true; frmOvl.MapFind1.First; frmOvl.MapFind1.Center; frmOvl.MapFind2.Active := false; frmOvl.MapFind2.FindPoint := false; frmOvl.MapFind2.MapSelect.Clear; frmOvl.MapFind2.MapObj.Style := OS_SELECT; frmOvl.MapFind2.MapSelect.Excode[-1,OL_SQUARE] := false; frmOvl.MapFind2.MapSelect.Excode[10000165,OL_SQUARE] := true; frmOvl.MapFind2.Active := true; frmOvl.MapFind2.First; frmOvl.MapFind2.Center; If Asinhro = false then ShowMessage ('Найден объект на карте '+ frmOvl.MapFind2.MapObj.ObjName); SquareObject := 0; frmOvl.ovlObj.CreateOVL(1, 0.001, -1, 0); // Здесь все нормально If res = 0 then begin ShowMessage('Ошибка создания объекта оверлейных операций!'); // exit; end; res := frmOvl.ovlObj.SetObjectCross(-1, 0.001, 0, ovl_METHOD_SQUARE, ovl_OBJECTINSIDE); // Здесь все нормально, результат 3 case res of 1 : begin If mapGetExclusiveSubject(frmOvl.MapObj1.ObjHandle, 0) = 0 // шаблон не замкнут then ShowMessage('Все контура объекта совпадают с шаблоном (лежат на шаблоне)!'); If mapGetExclusiveSubject(frmOvl.MapObj1.ObjHandle, 0) <> 0 // шаблон замкнут then ShowMessage('Все контура объекта внутри шаблона, либо совпадают!'); end; 2 : ShowMessage('Все контура объекта вне шаблона!'); 3 : begin SquareObject := 0; If Asinhro = false then ShowMessage('Один или несколько контуров объекта пересекаются с шаблоном!'); // Здесь все нормально // создадим временную карту для размещения результата пересечения // можно создавать и постоянную hsitenew := mapCreateAndAppendTempSite(mvMap.MapHandle, nil); ShowMessage ('hsitenew = '+IntToStr(hsitenew)); // Здесь все нормально if (hsitenew = 0) then begin ShowMessage('Временная карта для размещения результата не создана!'); exit; end; fillchar(parm1, sizeof(TPROCESSPARM), 0); parm1.Map := mvMap.MapHandle; parm1.Site2 := hsitenew; ShowMessage ('parm1.Map = '+IntToStr(parm1.Map)); // Здесь все нормально ShowMessage ('parm1.Site2 = '+IntToStr(parm1.Site2)); // Здесь все нормально hDll := 0; pFunc := LoadFunction(sGISVECEX, NameFunc, hDll); ShowMessage ('hDll = '+IntToStr(hDll)); // Здесь все нормально if (hDll = 0) then exit; // try if (not Assigned (pFunc)) then begin ShowMessage ('not Assigned'); // exit; end; RetFunc := pFunc(MapObj2.ObjHandle, MapObj1.ObjHandle, 4, @parm1, 0); ShowMessage ('RetFunc = '+IntToStr(RetFunc)); // Здесь вернул 0!!!!! Не понятно почему? Не понятно, где здесь объект пересечения, по которому можно определить площадь пересечения? Похоже я не понимаю как работает RetFunc if (RetFunc = 0) then begin ShowMessage('Ошибка при создании пересечений!'); exit; end; mvMap.Repaint; // finally if (hDll <> 0) then mapFreeLibrary(hDll); // end; { While 1=1 do begin frmOvl.MapObj3.CreateObjectByKey(1, KM_IDDOUBLE2, frmOvl.MapObj2.KeyName); If frmOvl.ovlObj.GetNextObject = 0 then break; frmOvl.MapObj3.Commit; frmOvl.mvMap.Repaint; frmOvl.MapObj3.Style := OS_SELECT; If Asinhro = false then ShowMessage (frmOvl.MapFind2.MapObj.ObjName+' пересекает зону уборки площадь объекта уборки = '+FloatToStr(frmOvl.MapObj3.Square)); SquareObject := SquareObject+frmOvl.MapObj3.Square; If Asinhro = false then ShowMessage (frmOvl.MapFind2.MapObj.ObjName+' нарастающая площадь объекта уборки = '+FloatToStr(SquareObject)); frmOvl.MapObj3.Delete; end; frmOvl.ovlObj.FreeOVL; NameObject := frmOvl.MapFind2.MapObj.ObjName; ExCode := frmOvl.MapFind2.MapObj.ExCode; } frmOvl.ovlObj.FreeOVL; If Asinhro = false then ShowMessage ('вызываю функцию AppendSanitObjects'); end; 4 : begin SquareObject := frmOvl.MapFind2.MapObj.Square; If Asinhro = false then begin frmOvl.MapFind2.Center; ShowMessage('Контур шаблона внутри контура объекта!'); ShowMessage (frmOvl.MapFind2.MapObj.ObjName+' объект внутри зоны уборки = '+FloatToStr(SquareObject)); end; NameObject := frmOvl.MapFind2.MapObj.ObjName; ExCode := frmOvl.MapFind2.MapObj.ExCode; If Asinhro = false then ShowMessage ('вызываю функцию AppendSanitObjects'); end; 0 : begin ShowMessage('Ошибка установки обрабатываемого объекта и метода обработки!'); exit; end; end; |
|||
|
|
21.02.2021 23:21:11
const NameFunc = 'cntOverlapTest'; var parm1 : TPROCESSPARM; hsitenew : HSITE; hDll : HMODULE; pFunc : Dll_cntOverlapTest; retfunc : integer; begin // Здесь должен быть цикл по газонам frmOvl.MapFind1.Active := false; frmOvl.MapFind1.FindPoint := false; frmOvl.MapFind1.MapSelect.Clear; frmOvl.MapFind1.MapObj.Style := OS_SELECT; frmOvl.MapFind1.MapSelect.Excode[-1,OL_SQUARE] := false; frmOvl.MapFind1.MapSelect.Excode[10000040,OL_SQUARE] := true; frmOvl.MapFind1.Active := true; frmOvl.MapFind1.First; frmOvl.MapFind1.Center; ShowMessage ('найден газон на карте'); // Здесь должен быть цикл по зонам уборки муниципальной frmOvl.MapFind2.Active := false; frmOvl.MapFind2.FindPoint := false; frmOvl.MapFind2.MapSelect.Clear; frmOvl.MapFind2.MapObj.Style := OS_SELECT; frmOvl.MapFind2.MapSelect.Excode[-1,OL_SQUARE] := false; frmOvl.MapFind2.MapSelect.Excode[10000165,OL_SQUARE] := true; frmOvl.MapFind2.Active := true; frmOvl.MapFind2.First; frmOvl.MapFind2.Center; // ShowMessage ('найдена зона уборки на карте'); // If Asinhro = false then ShowMessage ('Найден объект на карте '+ frmOvl.MapFind2.MapObj.ObjName); // создадим временную карту для размещения результата пересечения // можно создавать и постоянную hsitenew := mapCreateAndAppendTempSite(mvMap.MapHandle, nil); if (hsitenew = 0) then begin ShowMessage('Временная карта для размещения результата не создана!'); exit; end; fillchar(parm1, sizeof(TPROCESSPARM), 0); parm1.Map := mvMap.MapHandle; parm1.Site2 := hsitenew; hDll := 0; pFunc := LoadFunction(sGISVECEX, NameFunc, hDll); ShowMessage ('hDll = '+IntToStr(hDll)); // Здесь возвращается число if (hDll = 0) then exit; try if (not Assigned (pFunc)) then exit; RetFunc := pFunc(MapObj2.ObjHandle, MapObj1.ObjHandle, 4, @parm1, 0); ShowMessage ('RetFunc = '+IntToStr(RetFunc)); // Здесь возвращается 0. Так же не должно быть? if (RetFunc = 0) then begin ShowMessage('Ошибка при создании пересечений!'); exit; end; mvMap.Repaint; finally if (hDll <> 0) then mapFreeLibrary(hDll); end; end; |
|||
|
|
24.02.2021 11:05:43
Свой пример и тексты компонентов выслал на почту.
|
|
|
|
24.02.2021 11:07:38
MapFind1.MapObj и MapFind2.MapObj - это разные компоненты?
|
||||
|
|
|||
© КБ Панорама, 1991-2024 Регистрируясь или авторизуясь на форуме, Вы соглашаетесь с Политикой конфиденциальности |