• 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

cUniClipboard

Các Module, Class, UserControl và thư viện OCX, DLL hỗ trợ cho Visual Basic
Hình đại diện của người dùng
doicanhden
Thành viên tích cực
Thành viên tích cực
Bài viết: 160
Ngày tham gia: T.Tư 02/09/2009 4:29 pm
Đến từ: Tp.HCM
Has thanked: 7 time
Been thanked: 3 time
Liên hệ:

cUniClipboard

Gửi bàigửi bởi doicanhden » T.Tư 24/11/2010 11:48 pm

Tên: cUniClipboard
Loại: Module Class
Ngôn ngữ lập trình: VB6
Tác giả: doicanhden
Chức năng: Đây là module class giúp thao tác unicode với clipboard, và thêm một số phần mở rộng....


Ai có code gì hay về Clipboard API thì post vào đây.

Module Class:
  1. Public Enum Clipboard_Format
  2.      CF_TEXT = 1
  3.      CF_BITMAP = 2
  4.      CF_METAFILEPICT = 3
  5.      CF_SYLK = 4
  6.      CF_DIF = 5
  7.      CF_TIFF = 6
  8.      CF_OEMTEXT = 7
  9.      CF_DIB = 8
  10.      CF_PALETTE = 9
  11.      CF_PENDATA = 10
  12.      CF_RIFF = 11
  13.      CF_WAVE = 12
  14.      CF_UNICODETEXT = 13
  15.      CF_ENHMETAFILE = 14
  16.      CF_HDROP = 15
  17.      CF_LOCALE = 16
  18.      CF_MAX = 17
  19.      CF_OWNERDISPLAY = 128
  20.      CF_DSPTEXT = 129
  21.      CF_DSPBITMAP = 130
  22.      CF_DSPMETAFILEPICT = 131
  23.      CF_DSPENHMETAFILE = 142
  24.      CF_PRIVATEFIRST = 512
  25.      CF_PRIVATELAST = 767
  26.      CF_GDIOBJFIRST = 768
  27.      CF_GDIOBJLAST = 1023
  28. End Enum
  29. Private Enum GlobalMemory
  30.     GMEM_DDESHARE = &H2000
  31.     GMEM_DISCARDABLE = &H100
  32.     GMEM_DISCARDED = &H4000
  33.     GMEM_FIXED = &H0
  34.     GMEM_INVALID_HANDLE = &H8000
  35.     GMEM_LOCKCOUNT = &HFF
  36.     GMEM_MODIFY = &H80
  37.     GMEM_MOVEABLE = &H2
  38.     GMEM_NOCOMPACT = &H10
  39.     GMEM_NODISCARD = &H20
  40.     GMEM_NOT_BANKED = &H1000
  41.     GMEM_NOTIFY = &H4000
  42.     GMEM_SHARE = &H2000
  43.     GMEM_VALID_FLAGS = &H7F72
  44.     GMEM_ZEROINIT = &H40
  45.     GMEM_LOWER = GMEM_NOT_BANKED
  46.     GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
  47.     GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  48. End Enum
  49. Public Enum FileEffectConstants
  50.   EffectCopy = 1
  51.   EffectMove = 2
  52. End Enum
  53. Private Type POINTAPI
  54.    X As Long
  55.    y As Long
  56. End Type
  57. Private Type DROPFILES
  58.    pFiles As Long
  59.    pt As POINTAPI
  60.    fNC As Long
  61.    fWide As Long
  62. End Type
  63.  
  64. Private Declare Function RegisterClipboardFormat Lib "User32" Alias "RegisterClipboardFormatW" (ByVal lpString As Long) As Long
  65. Private Declare Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As Long) As Long
  66. Private Declare Function EnumClipboardFormats Lib "User32" (ByVal wFormat As Long) As Long
  67. Private Declare Function CountClipboardFormats Lib "User32" () As Long
  68. Private Declare Function GetClipboardFormatName Lib "User32" Alias "GetClipboardFormatNameW" (ByVal wFormat As Long, ByVal lpString As Long, ByVal nMaxCount As Long) As Long
  69. Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
  70. Private Declare Function EmptyClipboard Lib "User32" () As Long
  71. Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
  72. Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
  73. Private Declare Function CloseClipboard Lib "User32" () As Long
  74. Private Declare Function GlobalAlloc Lib "Kernel32" (ByVal wFlags As GlobalMemory, ByVal dwBytes As Long) As Long
  75. Private Declare Function GlobalFree Lib "Kernel32" (ByVal hMem As Long) As Long
  76. Private Declare Function GlobalLock Lib "Kernel32" (ByVal hMem As Long) As Long
  77. 'Private Declare Function GlobalReAlloc Lib "Kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long) As Long
  78. Private Declare Function GlobalSize Lib "Kernel32" (ByVal hMem As Long) As Long
  79. Private Declare Function GlobalUnlock Lib "Kernel32" (ByVal hMem As Long) As Long
  80. Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
  81. Private Declare Function LongStringCopy Lib "Kernel32" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
  82. Private Declare Function StrLen Lib "Kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long
  83. Private Declare Function DragQueryFile Lib "Shell32" Alias "DragQueryFileW" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As Long, ByVal ch As Long) As Long
  84. Public Function SetText(ByVal sText$) As Boolean
  85.     Dim sPtr&, iLen&, iLock&
  86.     On Error GoTo LabExit
  87.     iLen = LenB(sText) + 2
  88.     sPtr = GlobalAlloc(GHND, iLen)
  89.     iLock = GlobalLock(sPtr)
  90.     Call LongStringCopy(iLock, StrPtr(sText))
  91.     Call GlobalUnlock(sPtr)
  92.     If OpenClipboard(0&) Then
  93.         Call EmptyClipboard
  94.         Call SetClipboardData(CF_UNICODETEXT, sPtr)
  95.         Call CloseClipboard
  96.         SetText = True
  97.     End If
  98. LabExit:
  99. End Function
  100. Public Function GetText() As String
  101.     Dim lPtr&, lLenght&, lMemH&, sData$
  102.     If OpenClipboard(0&) Then
  103.         lPtr = GetClipboardData(CF_UNICODETEXT)
  104.         lMemH = GlobalLock(lPtr)
  105.         lLenght = GlobalSize(lPtr)
  106.         sData = String$(lLenght \ 2 - 1, Chr(0))
  107.         Call LongStringCopy(StrPtr(sData), lMemH)
  108.         Call GlobalUnlock(lPtr)
  109.         Call CloseClipboard
  110.         GetText = sData
  111.     End If
  112. End Function
  113. Public Function Clear() As Boolean
  114.     If OpenClipboard(0&) Then
  115.         Call EmptyClipboard
  116.         Call CloseClipboard
  117.         Clear = True
  118.     End If
  119. End Function
  120. Public Function GetFiles(Optional ByRef iFileCount As Long, Optional ByRef lEffect As FileEffectConstants) As String() 'Tra ve 1 mang chua danh sach cac tap tin
  121.    Dim hDrop&, lFormat&, hGlobal&, iFile&, sFileName$, iPos&, sFiles$()
  122.     On Error GoTo LabExit
  123.     If OpenClipboard(0&) Then
  124.         lFormat = RegisterClipboardFormat(StrPtr("Preferred DropEffect")) 'Get ID
  125.        hDrop = GetClipboardData(CF_HDROP)
  126.         hGlobal = GetClipboardData(lFormat) 'For Effect
  127.        Call CloseClipboard
  128.     End If
  129.     If (hDrop <> 0) Then
  130.         iFileCount = DragQueryFile(hDrop, -1&, StrPtr(""), 0&)
  131.         If (iFileCount > 0) Then
  132.             ReDim sFiles(1 To iFileCount) As String
  133.             sFileName = String$(260, Chr(0))
  134.             For iFile = 1 To iFileCount
  135.                 Call DragQueryFile(hDrop, iFile - 1, StrPtr(sFileName), Len(sFileName))
  136.                 iPos = InStr(sFileName, vbNullChar)
  137.                 If (iPos <> 0) Then
  138.                     sFiles(iFile) = Left$(sFileName, iPos - 1)
  139.                 Else
  140.                     sFiles(iFile) = sFileName
  141.                 End If
  142.                 GetFiles = sFiles
  143.                 ReDim sFiles(0)
  144.             Next iFile
  145.             If (hGlobal <> 0) Then
  146.                 Call CopyMemory(lEffect, ByVal hGlobal, 4) 'For Effect
  147.            End If
  148.         End If
  149.     End If
  150. LabExit:
  151. End Function
  152. Public Function SetFiles(ByRef sFiles() As String, Optional ByVal lEffect As FileEffectConstants = EffectCopy) As Boolean
  153.     Dim i&, sData$, hMemH&, hMemH2&
  154.     Dim DF As DROPFILES
  155.     Dim B() As Byte
  156.     Dim lFormat&
  157.     On Error GoTo LabExit
  158.     For i = LBound(sFiles) To UBound(sFiles)
  159.         sData = sData & sFiles(i) & vbNullChar
  160.     Next i
  161.     sData = sData & vbNullChar
  162.     DF.pFiles = Len(DF) ' Size of Structure: 20 bytes
  163.    DF.fWide = 1 ' 0 To ASCII; 1 To Unicode
  164.    lFormat = RegisterClipboardFormat(StrPtr("Preferred DropEffect")) ' Get ID
  165.    hMemH = GlobalAlloc(GHND, Len(DF) + LenB(sData))
  166.     hMemH2 = GlobalAlloc(GHND, 4) ' For Effect
  167.    hMemH = GlobalLock(hMemH)
  168.     hMemH2 = GlobalLock(hMemH2) ' For Effect
  169.    Call CopyMemory(ByVal hMemH, DF, Len(DF))
  170.     Call CopyMemory(ByVal (hMemH + Len(DF)), ByVal StrPtr(sData), LenB(sData))
  171.     Call CopyMemory(ByVal hMemH2, lEffect, 4) ' For Effect
  172.    Call GlobalUnlock(hMemH)
  173.     Call GlobalUnlock(hMemH2) ' For Effect
  174.    If OpenClipboard(0&) Then
  175.         Call EmptyClipboard
  176.         Call SetClipboardData(CF_HDROP, hMemH)
  177.         Call SetClipboardData(lFormat, hMemH2) ' For Effect
  178.        Call CloseClipboard
  179.         SetFiles = True
  180.     End If
  181. LabExit:
  182. End Function
  183. Public Function GetFormat(ByVal lFormat As Long) As Boolean
  184.     GetFormat = CBool(IsClipboardFormatAvailable(lFormat))
  185. End Function
  186. Public Function AddFormat(ByVal sName As String) As Long
  187.     Dim wFormat&
  188.     wFormat = RegisterClipboardFormat(StrPtr(sName & Chr$(0)))
  189.     If (wFormat > &HC000&) Then AddFormat = wFormat
  190. End Function
  191. Public Function GetBinaryData(ByVal lFormat As Long) As Byte()
  192.     Dim hMemH&, lSize&, lClipboard&, bTemp() As Byte
  193.     If CBool(IsClipboardFormatAvailable(lFormat)) Then
  194.         If OpenClipboard(0&) Then
  195.             lClipboard = GetClipboardData(lFormat)
  196.             lSize = GlobalSize(lClipboard)
  197.             If lSize > 0 Then
  198.                 hMemH = GlobalLock(lClipboard)
  199.                 ReDim bTemp(0 To lSize - 1)
  200.                 Call CopyMemory(bTemp(0), ByVal hMemH, ByVal lSize)
  201.                 Call GlobalUnlock(lClipboard)
  202.                 GetBinaryData = bTemp
  203.                 ReDim bTemp(0)
  204.             End If
  205.             Call CloseClipboard
  206.         End If
  207.     End If
  208. End Function
  209. Public Function SetBinaryData(ByRef bData() As Byte, ByVal lFormat As Long) As Boolean
  210.     Dim lSize&, lPtr&, hMemH&
  211.     lSize = UBound(bData) - LBound(bData) + 1
  212.     hMemH = GlobalAlloc(GHND, lSize)
  213.     If (hMemH <> 0) Then
  214.         lPtr = GlobalLock(hMemH)
  215.         CopyMemory ByVal lPtr, bData(LBound(bData)), lSize
  216.         Call GlobalUnlock(hMemH)
  217.         If OpenClipboard(0&) Then
  218.             Call SetClipboardData(lFormat, hMemH)
  219.             Call CloseClipboard
  220.             SetBinaryData = True
  221.         End If
  222.     End If
  223. End Function
  224. Public Function FormatCount() As Long
  225.     FormatCount = CountClipboardFormats()
  226. End Function
  227. Public Function ListNameFormat(Optional ByRef lListCount As Long) As String()
  228.     'Lay Danh Sach Ten Cac Dinh Dang Ton Tai Tren Clipboard
  229.    Dim lR&, i&, sName$()
  230.     If (OpenClipboard(0&)) Then
  231.         lR = EnumClipboardFormats(0)
  232.         If (lR <> 0) Then
  233.             Do
  234.                 ReDim Preserve sName(i)
  235.                 sName(i) = FormatName(lR)
  236.                 sName(i) = IIf(sName(i) = vbNullString, "[Unknow]", sName(i))
  237.                 lR = EnumClipboardFormats(lR)
  238.                 i = i + 1
  239.             Loop While lR <> 0
  240.         End If
  241.         Call CloseClipboard
  242.         lListCount = i - 1
  243.         ListNameFormat = sName
  244.     End If
  245. End Function
  246. Public Function ListIDFormat(Optional ByRef lListCount As Long) As Long()
  247.     'Lay Danh Sach ID Cac Dinh Dang Ton Tai Tren Clipboard
  248.    Dim lR&, i&, lID&()
  249.     If (OpenClipboard(0&)) Then
  250.         lR = EnumClipboardFormats(0)
  251.         If (lR <> 0) Then
  252.             Do
  253.                 ReDim Preserve lID(i)
  254.                 lID(i) = lR
  255.                 lR = EnumClipboardFormats(lR)
  256.                 i = i + 1
  257.             Loop While lR <> 0
  258.         End If
  259.         Call CloseClipboard
  260.         lListCount = i - 1
  261.         ListIDFormat = lID
  262.     End If
  263. End Function
  264. Public Function FormatName(ByVal lFormatID As Long) As String
  265.     Dim lSize&, lR&, sTmp$
  266.     If (lFormatID >= 1 And lFormatID <= 17) Then
  267.         Select Case lFormatID
  268.         Case CF_TEXT
  269.             sTmp = "Text"
  270.         Case CF_BITMAP
  271.             sTmp = "Bitmap Picture"
  272.         Case CF_METAFILEPICT
  273.             sTmp = "Meta-File Picture"
  274.         Case CF_SYLK
  275.             sTmp = "Microsoft Symbolic Link (SYLK) data."
  276.         Case CF_DIF
  277.            sTmp = "Software Arts"
  278.         Case CF_TIFF
  279.             sTmp = "Tagged Image File Format (TIFF) Picture"
  280.         Case CF_OEMTEXT
  281.             sTmp = "Text (OEM)"
  282.         Case CF_DIB
  283.             sTmp = "DIB Bitmap Picture"
  284.         Case CF_PALETTE
  285.             sTmp = "Colour Palette"
  286.         Case CF_PENDATA
  287.             sTmp = "Pen Data"
  288.         Case CF_RIFF
  289.             sTmp = "RIFF Audio data"
  290.         Case CF_WAVE
  291.             sTmp = "Wave File"
  292.         Case CF_UNICODETEXT
  293.             sTmp = "Text (Unicode)"
  294.         Case CF_ENHMETAFILE
  295.             sTmp = "Enhanced Meta-File Picture"
  296.          Case CF_HDROP
  297.             sTmp = "File List"
  298.         Case CF_LOCALE
  299.             sTmp = "Text Locale Identifier"
  300.         End Select
  301.     Else
  302.         sTmp = String$(255, 0)
  303.         lR = GetClipboardFormatName(lFormatID, StrPtr(sTmp), 255)
  304.         If (lR <> 0) Then
  305.             sTmp = Left$(sTmp, lR)
  306.         End If
  307.     End If
  308.     FormatName = sTmp
  309. End Function
  310.  

Download:
cUniClipboard.rar
Thao tác Unicode với Clipboard
(3.01 KiB) Đã tải 889 lần



baohiep
Thành viên danh dự
Thành viên danh dự
Bài viết: 109
Ngày tham gia: CN 27/12/2009 6:37 pm
Đến từ: Tam Kỳ
Has thanked: 3 time
Been thanked: 9 time

Re: cUniClipboard

Gửi bàigửi bởi baohiep » T.Sáu 04/03/2011 9:08 pm

hay! hay lắm.

Hình đại diện của người dùng
doicanhden
Thành viên tích cực
Thành viên tích cực
Bài viết: 160
Ngày tham gia: T.Tư 02/09/2009 4:29 pm
Đến từ: Tp.HCM
Has thanked: 7 time
Been thanked: 3 time
Liên hệ:

Re: cUniClipboard

Gửi bàigửi bởi doicanhden » T.Năm 20/09/2012 12:42 am

Hehe, bò vào lụm lại cái code, convert qua C/C++ cho nhanh đỡ phải viết lại. :]


Quay về “[VB] Module, Class, UserControl, OCX”

Đ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.0 khách