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

📄 unitqcgisproject.pas

📁 此代码是关于mapgis的在
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit UnitQCGISProject;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Forms, Graphics,
  Dialogs, MapXLib_TLB, Grids, yhbGrid, Buttons, DB, MapXTools, Controls, 
  ADODB, TFlatEditUnit, ComCtrls, Menus, ExtCtrls, ToolWin, MapXContainer,
  AppCmdCtrl, jpeg, DBTrees, VirtualDBEngine, WinControl, MapXDrv, MapXBase,
  DLControl, DBTools, UnitProject, UnitSubStationData, mis_RightDBStore,
  AnyPoster, DBM_MSSQL, DLRight, ActiveX, UnitAppTypes, AnyDBFactory,
  UnitQCConsts, IniFiles, UnitRecords;
  
type
  TDirectState=(dsKeepState, dsDisConnected, dsConnected);
  {七厂GIS工程类}
  TqcGISProject=class(TGISProject)
  private
    //---------------------------------------------------------------------//
    FDLCtrl:TDLControl;
    FRootMenuItem:TMenuItem;
    NAddStation:TMenuItem;
    NAddLine:TMenuItem;
    NAddKG:TMenuItem;
    NAddBT:TMenuItem;
    NLinkToPower:TMenuItem;
    NUserRight:TMenuItem;
    NReDirectServer:TMenuItem;
    NUpLoad:TMenuItem;
    NDownLoad:TMenuItem;
    NConfigPopedom:TMenuItem;
    NShapeProperties:TMenuItem;
    NConfigBDS:TMenuItem;
    PIMLoaded: Boolean;
    FDataFrom: Integer;
    {子站当前状态Frame}
    FSubStationFrame:TFrame_SubStationData;
    {SQLServer数据库管理者,因为物理数据库的不同导致了SQL语句的细微差别,
    数据库管理者就是为外界提供所需的SQL语句或子句}
    FDBManager:TSQLServerDBManager;
    {数据工厂对象}
    FDBFactory:TAnyDBFactory;
    {用户层}
    FUserLayer:CMapXLayer;
    {线路层}
    FLineLayer:CMapXLayer;
    {变压器层}
    FBTLayer:CMapXLayer;
    {开关层}
    FDotLayer:CMapXLayer;
    {子站层}
    FSubStationLayer:CMapXLayer;
    {水系层}
    FWaterSystemLayer:CMapXLayer;
    {道路层}
    FRoadLayer:CMapXLayer;
    {建筑物层}
    FBuildingLayer:CMapXLayer;
    {底图层}
    FBottomLayer:CMapXLayer;
    {当前变电所编号}
    FCurUnitID:Integer;
    {随机模拟开关状态的Timer}
    FPowerTimer:TTimer;
    //---------------------------------------------------------------------//
    {设置某个系统图层为编辑状态}
    procedure EditSystemLayer(LayerId:Integer);
    procedure DefConnectToServer;
    procedure ReInitServerPart;
    {加载图层树
        如果为系统管理员,可以维护图层树。维护内容包括:增加图层,图层属性,删除图
    层,拖动图层。拖动图层时:当FeatureClass中只有一个图层时,FeatureClass的编号变
    化。
        如果为一般用户,则可以查看图层属性,但不能修改。}
    procedure CreateFeatureClassNode(const FCId:Integer;
      ATreeView:TTreeView; ATreeNode:TTreeNode);
    procedure LoadLayerTreeInfo;
    procedure LoadAndInitMap;
    function IsOldLayer(aUnitID:Integer; aTableName:string):Boolean;
    procedure SetDownloadDate(aUnitID:Integer; aTableName:string;
      aDownDate:TDateTime);
    {加载地图内容}
    function CheckLocalMap:Boolean;
    procedure DownloadSymbolBitmaps(Section:Integer; LocalPath:string);
    procedure DownloadBinaryLayer(const UnitID:Integer;
      const LayerName, LocalPath, LocalLayerName:string);
    procedure DownLoadSystemLayers;
    {从系统表创建图层}
    procedure CreateLayerFromTable(aLayerInfo:TLayerTreeNodeRecord;
      const Index:Integer);
    {上载地图}
    procedure UpLoadResources(Section:Integer; ResType, ResPath:string);
    procedure UpLoadLayerFile(const UnitID:Integer; const FileName:string);
    procedure UpLoadSystemLayers;
    {加载一个菜单项}
    function LoadMenuItem(aPItem:TMenuItem; const Caption:string;
      const Tag:Integer; ClickProc:TNotifyEvent):TMenuItem;
    //---------------------------------------------------------------------//
    function ReDirectSQLServer(INIF:TIniFile; PState:TDirectState):TDirectState;
    //---------------------------------------------------------------------//
    {连接服务器菜单事件处理过程}
    procedure ConnectClick(Sender: TObject);
    {上载图层菜单事件处理过程}
    procedure UpLoadClick(Sender: TObject);
    {下载图层菜单事件处理过程}
    procedure DownLoadClick(Sender: TObject);
    {增加子站菜单事件处理过程}
    procedure AddStationClick(Sender: TObject);
    {增加线路菜单事件处理过程}
    procedure AddLineClick(Sender: TObject);
    {增加开关菜单事件处理过程}
    procedure AddKGClick(Sender: TObject);
    {增加变台菜单事件处理过程}
    procedure AddBTClick(Sender: TObject);
    {分析子站是否关联记录}
    procedure AnalyzeSubStationClick(Sender: TObject);
    {分析开关是否关联记录}
    procedure AnalyzePowerClick(Sender: TObject);
    {分析线路是否关联记录}
    procedure AnalyzeSDLineClick(Sender: TObject);
    {分析线路是否关联开关}
    procedure AnalyzeLinkPowerClick(Sender: TObject);
    {输电线路关联到开关}
    procedure LinkToPowerClick(Sender: TObject);
    {装载电力模拟数据}
    procedure LoadDLControlDataClick(Sender: TObject);
    {随机演示开关状态}
    procedure RandomPowerStateClick(Sender: TObject);
    {图形属性信息菜单事件处理过程}
    procedure ShapePropertiesClick(Sender: TObject);
    {窗口切换菜单事件处理过程}
    procedure ChangeWindowClick(Sender: TObject);
    {权限分配}
    procedure ConfigPopedomClick(Sender: TObject);
    {重新连接}
    procedure ReConnectClick(Sender: TObject);
    {重新登陆}
    procedure CheckPasswordClick(Sender: TObject);
    {图形类是否存在}
    function FeatueClassExists(const FCId:Integer):Boolean;
    {如果连接到数据库,则进一步设置}
    procedure DoAfterUserConnect;
    {图层是否存在}
    function LayerExists(const LayerName:string):Boolean;
    {取得单位名称}
    function GetCurUnitName: string;
    {取得系统图层路径,注意:和具体单位有关}
    function GetLocalMapPath: string;
    function GetConnected: Boolean;
    procedure GetUnits(List:TStrings);
    function GetUserUnitType: Integer;
    procedure AnalyzeFeatures(ALyr:Layer; Fts:Features; FtType:TOLEEnum;
      WarningColor:TColor);
    procedure PowerTimerOnTimer(Sender:TObject);
    //---------------------------------------------------------------------//
  protected
    FirstFeature:Boolean;
    FirstFeatureKeyValue:string;
    {数据提交者,对有必要隐藏的SQL语句进行了隔离处理,对于变成者来说,
    编写提交数据的代码将更加简洁}
    GDBPoster:TDBPosterWithSQL;
    {取得图层的图形类编号}
    function GetLayerFeatureId(ALyr:Layer):Integer;
    {注册本GIS实例所需的风格}
    procedure RegisterProjectStyles; override;
    {注册本GIS实例所需的工具}
    procedure RegisterProjectTools; override;
  public
    //---------------------------------------------------------------------//
    constructor Create(AOwner:TComponent; MapX:TMapXObject); override;
    destructor Destroy; override;
    //---------------------------------------------------------------------//
    {应用权限}
    procedure DoApplayFunctions; override;
    {检查是否有权操作}
    function CheckFunction(ActionId:Integer):Boolean; override;
    {显示属性对话框}
    procedure DoOnCtrlPropDialog(Sender:TObject; ActionId:Integer; Ft:Feature); override;
    {开始动作}
    procedure DoBeginAction(ActionId:Integer; var Cancel:Boolean); override;
    {结束动作}
    procedure DoEndAction(ActionId:Integer); override;
    {图形删除前}
    procedure DoBeforeDelete(Ft:Feature; ActionId:Integer); override;
    {图形创建后}
    procedure DoFeatureCreate(Ft:Feature; ActionId:Integer); override;
    {填写网格数据}
    function DoWriteDataGridData(AGridFrame:TFrame_Records):Boolean; override;
    //---------------------------------------------------------------------//
    {增加本地图层到工程}
    procedure AddLayerToProject(ALyr:CMapXLayer; aLayerInfo:TLayerTreeNodeRecord;
      const FCId:Integer); override;
    {从工程下载图层}
    procedure DownloadProjectLayer(ALyr:CMapXLayer; aLayerInfo:TLayerTreeNodeRecord;
      const LayerName, Path:string); override;
    {创建业务菜单项}
    procedure LoadBusinessMenuItems(AMenuItem:TMenuItem); override;
    {工程实例加载,包括连接数据库、加载所有系统图层等操作}
    procedure LoadProject; override;
    {连接数据库}
    function ConnectToDataBase(const Server, UserName, Password:string):Boolean;
    {登陆到服务器}
    function Connect(const UserName, Password:string):Boolean;
    {用对话框登陆}
    function ConnectUseDialog:Boolean;
    {加载地图}
    procedure LoadMaps(const ItemIndex:Integer); override;
    procedure SetCurrentUnit(const UnitID:Integer);
    {注册命令}
    procedure RegisterCmdCtrlGroups; override;
    {刷新开关显示}
    procedure RefreshDotState(aDot:TDot);
    {刷新所有开关显示}
    procedure RefreshAllDotState;
    {刷新电路状态显示}
    procedure RefreshLineLayerState(const bChanged:Boolean);
    {监控扩展菜单}
    procedure LoadParentInstanceModules; override;
    {刷新模拟图}
    procedure RefreshSimulantMap; 
    {选择子站当前状态刷新}
    procedure RefreshSelectedSubStationsState;
    {取得子站关联的开关及其当前状态}
    function GetSubStationLinkPowerInfo(const SubStationId:Integer;
      var ZKPowerId, GLPower1Id, GLPower2Id:Integer;
      var ZKPowerState, GLPower1State, GLPower2State:Smallint):Boolean;
    {子站报警}
    procedure SubStationWarning(const SubStationId:Integer;
      const WarningString:string; BoundSeed:Double);
    {定位子站}
    procedure GoToSubStation(const SubStationId:Integer; BoundSeed:Double);
    {设置开关状态}
    procedure SetPowerState(aDot:TDot; aState:TDotState; bAnalyze,
      bSaveState:Boolean); overload;
    {设置开关状态}
    procedure SetPowerState(const PowerId:Integer; aState:Smallint; bAnalyze,
      bSaveState:Boolean); overload;
    {双击}
    procedure DoFeatureDblClick(Sender:TObject; Ft:Feature); override;
    procedure InitLineLayerRecords;
    procedure InitDotLayerRecords;
    //---------------------------------------------------------------------//
    property DLCtrl:TDLControl read FDLCtrl;
    property SubStationLayer:CMapXLayer read FSubStationLayer;
    property DotLayer:CMapXLayer read FDotLayer;
    property LineLayer:CMapXLayer read FLineLayer;
    property DataFrom:Integer read FDataFrom write FDataFrom;
    property UserUnitType:Integer read GetUserUnitType;
    property CurUnitID:Integer read FCurUnitID;
    property CurUnitName:string read GetCurUnitName;
    property LocalMapPath:string read GetLocalMapPath;
    property Connected:Boolean read GetConnected;
    property DefDBPoster:TDBPosterWithSQL read GDBPoster;
    //---------------------------------------------------------------------//
  end;

implementation

uses
  UnitDMLinks, UnitMainLinkObjects, BusinessDialogs, MapXStyles, MapXAPIs,
  MapXAdvance, MapXConsts, MapXMessages, UnitLineInfo, UnitPowerInfo, IntList,
  ADODBTools, StringOperations, WinFileSystem, MainFormInstance, DBBase,
  UnitGetUserInfo, mis_Instance, UnitQCProjectTools, UnitConnectToSQLServerDB,
  ADOConnection, UnitGISShell, UnitShellAPIs, UnitAppConsts, UnitQCAPIs,
  UnitEagleEye, UnitPopedomInfo, mis_Right, UnitChangePassword,
  UnitQCProjectOptions, AppDebug, TypInfo, UnitSubStationInfo, DBS_MSSQL;
  
{ TqcGISProject }

function GetPowerLocalState(strState:string):SmallInt;
begin
  strState:=Trim(strState);
  if strState='开' then
    Result:=1
  else if strState='关' then
    Result:=0
  else
    Result:=-1;
end;

procedure TqcGISProject.AddBTClick(Sender: TObject);
begin
  EditSystemLayer(LAYER_SYS_BT);
end;

procedure TqcGISProject.AddKGClick(Sender: TObject);
begin
  EditSystemLayer(LAYER_SYS_POWER);
  SetCurrentMapTool('TAddKGLineMapTool', OnTurnTool);
end;

procedure TqcGISProject.AddLayerToProject(ALyr: CMapXLayer;
  aLayerInfo:TLayerTreeNodeRecord; const FCId:Integer);
var
  LayerId:Integer;
  Path:string;
  TableName:string;
  ANode:TTreeNode;
begin
  if not dm_Links.DBMachine1.Connected then Exit;
  Path:=CheckPath(ExtractFilePath(aLayerInfo.FileName));
  TableName:=ExtractFileNameNoExt(aLayerInfo.FileName);
  {图形类是否存在}
  if not FeatueClassExists(FCId) then
    raise Exception.Create('图形类不存在!');
  {图层是否存在}
  if LayerExists(ALyr.Name) then
    raise Exception.Create('工程中存在同名图层,请重新命名后加入!');
  case DataFrom of
    1:begin
      {将数据导入到表中}
      with GMapTools.m_Layer do
      begin
        Layer:=aLyr;
        SaveFeaturesToTable(dm_MainLinkObjects.PublicQuery,
                         aLyr.DataSets.Item[1],
                         dbtSQLServer,
                         TableName);
      end;
    end;
    2:begin
      UpLoadLayerFile(CurUnitID, Path+TableName+'.DAT');
      UpLoadLayerFile(CurUnitID, Path+TableName+'.ID');
      UpLoadLayerFile(CurUnitID, Path+TableName+'.MAP');
      UpLoadLayerFile(CurUnitID, Path+TableName+'.TAB');
    end;
    else begin
      WarningAbort('错误', '无法识别图层存储标志!');
    end;
  end;
  {记录图层信息}
  LayerId:=GetNewIntID(dm_MainLinkObjects.PublicQuery, 't_Layers', 'LayerId', '', 1);
  with dm_MainLinkObjects.PublicQuery do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from t_Layers where LayerId=:LayerId');
    SetParamValue(dm_MainLinkObjects.PublicQuery, 'LayerId', -1);
    Open;
    Append;
    FieldByName('LayerId').Value:=LayerId;
    FieldByName('LayerName').Value:=ALyr.Name;
    FieldByName('LayerIndex').Value:=1;
    FieldByName('FCId').Value:=FCId;
    FieldByName('LayerType').Value:=1;
    FieldByName('Visible').Value:=aLyr.Visible;
    FieldByName('DataFrom').Value:=DataFrom;
    FieldByName('TableName').Value:=TableName;
    FieldByName('SysCfg').Value:='InitBounds='+GetBoundsString(GMapTools.MapX.Bounds)+';KeyField=;Caption=;ShowCaption=False';
    FieldByName('UserCfg').Value:='';
    FieldByName('CDataTime').Value:=Now;
    FieldByName('CUser').Value:='';
    FieldByName('LMDateTime').Value:=Now;
    FieldByName('LMUser').Value:='';
    Post;
  end;  
  {增加图层类的LayerCount}
  with dm_MainLinkObjects.PublicQuery do
  begin
    Close;
    SQL.Clear;
    SQL.Add('update t_FeatureClasses set LayerCount=LayerCount+1');
    SQL.Add('where FCId=:FCId');
    SetParamValue(dm_MainLinkObjects.PublicQuery, 'FCId', FCId);
    ExecSQL;
  end;
  {删除原有节点,增加新节点}
  ANode:=FindFeatureClassNode(FCId);
  AddLayerNode(SysTree, ANode, naAddChildFirst,
               -1, aLyr.Name, aLayerInfo.FileName, False, 2, -1, 3);
  ANode:=FindLayerNode(ALyr);
  DeleteNode(ANode);
end;

procedure TqcGISProject.AddLineClick(Sender: TObject);
begin
  EditSystemLayer(LAYER_SYS_LINE);
  SetCurrentMapTool('TAddSDLineMapTool', OnTurnTool);
end;

procedure TqcGISProject.AddStationClick(Sender: TObject);
begin
  EditSystemLayer(LAYER_SYS_SUBSTATION);
  SetCurrentMapTool('TAddSubStationMapTool', OnTurnTool);
end;

constructor TqcGISProject.Create(AOwner:TComponent; MapX:TMapXObject);
begin
  inherited Create(AOwner, MapX);

  RegOwnerName:='大庆采油七厂';
  ProjectName:=RegOwnerName+'电力监控系统 -- 地理信息子系统';

  FDBManager:=TSQLServerDBManager.Create;
  GDBPoster:=TDBPosterWithSQL.Create;
  GDBPoster.DBManager:=FDBManager;
  FDBFactory:=TAnyDBFactory.Create;
  FDBFactory.DBManager:=FDBManager;

⌨️ 快捷键说明

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