📄 unitqcgisproject.pas
字号:
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 + -