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