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

📄 unitqcgisproject.pas

📁 此代码是关于mapgis的在
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   
  App_UserInfo:=TQCUserInfo.Create;
  TQCUserInfo(App_UserInfo).DBFactory:=FDBFactory;

  FDLCtrl:=TDLControl.Create;
  FPowerTimer:=TTimer.Create(nil);
  FPowerTimer.Enabled:=False;
  FPowerTimer.OnTimer:=PowerTimerOnTimer;  

  FDataFrom:=2;

  FirstFeature:=True;

  FSubStationFrame:=nil;
end;

destructor TqcGISProject.Destroy;
begin
  FPowerTimer.Free;
  FDBManager.Free;
  GDBPoster.Free;
  FDBFactory.Free;
  FDLCtrl.Free;
  inherited Destroy;
end;

procedure TqcGISProject.DoOnCtrlPropDialog(Sender: TObject;
  ActionId:Integer; Ft: Feature);
var
  ALyr:Layer;
  LayerIndex:Integer;
  ANode:TTreeNode;
begin
  //如果为系统图层,则使用自定义属性对话框,否则使用系统属性对话框//
  ALyr:=TLayerManager(Sender).Layer;
  LayerIndex:=GMapTools.m_Layers.IndexByLayer(ALyr);
  ANode:=FindLayerNode(LayerIndex);
  case TLayerTreeNodeRecord(ANode.Data).FtClassType of
    LAYER_SYS_SUBSTATION:begin
      if Ft.type_<>miFeatureTypeSymbol then Exit;
      if (Ft.KeyValue<>'')and(StrToInt(Ft.KeyValue)>0) then
        ConfigSubStationInfo(GMapTools.MapX, FDBFactory, CurUnitID, Ft)
      else
        NewSubStationInfo(GMapTools.MapX, FDBFactory, CurUnitID, Ft);
    end;
    LAYER_SYS_POWER:begin
      if (Ft.type_<>miFeatureTypeLine)and(Ft.type_<>miFeatureTypeRegion) then
        Exit;
      if (Ft.KeyValue<>'')and(StrToInt(Ft.KeyValue)>0) then
        ConfigPowerInfo(GMapTools.MapX, CurUnitID, Ft)
      else
        NewPowerInfo(GMapTools.MapX, CurUnitID, Ft);
    end;
    LAYER_SYS_LINE:begin
      if (Ft.type_<>miFeatureTypeLine)and(Ft.type_<>miFeatureTypeRegion) then
        Exit;
      if (Ft.KeyValue<>'')and(StrToInt(Ft.KeyValue)>0) then
        ConfigSDLineInfo(GMapTools.MapX, CurUnitID, Ft)
      else 
        NewSDLineInfo(GMapTools.MapX, CurUnitID, Ft);
    end;
    LAYER_SYS_USER:begin
    end;
    LAYER_SYS_ROAD:begin
    end;    
  end;      
end;

procedure TqcGISProject.DownLoadClick(Sender: TObject);
begin
  if YHB_Confirmation('是否从服务器上下载图层?', False) then
  begin
    DownLoadSystemLayers;
    if Form_Main.cb_Maps.ItemIndex<>-1 then
      Form_Main.cb_Maps.OnChange(Form_Main.cb_Maps);
  end;
end;

procedure TqcGISProject.DownloadProjectLayer(ALyr: CMapXLayer;
  aLayerInfo:TLayerTreeNodeRecord; const LayerName, Path:string);
var
  MapFields:TMapFieldList;
  FileName:string;
begin
  MapFields:=TMapFieldList.Create;
  try
    if aLayerInfo.DataFrom=1 then
    begin
      LoadMapFields(aLyr.DataSets.Item[1].Fields, MapFields);
      aLyr:=GMapTools.m_Layers.CreateCustomTableLayer(
                   LayerName, Path, MapFields, 1, True);
      AddLayerNode(SysTree, SysTreeRoot, naAddChildFirst,
                   -1, aLyr.Name, Path+'\'+LayerName+'.TAB', False, 2, -1, 3);
      GMapTools.m_Layer.Layer:=aLyr;
      GMapTools.m_Layer.LoadFeaturesFromTable(
                   dm_MainLinkObjects.PublicQuery,
                   aLayerInfo.FileName, MapFields);
    end
    else
    begin
      FileName:=CheckPath(Path)+LayerName+'.TAB';
      DownloadBinaryLayer(CurUnitID, aLayerInfo.FileName, Path, LayerName);
      if not FileExists(FileName) then
        WarningAbort('错误', '下载失败,可能服务器图层被删除!');
      aLyr:=GMapTools.m_Layers.CreateLayerFromFile(
                   LayerName, FileName, 1, True);
      AddLayerNode(SysTree, SysTreeRoot, naAddChildFirst,
                   -1, aLyr.Name, FileName, False, 2, -1, 3);
    end;
  finally
    MapFields.Free;
  end;   
end;

procedure TqcGISProject.LoadAndInitMap;
var
  i:Integer;
  Index:Integer;
  pLayerInfo:TLayerTreeNodeRecord;
  MapFields:TMapFieldList;
begin
  AppPath:=CheckPath(AppPath);
  MapFields:=TMapFieldList.Create;
  try
    Index:=0;
    for i:=0 to SysTree.Items.Count-1 do
    begin
      pLayerInfo:=TLayerTreeNodeRecord(SysTree.Items[i].Data);
      if (pLayerInfo<>nil)and(pLayerInfo.NodeType=LTN_LAYER) then
      begin
        Inc(Index);
        if pLayerInfo.IsSystem then  //如果系统图层,并且从服务器加载//
          CreateLayerFromTable(pLayerInfo, Index)
        else     //如果是本地图层,则从文件加载//
          with GMapTools.m_Layers do
          begin
            if FileExists(pLayerInfo.FileName) then
              CreateLayerFromFile(pLayerInfo.Name, pLayerInfo.FileName, -1, True)
            else begin
              MapFields.Clear;
              MapFields.AddAndInit('ID', mftInteger, 0, 0, 0);
              MapFields.AddAndInit('Caption', mftString, 50, 0, 0);
              CreateCustomTableLayer(pLayerInfo.Name, AppPath+'Maps'+CurUnitName, MapFields, -1, True);
            end;
          end;
      end;
    end;
  finally
    MapFields.Free;
  end;
  {编辑图层初始化为nil}
  EditLayer:=nil;
end;

procedure TqcGISProject.LoadBusinessMenuItems(AMenuItem: TMenuItem);
var
  aSubItem:TMenuItem;
begin
  if AMenuItem=nil then Exit;
  FRootMenuItem:=AMenuItem;
  FRootMenuItem.Clear;

  aSubItem:=LoadMenuItem(FRootMenuItem,  '系统管理', -1, nil);
  NReDirectServer:=aSubItem;
  LoadMenuItem(aSubItem, '客户端配置...', MENU_ID_CONNECT, ConnectClick);

  LoadMenuItem(FRootMenuItem, '-', -1, nil);

  aSubItem:=LoadMenuItem(FRootMenuItem,  '业务操作', -1, nil);
  
  NConfigBDS:=LoadMenuItem(aSubItem, '变电所管理', -1, nil);
  LoadMenuItem(aSubItem, '-', -1, nil);
  NAddStation:=LoadMenuItem(aSubItem, '增加子站', MENU_ID_ADDSUBSTATION, AddStationClick);
  NAddLine:=LoadMenuItem(aSubItem, '增加线路', MENU_ID_ADDLINE, AddLineClick);
  NAddKG:=LoadMenuItem(aSubItem, '增加开关', MENU_ID_ADDKG, AddKGClick);
  NAddBT:=LoadMenuItem(aSubItem, '增加变台', MENU_ID_ADDBT, AddBTClick);

  LoadMenuItem(aSubItem, '-', -1, nil);
  LoadMenuItem(aSubItem, '分析无记录子站', -1, AnalyzeSubStationClick);
  LoadMenuItem(aSubItem, '分析无记录开关', -1, AnalyzePowerClick);
  LoadMenuItem(aSubItem, '分析无记录线路', -1, AnalyzeSDLineClick);
  LoadMenuItem(aSubItem, '分析无开关线路', -1, AnalyzeLinkPowerClick);

  LoadMenuItem(aSubItem, '-', -1, nil);
  NLinkToPower:=LoadMenuItem(aSubItem, '关联开关', MENU_ID_LINKTOPOWER, LinkToPowerClick);

  LoadMenuItem(aSubItem, '-', -1, nil);
  LoadMenuItem(aSubItem, '从新装载模拟数据', -1, LoadDLControlDataClick);
  LoadMenuItem(aSubItem, '启动开关状态随机模拟', -1, RandomPowerStateClick);
  
  LoadMenuItem(aSubItem, '-', -1, nil);

  NUpLoad:=LoadMenuItem(aSubItem, '上载图层', -1, UpLoadClick);
  NDownLoad:=LoadMenuItem(aSubItem, '下载图层', -1, DownLoadClick);

  LoadMenuItem(aSubItem, '-', -1, nil);

  NShapeProperties:=LoadMenuItem(aSubItem, '图形属性', MENU_ID_PROPERTIES, ShapePropertiesClick);

  LoadMenuItem(FRootMenuItem, '-', -1, nil);

  aSubItem:=LoadMenuItem(FRootMenuItem,  '权限管理', -1, nil);
  NUserRight:=aSubItem;
  LoadMenuItem(aSubItem, '重新登陆', -1, ReConnectClick);
  LoadMenuItem(aSubItem, '密码修改', -1, CheckPasswordClick);
  
  LoadMenuItem(aSubItem, '-', -1, nil);
  NConfigPopedom:=LoadMenuItem(aSubItem, '权限分配', -1, ConfigPopedomClick);
end;

procedure TqcGISProject.CreateFeatureClassNode(const FCId: Integer;
  ATreeView: TTreeView; ATreeNode: TTreeNode);

  procedure LoadFields(ALayerInfo:TLayerTreeNodeRecord);
  var
    i:Integer;
    ADBShell:TSQLServerDBShell;
    AStruct:TQueryStruct;
    AMapField:TMapField;
  begin
    AStruct:=TQueryStruct.Create;
    try
      ADBShell:=TSQLServerDBShell.Create;
      try
        with ADBShell do
        begin
          DBFactory:=FDBFactory;
          GetQueryStruct(ALayerInfo.FileName, AStruct);
        end;
        for i:=0 to AStruct.Fields.Count-1 do
        begin
          AMapField:=ALayerInfo.Fields.Add;
          AMapField.FieldName:=AStruct.Fields.Items[i].ColName;
          AMapField.DisplayLabel:=AStruct.Fields.Items[i].Caption;
        end;
      finally
        ADBShell.Free;
      end;
    finally
      AStruct.Free;
    end;
  end;
  
var
  ALayerNode:TTreeNode;
  ALayerInfo:TLayerTreeNodeRecord;
begin
  with dm_Links.DBMachine1.CreateSingleDataSet do
  begin
    try
      SQL.Add('select LayerId, LayerName, FCId, TableName, DataFrom');
      SQL.Add('from t_Layers where FCId=:FCId order by LayerIndex');
      SetParamValue(0, FCId);
      Open;
      while not Eof do
      begin
        ALayerNode:=AddLayerNode(ATreeView, ATreeNode, naAddChild,
                     Fields[0].AsInteger, Fields[1].AsString,
                     Fields[3].AsString,
                     True, Fields[4].AsInteger,
                     Fields[2].AsInteger,2);
        ALayerInfo:=TLayerTreeNodeRecord(ALayerNode.Data);
        LoadFields(ALayerInfo);
        Next;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TqcGISProject.LoadLayerTreeInfo;
var
  aRoot:TTreeNode;
  aFCItem:TTreeNode;
  aLayerInfo:TLayerTreeNodeRecord;
begin
  SysTree.Items.BeginUpdate;
  try
    {清空树型列表}
    RemoveAllNodes;
    {创建系统图层的根节点}
    aRoot:=SysTree.Items[0];
    {加载系统图层,必须加载}
    with dm_Links.DBMachine1.CreateSingleDataSet do
    begin
      try
        SQL.Add('select FCId, FCName, FCIndex, LayerCount, Visible from t_FeatureClasses');
        SQL.Add('where LayerCount>0 order by FCIndex');
        Open;
        while not Eof do
        begin
          if Fields[3].AsInteger=1 then  //如果只有一个图层,则加载在系统跟节点下//
            CreateFeatureClassNode(Fields[0].AsInteger, SysTree, aRoot)
          else begin  //如果有多个图层,则先创建图层组节点,然后将该图层组的图层加载进来//
            aFCItem:=SysTree.Items.AddChild(aRoot, Fields[1].AsString);
            aFCItem.ImageIndex:=1;
            aFCItem.SelectedIndex:=1;
            aFCItem.StateIndex:=TREENODESTATE_SUBCHECKEDALL;
            aLayerInfo:=TLayerTreeNodeRecord.Create;
            aFCItem.Data:=aLayerInfo;
            aLayerInfo.NodeType:=LTN_FEATURECLASS;
            aLayerInfo.Id:=Fields[0].AsInteger;
            aLayerInfo.Name:=Fields[1].AsString;
            aLayerInfo.IsSystem:=True;
            CreateFeatureClassNode(aLayerInfo.Id, SysTree, aFCItem)   //如果有多个图层,则加载在图层组下//
          end;
          Next;
        end;
      finally
        Free;
      end;
    end;
    {展开第一层节点}
    if SysTree.Items.Count>0 then
      SysTree.Items[0].Expand(False);
  finally
    SysTree.Items.EndUpdate;
  end;
end;

function TqcGISProject.LoadMenuItem(aPItem:TMenuItem; const Caption: string;
  const Tag: Integer; ClickProc: TNotifyEvent):TMenuItem;
begin
  Result:=TMenuItem.Create(aPItem.Owner);
  Result.Caption:=Caption;
  Result.Tag:=Tag;
  Result.OnClick:=ClickProc;
  aPItem.Add(Result);
end;

procedure TqcGISProject.LoadProject;
begin
  inherited LoadProject;
  //设置主窗口标题//
  Form_Main.Caption:=ProjectName;
  //因为嵌入VC或Delphi后点击按钮存在问题,所以隐藏//
  SetGISPageVisible(ID_PAGE_SEARCH, False);
  SetGISPageVisible(ID_PAGE_DRAW, False);
  //创建数据库连接//
  Application.CreateForm(Tdm_Links, dm_Links);
  Application.CreateForm(Tdm_MainLinkObjects, dm_MainLinkObjects);
  //设置数据提交者的引擎//
  GDBPoster.Engine:=dm_Links.DBMachine1;
  //设置用户信息的引擎//
  FDBFactory.Engine:=dm_Links.DBMachine1;
  //加载TrackLayer,目前该图层没有被使用,属于保留图层//
  with GMapTools.m_Layers do
    UserLayer:=CreateDefaultTempLayer('_YHB_SYS_TRACKLAYER', 1);
  //EXE程序,使用上次配置连接数据库,其它方式登陆,使用函数连接数据库//
  if AppType=atExe then
  begin
    //连接到数据库//
    DefConnectToServer;
    //需要使用对话框获取用户信息//
    if dm_Links.DBMachine1.Connected then ConnectUseDialog;
    //如果连接到服务器,则调用DoAfterConnect进一步设置//
    if Connected then DoAfterUserConnect;
  end;
end;

procedure TqcGISProject.RefreshDotState(aDot:TDot);
var
  aFts:Features;
  aFt:Feature;
  NewColor:TColor;
begin
  if FDotLayer=nil then Exit;
  aFts:=FDotLayer.Search('DotID='+IntToStr(aDot.DotId), EmptyParam);
  if aFts.Count=1 then
  begin
    aFt:=aFts.Item[1];
    if aDot.DotState=dsLink then
      NewColor:=clRed
    else
      NewColor:=clBlack;
    if NewColor<>aFt.Style.LineColor then
    begin
      aFt.Style.LineColor:=NewColor;
      aFt.Update(EmptyParam, EmptyParam);
    end;
  end;
end;

procedure TqcGISProject.RefreshLineLayerState(const bChanged:Boolean);
var
  i:Integer;
  aFts:Features;
  aFt:Feature;
  aLine:TLine;
  NewColor:TColor;
begin
  if FLineLayer=nil then Exit;
  for i:=0 to FDLCtrl.Lines.ItemCount-1 do
  begin
    aLine:=FDLCtrl.Lines.Items[i];
    if (bChanged) and (not aLine.StateChanged) then
      Continue;

⌨️ 快捷键说明

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