ҡդӶ ʵŧ 纺촨շ٨絴͵ ᷹ФѺ

͵Դҷҧ Inbox Ѻ

˹ѡ
-
VB 6/VB.Net
ASP/ASP.Net
Ѻ¤
¹ҹ Flash Movie
ռͺش  
 RSS Feeds
 ǹŴ RSS Reader ...   Download  RSS Reader

Forum - www.g2gnet.com
Webmaster - www.g2gnet.com
Visitors - Session views
 5 6 1 6 1 6 2

7 ѹҤ ..2549
117 Users On-Line.
Visitors - Page views
 8 9 7 3 9 0 5
1 Ҿѹ ..2551

Google   
g2gnet.com
Ҵѡ:  

ҧԴ (MS Flex Grid) ... ͹ Wheel Mouse MS FlexGrid

Category »  VB 6/VB.Net
: Webmaster 3/4/2552   : 14:56
(ҹ : 17014) 
͡Ƕ֧ Wheel Mouse ... Դµ¤礧Чѹ () ... Wheel Mouse ѹ ١駷ç觡ҧФѺ ª㹡͹ (Scroll) ʴŵҧ ŧ MS FlexGrid ѹҹǹ ????? ... 㹻Ѩغѹҷѧࡵ շ駹ѡѲҫͿ蹡ҡ ҧ (55555+) MS FlexGrid ҹ Application ͧͧҧҡ Ҥ˹ش礧˹鹡ҹ (Users) ҡ ... ѹӹ¤дǡ㹡ҹѺ () "¹ ¹ () 褹ͧ㨤¹ ()" ... ҡй ҧѹ 觾ѧѺشʹਤѧçҹҧͧҴա ...
ǹŴ
ǹŴ Source Code Ѻ MS Visual Basic 6.0 - Service Pack 6
 ǹŴ Visual Basic 6.0 SP5: Run-Time Redistribution Pack
 ǹŴ Microsoft Data Access Object (MDAC) Jet 4.0 Update
 ǹŴ Microsoft Visual Basic Service Pack 6

ҧԴ (MS Flex Grid) ... VB 6.0
ҹẺ Text File MS FlexGrid MS Visual Basic 6.0
ҧԴ (MS Flex Grid) ... ͹èѴ§㹡ʴ MS FlexGrid
ҧԴ (MS Flex Grid) ... ͹ MS FlexGrid شȨ
鹡кǹ÷ӧҹ

Projects --> Component ...


Design Time


Run Time ẺҧѹѺ MS FlexGrid
Ҵ鴡ѹ ...

Option Explicit

' =========================================
' ҹп
' =========================================
Public Sub MouseWheel( _
    ByVal MouseKeys As Long, _
    ByVal Rotation As Long, _
    ByVal AxisX As Long, _
    ByVal AxisY As Long _
    )

' ˹觷ͧ͹
Dim NewAxis As Long
' ҤҨӹǹǷʴ MS FlexGrid
Dim RowALL As Single

On Error Resume Next

    With fgData
        ' ҤҢͧ͹ Wheel Mouse
        ' ¤Ҥ٧ͧ MS FlexGrid ô¤٧ͧ ( 330 Twips)
        ' ҵӹǹǷͧ MS FlexGrid ( Header)
        RowALL = Int(.Height \ .RowHeight(0)) - 1 ' Ŵŧ 1 ѹ Column header

        If .Rows < RowALL Then Exit Sub
        
        ' ҡ Rotation 繺ǡ ¤͹ Scroll Mouse 鹴ҹ
        ' Ŵ NewAxis ŧ
        If Rotation > 0 Then
            NewAxis = .TopRow - RowALL
            If NewAxis < 1 Then NewAxis = 1
            
        ' ͹ Scroll Mouse ŧҹҧ  NewAxis ա
        Else
            NewAxis = .TopRow + RowALL
            If NewAxis > .Rows - 1 Then NewAxis = .Rows - 1
        End If
        
        .TopRow = NewAxis
    
    End With

End Sub

Private Sub Form_Activate()
    ' =============================================================
    ' ҹп
    ' ¡ҹ WheelHook  Form ӧҹ (ҡóշ繿١ͧ MDI Form)
    Call WheelHook(Me)
    ' =============================================================
End Sub

Private Sub Form_Load()
    
    Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
    Call SetupGrid              ' 駤ҤسѵѺ MS FlexGrid Ẻ Run - Time
    Call DisplayfgData      ' Ӣѧ MS FlexGrid
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ' =========================================
    ' ҹп ... ¡ԡèѺͧ鹷˹¤
    ' =========================================
    Call WheelUnHook
End Sub

' ======================================================
' õ駤ҤسѵԢͧ MS FlexGrid ѡɳТͧ Run Time
' ======================================================
Sub SetupGrid()
    With fgData
        .Cols = 3
        .Rows = 500
        .ColWidth(0) = 0
        .ColWidth(1) = 1800
        .ColWidth(2) = 3600
        .TextMatrix(0, 0) = "PK"
        .TextMatrix(0, 1) = "Թ"
        .TextMatrix(0, 2) = "ҤԹ"
    End With
    
    ' ǹͧʴѺ MS FlexGrid
    With fgData
        .RowHeightMin = 330
        .SelectionMode = flexSelectionByRow
        .AllowUserResizing = flexResizeNone
        .FixedAlignment(2) = flexAlignRightCenter
        .ColAlignment(2) = flexAlignRightCenter
        .FocusRect = flexFocusHeavy
    End With
    
    ' ǹͧҧѹ§Ѻ MS FlexGrid
    With fgData
        .BackColorFixed = RGB(133, 175, 255)
        .ForeColorFixed = vbBlack
        .BackColorBkg = RGB(245, 245, 245)
        .BackColorSel = RGB(121, 255, 53)
        .ForeColorSel = vbBlack
        .BackColor = RGB(255, 255, 204)
        .ForeColor = vbBlack
        .GridColor = vbBlack
    End With
End Sub

' ======================================================
' ùӢ MS FlexGrid
' ======================================================
Sub DisplayfgData()
Dim sRow As Integer
    Randomize
    ' ҧ 499 ¡
    For sRow = 1 To 499
        fgData.TextMatrix(sRow, 0) = sRow
        fgData.TextMatrix(sRow, 1) = Chr$(Int(Rnd() * 26) + 65) & Int(100 * Rnd)
        fgData.TextMatrix(sRow, 2) = Format(Int(10000 * Rnd), "0.00#,##")
    Next
    SendKeys "{UP}"
End Sub
ǹͧ Module ÷ Wheel Mouse (modWheelMouse.bas)

Option Explicit

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal Wparam As Long, _
    ByVal Lparam As Long _
    ) As Long

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
    ) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    pDst As Any, _
    pSrc As Any, _
    ByVal ByteLen As Long _
    )

Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A     ' 522 㹰ҹ 10

Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim GetForm As Form

Private Function WindowProc( _
    ByVal Lwnd As Long, _
    ByVal Lmsg As Long, _
    ByVal Wparam As Long, _
    ByVal Lparam As Long _
    ) As Long

    Dim MouseKeys As Long
    Dim Rotation As Long
    Dim AxisX As Long
    Dim AxisY As Long
    
    ' Դع١ (Wheel) ͧ
    If Lmsg = WM_MOUSEWHEEL Then
        MouseKeys = Wparam And 65535
        Rotation = Wparam / 65536
        AxisX = Lparam And 65535
        AxisY = Lparam / 65536
        GetForm.MouseWheel MouseKeys, Rotation, AxisX, AxisY
    End If
    
    ' Ҿҧ ͧԴҡ MSDN ͧФѺ ...
    '  ҹҡͧʴ Icon  System Tray
    WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
    

End Function

Public Sub WheelHook(frm As Form)

    On Error Resume Next

    Set GetForm = frm
    LocalHwnd = frm.hWnd
    LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub WheelUnHook()
Dim blnFlag As Long

On Error Resume Next
    blnFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
    Set GetForm = Nothing
End Sub
Conclusion:
㴷ͧ Ŵ⼹ ⨹ҹ仵䫵ҧ ҧ 繤ԾҡԨó㹷ҧźͧ Basic ºѺùФѺ ֡ҡ仡 ö·ѹҤҹ֡ ֧ ֧蹢ͧҵǹ ... öз١ء͹ MS Visual Basic ѹѧա ... ҡ ... ѹ "餹Դ¹ Basic Ѻ仼ԴЧ鹹" ... () Ѻ ... 55555+

͵ - g2gNet Dot Com
Ţ¹ҳԪ硷͹ԡ 0407314800231
CopyLeft © 2004 - 2099 g2gNet.Com All rights reserved.
Email: [email protected] . 08-6862-6560