frmysinstock.frm

金算盘软件代码

        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)
    lngID = 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
    
    IntiForm
    
    Set CmdButton(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set CmdButton(1).Picture = Utility.GetFormResPicture(1002, 0)
    
    MesGrid.ColOfs = intFixCols
    
    ReceiptHeadSQL
    GridList
    RedrawForm
    
    MesGrid.SetupStyle
    GrdList.ColSel = 0
    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_Load()
    Me.HelpContextID = 10025
    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 AS 部门, 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=" & lngID
    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))
                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, "请将结算栏放在第一列上！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
            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
        Dim strNum As String    '保存当前输入框内的文本内容
        Dim Start As Integer    '保存输入的数据的小数点左边的位数
        Dim NumC As String, NumR As Double  'NumC存录入字符串的小数部分，NumR存转换因子
        
        NwCol = GrdList.col
        NwRow = GrdList.Row
        
        blnIsSave = True
        
        Start = InStr(Trim(CalText.Text), ".")
        If Start = 0 Then
            NumC = 0
        Else
            NumC = Mid(Trim(CalText.Text), Start + 1)
        End If
        NumR = C2Dbl(GrdList.TextMatrix(GrdList.Row, 3))
        
        If (C2Dbl(NumC) >= NumR) Or (Len(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
'            NumK = DisplayData(Me.hwnd, NumK, C2Dbl(grdList.TextMatrix(NwRow, 3)))
'            NumI = DisplayData(Me.hwnd, NumI, C2Dbl(grdList.TextMatrix(NwRow, 3)))
''           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