[VB6] การจัดกลุ่มใน SharpGrid ActiveX แบบ Bound Data Run Time
http://www.g2gnet.com/webboard/images/vb6/SharpgridBoundGroup.pngสำหรับ Visual Basic ทุกรุ่น วิธีการที่เขียนโค้ดคำสั่งขึ้นมา แล้วสั่งรันมันถึงจะเห็นผล เราเรียกว่า Run-Time ซึ่งจะต่างไปจากการจับลากมาวางแปะๆ ปรับโน่นนั่นนี่แสดงผลให้เห็นทันทีเป็นอันจบ อันนี้เรียกว่า Design-Time ... ในการพัฒนาโปรแกรมจริงๆ เราจะต้องอาศัยทั้ง 2 วิธีนั่นแหละ แต่ทุกๆหัวข้อแอดมินจะเน้นย้ำวิธีการแบบ Run-Time มากกว่า เพราะมันจะเกิดความยืดหยุ่นให้กับตัวโปรแกรม จะหดจะขยายได้ดั่งใจนึก จะได้ไม่เป็นภาระของลูกหลานที่มาอ่านโค้ดตามหลังเรา และที่สำคัญมันจะเป็นพื้นฐานต่อ-ยอดออกไปยังการใช้งานเทคโนโลยี Net Framework อย่างไม่ยากเย็นนัก ... สำหรับวันนี้แอดมินจะมาแสดงโค้ดการจัดกลุ่มข้อมูลใน SharpGrid แบบผูกข้อมูล (Bound Data Control) ในลักษณะแบบ Run-Time กันน่ะครับ ...
แจกโค้ดการใช้งานตารางกริด SharpGrid Bound Data Control ในแบบ Run Time
แจกโค้ดการใช้งานตารางกริด SharpGrid UnBound Data Control ในแบบ Run Time
ดาวน์โหลดชุดติดตั้ง SharpGrid ได้ที่นี่ (เฉพาะสมาชิกเท่านั้น) ...
มาดูโค้ดกันเถอะ ... สำหรับฟอร์มหลัก
' / -----------------------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / MORE: http://www.g2gnet.com/webboard
' /
' / Purpose : Sample SharpGrid ActiveX for Bound Data & Grouping Run-Time.
' / Microsoft Visual Basic 6.0 (SP6)
' /
' / This is open source code under @CopyLeft by Thongkorn/Common Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / -----------------------------------------------------------------------------------------------
Option Explicit
' / -----------------------------------------------------------------------------------------------
' / เลือกการแสดงผลแบบกลุ่ม
Private Sub cmbGroup_Click()
If cmbGroup.ListIndex = 0 Then
cmdCollapse.Enabled = False
cmdExpand.Enabled = False
Else
cmdCollapse.Enabled = True
cmdExpand.Enabled = True
End If
' / Bound Data เข้าสู่ SharpGrid
Call SGGridCountryBound
End Sub
Private Sub cmdCollapse_Click()
SGGridData.CollapseAll
End Sub
Private Sub cmdExpand_Click()
SGGridData.ExpandAll
End Sub
' / -----------------------------------------------------------------------------------------------
Private Sub Form_Load()
' / -----------------------------------------------------------------------------------------------
On Error GoTo ErrorHandler
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
' / เชื่อมต่อกับไฟล์ฐานข้อมูล
Call OpenDataBase
' / ใส่รายการกลุ่มใน ComboBox
cmbGroup.AddItem "แสดงผลทั้งหมด" ' / Index = 0
cmbGroup.AddItem "จัดกลุ่มตามโซน" ' / Index = 1
cmbGroup.ListIndex = 0' / เริ่มต้นที่แสดงผลทั้งหมด
' / ตั้งค่าเริ่มต้นให้กับ SharpGrid
Call SetupSGGridCountry
' / Bound Data เข้าสู่ SharpGrid
Call SGGridCountryBound
ExitProc:
Exit Sub
ErrorHandler:
MsgBox "Error : " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "รายงานความผิดพลาด"
Resume ExitProc
End Sub
' / -----------------------------------------------------------------------------------------------
Sub SetupSGGridCountry()
' / -----------------------------------------------------------------------------------------------
' / Initialize grid properties
' / การตั้งค่าคุณสมบัติ (Properties) ในแบบ Run Time (สั่งรันโปรแกรมจึงจะเห็นผล)
' / เป็นการตั้งค่ามาตรฐานที่เราต้องใช้งานกันเป็นประจำ แบบไม่ต้องมาท่องจำ
With SGGridData
' ============ IMPORTANT ===========
' / สำหรับการจัดกลุ่มแบบ Drag & Drop
.GroupByBoxVisible = False' <----- ปิดการ Drag & Drop ของ Group
.CacheAllRecords = True
'.GroupByBoxText = "Drag a column header here to group by that column"
.GroupByBoxText = "ลากส่วนหัวของแต่ละหลักมาวางเพื่อทำการจัดกลุ่ม"
' ===================================
.FitLastColumn = True
.Appearance = sg3D
.SpecialMode = sgModeListBox
.CellsBorderVisible = True
.AutoResize = sgAutoResizeColumns ' / ปรับขนาดหลักแบบออโต้
.GroupIndentation = 225 ' / ระยะการจัดกลุ่มเยื้องมาจากทางซ้าย
.DefaultRowHeight = 390
.RowHeightMin = 390
.HeadingColCount = 1
.HeadingGridLinesColor = vbBlack
.HeadingGridLines = sgGridLineFlat
.EvenOddStyle = sgEvenOddRows
.ColorOdd = &HEFEFE0
.CellTips = sgCellTipsFloat
.CellTipsDelay = 400
.ScrollBarTips = sgScrollTipsVertical
' / การแสดงผลปกติในตารางกริด
With .Styles("Normal")
.BkgStyle = sgCellBkgSolid
.Font.Name = "Tahoma"
.Font.Size = 8
.Padding = 18
End With
' / ส่วนหัวของหลัก (Columns)
With .Styles("Heading")
.BackColor = RGB(205, 0, 0)
.ForeColor = vbWhite
.Font.Name = "Tahoma"
.Font.Size = 9
.Font.Bold = True
.Padding = 75
End With
' / ส่วนหัวของ Group
With .Styles("GroupHeader")
.Font.Size = 9
.Font.Bold = True
.BackColor = RGB(241, 239, 226)
.BkgStyle = sgCellBkgSolid
.Padding = 30
.BorderColor = RGB(241, 207, 0)
.Borders = sgCellBorderBottom
.BorderSize = 1
End With
' / ส่วนด้านล่างหรือสรุปของ Group
With .Styles("GroupFooter")
.Font.Size = 9
.Font.Name = "Tahoma"
.ForeColor = vbBlue
.BackColor = RGB(255, 255, 224)
.BkgStyle = sgCellBkgSolid
.Padding = 75
.BorderColor = RGB(255, 207, 0)
.Borders = sgCellBorderBottom
.BorderSize = 50
.TextAlignment = sgAlignLeftCenter
End With
With .Styles("Tip")
.Font.Size = 10
.Padding = 40
End With
' / แถวที่เราเลือกหรือโฟกัส
With .Styles("Selection")
.BackColor = RGB(0, 170, 0)
.ForeColor = vbWhite
.BkgStyle = sgCellBkgSolid
End With
' / แถวที่เราไม่ได้โฟกัส
With .Styles("InactiveSelection")
.BackColor = RGB(0, 170, 0)
.ForeColor = vbWhite
.BkgStyle = sgCellBkgSolid
End With
End With
End Sub
' / -----------------------------------------------------------------------------------------------
Sub SGGridCountryBound()
' / -----------------------------------------------------------------------------------------------
' สร้าง Instance ขึ้นมาใหม่ พร้อมกับตัดการเชื่อมต่อเดิมทิ้ง (หากลืม)
Set RS = New ADODB.Recordset
' / ****************** I M P O R T A N T ******************
' / Create select statement, sample join 2 tables.
' / การ Bound Data เมื่อเวลาแสดงผลในแต่ละหลัก (Column) มันจะถูกจัดเรียงตามการชื่อฟิลด์ใน Query
' / ย้ำอีกทีว่าหลักจะถูกจัดเรียงตามชื่อฟิลด์
Statement = " SELECT Countries.CountryPK, Countries.Flag, Countries.A2, Countries.Country, Countries.Capital, " & _
" Countries.Population, Zones.ZoneName " & _
" FROM Countries INNER JOIN Zones ON Countries.ZoneFK = Zones.ZonePK "
' ////////// I M P O R T A N T /////////////
' / การจัดเรียงข้อมูล (ORDER) จะมีผลต่อการแสดงผลในการจัดกลุ่ม
Select Case cmbGroup.ListIndex
Case 0:
Statement = Statement & " ORDER BY Countries.A2 "
Case 1:
' / จัดกลุ่มตามโซน ก็จะต้องให้เกิดการจัดเรียงข้อมูลตาม ZoneName
Statement = Statement & " ORDER BY Zones.ZoneName, Countries.A2 "
End Select
' ============ IMPORTANT ==========
SGGridData.DataMode = sgBound
' ==================================
RS.CursorLocation = adUseClient
RS.Open Statement, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
' ======================= ผูกเข้ากับตาราง RecordSet =========================
Set SGGridData.DataSource = RS
' =====================================================================
'SGGridData.DataRowCount = RS.RecordCount
With SGGridData
' / หลัก 0 นี่คือหลักที่แสดงหมายเลขแถวครับ
.Rows.At(0).Height = 420
' / คลิ๊กส่วนหัวให้สามารถจัดเรียงข้อมูลแบบน้อยไปหามาก และคลิ๊กอีกทีจะเรียงจากมากไปหาน้อย
.ColumnClickSort = True
' / หลัก 0 ที่แสดงหมายเลขแถวจะถูกซ่อน ไม่ให้แสดงผล
.Columns(0).Hidden = True
' / ไม่แสดงผลลำดับที่
.RowNumbering = False
' /
.Columns(1).Caption = "CountryPK"
' / ซ่อนหลัก Primary Key (หลัก 1 เพราะหลัก 0 คือหลักแสดงผลลำดับแถว)
.Columns(1).Hidden = True
'
.Columns(2).Caption = "ธงชาติ"
.Columns(2).Width = 800
.Columns(3).Caption = "ชื่อย่อ"
.Columns(3).Width = 800
.Columns(4).Caption = "ชื่อประเทศ"
.Columns(4).Width = 2000
.Columns(5).Caption = "ชื่อเมืองหลวง"
.Columns(5).Width = 1800
.Columns(6).Caption = "จำนวนประชากร"
.Columns(6).Width = 1600
.Columns(6).Style.TextAlignment = sgAlignRightCenter
.Columns(6).DataType = sgtCurrency
.Columns(6).Style.Format = "#,##0.00"
.Columns(7).Caption = "โซน"
.Columns(7).Hidden = False
End With
' ========== Start of Group ==========
If cmbGroup.ListIndex = 1 Then
Dim Grp1 As SGGroup
With SGGridData
' Add group
' / ZoneName คือต้องการจัดกลุ่มตามชื่อโซน
Set Grp1 = .Groups.Add("ZoneName", sgNoSorting, False, True)
' / ในส่วนการแสดงผล
Grp1.HeaderCaption = "กลุ่มโซน"
Grp1.FetchHeaderStyle = True
Grp1.HeaderTextSource = sgGrpHdrCaptionAndValue
' / หาค่า Summary ของหลัก Population (การคำนวณอื่นๆ ขอให้ไปดูที่ Help น่ะครับ)
Grp1.Calculations.Add sgCalcSum, "Population"
' / แสดงผลการรวมจำนวนประชากรที่กลุ่มของ Footer (สรุปผล)
Grp1.FooterTextSource = sgGrpFooterFormula
Grp1.FooterFormula = "'Total populations: ' & Format((GroupCalc(1)),'#,##0.00')& ' คน." & "'"
' / ปิดการแสดงผลในหลักที่ 7 เพราะเรานำหลักนี้ไปจัดกลุ่ม
.Columns(7).Hidden = True
End With
'
Set Grp1 = Nothing
' / หากต้องการแสดงผลการจัดกลุ่มแบบมีกิ่งก้านสาขา ให้สั่ง ExpandAll
SGGridData.ExpandAll
End If
' ========== End of Group ==========
' / ต้องตัดการเชื่อมต่อ RecordSet ทุกครั้ง
RS.Close: Set RS = Nothing
End Sub
' / -----------------------------------------------------------------------------------------------
' / แสดง Primary Key ที่ถูกซ่อนเอาไว้ เพื่อนำไปใช้งาน
Private Sub SGGridData_DblClick()
' / -----------------------------------------------------------------------------------------------
' / หลัก 1 คือ Primary Key ที่เรานำไปซ่อนไว้ไม่ให้ Users มองเห็น
SGGridData.Col = 1
' / หากดับเบิ้ลคลิ๊กเมาส์แล้ว เจอแถวที่แสดงผลแบบกลุ่ม ก็ให้ออกไปจากโปรแกรมย่อย
If Not IsNumeric(SGGridData.Text) Then Exit Sub
MsgBox "CountryPK = " & Val(SGGridData.Text)
End Sub
' / -----------------------------------------------------------------------------------------------
' / เหตุการณ์ที่เกิดก่อนการเปลี่ยนแปลงในการจัดกลุ่มในแต่ละหลัก (Column)
' / ไม่ได้ใช้สำหรับการจัดกลุ่มในโค้ดชุดนี้
Private Sub SGGridData_BeforeGroupChange( _
ByVal Operation As DDSharpGridOLEDB2U.sgGroupOperation, _
ByVal GroupOrColIndex As Long, _
ByVal NewIndex As Long, _
SortOrder As DDSharpGridOLEDB2U.sgSortOrder, _
SortType As DDSharpGridOLEDB2U.sgSortType, _
ShowFooter As Boolean, _
Cancel As Boolean _
)
' / -----------------------------------------------------------------------------------------------
If Operation = sgGroupRemove Then
SGGridData.Columns(SGGridData.Groups(GroupOrColIndex).GroupingColumn).Hidden = False
ElseIf Operation = sgGroupAdd Then
SGGridData.Columns(GroupOrColIndex).Hidden = True
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.ScaleWidth < 120 Or Me.ScaleHeight < 120 Then Exit Sub
fraData.Height = Me.ScaleHeight - 30
fraData.Move 15, 0, Me.ScaleWidth - 15
SGGridData.Move 15, 795, fraData.Width - (SGGridData.Left) - 15, fraData.Height - 300
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If Dir$(App.Path & "\*.tmp") <> "" Then
Kill App.Path & "\*.tmp"
End If
'
Call CloseDataBase
End
End Sub
มาดูโค้ดในส่วนของโมดูลหากิน ...
' / -----------------------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand only)
' / Facebook: https://www.facebook.com/commonindy (For International)
' / Purpose : Standard module for connect database and declare global variable.
' / Microsoft Visual Basic 6.0 Service Pack 6
' / -----------------------------------------------------------------------------------------------
Option Explicit
Global ConnDB As New ADODB.Connection
Global RS As New ADODB.Recordset ' / RecordSet หลัก
Global DS As New ADODB.Recordset ' / RecordSet สำรอง
'Global RstData As New ADODB.Recordset ' / ใช้ในการพิมพ์รายงาน
Global Statement As String
'Global SQLStmt As String
' / -----------------------------------------------------------------------------------------------
Public Sub OpenDataBase()
On Error GoTo Err_Handler
Dim DB_File As String
Dim CnStr As String
DB_File = App.Path
If Right$(DB_File, 1) <> "\" Then DB_File = DB_File & "\"
DB_File = DB_File & "Countries.MDB"
' Open a connection.
Set ConnDB = New ADODB.Connection
ConnDB.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DB_File & ";" & _
"Persist Security Info=False"
'" Jet OLEDB:Database Password=" & "password" & ";" '& _
'" Engine Type=5;"
ConnDB.Open
Exit Sub
Err_Handler:
MsgBox "Open Database Error : " & vbCrLf & Err.Number & " " & Err.Description
End
End Sub
Public Sub CloseDataBase()
' ตรวจสอบว่ามีการเชื่อมโยง - Connect ข้อมูลหรือไม่
If ConnDB.State = adStateOpen Then
ConnDB.Close
Set ConnDB = Nothing
End If
End Sub
' / -----------------------------------------------------------------------------------------------
' / ฟังค์ชั่นแก้ไขในการ SendKeys ซึ่งใน Windows 8+ 64 บิท จะมีปัญหา
Public Sub Sendkeys(Text As String, Optional Wait As Boolean = False)
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.shell")
WshShell.Sendkeys Text, Wait
Set WshShell = Nothing
End Sub
ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...
หน้า:
[1]