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

📄 unitqcgisproject.pas

📁 此代码是关于mapgis的在
💻 PAS
📖 第 1 页 / 共 5 页
字号:
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 + -