unitcommonmodule.~pas

在delphi下基于MapX5.0的GIS程序

  LoadedMap := False;
// Get Application's FilePath
  ExeFilePath:=ExtractFilePath(Application.ExeName);
// Read IniFile
  ReadIniFile();
// 初始化Empty
  TVarData(Empty).vType := varError;
  TVarData(Empty).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
  TVarData(Nothing).VType := varDispatch;
// 图元字段的创建
  RowVal := CoRowValue.Create;
  RowVals := CoRowValues.Create;
// 注册
  RegMapX();
// 错误处理
  Application.OnException := FrmMain.AppException;
// 设置状态
  infFormViewType := SEARCH_FEATURE;
// 设置连接用户数量
  Users.Num := -1;
  With FrmMain do
  begin
  // Initial Map MapEagleEye
    Map1.GeoSet := '';
//    FrmEagleEye.MapEagleEye.GeoSet := '';
  // 设置圆的光滑度
    Map1.DefaultConversionResolution := 30;
  end;
  CreatCustomTool();
end;

// 系统运行结束设置
procedure ApplicationDestroy();
begin
//
end;

// 图层绑定及查找
procedure BindLayerToDataset();
var
  i: Integer;
begin
  with FrmMain do
  begin
    Map1.DataSets.RemoveAll;
    for i := 1 to Map1.Layers.Count do
    begin
      Map1.Datasets.Add(miDataSetLayer, Map1.Layers.Item[i], Map1.Layers.Item[i].Name, Empty, Empty, Empty, Empty, Empty);
      Map1.Layers.Item[i].Find.FindDataset := Map1.Datasets.Item[i];
      Map1.Layers.Item[i].Find.FindField := Map1.Datasets.Item[i].Fields.Item['ID'];
    end;
  end;
end;

// 更新图层的图元类型
procedure upDate_LayerToFtTypes();
var
  i: Integer;
  LayerName, TypeName, ToolName: String;
begin
// 初始化数组
  with FrmMain do
  begin
    OpenADOQueryAll(DM.ADOQueryLayerToTable, '图与表');
    for i := 1 to Map1.Layers.Count do
    begin
      LayerToFtTypeArr[i].TypeName := Map1.Layers[i].Name;
      LayerToFtTypeArr[i].TypeNum := 0;
      // Fill LayerToFtTypes
      DM.ADOQueryLayerToTable.First;
      while Not DM.ADOQueryLayerToTable.Eof do
      begin
         LayerName := DM.ADOQueryLayerToTable.FieldByName('MapLayer').AsString;
         TypeName  := DM.ADOQueryLayerToTable.FieldByName('Type').AsString;
         ToolName  := DM.ADOQueryLayerToTable.FieldByName('DrawTool').AsString;
         if LayerToFtTypeArr[i].TypeName = LayerName then
         begin
           Inc(LayerToFtTypeArr[i].TypeNum);
           LayerToFtTypeArr[i].FeatureTypeArr[LayerToFtTypeArr[i].TypeNum] := TypeName;
           LayerToFtTypeArr[i].FeatureToolArr[LayerToFtTypeArr[i].TypeNum] := ToolName;
         end;
         DM.ADOQueryLayerToTable.Next;
      end;
    end;
  end;
end;

// 创建自定义工具
procedure CreatCustomTool();
begin
  With FrmMain do
  begin
  // Creat Customtool
    Map1.CreateCustomTool(CUSTOM_SYMBOL_TOOL, miToolTypePoint, miSymbolCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_LINE_TOOL, miToolTypeLine, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_POLYLINE_TOOL, miToolTypePoly, miCrossCursor, miArrowCursor, miArrowCursor, empty);
  //  Map1.CreateCustomTool(CUSTOM_ARC_TOOL, miToolTypeLine, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_CIRCULARREGION_TOOL, miToolTypeCircle, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_ELLIPTICALREGION_TOOL, miToolTypeCircle, miCrossCursor, miArrowCursor, miArrowCursor, empty);
  //  Map1.CreateCustomTool(CUSTOM_MULTIPOINT_TOOL, miToolTypePoint, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_REGION_TOOL, miToolTypePolygon, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_TEXT_TOOL, miToolTypePoint, miTextCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_INFO_TOOL, miToolTypePoint, miCrossCursor, miArrowCursor, miArrowCursor, empty);
  //  Map1.CreateCustomTool(CUSTOM_ERASE_TOOL, miToolTypePoint, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_RECTANGLE_TOOL, miToolTypeMarquee, miRectSelectCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_LABEL_TOOL, miToolTypePoint, miCrossCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_ZOOMIN_TOOL, miToolTypeMarquee, miZoomInCursor, miArrowCursor, miArrowCursor, empty);
    Map1.CreateCustomTool(CUSTOM_ZOOMOUT_TOOL, miToolTypeMarquee, miZoomOutCursor, miArrowCursor, miArrowCursor, empty);
  end;
end;

//  设置菜单的选中和按钮的按下
procedure Set_MenuCheck_BtnDown(Var NTool: TMenuItem;  TBtnTool: TToolButton);
var
  j, i: Integer;
begin
  with FrmMain do
  begin
    for j := 0 to 2 do
    for i := 0 to NMapTool.Items[j].Count-1 do
    if NMapTool.Items[j].Items[i].Tag <> 0 then
       NMapTool.Items[j].Items[i].Checked := False;

//    for i := 0 to 3 do FrmMain.MainMenu1.Items[i].Checked := False;

    for i :=0 to ToolBarMapViewTool.ButtonCount-1 do
    if ToolBarMapViewTool.Buttons[i].Tag <> 0 then
      ToolBarMapViewTool.Buttons[i].Down := False;

    for i := 0 to ToolBarDrawMapTool.ButtonCount-1 do
    if ToolBarDrawMapTool.Buttons[i].Tag <> 0 then
      ToolBarDrawMapTool.Buttons[i].Down := False;
  end;
  with FrmMain do
  begin
  // 处理右键按钮
    if NTool.Caption = '漫游' then PNmiPanTool.Checked := True else
    if NTool.Caption = '放大' then PNCUSTOM_ZOOMIN_TOOL.Checked := True else
    if NTool.Caption = '缩小' then PNCUSTOM_ZOOMOUT_TOOL.Checked := True else
    if NTool.Caption = '居中' then PNmiCenterTool.Checked := True;
  end;
  NTool.Checked := True;
  TBtnTool.Down := True;
end;

// 屏蔽菜单和工具
procedure LockMenuTButton();
var
  k: Integer;
begin
  With FrmMain do
  begin
    // LockMenu
    for k := 0 to NMapControl.Items[2].Count-1 do
    if NMapControl.Items[2].Items[k].Tag <> 0 then
       NMapControl.Items[2].Items[k].Enabled := False;
    // LockButton
    for k := 6 to 12 do
    if (ToolBarDrawMapTool.Buttons[k].Tag <> 0) then
       ToolBarDrawMapTool.Buttons[k].Enabled := False;
  end;
end;

// 地图显示变化处理
procedure SetMapViewChanged();
var
  tempFea: MapXLib_TLB.Feature; //声明Feature变量
  tempStyle: MapXLib_TLB.Style; //声明Style变量
begin
  With FrmMain do
  begin
  //  地图的前视处理
    PrevMapZoom := CurMapZoom;
    PrevMapZoomPosX := CurMapZoomPosX;
    PrevMapZoomPosY := CurMapZoomPosY;
    CurMapZoom := Map1.Zoom;
    CurMapZoomPosX := Map1.CenterX;
    CurMapZoomPosY := Map1.CenterY;

  //  鹰眼处理
    if  Have_EagleEye then
    begin
      if EagleEye_Layer.AllFeatures.Count=0 then
      begin
      //  设置矩形边框样式
        tempStyle := MapXLib_TLB.CoStyle.Create;
        tempStyle.RegionPattern := miPatternNoFill; //设置Style的矩形内部填充样式
        tempStyle.RegionBorderColor := RGB(255, 0, 0); //设置Style的矩形边框颜色
        tempStyle.RegionBorderWidth := 2; //设置Style的矩形边框宽度
      //在图层创建大小为Map1的边界的Rectangle对象
        tempFea := FrmEagleEye.MapEagleEye.FeatureFactory.CreateRegion(Map1.Bounds, tempStyle);
        EagleEye_Fea := EagleEye_Layer.AddFeature(tempFea, Empty); //添加矩形边框
      end
      else begin  //否则，根据Map1的视野变化改变矩形边框的大小和位置
             EagleEye_Fea.Parts.Item[1].RemoveAll; //除去已有的矩形边框的顶点
             //添加大小和位置已变化的矩形边框的四个顶点
             EagleEye_Fea.Parts.Item[1].AddXY(Map1.Bounds.XMin, Map1.Bounds.YMin, 1);
             EagleEye_Fea.Parts.Item[1].AddXY(Map1.Bounds.XMax, Map1.Bounds.YMin, 1);
             EagleEye_Fea.Parts.Item[1].AddXY(Map1.Bounds.XMax, Map1.Bounds.YMax, 1);
             EagleEye_Fea.Parts.Item[1].AddXY(Map1.Bounds.XMin, Map1.Bounds.YMax, 1);
           end;
      EagleEye_Fea.Update(EagleEye_Fea, empty);
    end;
  end;
end;

//  设置标注文字的属性
procedure SetLabelStyle(TypeName: String);
begin
  if Not DM.ADOQueryTextStyle.Active then DM.ADOQueryTextStyle.Open;
  if DM.ADOQueryTextStyle.Locate('Type', TypeName, [loCaseInsensitive]) then
  begin
    with FrmMain do
    begin
      SetStyle := Map1.DefaultStyle.TextFont;
      SetStyle.Name := DM.ADOQueryTextStyleName.Value;
      SetStyle.Size := DM.ADOQueryTextStyleSizes.Value;
      Map1.DefaultStyle.TextFontColor := StringToColor(DM.ADOQueryTextStyleColor.Value);
      Map1.DefaultStyle.TextFontRotation := DM.ADOQueryTextStyleRotation.Value;
      Map1.DefaultStyle.TextFontHalo := DM.ADOQueryTextStyleHalo.Value;
      Map1.DefaultStyle.TextFontOpaque := DM.ADOQueryTextStyleBox.Value;
      Map1.DefaultStyle.TextFontBackColor := StringToColor(DM.ADOQueryTextStyleBackColor.Value);
    end;
  end;
end;

//  设置符号的属性
procedure SetSymbolStyle(TypeName : String);
begin
  if Not DM.ADOQuerySymbolStyle.Active then DM.ADOQuerySymbolStyle.Open;
  if DM.ADOQuerySymbolStyle.Locate('Type', TypeName, [loCaseInsensitive]) then
  begin
    with FrmMain do
    begin
      SetStyle := Map1.DefaultStyle;
      SetStyle.SymbolType:= Map1.DefaultStyle.SymbolType;
      SetStyle.SymbolFont.Name := DM.ADOQuerySymbolStyleName.Value;
      SetStyle.SymbolFont.Size := DM.ADOQuerySymbolStyleSizes.Value;
      Map1.DefaultStyle.SymbolCharacter := DM.ADOQuerySymbolStyleCharacters.Value;
      Map1.DefaultStyle.SymbolFontColor := StringToColor(DM.ADOQuerySymbolStyleColor.Value);
      Map1.DefaultStyle.SymbolFontHalo := DM.ADOQuerySymbolStyleHalo.Value;
      Map1.DefaultStyle.SymbolFontOpaque := DM.ADOQuerySymbolStyleBox.Value;
      Map1.DefaultStyle.SymbolFontBackColor := StringToColor(DM.ADOQuerySymbolStyleBackColor.Value);
    end;
  end;
end;

//  设置线的属性
procedure SetLineStyle(TypeName : String);
begin
  if Not DM.ADOQueryLineStyle.Active then DM.ADOQueryLineStyle.Open;
  if DM.ADOQueryLineStyle.Locate('Type', TypeName, [loCaseInsensitive]) then
  begin
    with FrmMain do
    begin
      Map1.DefaultStyle.LineStyle := DM.ADOQueryLineStyleStyle.Value;
      Map1.DefaultStyle.LineColor := StringToColor(DM.ADOQueryLineStyleColor.Value);
      Map1.DefaultStyle.LineWidthUnit := DM.ADOQueryLineStyleLineWidthUnit.Value;
      Map1.DefaultStyle.LineWidth := DM.ADOQueryLineStyleWidth.Value;
      Map1.DefaultStyle.LineInterleaved := DM.ADOQueryLineStyleInterleaved.Value;
    end;
  end;
end;

//  设置区域的属性
procedure SetRegionStyle(TypeName : String);
begin
  if Not DM.ADOQueryRegionStyle.Active then DM.ADOQueryRegionStyle.Open;
  if DM.ADOQueryRegionStyle.Locate('Type', TypeName, [loCaseInsensitive]) then
  begin
    with FrmMain do
    begin
      Map1.DefaultStyle.RegionPattern := DM.ADOQueryRegionStylePattern.Value;
      Map1.DefaultStyle.RegionColor := StringToColor(DM.ADOQueryRegionStyleColor.Value);
      Map1.DefaultStyle.RegionTransparent := DM.ADOQueryRegionStyleTransparent.Value;
      Map1.DefaultStyle.RegionBackColor := StringToColor(DM.ADOQueryRegionStyleBackColor.Value);
      Map1.DefaultStyle.RegionBorderStyle := DM.ADOQueryRegionStyleBorderStyle.Value;
      Map1.DefaultStyle.RegionBorderColor := StringToColor(DM.ADOQueryRegionStyleBorderColor.Value);
      Map1.DefaultStyle.RegionBorderWidthUnit := DM.ADOQueryRegionStyleBorderWidthUnit.Value;
      Map1.DefaultStyle.RegionBorderWidth := DM.ADOQueryRegionStyleBorderWidth.Value;
    end;
  end;
end;

// 打开数据库以省缺的 SELECT * 打开
procedure OpenADOQueryAll(Query : TADOQuery; TableName: String);
begin
  Query.Close;
  Query.SQL.Clear;
  SQLString := 'SELECT *' + #13;
  SQLString := SQLString + 'FROM ' + TableName;
  Query.SQL.Add(SQLString);
  Query.Open;
end;

// 打开数据库以加WHERE的形式打开
procedure OpenADOQueryAllL(Query:TADOQuery; TableName, LikeName: String);
begin
  Query.Close;
  Query.SQL.Clear;
  SQLString := 'SELECT *' + #13;
  SQLString := SQLString + 'FROM ' + TableName+ #13;
  SQLString := SQLString + 'WHERE Name Like ''%' + LikeName + '%''';
  Query.SQL.Add(SQLString);
  Query.Open;
end;

// 添加图元的标注 ID
procedure AddFeatureLabelID(IniPoint: MapXLib_TLB.Point; IniText: String);
var
  i: Integer;
begin
  Ftrs := FrmMain.Map1.Layers['标记'].SearchAtPoint(IniPoint, 0);
  if Ftrs.Count = 1 Then
  begin
    infoFeature := Ftrs.Item[1];
    LabelStr := IniText;
    for i := 1 to ChineseNum(IniText) do
      LabelStr := LabelStr + ' ';
    infoFeature.Caption := LabelStr;
    infoFeature.KeyValue := PYConvert(IniText);
    infoFeature.Update(Empty, Empty);
  end;
end;

// 在对应的图层中得到一个合法的随机名称
function SetRandomNameValue(Layer: MapXLib_TLB.Layer; FeatureType: String): String;
var
  Num: Integer;
begin
  OpenADOQueryAll(DM.ADOQueryText, '标记');
  Num := 0;
  repeat
    Inc(Num);
  until Not DM.ADOQueryText.Locate('ID', PYConvert(FeatureType + IntToStr(Num)), [loCaseInsensitive]);
  Result := FeatureType + IntToStr(Num);
end;

// 处理图元字段的初始化值
procedure SetFeatureRowValue(LayerName, FieldValue : String);
begin
  with FrmMain do
  begin
    RowVals.RemoveAll;
    RowVal.Dataset := Map1.DataSets[LayerName];
    RowVal.Field := Map1.DataSets[LayerName].Fields['Name'];
    if LayerName = '标记' then RowVal.Value := FieldValue
       else RowVal.Value := '';
    RowVals.Add(RowVal);
    RowVal.Dataset := Map1.DataSets[LayerName];
    RowVal.Field := Map1.DataSets[LayerName].Fields['ID'];
    RowVal.Value := PYConvert(FieldValue);
    RowVals.Add(RowVal);
  end;
end;

// 窗体上控件建立锁定
procedure LockEdit(Frm: TForm);
var
  i: Integer;
begin
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].ClassName = 'TLabeledEdit' then
      TLabeledEdit(Frm.Components[i]).ReadOnly := True else
    if Frm.Components[i].ClassName = 'TComboBox' then
      TComboBox(Frm.Components[i]).Enabled := False else
    if Frm.Components[i].ClassName = 'TMemo' then
      TMemo(Frm.Components[i]).ReadOnly := True else
    if Frm.Components[i].ClassName = 'TMaskEdit' then
      TMaskEdit(Frm.Components[i]).ReadOnly := True else
    if Frm.Components[i].ClassName = 'TSpinEdit' then
      TSpinEdit(Frm.Components[i]).ReadOnly := True else
    if Frm.Components[i].ClassName = 'TEdit' then
      TEdit(Frm.Components[i]).ReadOnly := True else
    if Frm.Components[i].ClassName = 'TCheckBox' then
      TCheckBox(Frm.Components[i]).Enabled := False;
  end;
end;

// 窗体上控件解除锁定
procedure UnLockEdit(Frm: TForm);
var
  i: Integer;
begin
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].ClassName = 'TLabeledEdit' then
      TLabeledEdit(Frm.Components[i]).ReadOnly := False else
    if Frm.Components[i].ClassName = 'TMemo' then
      TMemo(Frm.Components[i]).ReadOnly := False else
    if Frm.Components[i].ClassName = 'TMaskEdit' then
      TMaskEdit(Frm.Components[i]).ReadOnly := False else
    if Frm.Components[i].ClassName = 'TSpinEdit' then
      TSpinEdit(Frm.Components[i]).ReadOnly := False else
    if Frm.Components[i].ClassName = 'TEdit' then
      TEdit(Frm.Components[i]).ReadOnly := False else
    if Frm.Components[i].ClassName = 'TCheckBox' then
      TCheckBox(Frm.Components[i]).Enabled := True;
  end;
end;

// 窗体上控件Text类清空
procedure ClearEdit(Frm: TForm);
var
  i: Integer;
begin
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].ClassName = 'TEdit' then
    begin
      TEdit(Frm.Components[i]).Text := '';
    end;
    if Frm.Components[i].ClassName = 'TLabeledEdit' then
    begin
      TLabeledEdit(Frm.Components[i]).Text := '';
    end;
    if Frm.Components[i].ClassName = 'TMaskEdit' then
    begin
      TMaskEdit(Frm.Components[i]).Text := '';
    end;
    if Frm.Components[i].ClassName = 'TMemo' then
    begin
      TMemo(Frm.Components[i]).Text := '';
    end;
  end;
end;

// 窗体上控件Text类获得焦点的处理
procedure EnterEdit(Frm: TForm);
var
  i: Integer;
begin
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].ClassName = 'TEdit' then