Project

General

Profile

Statistics
| Revision:

root / Components / mdlApi.bas @ 321

History | View | Annotate | Download (1.96 KB)

1
Attribute VB_Name = "mdlApi"
2
Option Explicit
3

    
4
Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
5
   As Long
6
Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
7
   As Long
8
Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
9
   ByVal dwBytes As Long) As Long
10
Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
11
Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
12
   As Long
13
Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
14
Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
15
   ByVal lpString2 As Any) As Long
16
Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
17
   As Long, ByVal hMem As Long) As Long
18
 
19
Public Const GHND = &H42
20
Public Const CF_TEXT = 1
21
Public Const MAXSIZE = 4096
22

    
23
Public Function ClipBoard_SetData(MyString As String)
24
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
25
   Dim hClipMemory As Long, X As Long
26
 
27
   ' Allocate moveable global memory.
28
   '-------------------------------------------
29
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
30
 
31
   ' Lock the block to get a far pointer
32
   ' to this memory.
33
   lpGlobalMemory = GlobalLock(hGlobalMemory)
34
 
35
   ' Copy the string to this global memory.
36
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
37
 
38
   ' Unlock the memory.
39
   If GlobalUnlock(hGlobalMemory) <> 0 Then
40
      MsgBox "Could not unlock memory location. Copy aborted."
41
      GoTo OutOfHere2
42
   End If
43
 
44
   ' Open the Clipboard to copy data to.
45
   If OpenClipboard(0&) = 0 Then
46
      MsgBox "Could not open the Clipboard. Copy aborted."
47
      Exit Function
48
   End If
49
 
50
   ' Clear the Clipboard.
51
   X = EmptyClipboard()
52
 
53
   ' Copy the data to the Clipboard.
54
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
55
 
56
OutOfHere2:
57
 
58
   If CloseClipboard() = 0 Then
59
      MsgBox "Could not close Clipboard."
60
   End If
61
 
62
   End Function