frmmain.frm

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

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{709F7AE3-E049-11D2-9362-00403332E72F}#1.0#0"; "LEDGER50.OCX"
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Object = "{54FC599E-9611-11D2-8350-E97AACC90D73}#1.1#0"; "SpltrBar.ocx"
Begin VB.Form frmMain 
   Caption         =   "Form1"
   ClientHeight    =   7950
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   10545
   LinkTopic       =   "Form1"
   ScaleHeight     =   7950
   ScaleWidth      =   10545
   StartUpPosition =   2  '屏幕中心
   Begin SplitterBars.VSplitterBar frmSplit 
      Height          =   5055
      Left            =   3840
      Top             =   2280
      Width           =   30
      _ExtentX        =   53
      _ExtentY        =   8916
      BackColor       =   -2147483635
   End
   Begin CELL50Lib.Cell frmCell 
      Height          =   2295
      Left            =   4920
      TabIndex        =   3
      Top             =   3120
      Width           =   1695
      _Version        =   65536
      _ExtentX        =   2990
      _ExtentY        =   4048
      _StockProps     =   0
   End
   Begin LEDGER50Lib.Ledger50 frmRpt 
      Height          =   3255
      Left            =   840
      TabIndex        =   2
      Top             =   2400
      Width           =   2415
      _Version        =   65536
      _ExtentX        =   4260
      _ExtentY        =   5741
      _StockProps     =   237
      ForeColor       =   0
      BackColor       =   16777215
   End
   Begin ActiveBar2LibraryCtl.ActiveBar2 SBar 
      Height          =   495
      Left            =   0
      TabIndex        =   1
      Top             =   7320
      Width           =   10455
      _LayoutVersion  =   1
      _ExtentX        =   18441
      _ExtentY        =   873
      _DataPath       =   ""
      Bands           =   "frmMain.frx":0000
   End
   Begin ActiveBar2LibraryCtl.ActiveBar2 TBar 
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   9615
      _LayoutVersion  =   1
      _ExtentX        =   16960
      _ExtentY        =   873
      _DataPath       =   ""
      Bands           =   "frmMain.frx":01C8
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private ImgPath As String
Private ImgStd As StdPicture

Private objEntry As Object

Private daCn As New ADODB.Connection
Private daRs As New ADODB.Recordset
Private lSql As String
Private SelItemID As Long

'//窗体初始化
Private Sub formInit()
 '//参数初始化
 ImgPath = App.Path & "\ResLib\"
 Set ImgStd = LoadPicture(ImgPath & "Title.Ico")
 With Me
  .Caption = TitleText
  Set .Icon = ImgStd
  .Width = Screen.Width * 0.95
  .Height = Screen.Height * 0.9
 End With
 '//
 With TBar
  .Left = 0
  .Top = 0
  .Width = Me.ScaleWidth
  .Height = 720
 End With
 '//
 With SBar
  .Left = 0
  .Width = Me.ScaleWidth
  .Height = 350
  .Top = Me.ScaleHeight - .Height
  .Picture = LoadPicture(ImgPath & "SBarBack.Gif")
 End With
With frmRpt
  .Left = 0
  .Top = TBar.Top + TBar.Height '// frmTitle.Top
  .Width = Me.ScaleWidth * 0.45
  .Height = SBar.Top - .Top
 End With
 '//
 With frmSplit
  .Left = frmRpt.Left + frmRpt.Width
  .Top = frmRpt.Top
  .Height = frmRpt.Height
 End With
 '//
 With frmCell
  .Left = frmSplit.Left + frmSplit.Width
  .Width = Me.ScaleWidth - frmSplit.Width - frmRpt.Width
  .Top = frmSplit.Top
  .Height = frmSplit.Height
 End With
 '//
 Set objEntry = CreateObject("StdRptBase.UserGroup")
 daCn.ConnectionString = meObj.BaseInfo.getConStr
 daCn.Open
End Sub

'//初始化工具栏
Private Sub LoadTBar()
 TBar.UserDefinedCustomization = True
 '//
 Dim Tool As ActiveBar2LibraryCtl.Tool
 Dim Band As ActiveBar2LibraryCtl.Band
 '//
 Set ImgStd = LoadPicture(ImgPath & "TBarBk.jpg")
 With TBar
  .Picture = ImgStd
 End With
 '//
 Set Band = TBar.Bands.Add("TTBar")
 With Band
  .Caption = "TTBar"
  .Type = ddBTNormal
  .DockingArea = ddDATop
  .GrabHandleStyle = ddGSIE
  .MouseTracking = ddTSColor
 End With
 '//
 Set Tool = Band.Tools.Add(1, "TNew")
 With Tool
  .Caption = "增加"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "New.Ico"), &HFF8080
  .ToolTipText = "增加[" & TitleText & "]"
 End With
 '//
 Set Tool = Band.Tools.Add(2, "TEdit")
 With Tool
  .Caption = "编辑"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "Edit.Ico"), &HC0C0C0
  .ToolTipText = "编辑[" & TitleText & "]"
 End With
 '//
 Set Tool = Band.Tools.Add(3, "TDel")
 With Tool
  .Caption = "删除"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "delete.ico"), &HC0C0C0
  .ToolTipText = "删除[" & TitleText & "]"
 End With
 '//
 Set Tool = Band.Tools.Add(4, "SplitOne")
 With Tool
  .ControlType = ddTTSeparator
 End With
 '//
 Set Tool = Band.Tools.Add(5, "TSave")
 With Tool
  .Caption = "保存"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "Save.Ico"), &HC0C0C0
  .ToolTipText = "保存[" & TitleText & "]"
 End With
 '//
 Set Tool = Band.Tools.Add(6, "TFind")
 With Tool
  .Caption = "查找"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "Find.Ico"), &HC0C0C0
  .ToolTipText = "查找[" & TitleText & "]"
 End With
 '//
 Set Tool = Band.Tools.Add(7, "TPrint")
 With Tool
  .Caption = "打印"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "Print.Ico"), &HC0C0C0
  .ToolTipText = "打印[" & TitleText & "]"
 End With
 '//
 Set Tool = Band.Tools.Add(8, "SplitTwo")
 With Tool
  .ControlType = ddTTSeparator
 End With
 '//
 Set Tool = Band.Tools.Add(9, "TExit")
 With Tool
  .Caption = "退出"
  .Category = "TTBar"
  .ControlType = ddTTButton
  .Style = ddSIconText
  .CaptionPosition = ddCPBelow
  .SetPicture 0, LoadPicture(ImgPath & "Exit.Ico"), &HC0C0C0
  .ToolTipText = "退出基础资料管理"
 End With
 TBar.RecalcLayout
 TBar.Refresh
End Sub

'//
Private Sub LoadSBar()
 Dim Tool As ActiveBar2LibraryCtl.Tool
 Dim Band As ActiveBar2LibraryCtl.Band
 '//添加用户图标
 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 = meObj.BaseInfo.getItemName(12, meObj.BaseInfo.getUserID)
  .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 = meObj.BaseInfo.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 LoadCell()
 Dim iLoop As Integer
 Call getCellData
 With frmCell
  '//
  .ShowTopLabel 0, 0
  .ShowSideLabel 0, 0
  .ShowSheetLabel 0, 0
  '.SetSelectMode 0, 2
  .ShowPageBreak 0
  '//滚动栏信息
  .ShowHScroll 0, 0
  .ShowVScroll 0, 0
  .AllowSizeColInGrid = True
  .AllowSizeRowInGrid = True
  '//页面信息
  .PrintSetPaper 9
  .PrintSetOrient 1
  .PrintSetAlign 1, 1
  .PrintSetMargin 10, 0.5, 10, 0.5
  .WndBkColor = RGB(&HFF, &HFF, &HFF)
  '
  .SetCols meCell.MaxCols, 0
  .SetRows meCell.MaxRows, 0
  '//
  .SetCellFont 1, 1, 0, .FindFontIndex("黑体", 1)
  .SetCellFontSize 1, 1, 0, 11
  .SetCellAlign 1, 1, 0, 4 + 32
  .SetCellFontStyle 1, 1, 0, 2
  .SetCellInput 1, 1, 0, 5
  '//
  .SetCellString 1, 1, 0, "项目名称"
  .SetCellFont 2, 1, 0, .FindFontIndex("黑体", 1)
  .SetCellFontSize 2, 1, 0, 11
  .SetCellAlign 2, 1, 0, 4 + 32
  .SetCellFontStyle 2, 1, 0, 2
  .SetCellInput 2, 1, 0, 5
  '//
  .SetCellString 2, 1, 0, "项目数据"
  .SetColWidth 0, .Width * 0.04, 1, 0
  .SetColWidth 0, .Width * 0.08, 2, 0
  '//
  .SetCellFont 1, 1, 0, .FindFontIndex("黑体", 1)
  .SetCellFontSize 1, 1, 0, 11
  .SetCellAlign 1, 1, 0, 4 + 32
  .SetCellFontStyle 1, 1, 0, 2
  .SetCellInput 1, 1, 0, 5
  '//
  .SetCellString 1, 1, 0, "项目名称"
  .SetCellFont 2, 1, 0, .FindFontIndex("黑体", 1)
  .SetCellFontSize 2, 1, 0, 11
  .SetCellAlign 2, 1, 0, 4 + 32
  .SetCellFontStyle 2, 1, 0, 2
  .SetCellInput 2, 1, 0, 5
  '//
  .SetCellString 2, 1, 0, "项目数据"
  .SetColWidth 0, .Width * 0.04, 1, 0
  .SetColWidth 0, .Width * 0.11, 2, 0
  '//显示上级分组
  .SetCellString 1, 2, 0, "上级分组："
  .SetCellAlign 1, 2, 0, 2 + 32
  .SetCellInput 1, 2, 0, 5
  .SetCellFontStyle 1, 2, 0, 2
  .SetCellInput 2, 2, 0, 5
  .SetCellBackColor 2, 2, 0, .FindColorIndex(RGB(&HFF, &HFF, &HFF), 1)
  
  
  .SetCellString 1, 3, 0, "组_名_称："
  .SetCellAlign 1, 3, 0, 2 + 32
  .SetCellInput 1, 3, 0, 5
  .SetCellFontStyle 1, 3, 0, 2
  
  .SetCellString 1, 4, 0, "组_用_户："
  .SetCellAlign 1, 4, 0, 2 + 8
  .SetCellInput 1, 4, 0, 5
  .SetCellFontStyle 1, 4, 0, 2
  .SetCellInput 2, 4, 0, 5
  .SetCellBackColor 2, 4, 0, .FindColorIndex(RGB(&HFF, &HFF, &HFF), 1)
  
  .SetCellString 1, 5, 0, "启用标志："
  .SetCellAlign 1, 5, 0, 2 + 32
  .SetCellInput 1, 5, 0, 5