billstart.cls

金算盘软件代码

    If lngID > 0 Then
        strSql = "DELETE * FROM ActivityDetail WHERE lngActivityDetailID =" & lngID
        gclsBase.BaseDB.Execute strSql
        strSql = "DELETE * FROM CashToApp WHERE lngARAPActivityDetailID =" & lngID
        gclsBase.BaseDB.Execute strSql
        DoEvents
   End If
        blnDeleteARow = True
Endproc:
    Exit Function
ErrorHandle:
    blnDeleteARow = False
    gclsBase.BaseWorkSpace.Rollback
    Resume Endproc
End Function

'------------------------------
'在GRID上写红字
'------------------------------
Public Sub WriteGrd(ByVal strText As String, ByVal lngRow As Long, ByVal lngCol As Long)
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    If lngRow > frmName.grdCol.Rows - 1 Or lngCol > frmName.grdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Sub
    End If
    If frmName.grdCol.ColAlignment(lngCol) = flexAlignRightCenter Then
        blnB = My.blnCtrlBinding
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.grdCol.Row
        lngC = frmName.grdCol.Col
        frmName.grdCol.Row = lngRow
        frmName.grdCol.Col = lngCol
            
        frmName.grdCol.TextMatrix(lngRow, lngCol) = Abs(C2Dbl((strText)))
        
        If C2Dbl(strText) < 0 Then
            frmName.grdCol.CellForeColor = RGB(255, 0, 0)
        ElseIf C2Dbl(strText) > 0 Then
            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
        Else
            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
            frmName.grdCol.TextMatrix(lngRow, lngCol) = ""
        End If

        frmName.grdCol.Row = lngR
        frmName.grdCol.Col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = True
    Else
        frmName.grdCol.TextMatrix(lngRow, lngCol) = strText
    End If

End Sub
'------------------------------
'从GRID上某一单元格内取出字符串
'------------------------------
Public Function strGrdCell(ByVal lngRow As Long, ByVal lngCol As Long) As String
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    If lngRow > frmName.grdCol.Rows - 1 Or lngCol > frmName.grdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Function
    End If
    If frmName.grdCol.ColAlignment(lngCol) = flexAlignRightCenter Then
        blnB = My.blnCtrlBinding
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.grdCol.Row
        lngC = frmName.grdCol.Col
        frmName.grdCol.Row = lngRow
        frmName.grdCol.Col = lngCol
        If CLng(frmName.grdCol.CellForeColor) = CLng(RGB(255, 0, 0)) Then
            strGrdCell = CStr(C2Dbl(frmName.grdCol.TextMatrix(lngRow, lngCol)) * (-1))
        Else
            strGrdCell = frmName.grdCol.TextMatrix(lngRow, lngCol)
        End If

        frmName.grdCol.Row = lngR
        frmName.grdCol.Col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = True
    Else
        strGrdCell = frmName.grdCol.TextMatrix(lngRow, lngCol)
    End If
End Function

Private Sub Class_Terminate()
    Set ctrInput = Nothing
    
    Erase Field()
    Erase ColProperty()
    Erase lngPosition()
    Erase ColProperty()
    
    Set frmName = Nothing
End Sub

Private Sub HookHe_OnMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    If Msg = WM_KEYDOWN Then
        If (wParam = 37 Or wParam = 38 Or wParam = 39 Or wParam = 40) And Not blnIsBusy Then      'TAB键处理程序
            blnIsBusy = True
            TabOrder (wParam)
            blnIsBusy = False
        ElseIf wParam = 27 Then 'ESCAPE
            Reload
        End If
    End If
End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim lngX As Long, lngY As Long
    Dim sinX As Single, sinY As Single
    Dim lngCnt As Long
    Dim i As Integer, mOldRow As Integer, mOldCol As Integer
    Dim intRow As Integer
    Dim blnCancel As Boolean
    Static blnColDrag As Boolean
    Static intCol As Integer
    Static blnColMin As Boolean

    blnCancel = False
    lngX = (lParam Mod (2 ^ 16)) * Screen.TwipsPerPixelX
    lngY = (lParam \ (2 ^ 16)) * Screen.TwipsPerPixelY
    sinX = lngX
    sinY = lngY
    If Msg = WM_LBUTTONUP Then
        mclsSubClass.CallWndProc Msg, wParam, lParam
        If blnColDrag Then
            With frmName.grdCol
                If My.bytRegion = FGrid Then
                    GrdInputButtonLocal .Row, .Col
                    TotalRowAdjust
                End If
            End With
            blnColDrag = False
            frmName.MousePointer = vbDefault
        End If
        
        Exit Sub
    End If
    
    If Msg = WM_LBUTTONDOWN Then        '鼠标左键按下
        With frmName.grdCol
            If .MouseRow = 0 Then
                '判断鼠标是否点中列线以便拖动
                i = .MouseCol
                mclsSubClass.CallWndProc Msg, wParam, lParam
                If lngX >= .ColPos(i) + .ColWidth(i) - 50 And lngX <= .ColPos(i + 1) + 50 Then
                    blnColDrag = True
                    intCol = i
                End If
            End If
        End With
        If Not blnCancel Then mclsSubClass.CallWndProc Msg, wParam, lParam
        Exit Sub
    End If
    
    If Msg = WM_PAINT Then
    '取Paint事件矩形区域
       If My.blnRefresh Then
            '取Paint事件矩形区域
            GetUpdateRect frmName.grdCol.hWnd, GridClipRect, False
            mclsSubClass.CallWndProc Msg, wParam, lParam
            If frmName.grdCol.Visible Then
                DrawGridLine
                DrawReadOnlyCol
            End If
        End If
    Else
        mclsSubClass.CallWndProc Msg, wParam, lParam
    End If
End Sub

Private Sub mclsHook_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.X = lngDefaultWidth \ Screen.TwipsPerPixelX
        MinMax.ptMinTrackSize.y = lngDefaultHeight \ Screen.TwipsPerPixelY
        MinMax.ptMaxTrackSize.X = 1800
        MinMax.ptMaxTrackSize.y = 1600
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
        Exit Sub
    End If
        

    If Msg = WM_PAINT Then
        If My.blnRefresh Then
            '取Paint事件矩形区域
            GetUpdateRect frmName.hWnd, FormClipRect, False
            mclsHook.CallWndProc Msg, wParam, lParam
            If Not blnIsBusy Then
                blnIsBusy = True
                If frmName.grdCol.Visible Then DrawTotalBox
                If frmName.grdCol.Visible Then DrawAllButton
                blnIsBusy = False
            End If
        End If
    Else
        mclsHook.CallWndProc Msg, wParam, lParam
    End If
End Sub

'Private Sub mclsPicHook_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
'    If Msg = WM_PAINT Then
'        mclsHook.CallWndProc Msg, wParam, lParam
'        If My.blnRefresh Then
'            If picInput.Visible Then
'                DrawPicCtrButton
'            End If
'        End If
'    Else
'    End If
'End Sub
Private Sub DrawGridLine()
    
    Dim inti As Integer
    My.blnRefresh = False
    
    '画GRID网格线
    For inti = 1 To 40
        '画水平线
        If frmName.grdCol.RowHeight(0) * inti > frmName.grdCol.Height Then Exit For
            DrawALine frmName.grdCol.hWnd, 0, frmName.grdCol.RowHeight(0) * inti - Screen.TwipsPerPixelY, _
                       frmName.grdCol.Width, frmName.grdCol.RowHeight(0) * inti - Screen.TwipsPerPixelY, _
                       GridClipRect.Left, GridClipRect.Top, GridClipRect.Right, GridClipRect.Bottom
    Next inti
    '画竖线
    For inti = 0 To frmName.grdCol.Cols - 1
        If frmName.grdCol.ColPos(inti) + frmName.grdCol.ColWidth(inti) >= frmName.grdCol.Width - Screen.TwipsPerPixelX Or (Not frmName.grdCol.ColIsVisible(inti)) Then
        Else
            DrawALine frmName.grdCol.hWnd, frmName.grdCol.ColPos(inti) + frmName.grdCol.ColWidth(inti) - 15, 0, _
                               frmName.grdCol.ColPos(inti) + frmName.grdCol.ColWidth(inti) - 15, frmName.grdCol.Height, _
                               GridClipRect.Left, GridClipRect.Top, GridClipRect.Right, GridClipRect.Bottom
        End If
    Next inti

    My.blnRefresh = True
End Sub
Public Sub DrawReadOnlyCol()
    Dim intLeft As Integer
    Dim i As Integer
    Dim X1 As Long, X2 As Long, Y1 As Long, Y2 As Long
    With frmName.grdCol
        If .RowIsVisible(.Rows - 1) = False Then Exit Sub
        intLeft = .LeftCol
        If intLeft = 0 Then intLeft = 1
        For i = intLeft To .Cols - 1
            If ColProperty(i).blnReadOnly And .ColIsVisible(i) Then
                If .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) < .Height Then
                    X1 = .ColPos(i)
                    Y1 = .RowPos(.Rows - 1) + .RowHeight(.Rows - 1)
                    X2 = .ColPos(i) + .ColWidth(i) - Screen.TwipsPerPixelX
                    Y2 = .Height
                    DrawABox .hWnd, X1, Y1, X2, Y2, _
                    RGB(192, 192, 192), RGB(192, 192, 192)
                End If
            End If
        Next i
    End With
End Sub

Private Sub DrawTotalBox()
    Dim inti As Integer
    '画阴影
    DrawABox frmName.hWnd, frmName.LblBack.Left + frmName.LblBack.Width, _
                           frmName.LblBack.Top + 3 * Screen.TwipsPerPixelY, _
                           frmName.LblBack.Left + frmName.LblBack.Width + 2 * Screen.TwipsPerPixelX, _
                           frmName.LblBack.Top + frmName.LblBack.Height + 3 * Screen.TwipsPerPixelY, _
                           RGB(128, 128, 128), True
    DrawABox frmName.hWnd, frmName.LblBack.Left + 3 * Screen.TwipsPerPixelX, _
                           frmName.LblBack.Top + frmName.LblBack.Height + 0 * Screen.TwipsPerPixelY, _
                           frmName.LblBack.Left + frmName.LblBack.Width + 0 * Screen.TwipsPerPixelX, _
                           frmName.LblBack.Top + frmName.LblBack.Height + 3 * Screen.TwipsPerPixelY, _
                           RGB(128, 128, 128), True
    
    '画标题下的横线
    DrawALine frmName.hWnd, frmName.lblCaption.Left, frmName.lblCaption.Top + frmName.lblCaption.Height + 2 * Screen.TwipsPerPixelY, _
        frmName.lblCaption.Left + frmName.lblCaption.Width, frmName.lblCaption.Top + frmName.lblCaption.Height + 2 * Screen.TwipsPerPixelY, _
        FormClipRect.Left, FormClipRect.Top, FormClipRect.Right, FormClipRect.Bottom, RGB(0, 0, 0)
        '画合计栏上的竖线
    For inti = 1 To frmName.grdCol.Cols - 1
        If frmName.grdCol.ColPos(inti) + frmName.grdCol.ColWidth(inti) >= frmName.grdCol.Width - Screen.TwipsPerPixelX Or (Not frmName.grdCol.ColIsVisible(inti)) Then
        Else
            DrawALine frmName.hWnd, frmName.grdCol.Left + frmName.grdCol.ColPos(inti) + frmName.grdCol.ColWidth(inti) - Screen.TwipsPerPixelX, frmName.grdCol.Top + frmName.grdCol.Height, _
                        frmName.grdCol.Left + frmName.grdCol.ColPos(inti) + frmName.grdCol.ColWidth(inti) - Screen.TwipsPerPixelX, frmName.grdCol.Top + frmName.grdCol.Height + frmName.grdCol.RowHeight(0), _
                        FormClipRect.Left, FormClipRect.Top, FormClipRect.Right, FormClipRect.Bottom
        End If
    Next inti
    '画GRID下的表格
    DrawABox frmName.hWnd, frmName.grdCol.Left - Screen.TwipsPerPixelX, frmName.grdCol.Top - 1 * Screen.TwipsPerPixelY, _
        frmName.grdCol.Left + frmName.grdCol.Width - 0 * Screen.TwipsPerPixelX, frmName.lblmemo(0).Top - 3 * Screen.TwipsPerPixelY
    DrawALine frmName.hWnd, frmName.grdCol.Left, frmName.grdCol.Top + frmName.grdCol.Height + 0, _
        frmName.grdCol.Left + frmName.grdCol.Width, frmName.grdCol.Top + frmName.grdCol.Height + 0, _
        FormClipRect.Left, FormClipRect.Top, FormClipRect.Right, FormClipRect.Bottom
    DrawALine frmName.hWnd, frmName.grdCol.Left, frmName.grdCol.Top + frmName.grdCol.Height + frmName.grdCol.RowHeight(0) + 0, _
        frmName.grdCol.Left + frmName.grdCol.Width, frmName.grdCol.Top + frmName.grdCol.Height + frmName.grdCol.RowHeight(0) + 0, _
        FormClipRect.Left, FormClipRect.Top, FormClipRect.Right, FormClipRect.Bottom
    DrawALine frmName.hWnd, frmName.lblNote(0).Left + frmName.lblNote(0).Width + 30, frmName.grdCol.Top + frmName.grdCol.Height, _
                frmName.lblNote(0).Left + frmName.lblNote(0).Width + 30, frmName.lblmemo(0).Top - 50, _
                FormClipRect.Left, FormClipRect.Top, FormClipRect.Right, FormClipRect.Bottom
    '画备注框
    
    DrawALine frmName.hWnd, frmName.lblmemo(0).Left - Screen.TwipsPerPixelX, _
                                frmName.lblmemo(0).Top - Screen.TwipsPerPixelY, _
                                frmName.lblmemo(frmName.lblmemo.Count - 3).Left + frmName.lblmemo(frmName.lblmemo.Count - 3).Width + Screen.TwipsPerPixelX, _
                                frmName.lblmemo(0).Top - Screen.TwipsPerPixelY, _
                                FormClipRect.Left, FormClipRect.Top, FormClipRect.Right, FormClipRect.Bottom, 0
    DrawALine frmName.hWnd, frmName.lblmemo(0).Left - Screen.TwipsPerPixelX, _
                                frmName.lblmemo(1).Top + frmName.lblmemo(1).Height, _