📄 unitqcgisproject.pas
字号:
end;
procedure TqcGISProject.DefConnectToServer;
var
INIF:TIniFile;
Server,UserName,Password:string;
begin
INIF:=TIniFile.Create(CheckPath(AppPath)+'AppInstConfig.ini');
try
Server:=INIF.ReadString('DBConnection', 'Server', '');
UserName:=INIF.ReadString('DBConnection', 'UserName', '');
Password:=INIF.ReadString('DBConnection', 'Password', '');
finally
INIF.Free;
end;
if not ConnectToDataBase(Server,UserName,Password) then
MyDefInformation('连接服务器失败,无法使用服务器功能!');
end;
procedure TqcGISProject.LoadParentInstanceModules;
var
aSubItem:TMenuItem;
aPage:TTabSheet;
begin
if FSubStationFrame=nil then
begin
aPage:=TTabSheet.Create(Form_Main);
aPage.PageControl:=Form_Main.pcControl;
aPage.Caption:='子站状态';
aPage.Name:='tsSubStation';
FSubStationFrame:=TFrame_SubStationData.Create(Form_Main);
with FSubStationFrame do
begin
Parent:=aPage;
Align:=alClient;
end;
end;
case ParentAppId of
//如果内嵌在检测系统中,需要增加切换菜单//
ID_APP_PARENT_JK_GZZ,
ID_APP_PARENT_JK_DDS:begin
if not PIMLoaded then
begin
LoadMenuItem(FRootMenuItem, '-', -1, nil);
aSubItem:=LoadMenuItem(FRootMenuItem, '切换窗口', -1, nil);
LoadMenuItem(aSubItem, '检测窗口', 1, ChangeWindowClick);
LoadMenuItem(aSubItem, '地图窗口', 2, ChangeWindowClick);
LoadMenuItem(aSubItem, '报表窗口', 3, ChangeWindowClick);
PIMLoaded:=True;
end;
end;
end;
end;
procedure TqcGISProject.SubStationWarning(const SubStationId: Integer;
const WarningString: string; BoundSeed:Double);
var
ZKPowerId, GLPower1Id, GLPower2Id:Integer;
ZKPowerState, GLPower1State, GLPower2State:Smallint;
begin
//跳到这个子站//
GoToSubStation(SubStationId, BoundSeed);
//取得开关状态,刷新模拟图状态//
if GetSubStationLinkPowerInfo(SubStationId,
ZKPowerId, GLPower1Id,
GLPower2Id, ZKPowerState,
GLPower1State, GLPower2State) then
begin
//设置开关状态,保存状态到数据库//
SetPowerState(ZKPowerId, ZKPowerState, False, True);
SetPowerState(GLPower1Id, GLPower1State, False, True);
SetPowerState(GLPower2Id, GLPower2State, False, True);
//刷新模拟图//
RefreshSimulantMap;
end;
//显示消息//
with Form_Main do
if RichEdit_UserMsg<>nil then
begin
PageControl1.ActivePage:=tsMessage;
RichEdit_UserMsg.Lines.Add(IntToStr(SubStationId)+'号子站: '+WarningString);
end;
end;
procedure TqcGISProject.DoFeatureDblClick(Sender: TObject; Ft: Feature);
var
aDotId:Integer;
aDotIndex:Integer;
aDot: TDot;
begin
//如果是开关层,则设置开关状态//
if Ft.Layer=FDotLayer then
begin
aDotId:=StrToInt(Ft.KeyValue);
aDotIndex:=DLCtrl.Dots.IndexOf(aDotId);
if aDotIndex>-1 then
begin
aDot:=DLCtrl.Dots.Items[aDotIndex];
if aDot.DotState=dsLink then
SetPowerState(aDot, dsBreak, True, True)
else
SetPowerState(aDot, dsLink, True, True);
end;
end;
end;
procedure TqcGISProject.SetPowerState(aDot: TDot; aState:TDotState;
bAnalyze, bSaveState:Boolean);
begin
with TqcGISProject(MyGIS) do
begin
if aDot.BDSDot then Exit;
DLCtrl.SetDotState(aDot, aState, False);
if bAnalyze then
begin
DLCtrl.AnalyzeState;
RefreshDotState(aDot);
RefreshLineLayerState(True);
end;
end;
if bSaveState then
with GDBPoster do
begin
TableName:='t_CtrlDotsLayer';
SetModifyFields('KgState');
WhereSQL.Text:='DotId=:DotId';
SetCustomValue('KgState', aState=dsLink);
SetParamValue('DotId', aDot.DotId);
EditPost;
end;
end;
procedure TqcGISProject.DownloadSymbolBitmaps(Section:Integer; LocalPath:string);
var
FileName:string;
begin
with dm_MainLinkObjects.PublicQuery do
begin
Close;
SQL.Clear;
SQL.Add('select * from t_Resources');
SQL.Add('where Section='+IntToStr(Section));
Open;
while not Eof do
begin
FileName:=CheckPath(LocalPath)+FieldByName('Name').AsString;
TBlobField(FieldByName('Info')).SaveToFile(FileName);
Next;
end;
end;
end;
procedure TqcGISProject.UpLoadResources(Section:Integer; ResType,
ResPath:string);
var
Path, FileName: String;
sr: TSearchRec;
begin
AppPath:=CheckPath(AppPath);
Path := ResPath + '\*.' + ResType;
if FindFirst(Path, $00000020, sr) = 0 then
begin
with dm_MainLinkObjects.PublicQuery do
begin
Close;
SQL.Text:='select * from t_Resources where Section='+IntToStr(Section);
Open;
repeat
begin
FileName := AppPath +'SymbolBitmaps\'+ sr.Name;
if Locate('Section; Name', VarArrayOf([Section, sr.Name]), [loCaseInsensitive]) then
Edit
else
Append;
FieldByName('Section').AsInteger := Section;
FieldByName('Name').AsString := sr.Name;
FieldByName('Type').AsString := ResType;
TBlobField(FieldByName('Info')).LoadFromFile(FileName);
Post;
end;
until SysUtils.FindNext(sr) <> 0;
Close;
end;
FindClose(sr);
end;
end;
procedure TqcGISProject.ConnectClick(Sender: TObject);
var
INIF:TIniFile;
begin
INIF:=TIniFile.Create(CheckPath(AppPath)+'AppInstConfig.ini');
try
case ReDirectSQLServer(INIF, dsKeepState) of
dsDisConnected:begin
MyDefInformation('连接服务器失败,系统将要重新启动!');
Application.Terminate;
end;
dsConnected:begin
//EXE程序登陆,需要使用对话框获取用户信息;其它方式登陆,使用函数//
if AppType=atExe then ConnectUseDialog;
//如果连接到服务器,则调用DoAfterConnect进一步设置//
if Connected then DoAfterUserConnect;
end;
end;
finally
INIF.Free;
end;
end;
procedure TqcGISProject.ReInitServerPart;
procedure InitSubMapItems;
begin
Form_Main.cb_Maps.Clear;
with dm_MainLinkObjects.PublicQuery do
begin
Close;
SQL.Text:='select * from t_Units order by UnitID';
Open;
while not Eof do
begin
Form_Main.cb_Maps.Items.Add(FieldByName('UnitName').AsString);
Next;
end;
Close;
end;
end;
var
Path:string;
begin
//-------------------------------------------------------------------------//
if not dm_Links.DBMachine1.Connected then Exit;
//-------------------------------------------------------------------------//
//从数据库加载图标到MapX图标文件夹//
Path:=CheckPath(AppPath)+'SymbolBitmaps';
if not DirectoryExists(Path) then
ForceDirectories(Path);
DownloadSymbolBitmaps(1, Path);
LoadSymbolBitmaps(Path, True);
//-------------------------------------------------------------------------//
InitSubMapItems;
//-------------------------------------------------------------------------//
end;
procedure TqcGISProject.UpLoadLayerFile(const UnitID:Integer;
const FileName:string);
var
ShortFileName:string;
begin
{上传图层}
ShortFileName:=ExtractFileName(FileName);
with dm_MainLinkObjects.PublicQuery do
begin
Close;
SQL.Text:='select * from t_Maps where UnitID=:UnitID and Name=:Name';
SetParamValue(dm_MainLinkObjects.PublicQuery, 'UnitID', UnitID);
SetParamValue(dm_MainLinkObjects.PublicQuery, 'Name', ShortFileName);
Open;
if (not Eof)and(FieldByName('Name').AsString<>'') then
Edit
else
Append;
FieldByName('UnitID').AsInteger := UnitID;
FieldByName('Name').AsString := ShortFileName;
TBlobField(FieldByName('Info')).LoadFromFile(FileName);
Post;
end;
{修改服务器图层日期}
GDBPoster.TableName:='t_UpLoadTime';
GDBPoster.SetInsertFields('UnitID,TableName,ModifyTime,ModifyUser');
GDBPoster.SetModifyFields('ModifyTime,ModifyUser');
GDBPoster.WhereSQL.Text:='UnitID=:UnitID and TableName=:TableName';
GDBPoster.SetCustomValue('UnitID', UnitID);
GDBPoster.SetCustomValue('TableName', ExtractFileNameNoExt(ShortFileName));
GDBPoster.SetCustomValue('ModifyTime', Now);
GDBPoster.SetCustomValue('ModifyUser', App_UserInfo.UserName);
GDBPoster.SetParamValue('UnitID', UnitID);
GDBPoster.SetParamValue('TableName', ExtractFileNameNoExt(ShortFileName));
GDBPoster.IniPost;
{修改本地最后一次下载日期}
SetDownloadDate(UnitID, ExtractFileNameNoExt(ShortFileName), Now);
end;
procedure TqcGISProject.LoadMaps(const ItemIndex: Integer);
procedure LoadCurUnitInfo;
begin
with dm_MainLinkObjects.PublicQuery do
begin
Close;
SQL.Text:='select * from t_Units where UnitName=:UnitName';
SetParamValue(dm_MainLinkObjects.PublicQuery, 'UnitName', CurUnitName);
Open;
FCurUnitID:=FieldByName('UnitID').AsInteger;
FDLCtrl.UnitID:=FCurUnitID;
Close;
end;
end;
var
ANode:TTreeNode;
begin
//-------------------------------------------------------------------------//
if not dm_Links.DBMachine1.Connected then Exit;
//-------------------------------------------------------------------------//
//初始化前检查//
if SysTree=nil then
raise Exception.Create('变量 SysTree 没有初始化,无法加载GIS系统实例信息!');
//-------------------------------------------------------------------------//
LoadCurUnitInfo;
//加载图层树信息//
LoadLayerTreeInfo;
//-------------------------------------------------------------------------//
//检查本地图层是否完整,如果不完整,则提示是否自动下载服务器图层//
if CheckLocalMap=False then
begin
if MyConfirmation('提示', '本地地图不完整,是否从服务器下载?', False) then
DownLoadSystemLayers;
end;
//-------------------------------------------------------------------------//
//加载图层,并设置图层的可见性,是否可编辑,默认样式//
LoadAndInitMap;
//保存各个系统图层对象,这样操作图层速度快//
FUserLayer:=GetLayer(LAYER_SYS_USER, ANode);
FSubStationLayer:=GetLayer(LAYER_SYS_SUBSTATION, ANode);
FDotLayer:=GetLayer(LAYER_SYS_POWER, ANode);
FLineLayer:=GetLayer(LAYER_SYS_LINE, ANode);
FBTLayer:=GetLayer(LAYER_SYS_BT, ANode);
FWaterSystemLayer:=GetLayer(LAYER_SYS_WARTERSYS, ANode);
FRoadLayer:=GetLayer(LAYER_SYS_ROAD, ANode);
FBuildingLayer:=GetLayer(LAYER_SYS_BUILDING, ANode);
FBottomLayer:=GetLayer(LAYER_SYS_BOTTOM, ANode);
//-------------------------------------------------------------------------//
//加载模拟数据//
DLCtrl.LoadFromDataBase(dm_MainLinkObjects.PublicQuery);
//刷新模拟图//
RefreshSimulantMap;
//-------------------------------------------------------------------------//
//地图视口调整//
GMapTools.m_Map.ViewGlobalMap;
//应验窗口初始化//
Form_Main.InitEyeForm;
//-------------------------------------------------------------------------//
end;
function TqcGISProject.GetCurUnitName: string;
begin
Result:=Form_Main.cb_Maps.Items[Form_Main.cb_Maps.ItemIndex];
end;
function TqcGISProject.GetLocalMapPath: string;
begin
AppPath:=CheckPath(AppPath);
if UserUnitType=2 then
Result:=AppPath+'Maps\'+CurUnitName+'\'
else
Result:=AppPath+'Maps\';
end;
function TqcGISProject.Connect(const UserName, Password: string): Boolean;
begin
TQCUserInfo(App_UserInfo).LoadInfo(UserName, Password);
Result:=App_UserInfo.UserExists;
DebugLog.Add('DB500TS-C', ['用户【'+UserName+'】合法,允许登陆']);
//如果连接到服务器,则调用DoAfterConnect进一步设置//
if Result then DoAfterUserConnect;
end;
function TqcGISProject.ConnectUseDialog: Boolean;
const
TestCount=3;
var
i:integer;
userCode,userPassword:string;
begin
Result:=False;
for i:=1 to TestCount do
begin
if not GetUserInfo(userCode,userPassword) then
begin
MyInformation('登陆系统', '您已取消登陆,只能使用本地功能!');
Exit;
end;
TQCUserInfo(App_UserInfo).LoadInfo(userCode,userPassword);
Result:=App_UserInfo.UserExists;
if Result then Exit;
if i>=TestCount then
begin
MyInformation('登陆系统', '超过'+IntToStr(TestCount)+'次,只能使用本地功能!');
Exit;
end;
MyInformation('登陆系统', '用户不存在或口令错误,请重试!');
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -