frmmain.frm

本系统是一个报表分析查询系统

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.ocx"
Object = "{7DB16ABC-EB77-4367-ABFC-A99311A23C80}#3.0#0"; "Office2007Top.ocx"
Object = "{08134D0F-33EF-4084-A641-6410AE55BBA6}#1.0#0"; "XhuiActX.ocx"
Object = "{D05C3AD7-7EF1-4749-885E-A2006408FC13}#1.0#0"; "VsListview.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form FrmMain 
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   5730
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8610
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5730
   ScaleWidth      =   8610
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSWinsockLib.Winsock frmLink 
      Left            =   4080
      Top             =   2640
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog frmSave 
      Left            =   4080
      Top             =   2640
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin Office2007Top.ACPRibbon TBar 
      Height          =   735
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   8610
      _ExtentX        =   15187
      _ExtentY        =   1296
   End
   Begin vsListViewXP.vsListView HMenu 
      Height          =   3615
      Left            =   2640
      TabIndex        =   2
      Top             =   1080
      Width           =   4935
      _ExtentX        =   8705
      _ExtentY        =   6376
   End
   Begin XhuiActX.ctlExplorerBar VMenu 
      Height          =   4095
      Left            =   0
      TabIndex        =   1
      Top             =   840
      Width           =   2175
      _ExtentX        =   3836
      _ExtentY        =   7223
   End
   Begin ActiveBar2LibraryCtl.ActiveBar2 SBar 
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   5160
      Width           =   7815
      _LayoutVersion  =   1
      _ExtentX        =   13785
      _ExtentY        =   873
      _DataPath       =   ""
      Bands           =   "frmMain.frx":038A
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private imgStd As StdPicture
Private ImgPath As String
Private RmID As Long
Private SmID As Long
Private SmItemID As Long

Private Sub LoadFrm()
  ImgPath = App.Path & "\ResLib\"
  With Me
   .Width = Screen.Width * 0.7
   .Height = Screen.Height * 0.6
   .Caption = AppTitle
  End With
  RmID = 1
  SmID = 1
'  If obj.GetServerDate(1) > "2007-07-31" Then
'   End
'  End If
End Sub

''//装载工具栏
Private Sub LoadTBar()
 With TBar
  .Left = 0
  .Top = 0
  .Width = Me.ScaleWidth
  .Caption = AppTitle
  Set imgStd = LoadPicture(ImgPath & "App.Ico")
  Set .Picture = imgStd
  .ShowCustomMenu = False
  Set imgStd = LoadPicture(ImgPath & "exit.Ico")
  .AddTopButton "001", "关闭系统", imgStd
 End With
End Sub

''//装在状态条
Private Sub LoadSBar()
 Dim Tool As ActiveBar2LibraryCtl.Tool
 Dim Band As ActiveBar2LibraryCtl.Band
 '//初始化状态条
 With SBar
  .Left = 0
  .Width = Me.ScaleWidth
  .Height = 350
  .Top = Me.ScaleHeight - .Height
  .Picture = LoadPicture(ImgPath & "SBarBack.Gif")
 End With
 '//添加用户图标
 Set Tool = SBar.Tools.Add(1, "UserImg")
 With Tool
  .Height = SBar.Height
  .Alignment = ddACenterTop
  .ControlType = ddTTButton
  .SetPicture ddITNormal, LoadPicture(ImgPath & "User.Ico")
  .Style = ddSIcon
 End With
 '//添加用户名称
 Set Tool = SBar.Tools.Add(2, "UserName")
 With Tool
  .Height = SBar.Height
  .Alignment = ddALeftCenter
  .Caption = obj.getItemName(12, UserID)
  .ControlType = ddTTLabel
  .CaptionPosition = ddCPStandard
  .LabelBevel = ddLBInset
  .LabelStyle = ddLSNormal
  .Width = SBar.Width * 0.1
 End With
 '//添加主信息
 Set Tool = SBar.Tools.Add(3, "MainMsg")
 With Tool
  .Height = SBar.Height
  .Alignment = ddACenterCenter
  .Caption = "准备就绪"
  .ControlType = ddTTLabel
  .CaptionPosition = ddCPStandard
  .LabelBevel = ddLBInset
  .LabelStyle = ddLSNormal
  .Width = SBar.Width * 0.5
 End With
 '//添加时间图形
 Set Tool = SBar.Tools.Add(4, "DateImg")
 With Tool
  .Height = SBar.Height
  .Alignment = ddACenterTop
  .ControlType = ddTTButton
  .SetPicture ddITNormal, LoadPicture(ImgPath & "Timer.Ico")
  .Style = ddSIcon
 End With
 '//添加时间值
 Set Tool = SBar.Tools.Add(5, "DateVal")
 With Tool
  .Height = SBar.Height
  .Alignment = ddACenterCenter
  .Caption = obj.getServerDate(1)
  .ControlType = ddTTLabel
  .CaptionPosition = ddCPStandard
  .LabelBevel = ddLBInset
  .LabelStyle = ddLSNormal
  .Width = SBar.Width * 0.1
 End With
 '//
 Set Tool = SBar.Tools.Add(6, "Inst")
 With Tool
  .Height = SBar.Height
  .Alignment = ddACenterCenter
  .ControlType = ddTTLabel
  .CaptionPosition = ddCPStandard
  .LabelBevel = ddLBInset
  .LabelStyle = ddLSInsert
 End With
 Set Band = SBar.Bands.Add("TSBar"): Band.Type = ddBTStatusBar
 With Band.Tools
  .Insert .Count, SBar.Tools("UserImg")
  .Insert .Count, SBar.Tools("UserName")
  .Insert .Count, SBar.Tools("MainMsg")
  .Insert .Count, SBar.Tools("DateImg")
  .Insert .Count, SBar.Tools("DateVal")
  .Insert .Count, SBar.Tools("Inst")
 End With
 SBar.RecalcLayout
 SBar.Refresh
End Sub

Private Sub LoadMenu()
 With VMenu
  .Top = TBar.Top + TBar.Height
  .Left = 0
  .Height = SBar.Top - .Top
  .Width = Me.ScaleWidth * 0.4
  '//
  .AddSpecialItem "设置", , LoadPicture(ImgPath & "VMenu.Ico"), LoadPicture(ImgPath & "VMenuBack.Jpg")
  .AddSubItem 1, "资料设置", LoadPicture(ImgPath & "SystemCfg.Ico")
  '----
  .AddSpecialItem "报表管理", , LoadPicture(ImgPath & "Forms.Ico"), LoadPicture(ImgPath & "VMenuBack.Jpg")
  .AddSubItem 2, "报表设计", LoadPicture(ImgPath & "NewForm.Ico")
  .AddSubItem 2, "报表列表", LoadPicture(ImgPath & "ListForm.Ico")
  '----
  .AddSpecialItem "数据编辑", , LoadPicture(ImgPath & "TextEdit.Ico"), LoadPicture(ImgPath & "VMenuBack.Jpg")
  .AddSubItem 3, "数据编辑", LoadPicture(ImgPath & "CSave.ico")
 End With
End Sub

Private Sub LoadhMenu()
 With HMenu
  .Top = VMenu.Top
  .Left = VMenu.Left + VMenu.Width
  .Width = Me.ScaleWidth - VMenu.Width
  .Height = VMenu.Height
  Call .Initialize
  Call .InitializeImageListSmall
  Call .InitializeImageListLarge
  Call .InitializeImageListHeader
  Call .ImageListLarge_AddBitmap(LoadResPicture(101, vbResBitmap), vbMagenta) '//用户组
  Call .ImageListLarge_AddBitmap(LoadResPicture(102, vbResBitmap), vbMagenta) '//用户
  Call .ImageListLarge_AddBitmap(LoadResPicture(103, vbResBitmap), vbMagenta) '//用户导入
  Call .ImageListLarge_AddBitmap(LoadResPicture(104, vbResBitmap), vbMagenta) '//报表组
  Call .ImageListLarge_AddBitmap(LoadResPicture(105, vbResBitmap), vbMagenta) '//登录方案
  Call .ImageListLarge_AddBitmap(LoadResPicture(106, vbResBitmap), vbMagenta) '//权限方案
  Call .ImageListLarge_AddBitmap(LoadResPicture(107, vbResBitmap), vbMagenta) '//权限设置
  Call .ImageListLarge_AddBitmap(LoadResPicture(108, vbResBitmap), vbMagenta) '//数据导入
  Call .ImageListLarge_AddBitmap(LoadResPicture(109, vbResBitmap), vbMagenta) '//数据导出
  Call .ImageListLarge_AddBitmap(LoadResPicture(110, vbResBitmap), vbMagenta) '//系统升级
  Call .ImageListLarge_AddBitmap(LoadResPicture(111, vbResBitmap), vbMagenta) '//报表设计
  Call .ImageListLarge_AddBitmap(LoadResPicture(112, vbResBitmap), vbMagenta) '//报表列表
  Call .ImageListLarge_AddBitmap(LoadResPicture(113, vbResBitmap), vbMagenta) '//数据编辑
  Call .ImageListLarge_AddBitmap(LoadResPicture(114, vbResBitmap), vbMagenta) '//修改密码
  .ViewMode = vmIcon
  Call SysCfg
  .RaiseSubItemPrePaint = True
  .BackgroundPictureSet ImgPath & "VmenuBack.Jpg"
 End With
End Sub

'//开始连接服务器
Private Function CValidate() As Boolean
' frmLink.RemotePort = obj.getSystemKey("ServerPort")
' Call frmLink.Connect(obj.getSystemKey("ServerIP"))
' While 1 = 1
'  TBar.Caption = frmLink.State
'  If frmLink.State = 7 Then Exit Function
'  DoEvents
' Wend
 '//MsgBox obj.getSystemKey("ServerPort") & "::" & obj.getSystemKey("ServerIP")
' While 1 = 1
'  Select Case frmLink.State
'   Case sckClosed, sckClosing, sckError
'    Call frmLink.Connect(obj.getSystemKey("ServerIP"))
'   Case sckConnected
'    MsgBox sckConnected
'    Exit Function
'   Case Else
'    MsgBox frmLink.State
'  End Select
' Wend
End Function

Private Sub Form_Load()
 Call CValidate
 Call LoadFrm
 Call LoadTBar
 Call LoadSBar
 Call LoadMenu
 Call LoadhMenu
End Sub

Private Sub SysCfg()
 '//系统设置
 With HMenu
  .Clear
  .ItemAdd 1, "修改密码", 0, 13
  .ItemAdd 2, "用_户_组", 0, 0
  .ItemAdd 3, "管理用户", 0, 1
  .ItemAdd 4, "用户导入", 0, 2
  .ItemAdd 5, "报_表_组", 0, 3
  .ItemAdd 6, "登录方案", 0, 4
  .ItemAdd 7, "权限方案", 0, 5
  .ItemAdd 8, "权限设置", 0, 6
  .ItemAdd 9, "数据导出", 0, 7
  .ItemAdd 10, "数据导入", 0, 8
  .ItemAdd 11, "系统升级", 0, 9
  .RaiseSubItemPrePaint = True
 End With
End Sub

Private Sub NewRpt()
 '//报表设计
 With HMenu
  .Clear