home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / CodeHelp_A1935969282005.psc / CHCore / CHGlobalLib / CHGlobal.cls next >
Text File  |  2005-09-14  |  2KB  |  75 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CHHelper"
  10. Attribute VB_GlobalNameSpace = True
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15. '***********************************
  16. 'CodeHelp Helper class
  17. '***********************************
  18.  
  19. Private Const ccCFBitmap = 2
  20. Private Const ccCFMetafile = 3
  21. Private Const ccCFDIB = 8
  22.  
  23. Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" _
  24.      (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
  25.      ByVal lpOutput As String, ByVal lpInitData As String) As Long
  26.  
  27.  
  28. Function GetCHCore(ByVal lPtr As Long) As ICHCore
  29.   Dim oTemp As Object
  30.    ' Turn the pointer into an illegal, uncounted interface
  31.   If lPtr = 0 Then Exit Function
  32.   
  33.   If IsBadReadPtr(lPtr, ByVal 4) Then Exit Function  ' better to be safe
  34.   CopyMemory oTemp, lPtr, 4
  35.   
  36.   ' Assign to legal reference
  37.   Set GetCHCore = oTemp
  38.   
  39.   ' Destroy the illegal reference
  40.   CopyMemory oTemp, 0&, 4
  41. End Function
  42.  
  43. Sub CopyIconToClipBoardAsBmp(oIcon As StdPicture, oBMP As StdPicture)
  44.     Dim Rc As Long
  45.     Dim hdc As Long
  46.     Dim hdcMem As Long
  47.     Dim hBmOld As Long
  48.     
  49.     hdc = CreateIC("DISPLAY", vbNullChar, vbNullChar, vbNullChar)
  50.     hdcMem = CreateCompatibleDC(hdc)
  51.     hBmOld = SelectObject(hdcMem, oBMP.Handle)
  52.     Rc = DrawIconEx(hdcMem, 0, 0, oIcon.Handle, 16, 16, 0, 0, DI_NORMAL)
  53.     SelectObject hdcMem, hBmOld
  54.     DeleteDC hdc
  55.     DeleteDC hdcMem
  56.         
  57.     Clipboard.Clear
  58.     Clipboard.SetData oBMP, ccCFBitmap
  59.     Clipboard.SetData oBMP, ccCFDIB
  60.  
  61. End Sub
  62.  
  63. Sub LogToNotePad(ByVal sMsg As String)
  64.     'Help trace in compiled mode
  65.     'The message will be appended to first notepad instance found
  66.     
  67.     Dim hNote As Long
  68.     hNote = A_FindWindowEx(0, 0, "Notepad", "Untitled - Notepad")
  69.     
  70.     If hNote <> 0 Then
  71.         hNote = A_FindWindowEx(hNote, 0, "Edit", vbNullString)
  72.         A_SendMessageStr hNote, EM_REPLACESEL, 0, sMsg
  73.     End If
  74. End Sub
  75.