API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Oct 22nd, 2019
118
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 24.59 KB | None | 0 0
raw download clone embed print report
  1. Private Function LoadTree() As Boolean
  2. 'On Error GoTo HELL
  3.  
  4. Dim Rec As New ADODB.Recordset
  5. Dim str As String
  6. Dim i As Integer
  7. Dim TypeBefore, GroupBefore As String
  8.  
  9. str = "select Distinct Type_name from v_materials WHERE Type_Code = 'MT001' or Type_Code = 'MT002' ORDER BY Type_Name" 'cari root
  10. Set Rec = oConn.ExecuteSQL(str, True)
  11. With fgStructures
  12. .Cols = 23: .Rows = 1
  13. .OutlineCol = 4
  14. .GridLines = 8
  15. For i = 0 To 3
  16. .ColHidden(i) = True
  17. Next i
  18.  
  19. For i = 13 To .Cols - 1
  20. .ColHidden(i) = True
  21. Next i
  22. ' 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
  23. .FormatString = "Code|Mat Code|Mat Name|Description| |Usage|Unit|Conv Usage|Conv Unit|Create|Revision No|Ref Number|Draw Number|main Mat|PARENT|FLAG|LEVEL|ID|p_code|MType|MGroup|TypeCode|GroupCode"
  24. .Cell(flexcpFontBold, 0, 0, 0, .Cols - 1) = True
  25. While Not Rec.EOF
  26. str = "" & vbTab & "" & vbTab & "" & vbTab & "" & vbTab & Rec.Fields(0)
  27. .AddItem str
  28. .IsSubtotal(.Rows - 1) = True
  29. .RowOutlineLevel(.Rows - 1) = 1 'Rec!bom_level ' + 1
  30. .Cell(flexcpFontBold, .Rows - 1, 0, , .Cols - 1) = True
  31. .Cell(flexcpPicture, .Rows - 1, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  32. .Cell(flexcpBackColor, .Rows - 1, 0, .Rows - 1, .Cols - 1) = LblTypeColor.BackColor
  33. .GetNode(.Rows - 1).Key = Rec.Fields(0)
  34. ' add hidden node (we'll handle this when the user expands it)
  35. .AddItem ""
  36. .IsSubtotal(.Rows - 1) = True
  37. .RowOutlineLevel(.Rows - 1) = .RowOutlineLevel(.Rows - 2) + 1
  38. Rec.MoveNext
  39. Wend
  40. For i = 4 To 12
  41. .AutoSize i
  42. Next
  43.  
  44. For i = 1 To .Rows - 1
  45. .IsCollapsed(i) = flexOutlineCollapsed
  46. Next
  47.  
  48. End With
  49. LoadTree = True
  50. Set Rec = Nothing
  51. HELL:
  52. If Err.Number <> 0 Then
  53. LoadTree = False
  54. Set Rec = Nothing
  55. Call LogActivities(Now(), "", Err.Number, Err.Source, Err.Description, "LoadTree() As Boolean", App.Major & "." & App.Minor & "." & App.Revision, "", vTypeError)
  56. MsgBox Err.Description, vbCritical, "LoadTreeMenu @ " & App.Title & "." & Me.Caption
  57. End If
  58. End Function
  59.  
  60.  
  61.  
  62. Private Sub ExpandRow(ByVal R&)
  63. Dim str As String
  64. Dim sql As String
  65. Dim encrypt As String
  66. Dim qty As String
  67. Dim Rs As New ADODB.Recordset
  68.  
  69. With fgStructures
  70. ' make it fast
  71. .Redraw = flexRDNone
  72. MousePointer = 11
  73. ' get information for new items
  74. Dim RsTmp As New ADODB.Recordset
  75. Dim i&, iPos&, iLvl&
  76. Dim StrNodeCode As String
  77. iPos = R + 1
  78. iLvl = .RowOutlineLevel(R) + 1
  79. 'cari kode node bom, item yang diselect
  80. If iLvl = 2 Then
  81. StrNodeCode = fgStructures.TextMatrix(R, 4)
  82. str = "SELECT DISTINCT Group_Name from v_materials " & _
  83. "WHERE Type_name = '" & StrNodeCode & "' " & _
  84. "Order By Group_Name" 'cari root
  85. Set RsTmp = oConn.ExecuteSQL(str, True)
  86. While Not RsTmp.EOF
  87. str = "" & vbTab & "" & vbTab & "" & vbTab & StrNodeCode & vbTab & RsTmp.Fields(0)
  88. .AddItem str, iPos
  89. .IsSubtotal(iPos) = True
  90. .RowOutlineLevel(iPos) = iLvl
  91. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  92. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  93. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblGroupColor.BackColor
  94. .GetNode(iPos).Key = StrNodeCode & "|" & RsTmp.Fields(0)
  95. ' add hidden node (we'll handle this when the user expands it)
  96. iPos = iPos + 1
  97. .AddItem "", iPos
  98. .IsSubtotal(iPos) = True
  99. .RowOutlineLevel(iPos) = iLvl + 1
  100. RsTmp.MoveNext
  101. iPos = iPos + 1
  102. Wend
  103. ElseIf iLvl = 3 Then
  104. 'cari Root
  105. StrNodeCode = .GetNode(R).Key
  106. str = "SELECT * from v_bill_of_materials " & _
  107. "WHERE parent_code = '0' and priority = 0 and " & _
  108. "MatType+'|'+Matgroup = '" & StrNodeCode & "' "
  109. Set RsTmp = oConn.ExecuteSQL(str, True)
  110. While Not RsTmp.EOF
  111. encrypt = IsValue(RsTmp!encript)
  112. If encrypt = "" Then encrypt = False
  113. If encrypt = True Then
  114. GroupName = oConn.LookUpTable("t_usermenu", "group_name", "user_name = '" & pubVar_UserName & "'")
  115. If oConn.LookUpTable("t_param", "ID", "param_name = 'decript' and param_value = '" & GroupName & "'") <> "" Then
  116. sql = "select dbo.Fn_LoadCript('" & IsValue(RsTmp!qty_usage) & "') as val"
  117. Set Rs = oConn.ExecuteSQL(sql, True)
  118. qty = IsValue(Rs("Val"))
  119. str = RsTmp!code & vbTab & IsValue(RsTmp!mat_code) & vbTab & _
  120. IsValue(RsTmp!mat_name) & vbTab & _
  121. IsValue(RsTmp!mat_desc) & vbTab & _
  122. IsValue(RsTmp!mat_code) & " - " & IsValue(RsTmp!mat_name) & " - " & _
  123. IsValue(RsTmp!brand) & " - " & IsValue(RsTmp!Model) & " - " & _
  124. IsValue(RsTmp!mat_desc) & " - " & IsValue(RsTmp!mat_color) & vbTab & _
  125. Format(qty, "###,###,##0.############") & vbTab & _
  126. IsValue(RsTmp!uom_usage_name) & vbTab & _
  127. Format(IsValue(RsTmp!qty_conv), "###,###,##0.############") & vbTab & _
  128. IsValue(RsTmp!uom_conv_name) & vbTab & _
  129. Format(IsValue(RsTmp!define_date), "dd-mmm-yyyy") & vbTab & _
  130. IsValue(RsTmp!Revision_no) & vbTab
  131. str = str & _
  132. IsValue(RsTmp!ref_no) & vbTab & _
  133. IsValue(RsTmp!draw_no) & vbTab & _
  134. IsValue(RsTmp!mat_main_code) & vbTab & _
  135. IsValue(RsTmp!parent_code) & vbTab & _
  136. IsValue(RsTmp!parent_flag) & vbTab & _
  137. IsValue(RsTmp!bom_level) & vbTab & _
  138. IsValue(RsTmp!ID) & vbTab & _
  139. IsValue(RsTmp!p_code) & vbTab & _
  140. IsValue(RsTmp!MatType) & vbTab & _
  141. IsValue(RsTmp!MatGroup) & vbTab & _
  142. IsValue(RsTmp!Type_Code) & vbTab & _
  143. IsValue(RsTmp!Group_Code) & vbTab & _
  144. IsValue(RsTmp!p_code)
  145. .AddItem str, iPos
  146. .IsSubtotal(iPos) = True
  147. .RowOutlineLevel(iPos) = iLvl
  148. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  149. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  150. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblParentColor.BackColor
  151. .GetNode(iPos).Key = "P" & RsTmp!ID
  152. ' add hidden node (we'll handle this when the user expands it)
  153. iPos = iPos + 1
  154. .AddItem "", iPos
  155. .IsSubtotal(iPos) = True
  156. .RowOutlineLevel(iPos) = iLvl + 1
  157. RsTmp.MoveNext
  158. iPos = iPos + 1
  159. Else
  160. str = RsTmp!code & vbTab & IsValue(RsTmp!mat_code) & vbTab & _
  161. IsValue(RsTmp!mat_name) & vbTab & _
  162. IsValue(RsTmp!mat_desc) & vbTab & _
  163. IsValue(RsTmp!mat_code) & " - " & IsValue(RsTmp!mat_name) & " - " & _
  164. IsValue(RsTmp!brand) & " - " & IsValue(RsTmp!Model) & " - " & _
  165. IsValue(RsTmp!mat_desc) & " - " & IsValue(RsTmp!mat_color) & vbTab & _
  166. Format(IsValue(RsTmp!qty_usage), "###,###,##0.############") & vbTab & _
  167. IsValue(RsTmp!uom_usage_name) & vbTab & _
  168. Format(IsValue(RsTmp!qty_conv), "###,###,##0.############") & vbTab & _
  169. IsValue(RsTmp!uom_conv_name) & vbTab & _
  170. Format(IsValue(RsTmp!define_date), "dd-mmm-yyyy") & vbTab & _
  171. IsValue(RsTmp!Revision_no) & vbTab
  172. str = str & _
  173. IsValue(RsTmp!ref_no) & vbTab & _
  174. IsValue(RsTmp!draw_no) & vbTab & _
  175. IsValue(RsTmp!mat_main_code) & vbTab & _
  176. IsValue(RsTmp!parent_code) & vbTab & _
  177. IsValue(RsTmp!parent_flag) & vbTab & _
  178. IsValue(RsTmp!bom_level) & vbTab & _
  179. IsValue(RsTmp!ID) & vbTab & _
  180. IsValue(RsTmp!p_code) & vbTab & _
  181. IsValue(RsTmp!MatType) & vbTab & _
  182. IsValue(RsTmp!MatGroup) & vbTab & _
  183. IsValue(RsTmp!Type_Code) & vbTab & _
  184. IsValue(RsTmp!Group_Code) & vbTab & _
  185. IsValue(RsTmp!p_code)
  186. .AddItem str, iPos
  187. .IsSubtotal(iPos) = True
  188. .RowOutlineLevel(iPos) = iLvl
  189. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  190. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  191. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblParentColor.BackColor
  192. .GetNode(iPos).Key = "P" & RsTmp!ID
  193. ' add hidden node (we'll handle this when the user expands it)
  194. iPos = iPos + 1
  195. .AddItem "", iPos
  196. .IsSubtotal(iPos) = True
  197. .RowOutlineLevel(iPos) = iLvl + 1
  198. RsTmp.MoveNext
  199. iPos = iPos + 1
  200. End If
  201.  
  202. '--- decript
  203. Else
  204. str = RsTmp!code & vbTab & IsValue(RsTmp!mat_code) & vbTab & _
  205. IsValue(RsTmp!mat_name) & vbTab & _
  206. IsValue(RsTmp!mat_desc) & vbTab & _
  207. IsValue(RsTmp!mat_code) & " - " & IsValue(RsTmp!mat_name) & " - " & _
  208. IsValue(RsTmp!brand) & " - " & IsValue(RsTmp!Model) & " - " & _
  209. IsValue(RsTmp!mat_desc) & " - " & IsValue(RsTmp!mat_color) & vbTab & _
  210. Format(IsValue(RsTmp!qty_usage), "###,###,##0.############") & vbTab & _
  211. IsValue(RsTmp!uom_usage_name) & vbTab & _
  212. Format(IsValue(RsTmp!qty_conv), "###,###,##0.############") & vbTab & _
  213. IsValue(RsTmp!uom_conv_name) & vbTab & _
  214. Format(IsValue(RsTmp!define_date), "dd-mmm-yyyy") & vbTab & _
  215. IsValue(RsTmp!Revision_no) & vbTab
  216. str = str & _
  217. IsValue(RsTmp!ref_no) & vbTab & _
  218. IsValue(RsTmp!draw_no) & vbTab & _
  219. IsValue(RsTmp!mat_main_code) & vbTab & _
  220. IsValue(RsTmp!parent_code) & vbTab & _
  221. IsValue(RsTmp!parent_flag) & vbTab & _
  222. IsValue(RsTmp!bom_level) & vbTab & _
  223. IsValue(RsTmp!ID) & vbTab & _
  224. IsValue(RsTmp!p_code) & vbTab & _
  225. IsValue(RsTmp!MatType) & vbTab & _
  226. IsValue(RsTmp!MatGroup) & vbTab & _
  227. IsValue(RsTmp!Type_Code) & vbTab & _
  228. IsValue(RsTmp!Group_Code) & vbTab & _
  229. IsValue(RsTmp!p_code)
  230. .AddItem str, iPos
  231. .IsSubtotal(iPos) = True
  232. .RowOutlineLevel(iPos) = iLvl
  233. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  234. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  235. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblParentColor.BackColor
  236. .GetNode(iPos).Key = "P" & RsTmp!ID
  237. ' add hidden node (we'll handle this when the user expands it)
  238. iPos = iPos + 1
  239. .AddItem "", iPos
  240. .IsSubtotal(iPos) = True
  241. .RowOutlineLevel(iPos) = iLvl + 1
  242. RsTmp.MoveNext
  243. iPos = iPos + 1
  244.  
  245. End If
  246. Wend
  247. Else
  248.  
  249. StrNodeCode = oConn.LookUpTable("v_bill_of_materials", "code", _
  250. "mat_code='" & fgStructures.TextMatrix(R, 1) & "' " & _
  251. " and parent_code = '0' and priority = 0 ")
  252. End If
  253. str = "select * from v_bill_of_materials " & _
  254. "WHERE parent_Code = '" & StrNodeCode & "' and priority = 0 " & _
  255. "ORDER BY Parent_Code, mat_code"
  256. Set RsTmp = oConn.ExecuteSQL(str, True)
  257. While Not RsTmp.EOF
  258. encrypt = IsValue(RsTmp!encript)
  259. If encrypt = "" Then encrypt = False
  260. If encrypt = True Then
  261. GroupName = oConn.LookUpTable("t_usermenu", "group_name", "user_name = '" & pubVar_UserName & "'")
  262. If oConn.LookUpTable("t_param", "ID", "param_name = 'decript' and param_value = '" & GroupName & "'") <> "" Then
  263. sql = "select dbo.Fn_LoadCript('" & IsValue(RsTmp!qty_usage) & "') as val"
  264. Set Rs = oConn.ExecuteSQL(sql, True)
  265. qty = IsValue(Rs("Val"))
  266. str = RsTmp!code & vbTab & IsValue(RsTmp!mat_code) & vbTab & _
  267. IsValue(RsTmp!mat_name) & vbTab & _
  268. IsValue(RsTmp!mat_desc) & vbTab & _
  269. IsValue(RsTmp!mat_code) & " - " & IsValue(RsTmp!mat_name) & " - " & _
  270. IsValue(RsTmp!brand) & " - " & IsValue(RsTmp!Model) & " - " & _
  271. IsValue(RsTmp!mat_desc) & " - " & IsValue(RsTmp!mat_color) & vbTab & _
  272. Format(qty, "###,###,##0.############") & vbTab & _
  273. IsValue(RsTmp!uom_usage_name) & vbTab & _
  274. Format(IsValue(RsTmp!qty_conv), "###,###,##0.############") & vbTab & _
  275. IsValue(RsTmp!uom_conv_name) & vbTab & _
  276. Format(IsValue(RsTmp!define_date), "dd-mmm-yyyy") & vbTab & _
  277. IsValue(RsTmp!Revision_no) & vbTab
  278. str = str & _
  279. IsValue(RsTmp!ref_no) & vbTab & _
  280. IsValue(RsTmp!draw_no) & vbTab & _
  281. IsValue(RsTmp!mat_main_code) & vbTab & _
  282. IsValue(RsTmp!parent_code) & vbTab & _
  283. IsValue(RsTmp!parent_flag) & vbTab & _
  284. IsValue(RsTmp!bom_level) & vbTab & _
  285. IsValue(RsTmp!ID) & vbTab & _
  286. IsValue(RsTmp!p_code) & vbTab & _
  287. IsValue(RsTmp!MatType) & vbTab & _
  288. IsValue(RsTmp!MatGroup) & vbTab & _
  289. IsValue(RsTmp!Type_Code) & vbTab & _
  290. IsValue(RsTmp!Group_Code) & vbTab & _
  291. IsValue(RsTmp!p_code)
  292.  
  293. .AddItem str, iPos
  294. .IsSubtotal(iPos) = True
  295. .RowOutlineLevel(iPos) = iLvl
  296. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblChildColor.BackColor
  297. If RsTmp.Fields("Parent_flag") Then
  298. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  299. If RsTmp!parent_code = "0" Then
  300. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  301. Else
  302. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(2).ExtractIcon
  303. End If
  304. .GetNode(iPos).Key = "P" & RsTmp!ID
  305. ' add hidden node (we'll handle this when the user expands it)
  306. iPos = iPos + 1
  307. .AddItem "", iPos
  308. .IsSubtotal(iPos) = True
  309. .RowOutlineLevel(iPos) = iLvl + 1
  310. Else
  311. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = False
  312. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(4).ExtractIcon
  313. .GetNode(iPos).Key = "C" & RsTmp!ID
  314. End If
  315. iPos = iPos + 1
  316. RsTmp.MoveNext
  317. Else
  318. str = RsTmp!code & vbTab & IsValue(RsTmp!mat_code) & vbTab & _
  319. IsValue(RsTmp!mat_name) & vbTab & _
  320. IsValue(RsTmp!mat_desc) & vbTab & _
  321. IsValue(RsTmp!mat_code) & " - " & IsValue(RsTmp!mat_name) & " - " & _
  322. IsValue(RsTmp!brand) & " - " & IsValue(RsTmp!Model) & " - " & _
  323. IsValue(RsTmp!mat_desc) & " - " & IsValue(RsTmp!mat_color) & vbTab & _
  324. Format(IsValue(RsTmp!qty_usage), "###,###,##0.############") & vbTab & _
  325. IsValue(RsTmp!uom_usage_name) & vbTab & _
  326. Format(IsValue(RsTmp!qty_conv), "###,###,##0.############") & vbTab & _
  327. IsValue(RsTmp!uom_conv_name) & vbTab & _
  328. Format(IsValue(RsTmp!define_date), "dd-mmm-yyyy") & vbTab & _
  329. IsValue(RsTmp!Revision_no) & vbTab
  330. str = str & _
  331. IsValue(RsTmp!ref_no) & vbTab & _
  332. IsValue(RsTmp!draw_no) & vbTab & _
  333. IsValue(RsTmp!mat_main_code) & vbTab & _
  334. IsValue(RsTmp!parent_code) & vbTab & _
  335. IsValue(RsTmp!parent_flag) & vbTab & _
  336. IsValue(RsTmp!bom_level) & vbTab & _
  337. IsValue(RsTmp!ID) & vbTab & _
  338. IsValue(RsTmp!p_code) & vbTab & _
  339. IsValue(RsTmp!MatType) & vbTab & _
  340. IsValue(RsTmp!MatGroup) & vbTab & _
  341. IsValue(RsTmp!Type_Code) & vbTab & _
  342. IsValue(RsTmp!Group_Code) & vbTab & _
  343. IsValue(RsTmp!p_code)
  344.  
  345. .AddItem str, iPos
  346. .IsSubtotal(iPos) = True
  347. .RowOutlineLevel(iPos) = iLvl
  348. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblChildColor.BackColor
  349. If RsTmp.Fields("Parent_flag") Then
  350. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  351. If RsTmp!parent_code = "0" Then
  352. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  353. Else
  354. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(2).ExtractIcon
  355. End If
  356. .GetNode(iPos).Key = "P" & RsTmp!ID
  357. ' add hidden node (we'll handle this when the user expands it)
  358. iPos = iPos + 1
  359. .AddItem "", iPos
  360. .IsSubtotal(iPos) = True
  361. .RowOutlineLevel(iPos) = iLvl + 1
  362. Else
  363. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = False
  364. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(4).ExtractIcon
  365. .GetNode(iPos).Key = "C" & RsTmp!ID
  366. End If
  367. iPos = iPos + 1
  368. RsTmp.MoveNext
  369. End If
  370. Else
  371. str = RsTmp!code & vbTab & IsValue(RsTmp!mat_code) & vbTab & _
  372. IsValue(RsTmp!mat_name) & vbTab & _
  373. IsValue(RsTmp!mat_desc) & vbTab & _
  374. IsValue(RsTmp!mat_code) & " - " & IsValue(RsTmp!mat_name) & " - " & _
  375. IsValue(RsTmp!brand) & " - " & IsValue(RsTmp!Model) & " - " & _
  376. IsValue(RsTmp!mat_desc) & " - " & IsValue(RsTmp!mat_color) & vbTab & _
  377. Format(IsValue(RsTmp!qty_usage), "###,###,##0.############") & vbTab & _
  378. IsValue(RsTmp!uom_usage_name) & vbTab & _
  379. Format(IsValue(RsTmp!qty_conv), "###,###,##0.############") & vbTab & _
  380. IsValue(RsTmp!uom_conv_name) & vbTab & _
  381. Format(IsValue(RsTmp!define_date), "dd-mmm-yyyy") & vbTab & _
  382. IsValue(RsTmp!Revision_no) & vbTab
  383. str = str & _
  384. IsValue(RsTmp!ref_no) & vbTab & _
  385. IsValue(RsTmp!draw_no) & vbTab & _
  386. IsValue(RsTmp!mat_main_code) & vbTab & _
  387. IsValue(RsTmp!parent_code) & vbTab & _
  388. IsValue(RsTmp!parent_flag) & vbTab & _
  389. IsValue(RsTmp!bom_level) & vbTab & _
  390. IsValue(RsTmp!ID) & vbTab & _
  391. IsValue(RsTmp!p_code) & vbTab & _
  392. IsValue(RsTmp!MatType) & vbTab & _
  393. IsValue(RsTmp!MatGroup) & vbTab & _
  394. IsValue(RsTmp!Type_Code) & vbTab & _
  395. IsValue(RsTmp!Group_Code) & vbTab & _
  396. IsValue(RsTmp!p_code)
  397.  
  398. .AddItem str, iPos
  399. .IsSubtotal(iPos) = True
  400. .RowOutlineLevel(iPos) = iLvl
  401. .Cell(flexcpBackColor, iPos, 0, iPos, .Cols - 1) = LblChildColor.BackColor
  402. If RsTmp.Fields("Parent_flag") Then
  403. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = True
  404. If RsTmp!parent_code = "0" Then
  405. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(1).ExtractIcon
  406. Else
  407. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(2).ExtractIcon
  408. End If
  409. .GetNode(iPos).Key = "P" & RsTmp!ID
  410. ' add hidden node (we'll handle this when the user expands it)
  411. iPos = iPos + 1
  412. .AddItem "", iPos
  413. .IsSubtotal(iPos) = True
  414. .RowOutlineLevel(iPos) = iLvl + 1
  415. Else
  416. .Cell(flexcpFontBold, iPos, 0, , .Cols - 1) = False
  417. .Cell(flexcpPicture, iPos, .OutlineCol) = imgListTree.ListImages.Item(4).ExtractIcon
  418. .GetNode(iPos).Key = "C" & RsTmp!ID
  419. End If
  420. iPos = iPos + 1
  421. RsTmp.MoveNext
  422. End If
  423. Wend
  424.  
  425. End If
  426. 'fgStructures.Tag = str
  427. RsTmp.Close
  428. Set RsTmp = Nothing
  429. ' collapse the items we just added
  430. For i = R + 1 To iPos - 1
  431. If .IsSubtotal(i) Then .IsCollapsed(i) = flexOutlineCollapsed
  432. Next
  433.  
  434. For i = 4 To 12
  435. .AutoSize i
  436. Next
  437. If .ColWidth(4) < LblTypeColor.Width Then .ColWidth(4) = LblTypeColor.Width
  438. ' ready to redraw
  439. MousePointer = 0
  440. .Redraw = flexRDBuffered
  441. .Row = R
  442.  
  443. End With
  444. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!