frmmain.frm

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

VERSION 5.00
Object = "{709F7AE3-E049-11D2-9362-00403332E72F}#1.0#0"; "LEDGER50.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{54FC599E-9611-11D2-8350-E97AACC90D73}#1.1#0"; "SpltrBar.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   6555
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   9435
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6555
   ScaleWidth      =   9435
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.ImageList TreeImgList 
      Left            =   3600
      Top             =   2040
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":058A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":0B24
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin SplitterBars.VSplitterBar frmSplit 
      Height          =   4935
      Left            =   3240
      Top             =   840
      Width           =   30
      _ExtentX        =   53
      _ExtentY        =   8705
      BackColor       =   8421504
   End
   Begin MSComctlLib.ImageList TBarImgList 
      Left            =   3600
      Top             =   840
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":121E
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":15B8
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmMain.frx":1B52
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin LEDGER50Lib.Ledger50 frmRpt 
      Height          =   5295
      Left            =   4800
      TabIndex        =   3
      Top             =   720
      Width           =   4455
      _Version        =   65536
      _ExtentX        =   7858
      _ExtentY        =   9340
      _StockProps     =   237
      ForeColor       =   0
      BackColor       =   16777215
   End
   Begin MSComctlLib.TreeView frmTree 
      Height          =   5415
      Left            =   0
      TabIndex        =   2
      Top             =   720
      Width           =   2775
      _ExtentX        =   4895
      _ExtentY        =   9551
      _Version        =   393217
      LabelEdit       =   1
      LineStyle       =   1
      Style           =   7
      ImageList       =   "TreeImgList"
      Appearance      =   0
   End
   Begin MSComctlLib.StatusBar SBar 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   6180
      Width           =   9435
      _ExtentX        =   16642
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   5
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Text            =   "操作人员"
            TextSave        =   "操作人员"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Text            =   "操作日期"
            TextSave        =   "操作日期"
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar TBar 
      Align           =   1  'Align Top
      Height          =   330
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   9435
      _ExtentX        =   16642
      _ExtentY        =   582
      ButtonWidth     =   1349
      ButtonHeight    =   582
      Style           =   1
      TextAlignment   =   1
      ImageList       =   "TBarImgList"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   4
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "选择"
            Object.ToolTipText     =   "选择指定的资料"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "搜索"
            Object.ToolTipText     =   "搜索资料"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "关闭"
            Object.ToolTipText     =   "关闭选择框"
            ImageIndex      =   3
         EndProperty
      EndProperty
   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 SelItem() As Long
Private frmCn As New ADODB.Connection
Private frmRs As New ADODB.Recordset
Private TxtSql As String
Private SelItemID As Long

'//初始化参数
Private Sub LoadActiveX()
 With Me
  .Width = Screen.Width * 0.6
  .Height = Screen.Height * 0.5
  .Caption = "请选择：" & TitleStr
 End With
 '/
 With frmTree
  .Left = 0
  .Top = TBar.Top + TBar.Height
  .Width = Me.ScaleWidth * 0.3
  .Height = SBar.Top - .Top
 End With
 '/
 With frmSplit
  .Left = frmTree.Left + frmTree.Width
  .Top = frmTree.Top
  .Height = frmTree.Height
 End With
 '/
 With frmRpt
  .Left = frmSplit.Left + frmSplit.Width
  .Top = frmSplit.Top
  .Width = Me.ScaleWidth - frmSplit.Width - frmTree.Width
  .Height = frmSplit.Height
 End With
 '//
 TBar.Buttons.Item(1).Enabled = False
 Set meObj.UserObj = CreateObject("StdRptBase.User")
End Sub

'//处理状态条
Private Sub LoadSBar()
 With SBar
  .Panels(1).Width = .Width * 0.15
  .Panels(2).Width = .Width * 0.15
  .Panels(3).Width = .Width * 0.4
  .Panels(4).Width = .Width * 0.15
  .Panels(4).Width = .Width * 0.15
  '//
  .Panels(2).Text = meObj.BaseInfo.getItemName(meObj.BaseInfo.getClassID, meObj.BaseInfo.getUserID)
  .Panels(5).Text = meObj.BaseInfo.getServerDate(1)
 End With
End Sub

'//装在顶级目录
Private Sub LoadTopTree()
 Dim daCn As New ADODB.Connection
 Dim daRs As New ADODB.Recordset
 Dim Sql As String
 Dim NodeX As Node
 Dim FItemID As Long
 Dim FName As String
 Dim FNodeSign As String
 Dim iLoop As Long
 Sql = getClassSql(0)
 daCn.ConnectionString = meObj.BaseInfo.getConStr
 daCn.Open
 daRs.CursorLocation = adUseClient
 daRs.Open Sql, daCn, adOpenStatic, adLockReadOnly
 If Not daRs.EOF Then
  iLoop = 0
  While Not daRs.EOF
   If Not IsNull(daRs("FItemID")) Then FItemID = daRs("FItemID")
   If Not IsNull(daRs("FName")) Then FName = daRs("FName")
   iLoop = iLoop + 1
   ReDim Preserve SelItem(1 To iLoop)
   SelItem(iLoop) = FItemID
   FNodeSign = "Top" & FItemID
   Set NodeX = frmTree.Nodes.Add(, , FNodeSign, FName, 1, 2)
   daRs.MoveNext
  Wend
 End If
 daRs.Close
 daCn.Close
 Set daRs = Nothing
 Set daCn = Nothing
End Sub

'//装在顶级目录
Private Sub LoadNextTree(ByVal inParentID As Long)
 Dim daCn As New ADODB.Connection
 Dim daRs As New ADODB.Recordset
 Dim Sql As String
 Dim NodeX As Node
 Dim FItemID As Long
 Dim FName As String
 Dim FNodeSign As String
 Dim iLoop As Long
 Sql = getClassSql(inParentID)
 daCn.ConnectionString = meObj.BaseInfo.getConStr
 daCn.Open
 daRs.CursorLocation = adUseClient
 daRs.Open Sql, daCn, adOpenStatic, adLockReadOnly
 If Not daRs.EOF Then
  iLoop = UBound(SelItem)
  While Not daRs.EOF
   If Not IsNull(daRs("FItemID")) Then FItemID = daRs("FItemID")
   If Not IsNull(daRs("FName")) Then FName = daRs("FName")
   iLoop = iLoop + 1
   ReDim Preserve SelItem(1 To iLoop)
   SelItem(iLoop) = FItemID
   FNodeSign = "Top" & FItemID
   Set NodeX = frmTree.Nodes.Add("Top" & inParentID, tvwChild, FNodeSign, FName, 1, 2)
   daRs.MoveNext
  Wend
 End If
 daRs.Close
 daCn.Close
 Set daRs = Nothing
 Set daCn = Nothing
End Sub

'//装在资料列表
Private Sub LoadRpt()
 With frmRpt
  .Face.Rows = 1
  .Face.FixedRows = 1
  .Face.Cols = 6
  .Col(1).Width = 0
  .Col(1).Switch(E_LDG_ColFlag_Hide) = True
 End With
 frmCn.ConnectionString = meObj.BaseInfo.getConStr
 frmCn.Open
 TxtSql = getListSql(0)
End Sub

Private Sub RefreshLdg()
 On Error GoTo Errhandler
 Dim Sql As String
 Sql = TxtSql '// getListSql(meObj.BaseInfo.getClassID, 0)
 If frmRs.State = adStateOpen Then frmRs.Close
 frmRs.CursorLocation = adUseClient
 frmRs.Open Sql, frmCn, adOpenStatic, adLockReadOnly
 frmRpt.Merge.UnMergeAll
 frmRpt.Face.Rows = frmRs.RecordCount + frmRpt.Face.FixedRows
 frmRpt.Face.ForceRefresh
 SBar.Panels(3).Text = "共计找到[" & frmRs.RecordCount & "]笔记录"
 Exit Sub
Errhandler:
 MsgBox "错误，编号：" & Err.Number & "-->信息：" & Err.Description, vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
End Sub

Private Sub SetRetVlue()
 Dim MsgInfo As String
 If meObj.UserObj.Load(SelItemID, MsgInfo) = False Then
  MsgBox MsgInfo, vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
  Exit Sub
 End If
End Sub

Private Sub Form_Load()
 Call LoadActiveX
 Call LoadSBar
 Call LoadTopTree
 Call LoadRpt
 Call RefreshLdg
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If frmCn.State = adStateOpen Then frmCn.Close
  If frmRs.State = adStateOpen Then frmRs.Close
  Set frmCn = Nothing
  Set frmRs = Nothing
End Sub

Private Sub frmRpt_DblClick()
 Dim MsgInfo As String
 If meObj.UserObj.Load(Val(frmRpt.Cell(frmRpt.Sel.Row, 1).Text), MsgInfo) = False Then
  MsgBox MsgInfo, vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
  Exit Sub
 End If
 Unload Me
End Sub

Private Sub frmRpt_FillRow(ByVal lRow As Long, strRowData As String, clrBack As stdole.OLE_COLOR, clrFore As stdole.OLE_COLOR)
 Dim iLoop As Integer
 If lRow = 1 Then
  strRowData = getListTitle()
  Exit Sub
 End If
 frmRs.AbsolutePosition = lRow - frmRpt.Face.FixedRows
 For iLoop = 0 To frmRpt.Face.Cols - 1
  strRowData = strRowData & frmRs(iLoop) & "|"
 Next
End Sub

Private Sub frmSplit_EndMoving()
 frmTree.Width = frmSplit.Left - frmTree.Left
 frmRpt.Left = frmSplit.Left + frmSplit.Width
 frmRpt.Width = Me.ScaleWidth - frmSplit.Width - frmTree.Width
End Sub

Private Sub frmTree_NodeClick(ByVal Node As MSComctlLib.Node)
 Dim ChildSign As Integer
 '/
 ChildSign = Node.Children
 SelItemID = SelItem(Node.Index)
 If ChildSign = 0 Then
  Call LoadNextTree(SelItemID)
 End If
 TxtSql = getListSql(SelItemID)
 Call RefreshLdg
 '//
 SBar.Panels(3).Text = "选择目录[" & Node.Text & "] 目录内码[" & SelItemID & "]"
End Sub

Private Sub TestL2E()
' Dim MsgInfo As String
' Dim TsObj As Object
' Set TsObj = CreateObject("Ledger2Excel.L2ECell")
' TsObj.setUserID = meObj.BaseInfo.getUserID
' TsObj.setRptID = 0
' TsObj.getRpt = frmRpt
' If TsObj.TransmissionData(MsgInfo) = False Then
'  MsgBox MsgInfo, vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
' End If
' Set TsObj = Nothing
End Sub

Private Sub TBar_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Caption
  Case "选择"
   Call SetRetVlue
   Unload Me
  Case "搜索"
   Call TestL2E
   '//MsgBox "预留功能", vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
  Case "关闭"
   Unload Me
 End Select
End Sub