frmcalcdiscdetail.frm

金算盘软件代码

                        End If
                    Else
                        If DiscInfoTmp.lngRowno = 0 Then
                            dblUsableAmount = dblUsableAmount + DiscInfoTmp.dblSavedAmount
'                            GrdCol.TextMatrix(i, GrdCol.Cols - 1) = DiscInfoTmp.dblSavedAmount
                        Else
                            dblUsableAmount = dblUsableAmount - DiscInfoTmp.dblUsedAmount
                        End If
                    End If
                End If
            Next
            GrdCol.TextMatrix(i, 5) = Format(dblUsableAmount, strCurrDec)
        Next
    End If
    
    For i = GrdCol.Rows - 1 To 1 Step -1
        If C2Dbl(GrdCol.TextMatrix(i, 5)) <= 0 Then
            If i = 1 And GrdCol.Rows = 2 Then
                GrdCol.Rows = 1
            Else
                GrdCol.RemoveItem i
            End If
        End If
    Next

    ReDim dblRowData(GrdCol.Rows - 1, 2)    '0 LngTabID,1 dblSavedAmount,2 dblUsedAmount
    
    For i = 1 To GrdCol.Rows - 1
        dblRowData(i, 0) = C2lng(GrdCol.TextMatrix(i, GrdCol.Cols - 3))
    Next
    
    GrdCol.Cols = GrdCol.Cols - 3
    
    ReDim strColName(GrdCol.Cols - 1)
    ReDim xlngColNo(GrdCol.Cols - 1)
    
    For i = 0 To GrdCol.Cols - 1
        If InStr(GrdCol.TextMatrix(0, i), "数量") <> 0 Or InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
            GrdCol.ColAlignment(i) = flexAlignRightCenter
        Else
            GrdCol.ColAlignment(i) = flexAlignLeftCenter
        End If
        strColName(i) = GrdCol.TextMatrix(0, i)
    Next
    
    mclsGrid.ColOfs = 2
'    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    
    '默认
'    Dim blnSetDefault As Boolean
'    blnSetDefault = True
'    For i = 1 To DiscInfos.Count Step 7
'      If DiscInfos.Item(i) = lngRowno Then
'         blnSetDefault = False
'         Exit For
'      End If
'    Next
'    If blnSetDefault Then
'        For i = 1 To GrdCol.Rows - 1
'            GrdCol.TextMatrix(i, 1) = "√"
'        Next
'        reCalculate
'        For i = 1 To GrdCol.Rows - 1
'            If dblRowData(i, 2) = 0 Then
'                GrdCol.TextMatrix(i, 1) = ""
'            End If
'        Next
'        reCalculate
'    Else
      #If conQuanDisc = -1 Then
         OptReturn(1).Value = True
      #Else
        reCalculate
      #End If
'    End If
    blnNotFirstMouse = False
'    If Not mblnByMouse Then
'        blnNotFirstMouse = True
'    End If
EndProc:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    GrdCol.Redraw = True
    Set GrdCol.MouseIcon = Utility.GetFormResPicture(2001, 2)
    GrdCol.MousePointer = flexDefault
    LoadGrdColWidth
    Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    DATA1.Resultset.Close
    SaveGrdColWidth
    Utility.UnLoadFormResPicture Me
'    Utility.RemoveFormResPicture 139
'    Utility.RemoveFormResPicture 1001
'    Utility.RemoveFormResPicture 1002
'    Utility.RemoveFormResPicture 1021
    Utility.RemoveFormResPicture 2001
    Erase strColName
    Erase xlngColNo
    Set DiscInfos = Nothing
    Set frmName = Nothing
    Set mclsGrid = Nothing
    Erase dblRowData
    Erase bytOrder
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='" & Left(Me.Name, 16) & "列宽'"
    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
    GrdCol.ColWidth(1) = 480
    GrdCol.ColWidth(2) = 1215
    GrdCol.ColWidth(3) = 1140
    GrdCol.ColWidth(4) = 1095
    GrdCol.ColWidth(5) = 2355
    GrdCol.ColWidth(6) = 1005
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='" & Left(Me.Name, 16) & "列宽'"
    If gclsBase.ExecSQL("DELETE " & strSql) = False Then GoTo ErrHandle
        
    strSql = "SELECT *" & strSql
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With recTmp
        For i = 1 To GrdCol.Cols - 1
            .AddNew
            !lngModuleID = 0
            !strSection = Left(Me.Name, 16) & "列宽"
            !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 grdCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If ChkAdjust.Value = 0 Then
      If x < GrdCol.ColWidth(1) And y > GrdCol.RowHeight(0) Then
          GrdCol.MousePointer = 99
      Else
          GrdCol.MousePointer = flexDefault
      End If
    Else
      GrdCol.MousePointer = flexDefault
    End If
End Sub

Private Sub GrdCol_KeyPress(KeyAscii As Integer)
    If ChkAdjust.Value <> 0 Then Exit Sub
    If KeyAscii = vbKeySpace Then
        If GrdCol.Row >= GrdCol.FixedRows Then
            Grid_Click
        End If
    End If
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If ChkAdjust.Value <> 0 Then Exit Sub
    If blnNotFirstMouse = False Then
        blnNotFirstMouse = True
        Exit Sub
    End If
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak1 As Long
    Dim lngRowBak2 As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    
    If GrdCol.Rows <= GrdCol.FixedRows Then Exit Sub

    If y < GrdCol.RowHeight(0) Then
        GrdCol.Redraw = False
        lngRowBak1 = GrdCol.RowData(GrdCol.Row)
        lngRowBak2 = dblRowData(GrdCol.Row, 0)
        GrdCol.Row = 0
        GrdCol.col = i
        
        GrdCol.Cols = GrdCol.Cols + 3
        GrdCol.ColWidth(GrdCol.Cols - 3) = 0
        GrdCol.ColWidth(GrdCol.Cols - 2) = 0
        GrdCol.ColWidth(GrdCol.Cols - 1) = 0
        For i = 1 To GrdCol.Rows - 1
            GrdCol.TextMatrix(i, GrdCol.Cols - 1) = dblRowData(i, 2)
            GrdCol.TextMatrix(i, GrdCol.Cols - 2) = dblRowData(i, 1)
            GrdCol.TextMatrix(i, GrdCol.Cols - 3) = dblRowData(i, 0)
        Next
        For i = 0 To GrdCol.Cols - 4
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                GrdCol.col = i
                GrdCol.ColSel = 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
                
            Else
                GrdCol.TextMatrix(0, i) = ColName(i)
            End If
        Next
        For i = 1 To GrdCol.Rows - 1
            dblRowData(i, 2) = C2Dbl(GrdCol.TextMatrix(i, GrdCol.Cols - 1))
            dblRowData(i, 1) = C2Dbl(GrdCol.TextMatrix(i, GrdCol.Cols - 2))
            dblRowData(i, 0) = C2Dbl(GrdCol.TextMatrix(i, GrdCol.Cols - 3))
        Next
        GrdCol.Cols = GrdCol.Cols - 3
        For j = 1 To GrdCol.Rows - 1
            If GrdCol.RowData(j) = lngRowBak1 And dblRowData(j, 0) = lngRowBak2 Then
                GrdCol.Row = j
                Exit For
            End If
        Next
        GrdCol.Redraw = True
    Else
        If GrdCol.Row >= GrdCol.FixedRows Then
            Grid_Click
        End If
'        GrdCol_MouseDownUp Button, Shift, x, y
    End If

End Sub

Private Sub grdCol_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If ChkAdjust.Value <> 0 Then Exit Sub
'    GrdCol_MouseDownUp Button, x, y
    blnNotFirstMouse = True
End Sub
Private Sub GrdCol_MouseDownUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim j As Long
    Dim lngRowheight As Long


    If Button = vbRightButton Then
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        Exit Sub
    Else
        lngRowheight = GrdCol.RowHeight(0)
        For j = 1 To GrdCol.Rows - 1
            If y < lngRowheight + GrdCol.RowHeight(j) Then
                Grid_Click j
                Exit For
            End If
            lngRowheight = lngRowheight + GrdCol.RowHeight(j)
        Next
    End If
End Sub
Private Sub GrdCol_Click()
'    If GrdCol.Row >= GrdCol.FixedRows Then
'        Grid_Click
'    End If
End Sub
Private Sub Grid_Click(Optional lngRow As Long = 0, Optional blnSelect As Boolean = False)
    If lngRow = 0 Then
        lngRow = GrdCol.Row
    End If
    GrdCol.ColSel = GrdCol.Cols - 1
    If GrdCol.TextMatrix(lngRow, 1) = "" Then
        GrdCol.TextMatrix(lngRow, 1) = "√"