frmselectbill.frm

金算盘软件代码

'        .Parameters("DetailID") = 0
'        .Parameters("ActivityID") = frmName.getID
'        If lngReceiptTypeID = 2 Then
'            .Parameters("Borrow") = 0
'        ElseIf lngReceiptTypeID = 3 Then
'            .Parameters("Borrow") = 1
'        ElseIf lngReceiptTypeID = 4 Then
'            .Parameters("Borrow") = -1
'        ElseIf lngReceiptTypeID = 8 Or lngReceiptTypeID = 20 Then
'            .Parameters("NotVoucher") = 0
'        End If
'        Set Data1.Recordset = .OpenResultset(rdOpenStatic)
'    End With
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Data1.Resultset.Close
    SaveGrdColWidth
    Utility.UnLoadFormResPicture Me
'    Utility.RemoveFormResPicture 139
'    Utility.RemoveFormResPicture 1001
'    Utility.RemoveFormResPicture 1002
'    Utility.RemoveFormResPicture 1021
    Utility.RemoveFormResPicture 2001
    Set frmName = Nothing
    Erase strColName
    Erase lngSelected
    Erase xlngColNo
    Set mclsGrid = Nothing
End Sub

Private Sub GrdCol_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeySpace Then
        If GrdCol.Row >= GrdCol.FixedRows Then
            If GrdCol.TextMatrix(GrdCol.Row, 1) = "" Then
                GrdCol.TextMatrix(GrdCol.Row, 1) = "√"
            Else
                GrdCol.TextMatrix(GrdCol.Row, 1) = ""
            End If
        End If
    End If
End Sub

Private Sub grdCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If x < GrdCol.ColWidth(1) And y > GrdCol.RowHeight(0) Then
        If y > GrdCol.RowPos(GrdCol.Rows - 1) + GrdCol.RowHeight(GrdCol.Rows - 1) Then
            GrdCol.MousePointer = flexDefault
        Else
            GrdCol.MousePointer = 99
        End If
    Else
        GrdCol.MousePointer = flexDefault
    End If
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        GrdCol.Redraw = False
        For i = 0 To GrdCol.Cols - 1
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                lngRowBak = GrdCol.RowData(GrdCol.Row)
                GrdCol.Row = 0
                GrdCol.col = i
                If GrdCol.ColAlignment(i) = flexAlignRightCenter Then
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = C2Dbl(GrdCol.TextMatrix(j, i))
                        Next
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortNumericDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = flexSortNumericAscending
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strCurrDec)
                        Next
                    End If
                Else
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortStringNoCaseDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = 5
                    End If
                End If
                For j = 1 To GrdCol.Rows - 1
                    If GrdCol.RowData(j) = lngRowBak Then
                        GrdCol.Row = j
                        If Not GrdCol.RowIsVisible(j) Then
                            GrdCol.TopRow = j
                        End If
                        Exit For
                    End If
                Next
            Else
                GrdCol.TextMatrix(0, i) = ColName(i)
            End If
        Next
        GrdCol.Redraw = True
    Else
        If y <= GrdCol.RowPos(GrdCol.Rows - 1) + GrdCol.RowHeight(GrdCol.Rows - 1) Then
            If GrdCol.Row >= GrdCol.FixedRows Then
                If GrdCol.TextMatrix(GrdCol.Row, 1) = "" Then
                    GrdCol.TextMatrix(GrdCol.Row, 1) = "√"
                Else
                    GrdCol.TextMatrix(GrdCol.Row, 1) = ""
                End If
            End If
        End If
    End If
End Sub

Private Sub LoadGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    strSql = "SELECT strKey,strSetting FROM Setting WHERE lngModuleID=0 AND strSection='" & Me.Name & CStr(lngReceiptTypeID) & "列宽'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        FirstGrdColWidth
    Else
        Do While Not recTmp.EOF
            GrdCol.ColWidth(C2lng(recTmp!strKey)) = C2lng(recTmp!strSetting)
            recTmp.MoveNext
        Loop
    End If
    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Sub FirstGrdColWidth()
    Dim lngTmp As Long
    Dim i As Integer
    
    lngTmp = 0
    For i = 1 To GrdCol.Cols - 1
        lngTmp = lngTmp + IIf(InStr(GrdCol.TextMatrix(0, i), "日期") <> 0, 10, StrLen(GrdCol.TextMatrix(0, i)))
    Next
    For i = 1 To GrdCol.Cols - 1
        GrdCol.ColWidth(i) = Int((GrdCol.width - 5 * Screen.TwipsPerPixelX) * IIf(InStr(GrdCol.TextMatrix(0, i), "日期") <> 0, 10, StrLen(GrdCol.TextMatrix(0, i))) / lngTmp)
    Next
End Sub
Private Sub SaveGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    On Error GoTo ErrHandle
    GetLngColNO
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    strSql = " FROM Setting WHERE lngModuleID=0 AND strSection='" & Me.Name & CStr(lngReceiptTypeID) & "列宽'"
    gclsBase.BaseDB.Execute "DELETE " & strSql
        
    strSql = "SELECT *" & strSql
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With recTmp
        For i = 1 To GrdCol.Cols - 1
            .AddNew
            !lngModuleID = 0
            !strSection = Me.Name & CStr(lngReceiptTypeID) & "列宽"
            !strKey = i
            !strSetting = CStr(IIf(GrdCol.ColWidth(xlngColNo(i)) < 400, 400, GrdCol.ColWidth(xlngColNo(i))))
            !strTypeName = "Long"
            .Update
        Next
    End With
    recTmp.Close
    Set recTmp = Nothing
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
ErrHandle:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    gclsBase.BaseWorkSpace.RollBacktrans
End Sub


Private Sub cmdokcancel_Click(index As Integer)
    Dim i As Long
    
    Select Case index
    Case 0
        GetLngColNO
        cmdOK_Click
        frmName.WriteTotalRow
        Unload Me
    Case 1
        blnSucceed = False
        Unload Me
    Case 2
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "√" Then
                GrdCol.TextMatrix(i, 1) = "√"
            End If
        Next
    Case 3
        For i = 1 To GrdCol.Rows - 1
            If GrdCol.TextMatrix(i, 1) <> "" Then
                GrdCol.TextMatrix(i, 1) = ""
            End If
        Next
    End Select
End Sub

Private Sub cmdOK_Click()
    Dim i As Long
    Dim lngRowno As Long
    Dim lngTmp As Long
    Dim blnDelete() As Boolean
    
    blnSucceed = False
    ReDim blnDelete(frmName.GrdCol.Rows - 1)
    '清除
    For i = 1 To GrdCol.Rows - 1
        If GrdCol.TextMatrix(i, 1) <> "" Then
            blnSucceed = True
            Exit For
        End If
    Next
    If i = GrdCol.Rows Then
        For i = GrdCol.Rows - 1 To 1 Step -1
            lngTmp = lngSelectedRow(i)
            If lngTmp <> 0 Then
                blnDelete(lngTmp) = True
                blnSucceed = True
            End If
        Next
        DeleteRows blnDelete
        If blnSucceed Then
            frmName.setAllItemproperty
        End If
        Erase blnDelete
        Exit Sub
    End If
    
    lngRowno = frmName.GrdCol.Rows - 1
    If Trim(frmName.TextOfGrid(lngRowno, 1)) = "" Then
        If frmName.GrdCol.Rows > 2 Then
'            frmName.GrdCol.RemoveItem lngRowNO
            frmName.blnDeleteARow lngRowno
        Else
'            frmName.grdCol.Rows = 1
            frmName.SetGridRows 1
        End If
        lngRowno = lngRowno - 1
    End If
    
    frmName.FormRefresh False
    frmName.GrdCol.Redraw = False
    
    For i = 1 To GrdCol.Rows - 1
        lngTmp = lngSelectedRow(i)
        If lngTmp = 0 Then
            If GrdCol.TextMatrix(i, 1) <> "" Then
                frmName.InsertARow
                lngRowno = lngRowno + 1
                SetARow i, lngRowno
            End If
        Else
            If GrdCol.TextMatrix(i, 1) <> "" Then
                SetARow i, lngTmp, False
            Else
                blnDelete(lngTmp) = True
            End If
        End If
    Next
    DeleteRows blnDelete
    frmName.setAllItemproperty
    frmName.FormRefresh True
    frmName.GrdCol.Redraw = True
    Erase blnDelete
End Sub

Private Sub SetARow(ByVal lngRowno As Long, ByVal lngWriteRowNO As Long, Optional blnSetInfo As Boolean = True)
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    Select Case lngReceiptTypeID
    Case 2, 3, 4
        strSql = "SELECT Item.strItemCode||' '||Item.strItemName||' '||Item.strItemStyle AS strItem, " _
    & "PurchaseOrder.strDate AS StrDate,Ltrim(PurchaseOrder.strReceiptNO||LPAD(PurchaseOrder.lngReceiptNO,4,'0')) AS ReceiptNO," _
    & "ItemUnit.strUnitName AS strUnit, Tax.strTaxName AS strTax,Job.strJobCode||' '||Job.strJobName AS strJob," _
    & "Position.strPositionCode||' '||Position.strPositionName as strPosition,Item.lngPositionID," _
    & "Custom0.strCustomCode||' '||Custom0.strCustomName AS strCustom0," _
    & "Custom1.strCustomCode||' '||Custom1.strCustomName AS strCustom1," _
    & "Custom2.strCustomCode||' '||Custom2.strCustomName AS strCustom2," _
    & "Custom3.strCustomCode||' '||Custom3.strCustomName AS strCustom3," _
    & "Custom4.strCustomCode||' '||Custom4.strCustomName AS strCustom4," _
    & "Custom5.strCustomCode||' '||Custom5.strCustomName AS strCustom5,"
        strSql = strSql _
    & "PurchaseOrderDetail.lngItemID AS lngItemID, PurchaseOrderDetail.lngUnitID AS lngUnitID," _
    & "ItemUnit.dblFactor AS dblFactor, PurchaseOrderDetail.dblPrice AS dblPrice,PurchaseOrderDetail.dblPriceTax AS dblPriceTax, " _
    & "PurchaseOrderDetail.dblDiscountRate AS dblDiscountRate, PurchaseOrderDetail.lngTaxID AS lngTaxID, " _
    & "Tax.dblPurchaseTaxRate/100 AS dblTax," _
    & "PurchaseOrderDetail.lngJobID,PurchaseOrderDetail.lngCustomID0,PurchaseOrderDetail.lngCustomID1," _
    & "PurchaseOrderDetail.lngCustomID2,PurchaseOrderDetail.lngCustomID3,PurchaseOrderDetail.lngCustomID4," _
    & "PurchaseOrderDetail.lngCustomID5,Item.intValidDay "
        strSql = strSql & "FROM PurchaseOrderDetail,PurchaseOrder,Item,ItemUnit,Position,Tax,Job," _
    & "Custom0,Custom1,Custom2,Custom3,Custom4,Custom5 "
        strSql = strSql _
    & "WHERE PurchaseOrderDetail.lngPurchaseOrderID=PurchaseOrder.lngPurchaseOrderID " _
    & "AND PurchaseOrderDetail.lngItemID = Item.lngItemID(+) " _
    & "AND PurchaseOrderDetail.lngUnitID = ItemUnit.lngUnitID(+) " _
    & "AND Item.lngPositionID=Position.lngPositionID(+) " _
    & "AND PurchaseOrderDetail.lngTaxID = Tax.lngTaxID(+) " _
    & "AND PurchaseOrderDetail.lngJobID = Job.lngJobID(+) " _
    & "AND PurchaseOrderDetail.lngCustomID0 = Custom0.lngCustomID(+) " _
    & "AND PurchaseOrderDetail.lngCustomID1 = Custom1.lngCustomID(+) " _
    & "AND PurchaseOrderDetail.lngCustomID2 = Custom2.lngCustomID(+) " _
    & "AND PurchaseOrderDetail.lngCustomID3 = Custom3.lngCustomID(+) " _
    & "AND PurchaseOrderDetail.lngCustomID4 = Custom4.lngCustomID(+) " _
    & "AND PurchaseOrderDetail.lngCustomID5 = Custom5.lngCustomID(+) " _
    & "AND PurchaseOrderDetail.lngPurchaseOrderDetailID = " & GrdCol.RowData(lngRowno)
    
    Case 13, 15, 18
        strSql = "SELECT Item.strItemCode||' '||Item.strItemName||' '||Item.strItemStyle AS strItem, " _
    & "SaleOrder.strDate AS StrDate,Ltrim(SaleOrder.strReceiptNO||LPAD(SaleOrder.lngReceiptNO,4,'0')) AS ReceiptNO," _
    & "ItemUnit.strUnitName AS strUnit, Tax.strTaxName AS strTax,Job.strJobCode||' '||Job.strJobName AS strJob," _