หากมีคำถาม ขอให้ไปโพสต์ลง เว็บบอร์ดจีทูจีเน็ตดอตคอม ตัวใหม่แทนน่ะครับ

หรือติดต่อเข้ามาทาง 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 1 2 8 4 6 7

7 ธันวาคม พ.ศ.2549
248 Users On-Line.
Visitors - Page views
 8 4 2 4 5 0 6
1 กุมภาพันธ์ พ.ศ.2551

Google   
เว็บ g2gnet.com
ขนาดตัวอักษร:  

ตารางกริด (MS Flex Grid) ธรรมดา ที่ไม่ธรรมดา ... ตอนใช้ Wheel Mouse ใน MS FlexGrid ได้

Category »  VB 6/VB.Net
โดย : Webmaster เมื่อ 3/4/2552   เวลา: 14:56
(อ่าน : 14758) 
พอกล่าวถึง 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