[VB6] การจัดกลุ่มใน SharpGrid ActiveX แบบ Bound Data Run Time

thongkorn

สำหรับ Visual Basic ทุกรุ่น วิธีการที่เขียนโค้ดคำสั่งขึ้นมา แล้วสั่งรันมันถึงจะเห็นผล เราเรียกว่า Run-Time ซึ่งจะต่างไปจากการจับลากมาวางแปะๆ ปรับโน่นนั่นนี่แสดงผลให้เห็นทันทีเป็นอันจบ อันนี้เรียกว่า Design-Time ... ในการพัฒนาโปรแกรมจริงๆ เราจะต้องอาศัยทั้ง 2 วิธีนั่นแหละ แต่ทุกๆหัวข้อแอดมินจะเน้นย้ำวิธีการแบบ Run-Time มากกว่า เพราะมันจะเกิดความยืดหยุ่นให้กับตัวโปรแกรม จะหดจะขยายได้ดั่งใจนึก จะได้ไม่เป็นภาระของลูกหลานที่มาอ่านโค้ดตามหลังเรา และที่สำคัญมันจะเป็นพื้นฐานต่อ-ยอดออกไปยังการใช้งานเทคโนโลยี Net Framework อย่างไม่ยากเย็นนัก ... สำหรับวันนี้แอดมินจะมาแสดงโค้ดการจัดกลุ่มข้อมูลใน SharpGrid แบบผูกข้อมูล (Bound Data Control) ในลักษณะแบบ Run-Time กันน่ะครับ ...

[VB6] แจกโค้ดการใช้งานตารางกริด SharpGrid Bound Data Control ในแบบ Run Time
[VB6] แจกโค้ดการใช้งานตารางกริด SharpGrid UnBound Data Control ในแบบ Run Time

ดาวน์โหลดชุดติดตั้ง SharpGrid ได้ที่นี่ (เฉพาะสมาชิกเท่านั้น) ...


มาดูโค้ดกันเถอะ ... สำหรับฟอร์มหลัก

1. ' / -----------------------------------------------------------------------------------------------
   
2. ' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
   
3. ' / eMail : thongkorn@hotmail.com
   
4. ' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
   
5. ' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
   
6. ' / Facebook: https://www.facebook.com/commonindy (Worldwide)
   
7. ' / MORE: http://www.g2gnet.com/webboard
   
8. ' /
   
9. ' / Purpose : Sample SharpGrid ActiveX for Bound Data & Grouping Run-Time.
   
10. ' / Microsoft Visual Basic 6.0 (SP6)
    
11. ' /
    
12. ' / This is open source code under @CopyLeft by Thongkorn/Common Tubtimkrob.
    
13. ' / You can modify and/or distribute without to inform the developer.
    
14. ' / -----------------------------------------------------------------------------------------------
    
15. 
    
16. Option Explicit
    
17. 
    
18. ' / -----------------------------------------------------------------------------------------------
    
19. ' / เลือกการแสดงผลแบบกลุ่ม
    
20. Private Sub cmbGroup_Click()
    
21.     If cmbGroup.ListIndex = 0 Then
    
22.         cmdCollapse.Enabled = False
    
23.         cmdExpand.Enabled = False
    
24.     Else
    
25.         cmdCollapse.Enabled = True
    
26.         cmdExpand.Enabled = True
    
27.     End If
    
28.     ' / Bound Data เข้าสู่ SharpGrid
    
29.     Call SGGridCountryBound
    
30. End Sub
    
31. 
    
32. Private Sub cmdCollapse_Click()
    
33.     SGGridData.CollapseAll
    
34. End Sub
    
35. 
    
36. Private Sub cmdExpand_Click()
    
37.     SGGridData.ExpandAll
    
38. End Sub
    
39. 
    
40. ' / -----------------------------------------------------------------------------------------------
    
41. Private Sub Form_Load()
    
42. ' / -----------------------------------------------------------------------------------------------
    
43. On Error GoTo ErrorHandler
    
44.     Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
    
45.     ' / เชื่อมต่อกับไฟล์ฐานข้อมูล
    
46.     Call OpenDataBase
    
47.    
    
48.     ' / ใส่รายการกลุ่มใน ComboBox
    
49.     cmbGroup.AddItem "แสดงผลทั้งหมด"    ' / Index = 0
    
50.     cmbGroup.AddItem "จัดกลุ่มตามโซน"       ' / Index = 1
    
51.     cmbGroup.ListIndex = 0  ' / เริ่มต้นที่แสดงผลทั้งหมด
    
52.    
    
53.     ' / ตั้งค่าเริ่มต้นให้กับ SharpGrid
    
54.     Call SetupSGGridCountry
    
55.     ' / Bound Data เข้าสู่ SharpGrid
    
56.     Call SGGridCountryBound
    
57.    
    
58. ExitProc:
    
59.     Exit Sub
    
60.    
    
61. ErrorHandler:
    
62.     MsgBox "Error : " & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "รายงานความผิดพลาด"
    
63.     Resume ExitProc
    
64. 
    
65. End Sub
    
66. 
    
67. ' / -----------------------------------------------------------------------------------------------
    
68. Sub SetupSGGridCountry()
    
69. ' / -----------------------------------------------------------------------------------------------
    
70.     ' / Initialize grid properties
    
71.     ' / การตั้งค่าคุณสมบัติ (Properties) ในแบบ Run Time (สั่งรันโปรแกรมจึงจะเห็นผล)
    
72.     ' / เป็นการตั้งค่ามาตรฐานที่เราต้องใช้งานกันเป็นประจำ แบบไม่ต้องมาท่องจำ
    
73.     With SGGridData
    
74.         ' ============ IMPORTANT ===========
    
75.         ' / สำหรับการจัดกลุ่มแบบ Drag & Drop
    
76.         .GroupByBoxVisible = False  ' <----- ปิดการ Drag & Drop ของ Group
    
77.         .CacheAllRecords = True
    
78.         '.GroupByBoxText = "Drag a column header here to group by that column"
    
79.         .GroupByBoxText = "ลากส่วนหัวของแต่ละหลักมาวางเพื่อทำการจัดกลุ่ม"
    
80.         ' ===================================
    
81.         .FitLastColumn = True
    
82.         .Appearance = sg3D
    
83.         .SpecialMode = sgModeListBox
    
84.         .CellsBorderVisible = True
    
85.         .AutoResize = sgAutoResizeColumns   ' / ปรับขนาดหลักแบบออโต้
    
86.         .GroupIndentation = 225 ' / ระยะการจัดกลุ่มเยื้องมาจากทางซ้าย
    
87.         
    
88.         .DefaultRowHeight = 390
    
89.         .RowHeightMin = 390
    
90.         .HeadingColCount = 1
    
91.         
    
92.         .HeadingGridLinesColor = vbBlack
    
93.         .HeadingGridLines = sgGridLineFlat
    
94.         
    
95.         .EvenOddStyle = sgEvenOddRows
    
96.         .ColorOdd = &HEFEFE0
    
97.         
    
98.         .CellTips = sgCellTipsFloat
    
99.         .CellTipsDelay = 400
    
100.         .ScrollBarTips = sgScrollTipsVertical
     
101.         
     
102.         ' / การแสดงผลปกติในตารางกริด
     
103.         With .Styles("Normal")
     
104.             .BkgStyle = sgCellBkgSolid
     
105.             .Font.Name = "Tahoma"
     
106.             .Font.Size = 8
     
107.             .Padding = 18
     
108.         End With
     
109.         ' / ส่วนหัวของหลัก (Columns)
     
110.         With .Styles("Heading")
     
111.             .BackColor = RGB(205, 0, 0)
     
112.             .ForeColor = vbWhite
     
113.             .Font.Name = "Tahoma"
     
114.             .Font.Size = 9
     
115.             .Font.Bold = True
     
116.             .Padding = 75
     
117.         End With
     
118.         ' / ส่วนหัวของ Group
     
119.         With .Styles("GroupHeader")
     
120.             .Font.Size = 9
     
121.             .Font.Bold = True
     
122.             .BackColor = RGB(241, 239, 226)
     
123.             .BkgStyle = sgCellBkgSolid
     
124.             .Padding = 30
     
125.             .BorderColor = RGB(241, 207, 0)
     
126.             .Borders = sgCellBorderBottom
     
127.             .BorderSize = 1
     
128.         End With
     
129.         ' / ส่วนด้านล่างหรือสรุปของ Group
     
130.         With .Styles("GroupFooter")
     
131.             .Font.Size = 9
     
132.             .Font.Name = "Tahoma"
     
133.             .ForeColor = vbBlue
     
134.             .BackColor = RGB(255, 255, 224)
     
135.             .BkgStyle = sgCellBkgSolid
     
136.             .Padding = 75
     
137.             .BorderColor = RGB(255, 207, 0)
     
138.             .Borders = sgCellBorderBottom
     
139.             .BorderSize = 50
     
140.             .TextAlignment = sgAlignLeftCenter
     
141.         End With
     
142.         
     
143.         With .Styles("Tip")
     
144.             .Font.Size = 10
     
145.             .Padding = 40
     
146.         End With
     
147.         ' / แถวที่เราเลือกหรือโฟกัส
     
148.         With .Styles("Selection")
     
149.             .BackColor = RGB(0, 170, 0)
     
150.             .ForeColor = vbWhite
     
151.             .BkgStyle = sgCellBkgSolid
     
152.         End With
     
153.         ' / แถวที่เราไม่ได้โฟกัส
     
154.         With .Styles("InactiveSelection")
     
155.             .BackColor = RGB(0, 170, 0)
     
156.             .ForeColor = vbWhite
     
157.             .BkgStyle = sgCellBkgSolid
     
158.         End With
     
159.    
     
160.     End With
     
161.    
     
162. End Sub
     
163. ' / -----------------------------------------------------------------------------------------------
     
164. Sub SGGridCountryBound()
     
165. ' / -----------------------------------------------------------------------------------------------
     
166.    
     
167.     ' สร้าง Instance ขึ้นมาใหม่ พร้อมกับตัดการเชื่อมต่อเดิมทิ้ง (หากลืม)
     
168.     Set RS = New ADODB.Recordset
     
169.     ' / ****************** I M P O R T A N T ******************
     
170.     ' / Create select statement, sample join 2 tables.
     
171.     ' / การ Bound Data เมื่อเวลาแสดงผลในแต่ละหลัก (Column) มันจะถูกจัดเรียงตามการชื่อฟิลด์ใน Query
     
172.     ' / ย้ำอีกทีว่าหลักจะถูกจัดเรียงตามชื่อฟิลด์
     
173.     Statement = " SELECT Countries.CountryPK, Countries.Flag, Countries.A2, Countries.Country, Countries.Capital, " & _
     
174.                         " Countries.Population, Zones.ZoneName " & _
     
175.                         " FROM Countries INNER JOIN Zones ON Countries.ZoneFK = Zones.ZonePK "
     
176. 
     
177.     ' ////////// I M P O R T A N T /////////////
     
178.     ' / การจัดเรียงข้อมูล (ORDER) จะมีผลต่อการแสดงผลในการจัดกลุ่ม
     
179.     Select Case cmbGroup.ListIndex
     
180.         Case 0:
     
181.             Statement = Statement & " ORDER BY Countries.A2 "
     
182.         Case 1:
     
183.             ' / จัดกลุ่มตามโซน ก็จะต้องให้เกิดการจัดเรียงข้อมูลตาม ZoneName
     
184.             Statement = Statement & " ORDER BY Zones.ZoneName, Countries.A2 "
     
185.     End Select
     
186. 
     
187.     ' ============ IMPORTANT ==========
     
188.     SGGridData.DataMode = sgBound
     
189.     ' ==================================
     
190.     RS.CursorLocation = adUseClient
     
191.     RS.Open Statement, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
     
192.     ' ======================= ผูกเข้ากับตาราง RecordSet =========================
     
193.     Set SGGridData.DataSource = RS
     
194.     ' =====================================================================
     
195.     'SGGridData.DataRowCount = RS.RecordCount
     
196.    
     
197.     With SGGridData
     
198.         ' / หลัก 0 นี่คือหลักที่แสดงหมายเลขแถวครับ
     
199.         .Rows.At(0).Height = 420
     
200.         ' / คลิ๊กส่วนหัวให้สามารถจัดเรียงข้อมูลแบบน้อยไปหามาก และคลิ๊กอีกทีจะเรียงจากมากไปหาน้อย
     
201.         .ColumnClickSort = True
     
202.         ' / หลัก 0 ที่แสดงหมายเลขแถวจะถูกซ่อน ไม่ให้แสดงผล
     
203.         .Columns(0).Hidden = True
     
204.         ' / ไม่แสดงผลลำดับที่
     
205.         .RowNumbering = False
     
206.         ' /
     
207.         .Columns(1).Caption = "CountryPK"
     
208.         ' / ซ่อนหลัก Primary Key (หลัก 1 เพราะหลัก 0 คือหลักแสดงผลลำดับแถว)
     
209.         .Columns(1).Hidden = True
     
210.         '
     
211.         .Columns(2).Caption = "ธงชาติ"
     
212.         .Columns(2).Width = 800
     
213.         .Columns(3).Caption = "ชื่อย่อ"
     
214.         .Columns(3).Width = 800
     
215.         .Columns(4).Caption = "ชื่อประเทศ"
     
216.         .Columns(4).Width = 2000
     
217.         .Columns(5).Caption = "ชื่อเมืองหลวง"
     
218.         .Columns(5).Width = 1800
     
219.         .Columns(6).Caption = "จำนวนประชากร"
     
220.         .Columns(6).Width = 1600
     
221.         .Columns(6).Style.TextAlignment = sgAlignRightCenter
     
222.         .Columns(6).DataType = sgtCurrency
     
223.         .Columns(6).Style.Format = "#,##0.00"
     
224.         .Columns(7).Caption = "โซน"
     
225.         .Columns(7).Hidden = False
     
226.     End With
     
227.     ' ========== Start of Group ==========
     
228.     If cmbGroup.ListIndex = 1 Then
     
229.         Dim Grp1 As SGGroup
     
230.         With SGGridData
     
231.             ' Add group
     
232.             ' / ZoneName คือต้องการจัดกลุ่มตามชื่อโซน
     
233.             Set Grp1 = .Groups.Add("ZoneName", sgNoSorting, False, True)
     
234.             ' / ในส่วนการแสดงผล
     
235.             Grp1.HeaderCaption = "กลุ่มโซน"
     
236.             Grp1.FetchHeaderStyle = True
     
237.             Grp1.HeaderTextSource = sgGrpHdrCaptionAndValue
     
238.             ' / หาค่า Summary ของหลัก Population (การคำนวณอื่นๆ ขอให้ไปดูที่ Help น่ะครับ)
     
239.             Grp1.Calculations.Add sgCalcSum, "Population"
     
240.             ' / แสดงผลการรวมจำนวนประชากรที่กลุ่มของ Footer (สรุปผล)
     
241.             Grp1.FooterTextSource = sgGrpFooterFormula
     
242.             Grp1.FooterFormula = "'Total populations:    ' & Format((GroupCalc(1)),'#,##0.00')  & ' คน." & "'"
     
243.             
     
244.             ' / ปิดการแสดงผลในหลักที่ 7 เพราะเรานำหลักนี้ไปจัดกลุ่ม
     
245.             .Columns(7).Hidden = True
     
246.         End With
     
247.         '
     
248.         Set Grp1 = Nothing
     
249.         ' / หากต้องการแสดงผลการจัดกลุ่มแบบมีกิ่งก้านสาขา ให้สั่ง ExpandAll
     
250.         SGGridData.ExpandAll
     
251.     End If
     
252.     ' ========== End of Group ==========
     
253.    
     
254.     ' / ต้องตัดการเชื่อมต่อ RecordSet ทุกครั้ง
     
255.     RS.Close:   Set RS = Nothing
     
256. End Sub
     
257. 
     
258. ' / -----------------------------------------------------------------------------------------------
     
259. ' / แสดง Primary Key ที่ถูกซ่อนเอาไว้ เพื่อนำไปใช้งาน
     
260. Private Sub SGGridData_DblClick()
     
261. ' / -----------------------------------------------------------------------------------------------
     
262.     ' / หลัก 1 คือ Primary Key ที่เรานำไปซ่อนไว้ไม่ให้ Users มองเห็น
     
263.     SGGridData.Col = 1
     
264.     ' / หากดับเบิ้ลคลิ๊กเมาส์แล้ว เจอแถวที่แสดงผลแบบกลุ่ม ก็ให้ออกไปจากโปรแกรมย่อย
     
265.     If Not IsNumeric(SGGridData.Text) Then Exit Sub
     
266.    
     
267.     MsgBox "CountryPK = " & Val(SGGridData.Text)
     
268. End Sub
     
269. 
     
270. ' / -----------------------------------------------------------------------------------------------
     
271. ' / เหตุการณ์ที่เกิดก่อนการเปลี่ยนแปลงในการจัดกลุ่มในแต่ละหลัก (Column)
     
272. ' / ไม่ได้ใช้สำหรับการจัดกลุ่มในโค้ดชุดนี้
     
273. Private Sub SGGridData_BeforeGroupChange( _
     
274.     ByVal Operation As DDSharpGridOLEDB2U.sgGroupOperation, _
     
275.     ByVal GroupOrColIndex As Long, _
     
276.     ByVal NewIndex As Long, _
     
277.     SortOrder As DDSharpGridOLEDB2U.sgSortOrder, _
     
278.     SortType As DDSharpGridOLEDB2U.sgSortType, _
     
279.     ShowFooter As Boolean, _
     
280.     Cancel As Boolean _
     
281.     )
     
282. ' / -----------------------------------------------------------------------------------------------
     
283.     If Operation = sgGroupRemove Then
     
284.         SGGridData.Columns(SGGridData.Groups(GroupOrColIndex).GroupingColumn).Hidden = False
     
285.     ElseIf Operation = sgGroupAdd Then
     
286.         SGGridData.Columns(GroupOrColIndex).Hidden = True
     
287.     End If
     
288. End Sub
     
289. 
     
290. Private Sub Form_Resize()
     
291.     On Error Resume Next
     
292.     If Me.ScaleWidth < 120 Or Me.ScaleHeight < 120 Then Exit Sub
     
293.     fraData.Height = Me.ScaleHeight - 30
     
294.     fraData.Move 15, 0, Me.ScaleWidth - 15
     
295.     SGGridData.Move 15, 795, fraData.Width - (SGGridData.Left) - 15, fraData.Height - 300
     
296. End Sub
     
297. 
     
298. Private Sub Form_Unload(Cancel As Integer)
     
299. On Error Resume Next
     
300.     If Dir$(App.Path & "\*.tmp") <> "" Then
     
301.         Kill App.Path & "\*.tmp"
     
302.     End If
     
303.     '
     
304.     Call CloseDataBase
     
305.     End
     
306. End Sub

คัดลอกไปที่คลิปบอร์ด

มาดูโค้ดในส่วนของโมดูลหากิน ...

1. ' / -----------------------------------------------------------------------------------------------
   
2. ' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
   
3. ' / eMail : thongkorn@hotmail.com
   
4. ' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
   
5. ' / Facebook: https://www.facebook.com/g2gnet (For Thailand only)
   
6. ' / Facebook: https://www.facebook.com/commonindy (For International)
   
7. ' / Purpose : Standard module for connect database and declare global variable.
   
8. ' / Microsoft Visual Basic 6.0 Service Pack 6
   
9. ' / -----------------------------------------------------------------------------------------------
   
10. Option Explicit
    
11. 
    
12. Global ConnDB As New ADODB.Connection
    
13. Global RS As New ADODB.Recordset    ' / RecordSet หลัก
    
14. Global DS As New ADODB.Recordset    ' / RecordSet สำรอง
    
15. 'Global RstData As New ADODB.Recordset   ' / ใช้ในการพิมพ์รายงาน
    
16. Global Statement As String
    
17. 'Global SQLStmt As String
    
18. 
    
19. ' / -----------------------------------------------------------------------------------------------
    
20. Public Sub OpenDataBase()
    
21. On Error GoTo Err_Handler
    
22. Dim DB_File As String
    
23. Dim CnStr As String
    
24.     DB_File = App.Path
    
25.     If Right$(DB_File, 1) <> "" Then DB_File = DB_File & ""
    
26.     DB_File = DB_File & "Countries.MDB"
    
27.     ' Open a connection.
    
28.     Set ConnDB = New ADODB.Connection
    
29.     ConnDB.ConnectionString = _
    
30.         "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    
31.         "Data Source=" & DB_File & ";" & _
    
32.         "Persist Security Info=False"
    
33.         '" Jet OLEDB:Database Password=" & "password" & ";" '& _
    
34.         '" Engine Type=5;"
    
35.     ConnDB.Open
    
36.     Exit Sub
    
37. Err_Handler:
    
38.     MsgBox "Open Database Error : " & vbCrLf & Err.Number & " " & Err.Description
    
39.     End
    
40. End Sub
    
41. 
    
42. Public Sub CloseDataBase()
    
43.     ' ตรวจสอบว่ามีการเชื่อมโยง - Connect ข้อมูลหรือไม่
    
44.     If ConnDB.State = adStateOpen Then
    
45.         ConnDB.Close
    
46.         Set ConnDB = Nothing
    
47.     End If
    
48. End Sub
    
49. 
    
50. ' / -----------------------------------------------------------------------------------------------
    
51. ' / ฟังค์ชั่นแก้ไขในการ SendKeys ซึ่งใน Windows 8+ 64 บิท จะมีปัญหา
    
52. Public Sub Sendkeys(Text As String, Optional Wait As Boolean = False)
    
53.     Dim WshShell As Object
    
54.     Set WshShell = CreateObject("Wscript.shell")
    
55.     WshShell.Sendkeys Text, Wait
    
56.     Set WshShell = Nothing
    
57. End Sub

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...