clsorder.cls

金算盘软件代码

         If My.bytRegion = FcmdButton Then
            ChkSetFocus 0
         End If
      End If
'      If frmName.ActiveControl Is Nothing Then
'         ChkSetFocus 0
'      ElseIf frmName.ActiveControl.Name = "cmdButton" Then
'        ChkSetFocus 0
'      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
    Static blnColDrag As Boolean

    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
        '确保第0列不被拖出
        If frmName.GrdCol.ColWidth(0) > 0 Then frmName.GrdCol.ColWidth(0) = 0
        For i = 1 To frmName.GrdCol.Cols - 1
            If ColProperty(i).blnUsable = False And frmName.GrdCol.ColWidth(i) <> 0 Then
                frmName.GrdCol.ColWidth(i) = 0
            End If
            If ColProperty(i).blnUsable = True And frmName.GrdCol.ColWidth(i) < 490 Then
                frmName.GrdCol.ColWidth(i) = 490
            End If
        Next i
        If blnColDrag Then
            blnColDrag = False
            With frmName.GrdCol
                My.blnRefresh = False
                If My.bytRegion = FGrid Or My.bytRegion = FPicture Then
'                    If My.bytIndex <> .col Then .col = My.bytIndex
                    If My.lngOldCol <> .col Then .col = My.lngOldCol
                    If My.lngOldRow <> .Row Then .Row = My.lngOldRow
                     GrdInputButtonLocal .Row, .col
                End If
                TotalRowAdjust
'                frmName.LblBack.Refresh
                RefreshRect frmName.hwnd, frmName.GrdCol.Left, frmName.GrdCol.top + frmName.GrdCol.Height + 1 * Screen.TwipsPerPixelY, frmName.lblBack.Left + frmName.lblBack.width - 9 * Screen.TwipsPerPixelX, frmName.lblNote(1).top - 2 * Screen.TwipsPerPixelY
                My.blnRefresh = True
                'frmname.Refresh
            End With
        End If
        Exit Sub
    End If
    
    If Msg = WM_LBUTTONDOWN Then        '鼠标左键按下
        With frmName.GrdCol
            If .MouseRow < .FixedRows Then    '点中固定行
                '判断鼠标是否点中列线以便拖动
                i = .MouseCol
                If lngX >= .ColPos(i) + .ColWidth(i) - 50 Or lngX <= .ColPos(i) + 50 Then
                    blnColDrag = True
                End If
            End If
        End With
        mclsSubClass.CallWndProc Msg, wParam, lParam
        Exit Sub
    End If
    
    If Msg = WM_PAINT Then
    '取Paint事件矩形区域
        If My.blnRefresh Then
            '取Paint事件矩形区域
            If Not m_pBusy Then
                m_pBusy = True
                GetUpdateRect frmName.GrdCol.hwnd, GridClipRect, False
                mclsSubClass.CallWndProc Msg, wParam, lParam
                If frmName.GrdCol.Visible Then
                    DrawReadOnlyCol
                    DrawGridLine
    '               Debug.Print Time
                End If
                m_pBusy = False
            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_WINDOWPOSCHANGING Then
        If ctrInput Is Nothing Then

        Else
            On Error Resume Next
            If UCase(ctrInput.Name) = "REFINPUT" Or UCase(ctrInput.Name) = "DTMINPUT" Or UCase(ctrInput.Name) = "CURINPUT" Or UCase(ctrInput.Name) = "RECLIST" Then
                If UCase(ctrInput.Name) = "REFINPUT" Or UCase(ctrInput.Name) = "RECLIST" Then
                    If ctrInput.ReferVisible Then
                        ctrInput.PopRefer False
                        Exit Sub
                    End If
'                ElseIf UCase(ctrInput.Name) = "DTMINPUT" Or UCase(ctrInput.Name) = "CURINPUT" Then
'                    If ctrInput.IsDropDown Then
'
'                    End If
                End If
            End If
        End If
    End If
    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 frmName.lblHead(5).Visible Then DrawTotalBox
            If frmName.lblHead(5).Visible Then DrawAllButton
        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
    Dim lngRowheight As Long
    Dim lngHdc As Long
    
    My.blnRefresh = False
    SeparateLineColor = fccolor.lngGridLineColor   'GRID列分隔线色
    lngHdc = GetDC(frmName.GrdCol.hwnd)
    lngRowheight = frmName.GrdCol.RowHeight(0)
    '写第三列上显示的文本
'    For inti = frmname.grdCol.TopRow To frmname.grdCol.rows - 1
'        WriteAString lnghdc, frmname.grdCol.ColPos(3) + 30, _
'                            frmname.grdCol.RowPos(inti) + 10, _
'                            frmname.grdCol.TextMatrix(inti, 5), 10
'        WriteAString lnghdc, frmname.grdCol.ColPos(3) + frmname.grdCol.ColWidth(3) * 50 / 100 + 60, _
'                            frmname.grdCol.RowPos(inti) + 10, _
'                            frmname.grdCol.TextMatrix(inti, 6), 9
'        WriteAString lnghdc, frmname.grdCol.ColPos(3) + frmname.grdCol.ColWidth(3) * 25 / 100 + 30, _
'                            frmname.grdCol.RowPos(inti) + frmname.grdCol.RowHeight(0) + 10, _
'                            frmname.grdCol.TextMatrix(inti, 9), 12
'    Next inti
    
    '画GRID网格线
    With frmName.GrdCol
        For intI = 1 To 40
            '画水平线
            If lngRowheight * intI > .Height Then Exit For
'                DrawALine lnghdc, 0, lngRowheight * intI - Screen.TwipsPerPixelY, _
'                           .width, lngRowheight * intI - Screen.TwipsPerPixelY, _
'                           GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, fccolor.lngGridLineColor       '画第三列上线条
            If frmName.GrdCol.Row <> 0 And (intI = frmName.GrdCol.Row - frmName.GrdCol.TopRow + 1 Or intI = frmName.GrdCol.Row - frmName.GrdCol.TopRow + 2) Then
                DrawBLine lngHdc, 0, lngRowheight * intI - Screen.TwipsPerPixelY, _
                           .width, lngRowheight * intI - Screen.TwipsPerPixelY, _
                            C2lng(RGB(0, 0, 255))   'frmName.lblCaption.ForeColor
            Else
                DrawBLine lngHdc, 0, lngRowheight * intI - Screen.TwipsPerPixelY, _
                           .width, lngRowheight * intI - Screen.TwipsPerPixelY, _
                            SeparateLineColor
            End If
    '        If frmname.grdCol.RowHeight(0) * 2 * inti > frmname.grdCol.Height Then Exit For
    '            '横线
    '            DrawALine lnghdc, frmname.grdCol.ColPos(3), frmname.grdCol.RowHeight(0) * (2 * inti), _
    '                       frmname.grdCol.ColPos(3) + frmname.grdCol.ColWidth(3), frmname.grdCol.RowHeight(0) * (2 * inti), _
    '                       GridClipRect.Left, GridClipRect.Top, GridClipRect.Right, GridClipRect.Bottom
                '竖线
    '            DrawALine lnghdc, frmname.grdCol.ColPos(3) + frmname.grdCol.ColWidth(3) * 50 / 100, frmname.grdCol.RowHeight(0) * (2 * inti - 1), _
    '                       frmname.grdCol.ColPos(3) + frmname.grdCol.ColWidth(3) * 50 / 100, frmname.grdCol.RowHeight(0) * (2 * inti), _
    '                       GridClipRect.Left, GridClipRect.Top, GridClipRect.Right, GridClipRect.Bottom
                '箭头
    '            DrawArrow lnghdc, frmname.grdcol.ColPos(3) + frmname.grdcol.ColWidth(3) * 50 / 100 - 200, frmname.grdcol.RowHeight(0) * (2 * inti - 1) + 30

        Next intI
        '画竖线
        For intI = 1 To .Cols - 1
            If (Not .ColIsVisible(intI)) Then
            ElseIf .ColPos(intI) + .ColWidth(intI) >= .width - Screen.TwipsPerPixelX Then
                Exit For
            Else
               ' If frmname.grdCol.RowHeight(0) * frmname.grdCol.Rows < frmname.grdCol.Height Then
               '     DrawALine lnghdc, frmname.grdCol.ColPos(inti) + frmname.grdCol.ColWidth(inti) - 15, 0, _
               '                    frmname.grdCol.ColPos(inti) + frmname.grdCol.ColWidth(inti) - 15, frmname.grdCol.RowHeight(0) * frmname.grdCol.Rows, _
               '                    GridClipRect.Left, GridClipRect.Top, GridClipRect.Right, GridClipRect.Bottom, RGB(128, 128, 128)
               ' Else
                    DrawALine lngHdc, .ColPos(intI) + .ColWidth(intI) - 15, 0, _
                                   .ColPos(intI) + .ColWidth(intI) - 15, .Height, _
                                   GridClipRect.Left, GridClipRect.top, GridClipRect.Right, GridClipRect.Bottom, fccolor.lngGridLineColor
                'End If
            End If
        Next intI
    End With
    If frmName.chkPrint(1).Value = 0 Then
'        frmName.grdCol.Refresh
    Else
'        frmName.PaintPicture Utility.GetFormResPicture(1024, 0), _
'                frmName.lblCaption.Left + frmName.lblCaption.Width + 30, frmName.LblBack.top
        DrawAIcon lngHdc, frmName.lblCaption.Left + frmName.lblCaption.width, frmName.GrdCol.RowHeight(0), 1024
        Utility.RemoveFormResPicture (1024)
    End If
    ReleaseDC frmName.GrdCol.hwnd, lngHdc
    My.blnRefresh = True
End Sub
Public Sub DrawReadOnlyCol()
    Dim intLeft As Integer
    Dim i As Integer
    Dim intR As Integer
    Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
    Dim lngHdc As Long
    Dim lngRowheight As Long
    
    With frmName.GrdCol
        lngRowheight = .RowHeight(0)
        lngHdc = GetDC(.hwnd)
        If .RowIsVisible(.Rows - 1) = False Then Exit Sub
        intLeft = 1
        If intLeft = 0 Then intLeft = 1
        For i = intLeft To .Cols - 1
            If ColProperty(i).blnReadOnly Then
               If .ColIsVisible(i) And .ColWidth(i) <> 0 Then
                  x1 = .ColPos(i)
                  x2 = .ColPos(i) + .ColWidth(i) - 2 * Screen.TwipsPerPixelX
                  If .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) < .Height Then
                      y1 = .RowPos(.Rows - 1) + lngRowheight
                      y2 = y1 - 2 * Screen.TwipsPerPixelY
                      For intR = 1 To 30
                          y2 = y2 + lngRowheight  '.RowPos(.Rows - 1) + lngRowHeight * intR
                          If y2 > .Height Then
                             y2 = y2 - lngRowheight
                             Exit For
                          End If
                      Next intR
                      DrawABox lngHdc, x1, y1, x2, y2, RGB(192, 192, 192), RGB(192, 192, 192)
                  End If
               End If
            End If
        Next i
        ReleaseDC .hwnd, lngHdc
    End With
    If frmName.chkPrint(1).Value = 1 Then
        DrawAIcon frmName.GrdCol.hwnd, frmName.lblCaption.Left + frmName.lblCaption.width, lngRowheight, 1024
        Utility.RemoveFormResPicture (1024)
    End If
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