frmspsend.frm

金算盘软件代码

    cmdButton(0).Left = Me.ScaleWidth - cmdButton(0).width - LOrRSpace
    cmdButton(1).Left = cmdButton(0).Left
    cmdButton(2).Left = cmdButton(0).Left
    cmdButton(3).Left = cmdButton(0).Left
    
    LblBack(0).width = cmdButton(0).Left - 200
    LblBack(1).width = LblBack(0).width
    
    lRate = CInt(LblBack(1).width / 3)
    lblHead(1).Left = LblBack(0).Left + lRate + 600
    lblHead(2).Left = LblBack(0).Left + 2 * lRate + 200
    lblHead(4).Left = lblHead(1).Left
    
    Dim i As Integer
    For i = 0 To lblHeadCaption.Count - 1
        lblHeadCaption(i).Left = lblHead(i).Left + lblHead(i).width + PartSpace
    Next i
    lblHeadCaption(0).width = lblHead(1).Left - lblHeadCaption(0).Left - PartSpace
    lblHeadCaption(1).width = lblHead(2).Left - lblHeadCaption(1).Left - PartSpace
    lblHeadCaption(2).width = LblBack(0).Left + LblBack(0).width - lblHeadCaption(2).Left - PartSpace
    lblHeadCaption(3).width = lblHeadCaption(0).width
    lblHeadCaption(4).width = LblBack(0).Left + LblBack(0).width - lblHeadCaption(4).Left - PartSpace
    
    grdList.width = LblBack(1).width
    grdList.Height = Me.ScaleHeight - IntSpace - grdList.top
    
'    Dim intColSSWidth As Integer
'    Dim NCol As Integer

'    With grdList
'
'        intColSSWidth = Int((.Width - .ColWidth(1)) / 5) - 50
'
'        NCol = intFixCols
'        While NCol < .Cols
'            .ColWidth(NCol) = intColSSWidth
'            NCol = NCol + 1
'        Wend
'
'    End With
EndProc:
End Sub

Private Sub CalText_GotFocus()
    Debug.Print grdList.Row
    lblTitle(1).Tag = grdList.Row
End Sub

Private Sub CalText_KeyUp(ByVal KeyCode As Integer, ByVal Shift As Integer)
    If KeyCode = 13 Then
        If grdList.Row = grdList.Rows - 1 Then
            cmdButton(0).SetFocus
        End If
    End If

End Sub

Private Sub cmdButton_Click(Index As Integer)

    Select Case Index
        Case 0
            If grdList.col = 12 And C2lng(lblTitle(1).Tag) = grdList.Row And CalText.Text <> "" Then
                BlnNumIsTure
                If blnIsSave = False Then Exit Sub
            End If
            CmdButOK_Click              '确定
        Case 1
            CmdButCan_Click             '取消
        Case 2
            CmdButRK_Click              '全部出库
        Case 3
            CmdButAllCan_Click          '全部取消
    End Select
    
End Sub
 
 '确定
Private Sub CmdButOK_Click()
    
'    BlnNumIsTure                        '判断数据是否正确
'
'    If Not blnIsSave Then
'        ShowMsg Me.hWnd, "存盘失败", MB_ICONEXCLAMATION + MB_SYSTEMMODAL
'        Exit Sub
'    End If
  
    SaveData
    
    Unload Me
   
End Sub

'存盘
Private Sub SaveData()
    
    Dim i As Integer
    Dim NumJ As Double, NumK As Double, Num As Double
    Dim intDetailID As Long
    
    i = 1
    While i < grdList.Rows
        
        NumJ = C2Dbl(IIf(grdList.TextMatrix(i, 6) = "", 0, grdList.TextMatrix(i, 6)))
        NumK = C2Dbl(IIf(grdList.TextMatrix(i, 7) = "", 0, grdList.TextMatrix(i, 7)))

        Num = NumJ + NumK
        intDetailID = C2lng(grdList.TextMatrix(i, 0))
        
        Dim strSql As String
        strSql = " UPDATE ItemActivityDetail SET dblPositionQuantity = " & Num & " WHERE lngActivityDetailID = " & intDetailID
        gclsBase.ExecSQL strSql
        i = i + 1
    Wend
    
End Sub
 
 '取消
Private Sub CmdButCan_Click()

    Unload Me
    
End Sub

'全部出库
Private Sub CmdButRK_Click()

    Dim k As Integer
    Dim NowRow As Integer
    
    k = intFixCols
    
    While (grdList.TextMatrix(0, k) <> "本次出库数量")
        k = k + 1
    Wend
    
    NowRow = 1
    Do While NowRow < grdList.Rows
        grdList.TextMatrix(NowRow, 1) = "√"
                
        Dim NumI As Double, NumJ As Double, NumK As Double
        Dim Num As String
        
        NumI = C2Dbl(IIf(grdList.TextMatrix(NowRow, 5) = "", 0, grdList.TextMatrix(NowRow, 5)))
        NumJ = C2Dbl(IIf(grdList.TextMatrix(NowRow, 6) = "", 0, grdList.TextMatrix(NowRow, 6)))
        NumK = NumI - NumJ
        
        grdList.TextMatrix(NowRow, 7) = CStr(NumK)
        
        Num = NumberConvert(CStr(NumK), grdList.TextMatrix(NowRow, 3), False)
        grdList.TextMatrix(NowRow, k) = DisplayData(Me.hwnd, Num, grdList.TextMatrix(NowRow, 3))
        
        NowRow = NowRow + 1
    Loop
    
    CalText.Text = grdList.TextMatrix(grdList.Row, k)
    
End Sub


'全部取消
Private Sub CmdButAllCan_Click()

    Dim k As Integer
    Dim NowRow As Integer
    
    k = intFixCols
    While (grdList.TextMatrix(0, k) <> "本次出库数量")
        k = k + 1
    Wend
    
    NowRow = 1
    Do While NowRow < grdList.Rows
        grdList.TextMatrix(NowRow, 1) = ""
        grdList.TextMatrix(NowRow, k) = ""
        grdList.TextMatrix(NowRow, 7) = ""
        NowRow = NowRow + 1
    Loop
    
    If CalText.Text <> "" Then CalText.Text = ""
    
End Sub
Public Sub Into(ByVal frmName As Form)
    intID = frmName.getID
    lblTitle(0).Caption = Trim(frmName.Caption) & "单信息"
    Screen.MousePointer = vbHourglass
    Set MesGrid = New Grid
    Set MesGrid.Grid = grdList
    Set MesGrid.Form = Me
    MesGrid.HwndCancel = cmdButton(1).hwnd
    
    CalText.Digits = 10
    Me.Height = 5000
    Me.width = 9000
    Me.top = (Screen.Height - Me.Height) / 2 '4000
    Me.Left = (Screen.width - Me.width) / 2 '2000
    Me.KeyPreview = True
    
    IntiForm
    
    ReceiptHeadSQL
    
    Set cmdButton(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdButton(1).Picture = Utility.GetFormResPicture(1002, 0)
    
    MesGrid.ColOfs = intFixCols
    GridList
    RedrawForm
    
    MesGrid.SetupStyle
    If grdList.Rows > 1 Then
        grdList.Row = 1
        grdList.col = 12
    End If
    
    MesGrid.ListSetToGrid
    
    Set MesGrid.EditText = CalText
    MesGrid.SetEditText "本次出库数量"

    IntiShowGrid
    Screen.MousePointer = vbDefault
    Me.Show vbModal
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    Me.HelpContextID = 10015
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
End Sub

Private Sub Form_Resize()

    If Me.WindowState = 1 Then Exit Sub
    
    If Me.Height < intFormHeight Then Me.Height = intFormHeight
    If Me.width < intFormWidth Then Me.width = intFormWidth
    
    RedrawForm
    
End Sub

Private Sub ReceiptHeadSQL()

    Dim strSql As String
    Dim rec As rdoResultset

    strSql = "SELECT ItemActivity.strDate 日期, Employee.strEmployeeName 职员, " & _
                  "Department.strDepartmentName 部门, Customer.strCustomerName 单位, " & _
                  "ItemActivity.strReceiptNO || ltrim(to_char(ItemActivity.lngReceiptNO,'0000')) 单据号 " & _
             "FROM ItemActivityDetail,ItemActivity,Employee,Department,Customer " & _
             "WHERE ItemActivityDetail.lngActivityID = ItemActivity.lngActivityID AND ItemActivity.lngEmployeeID = Employee.lngEmployeeID(+) and ItemActivity.lngDepartmentID = Department.lngDepartmentID(+) and ItemActivity.lngCustomerID = Customer.lngCustomerID(+) AND " & _
             "ItemActivity.lngActivityID=" & intID
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)

    If rec.EOF And rec.BOF Then Exit Sub
    
    With rec
        .MoveFirst
        lblHeadCaption(0).Caption = IIf(IsNull(!单位), "", !单位)
        lblHeadCaption(2).Caption = IIf(IsNull(!单据号), "", !单据号)
        lblHeadCaption(3).Caption = IIf(IsNull(!部门), "", !部门)
        lblHeadCaption(4).Caption = IIf(IsNull(!职员), "", !职员)
        lblHeadCaption(1).Caption = IIf(IsNull(!日期), "", !日期)
    End With
    
    rec.Close
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set MesGrid = Nothing

    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture 139
    
End Sub

Private Sub grdList_Click()

    If grdList.Row > 0 And grdList.MouseRow > 0 Then
        
        If grdList.TextMatrix(0, 1) = "选择" And grdList.MouseCol = 1 Then
        
            Dim k As Integer
            Dim NowRow As Integer
            NowRow = grdList.Row
            
            k = intFixCols
            
            While (grdList.TextMatrix(0, k) <> "本次出库数量")
                k = k + 1
            Wend
            
            If grdList.TextMatrix(NowRow, 1) = "√" Then
                grdList.TextMatrix(NowRow, 1) = ""
                grdList.TextMatrix(NowRow, k) = ""
                grdList.TextMatrix(NowRow, 7) = ""
            Else
                grdList.TextMatrix(NowRow, 1) = "√"
                
                Dim NumI As Double, NumJ As Double, NumK As Double
                Dim Num As String
                
'                NumI = C2Dbl(IIf(grdList.TextMatrix(NowRow, 5) = "", 0, grdList.TextMatrix(NowRow, 5)))
'                NumJ = C2Dbl(IIf(grdList.TextMatrix(NowRow, 6) = "", 0, grdList.TextMatrix(NowRow, 6)))
'                NumK = NumI - NumJ
'
'                grdList.TextMatrix(NowRow, 7) = NumK
'                NumK = C2Dbl(grdList.TextMatrix(NowRow, 7))
'                Num = NumberConvert(CStr(NumK), grdList.TextMatrix(NowRow, 3), False)
'                grdList.TextMatrix(NowRow, k) = DisplayData(Me.hwnd, Num, grdList.TextMatrix(NowRow, 3))
                NumK = C2Dbl(grdList.TextMatrix(NowRow, 5)) - C2Dbl(grdList.TextMatrix(NowRow, 6))
                Num = NumberConvert(CStr(NumK), grdList.TextMatrix(NowRow, 3), False)
                grdList.TextMatrix(NowRow, k) = DisplayData(Me.hwnd, Num, grdList.TextMatrix(NowRow, 3))
                grdList.TextMatrix(NowRow, 7) = NumK
                grdList.col = 12
                
            End If
        Else
            If (grdList.TextMatrix(0, 1) <> "选择") Then
               ShowMsg Me.hwnd, ("请将结算栏放在第一列上！！"), 0, "提示"
            End If
        End If
    End If
    
End Sub


'判断所输出的本次出库数量是否正确
Private Sub BlnNumIsTure()

        Dim NumI As Double, NumJ As Double, NumK As Double
        Dim NwRow As Integer, NwCol As Integer
        Dim blnIsOut As Boolean
        
        NwCol = grdList.col
        NwRow = grdList.Row
        
        blnIsSave = True
    
        Dim strNum As String
        Dim Start As Integer
        Dim NumC As Double, NumR As Double
        
        Start = InStr(Trim(CalText.Text), ".")
        If Start = 0 Then
            NumC = 0
        Else
            NumC = C2Dbl(Mid(Trim(CalText.Text), Start + 1))
        End If
        NumR = C2Dbl(grdList.TextMatrix(grdList.Row, 3))
         
        
       If (NumC >= NumR) Or (Len(CStr(NumC)) > Len(CStr(NumR))) Then
            ShowMsg Me.hwnd, "数量小数部分录入错误！", MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "错误提示"
            blnIsSave = False
            Exit Sub
        End If
        
        strNum = DisplayData(Me.hwnd, CalText.Text, grdList.TextMatrix(NwRow, 3))
        grdList.TextMatrix(NwRow, 7) = NumberConvert(strNum, grdList.TextMatrix(NwRow, 3))
        NumI = C2Dbl(IIf(grdList.TextMatrix(NwRow, 5) = "", 0, grdList.TextMatrix(NwRow, 5)))
        If NumI < 0 Then
            blnIsOut = True
        Else
            blnIsOut = False
        End If
        NumJ = C2Dbl(IIf(grdList.TextMatrix(NwRow, 6) = "", 0, grdList.TextMatrix(NwRow, 6)))
        NumK = C2Dbl(IIf(grdList.TextMatrix(NwRow, 7) = "", 0, grdList.TextMatrix(NwRow, 7)))
        '判断“已出数量”+“本次出库数量”是否大于等于0
        If (NumJ + NumK < 0 And blnIsOut = False) Then
            ShowMsg Me.hwnd, "已出数量和本次出库数量之和应大于等于零", MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "错误提示"
            blnIsSave = False
            grdList.TextMatrix(NwRow, 7) = NumberConvert(grdList.TextMatrix(NwRow, NwCol), grdList.TextMatrix(NwRow, 3))
            Exit Sub
        ElseIf (blnIsOut = True And NumJ + NumK > 0) Then
            ShowMsg Me.hwnd, "已出数量和本次出库数量之和应小于等于零", MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "错误提示"
            blnIsSave = False
            grdList.TextMatrix(NwRow, 7) = NumberConvert(grdList.TextMatrix(NwRow, NwCol), grdList.TextMatrix(NwRow, 3))
            Exit Sub
        End If
'        '判断“本次出库数量”是否大于“应出数量”-“已出数量”
'        If (blnIsOut = False And NumK > NumI - NumJ) Or (blnIsOut = True And NumK < NumI - NumJ) Then
''            ShowMsg Me.hwnd, "本次出库数量( " & IIf(blnIsOut, (-1) * NumK, NumK) & " )加上已出库数量( " & IIf(blnIsOut, (-1) * NumJ, NumJ) & " )大于了应出库数量( " & IIf(blnIsOut, (-1) * NumI, NumI) & " )，请重新录入本次出库数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "错误提示"
'            ShowMsg Me.hwnd, "本次出库数量( " & CalText.Text & " )加上已出库数量( " & grdList.TextMatrix(NwRow, intT2) & " )大于了应出库数量( " & grdList.TextMatrix(NwRow, intT1) & " )， 请重新录入本次出库数量！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "错误提示"
'            blnIsSave = False
'            grdList.TextMatrix(NwRow, 7) = NumberConvert(grdList.TextMatrix(NwRow, NwCol), grdList.TextMatrix(NwRow, 3))
'            Exit Sub
'        End If
        '判断“应出数量”是否大于等于“已出数量”+“本次出库数量”
        If (blnIsOut = False And NumI < NumJ + NumK) Or (blnIsOut = True And NumI > NumJ + NumK) Then
            
            ShowMsg Me.hwnd, "应出数量应该大于等于已出数量和本次出库数量之和", MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "错误提示"
            blnIsSave = False
            grdList.TextMatrix(NwRow, 7) = NumberConvert(grdList.TextMatrix(NwRow, NwCol), grdList.TextMatrix(NwRow, 3))
            Exit Sub
            
        End If
        
        If C2Dbl(strNum) <> 0 Then
            grdList.TextMatrix(NwRow, 1) = "√"
        Else
            grdList.TextMatrix(NwRow, 1) = ""
        End If
        
        CalText.Text = Val(strNum)
        grdList.TextMatrix(NwRow, 7) = NumberConvert(strNum, grdList.TextMatrix(NwRow, 3))
End Sub


Private Sub GrdList_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    
    With grdList
        If .MouseCol = 1 Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With

End Sub

Private Sub MesGrid_AfterSave()
    If InStr(Abs(Val(grdList.TextMatrix(grdList.Row, 12))), ".") = 1 Then
        If C2Dbl(grdList.TextMatrix(grdList.Row, 12)) > 0 Then
            grdList.TextMatrix(grdList.Row, 12) = "0" & Abs(Val(grdList.TextMatrix(grdList.Row, 12)))
        ElseIf C2Dbl(grdList.TextMatrix(grdList.Row, 12)) < 0 Then
            grdList.TextMatrix(grdList.Row, 12) = "-0" & Abs(Val(grdList.TextMatrix(grdList.Row, 12)))
        Else
            grdList.TextMatrix(grdList.Row, 12) = ""
        End If
    End If
End Sub

Private Sub MesGrid_DataValid(blnCancel As Boolean)

    BlnNumIsTure

    If Not blnIsSave Then
        blnCancel = True
    End If
    
End Sub