凭证查询.frm

u8

   End With
   With UfGridADO1
      .LargeVirtualGrid = True
      .Rows = nFixRows + nRows
      .FixedRows = nFixRows
      .FixedCols = 0
      .Cols = 11
      
       '设置表头
      .TextMatrix(0, 1) = "业务日期"
      .JoinCells 0, 1, 1, 1, True

      .TextMatrix(0, 2) = "业务类型"
      .JoinCells 0, 2, 1, 2, True

      .TextMatrix(0, 3) = "业务号"
      .JoinCells 0, 3, 1, 3, True

      .TextMatrix(0, 4) = "制单人"
      .JoinCells 0, 4, 1, 4, True

      .TextMatrix(0, 5) = "凭证日期"
      .JoinCells 0, 5, 1, 5, True

      .TextMatrix(0, 6) = "凭证号"
      .JoinCells 0, 6, 1, 6, True
      
      .TextMatrix(0, 7) = "审核标志"
      .JoinCells 0, 7, 1, 7, True

      .TextMatrix(0, 8) = "记账标志"
      .JoinCells 0, 8, 1, 8, True
      
      .TextMatrix(0, 9) = "作废标志"
      .JoinCells 0, 9, 1, 9, True
      
      .TextMatrix(0, 10) = "标错标志"
      .JoinCells 0, 10, 1, 10, True
      
      ' 设置宽度
      For i = 0 To 10
          Select Case i
              Case 0
                  .ColWidth(i) = 0
              Case 1, 2, 4, 5, 6
                  .ColWidth(i) = 1200
              Case 3, 7, 8, 9, 10
                  .ColWidth(i) = 1000
          End Select
      Next i
   
      '设置表体的Alignment
      For i = 0 To 10
          Select Case i
              Case 0, 2, 4
                  .ColAlignment(i) = UG_ALIGNLEFT
              Case 1, 3, 5, 6, 7, 8, 9, 10
                  .ColAlignment(i) = UG_ALIGNCENTER
          End Select
      Next i
      
      '设置表头
      .HeadFont.Name = "宋体"
      .HeadBackColor = &HFFFFFF
      .HeadFont.Size = 9
      .HeadFont.Bold = True
      .Redraw = True
   End With
   
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   If Me.WindowState <> 1 Then
      If Me.width < frmMinWidth Then Me.width = frmMinWidth
      If Me.Height < frmMinWidth Then Me.Height = frmMinWidth
      Picture1.left = Me.width - Picture1.width
      Label1.left = Me.width / 2 - Label1.width / 2 + (Picture1.width - Me.width)
      Label2.left = 200 + (Picture1.width - Me.width)
      Combo1.left = 700    'Label2.Left + Label2.Width
      Label3.left = Label2.left + Label2.width + Combo1.width + 100
      Combo2.left = Combo1.left + Combo1.width + 150
      UfGridADO1.width = Me.width - 100
      UfGridADO1.Height = Me.Height - tlbAction.Height - Picture1.Height - 400
      UfGridADO1.top = tlbAction.Height + Picture1.Height
      UfGridADO1.left = 0
   End If
   On Error GoTo 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    zjGen_arr.FD0505 = False
    zjLogInfo.TaskExec "FD0505", 0, zjLogInfo.cIYear
    zjLogInfo.ClearError
    Set aClsPz = Nothing
End Sub

Private Sub tlbAction_ButtonClick(ByVal Button As ComctlLib.Button)
   Gen_Key Button.key
End Sub

Private Sub Gen_Key(TLB_Key As String)
   Select Case TLB_Key
      Case "Find"
         PzFind
      Case "PingZheng"
         DoPzJob Pz_LC
      Case "Modify"
         DoPzJob Pz_CX
      Case "ChongXiao"
         ChongXiao
      Case "Delete"
         DeleteVouch
      Case "UnionFind"
         UnionFindDj
      Case "Help"
         SendKeys "{F1}"
      Case "Exit"
         Unload Me
   End Select

End Sub

'********************************************************************
'*函数说明: 凭证查询                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub PzFind()
    InitPzControl
    aClsPz.StartUpPz "FD", "FD0505", Pz_CX, "CN"
End Sub

'********************************************************************
'*函数说明: 联查单据                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub UnionFindDj()
   Dim mDj As Us_ZJPz.clsBill
   On Error GoTo ErrL
   If UfGridADO1.Row < 2 Then Exit Sub
   'Set mDj = New Us_ZJPz.clsBill
   'Set mDj.UfDatabase = dbsZJ
   'mDj.ShowBill "fd", UfGridADO1.TextMatrix(UfGridADO1.row, 0) & UfGridADO1.TextMatrix(UfGridADO1.row, 3) 'GetSignID(UfGridADO1.TextMatrix(UfGridADO1.row, 2))
    Dim OID           As New U8FDEso.OIDObject
    Dim objVchInputUI As New clsVchInputUI
   sqlVouchs = "SELECT transactions_id FROM fd_transactions WHERE substring(transactions_id,1,2)='" & UfGridADO1.TextMatrix(UfGridADO1.Row, 0) & "' AND [transactions_code]='" & UfGridADO1.TextMatrix(UfGridADO1.Row, 3) & "'"
   Set rsVouchs = dbsZJ.OpenRecordset(sqlVouchs, dbOpenSnapshot)
   If rsVouchs.EOF Then Exit Sub
    OID = rsVouchs.Fields(0)
    objVchInputUI.Show g_sDataSourceName, smView, OID, mID(OID.id, 1, 2)
    Set OID = Nothing
    Set objVchInputUI = Nothing
   'Set mDj = Nothing
   Exit Sub
ErrL:
   MsgBox Err.Description, vbInformation, zjGl_Name
   Set mDj = Nothing
End Sub

'**** 冲销凭证时加锁 ****
Private Function LockVouchForCX(blnLock As Boolean) As Long
   'CuiDong Efficiency-A 2000/06/19 效率优化A OK
   Dim cComputerName As String
   Dim rsvouch       As New UfRecordset
   Dim cSpecial      As String
   
   cSpecial = "々"
   
   '---- 解锁
   On Error Resume Next
'   Set rsVouch = dbsZJ.OpenRecordset("FD_Vouch", 2)  'CuiDong Efficiency-A 2000/06/19 效率优化A
   Set rsvouch = dbsZJ.OpenRecordset("Select * From FD_Vouch Where cBus_id='" & strID(UfGridADO1.Row - 2) & "'", 2) 'CuiDong Efficiency-A 2000/06/19 效率优化A
   
   If Not blnLock Then
      With rsvouch
'         .Index = "PrimaryKey"                       'CuiDong Efficiency-A 2000/06/20 效率优化A
'         .FindFirst "cBus_id='" & ID & "'"           'CuiDong Efficiency-A 2000/06/19 效率优化A
'         If Not .NoMatch Then                        'CuiDong Efficiency-A 2000/06/19 效率优化A
         If Not (.EOF Or .BOF) Then                   'CuiDong Efficiency-A 2000/06/19 效率优化A
            .Edit
            !cAcc2_id = mID(!cAcc2_id, 1, InStr(1, !cAcc2_id, cSpecial) - 1)
            .Update
         End If
      End With
      Exit Function
   End If
   
   cComputerName = cSpecial & ComputerName
   
   '---- 加锁
   With rsvouch
'      .Index = "PrimaryKey"                                   'CuiDong Efficiency-A 2000/06/20 效率优化A
'      .FindFirst "cBus_id='" & ID & "'"                       'CuiDong Efficiency-A 2000/06/19 效率优化A
'      If .NoMatch Then     '---- 此张凭证已被其他用户冲销     'CuiDong Efficiency-A 2000/06/19 效率优化A
      If .EOF Or .BOF Then  '---- 此张凭证已被其他用户冲销     'CuiDong Efficiency-A 2000/06/19 效率优化A
         LockVouchForCX = 2
         Exit Function
      Else
         If InStr(1, !cAcc2_id, cSpecial) = 0 Then '---- 无其他用户使用
            .Edit
            If InStr(1, !cAcc2_id, cSpecial) <> 0 Then GoTo lblO
            !cAcc2_id = !cAcc2_id & cComputerName
            .Update
            If Err.Number <> 0 Then
               LockVouchForCX = 1
            End If
         Else
lblO:
            If mID(!cAcc2_id, InStr(1, !cAcc2_id, cSpecial)) = cComputerName Then
               '---- 用户在冲销时，由于异常原因(如死机或断电)，
               '---- 锁定标志未被取消，则可由此用户继续进行冲销操作
               LockVouchForCX = 0
               Exit Function
            Else                                '---- 其他用户正在冲销
               LockVouchForCX = 1
               Exit Function
            End If
         End If
      End If
   End With
   On Error GoTo 0
   CloseRS rsvouch
End Function

'********************************************************************
'*函数说明: 冲销凭证                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub ChongXiao()
   Dim sqlGlVouch       As String
   Dim rsGlVouch        As New UfRecordset
   Dim rsGlVouchOther   As New UfRecordset
   Dim lngCXResult      As Long
   
   If UfGridADO1.Row < 2 Then Exit Sub
   
   '---- 删除本地临时 Gl_vouchother
   DeleteGLVouchOther
   
   '---- 冲销凭证时加锁
   lngCXResult = LockVouchForCX(True)
   Select Case lngCXResult
      Case 1      '---- 其他用户正在冲销同一凭证
         MsgBox "其他用户正在冲销此张凭证，请过一会儿再试！", vbInformation, zjGl_Name
         Exit Sub
      Case 2      '---- 此张凭证已被其他用户冲销
         MsgBox "此张凭证已被其他用户冲销！", vbInformation, zjGl_Name
         fillgrid
         Exit Sub
   End Select
   
   sqlGlVouch = "SELECT * FROM GL_accvouch WHERE [coutsysname]='FD' AND [coutno_id]='" & _
      strID(UfGridADO1.Row - 2) & "' AND [iflag] IS NULL"
   Set rsGlVouch = dbsZJ.OpenRecordset(sqlGlVouch, dbOpenSnapshot)
   Set rsGlVouchOther = dbsZJ.OpenRecordset(aClsPub.WbTableName)
   While Not rsGlVouch.EOF
      With rsGlVouchOther
         .AddNew
         !coutaccset = rsGlVouch!coutaccset
         !ioutyear = rsGlVouch!ioutyear
         !coutsysname = rsGlVouch!coutsysname
         !coutsysver = rsGlVouch!coutsysver
         !doutbilldate = zjLogInfo.curDate
         !ioutperiod = zjLogInfo.iMonth
         !coutsign = rsGlVouch!coutsign
         !coutno_id = rsGlVouch!coutno_id
         !inid = rsGlVouch!inid
'         !doutdate = FormatDate(rsGlVouch!doutdate)                                       'Cuidong 2000.12.31
         If IsNull(rsGlVouch!doutdate) Then            'Cuidong 2000.12.31
            !doutdate = Null                           'Cuidong 2000.12.31
         Else                                          'Cuidong 2000.12.31
            !doutdate = FormatDate(rsGlVouch!doutdate) 'Cuidong 2000.12.31
         End If                                        'Cuidong 2000.12.31
         !coutbillsign = rsGlVouch!coutbillsign
         !coutid = rsGlVouch!coutid
         !idoc = rsGlVouch!idoc
         !cBill = zjLogInfo.cUserName
         !ccashier = rsGlVouch!ccashier
         !iFlag = rsGlVouch!iFlag
         !cDigest = rsGlVouch!cDigest
         !md = -rsGlVouch!md
         !mc = -rsGlVouch!mc
         !md_f = -rsGlVouch!md_f
         !mc_f = -rsGlVouch!mc_f
         !nFrat = rsGlVouch!nFrat
         !nd_s = rsGlVouch!nd_s
         !nc_s = rsGlVouch!nc_s
         !cCode = rsGlVouch!cCode
         !ccus_id = rsGlVouch!ccus_id
         !cdept_id = rsGlVouch!cdept_id
         !citem_class = rsGlVouch!citem_class
         !cItem_id = rsGlVouch!cItem_id
         !cperson_id = rsGlVouch!cperson_id
         !csup_id = rsGlVouch!csup_id
         !cSign = rsGlVouch!cSign
         !csettle = rsGlVouch!csettle
         !cn_id = rsGlVouch!cn_id
         If Not IsNull(rsGlVouch!dt_date) Then !dt_date = FormatDate(rsGlVouch!dt_date)
         !cname = rsGlVouch!cname
         !ccode_equal = rsGlVouch!ccode_equal
         !bvouchedit = False        'rsGlVouch!bvouchedit
         !bvouchaddordele = False   'rsGlVouch!bvouchaddordele
         !bvouchmoneyhold = True    'rsGlVouch!bvouchmoneyhold
         !bvalueedit = False        'rsGlVouch!bvalueedit