• 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

Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Các bài viết hướng dẫn, giúp các bạn hiểu và tiếp cận với Visual Basic nhanh hơn
Hình đại diện của người dùng
DQHung
Guru
Guru
Bài viết: 576
Ngày tham gia: T.Hai 12/02/2007 3:24 pm
Đến từ: Rach Gia - Kien Giang
Been thanked: 40 time
Liên hệ:

Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Gửi bàigửi bởi DQHung » CN 30/03/2008 8:20 am

Tên bài viết: Hướng dẩn cách tạo(viết) ActiveX control (ocx)
Tác giả: DQHung
Cấp độ bài viết: Cơ bản & Nâng cao
Tóm tắt: Giúp cho các bạn làm quen dần với việc tạo ra một usercontrol để tạo ocx hay để add vào dự án của bạn


Dành Cho VB6
-----------------------------------------------
Đây là hướng dẩn “đủ” để các bạn tạo 1 ActiveX Control (usercontrol or ocx) :

Cách 1 : Tạo 1 usercontrol dựa vào 1 control có sẳn
- Ví dụ thiết kế một Label mới dựa vào label chuẩn của VB6
+ Tạo một dự án mới, sau đó add vào một usercontrol (h1)
h1.JPG
h1.JPG (10.52 KiB) Đã xem 13814 lần

+ Và mở usercontrol đó lên.Add vào đó 1 label tên là label1
+Cách để bạn tạo các property nhanh nhất và gọn nhất là dùng “ActiveX Controls Interface Wizard …” (để mở nó bạn chọn Menu “Add-In” > “Add-In Manager” , hiện hộp thoại lên bấm vào “VB ActiveX Control Interface Wizard” check cả 2 “Loaded/Unloaded” và “Load on startup” và bấm OK)
,sau đó muốn sử dụng nó bạn chỉ việc vào menu “Add-in” sẻ thấy nó ngay.
+ Bấm vào “ActiveX Controls Interface Wizard …” và hiện ra hộp thoại
h2.JPG

bạn có thể check “Skip this screen in the future.” để mai mốt nó khỏi “làm phiền”
bấm next (Nếu trong project của bạn chỉ có 1 control thì nó sẽ qua hộp thoại này,nếu có nhiều control thì nó sẽ hiện hộp thoại khác để bạn chọn control)
h3.JPG

Đây là bước quan trọng, bạn phải dò tìm những property , method, event của label và chuyễn qua hết vào bên phải (có thể chọn những thứ khác không phải của label), xong bấm next
h4.JPG

Sau đó bấm vào những property,method.event của label và bên phải bấm vào combo và chọn label1 tương ứng (vì ta dùng lại những cái củ của label)
,chọn xong hết bấm next (cái này dành cho cách 2),bấm next thêm cái nửa và bấm finnish là xong, cuối cùng chỉ việc thêm vào vài dòng code sau để label khích với usercontrol :

Private Sub UserControl_Resize()
Label1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
--------------------------------------------------------
Kỳ sao mình sẽ hướng dẩn cách tạo usercontrol không theo control chuẩn của VB6 (Tức là tự chế :D)



Hình đại diện của người dùng
DQHung
Guru
Guru
Bài viết: 576
Ngày tham gia: T.Hai 12/02/2007 3:24 pm
Đến từ: Rach Gia - Kien Giang
Been thanked: 40 time
Liên hệ:

Re: Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Gửi bàigửi bởi DQHung » CN 30/03/2008 9:18 am

Cách 2 : Tạo usercontrol dựa vào API (không phải là Createwindow hay CreatewindowEx)
- Ví dụ này cũng vẩn tạo 1 label mới nhưng hổ trợ unicode (Không theo chuẩn của VB6)
Bạn vẩn dùng "ActiveX control Interface wizard …" để tạo các property,method,event nhưng không theo cách củ :
-Bước 1 : Không cho gì vào usercontrol mới cả,Mở "ActiveX control Interface wizard …" ta chọn các property,method,event chủ yếu cho label mới là :BackColor,BackStyle,Click,DoubleClick,Enable,Font,ForeColor,KeyDown,KeyPress,KeyUp,MouseDown,MouseUp,MoseMove,Refresh, bấm next.
h1.JPG

-Bước 2 : bấm new và hiện hôp thoại
h2.JPG
h2.JPG (10.67 KiB) Đã xem 13147 lần

Gỏ vào đó từ "Caption" (Ta tạo property mới) ,trong frame "Type" chọn Property và bấm OK,sau đó bấm next.
Bước 3 : tất cả những Property,Method,Event bên phải đều chọn là Usercontrol hết ,trừ Property "Caption" mà ta mới tạo là để trống (tức là (None))
h3.JPG

Bấm next.
h4.JPG

Trong hộp thoại này,ta chỉ có 1 public name duy nhất là property "Caption" (Vì lúc nãy ta cho nó là (none).)
-Chổ "Data Type" chọn là "String" (Vì đây là caption nên có kiểu String, nếu là một property khác thì tùy vào cấu trúc ta muốn khởi tạo mà đặt, ví dụ ta có property "Picture" thì chổ này phải chọn là "StdPicture" hay "Picture")
-Chổ Default Value (Giá trị ban đầu của caption,tức là khi add vào form nó sẽ mang giá trị này)
- Run Time và Design Time đều chọn là "Read/Write" để người dùng có thể chỉnh sửa lúc đang thiết kế hay đang chạy.
Bấm next, bấm tiếp Finish.
-Xong phần chuẩn bị,bây giờ bắt tay vào làm 1 Label mới (giả)

Chuẩn bị các hàm API sau :

Mã: Chọn hết

  1. Private Type RECT
  2.         Left As Long
  3.         Top As Long
  4.         Right As Long
  5.         Bottom As Long
  6. End Type
  7.  
  8. Const DT_EDITCONTROL = &H2000
  9. Const DT_LEFT = &H0
  10. Const DT_WORDBREAK = &H10
  11.  
  12. Private Declare Function DrawTextW Lib "user32" (ByVal hdc As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  13. 'Hàm này dùng để vẽ chuỗi Unicode lên usercontrol
  14.  
  15. 'Tạo 1 hàm mới có tên là "DrawLabel" như sau (Hàm này dùng để vẽ toàn bộ UniLabel) :
  16.  
  17. Private Sub DrawLabel()
  18.      Dim wRC as RECT , FL as Long
  19.      Usercontrol.Cls 'Làm sạch sẽ Usercontrol trước khi vẽ lên
  20.      With wRC 'Đặt vị trí để vẽ
  21.          .Left = 0
  22.          .Top = 0
  23.          .Right = ScaleWidth
  24.          .Bottom = ScaleHeight
  25.      End With
  26.      FL = DT_LEFT or DT_WORDBREAK or DT_EDITCONTROL
  27.       'bạn có thể cho thêm các cờ vào nếu muốn
  28.      DrawTextW Usercontrol.hdc, StrPtr(m_Caption), -1, wRC, FL 'vẽ chuỗi
  29. End Sub
  30.  
  31. 'Thế là hoàn tất,bạn chỉ còn việc cuối là đưa nó vào
  32. 'Sub Resize và Show của Usercontrol là xong
  33.  
  34. Private Sub UserControl_Resize()
  35.     DrawLabel 'Vẽ lại khi control thay đỗi kích thước
  36. End Sub
  37.  
  38. Private Sub UserControl_Show()
  39.     DrawLabel 'Vẽ khi control xuất hiện
  40. End Sub
  41.  
  42. Public Sub Refresh()
  43.     DrawLabel
  44.     UserControl.Refresh
  45. End Sub
  46.  


h1.JPG
Tập tin đính kèm
excontrol.rar
Source code của ví dụ trên
(3.24 KiB) Đã tải 1204 lần

Hình đại diện của người dùng
DQHung
Guru
Guru
Bài viết: 576
Ngày tham gia: T.Hai 12/02/2007 3:24 pm
Đến từ: Rach Gia - Kien Giang
Been thanked: 40 time
Liên hệ:

Re: Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Gửi bàigửi bởi DQHung » T.Ba 01/04/2008 1:50 pm

Tên bài viết: Hướng dẩn cách tạo(viết) ActiveX control (ocx)
Tác giả: DQHung
Cấp độ bài viết: Chưa đánh giá
Tóm tắt: Cách 3



Cách 3 : Tạo control bằng hàm CreateWindowEx (tất nhiên là có unicode kể cả khi dùng file manifest XP)
Ví dụ này tạo một CommandButton bằng hàm trên
- Chuẫn bị : Bộ subclass của Steve McMahon (Để bẩy các event của control), gồm các file : subclass.bas,subclass.cls,isubclass.cls (Có gởi kèm)
Đưa dòng này vào đầu tiên (sử dụng subclass) :

Mã: Chọn hết

  1. Implements ISubclass

Chép đoạn API sau vào usercontrol mới

Mã: Chọn hết

  1. Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  2. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  3. 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
  4. Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  5. Private Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  6.  
  7. Private Const WM_SETTEXT = &HC
  8. Private Const WS_CHILD = &H40000000
  9. Private Const WS_VISIBLE = &H10000000
  10. Private Const BS_PUSHBUTTON = &H0&
  11. Private Const WM_GETFONT = &H31
  12. Private Const WM_SETFONT = &H30
  13. Private Const WM_COMMAND = &H111


Dùng "ActiveX control Interface wizard …" tạo 2 property có tên là "Caption" (để là none) và "Font" chọn usercontrol (Nếu ko rành bước này xem lại 2 bài trên)

Khởi tạo 2 biến

Mã: Chọn hết

  1. Dim hFont As Long ' Dùng để chứa handleFont của Font
  2. Dim bHwnd As Long ' Handle của Control


Viết 1 hàm để tạo control

Mã: Chọn hết

  1. Private Sub CreateButton()
  2.    bHwnd = CreateWindowExW(0, StrPtr("Button"), StrPtr(m_Caption), WS_CHILD Or WS_VISIBLE Or BS_PUSHBUTTON, 0, 0, ScaleWidth, ScaleHeight, UserControl.hwnd, 0, App.hInstance, 0)
  3.    'Tạo button
  4.    hFont = SendMessage(UserControl.hwnd, WM_GETFONT, 0&, ByVal 0&) ' Lấy hFont của Usercontrol
  5.    SendMessage bHwnd, WM_SETFONT, hFont, ByVal 1& ' set hFont vừa lấy của usercontrol qua control
  6. End Sub
  7.  


sử lý hàm winProc

Mã: Chọn hết

  1. Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
  2. '
  3. End Property
  4.  
  5. Private Property Get ISubclass_MsgResponse() As EMsgResponse
  6.    ISubclass_MsgResponse = emrPreprocess
  7. End Property
  8.  
  9. Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  10.     Select Case iMsg
  11.        Case WM_COMMAND ' Nếu control click thì chuyển ngay đến event click
  12.           RaiseEvent Click
  13.     End Select
  14. End Function
  15. 'hàm Init này để bắt đầu subclass, thường là lúc UserControl_ReadProperties
  16. Private Sub Init(hWndA As Long)
  17.    AttachMessage Me, hWndA, WM_COMMAND ' subclass thông điệp WM_COMMAND
  18. End Sub
  19. 'Hàm remove để gở bỏ subclass
  20. Private Sub Remove(hWndA As Long)
  21.    DetachMessage Me, hWndA, WM_COMMAND ' Bỏ subclass
  22.    ' Chú ý nếu ta subclass bao nhiêu thông điệp thì phải remove bấy nhiêu,nếu thiếu có thể gây lỗi
  23. End Sub


Mã: Chọn hết

  1. Private Sub UserControl_Resize()
  2.    MoveWindow bHwnd, 0, 0, ScaleWidth, ScaleHeight, 0 ' Làm cho command khít với usercontrol
  3. End Sub
  4.  
  5. Private Sub UserControl_Show()
  6.    CreateButton ' Tạo command
  7. End Sub
  8.  
  9. Private Sub UserControl_Terminate()
  10.    DestroyWindow bHwnd 'xóa control (Commandbutton)
  11.    DetachMessage Me, UserControl.hwnd, WM_COMMAND '(gở bỏ subclass)
  12. End Sub
  13.  
  14. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  15.     Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  16.     m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  17.     If Ambient.UserMode Then 'nếu control đang trong lúc chạy (Run Time) thì tiếp tục
  18.        Init UserControl.hwnd ' Bắt đầu subclass
  19.     End If
  20. End Sub
  21.  
  22. 'trong Property Let Caption và Property Set Font
  23.  
  24. Public Property Let Caption(ByVal New_Caption As String)
  25.     m_Caption = New_Caption
  26.     SendMessageW bHwnd, WM_SETTEXT, &H1, StrPtr(New_Caption) ' thay caption mới cho control
  27.     PropertyChanged "Caption"
  28. End Property
  29.  
  30. Public Property Set Font(ByVal New_Font As Font)
  31.     Set UserControl.Font = New_Font
  32.     hFont = SendMessage(UserControl.hwnd, WM_GETFONT, 0&, ByVal 0&)
  33.     SendMessage bHwnd, WM_SETFONT, hFont, ByVal 1& 'gán font mới cho control
  34.     PropertyChanged "Font"
  35. End Property
  36.  


Và kết thúc, bạn đã có một control unicode theo chuẫn của VB6.
Nếu đọc không hiểu có thể tải source về nghiên cứu thêm vì trong bài viết mình chỉ viết vắn tắc.
Khi khác nếu có thời gian mình sẽ tiếp tục.
Tập tin đính kèm
CreateWindowsEx.rar
Source có kèm bộ subclass và cả file manifest để các bạn test
(18.05 KiB) Đã tải 1192 lần

Hình đại diện của người dùng
DQHung
Guru
Guru
Bài viết: 576
Ngày tham gia: T.Hai 12/02/2007 3:24 pm
Đến từ: Rach Gia - Kien Giang
Been thanked: 40 time
Liên hệ:

Re: Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Gửi bàigửi bởi DQHung » T.Sáu 17/04/2009 8:09 pm

Tên bài viết: Hướng dẫn cách tạo một control mảng
Tác giả: Dương Quốc Hưng
Cấp độ bài viết: Nâng cao
Tóm tắt: Tạo một Unicode Toolbar bằng các hàm vẽ và không Subclass/Hook



Trong bài này các bạn sẽ được biết đến các kỹ năng :
- Sử dụng "Property Page".
- Tạo/quản lý đối tượng bằng Class.
- Tạo một control (điều khiển) có dạng mảng và thủ thuật (Điều quan trọng mà mình muốn gửi đến trong bài này).

------------------------------------------------------------------------------------------------------------
Bắt đầu vào làm việc.
- Để tạo một Toolbar (giả) bạn phải tạo một khung xương cho nó để lưu các dử liệu liên quan.Có thể đến đây bạn chưa hiểu mấy nhưng lúc viết mình sẽ nói rõ hơn.
- Mình sẽ thiết kế khung xương cho Toolbar là như sau (Các bạn nên xem kỹ vì chữ Button cũng gần giống với Buttons) :
+ Buttons [Index or Key] (Parent, quản lý các Button)
- Add (Function, dùng để thêm 1 Button vào Buttons)
- Remove (Function, dùng để xóa 1 Button ra khỏi Buttons)
- Clear (Sub, Xóa tất cả các Button trong Buttons)
- Count (Property Get, trả về số lượng Button trong Buttons)
- Item (Property Get, trả về một đối tượng là Button thứ Index)
+Button (Child, chứa các thông tin của một Button)
- Public Caption As String (chứa nhãn của Button)
- Public ToolTipText As String (chứa ToolTipText)
- Public Key As String (Chứa key)
- Public Tag As String (chứa Tag)
-
+ Có thể thêm vài Property nếu muốn, tất nhiên sau khi thêm phải sửa lại Class Buttons
- Phần trên là lý thuyết, còn đây là code :
- Tạo một dự án Standard EXE. Add một Class vào và đặt tên là Buttons, copy đoạn code sau vào :

Mã: Chọn hết

  1. Public Caption As String
  2. Public ToolTipText As String
  3. Public Key As String
  4. Public Tag As String
  5.  
  6. Private mleft As Long 'Ta đặt chúng là private vì không muốn user thấy và chỉnh/sửa các thuộc tính này.
  7. Private mright As Long
  8.  
  9. 'Các thuộc tính này để lưu lại vị trí left và right của Button, chủ yếu là dể quản lý button trong Toolbar (lúc Click và kiểm tra)
  10. 'Hides property
  11. Friend Property Let Left(m_left As Long)
  12.    mleft = m_left
  13. End Property
  14.  
  15. Friend Property Get Left() As Long
  16.    Left = mleft
  17. End Property
  18.  
  19. Friend Property Let Right(m_right As Long)
  20.    mright = m_right
  21. End Property
  22.  
  23. Friend Property Get Right() As Long
  24.    Right = mright
  25. End Property


- Bây giờ ta đã có một đối tượng là Button. Ta tạo thêm Butttons để quản lý các Button này. Add 1 Class mới và đặt tên là Buttons và ... code đây :

Mã: Chọn hết

  1. Private m_Count As Long  'biến này dùng để lưu lại số lượng button được add
  2. Private m_Button() As New Button 'Các Button
  3.  
  4. Private Function GetItemIndex(ByVal sValue As Variant) As Long  
  5. 'hàm này dùng để kiểm tra xem giá trị ta cho vào là Index hay là Key của Button.Và trả về Index của Button đó.
  6. 'Ví dụ như ta có thể dùng : Buttons(2).Caption hoặc Buttons("open").Caption (nếu Index 2 có Key = "open").
  7.     Dim i As Long
  8.     If IsNumeric(sValue) = True Then
  9.         GetItemIndex = sValue
  10.     Else
  11.         For i = 1 To m_Count
  12.             If m_Button(i).Key = sValue Then
  13.                 GetItemIndex = i
  14.                 Exit Function
  15.             End If
  16.         Next i
  17.     End If
  18. End Function
  19.  
  20.  
  21. Public Function Add(Optional ByVal Caption As String = "Button", Optional Key As String = "Key", Optional ByVal ToolTipText As String = "", Optional ByVal Tag As String = "") As Button
  22. 'Hàm này dùng để add một Button vào Buttons
  23.     On Error GoTo Loi
  24.     'ta cộng thêm 1 vào biến đếm
  25.     m_Count = m_Count + 1
  26.     'khởi tạo button thứ "m_Count"
  27.     ReDim Preserve m_Button(m_Count)
  28.    
  29.     'gán các giá trị của Button mới tạo
  30.     With m_Button(m_Count)
  31.        .Caption = Caption
  32.        .Key = Key
  33.        .Tag = Tag
  34.        If m_Count > 1 Then
  35.           .Left = m_Button(m_Count - 1).Right
  36.        Else
  37.           .Left = 1
  38.        End If
  39.     End With
  40.     'Trả về Button
  41.     Set Add = m_Button(m_Count)
  42.     Exit Function
  43. Loi:
  44.     'Nếu bị lỗi sẽ trả về nothing
  45.     Set Add = Nothing
  46. End Function
  47.  
  48. Public Sub Clear()
  49.     'gán biến đếm = 0
  50.     m_Count = 0
  51.     'Xóa hết các Button
  52.     Erase m_Button()
  53. End Sub
  54.  
  55. Public Property Get Count() As Long 'Trả về số lượng cho user
  56.     Count = m_Count
  57. End Property
  58.  
  59. Public Sub Remove(ByVal Index As Variant)
  60. 'Xóa button
  61.   Dim i As Long, idx As Long
  62.   idx = GetItemIndex(Index)
  63.   If (idx < 1) Or (idx > m_Count) Then  'Nếu index nhỏ hơn 1 và lớn hơn số lượng button thì thoát khỏi property
  64.       MsgBox "Not found Button !", vbInformation, "DQHung"
  65.       Exit Sub
  66.   Else
  67.      'ngược lại ta đè button cần xóa bởi button phía trước nó.
  68.      'Tức là nếu ta xóa button số 6 thì button 7 sẽ đè lên button 6 và button 8 sẽ đè lên button 7 ... cứ vậy cho đến hết.
  69.      For i = idx + 1 To m_Count
  70.         m_Button(i - 1).Caption = m_Button(i).Caption
  71.         m_Button(i - 1).Key = m_Button(i).Key
  72.         m_Button(i - 1).Left = m_Button(i).Left
  73.         m_Button(i - 1).Right = m_Button(i).Right
  74.         m_Button(i - 1).ToolTipText = m_Button(i).ToolTipText
  75.      Next i
  76.      m_Count = m_Count - 1
  77.      'sau khi xóa xong khởi tạo lại button,vì ta dùng mảng nên phải khởi tạo lại nếu không button xóa vẫn tồn tại.
  78.      ReDim Preserve m_Button(0 To m_Count)
  79.   End If
  80. End Sub
  81.  
  82. Public Property Get Item(ByVal Index As Variant) As Button    'Func này trả về 1 button cho user sử lý
  83.      On Error GoTo Loi
  84.      Set Item = m_Button(GetItemIndex(Index))
  85.      Exit Property
  86. Loi:
  87.      Set Item = Nothing
  88. End Property


- Để tiện việc dùng các item thì mình nên tạo cách gọi Button tắc, giống như các bộ "Common control" của VB6 vậy.
- Ví dụ như thay vì ta phải nhập : Butttons.Item(2).Caption thì ta có thể gõ tắc Buttons(2).Caption. Đó gọi là gì,và làm thế nào để được như vậy ? Đó gọi là Default (mặc định). Tạo nó rất đơn giản, bạn hãy làm theo những bước sau :
- Mở Class "Buttons". Sau đó vào Menu "Tools"->"Procedure Attributes ...", sẽ hiện lên bảng sau :
p1.JPG

- Sau đó ta bấm vào nút "Advenced >>", phần dưới của cửa sổ hiện ra.
- ở Combobox "Name" ta chọn Property cần làm mặc định. Trong trường hợp này là "item" của Buttons.
- Sau khi chọn Name = Item xong, ta chọn "(Default)" ở mục "Procedure ID". Bấm OK. Bây giờ Property Item đã thành mặc định.

- Vậy là xong phần xương cho UniToolbar rồi đấy.
- Việc tiếp theo là tạo UniToolbar hoàn chỉnh.
- Add một Usercontrol mới và đặt tên là UniToolbar (UT).
- Đầu tiên ta đặt Alignable của UT = True, AutoRedraw = True, ScaleMode = Pixel. Đặt như vậy mới Draw được :) .

- Copy vài hàm API và các hàm tự tạo này vào (dùng để vẽ Toolbar) :

Mã: Chọn hết

  1. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  2. Private Declare Function ApiFrameRect Lib "user32" Alias "FrameRect" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  3. Private Declare Function ApiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
  4. Private Declare Function ApiFillRect Lib "user32" Alias "FillRect" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  5. Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
  6. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  7. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  8. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  9. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  10. Private Declare Function DrawTextW Lib "user32" (ByVal hdc As Long, ByVal lpStr As Long, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  11. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  12. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  13.  
  14. Private Type RECT
  15.     X1 As Long
  16.     Y1 As Long
  17.     x2 As Long
  18.     y2 As Long
  19. End Type
  20.  
  21. Private Type POINTAPI
  22.     X                   As Long
  23.     Y                   As Long
  24. End Type


Mã: Chọn hết

  1. Private Function MDMouseOver(ByVal HandleWindow As Long) As Boolean
  2. 'Hàm này dùng để kiểm tra xem mouse có nằm trong control không.
  3. 'Hàm trả về True nếu co và ngược lại.
  4. Dim PT As POINTAPI
  5.  
  6.     GetCursorPos PT
  7.     MDMouseOver = (WindowFromPoint(PT.X, PT.Y) = HandleWindow)
  8.  
  9. End Function
  10.  
  11. Private Sub DrawText(ByVal text As String, ByVal LeftX As Long, _
  12.             ByVal TopY As Long, _
  13.             ByVal RightX As Long, _
  14.             ByVal BottomY As Long)
  15.     'Hàm này để vẽ chữ lên Toolbar (có thể vẽ chữ Unicode)
  16.     Dim rc As RECT
  17.     With rc
  18.         .X1 = LeftX
  19.         .Y1 = TopY
  20.         .x2 = RightX
  21.         .y2 = BottomY
  22.     End With
  23.     DrawTextW hdc, StrPtr(text), -1, rc, &H4 & &H15
  24. End Sub
  25. 'Chuyen doi mau sang dang Long
  26. Private Function TranslateColor(ByVal clr As OLE_COLOR, _
  27.                                Optional hPal As Long = 0) As Long
  28.     If OleTranslateColor(clr, hPal, TranslateColor) Then
  29.         TranslateColor = -1
  30.     End If
  31. End Function
  32. 'Dùng để vẽ viền (borther)
  33. Private Sub DrawFrameRect(ByVal LeftX As Long, _
  34.             ByVal TopY As Long, _
  35.             ByVal RightX As Long, _
  36.             ByVal BottomY As Long, _
  37.             Optional ByVal clrFill As Long = -1)
  38.     Dim rc          As RECT
  39.     Dim hbrFill As Long
  40.     On Error Resume Next
  41.  
  42.     '--- create brush if neccessary
  43.     If clrFill <> -1 Then
  44.         hbrFill = CreateSolidBrush(TranslateColor(clrFill))
  45.     End If
  46.     With rc
  47.         .X1 = LeftX
  48.         .Y1 = TopY
  49.         .x2 = RightX
  50.         .y2 = BottomY
  51.     End With
  52.     Call ApiFrameRect(hdc, rc, hbrFill)
  53.     '--- cleanup the brush (if neccessary)
  54.     If clrFill <> -1 Then
  55.         Call ApiDeleteObject(hbrFill)
  56.     End If
  57. End Sub
  58. 'dùng để tô nền cho một vùng.
  59. Private Function DrawFillRECT(fColor As OLE_COLOR, cLeft As Long, cTop As Long, cRight As Long, cBottom As Long)
  60.    Dim NewBrt As Long, mRECT As RECT
  61.    With mRECT
  62.       .X1 = cLeft
  63.       .Y1 = cTop
  64.       .y2 = cBottom
  65.       .x2 = cRight
  66.    End With
  67.    NewBrt = CreateSolidBrush(TranslateColor(fColor))
  68.    ApiFillRect hdc, mRECT, NewBrt
  69.    ApiDeleteObject NewBrt
  70. End Function
  71. 'Dùng để vẽ đường thẳng
  72. Private Sub DrawALine(X As Long, Y As Long, X1 As Long, Y1 As Long, oColor As OLE_COLOR, Optional iWidth As Long = 1)
  73. Dim PT As POINTAPI
  74. Dim iPen As Long
  75. Dim iPen1 As Long
  76.     iPen = CreatePen(PS_SOLID, iWidth, oColor)
  77.     iPen1 = SelectObject(hdc, iPen)
  78.    
  79.     MoveToEx hdc, X, Y, PT
  80.     LineTo hdc, X1, Y1
  81.  
  82.     SelectObject hdc, iPen1
  83.     ApiDeleteObject iPen
  84. End Sub


Xong phần API và các hàm vẽ. Bây giờ khởi tạo biến cho UT.

Mã: Chọn hết

  1. Dim cx As Long, cy As Long, cW As Long, ch As Long   'các biến này dùng để lưu lại vị trí của Button, lác sau khi dùng sẽ nói rõ.
  2. Private m_Buttons As New Buttons    'Tạo mới một Buttons (Chỉ 1 là đủ)
  3. Private m_OldCount As Long             'Biến này dùng để lưu lại số lượng Button
  4.  
  5. Event ButtonClick(Index As Long)'Bẩy CLick


Cần phải có một số hàm sau, copy vào :

Mã: Chọn hết

  1. Public Sub Refresh()   'Cái này khỏi nói cũng phải biết  ;))
  2.     CalculateItem
  3.     DrawUniToolbar
  4. End Sub
  5.  
  6. Private Sub CalculateItem()         'Ta tự tính toán vị trí, chiều dài của Button
  7.     Dim i As Long, stxt As String
  8.     For i = 1 To m_Buttons.Count
  9.         With m_Buttons(i)
  10.             stxt = .Caption
  11.             If i = 1 Then   'Nếu Button là thứ 1 thì vị trí trái của nó là 2
  12.                 .Left = 2
  13.             Else 'Ngược lại Button lớn hơn 1 thì Left của nó là Right của Button phía trước (Chắc các bạn hiểu được).
  14.                 .Left = m_Buttons(i - 1).Right
  15.             End If
  16.  
  17.             If (stxt <> "-") Then   'Nếu ko phải là separator
  18.                 .Right = .Left + TextWidth(stxt) + 20  
  19.             ElseIf (stxt = "-") Then  'Nếu là Separator
  20.                 .Right = .Left + 4
  21.             End If
  22.         End With
  23.     Next i
  24. End Sub
  25.  
  26. Private Function GetCurrentItem(X As Single, Y As Single) As Integer    'Hàm này dùngể kiểm tra xem mouse đang ở Item thứ bao nhiêu
  27.     Dim i As Integer
  28.     For i = 1 To m_Buttons.Count
  29.         If ((X > m_Buttons(i).Right) And (X < ScaleWidth - 11)) Or (X < m_Buttons(1).Left) Then
  30.            GetCurrentItem = m_Buttons.Count + 1
  31.         ElseIf X > m_Buttons(i).Left And X < m_Buttons(i).Right Then
  32.            If (X < m_Buttons(i).Right) Or (X < m_Buttons(1).Left) Then
  33.               If (Y > 2) And (Y < ScaleHeight - 2) Then
  34.                  GetCurrentItem = i
  35.                  Exit Function
  36.               Else
  37.                  GetCurrentItem = -1
  38.               End If
  39.            Else
  40.              GetCurrentItem = -1
  41.            End If
  42.         ElseIf (X > ScaleWidth - 11) And (X < ScaleWidth) Then
  43.            GetCurrentItem = -10
  44.            Exit Function
  45.         End If
  46.     Next i
  47. End Function


Tạo một vài Property :

Mã: Chọn hết

  1. Public Property Get Font() As Font
  2.     Set Font = UserControl.Font
  3. End Property
  4.  
  5. Public Property Set Font(ByVal New_Font As Font)
  6.     Set UserControl.Font = New_Font
  7.     PropertyChanged "Font"
  8. End Property
  9.  
  10. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  11. 'MappingInfo=UserControl,UserControl,-1,ForeColor
  12. Public Property Get ForeColor() As OLE_COLOR
  13.     ForeColor = UserControl.ForeColor
  14. End Property
  15.  
  16. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  17.     UserControl.ForeColor() = New_ForeColor
  18.     PropertyChanged "ForeColor"
  19. End Property
  20.  
  21. Public Property Get Buttons() As Buttons   'Property này trả về 1 Buttons cho user.
  22.     Set Buttons = m_Buttons
  23. End Property


Như vậy là xem như Toolbar đã có xương và có ... "thịt" :))
Bây giờ cho nó bộ não nửa là nó chạy.

Mã: Chọn hết

  1. Private Sub DrawUniToolbar(Optional ByVal State As Integer = 0, Optional ByVal bIndex As Long = -1)
  2. ' Đây là hàm quan trọng nhất, dùng để vẽ Toolbar
  3. 'State là trạng thái mouse,Bindex là Index của Button đang có mouse
  4.     Dim i As Long
  5.    
  6.     'Clear Usercontrol
  7.     Cls
  8.    
  9.     'Ve mot duong line phia duoi Toolbar
  10.     DrawALine 0, ScaleHeight - 1, ScaleWidth, ScaleHeight - 1, TranslateColor(vbButtonShadow)
  11.     For i = 1 To m_Buttons.Count  'vẽ tất cả các button
  12.         With m_Buttons(i)   'do ta đã đặt Item là default nên có thể gọi Buttons như vậy.
  13.             If (.Caption <> "-") Then  'Nếu caption ko phải là separator
  14.                 DrawText .Caption, .Left, 2, .Right, ScaleHeight - 2
  15.             Else 'ngược lại
  16.                 DrawALine .Left, 4, .Left, ScaleHeight - 4, TranslateColor(vbButtonShadow)
  17.             End If
  18.         End With
  19.     Next i
  20.  
  21.     If (bIndex > -1) And (bIndex < m_Buttons.Count + 1) Then   'Vẽ Button đang được mouse "ghé thăm"  :-S
  22.         With m_Buttons(bIndex)
  23.             If State = 2 Then Nếu là mouse move qua thì :
  24.                 DrawFillRECT &HEDD0BF, .Left, 2, .Right, ScaleHeight - 2    'Tô nền
  25.                 DrawFrameRect .Left, 2, .Right, ScaleHeight - 2, &HC56A31  'Tô viền
  26.                 DrawText .Caption, .Left, 2, .Right, ScaleHeight - 2  'Vẽ chữ
  27.             ElseIf State = 1 Then  ' ngược lại nếu mouse click thì :
  28.                 DrawFillRECT &HE2B498, .Left, 2, .Right, ScaleHeight - 2  
  29.                 DrawFrameRect .Left, 2, .Right, ScaleHeight - 2, &HC56A31
  30.                 DrawText .Caption, .Left, 2, .Right, ScaleHeight - 2
  31.             End If
  32.         End With
  33.     End If
  34. End Sub
  35.  
  36. Private Sub Timer1_Timer()  'Timer dùng để kiễm tra xem mouse đã rời Toolbar chưa, nếu rời rồi thì vẽ lại toolbar và tự động ngừng chạy.
  37.     If (MDMouseOver(UserControl.hWnd) = False) Then
  38.         Timer1.Enabled = False
  39.         Timer1.Interval = 0
  40.         DrawUniToolbar 0
  41.    End If
  42. End Sub
  43.  
  44. Private Sub UserControl_InitProperties()
  45. 'Khi tạo mới một Usercontrol thì Sub này chạy đầu tiên và chỉ chạy 1 lần khi mới tạo.
  46. 'Khi mới tạo lần đầu ta add một Button vào.
  47.     Buttons.Add
  48.     Set UserControl.Font = Ambient.Font
  49. End Sub
  50.  
  51. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  52.     If (Button = 1) Then
  53.        For i = 1 To m_Buttons.Count
  54.           If (X > m_Buttons(i).Left) And (Y > 2) And (X < m_Buttons(i).Right) And (Y < ScaleHeight - 2) And (m_Buttons(i).Caption <> "-") Then
  55.               'Đây là lúc sử dụng các biến lúc nãy đã khai báo.
  56.               'Lưu lại vị trí của Button đang mouse down
  57.               cx = m_Buttons(i).Left
  58.               cy = 2
  59.               cW = m_Buttons(i).Right
  60.               ch = ScaleHeight - 2
  61.               DrawUniToolbar 1, GetCurrentItem(X, Y)  'Vẽ nó khi mouse down
  62.           End If
  63.        Next i
  64.     End If
  65. End Sub
  66.  
  67. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  68.     Timer1.Enabled = True
  69.     Timer1.Interval = 100
  70.     If (Button <> 1) Then
  71.         On Error Resume Next
  72.         If (m_Buttons(GetCurrentItem(X, Y)).Caption <> "-") Then
  73.         DrawUniToolbar 2, GetCurrentItem(X, Y)
  74.         End If
  75.     ElseIf Button = 1 Then
  76.         'Kiểm tra xem có phải Button đang down lúc nãy có được mouse quay lại ko, nếu có thì ... :
  77.         If Y > cy And Y < ch And X > cx And X < cW And (m_Buttons(i).Caption <> "-") Then
  78.             DrawUniToolbar 1, GetCurrentItem(X, Y)
  79.         Else
  80.             DrawUniToolbar 0, GetCurrentItem(X, Y)
  81.         End If
  82.     End If
  83. End Sub
  84.  
  85. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  86.     Dim i As Long
  87.     i = GetCurrentItem(X, Y)
  88.     If Y > cy And Y < ch And X > cx And X < cW Then   'cũng như Sub trên là kiểm tra xem mouse có nằm trong Button down
  89.     'lúc nãy ko, nếu có thì Bẫy sự kiện click
  90.         If (m_Buttons(i).Caption <> "-") Then
  91.             RaiseEvent ButtonClick(GetCurrentItem(X, Y))
  92.         End If
  93.     End If
  94. End Sub
  95.  
  96. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  97.     m_OldCount = PropBag.ReadProperty("Count" & i, "")  'đọc số Button được add vào
  98.     Khi chạy Buttons sẽ add lại tất cả các Button được lưu vào.
  99.     For i = 1 To m_OldCount
  100.           'Hàm BinaryToUnicode trong thư viện Supportunicode có đính kèm theo ở phía dưới
  101.           m_Buttons.Add BinaryToUnicode(PropBag.ReadProperty("ItemCaption" & i, 0)), _
  102.                         PropBag.ReadProperty("ItemKey" & i, ""), _
  103.                         BinaryToUnicode(PropBag.ReadProperty("ItemTooltiptext" & i, "")), _
  104.                         PropBag.ReadProperty("ItemTag" & i, "")
  105.     Next i
  106.     Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  107.     UserControl.ForeColor = PropBag.ReadProperty("ForeColor", vbButtonText)
  108.     CalculateItem
  109. End Sub
  110.  
  111. Private Sub UserControl_Resize()  'Tự vẽ lại Toolbar khi Usercontrol thay đỗi kích thước
  112.     DrawUniToolbar
  113. End Sub
  114.  
  115. Private Sub UserControl_Show()      'Tính toán và vẽ Toolbar lúc mới show hàng  ;;)
  116.     CalculateItem
  117.     DrawUniToolbar
  118. End Sub
  119.  
  120. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  121.     PropBag.WriteProperty "Count", m_Buttons.Count, 0       'Ghi lại số lượng Button, để lúc ReadProperties ta đọc nó
  122.     For i = 1 To m_Buttons.Count
  123.         'Hàm UnicodeToBinary cũng nằm trong thư viện SupportUnicode.
  124.         With m_Buttons(i)
  125.             PropBag.WriteProperty "ItemCaption" & i, UnicodeToBinary(.Caption), ""
  126.             PropBag.WriteProperty "ItemTooltiptext" & i, UnicodeToBinary(.ToolTipText), ""
  127.             PropBag.WriteProperty "ItemKey" & i, .Key, ""
  128.             PropBag.WriteProperty "ItemTag" & i, .Tag, ""
  129.         End With
  130.     Next i
  131.     Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
  132.     Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &HC56A3112)
  133. End Sub
  134.  


Vậy là xong Toolbar rồi đấy. Nhưng bây giờ chưa add các Button vào lúc Design time được.
Muốn add button lúc design time thì chỉ có dùng Property Page thôi. Và cách tạo nó thì cực kỳ đơn giản.

Add vào một Property page và thiết kế như trong hình, copy code sau vào :
p2.JPG
p2.JPG (6.37 KiB) Đã xem 8579 lần

Mã: Chọn hết

  1. Private Sub cmdAdd_Click()   'Code cho nút "Add"
  2.  
  3.     If Changed = True Then   'Nếu Page có thay đỗi nội dung thì cập nhật ngay
  4.         PropertyPage_ApplyChanges  
  5.     End If
  6.    
  7.     SelectedControls(0).Buttons.Add "Button" & vValue.Value + 1
  8.     Changed = True
  9.     DoEvents
  10.     'Sau khi add button thì gán trị lớn nhất cho vValue (VSCrollbar) và txtIndex (Textbox)
  11.     txtIndex.text = SelectedControls(0).Buttons.Count
  12.     vValue.Max = SelectedControls(0).Buttons.Count
  13.     vValue.Value = vValue.Max
  14. End Sub
  15.  
  16. Private Sub cmdRemove_Click()  'Code cho nút "Remove"
  17.     If vValue.Max > 1 Then
  18.         SelectedControls(0).Buttons.Remove CLng(txtIndex.text)
  19.         vValue.Max = SelectedControls(0).Buttons.Count
  20.         vValue.Value = vValue.Max
  21.         txtIndex.text = vValue.Max
  22.     End If
  23. End Sub
  24.  
  25. Private Sub PropertyPage_ApplyChanges()    'Code cho nút "Apply"
  26. 'Gán các giá trị trong Page vào Button
  27.     SelectedControls(0).Buttons(vValue.Value).Caption = txtCaption.text
  28.     SelectedControls(0).Buttons(vValue.Value).Key = txtKey.text
  29.     SelectedControls(0).Buttons(vValue.Value).ToolTipText = txtToolTip.text
  30.     SelectedControls(0).Buttons(vValue.Value).Tag = txtTag.text
  31.    
  32.     DoEvents
  33.     SelectedControls(0).Refresh
  34. End Sub
  35.  
  36. Private Sub PropertyPage_SelectionChanged()
  37. 'Gán giá trị của Button vào Page
  38.     vValue.Max = SelectedControls(0).Buttons.Count
  39.     txtIndex.text = vValue.Value
  40.     txtCaption.text = SelectedControls(0).Buttons(vValue.Value).Caption
  41.     txtKey.text = SelectedControls(0).Buttons(vValue.Value).Key
  42.     txtToolTip.text = SelectedControls(0).Buttons(vValue.Value).ToolTipText
  43.     txtTag.text = SelectedControls(0).Buttons(vValue.Value).Tag
  44. End Sub
  45.  
  46. Private Sub txtCaption_Change()
  47.     Changed = True
  48. End Sub
  49.  
  50. Private Sub txtKey_Change()
  51.     Changed = True
  52. End Sub
  53.  
  54. Private Sub txtTag_Change()
  55.     Changed = True
  56. End Sub
  57.  
  58. Private Sub txtToolTip_Change()
  59.     Changed = True
  60. End Sub
  61.  
  62. Private Sub vValue_Change()  'Khi VScrollbar thay đỗi giá trị thì hiển thị dử liệu của Button theo giá trị đó
  63.     txtIndex = vValue.Value
  64.     txtCaption.text = SelectedControls(0).Buttons(txtIndex.text).Caption
  65.     txtKey.text = SelectedControls(0).Buttons(txtIndex.text).Key
  66.     txtToolTip.text = (SelectedControls(0).Buttons(txtIndex.text).ToolTipText)
  67.     txtTag.text = SelectedControls(0).Buttons(txtIndex.text).Tag
  68.    
  69.     DoEvents
  70. End Sub
  71.  


Kết thúc. Bạn đã có một Unicode Toolbar với giao diện Office XP.
Theo mình thì bạn chịu khó đọc và thực hành thì sẽ hiểu ngay.
Một bài tập cho các bạn : Tạo thêm Icon cho Toolbar, mách các bạn 2 cách :
+ Icon dùng bằng ImageList - Tạo thêm 1 biến (dạng Long) trong Class Button để lưu ImageIndex của ImageList và vẽ lên Toolbar
+ Icon lưu trực tiếp trong Button - Tạo thêm 1 biến (dạng StdPicture) trong Class Button để lưu Picture lại.

Các bạn có thể download mã nguồn của UniToolbar trên ở đây :
UniToolbar.rar
Source code UnicodeToolbar
(14.61 KiB) Đã tải 883 lần


Khi khác nếu có thời gian mình sẽ tiếp tục.

dtv.dung
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: CN 16/05/2010 6:57 am
Đến từ: Đà Nẵng
Liên hệ:

Re: Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Gửi bàigửi bởi dtv.dung » T.Năm 20/05/2010 1:44 pm

Cho mình hỏi 1 phần của cách 1 bạn đã hướng dẫn
download/file.php?id=151&mode=view
Đây là bước quan trọng, bạn phải dò tìm những property , method, event của label và chuyễn qua hết vào bên phải (có thể chọn những thứ khác không phải của label), xong bấm next
thì những property, method, event của label là gì và bạn có thể cho mình xin những property, method, even của những thứ khác được chứ ví dụ như comanbuton...
Từ quá khứ đi đến tương lai đừng nhìn lại

Hình đại diện của người dùng
DQHung
Guru
Guru
Bài viết: 576
Ngày tham gia: T.Hai 12/02/2007 3:24 pm
Đến từ: Rach Gia - Kien Giang
Been thanked: 40 time
Liên hệ:

Re: Hướng dẩn cách tạo(viết) ActiveX control (ocx)

Gửi bàigửi bởi DQHung » CN 30/05/2010 3:54 pm

dtv.dung đã viết:Cho mình hỏi 1 phần của cách 1 bạn đã hướng dẫn
download/file.php?id=151&mode=view
Đây là bước quan trọng, bạn phải dò tìm những property , method, event của label và chuyễn qua hết vào bên phải (có thể chọn những thứ khác không phải của label), xong bấm next
thì những property, method, event của label là gì và bạn có thể cho mình xin những property, method, even của những thứ khác được chứ ví dụ như comanbuton...


Bạn muốn viết control thì bạn phải biết control đó "cần phải có thuộc tính gì" chứ nhỉ ?
Nếu muốn biết các thuộc tính của Command thì cứ mở "Object Browser" lên mà xem.


Quay về “[VB] Bài viết hướng dẫn”

Đ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