⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitmain.pas

📁 在delphi下基于MapX5.0的GIS程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
begin
  selItems := EditLayer.Selection;
  if selItems.Count > 1 then
  begin
    if Application.MessageBox('确实要合并吗?', '提示', MB_YESNO) = IDYES then
    begin
      Editlayer.KeyField := 'ID';
      // 设置属性
      newFeature := Map1.FeatureFactory.CombineFeatures(selItems.Item[1], selItems.Item[2]);
      Style := EditLayer.Selection.Item[1].Style;
      DeleteNumI := 1;
      DeleteFeatureLabelData(EditLayer.Selection.Item[1].KeyValue);
      DeleteNumI := 2;
      DeleteFeatureLabelData(EditLayer.Selection.Item[2].KeyValue);
      for i := 3 to selItems.Count do
      begin
        newFeature := Map1.FeatureFactory.CombineFeatures(newFeature, selItems.Item[i]);
        DeleteNumI := i;
        DeleteFeatureLabelData(EditLayer.Selection.Item[i].KeyValue);
      end;
      newFeature.Style := Style;
      // 添加随机的数据信息
      AddRandomData();
      EditLayer.AddFeature(newFeature, RowVals);
    end;
  end;
  TBtnCombineFeature.Enabled := False;
end;

procedure TFrmMain.NCUSTOM_SYMBOL_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_SYMBOL_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_SYMBOL_TOOL, TBtnCUSTOM_SYMBOL_TOOL);
end;

procedure TFrmMain.NCUSTOM_TEXT_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_TEXT_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_TEXT_TOOL, TBtnCUSTOM_TEXT_TOOL);
end;

procedure TFrmMain.NCUSTOM_LINE_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_LINE_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_LINE_TOOL, TBtnCUSTOM_LINE_TOOL);
end;

procedure TFrmMain.NCUSTOM_POLYLINE_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_POLYLINE_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_POLYLINE_TOOL, TBtnCUSTOM_POLYLINE_TOOL);
end;

procedure TFrmMain.NCUSTOM_RECTANGLE_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_RECTANGLE_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_RECTANGLE_TOOL, TBtnCUSTOM_RECTANGLE_TOOL);
end;

procedure TFrmMain.NCUSTOM_CIRCULARREGION_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_CIRCULARREGION_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_CIRCULARREGION_TOOL, TBtnCUSTOM_CIRCULARREGION_TOOL);
end;

procedure TFrmMain.NCUSTOM_REGION_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_REGION_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_REGION_TOOL, TBtnCUSTOM_REGION_TOOL);
end;

procedure TFrmMain.NmiSelectToolClick(Sender: TObject);
begin
  Map1.CurrentTool:= miSelectTool;
  Set_MenuCheck_BtnDown(NmiSelectTool, TBtnmiSelectTool);
end;

procedure TFrmMain.NmiRadiusSelectToolClick(Sender: TObject);
begin
  Map1.CurrentTool:= miRadiusSelectTool;
  Set_MenuCheck_BtnDown(NmiRadiusSelectTool, TBtnmiRadiusSelectTool);
end;

procedure TFrmMain.NmiRectSelectToolClick(Sender: TObject);
begin
  Map1.CurrentTool:= miRectSelectTool;
  Set_MenuCheck_BtnDown(NmiRectSelectTool, TBtnmiRectSelectTool);
end;

procedure TFrmMain.NmiPolygonSelectToolClick(Sender: TObject);
begin
  Map1.CurrentTool:= miPolygonSelectTool;
  Set_MenuCheck_BtnDown(NmiPolygonSelectTool, TBtnmiPolygonSelectTool);
end;

procedure TFrmMain.NmiClearSelToolClick(Sender: TObject);
begin
  Map1.Layers.ClearSelection;
end;

procedure TFrmMain.NDrawStyleModifyClick(Sender: TObject);
begin
  // 绘制属性设置
  FrmDrawStyleModify.ShowModal;
end;

procedure TFrmMain.Map1DblClick(Sender: TObject);
begin
  if Map1.CurrentTool = miSelectTool then
  if EditLayer.Selection.Count > 0 then
  begin
    infoFeature := EditLayer.Selection.Item[1];
    infFormViewType := SELECT_FEATURE;
// 根据类型而选择窗口
    case infoFeature.Type_ of
      miFeatureTypeRegion  :
      begin
        FrmComInfo.ShowModal;
      end;
      miFeatureTypeLine    :
      begin
        if EditLayer.Name = '街道' then FrmComInfo.ShowModal;
        if (EditLayer.Name = '公交线路') or (EditLayer.Name = '轻轨线路')
          then FrmComWay.ShowModal;
      end;
      miFeatureTypeSymbol  :
      begin
        if EditLayer.Name = '企事业' then FrmCompanysInfo.ShowModal;
        if EditLayer.Name = '公交站点' then FrmComInfo.ShowModal;
      end;
      miFeatureTypeText    :
      begin
        FrmLabelInfo.ShowModal;
      end;
      miFeatureTypeUnknown : ;
    end;
  end;
end;

procedure TFrmMain.NModifyWindowsClick(Sender: TObject);
begin
  CoolBar1.Bands.Items[1].Visible := True;
  FrmModify.Show;
end;

procedure TFrmMain.Map1Click(Sender: TObject);
var
  i, j, k: Integer;
  CBoxFeatureTypeIndex, IndexNum: Integer;
begin
// 对应选择的图元改变当前的图层及字体设置
  if Map1.CurrentTool = miSelectTool then
  for k := 1 to Map1.Layers.Count do
  if Map1.Layers[k].Selection.Count > 0 then
  begin
  // 当编辑层是标记层时的处理
    if k = 1 then
    begin
     // 记录选择标记的名称
      Map1.Layers['标记'].KeyField := 'Name';
      for i := 1 to Map1.Layers['标记'].Selection.Count do
      begin
        LabelStrArr[i] := Map1.Layers['标记'].Selection.Item[i].KeyValue;
        LabelStrArrX[i] := Map1.Layers['标记'].Selection.Item[i].CenterX;
        LabelStrArrY[i] := Map1.Layers['标记'].Selection.Item[i].CenterY;
      end;
      TBtnCombineFeature.Enabled := False;
    end;

    with FrmModify do
    begin
    // 设置标记文字的属性
      Map1.Layers[k].KeyField := 'ID';
      OpenADOQueryAll(DM.ADOQueryText, '标记');
      if DM.ADOQueryText.Locate('ID', Map1.Layers[k].Selection.Item[1].KeyValue, [loCaseInsensitive])
      then begin
             DataHaved := True;
             SetLabelStyle(DM.ADOQueryTextType.Value);
           end
      else DataHaved := False;  

      EditLayer := Map1.Layers[k];
      CBoxEditLayerName.ItemIndex := k-1;
      LBoxModify.ItemIndex := CBoxEditLayerName.ItemIndex; 
      
      // 添加类型刷新
      CBoxFeatureTypeIndex := 0;
      IndexNum := 0;
      CBoxFeatureType.Items.Clear;
      if CBoxEditLayerName.Text = '标记' then
      begin
        for j := 1 to CBoxEditLayerName.Items.Count do
        for i := 1 to LayerToFtTypeArr[j].TypeNum do
        begin
          CBoxFeatureType.Items.Add(LayerToFtTypeArr[j].FeatureTypeArr[i]);
          Inc(IndexNum);
          if LayerToFtTypeArr[j].FeatureTypeArr[i] = DM.ADOQueryTextType.Value then
            CBoxFeatureTypeIndex := IndexNum-1;
        end;
      end else
      for i := 1 to LayerToFtTypeArr[CBoxEditLayerName.ItemIndex+1].TypeNum do
      begin
        CBoxFeatureType.Items.Add(LayerToFtTypeArr[CBoxEditLayerName.ItemIndex+1].FeatureTypeArr[i]);
        if CBoxFeatureType.Items[i-1] = DM.ADOQueryTextType.Value then
          CBoxFeatureTypeIndex := i-1;
      end;
      //  定位类型框
      CBoxFeatureType.ItemIndex := CBoxFeatureTypeIndex;
    end;
    Break;
  end;
end;

procedure TFrmMain.TimerModifyMoveTextTimer(Sender: TObject);
var
  i, j: Integer;
  Pt: MapXLib_TLB.Point;
begin
// 当编辑层是标记层时的处理
  if EditLayer.Name = '标记' then
  if Map1.CurrentTool = miSelectTool then
  if Map1.Layers['标记'].Selection.Count > 0 then
  begin
    for i := 1 to Map1.Layers['标记'].Selection.Count do
    begin
      if Map1.Layers['标记'].Selection.Item[i].Caption <> LabelStrArr[i] then
      // 已经变了
      begin
        // 设置对应的字体属性
        if DM.ADOQueryText.Locate('ID', PYConvert(LabelStrArr[i]), [loCaseInsensitive]) then
        begin
          SetLabelStyle(DM.ADOQueryTextType.Value);
          Map1.DefaultStyle.TextFontRotation := DM.ADOQueryTextRotation.Value;
        end;

        // 处理图元字段的初始化值
        SetFeatureRowValue('标记', LabelStrArr[i]);
        LabelStr := LabelStrArr[i];
        for j := 1 to ChineseNum(LabelStrArr[i]) do
          LabelStr := LabelStr + ' ';
        Pt := Map1.Layers['标记'].Selection.Item[i].Point;
        Map1.Layers['标记'].DeleteFeature(Map1.Layers['标记'].Selection.Item[i]);
        newObj := Map1.FeatureFactory.CreateText(Pt, LabelStr, miPositionBR, Map1.Defaultstyle);
        Map1.Layers['标记'].AddFeature(newObj, RowVals);
      end;
    end;
    TimerModifyMoveText.Enabled := False;
//    Map1.Layers['标记'].Selection.ClearSelection;
  end;
end;

procedure TFrmMain.Map1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if DM.ADOConnection1.Connected then
// 当编辑层是标记层时的处理
  if EditLayer.Name = '标记' then
  if Map1.CurrentTool = miSelectTool then
  if Map1.Layers['标记'].Selection.Count > 0 then
    TimerModifyMoveText.Enabled := True;
end;

procedure TFrmMain.Map1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  // 如果按下Del键
  if LoadedMap then
  begin
    if EditLayer.Selection.Count > 0 then
    if Key = 46 then NRemoveFeatureClick(FrmMain);
   // 周边移动
    SetMapPos(Shift);
  end;
end;

procedure TFrmMain.NCUSTOM_LABEL_TOOLClick(Sender: TObject);
begin
  Map1.CurrentTool := CUSTOM_LABEL_TOOL;
  Set_MenuCheck_BtnDown(NCUSTOM_LABEL_TOOL, TBtnCUSTOM_LABEL_TOOL);
end;

procedure TFrmMain.Map1SelectionChanged(Sender: TObject);
begin
// 处理删除按钮
  if (infFormViewType = NEW_FEATURE) or
     (infFormViewType = SELECT_FEATURE) then
  begin
    if EditLayer.Selection.Count > 0 then
    begin
      NRemoveFeature.Enabled := True;
      TBtnRemoveFeature.Enabled := True;
    end else
    begin
      NRemoveFeature.Enabled := False;
      TBtnRemoveFeature.Enabled := False;
    end;
  // 处理合并按钮
    if (EditLayer.Name = '标记') or (EditLayer.Name = '企事业') or
       (EditLayer.Name = '公交站点') or (EditLayer.Selection.Count < 2)
    then
    begin
      NCombineFeature.Enabled := False;
      TBtnCombineFeature.Enabled := False;
    end
    else if EditLayer.Selection.Count > 1 then
         begin
           NCombineFeature.Enabled := True;
           TBtnCombineFeature.Enabled := True;
         end;
  end;
end;

procedure TFrmMain.NPackMapClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 2 to Map1.Layers.Count do
    Map1.Layers[i].Pack(miPackAll);
 Map1.Layers[1].Pack(miPackIndex);
//  CopyTable('标记', Map1);
end;

procedure TFrmMain.Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  MouseX := X;
  MouseY := Y;
end;

procedure TFrmMain.Map1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Move_Direction := DIRECTION_STOP;
end;

procedure TFrmMain.NAboutSystemClick(Sender: TObject);
begin
  FrmAbout.ShowModal;
end;

procedure TFrmMain.FormShow(Sender: TObject);
begin
  FrmLogin.ShowModal;
// 释放欢迎画面
  FrmSplash.Destroy;
  if CanLogin then
  begin
//    ShowWindow(Application.handle,SW_HIDE);
 // 加载右下角的图标
    aIcon:=LoadIcon(HInstance,'MainIcon');

    aIconData.uFlags:= NIF_MESSAGE + NIF_ICON + NIF_TIP;
    aIconData.uID:=UINT(IDI_TRAYICON);
    aIconData.cbSize:=sizeof(TNotifyIconData);
    aIconData.Wnd:=Handle;
    aIconData.uCallbackMessage:=TRAY_CALLBACK;
    aIconData.hIcon:=Application.Icon.Handle;
    aIconData.szTip:='吉林大学地理信息系统';
    Shell_NotifyIcon(NIM_ADD,@aIconData);
   // 数据库连接成功初始化设置
    DMIni();
    LoadMapSetIniMap();
  end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  ApplicationIni();
end;

procedure TFrmMain.NAllMapClick(Sender: TObject);
begin
//  view the whole map
  Map1.Bounds := Map1.Layers.Bounds;
  SetViewLayer();
end;

procedure TFrmMain.TrayCallBack(var Msg:TMessage);
var
  p:TPoint;
begin
  if (Msg.LParam=WM_RBUTTONDOWN) or (Msg.LParam=WM_LBUTTONDBLCLK) then
  begin
    if (Msg.WParam=IDI_TRAYICON) then
    begin
      GetCursorPos(p);
      PMenuIcon.Popup(p.x,p.y);
    end;
  end;
end;

procedure TFrmMain.PNExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.AppException(Sender: TObject; E: Exception);
begin
  ErrorInf:=E.Message;
  Application.MessageBox(Pchar('请记录下面的出错信息,并与开发人员联系!'+#13+
                               ErrorInf), '程序出错或系统错误!', 0);
end;

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Canclose:=False;
  if Application.MessageBox('你真的要退出系统吗?','提示', 1)=1 then
  begin
    if IsServer then
    begin
      // 管理员退出写日志
      SFillRecordE();
      FrmLogin.SSocket.Active := False;
    end
    else
    begin
    //Efeiyang<133#
    // 发出退出信息
      FrmLogin.CSocket.Socket.SendText('E'+CUser+'<'+CSocketID+'>'+CLoginTimeStr);
      FrmLogin.CSocket.Active := False;
    end;
    DeleteMap();
    Canclose:=True;
  end;
end;

procedure TFrmMain.NReEnterClick(Sender: TObject);
begin
  FrmLogin.ShowModal;
end;

procedure TFrmMain.TimerTimer(Sender: TObject);
begin
  SBar.Panels[SBar.Panels.Count-3].Text := FormatDateTime('dddddd  dddd', Now);
  SBar.Panels[SBar.Panels.Count-1].Text := FormatDateTime('tt', Now);
end;

procedure TFrmMain.NClientManageClick(Sender: TObject);
begin
  FrmClientManage.ShowModal;
end;

procedure TFrmMain.NRecordManageClick(Sender: TObject);
begin
  FrmRecordManage.ShowModal;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  // 去掉右下角的图标
  Shell_NotifyIcon(NIM_DELETE,@aIconData);
  Application.ProcessMessages;
end;

procedure TFrmMain.NExitClick(Sender: TObject);
begin
// Exit
  Close;
end;

procedure TFrmMain.NToolBarClick(Sender: TObject);
begin
// 查看工具栏
  NToolBar.Checked := Not NToolBar.Checked;
  CoolBar1.Bands.Items[0].Visible := NToolBar.Checked;
end;

procedure TFrmMain.NStatusBarClick(Sender: TObject);
begin
// 查看状态栏
  NStatusBar.Checked := Not NStatusBar.Checked;
  SBar.Visible := NStatusBar.Checked;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -