frmcostpricecheck.frm

金算盘软件代码

        For i = 0 To j Step 1
            strDecodeID = strDecodeID & mlngID(i) & ",'√',"
        Next i
        strDecodeID = Left(strDecodeID, Len(strDecodeID) - 1)
        strDecodeID = strDecodeID & "' ')"
    End If
    With msgGrid
        .Redraw = False
        .FixedCols = 0
    End With
    With mclsGrid1.ListSet
        '商品业务明细ID，商品ID，选择明细ID，选择
        strSelect = "SELECT ItemActivityDetail.lngActivityDetailID AS ID," _
            & "Item.lngItemID,decode(ItemActivityDetail.lngOrderDetailID , 0,1,0)" _
            & " AS blnShow,"
        If Len(strDecodeID) > 0 Then
            strSelect = strSelect & "decode(ItemActivityDetail.lngActivityDetailID," _
                & strDecodeID & " AS 选择 "
        Else
            strSelect = strSelect & "'√'  AS 选择 "
        End If
        If StrLen(LTrim(.SelectOfSql)) = 0 Then
            strSelect = strSelect
        Else
            strSelect = strSelect & "," & .SelectOfSql
        End If
        
        strFrom = .FromOfSql & " WHERE " & .WhereOfSql
'        strWhere = .WhereOfSql
        '只取“单价”或“金额”不为0的记录
'        strWhere = " ItemActivityDetail.dblQuantity<>0  AND ItemActivity.blnIsVoid = 0 " & " AND iif(isdate(ItemActivity.strReceiptDate),cDate(ItemActivity.strReceiptDate),#" & datBegine & "#)>=#" & datBegine _
'                 & "# AND " & "IIf(ISdate(ItemActivity.strReceiptDate),cdate(ItemActivity.strReceiptDate),#" & datEnd & "#)<=#" & datEnd & "#"
        strWhere = " ItemActivityDetail.dblQuantity<>0 AND ItemActivity.lngVoucherID=0  AND ItemActivity.blnIsVoid = 0 AND ItemActivity.strDate>='" & Format(datBegine, "yyyy-mm-dd") _
                 & "' AND " & "ItemActivity.strDate<='" & Format(datEnd, "yyyy-mm-dd") & "'"

    End With
    strSQL = strSelect & strFrom & " AND ActivityType.lngActivityTypeID=8 AND Item.lngItemID" _
        & " IN(" & mstrItemID & ")"
        ' AND ItemActivity.lngCurrencyID=" & lngNaturalCurID & "           '有币种限制吗？
    Dim strCode As String
    Dim strName As String
    IdToCodeAndName xItem, mstrItemID, strCode, strName
    Label1.Caption = "商品： " & strCode & " " & strName
    If Trim(strInID) = "" Then strInID = "(0)"
    
    If Len(strWhere) > 0 And blnWhere Then
        strSQL = strSQL & " AND (ItemActivityDetail.lngActivityDetailID IN " & strInID & " OR (" & strWhere & "))"
    Else
        If Not blnWhere Then
            strWhere = Filter.GetInitWhere(mclsGrid1.ListSet.ListID, 1)
            If Trim(strWhere) = "" Then
'                strSQL = strSQL & "AND ItemActivity.blnIsVoid = 0 AND ItemActivity.lngVoucherID=0  AND ItemActivity.strDate>='" & Format(datBegine, "yyyy-mm-dd") _
'                    & "' AND ItemActivity.strDate<='" & Format(datEnd, "yyyy-mm-dd") & "'"
                strSQL = strSQL & "AND ItemActivity.blnIsVoid = 0 AND ItemActivity.lngVoucherID=0 "
            Else
                strSQL = strSQL & " AND ItemActivity.blnIsVoid = 0 AND ItemActivity.lngVoucherID=0 AND ((" & strWhere & ") OR (ItemActivityDetail.lngActivityDetailID IN " & strInID & "))"
            End If
        End If
    End If
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If Not recRecordset.EOF Then
        recRecordset.MoveLast
        recRecordset.MoveFirst
    End If
    Set datCostPrice.Resultset = recRecordset
    recRecordset.Close
    Set recRecordset = Nothing
    With msgGrid
        For i = 1 To .Cols - 1
            If InStr(.TextMatrix(0, i), "日") <> 0 Then
               Exit For
            End If
        Next
        If j <> .Cols Then
         For j = .Rows - 1 To 1 Step -1
             If gclsBase.PeriodClosed(.TextMatrix(j, i)) <> 0 Then
                If j <> 1 Then
                   .RemoveItem j
                Else
                   .Rows = 1
                End If
             End If
         Next
        End If
        .SelectionMode = flexSelectionFree
        .FocusRect = flexFocusLight
        .Redraw = True
    End With
    On Error Resume Next
    mclsGrid1.ListSetToGrid
    mclsGrid1.SetupStyle
    msgGrid.FixedCols = 4
    msgGrid.ColWidth(1) = 0
    msgGrid.ColWidth(2) = 0
    msgGrid.ColWidth(7) = 0
    msgGrid.ColWidth(8) = 0
    msgGrid.ColWidth(msgGrid.Cols - 1) = 0
    msgGrid.ColWidth(3) = 420
    Call Make_Color
    If msgGrid.Rows > 1 Then
       msgGrid.col = 3               '对第一列进行排序
       msgGrid.ColSel = 3
       msgGrid.Row = 1
       msgGrid.RowSel = 1
       msgGrid.Sort = 6
    End If
End Sub

Private Sub Form_Resize()
   Dim leftx As Integer
    If Me.WindowState = 1 Then
       Exit Sub
    End If
    If Me.width < 7368 Then
        Me.width = 7368
    End If
    msgGrid.width = Me.ScaleWidth - DlListFormLeft - DlListFormRight * 2 - DlFormButtonWidth
    If Me.Height < 4018 Then
        Me.Height = 4018
    End If
    msgGrid.Height = Me.ScaleHeight - DlListUpAreaHeight + 128
    leftx = Me.ScaleLeft + Me.ScaleWidth - DlFormButtonWidth - DlListFormRight + 18
    cmdCostPrice(5).Left = leftx
    cmdCostPrice(6).Left = leftx
    cmdCostPrice(1).Left = leftx
    cmdCostPrice(2).Left = leftx
    cmdCostPrice(3).Left = leftx
    cmdCostPrice(4).Left = leftx
    'cmdCostPrice(5).Left = leftx
'    cmdCostPrice(6).Left = leftx
    Me.Refresh
End Sub

Private Sub Form_Unload(Cancel As Integer)
'响应退出窗体动作
    If blnIsCancel = False And msgGrid.Rows > 1 Then
       If Balance.IsChange(msgGrid, 3) Then
            If ShowMsg(Me.hWnd, "确定退出选择单据吗", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "选择单据") = IDNO Then
                Cancel = True
                Exit Sub
            End If
       End If
    End If
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1010)
    Utility.RemoveFormResPicture (2001)
    Utility.RemoveFormResPicture 139
    Set mclsGrid1 = Nothing
End Sub

Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'鼠标在Grid上移动响应的事件
    With msgGrid
        If x < .ColWidth(3) And y < .Rows * .RowHeight(0) Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub
'全选
Private Sub Select_All(ByVal strChoose As String)
'完全选择
    Dim i As Integer
    With msgGrid
        i = 1
        Do While i < .Rows
            If .TextMatrix(i, 2) = 0 Then
                '.TextMatrix(i, 3) = ""
            Else
                .TextMatrix(i, 3) = strChoose
            End If
            i = i + 1
        Loop
    End With
End Sub
'筛选
Private Sub Select_Some()
    Dim datBegine As Date
    Dim datEnd As Date
    Dim bytPeriod As Byte
    Dim intYear As Integer
    intYear = Year(gclsBase.BaseDate)
    bytPeriod = gclsBase.Period
    Call gclsBase.DateOfPeriod(intYear, bytPeriod, datBegine, datEnd)
    
    mclsGrid1.ListSet.SaveList
    Filter.ShowFilter mclsGrid1.ListSet.ListID, 1
    'Filter.ShowFilter mclsGrid1.ListSet.ListID, 1,64,mstrCond,日期,日期/自定义/datBegine,datEnd
    mclsGrid1.ListSet.SaveList
    mclsGrid1.ListSet.ViewId = 109
    Call RefreshGrid(False)
End Sub
'确定写单据GRID(传递一个数组)
Private Sub Select_OK()
    Dim i As Integer
    Dim j As Integer
    ReDim Preserve mlngID(0)
    i = 1
    j = 0
    With msgGrid
        Do While i < .Rows
            If .TextMatrix(i, 3) = "√" Then
                j = UBound(mlngID)
                ReDim Preserve mlngID(j + 1)
                mlngID(j) = .TextMatrix(i, 0)
            End If
            i = i + 1
        Loop
    End With
    ReDim Preserve mlngID(j + 1)
    mlngID(j + 1) = 0
    Call FrmCostPrice.SET_SelectedReceipts(mlngID)
'    Unload Me
End Sub
'根据对照表设置列表颜色
Private Sub Make_Color()
    Dim i As Integer
    Dim j As Integer
    Dim intRow As Integer
    Dim intCol As Integer
    
    ReDim blnOldSelect(0)
    With msgGrid
        intRow = .Row
        intCol = .col
        i = 1
        Do While i < .Rows
            ReDim Preserve blnOldSelect(i)
            If .TextMatrix(i, 2) = 0 Then
'                .TextMatrix(i, 3) = ""
                blnOldSelect(i) = True
                .Row = i
                For j = 3 To .Cols - 1 Step 1
                    .col = j
                    .CellBackColor = RGB(192, 192, 192)
                Next j
            Else
                .Row = i
                blnOldSelect(i) = False
                For j = 3 To .Cols - 1 Step 1
                    .col = j
                    .CellBackColor = RGB(255, 255, 255)
                Next j
            End If
            '写数量
            msgGrid.TextMatrix(i, msgGrid.Cols - 3) = BillPublic.DisplayData(Me.hWnd, NumberConvert(msgGrid.TextMatrix(i, msgGrid.Cols - 3), msgGrid.TextMatrix(i, msgGrid.Cols - 1), False), msgGrid.TextMatrix(i, msgGrid.Cols - 1))
            i = i + 1
        Loop
        .Row = intRow
        .col = intRow
    End With
End Sub

Private Sub msgGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgGrid
      If .Rows > 1 Then
        If x < .ColWidth(3) + 20 And y < .Rows * .RowHeight(0) Then
            If .TextMatrix(.Row, 2) = 0 Then
                ShowMsg Me.hWnd, "该明细已经计入入库成本单中", vbInformation, Me.Caption
                Exit Sub
            End If
            If .TextMatrix(.Row, 3) = "" Then
                .TextMatrix(.Row, 3) = "√"
            Else
                .TextMatrix(.Row, 3) = ""
            End If
        End If
      End If
    End With
End Sub
Public Sub getDim(ByRef fromDim() As Long, ByVal strItemID As String)
'将商品ID取到模块数组中
    Dim i As Integer
    ReDim mlngID(UBound(fromDim) - LBound(fromDim))
    For i = 0 To UBound(mlngID) - 1
        mlngID(i) = fromDim(i)
    Next
    mstrItemID = strItemID
    If Len(Trim(mstrItemID)) = 0 Then
       Exit Sub
    End If
End Sub