单据查询结果.frm

财务信息管理系统,适合做毕业论文的人使用

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "Mshflxgd.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "Msadodc.OCX"
Object = "{5AD81966-3173-4597-A32E-4F4620DA3B57}#3.3#0"; "U8TBCtl.ocx"
Begin VB.Form frmVchQueryResult 
   Caption         =   "单据查询结果"
   ClientHeight    =   2715
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6045
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   2715
   ScaleWidth      =   6045
   WindowState     =   2  'Maximized
   Begin MSComctlLib.ImageList ilsTlb 
      Left            =   5160
      Top             =   480
      _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         =   "单据查询结果.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "单据查询结果.frx":0452
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "单据查询结果.frx":08A4
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid msg 
      Bindings        =   "单据查询结果.frx":0CF6
      Height          =   1305
      Left            =   120
      TabIndex        =   0
      Top             =   960
      Width           =   5535
      _ExtentX        =   9763
      _ExtentY        =   2302
      _Version        =   393216
      AllowUserResizing=   3
      RowSizingMode   =   1
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin MSComctlLib.Toolbar tlbAction 
      Align           =   1  'Align Top
      Height          =   540
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   6045
      _ExtentX        =   10663
      _ExtentY        =   953
      ButtonWidth     =   820
      ButtonHeight    =   953
      AllowCustomize  =   0   'False
      Wrappable       =   0   'False
      Style           =   1
      ImageList       =   "ilsTlb"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   11
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打印"
            Key             =   "Print"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "预览"
            Key             =   "Preview"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "输出"
            Key             =   "Export"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "查询"
            Key             =   "Find"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "栏目"
            Key             =   "ColumnSet"
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "单据"
            Key             =   "ViewVch"
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "帮助"
            Key             =   "Help"
         EndProperty
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "退出"
            Key             =   "Exit"
         EndProperty
      EndProperty
   End
   Begin MSAdodcLib.Adodc Adodc 
      Align           =   2  'Align Bottom
      Height          =   330
      Left            =   0
      Top             =   2385
      Visible         =   0   'False
      Width           =   6045
      _ExtentX        =   10663
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin prjTBCtrl.CTBCtrl ocxCtbTool 
      Height          =   855
      Left            =   0
      Top             =   0
      Width           =   3975
      _ExtentX        =   7011
      _ExtentY        =   1508
   End
   Begin VB.Label lblResult 
      Caption         =   "Label1"
      Height          =   285
      Left            =   1755
      TabIndex        =   2
      Top             =   675
      Width           =   1950
   End
End
Attribute VB_Name = "frmVchQueryResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public SQL              As String
Public NodeKey          As Long
Private PrintTypeList   As String
Private PrintSizeList   As String
Private SetPrintDataStyleXML_flag As Boolean

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    On Error GoTo ErrHandler
    Dim ShiftDown, AltDown, CtrlDown
    ShiftDown = (Shift And vbShiftMask) > 0
    AltDown = (Shift And vbAltMask) > 0
    CtrlDown = (Shift And vbCtrlMask) > 0
    
    Select Case KeyCode
        Case vbKeyF1
            SendKeys "{F1 3}"
        Case vbKeyF3
            If Me.tlbAction.Buttons("Find").Enabled Then
                frmVchQueryFilter.NodeKey = NodeKey
                frmVchQueryFilter.stabFilter.Tab = 0
                frmVchQueryFilter.Show vbModal
            End If
        Case vbKeyP
            If CtrlDown And Me.tlbAction.Buttons("Print").Enabled Then
                PrintData
            End If
        Case vbKeyF4
            If CtrlDown Then
                Unload Me
            End If
    End Select
    SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
ErrHandler:
    Exit Sub
End Sub

Private Sub Form_Load()
    MSImageList_Initialize ilsTlb
    MSToolBar_Initialize tlbAction, "Print", TB_PRINT
    MSToolBar_Initialize tlbAction, "Preview", TB_PREVIEW
    MSToolBar_Initialize tlbAction, "Export", TB_Export
    MSToolBar_Initialize tlbAction, "Find", TB_FIND
    MSToolBar_Initialize tlbAction, "ColumnSet", TB_ColumnSet
    MSToolBar_Initialize tlbAction, "ViewVch", TB_BILL
    MSToolBar_Initialize tlbAction, "Help", TB_HELP
    MSToolBar_Initialize tlbAction, "Exit", TB_EXIT
    
    SetTlbStyle Me, False
    ocxCtbTool.RefreshEnable
    With Adodc
       .ConnectionString = g_sDataSourceName
       .RecordSource = SQL
    End With
    If Me.msg.FixedCols > 0 Then
        Me.msg.ColWidth(0) = 400
        Me.msg.ColWidth(Me.msg.FixedCols + 1) = 0 '内部业务ID
    Else
        Me.msg.ColWidth(1) = 0 '内部业务ID
    End If
    Set Me.msg.DataSource = Adodc
    SetPrintDataStyleXML_flag = False
    RefreshMsFlexGrid
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.msg.Move 0, Me.tlbAction.Height, Me.ScaleWidth, Me.ScaleHeight - Me.tlbAction.Height
    ResizeCtbTool Me
    On Error GoTo 0
End Sub

Private Sub msg_DblClick()
    If Me.msg.Rows > 1 Then
        Dim OID           As New U8FDEso.OIDObject
        Dim objVchInputUI As New clsVchInputUI
        
        OID = Me.msg.TextMatrix(Me.msg.Row, Me.msg.FixedCols + 1)
        objVchInputUI.Show g_sDataSourceName, smView, OID, mID(OID.id, 1, 2)
        
        Set OID = Nothing
        Set objVchInputUI = Nothing
    End If
End Sub

Public Sub RefreshMsFlexGrid()
    Dim i As Long
    
    For i = 1 To msg.Rows - 1
        msg.TextMatrix(i, 0) = i
    Next
End Sub

Private Sub msg_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        Me.PopupMenu frmRightMenu.mnuVchQuery
    End If
End Sub

Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbAction_ButtonClick tlbAction.Buttons(cButtonId)
End Sub

Private Sub tlbAction_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.key
        Case "Print"
            PrintData
        Case "Preview"
            PrintView
        Case "Export"
            Export
        Case "Find"
            frmVchQueryFilter.NodeKey = NodeKey
            frmVchQueryFilter.stabFilter.Tab = 0
            frmVchQueryFilter.Show vbModal
        Case "ColumnSet"
            frmVchQueryFilter.NodeKey = NodeKey
            frmVchQueryFilter.stabFilter.Tab = 1
            frmVchQueryFilter.Show vbModal
        Case "ViewVch"
            msg_DblClick
        Case "Help"
            SendKeys "{F1 3}"
        Case "Exit"
            Unload Me
    End Select
    If UCase(Button.key) <> "EXIT" Then SetTlbStyle Me, False: ocxCtbTool.RefreshEnable
End Sub

Private Sub PrintData()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML SQL
    frmRightMenu.ocxPrint.DoPrint
End Sub

Private Sub PrintView()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML SQL
    frmRightMenu.ocxPrint.PrintPreview
End Sub

Private Sub Export()
    If SetPrintDataStyleXML_flag = False Then SetPrintDataStyleXML SQL
    frmRightMenu.ocxPrint.ExportToFile 0, PrintTypeList, PrintSizeList, "", ""
End Sub

Public Sub SetPrintDataStyleXML(SQL As String)
    Dim lRet        As Long
    Dim sData       As String
    Dim sStyle      As String
    Dim sModuleId   As String
    Dim objVchDefBI As New U8FDBso.clsVchDefBI
    Dim objEO       As U8FDEso.EntityObject
    
    On Error GoTo lblHandle
    Set objEO = objVchDefBI.Init(g_sDataSourceName, NodeKey)
    
    sData = SetPrintDataXML(SQL, objEO.Caption, PrintTypeList, PrintSizeList)
    sStyle = SetPrintStyleXML("")
    sModuleId = "Default"
    
    lRet = frmRightMenu.ocxPrint.SetDataStyleXML(sData, False, sStyle, False, sModuleId)
    If lRet <> 0 Then
        MsgBox "打印数据格式设置失败！", vbInformation, App.ProductName
        SetPrintDataStyleXML_flag = False
    End If
    
    SetPrintDataStyleXML_flag = True
    
    Set objVchDefBI = Nothing
    Set objEO = Nothing
    Exit Sub
lblHandle:
    SetPrintDataStyleXML_flag = False
    MsgBox "打印数据格式设置失败！", vbInformation, App.ProductName
End Sub

Public Sub OrderDesc()
    Dim m_sql As String
    Dim objVchQuerySQLBI As New U8FDBso.clsVchQuerySQLBI
    objVchQuerySQLBI.DataSourceName = g_sDataSourceName
    m_sql = mID(SQL, 1, InStr(1, SQL, "order by ") - 1 + Len("order by "))
    m_sql = m_sql & "'" & objVchQuerySQLBI.GetFieldName(NodeKey, IIf(Me.msg.col > 2, Me.msg.col - 1, Me.msg.col)) & "' desc"
    msg.Rows = 0
    With Adodc
       .ConnectionString = g_sDataSourceName
       .RecordSource = m_sql
    End With
    Adodc.Refresh
    If Adodc.Recordset.EOF Then
        msg.Rows = 2
        msg.FixedRows = 1
    Else
        msg.Rows = Adodc.Recordset.RecordCount + 1
        msg.FixedRows = 1
    End If
    If Me.msg.FixedCols > 0 Then
        Me.msg.ColWidth(0) = 400
        Me.msg.ColWidth(Me.msg.FixedCols + 1) = 0 '内部业务ID
    Else
        Me.msg.ColWidth(1) = 0 '内部业务ID
    End If
    Set Me.msg.DataSource = Adodc
    RefreshMsFlexGrid
End Sub

Public Sub OrderAsc()
    Dim m_sql As String
    Dim objVchQuerySQLBI As New U8FDBso.clsVchQuerySQLBI
    objVchQuerySQLBI.DataSourceName = g_sDataSourceName
    m_sql = mID(SQL, 1, InStr(1, SQL, "order by ") - 1 + Len("order by "))
    m_sql = m_sql & "'" & objVchQuerySQLBI.GetFieldName(NodeKey, IIf(Me.msg.col > 2, Me.msg.col - 1, Me.msg.col)) & "' asc"
    msg.Rows = 0
    With Adodc
       .ConnectionString = g_sDataSourceName
       .RecordSource = m_sql
    End With
    Adodc.Refresh
    If Adodc.Recordset.EOF Then
        msg.Rows = 2
        msg.FixedRows = 1
    Else
        msg.Rows = Adodc.Recordset.RecordCount + 1
        msg.FixedRows = 1
    End If
    If Me.msg.FixedCols > 0 Then
        Me.msg.ColWidth(0) = 400
        Me.msg.ColWidth(Me.msg.FixedCols + 1) = 0 '内部业务ID
    Else
        Me.msg.ColWidth(1) = 0 '内部业务ID
    End If
    Set Me.msg.DataSource = Adodc
    RefreshMsFlexGrid
End Sub