• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Thêm background của TreeView là màu hay hình

Các thủ thuật về âm thanh, đồ họa, truyền thông đa phương tiện...
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Thêm background của TreeView là màu hay hình

Gửi bàigửi bởi truongphu » T.Năm 24/12/2009 4:03 pm

Thủ thuật: Thêm background của TreeView là màu hay hình
Tác giả: Sưu tầm
Mô tả: Thêm background của TreeView là màu hay hình



http://www.bigresource.com/Tracker/Track-vb-YwdKyI8vpV/

Module:
  1. '---Bas module code---
  2. Private Type RECT
  3.     Left As Long
  4.     Top As Long
  5.     Right As Long
  6.     Bottom As Long
  7. End Type
  8.  
  9. Private Type PAINTSTRUCT
  10.     hDC As Long
  11.     fErase As Long
  12.     rcPaint As RECT
  13.     fRestore As Long
  14.     fIncUpdate As Long
  15.     rgbReserved As Byte
  16. End Type
  17. Private Declare Function BeginPaint Lib "user32" _
  18.     (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
  19. Private Declare Function EndPaint Lib "user32" _
  20.     (ByVal hWnd As Long, lpPaint As PAINTSTRUCT) As Long
  21.  
  22. Private Type TRIVERTEX
  23.     x As Long
  24.     y As Long
  25.     Red As Integer
  26.     Green As Integer
  27.     Blue As Integer
  28.     Alpha As Integer
  29. End Type
  30.    
  31. Private Type GRADIENT_TRIANGLE
  32.     Vertex1 As Long
  33.     Vertex2 As Long
  34.     Vertex3 As Long
  35. End Type
  36.  
  37. Const GRADIENT_FILL_TRIANGLE As Long = &H2
  38.  
  39. Private Declare Function GradientFillTri Lib "msimg32" Alias "GradientFill" (ByVal hDC As Long, pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As GRADIENT_TRIANGLE, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Long
  40. Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTransparent As Long) As Long
  41.  
  42. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  43. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  44. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  45. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  46. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  47. Private Declare Function GetDC& Lib "user32" (ByVal hWnd As Long)
  48. Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
  49. Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
  50. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  51. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  52. Declare Function ValidateRectBynum& Lib "user32" Alias "ValidateRect" (ByVal hWnd As Long, ByVal lpRect As Long)
  53. Declare Function ReleaseDC& Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long)
  54.  
  55. Private Const GWL_WNDPROC = (-4)
  56. Private Const WM_PAINT = &HF
  57. Private Const WM_ERASEBKGND = &H14
  58. Private Const WM_HSCROLL = &H114
  59. Private Const WM_VSCROLL = &H115
  60. Private Const WM_MOUSEWHEEL = &H20A
  61. Private Const WM_SETREDRAW = &HB
  62. Dim vert(3) As TRIVERTEX
  63. Dim gTri(1) As GRADIENT_TRIANGLE
  64. Dim OldProc As Long, bPainting As Boolean
  65. Dim TVWidth As Long, TVHeight As Long
  66.  
  67. Public Sub SubClass(obj As Object)
  68.    Dim h As Long
  69.    On Error Resume Next
  70.    h = obj.hWnd
  71.    If Err Or (OldProc <> 0) Then Exit Sub
  72.    PrepareVertex obj
  73.    OldProc = SetWindowLong(h, GWL_WNDPROC, AddressOf WndProc)
  74. End Sub
  75.  
  76. Public Sub UnSubClass(obj As Object)
  77.    Dim h As Long
  78.    On Error Resume Next
  79.    h = obj.hWnd
  80.    If Err Or (OldProc = 0) Then Exit Sub
  81.    SetWindowLong h, GWL_WNDPROC, OldProc
  82.    OldProc = 0
  83. End Sub
  84.  
  85. Public Function WndProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  86.    Dim TVDC As Long, TempDC As Long
  87.    Dim oldBMP As Long, TempBMP As Long
  88.    Dim ps As PAINTSTRUCT
  89.    Select Case wMsg
  90.           Case WM_PAINT
  91.                If bPainting = False Then
  92.                      BeginPaint hWnd, ps
  93.                      bPainting = True
  94.                      TVDC = GetDC(hWnd)
  95.                      TempDC = CreateCompatibleDC(TVDC)
  96.                      TempBMP = CreateCompatibleBitmap(TVDC, TVWidth, TVHeight)
  97.                      oldBMP = SelectObject(TempDC, TempBMP)
  98.                      SendMessage hWnd, WM_PAINT, TempDC, ByVal 0&
  99.                      GradientFillTri TVDC, vert(0), 4, gTri(0), 2, GRADIENT_FILL_TRIANGLE
  100.                      TransparentBlt TVDC, 0, 0, TVWidth, TVHeight, TempDC, 0, 0, TVWidth, TVHeight, TranslateColor(vbWindowBackground)
  101.                      SelectObject TempDC, oldBMP
  102.                      DeleteObject TempBMP
  103.                      ReleaseDC hWnd, TempDC
  104.                      ReleaseDC hWnd, TVDC
  105.                      WndProc = 0
  106.                      bPainting = False
  107.                      EndPaint hWnd, ps
  108.                      Exit Function
  109.                End If
  110.            Case WM_ERASEBKGND
  111.                 WndProc = 1
  112.                 Exit Function
  113.            Case WM_HSCROLL, WM_VSCROLL, WM_MOUSEWHEEL
  114.                 InvalidateRect hWnd, 0, False
  115.            Case Else
  116.    End Select
  117.    WndProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)
  118. End Function
  119.  
  120. Private Sub PrepareVertex(tv As Object)
  121. '!!!Play with colors!!!
  122. TVWidth = tv.Width \ Screen.TwipsPerPixelX
  123. TVHeight = tv.Height \ Screen.TwipsPerPixelY
  124.  
  125. With vert(0)
  126.     .x = 0
  127.     .y = 0
  128.     .Red = 0&
  129.     .Green = LongToUShort(&HFF00&) '0
  130.    .Blue = LongToUShort(&HFF00&)
  131.     .Alpha = 0&
  132. End With
  133. With vert(1)
  134.     .x = TVWidth
  135.     .y = 0
  136.     .Red = 0 'LongToUShort(&HFF00&)
  137.    .Green = 0&
  138.     .Blue = LongToUShort(&HFF00&)
  139.     .Alpha = 0&
  140. End With
  141. With vert(2)
  142.     .x = TVWidth
  143. '    .x = Me.ScaleWidth
  144.    .y = TVHeight
  145.     .Red = 0
  146.     .Green = 0&
  147.     .Blue = 0 'LongToUShort(&HFF00&)
  148.    .Alpha = 0&
  149. End With
  150. With vert(3)
  151.     .x = 0
  152.     .y = TVHeight
  153.     .Red = 0 'LongToUShort(&HFF00&)
  154.    .Green = LongToUShort(&HFF00&)
  155.     .Blue = LongToUShort(&HFF00&)
  156.     .Alpha = 0&
  157. End With
  158. gTri(0).Vertex1 = 0
  159. gTri(0).Vertex2 = 1
  160. gTri(0).Vertex3 = 2
  161.  
  162. gTri(1).Vertex1 = 0
  163. gTri(1).Vertex2 = 2
  164. gTri(1).Vertex3 = 3
  165. End Sub
  166.  
  167. Private Function LongToUShort(ULong As Long) As Integer
  168.    LongToUShort = CInt(ULong - &H10000)
  169. End Function
  170.  
  171. Private Function TranslateColor(inCol As Long) As Long
  172.    Dim retCol As Long
  173.    OleTranslateColor inCol, 0&, retCol
  174.    TranslateColor = retCol
  175. End Function


Form có TreeView:

  1. Private Sub Form_Load()
  2. Dim Root As Node
  3.  
  4. With TreeView1.Nodes
  5. Set Root = .Add(, , , "Top-level Node #1")
  6. .Add Root.Index, tvwChild, , "Child Node #1"
  7. .Add Root.Index, tvwChild, , "Child Node #2"
  8. .Add Root.Index, tvwChild, , "Child Node #3"
  9. Root.Expanded = True
  10. Set Root = .Add(, , , "Top-level Node #2")
  11. .Add Root.Index, tvwChild, , "Child Node #1"
  12. .Add Root.Index, tvwChild, , "Child Node #2"
  13. .Add Root.Index, tvwChild, , "Child Node #3"
  14. Set Root = .Add(, , , "Top-level Node #3")
  15. .Add Root.Index, tvwChild, , "Child Node #1"
  16. .Add Root.Index, tvwChild, , "Child Node #2"
  17. .Add Root.Index, tvwChild, , "Child Node #3"
  18. Root.Expanded = True
  19. Set Root = .Add(, , , "Top-level Node #4")
  20. .Add Root.Index, tvwChild, , "Child Node #1"
  21. .Add Root.Index, tvwChild, , "Child Node #2"
  22. .Add Root.Index, tvwChild, , "Child Node #3"
  23. Root.Expanded = True
  24. End With
  25.  
  26. SubClass TreeView1
  27.  
  28. End Sub
  29.  
  30. Private Sub Form_Unload(Cancel As Integer)
  31.   UnSubClass TreeView1
  32. End Sub
Tập tin đính kèm
treeview background color or image.rar
(3.2 KiB) Đã tải 600 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Koha JeseMen
Thành viên chính thức
Thành viên chính thức
Bài viết: 24
Ngày tham gia: T.Ba 27/07/2010 9:00 pm
Has thanked: 5 time

Re: Thêm background của TreeView là màu hay hình

Gửi bàigửi bởi Koha JeseMen » T.Tư 27/04/2011 4:35 pm

:( Không có Licence TreeView !
Giúp với :D

Hình đại diện của người dùng
vietteiv
Quản trị
Quản trị
Bài viết: 1318
Ngày tham gia: T.Bảy 10/02/2007 12:17 am
Đến từ: Cung cấp giải pháp quản lý doanh nghiệp, dự án, tư vấn xây dựng
Has thanked: 6 time
Been thanked: 69 time
Liên hệ:

Re: Thêm background của TreeView là màu hay hình

Gửi bàigửi bởi vietteiv » T.Tư 27/04/2011 9:15 pm

treeview nào cần licence vậy bạn?


Quay về “[VB] Âm thanh và Đồ họa”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách