unitqcgisproject.pas

此代码是关于mapgis的在

    aFts:=FLineLayer.Search('LineID='+IntToStr(aLine.LineId), EmptyParam);
    if aFts.Count=1 then
    begin
      aFt:=aFts.Item[1];
      if aLine.CurState=lsOn then
        NewColor:=clRed
      else
        NewColor:=clBlack;
      if NewColor<>aFt.Style.LineColor then
      begin
        aFt.Style.LineColor:=NewColor;
        aFt.Update(EmptyParam, EmptyParam);
      end;
    end;
  end;
end;

procedure TqcGISProject.RegisterProjectStyles;
var
  AStyle:TBaseStyleInfo;
begin
  //增加子站样式//
  AStyle:=TSymbolBitmapStyleInfo.Create;
  with TSymbolBitmapStyleInfo(AStyle) do
  begin
    UserId:=STYLE_SUBSTATION;
    BitmapName:='SUBSTATION.bmp';
    BitmapTransparent:=True;
    BitmapSize:=24;
    BitmapColor:=0;
  end;
  GMapTools.m_Map.UserStyles.Add(AStyle);
  //增加输电线路样式//
  AStyle:=TLineStyleInfo.Create;
  with TLineStyleInfo(AStyle) do
  begin
    UserId:=STYLE_SDLINE;
    LineStyle:=miLineTypeSimple;
    LineWidth:=1;
    LineColor:=clBlack;
    LineInterleaved:=False;
  end;
  GMapTools.m_Map.UserStyles.Add(AStyle);
  //增加开关样式//
  AStyle:=TLineStyleInfo.Create;
  with TLineStyleInfo(AStyle) do
  begin
    UserId:=STYLE_KG;
    LineStyle:=miLineTypeSimple;
    LineWidth:=1;
    LineColor:=clRed;
    LineInterleaved:=False;
  end;
{  AStyle:=TSymbolBitmapStyleInfo.Create;
  with TSymbolBitmapStyleInfo(AStyle) do
  begin
    UserId:=STYLE_KG;
    BitmapName:='KG2_OPEN.bmp';
    BitmapTransparent:=True;
    BitmapSize:=24;
    BitmapColor:=0;
  end; }
  GMapTools.m_Map.UserStyles.Add(AStyle);
end;

procedure TqcGISProject.RegisterProjectTools;
begin
  RegisterMapXTool(TAddSubStationMapTool,
                   GMapTools.m_Map.UserTools,
                   GMapTools.m_Map);
  RegisterMapXTool(TAddSDLineMapTool,
                   GMapTools.m_Map.UserTools,
                   GMapTools.m_Map);
  RegisterMapXTool(TAddKGLineMapTool,
                   GMapTools.m_Map.UserTools,
                   GMapTools.m_Map);
  RegisterMapXTool(TLinkToPowerMapTool,
                   GMapTools.m_Map.UserTools,
                   GMapTools.m_Map);
end;

procedure TqcGISProject.ShapePropertiesClick(Sender: TObject);
begin
  CheckEditLayer;
  with GMapTools.m_Layer do
  begin
    Layer:=EditLayer;
    ShowPropDialog(EditLayer.Selection.Item[1]);
  end;
end;

procedure TqcGISProject.UpLoadClick(Sender: TObject);
var
  Path:string;
begin
  if YHB_Confirmation('是否将本地图层上传到服务器上？', False) then
  begin
    if GMapTools.MapX.Layers.Count=0 then
      MyDefInformation('地图至少需要一个图层，请添加图层！')
    else
      GMapTools.m_Map.SaveMapAsGeoset(AppPath+'Maps\鹰眼.GST');
    Path:=CheckPath(AppPath)+'SymbolBitmaps';
    UpLoadResources(1, 'bmp', Path);
    UpLoadSystemLayers;
  end;
end;

procedure TqcGISProject.CreateLayerFromTable(
  aLayerInfo: TLayerTreeNodeRecord; const Index:Integer);

  procedure ApplySysConfig;
  var
    List:TStringList;
    BoundsStr:string;
  begin
    List:=TStringList.Create;
    try
      with dm_MainLinkObjects.PublicQuery2 do
      begin
        Close;
        SQL.Text:='select * from t_Layers where LayerId='+IntToStr(aLayerInfo.Id);
        Open;
        Trans2(FieldByName('SysCfg').AsString, ';', List);
        Close;
      end;
      BoundsStr:=GetValueByName(List, 'InitBounds');
      if BoundsStr<>'' then
        GMapTools.MapX.Bounds:=CreateBoundsUseBoundsString(BoundsStr);
    finally
      List.Free;
    end;
  end;
  
var
  MapFields:TMapFieldList;
  MapFileName:string;
  aLyr:Layer;
begin
  AppPath:=CheckPath(AppPath);
  MapFields:=TMapFieldList.Create;
  try
    {当DataFrom为1时，数据来自于图形记录表，为2时数据来自于文件}
    case aLayerInfo.DataFrom of
      1:begin
        {取得字段}
        with dm_MainLinkObjects.PublicQuery do
        begin
          Close;
          SQL.Text:='select top 0 * from '+aLayerInfo.FileName;
          Open;
        end;
        LoadMapFields(dm_MainLinkObjects.PublicQuery, MapFields);
        {创建图层}
        aLyr:=GMapTools.m_Layers.CreateCustomTempLayer(aLayerInfo.Name,
                                         MapFields, Index, True);
        ApplySysConfig;
        {加载图形}
        GMapTools.m_Layer.Layer:=aLyr;
        GMapTools.m_Layer.LoadFeaturesFromTable(dm_MainLinkObjects.PublicQuery,
                                         aLayerInfo.FileName, MapFields);
        dm_MainLinkObjects.PublicQuery.Close;
      end;
      2:begin
        {创建本地图层}
        MapFileName:=AppPath+'Maps\'+CurUnitName+'\'+aLayerInfo.FileName+'.TAB';
        if FileExists(MapFileName) then
          aLyr:=GMapTools.m_Layers.CreateLayerFromFile(
                                         aLayerInfo.Name,
                                         MapFileName,
                                         Index, True)
        else
          aLyr:=GMapTools.m_Layers.CreateDefaultTempLayer(aLayerInfo.Name,
                                         Index);
        ApplySysConfig;
      end;
    end;
  finally
    MapFields.Free;
  end;
end;

function TqcGISProject.FeatueClassExists(const FCId: Integer): Boolean;
begin
  with dm_MainLinkObjects.PublicQuery do
  begin
    Close;
    SQL.Text:='select FCId from t_FeatureClasses where FCId=:FCId';
    SetParamValue(dm_MainLinkObjects.PublicQuery, 'FCId', FCId);
    Open;
    Result:=(not Eof) and (Fields[0].AsString<>'');
    Close;
  end;
end;

function TqcGISProject.LayerExists(const LayerName: string): Boolean;
begin
  with dm_MainLinkObjects.PublicQuery do
  begin
    Close;
    SQL.Text:='select LayerId from t_Layers where LayerName=:LayerName';
    SetParamValue(dm_MainLinkObjects.PublicQuery, 'LayerName', LayerName);
    Open;
    Result:=(not Eof) and (Fields[0].AsString<>'');
    Close;
  end;
end;

procedure TqcGISProject.ChangeWindowClick(Sender: TObject);
begin
  PostMessage(CallerHandle, WM_CHANGEWINDOW, TMenuItem(Sender).Tag, 0);
end;

procedure TqcGISProject.DownloadBinaryLayer(const UnitID:Integer;
  const LayerName, LocalPath, LocalLayerName: string);
var
  FileName:string;
begin
  {下载图层}
  with dm_MainLinkObjects.ADOQueryFileData do
  begin
    if not Active then Open;
    Filtered:=False;
    Filter:='UnitID='+IntToStr(UnitID)+' and Name like '''+LayerName+'%''';
    Filtered:=True;
    First;
    while not Eof do
    begin
      FileName:=CheckPath(LocalPath)+LocalLayerName+ExtractFileExt(FieldByName('Name').AsString);
      TBlobField(FieldByName('Info')).SaveToFile(FileName);
      Next;
    end;
  end;
  {修改本地最后一次下载日期}
  SetDownloadDate(UnitID, LayerName, Now);
end;

function TqcGISProject.CheckLocalMap: Boolean;
var
  i:Integer;
  Path, TableName, FileName: String;
  List:TStringList;
begin
  Result:=True;
  Path := LocalMapPath;
  List:=TStringList.Create;
  try
    GetUnits(List);
    with dm_MainLinkObjects.PublicQuery2 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select TableName from t_Layers');
      SQL.Add('where DataFrom=2');
      Open;
      First;
      while not Eof do
      begin
        TableName:=Fields[0].AsString;
        if UserUnitType=2 then
        begin
          FileName := Path+TableName+'.TAB';
          if (not FileExists(FileName)) or
             IsOldLayer(CurUnitID,TableName) then
          begin
            Result:=False;
            Exit;
          end;
        end
        else
        begin
          for i:=0 to List.Count-1 do
          begin
            FileName := Path+List.ValueFromIndex[i]+'\'+TableName+'.TAB';
            if (not FileExists(FileName)) or
               IsOldLayer(StrToInt(List.Names[i]),TableName) then
            begin
              Result:=False;
              Exit;
            end;
          end;
        end;
        Next;
      end;
      Close;
    end;
  finally
    List.Free;
  end;
end;

procedure TqcGISProject.DownLoadSystemLayers;
var
  i:Integer;
  Path, TableName, FileName: String;
  List:TStringList;
begin
  List:=TStringList.Create;
  try
    //取得部门列表，形式为：UnitID=UnitName//
    GetUnits(List);
    //创建部门地图的本地存储路径//
    for i:=0 to List.Count-1 do
    begin
      Path:=CheckPath(AppPath)+'Maps\'+List.ValueFromIndex[i];
      if not DirectoryExists(Path) then ForceDirectories(Path);
    end;
    //取得地图路径，当UnitType=2是返回当前部门地图路径，当UnitType=1时
    //返回本地地图全局路径//
    Path := CheckPath(LocalMapPath);
    with dm_MainLinkObjects.PublicQuery2 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('select TableName from t_Layers');
      SQL.Add('where DataFrom=2');
      Open;
      First;
      while not Eof do
      begin
        TableName:=Fields[0].AsString;
        if UserUnitType=2 then
        begin
          FileName := Path+TableName+'.TAB';
          if (not FileExists(FileName)) or IsOldLayer(CurUnitID, TableName) then
            DownloadBinaryLayer(CurUnitID, TableName, Path, TableName);
        end
        else
        begin
          for i:=0 to List.Count-1 do
          begin
            FileName := Path+List.ValueFromIndex[i]+'\'+TableName+'.TAB';
            if (not FileExists(FileName)) or IsOldLayer(StrToInt(List.Names[i]), TableName) then
              DownloadBinaryLayer(StrToInt(List.Names[i]), TableName,
                                  Path+List.ValueFromIndex[i], TableName);
          end;
        end;
        Next;
      end;
      Close;
    end;
  finally
    List.Free;
  end;
end;

procedure TqcGISProject.UpLoadSystemLayers;
var
  i:Integer;
  FindStr:string;
  Path, FileName: String;
  sr: TSearchRec;
  List:TStrings;
begin
  AppPath:=CheckPath(AppPath);
  List:=TStringList.Create;
  try
    GetUnits(List);
    for i:=0 to List.Count-1 do
    begin
      Path := AppPath + '\Maps\'+List.ValueFromIndex[i]+'\';
      FindStr:=Path+'*.*';
      if FindFirst(FindStr, $00000020, sr) = 0 then
      begin
        repeat
          FileName := Path+ sr.Name;
          UpLoadLayerFile(StrToInt(List.Names[i]), FileName);
        until SysUtils.FindNext(sr) <> 0;
        FindClose(sr);
      end;
    end;
  finally
    List.Free;
  end;
end;

procedure TqcGISProject.RegisterCmdCtrlGroups;
begin
  with Form_Main.CmdToolGroups.Items[0] do
  begin
    Add(0, NAddStation, []);
    Add(0, NAddLine, []);
    Add(0, NAddKG, []);
    Add(0, NAddBT, []);
    Add(0, NLinkToPower, []);
  end;
end;

procedure TqcGISProject.EditSystemLayer(LayerId:Integer);
var
  Index:Integer;
  aLyr:Layer;
  LayerNode:TTreeNode;
begin
  aLyr:=GetLayer(LayerId, LayerNode);
  if aLyr=nil then
    WarningAbort('提示', '没有找到子站层！');
  Index:=GetLayerIndex(GMapTools.MapX, aLyr);
  Form_Main.SetLayerEditable(Index, True);