凭证批处理.frm

用友U8财务软件VB源程序, 本版本为2002年版本

   gSup_id As String       '辅助类
   gSign As String         '辅助类
   gInid As String         '行号
End Type
'单据信息
Private Type DjInformation
   fDjrq As Date           '单据日期
   fDjID As String         '单据编号
   fMoney As Currency      '金额
   fHl As Double           '汇率
   fZhID1 As String        '账户号1
   fZhID2 As String        '账户号2
   fDigest As String       '摘要
   blnDoIt As Boolean      '生成标志
   '-------------------------------- luotao 2002-07-03
   fCode1 As String           '科目编码1
   fCode2 As String           '科目编码2
   fCode3 As String           '科目编码3
   fCus_id(2) As String       '客户编码
   fDept_id(2) As String      '部门编号
   fItem_Class(2) As String   '项目大类
   fItem_id(2) As String      '项目编号
   fPerson_id(2) As String    '个人编号
   fSup_id(2) As String       '供应商编号
   fSign As String            '凭证类别
   fYwID As String            '业务编号
   fDyYwID As String          '对应业务编号
   '----------------------------------
End Type

Private pVouch             As VouchsInfomation
Private dVouch()           As DjInformation

Private WithEvents xClsPz  As clsPZ
Attribute xClsPz.VB_VarHelpID = -1

Public Property Get EO() As U8FDEso.EntityObject
    Set EO = m_EO
End Property

Public Property Set EO(NewEO As U8FDEso.EntityObject)
    Set m_EO = NewEO
End Property

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   Shift = Shift And 7
   Select Case KeyCode
      Case vbKeyO
          If Shift = vbCtrlMask Then
              Gen_Key "Select"
          ElseIf Shift = vbAltMask Then
              Gen_Key "SelectAll"
          End If
      Case vbKeyF4
          If Shift = vbCtrlMask Then
            Gen_Key "Exit"
            Exit Sub
          ElseIf Shift = 0 Then
            Gen_Key "UnionFind"
          End If
      Case vbKeyU
          If Shift = vbCtrlMask Then
              Gen_Key "Unselect"
          ElseIf Shift = vbAltMask Then
              Gen_Key "UnselectAll"
          End If
      Case vbKeyF7
          If Shift = vbAltMask And tlbTool.Buttons("Dovouch").Enabled Then
              Gen_Key "Dovouch"
          End If
   End Select
    ocxCtbtool.RefreshEnable

End Sub

Private Sub Form_Load()
'    Dim i As Integer
'    ReDim mField(4)
'    For i = 0 To 4
'        mField(i).fshow = True
'    Next
'    mField(0).fName = "BillDate"
'    mField(0).fcaption = "业务日期"
'    mField(1).fName = "BillID"
'    mField(1).fcaption = "业务类型"
'    mField(2).fName = "BillID"
'    mField(2).fcaption = "业务编号"
'    mField(3).fName = "BillMoney"
'    mField(3).fcaption = "金额"
'    mField(4).fName = "BillDigest"
'    mField(4).fcaption = "摘要"
   
    Me.Icon = LoadResPicture(109, vbResIcon)
'*******************************************
    '罗涛 2002-07-03
'    frmVouchsTj.Show 1
    Screen.MousePointer = vbHourglass
    If Trim(showField) = "" Then
        showField = "    Format(![BillDate], 'YYYY-MM-DD')   GetClassName(Left(![BillID], 2))    Right(![BillID], 10)    Format(![BillMoney], '#0.00')   ![BillDigest]"
    End If
'********************************************
    
    loadstatic
'    GetSQLOrder  'luotao 2002-07-06
'    fillGrid
    SetTBStyle Me
    
    NodeKey = -1
    
    initGrid
    
    setTreeview
    
    Screen.MousePointer = vbDefault
    
    ocxCtbtool.RefreshEnable
End Sub

'********************************************************************
'*函数说明: 加载资源                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub loadstatic()
   Picture1.Align = 0
   Picture1.width = ZjAccInfo.zjPictWidth
   Picture1.Picture = LoadPicture(ZjAccInfo.zjRepPath & "BookBack.BMP")
   'TlbVouch_f tlbTool, ImageList1
'       Dim imgt As ListImage
    ImageList1.ListImages.Add , "Select", LoadResPicture(888, vbResBitmap)
    ImageList1.ListImages.Add , "Unselect", LoadResPicture(326, vbResBitmap)
    ImageList1.ListImages.Add , "SelectAll", LoadResPicture(207, vbResBitmap)
    ImageList1.ListImages.Add , "UnselectAll", LoadResPicture(208, vbResBitmap)
    ImageList1.ListImages.Add , "Dovouch", LoadResPicture(143, vbResBitmap)
    ImageList1.ListImages.Add , "UnionFind", LoadResPicture(1102, vbResBitmap)
    ImageList1.ListImages.Add , "Help", LoadResPicture(396, vbResBitmap)
    ImageList1.ListImages.Add , "Exit", LoadResPicture(1118, vbResBitmap)
    ImageList1.ListImages.Add , "find", LoadResPicture(331, vbResBitmap)        '查询
    ImageList1.ListImages.Add , "showField", LoadResPicture(102, vbResBitmap)
    ImageList1.ListImages.Add , "UniteSelect", LoadResPicture(146, vbResBitmap) '合并

    With tlbTool
        .Buttons("Select").Caption = "选择"
        .Buttons("Select").Image = "Select"
        .Buttons("Select").ToolTipText = "Ctrl+O"
        .Buttons("Unselect").Caption = "取消"
        .Buttons("Unselect").Image = "Unselect"
        .Buttons("Unselect").ToolTipText = "Ctrl+U"
        .Buttons("SelectAll").Caption = "全选"
        .Buttons("SelectAll").Image = "SelectAll"
        .Buttons("SelectAll").ToolTipText = "Alt+O"
        .Buttons("UnselectAll").Caption = "全消"
        .Buttons("UnselectAll").Image = "UnselectAll"
        .Buttons("UnselectAll").ToolTipText = "Alt+U"
        .Buttons("Dovouch").Caption = "制单"
        .Buttons("Dovouch").Image = "Dovouch"
        .Buttons("Dovouch").ToolTipText = "Alt+F7"
        .Buttons("UnionFind").Caption = "单据"
        .Buttons("UnionFind").Image = "UnionFind"
        .Buttons("UnionFind").ToolTipText = "F4"
        .Buttons("Help").Image = "Help"
        .Buttons("Help").Caption = "帮助"
        .Buttons("Help").ToolTipText = "F1"

        .Buttons("Exit").Image = "Exit"
        .Buttons("Exit").Caption = "退出"
        .Buttons("Exit").ToolTipText = "Ctrl+F4"

        .Buttons("combinDo").Image = "UniteSelect"
        .Buttons("combinDo").Caption = "合并"
        .Buttons("combinDo").ToolTipText = ""

        .Buttons("find").Image = "find"
        .Buttons("find").Caption = "查询"
        .Buttons("find").ToolTipText = ""
        
        .Buttons("showField").Image = "showField"
        .Buttons("showField").Caption = "列表"
        .Buttons("showField").ToolTipText = ""
    End With

End Sub

Private Sub GetSQLOrder()
   If sqlVouchs = "" Then Exit Sub
   If InStr(1, sqlVouchs, "UNION") = 0 Then
      sqlVouchs = sqlVouchs & "ORDER BY [Bill_Date]"
   Else
      sqlVouchs = sqlVouchs & "ORDER BY [BillDate]"
   End If
   
End Sub

'********************************************************************
'*函数说明: 填充显示Grid                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub fillgrid()
   Dim i As Integer
   Dim strTemp As String
   Dim rskmbm As New UfRecordset
   nFixRows = 2
   nRows = 0
   initGrid
   If sqlVouchs = "" Then Exit Sub
   'sqlVouchs = sqlVouchs & " " & sqlwhere & " order by [Bill_Date]"
   Set rsVouchs = dbsZJ.OpenRecordset(sqlVouchs, dbOpenSnapshot)
   If rsVouchs.EOF Then Exit Sub
   With rsVouchs
      i = 1
      While Not .EOF
'         UfGridADO1.AddItem Format(![BillDate], "YYYY-MM-DD") & vbTab & GetClassName(Left(![BillID], 2)) & _
'            vbTab & Right(![BillID], 10) & vbTab & ![BillDigest] & vbTab & Format(![BillMoney], "#0.00")
        'UfGridADO1.AddItem showField  'luotao 2002-07-06
        UfGridADO1.AddItem " " & vbTab & " 1"
   Dim j As Long
   Dim k As Integer
   k = 1
   j = UfGridADO1.Rows - 1
   If mField(0).fshow Then
        UfGridADO1.TextMatrix(j, k) = Format(![BillDate], "YYYY-MM-DD")
        k = k + 1
   End If
   If mField(1).fshow Then
      'UfGridADO1.TextMatrix(j, k) = GetClassName(left(![BillID], 2))
      UfGridADO1.TextMatrix(j, k) = m_PzSign
      k = k + 1
   End If
   If mField(2).fshow Then
        UfGridADO1.TextMatrix(j, k) = right(![BillID], 10)
         k = k + 1
   End If