frmysinstock.frm

金算盘软件代码

Dim OldCol As Integer               '原来列
Dim intT1 As Integer               '应收数量列
Dim intT2 As Integer               '已收数量列
Dim intT3 As Integer               '本次数量列

Dim blnIsSave As Boolean            '判断是否能够存盘


'从对应视图取SQL语句，取出记录给列表
Private Sub GridList()
    
    Dim strSql As String
    Dim SelectSQL As String, FromSQl As String, WhereSQL As String
    Dim strWH As String
    Dim RecGrid As rdoResultset
    
    MesGrid.ListSet.ViewId = intViewID
    
    With GrdList
        .Redraw = False
        .FixedCols = 0
    End With
   
    With MesGrid.ListSet
        FromSQl = .FromOfSql
        SelectSQL = .SelectOfSql
        WhereSQL = .WhereOfSql
    End With

    strWH = " WHERE (ItemNature.strItemCategory='1' Or ItemNature.strItemCategory='2') AND (ItemActivity.lngActivityID =" & lngID & ")"
    If Trim(WhereSQL) <> "" Then strWH = strWH & "AND" & WhereSQL
    
    strSql = "SELECT ItemActivityDetail.lngActivityDetailID 业务明细ID,' ' 选择, " _
                  & "ItemUnit.lngUnitID 计量单位ID, ItemUnit.dblFactor 转换因子, " _
                  & "Item.lngMinUnitID 最小计量单位ID,ItemActivityDetail.dblQuantity 应出入库数量, " _
                  & "ItemActivityDetail.dblPositionQuantity 出入库数量,0 本次数量, "
    strSql = strSql & SelectSQL & " " & FromSQl & strWH
    
    Set RecGrid = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set DataGrid.Resultset = RecGrid
    RecGrid.Close
    
    With GrdList
        .SelectionMode = flexSelectionFree
        .FocusRect = flexFocusNone
        .FixedCols = intFixCols
        .ColWidth(0) = 0                        '业务明细ID
        .ColWidth(1) = 500
        .ColWidth(2) = 0                        '计量单位ID
        .ColWidth(3) = 0                      '转换因子
        .ColWidth(4) = 0                        '最小计量单位ID
        .ColWidth(5) = 0                       '应出入库数量
        .ColWidth(6) = 0                        '出入库数量
        .ColWidth(7) = 0                        '本次出入库数量
        .Redraw = True
    End With

End Sub


'在GRID列中显示转换后的数量值
Private Sub IntiShowGrid()

    Dim i As Integer, j As Integer, k As Integer
    Dim NumI As String, NumJ As String, NumK As String
    Dim NumbI As String, NumbJ As String, NumbK As String
    Dim strTmp As String
    i = intFixCols
    j = intFixCols
    k = intFixCols
    
    Do While (GrdList.TextMatrix(0, i) <> "应入数量")
        i = i + 1
        If i = GrdList.Cols Then
            i = GrdList.Cols - 1
            Exit Do
        End If
    Loop
    Do While (GrdList.TextMatrix(0, j) <> "已入数量")
        j = j + 1
        If j = GrdList.Cols Then
            j = GrdList.Cols - 1
            Exit Do
        End If
    Loop
    Do While (GrdList.TextMatrix(0, k) <> "本次入库数量")
        k = k + 1
        If k = GrdList.Cols Then
            k = GrdList.Cols - 1
            Exit Do
        End If
    Loop
    
    intT1 = i
    intT2 = j
    intT3 = k

    Dim NowRow As Integer
    NowRow = 1
    While NowRow < GrdList.Rows
        
        NumI = GrdList.TextMatrix(NowRow, 5)
        NumJ = GrdList.TextMatrix(NowRow, 6)
        NumK = GrdList.TextMatrix(NowRow, 7)
        strTmp = GrdList.TextMatrix(NowRow, 3)
        If strTmp = "" Then strTmp = "0"
        NumbI = NumberConvert(NumI, C2Dbl(strTmp), False)
        NumbJ = NumberConvert(NumJ, C2Dbl(strTmp), False)
        NumbK = NumberConvert(NumK, C2Dbl(strTmp), False)
        
        GrdList.TextMatrix(NowRow, i) = DisplayData(Me.hWnd, NumbI, C2Dbl(strTmp))
        GrdList.TextMatrix(NowRow, j) = DisplayData(Me.hWnd, NumbJ, C2Dbl(strTmp))
        GrdList.TextMatrix(NowRow, k) = DisplayData(Me.hWnd, NumbK, C2Dbl(strTmp))
        NowRow = NowRow + 1
    Wend
    CmdButRK_Click
End Sub

'窗体初始化
Public Sub IntiForm()
    
    lblTitle(0).Move LOrRSpace, IntSpace
    
    lblback(0).Move LOrRSpace, lblTitle(0).top + lblTitle(0).Height + IntSpace
    lblback(1).Move lblback(0).Left + BackSpace, lblback(0).top + BackSpace
    
    lblhead(0).Move lblback(0).Left + 135, lblback(0).top + HeadS
    
    lblhead(1).top = lblhead(0).top
    lblhead(2).top = lblhead(0).top
    
    lblhead(3).Move lblhead(0).Left, lblhead(0).top + lblhead(0).Height + HeadS
    lblhead(4).top = lblhead(3).top
    
    Dim i As Integer
    For i = 0 To lblhead.Count - 1
        lblHeadCaption(i).top = lblhead(i).top
    Next i
    
    CmdButton(0).top = lblback(0).top
    CmdButton(1).top = CmdButton(0).top + CmdButton(0).Height + IntSpace
    
    lblTitle(1).Move LOrRSpace, lblback(1).top + lblback(1).Height + IntSpace
    
    GrdList.Move LOrRSpace, lblTitle(1).top + lblTitle(1).Height + IntSpace
    
    CmdButton(2).top = GrdList.top
    CmdButton(3).top = CmdButton(2).top + CmdButton(2).Height + IntSpace
End Sub

'窗体尺寸大小改变
Public Sub RedrawForm()
    Dim lRate As Integer
    
    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
    
    Me.Refresh
'    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
    
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 CalText_LostFocus()
'    If GrdList.col = 12 And C2lng(lblTitle(1).Tag) = GrdList.Row Then
'        BlnNumIsTure
'        If blnIsSave = False Then Exit Sub
'    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()
'    If Caltext.Visible Then
'        BlnNumIsTure                        '判断数据是否正确
'    End If
'    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