ตารางกริด (MS Flex Grid) ธรรมดา ที่ไม่ธรรมดา ... ตอน MS FlexGrid สุดมหัศจรรย์หรรษา

' ======================================================
' การตั้งค่าคุณสมบัติของ MS FlexGrid ในลักษณะของ Run Time
' ======================================================
Sub SetupGrid()
    With fgData
        .FixedRows = 1
        .FixedCols = 0
        .Cols = 5
        .Rows = 500
        .ColWidth(0) = 0
        .ColWidth(1) = 1800
        .ColWidth(2) = 2600
        .ColWidth(3) = 1400
        .ColWidth(4) = 2400
        
        .TextMatrix(0, 0) = "PK"
        .TextMatrix(0, 1) = "รหัสสินค้า"
        .TextMatrix(0, 2) = "ราคาสินค้า"
        .TextMatrix(0, 3) = "จำนวน"
        .TextMatrix(0, 4) = "รวมจำนวนเงิน"
    End With
    
    With fgData
        .RowHeightMin = 330
        .SelectionMode = flexSelectionFree  ' Focus แบบ Cell เหมือนใน MS Excel
        .AllowUserResizing = flexResizeNone ' ไม่อนุญาตให้ปรับขนาดของแถวหรือหลักได้
        .HighLight = flexHighlightNever ' ไม่ต้องแสงแถบแสง
        
        .FixedAlignment(2) = flexAlignRightCenter
        .ColAlignment(2) = flexAlignRightCenter
        .FixedAlignment(3) = flexAlignRightCenter
        .ColAlignment(3) = flexAlignRightCenter
        .FixedAlignment(4) = flexAlignRightCenter
        .ColAlignment(4) = flexAlignRightCenter
    End With
    
    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
    ' ตัวอย่างข้อมูล
    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")
        ' จะให้มีการป้อนข้อมูลลงในหลักที่ 3
        fgData.TextMatrix(sRow, 3) = 1
        
        ' สำหรับหลักที่ 2 และ 4 ผมไม่ใช้ Format(X, "#,##0.00") หรือ การใส่เครื่องหมาย , (Comma)
        ' เพราะการใส่ Comma มันจะกลายเป็น String ไม่ใช่ Numeric อีกต่อไป
        ' ต้องเปลี่ยนการจัดเรียงจากแบบ Numeric ให้กลายเป็น String แทนไงล่ะครับ
        fgData.TextMatrix(sRow, 4) = Format(fgData.TextMatrix(sRow, 2) * fgData.TextMatrix(sRow, 3), "0.00")
        ' ========================== ค่าคงที่ในการจัดเรียง =====================
        ' 0 = flexSortNone
        ' 1 = flexSortGenericAscending
        ' 2 = flexSortGenericDescending
        ' 3 = flexSortNumericAscending
        ' 4 = flexSortNumericDescending
        ' 5 = flexSortStringNoCaseAsending
        ' 6 = fflexSortStringNoCaseDescending
        ' 7 = flexSortStringAscending
        ' 8 = flexSortStringDescending
        ' =============================================================
    Next
    SendKeys "{UP}"

End Sub

' =============================================
' พิจารณาจากเหตุการณ์ (Event) ในการ Focus ตรงตำแหน่งใน Cell
' =============================================
Sub fgData_EnterCell()
Select Case fgData.Col ' เลือก Column ที่ต้องการ
    Case 0, 1, 2, 4: ' เราไม่ได้ป้อนข้อมูลในหลักที่ 0, 1 และ 2
        txtData.Visible = False ' จึงต้องสั่งให้ปิดการมองเห็น txtData

    Case 3: ' โอเค ถูกต้อง Cell ที่กำลัง Focus มาอยู่หลักที่ 3 ก็เริ่มต้นกระบวนการทำงานได้
        txtData.Visible = True ' เปิดให้ txtData มองเห็นได้
        txtData.Text = fgData.Text ' ค่าเดิมที่อยู่ใน Cell จะถูกส่งต่อไปให้ txtData เพื่อทำการแก้ไขต่อไป

        ' ขั้นตอนนี้คือการเลื่อนตำแหน่งของ txtData ให้ไปทับอยู่บนตำแหน่งของ Cell (หลักที่กำหนด) ตามที่เราต้องการ
        ' การเคลื่อนที่ โดย fgData.Move ตำแหน่งทางซ้าย, ตำแหน่งบน, ความกว้างของเซลล์, ความสูงของเซลล์
        txtData.Move fgData.CellLeft + 30, fgData.CellTop + 150, fgData.CellWidth, fgData.CellHeight
        ' การที่ CellLeft + 30 ... ก็เพราะว่าตำแหน่ง Left ของ MS FlexGrid มันอยู่ที่ 30 ... เลยต้องบวกเพิ่ม
        ' การที่ CellTop + 150 ... ก็เพราะว่าตำแหน่ง Top ของ MS FlexGrid มันอยู่ที่ 150 ... เช่นเดียวกัน

        ' เมื่อ txtData เคลื่อนที่ไปทับตำแหน่ง Cell ที่เราต้องการแล้ว ให้ Focus ไปที่ txtData เพื่อที่จะสามารถแก้ไขข้อมูลลงใน TextBox ได้
        txtData.SetFocus
End Select

End Sub

' เมื่อค่าใน TextBox เปลี่ยน ค่าใน Cell ที่ TextBox ทับเอาไว้ ก็ต้องเปลี่ยนตาม
Private Sub txtData_Change()
    Dim sRow As Integer
    ' หาค่าตำแหน่งของแถว
    sRow = fgData.Row
    
    ' เมื่อ txtData เกิดการเปลี่ยนแปลง ก็จะส่งค่าให้กับ Cell ที่เราต้องการด้วย
    ' แต่ ณ ขณะนี้เรายังมองไม่เห็นหรอกครับ เพราะ txtData มันทับ Cell ไว้อยู่ -- สำมะคัญน่ะตัวนี้
    ' ค่าใน TextBox จะต้องไม่เป็นค่าว่าง ... หากเป็นใส่ 0 ให้มันซ่ะ
    If Trim(txtData.Text) = "" Or Len(Trim(txtData.Text)) = 0 Then txtData.Text = "0"
    
    fgData.TextMatrix(sRow, 3) = txtData.Text
    fgData.TextMatrix(sRow, 4) = Format(fgData.TextMatrix(sRow, 2) * fgData.TextMatrix(sRow, 3), "0.00")

End Sub

Private Sub txtData_GotFocus()
    ' โปรแกรมย่อยในการทำ High Light ใน TextBox
    Call HLText(txtData)
End Sub

' การดักคีย์ที่กดลงบน TextBox
Private Sub txtData_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyDown
            SendKeys "{DOWN}"
            Call txtData_KeyPress(vbKeyReturn)
        Case vbKeyUp
            SendKeys "{UP}"
            Call txtData_KeyPress(vbKeyReturn)
        Case vbKeyEscape
            Call txtData_KeyPress(vbKeyReturn)
    End Select
End Sub

Private Sub txtData_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtData.Visible = False
        KeyAscii = 0
    End If
    ' ตรวจสอบการกดคีย์ตัวเลขได้เท่านั้น
    KeyAscii = CheckDigitOnly(KeyAscii)
End Sub

' ตรวจสอบการป้อนค่าได้เฉพาะตัวเลข
Function CheckDigitOnly(Index As Integer) As Integer
    Select Case Index
        Case 48 To 57 ' 0 - 9
        Case 8            ' Back Space
        Case 13         ' Enter
        Case Else
            Index = 0
    End Select
    CheckDigitOnly = Index
End Function

' โปรแกรมย่อยในการทำ High Light ใน TextBox ... ใช้ร่วมกับ GotFocus
Public Sub HLText(ByRef sText)
    On Error Resume Next
    With sText
        .SelStart = 0
        .SelLength = Len(sText.Text)
    End With
End Sub