?? 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 + -