frmreceiptlist.frm

金算盘软件代码

    End If
    If mobjRpList.ReferRow <> -1 Then
       ChooseRow mobjRpList.ReferRow
       grdRefer.Row = mobjRpList.ReferRow
    Else
       grdRefer.Row = 1
    End If
    grdRefer.col = 0
    grdRefer.ColSel = grdRefer.Cols - 1
    grdRefer.SetFocus
    Resized = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set m_clsHook = Nothing
End Sub

Private Sub grdRefer_Click()
    PressEnter
End Sub

Private Sub PressEnter()
    On Error Resume Next
    If grdRefer.Row >= 1 Then
       If grdRefer.RowHeight(1) > 0 Then
            mobjRpList.ReferRow = grdRefer.Row
            mobjRpList.AddText GetText(grdRefer.Row)
            If UserControls.mintCodeIdCol <> -1 Then
                mobjRpList.CodeId = grdRefer.TextMatrix(grdRefer.Row, UserControls.mintCodeIdCol)
            End If
            If UserControls.mintSubIdCol <> -1 Then
                mobjRpList.SubId = grdRefer.TextMatrix(grdRefer.Row, UserControls.mintSubIdCol)
            End If
       End If
    End If
    mobjRpList.ReferVisible = False
    Unload Me
End Sub

Private Function GetText(ByVal intRow As Integer) As String
  Dim intCount As Integer
     If intRow >= 1 Then
        For intCount = 1 To UserControls.mintTextCols
             If GetText = "" Then
                 GetText = grdRefer.TextMatrix(intRow, UserControls.marrTextCol(intCount))
             Else
                 GetText = GetText & " " & grdRefer.TextMatrix(intRow, UserControls.marrTextCol(intCount))
             End If
        Next intCount
    End If
End Function

Private Sub CalTotal()
  Dim intRow As Long, intCol As Integer, intCount As Integer
  Dim TotalCol As Integer, curData As Double, intBeginCol As Integer
  Dim lngWid As Long, blnNoRecord As Boolean
  
     grdTotal.Clear
     With grdRefer
        For intRow = 1 To .Rows - 1
            For intCol = 1 To UserControls.mintTotalCols
                If (UserControls.marrTotalCol(intCol) > UserControls.mintCodeIdCol And UserControls.mintCodeIdCol <> -1) And _
                   (UserControls.marrTotalCol(intCol) > UserControls.mintSubIdCol And UserControls.mintSubIdCol <> -1) Then
                   TotalCol = UserControls.marrTotalCol(intCol) - 2
                Else
                If (UserControls.marrTotalCol(intCol) > UserControls.mintCodeIdCol And UserControls.mintCodeIdCol <> -1) Or _
                   (UserControls.marrTotalCol(intCol) > UserControls.mintSubIdCol And UserControls.mintSubIdCol <> -1) Then
                       
                       TotalCol = UserControls.marrTotalCol(intCol) - 1
                   Else
                       TotalCol = UserControls.marrTotalCol(intCol)
                   End If
                End If
                If Trim(.TextMatrix(intRow, UserControls.marrTotalCol(intCol))) = "" Then
                   curData = 0
                Else
                   curData = CDbl(.TextMatrix(intRow, UserControls.marrTotalCol(intCol)))
                End If
                If curData <> 0 Then
                    If Trim(grdTotal.TextMatrix(0, TotalCol)) = "" Then
                       grdTotal.TextMatrix(0, TotalCol) = Format(curData, UserControls.marrTotalDec(intCol))
                    Else
                       grdTotal.TextMatrix(0, TotalCol) = Format(CDbl(grdTotal.TextMatrix(0, TotalCol)) + curData, UserControls.marrTotalDec(intCol))
                    End If
                Else
                   grdTotal.TextMatrix(0, TotalCol) = 0
                End If
            Next intCol
        Next intRow
     End With
     intBeginCol = -1
     blnNoRecord = True
     If grdRefer.Rows > 1 Then
        If grdRefer.RowHeight(1) > 0 Then
            blnNoRecord = False
        End If
     End If
     If Not blnNoRecord Then
        With grdTotal
           .Redraw = False
           For intCol = 0 To .Cols - 1
               If Trim(.TextMatrix(0, intCol)) = "" Then
                   If intBeginCol = -1 Then
                       intBeginCol = intCol
                   End If
                   lngWid = lngWid + .ColWidth(intCol)
                   .TextMatrix(0, intCol) = "合计"
                   .ColAlignment(intCol) = 4
                   .ColWidth(intCol) = 0
               Else
                   If Trim(.TextMatrix(0, intCol)) = "0" Then
                      .TextMatrix(0, intCol) = ""
                   End If
                   .ColWidth(intBeginCol) = lngWid
                   .Redraw = True
                   Exit For
               End If
           Next intCol
        End With
     Else
        intCol = 0
        For intCount = 0 To grdRefer.Cols - 1
           If grdRefer.ColWidth(intCount) > 0 Then
              grdTotal.Cols = intCol + 1
              grdTotal.ColWidth(intCol) = grdRefer.ColWidth(intCount)
              intCol = intCol + 1
           End If
        Next intCount
        grdTotal.TextMatrix(0, 0) = "合计"
        grdTotal.ColAlignment(0) = 4
     End If
End Sub

Public Sub ChooseRow(ByVal tRow As Long, Optional Choose As Boolean = True)
    On Error Resume Next
    If tRow <= 0 Then
        Exit Sub
    End If
    With grdRefer
         If Choose Then
            .TextMatrix(tRow, 0) = "√"
            .TopRow = tRow
         Else
            .TextMatrix(tRow, 0) = ""
         End If
    End With
End Sub

Public Sub ChangeCurRow(ByVal tRow As Integer)
    With grdRefer
        If tRow > 0 Then
           If tRow > .Rows - 1 Then
              .Row = .Rows - 1
           Else
              If tRow < 1 Then
                 .Row = 1
              Else
                 .Row = tRow
              End If
           End If
           .col = 0
           .ColSel = .Cols - 1
        Else
           
        End If
    End With
End Sub

Private Sub grdRefer_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Long
    
    If KeyCode = vbKeyReturn Then
         PressEnter
    ElseIf KeyCode = vbKeyEscape Then
        mobjRpList.ReferVisible = False
        Unload Me
    ElseIf KeyCode = vbKeySpace Then
        If grdRefer.Row >= 1 Then
           If grdRefer.RowHeight(1) > 0 Then
                For i = 1 To grdRefer.Rows - 1
                    If grdRefer.TextMatrix(i, 0) <> "" Then
                        grdRefer.TextMatrix(i, 0) = ""
                    End If
                Next
                If mobjRpList.ReferRow <> grdRefer.Row Then
                    mobjRpList.ReferRow = grdRefer.Row
                    mobjRpList.AddText GetText(grdRefer.Row)
                    If UserControls.mintCodeIdCol <> -1 Then
                        mobjRpList.CodeId = grdRefer.TextMatrix(grdRefer.Row, UserControls.mintCodeIdCol)
                    End If
                    If UserControls.mintSubIdCol <> -1 Then
                        mobjRpList.SubId = grdRefer.TextMatrix(grdRefer.Row, UserControls.mintSubIdCol)
                    End If
                    ChooseRow grdRefer.Row
                Else
                    mobjRpList.ReferRow = -1
'                    mobjRpList.AddText ""
                    If UserControls.mintCodeIdCol <> -1 Then
                        mobjRpList.CodeId = 0
                    End If
                    If UserControls.mintSubIdCol <> -1 Then
                        mobjRpList.SubId = 0
                    End If
                    ChooseRow grdRefer.Row, False
                End If
           End If
        End If
    End If
End Sub

Private Sub grdRefer_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    '点在Text框和CmdBrow内
    If y > -300 And y < 0 And x > 0 And x < 8000 Then
        ReleaseCapture
        mobjRpList.ReferVisible = False
        FormUnloadProc
        Unload Me
    End If
    
    If y > grdRefer.Height + 300 Or y < -300 Or x < 0 Or x > grdRefer.width + 50 Then
        ReleaseCapture
        mobjRpList.ReferVisible = False
        FormUnloadProc
        Unload Me
    End If
End Sub

Private Sub grdRefer_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If grdRefer.Rows > 12 Then
       If x > grdRefer.width - gclsEniv.VScrollWidth And x < grdRefer.width _
          And y > 0 And y < grdRefer.Height Then
            ReleaseCapture
       Else
            SetCapture grdRefer.hwnd
       End If
    End If
End Sub

Private Sub grdRefer_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    ReleaseCapture
    SetCapture grdRefer.hwnd
End Sub

Private Sub grdRefer_RowColChange()
    On Error Resume Next
  With grdRefer
     If .Row <> mobjRpList.CurRow And .Row > 0 Then
         mobjRpList.CurRow = .Row
         mobjRpList.AddText GetText(.Row)
     End If
  End With
End Sub


Private Sub FormUnloadProc()
    Dim i As Long
    For i = 1 To grdRefer.Rows - 1
        If Trim(grdRefer.TextMatrix(i, 0)) <> "" Then
            Exit For
        End If
    Next
    If i <> grdRefer.Rows Then
        grdRefer.Row = i
    Else
        mobjRpList.CurRow = -1
        mobjRpList.AddText ""
    End If
End Sub

'Private Sub SubWin1_OnMsgAfter(umsg As Long, wParam As Long, lParam As Long)
'  Dim hdc As Long
'  Dim po As POINTAPI
'  Dim intCol As Integer
'  Dim curX As Double
'
'  If umsg = &HF Then
'    hdc = GetDC(grdRefer.hwnd)
'    For intCol = 0 To grdRefer.Cols - 2
'        curX = curX + grdRefer.ColWidth(intCol)
'        MoveToEx hdc, (curX - 15) / Screen.TwipsPerPixelX, grdRefer.RowHeight(0) / Screen.TwipsPerPixelY, po
'        LineTo hdc, (curX - 15) / Screen.TwipsPerPixelX, grdRefer.Height / Screen.TwipsPerPixelY
'    Next intCol
'    ReleaseDC grdRefer.hwnd, hdc
' End If
'End Sub

Private Sub m_clsHook_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
  Dim hdc As Long
  Dim po As POINTAPI
  Dim intCol As Integer
  Dim curX As Double
  If mblnbusy Then
      Exit Sub
  End If
  mblnbusy = True
  If Msg = &HF Then
    m_clsHook.CallWndProc Msg, wParam, lParam
    hdc = GetDC(grdRefer.hwnd)
    For intCol = 0 To grdRefer.Cols - 2
        curX = curX + grdRefer.ColWidth(intCol)
        MoveToEx hdc, (curX - 15) / Screen.TwipsPerPixelX, grdRefer.RowHeight(0) / Screen.TwipsPerPixelY, po
        LineTo hdc, (curX - 15) / Screen.TwipsPerPixelX, grdRefer.Height / Screen.TwipsPerPixelY
    Next intCol
    ReleaseDC grdRefer.hwnd, hdc
 End If
 
 mblnbusy = False
End Sub