unitcommonmodule.~pas

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

    begin
      //EditOnEnter(Frm.Components[i]);
    end;
    if Frm.Components[i].ClassName = 'TLabeledEdit' then
    begin
      TLabeledEdit(Frm.Components[i]).Color := clCream;
    end;
    if Frm.Components[i].ClassName = 'TMaskEdit' then
    begin
      TMaskEdit(Frm.Components[i]).Color := clCream;
    end;
    if Frm.Components[i].ClassName = 'TMemo' then
    begin
      TMemo(Frm.Components[i]).Color := clCream;
    end;
  end;
end;

// 处理标记的Text：加空格字符
procedure SetLabelStr(InfoText: String);
var
  i: Integer;
begin
  LabelStr := InfoText;
  for i := 1 to ChineseNum(InfoText) do
    LabelStr := LabelStr + ' ';
end;

// 处理选择图元及对应的标注属性
procedure SetFeatureAndLabel(IniEditName, EditName: String);
begin
// 更改编辑图层图元信息
  EditLayer.KeyField := 'ID';
  infoFeature.KeyValue := PYConvert(EditName);
  infoFeature.Update(Empty, Empty);
// 需要处理标注改标注内容
  With FrmMain do
  begin
    // 设置字体角度
    Map1.DefaultStyle.TextFontRotation := DM.ADOQueryTextRotation.Value;
    // 处理标记的Text：加空格字符
    SetLabelStr(Editname);
    // 处理图元字段的初始化值
    SetFeatureRowValue('标记', EditName);
    // 查询看看有没有以前的标记，有就删除
    FoundObj := Map1.Layers['标记'].Find.Search(PYConvert(IniEditName), '');
    if (FoundObj.Findrc Mod 10 = 1) then
    begin
      newObj := Map1.FeatureFactory.CreateText(FoundObj.Point, LabelStr, miPositionBR, Map1.Defaultstyle);
      Map1.Layers['标记'].DeleteFeature(FoundObj);
      Map1.Layers['标记'].AddFeature(newObj, RowVals);
    end
    else // 处理没有显示标记的图元情况
      if infFormViewType = NEW_FEATURE then
      begin
        Pt := CreateOleObject('MapX.Point.5');
        Pt.Set(infoFeature.CenterX, infoFeature.CenterY);
        newObj := Map1.FeatureFactory.CreateText(Pt, LabelStr, miPositionBR, Map1.Defaultstyle);
        Map1.Layers['标记'].AddFeature(newObj, RowVals);
        VarClear(Pt);
      end;
  end;
end;

// 得到标记对应的图元的图层名
function TypeToLayer(TypeValue: String): String;
var
  i, j: Integer;
begin
  for j := 1 to FrmMain.Map1.Layers.Count do
  for i := 1 to LayerToFtTypeArr[j].TypeNum do
  if TypeValue = LayerToFtTypeArr[j].FeatureTypeArr[i] then
  begin
    Result := LayerToFtTypeArr[j].TypeName;
    Break;
  end;
//  if Not DM.ADOQueryLayerToTable.Active then DM.ADOQueryLayerToTable.Open;
//  if DM.ADOQueryLayerToTable.Locate('Type', TypeValue, [loCaseInsensitive])
//    then Result := DM.ADOQueryLayerToTable.FieldByName('MapLayer').AsString
//    else Result := '';
end;

// 删除图元及对应的数据  标记图元及数据
procedure DeleteFeatureLabelData(IDValue : String);
begin
  With FrmMain do
  begin
    // 删除标记
    Map1.Layers['标记'].KeyField := 'ID';
    FoundObj := Map1.Layers['标记'].Find.Search(IDValue, '');
    if (FoundObj.Findrc Mod 10 = 1) then
      FrmMain.Map1.Layers['标记'].DeleteFeature(FoundObj);
    // 删除对应的数据信息
    DelLayerName := '';
    OpenADOQueryAll(DM.ADOQueryText, '标记');
    if DM.ADOQueryText.Locate('ID', IDValue, [loCaseInsensitive]) then
    begin
      // 得到标记对应的图元的图层名
      DelLayerName := TypeToLayer(DM.ADOQueryTextType.Value);
      DM.ADOQueryText.Delete;
    end;
    if DelLayerName <> '' then
    begin
      // 删除图元
      Map1.Layers[DelLayerName].KeyField := 'ID';
      FoundObj := Map1.Layers[DelLayerName].Find.Search(IDValue, '');
      if (FoundObj.Findrc Mod 10 = 1) then
        Map1.Layers[DelLayerName].DeleteFeature(FoundObj);
      // 删除对应的数据信息
      OpenADOQueryAll(DM.ADOQueryAll, DelLayerName);
      if DM.ADOQueryAll.Locate('ID', IDValue, [loCaseInsensitive]) then
        DM.ADOQueryAll.Delete;
    end else
    begin
      // 在直接点击图元时的处理
      OpenADOQueryAll(DM.ADOQueryAll, EditLayer.Name);
      if DM.ADOQueryAll.Locate('ID', IDValue, [loCaseInsensitive]) then
        DM.ADOQueryAll.Delete;
      EditLayer.DeleteFeature(EditLayer.Selection.Item[DeleteNumI]);
    end;
  end;
end;

// 在新建图元时初始化窗体设置
procedure IniNewFormData(Frm: TForm);
var
  i, j: Integer;
begin
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].Name = 'CBoxType' then
    if DataHaved
      then begin
             TComboBox(Frm.Components[i]).Text := FrmModify.CBoxFeatureType.Text;
             TComboBox(Frm.Components[i]).Enabled := False;
           end
      else begin
             TComboBox(Frm.Components[i]).Enabled := True;
             TComboBox(Frm.Components[i]).Items.Clear;
             for j := 0 to FrmModify.CBoxFeatureType.Items.Count do
               TComboBox(Frm.Components[i]).Items.Add(FrmModify.CBoxFeatureType.Items[j]);
             TComboBox(Frm.Components[i]).ItemIndex := 0;
           end;
    if Frm.Components[i].Name = 'BBtnDelete' then
      TBitBtn(Frm.Components[i]).Visible := False;
    if Frm.Components[i].Name = 'BBtnEdit' then
      TBitBtn(Frm.Components[i]).Visible := False;
    if Frm.Components[i].Name = 'BBtnExport' then
    begin
      TBitBtn(Frm.Components[i]).Visible := True;
      TBitBtn(Frm.Components[i]).Enabled := True;
    end;
  end;
  UnLockEdit(Frm);
end;

// 在选择图元时初始化窗体设置
procedure IniSelectFormData(Frm: TForm);
var
  i: Integer;
begin
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].Name = 'BBtnDelete' then
      TBitBtn(Frm.Components[i]).Visible := True;
    if Frm.Components[i].Name = 'BBtnEdit' then
      TBitBtn(Frm.Components[i]).Visible := True;
    if Frm.Components[i].Name = 'BBtnExport' then
    begin
      TBitBtn(Frm.Components[i]).Visible := True;
      TBitBtn(Frm.Components[i]).Enabled := False;
    end;
  end;
  LockEdit(Frm);
end;

// 在查询图元时初始化窗体设置
procedure IniSearchFormData(Frm: TForm);
var
  i: Integer;
begin
// 设置属性框为不可编辑
  for i := 0 to Frm.ComponentCount-1 do
  begin
    if Frm.Components[i].Name = 'BBtnDelete' then
      TBitBtn(Frm.Components[i]).Visible := False;
    if Frm.Components[i].Name = 'BBtnEdit' then
      TBitBtn(Frm.Components[i]).Visible := False;
    if Frm.Components[i].Name = 'BBtnExport' then
      TBitBtn(Frm.Components[i]).Visible := False;
    if Frm.Components[i].Name = 'BBtnCancel' then
      TBitBtn(Frm.Components[i]).Visible := True;
  end;
  UnLockEdit(Frm);
end;

// 信息窗体修改按钮点击
procedure EditBtnClick(Frm: TForm);
var
  i: Integer;
begin
  UnLockEdit(Frm);
  for i := 0 to Frm.ComponentCount-1 do
  begin

    if Frm.Components[i].Name = 'LEditName' then
      TLabeledEdit(Frm.Components[i]).SetFocus else
    if Frm.Components[i].Name = 'BBtnExport' then
      TBitBtn(Frm.Components[i]).Enabled := True else
    if Frm.Components[i].Name = 'BBtnCancel' then
      TBitBtn(Frm.Components[i]).Enabled := True
  end;
end;

// 添加随机的数据信息
procedure AddRandomData();
begin
  // 处理图元字段的初始化值
  RandomNameValue := SetRandomNameValue(EditLayer, FrmModify.CBoxFeatureType.Text);
  SetFeatureRowValue(EditLayer.Name, RandomNameValue);
  // 添加数据到数据库中
  OpenADOQueryAll(DM.ADOQueryAll, FrmModify.CBoxEditLayerName.Text);
  DM.ADOQueryAll.Append;
  DM.ADOQueryAll.FieldByName('ID').AsString := PYConvert(RandomNameValue);
  DM.ADOQueryAll.FieldByName('Name').AsString := RandomNameValue;
  DM.ADOQueryAll.FieldByName('Type').AsString := FrmModify.CBoxFeatureType.Text;
  DM.ADOQueryAll.Post;
  // 添加数据到数据库中
  OpenADOQueryAll(DM.ADOQueryText, '标记');
  DM.ADOQueryText.Append;
  DM.ADOQueryTextID.Value := PYConvert(RandomNameValue);
  DM.ADOQueryTextName.Value := RandomNameValue;
  DM.ADOQueryTextType.Value := FrmModify.CBoxFeatureType.Text;
  DM.ADOQueryTextHideLabel.Value := True;
  DM.ADOQueryText.Post;
end;

// 从数据库中下载地图
procedure LoadMap();
var
  Path, FileName: String;
begin
  Path := ExeFilePath + 'Maps\';
  if Not DM.ADOQueryFileData.Active then
    DM.ADOQueryFileData.Open;
  DM.ADOQueryFileData.First;
  while Not DM.ADOQueryFileData.Eof do
  begin
    FileName := Path + DM.ADOQueryFileData.FieldByName('Name').AsString;
    TBlobField(DM.ADOQueryFileData.FieldByName('Info')).SaveToFile(FileName);
    DM.ADOQueryFileData.Next;
  end;
end;

// 上载地图
procedure UpLoadMap();
var
  Path, FileName: String;
  sr: TSearchRec;
begin
  Path := ExeFilePath + 'Maps\*.*';
  if FindFirst(Path, $00000020, sr) = 0 then
  begin
    if Not DM.ADOQueryFileData.Active then
      DM.ADOQueryFileData.Open;
    repeat
      begin
        FileName := ExeFilePath +'Maps\'+ sr.Name;
        if DM.ADOQueryFileData.Locate('Name', sr.Name, [loCaseInsensitive])
          then DM.ADOQueryFileData.Edit
          else DM.ADOQueryFileData.Append;
        DM.ADOQueryFileData.FieldByName('Name').AsString := sr.Name;
        TBlobField(DM.ADOQueryFileData.FieldByName('Info')).LoadFromFile(FileName);
        DM.ADOQueryFileData.Post;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

// 删除地图
procedure DeleteMap();
var
  Path, FileName: String;
  sr: TSearchRec;
begin
  Path := ExeFilePath + 'Maps\*.*';
  if FindFirst(Path, $00000020, sr) = 0 then
  begin
    if Not DM.ADOQueryFileData.Active then
      DM.ADOQueryFileData.Open;
    repeat
      begin
        FileName := ExeFilePath +'Maps\'+ sr.Name;
        if sr.Name <> 'GeoDict.DCT' then
          DeleteFile(PChar(FileName));
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;

// 加载地图及初始化设置
procedure LoadMapSetIniMap();
begin
  With FrmMain do
  begin
    LoadedMap := True;
  // Load Map1 GeoSet
    LoadMap();
    Map1.GeoSet := ExeFilePath+'Maps\JLU-MAP.GST';
  // Load EagleEye GeoSet
    FrmEagleEye.MapEagleEye.GeoSet := ExeFilePath+'Maps\鹰眼.GST';
  // Set EagleEye doing
    Have_EagleEye := True;
    EagleEye_Layer := FrmEagleEye.MapEagleEye.Layers.CreateLayer('EagleEye', Empty, 1, Empty, Empty);
  // Save Initial MapZoom
    CurMapZoom := Map1.Zoom;
    CurMapZoomPosX := Map1.CenterX;
    CurMapZoomPosY := Map1.CenterY;
    IniMapZoom := Map1.Zoom;
    IniMapZoomPosX := Map1.CenterX;
    IniMapZoomPosY := Map1.CenterY;
  // 初始化地图操作工具
    NmiPanToolClick(FrmMain);
  // upDate LayerToFtTypes
    upDate_LayerToFtTypes();
  // 图层绑定及查找
    BindLayerToDataset();
    EditLayer := Map1.Layers['标记'];
  end;
end;

// 地图加标记工具用完时
procedure LabelToolUsed();
var
  i: Integer;
begin
  With FrmMain do
  begin
    for i := 2 to Map1.Layers.Count do
    begin
      Ftrs := Map1.Layers[i].SearchAtPoint(Pt, 0);
      if Ftrs.Count = 1 Then
      begin
        Map1.Layers[i].KeyField := 'ID';
        infoFeature := Ftrs.Item[1];
        OpenADOQueryAll(DM.ADOQueryText, '标记');
        if DM.ADOQueryText.Locate('ID', infoFeature.KeyValue, [loCaseInsensitive]) then
        if DM.ADOQueryTextHideLabel.Value then
        begin
          SetLabelStyle(DM.ADOQueryTextType.Value);
          Map1.DefaultStyle.TextFontRotation := DM.ADOQueryTextRotation.Value;
          SetLabelStr(DM.ADOQueryTextName.Value);
          SetFeatureRowValue('标记', DM.ADOQueryTextName.Value);
          newObj := Map1.FeatureFactory.CreateText(Pt, LabelStr, miPositionBR, Map1.Defaultstyle);
          Map1.Layers['标记'].AddFeature(newObj, RowVals);
          DM.ADOQueryText.Edit;
          DM.ADOQueryTextHideLabel.Value := False;
          DM.ADOQueryText.Post;
        end;
        Break;
      end;
    end;
  end;
end;

// 添加查询结果显示框
procedure FillResultData();
begin
  if DM.ADOQuerySearchAll.RecordCount > 0 then
  With FrmSearchResult do
  begin
    TimerFlash.Enabled := False;
    FrmMain.Map1.Layers.ClearSelection;
    CanChangeZoom := False;
    // 设置属性信息
    LabelName.Caption := DM.ADOQuerySearchAll['Name'];
    LabelType.Caption := DM.ADOQuerySearchAll['Type'];
    LabelLayer.Caption := TypeToLayer(LabelType.Caption);
    // 设置发大倍数
    if (LabelLayer.Caption = '企事业') or
       (LabelLayer.Caption = '公交站点') then TBarZoom.Position := 1
    else
    if (LabelLayer.Caption = '居民区') or
       (LabelLayer.Caption = '绿地') then TBarZoom.Position := 3
    else
    if (LabelLayer.Caption = '公交线路') or
       (LabelLayer.Caption = '轻轨线路') or
       (LabelLayer.Caption = '街道') then TBarZoom.Position := 5
    else
    if (LabelLayer.Caption = '地理区域') or
       (LabelLayer.Caption = '水系') then TBarZoom.Position := 8;
  end;
end;

// 周边环境查询
procedure CenterFeatureFind(FeatureName: String; Dist: Integer; LayerName: String);
var
  CenterType, CenterLayer: String;
  i: Integer;
begin
  if DM.ADOQueryCenterFind.Locate('ID', PYConvert(FeatureName), [loCaseInsensitive]) then
    CenterType := DM.ADOQueryCenterFind.FieldByName('Type').AsString;
  CenterLayer := TypeToLayer(CenterType);
  // 找中心点
  FoundObj := FrmMain.Map1.Layers[CenterLayer].Find.Search(PYConvert(FeatureName), '');
  if (FoundObj.Findrc Mod 10 = 1) then
  begin
     FrmMain.Map1.ZoomTo(50, FoundObj.CenterX, FoundObj.CenterY);
     FrmMain.Map1.Layers.ClearSelection;
     FrmMain.Map1.Layers[CenterLayer].Selection.SelectByPoint(FoundObj.CenterX, FoundObj.CenterY, miSelectionAppend, miSearchResultDefault);
  end
  else begin
         Application.MessageBox('中心点不能定位！', '提示', MB_OK);
       end;

  // 找周边的满足条件的信息
  if LayerName = '全部类别' then
    EditLayer := FrmMain.Map1.Layers['标记']
  else EditLayer := FrmMain.Map1.Layers[LayerName];
  EditLayer.KeyField := 'ID';
  Ftrs := EditLayer.SearchWithinDistance(FoundObj, Dist, 0, 0);
  if Ftrs.Count > 0 then
  begin
    DM.ADOQuerySearchAll.Close;
    DM.ADOQuerySearchAll.SQL.Clear;
    SQLString := 'SELECT *' + #13;
    SQLString := SQLString + 'FROM ' + EditLayer.Name+ #13;
    SQLString := SQLString + 'WHERE ID = ''' + Ftrs.Item[1].KeyValue + '''' +#13;
    for i := 2 to Ftrs.Count do
    begin
      SQLString := SQLString + 'OR ID = ''' + Ftrs.Item[i].KeyValue + '''' +#13;
    end;
    DM.ADOQuerySearchAll.SQL.Add(SQLString);
    DM.ADOQuerySearchAll.Open;