Binaryworld - Realtime Clipboard viewer (Subclassing technique) ... [ VB -> Clipboard ]

The clipboard is a set of functions and messages that enable applications to transfer data. Because all applications have access to the clipboard, data can be easily transferred between applications or within an application. In this article you will learn various techniques to develop fully functional Realtime ClipBoard Viewer using Subclassing technique.

Step-By-Step Example

- Create a standard exe project
- Add one module
- Add one textbox control (MultiLine=true and scrollbar=both), one listbox control and one picture box control
- Add the following code in form1

Click here to copy the following block

Public Sub Form_Load()
  With Text1
    .Visible = True
    .Text = ""
  End With
  With Picture1
    .Visible = False
    .Move Text1.Left, Text1.Top, Text1.Width, Text1.Height  '//Make same size as text1
    .AutoRedraw = True
  End With

  ' Setup window hook
  Call HookWindow(Me.hWnd, Me)
  ' Paint whatever's in the clipboard currently

  ' Install app in viewer chain
  m_hWndNext = SetClipboardViewer(hWnd)
End Sub

Public Sub Form_Unload(Cancel As Integer)
  Dim nRet As Long

  ' Remove Me from the clipboard viewer chain.
  ' DO NOT stop execution from VB menu or toolbar!

  With Me
    Call ChangeClipboardChain(.hWnd, m_hWndNext)
    Call UnhookWindow(.hWnd)
  End With
End Sub

Public Function UpdateClipView() As Boolean
  Dim nRet As Boolean
  Dim bAuto As Boolean

  Picture1.Visible = False
  Set Picture1.Picture = Nothing
  Text1.Visible = False

  Select Case m_ClipFmt
    Case CF_TEXT, CF_OEMTEXT, CF_DSPTEXT, CF_UNICODETEXT
      nRet = DisplayText(m_ClipFmt, Text1)
      Text1.Visible = True

    Case CF_HDROP
      nRet = DisplayFileList(Text1)
      Text1.Visible = True

    Case CF_BITMAP, CF_DSPBITMAP, _
        CF_METAFILEPICT, CF_DSPMETAFILEPICT, CF_ENHMETAFILE
      Picture1.Visible = True
      nRet = DisplayPicture(m_ClipFmt, Picture1)

    Case CF_PALETTE
      Picture1.Visible = True
      nRet = DisplayPalette(Picture1)

    Case CF_LOCALE
      nRet = DisplayLocale(Text1)
      Text1.Visible = True

    Case CF_OWNERDISPLAY
      Picture1.Visible = True
      nRet = DisplayOwnerDisplay(Picture1)
    Case Else
      '//Unknown format
      Text1.Visible = True
      Text1.Text = Clipboard.GetData()
  End Select

  If nRet = False Then
    Me.Caption = "No Supported Format"
  End If

  UpdateClipView = nRet
End Function

Public Sub List1_Click()
  If List1.ListIndex < 0 Then Exit Sub
  m_ClipFmt = List1.ItemData(List1.ListIndex)

  '//Display clipboard data when somebody select clipboard data format
  Call UpdateClipView
End Sub

- Add the following code in module1

Click here to copy the following block

Option Explicit

' Required data structures
Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Public Type SIZEL
  cx As Long
  cy As Long
End Type

Public Type PAINTSTRUCT
  hdc As Long
  fErase As Long
  rcPaint As RECT
  fRestore As Long
  fIncUpdate As Long
  rgbReserved(1 To 32) As Byte
End Type

Public Type POINTAPI
  x As Long
  y As Long
End Type

'//Clipboard Manager Functions
Public Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function GetClipboardOwner Lib "user32" () As Long
Public Declare Function SetClipboardViewer Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function GetClipboardViewer Lib "user32" () As Long
Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hWnd As Long, ByVal hWndNext As Long) As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function CountClipboardFormats Lib "user32" () As Long
Public Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function GetPriorityClipboardFormat Lib "user32" (lpPriorityList As Long, ByVal nCount As Long) As Long

'//Other required Win32 APIs
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalHandle Lib "kernel32" (wMem As Any) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hEmf As Long, lpRect As RECT) As Long
Public Declare Function GetEnhMetaFileHeader Lib "gdi32" (ByVal hEmf As Long, ByVal cbBuffer As Long, lpemh As ENHMETAHEADER) As Long
Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Public Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Public 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

'//Other Win32 APIs used only within this module.
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal wNewWord As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

'//Used with GetWindowLong to retrieve the WindowProc address for hooked window.
Public Const GWL_WNDPROC As Long = -4&

' Clipboard Window Messages
Public Const WM_CUT = &H300
Public Const WM_COPY = &H301
Public Const WM_PASTE = &H302
Public Const WM_CLEAR = &H303
Public Const WM_UNDO = &H304
Public Const WM_RENDERFORMAT = &H305
Public Const WM_RENDERALLFORMATS = &H306
Public Const WM_DESTROYCLIPBOARD = &H307
Public Const WM_DRAWCLIPBOARD = &H308
Public Const WM_PAINTCLIPBOARD = &H309
Public Const WM_VSCROLLCLIPBOARD = &H30A
Public Const WM_SIZECLIPBOARD = &H30B
Public Const WM_ASKCBFORMATNAME = &H30C
Public Const WM_CHANGECBCHAIN = &H30D
Public Const WM_HSCROLLCLIPBOARD = &H30E

' Predefined Clipboard Formats
Public Const CF_TEXT = 1
Public Const CF_BITMAP = 2
Public Const CF_METAFILEPICT = 3
Public Const CF_SYLK = 4
Public Const CF_DIF = 5
Public Const CF_TIFF = 6
Public Const CF_OEMTEXT = 7
Public Const CF_DIB = 8
Public Const CF_PALETTE = 9
Public Const CF_PENDATA = 10
Public Const CF_RIFF = 11
Public Const CF_WAVE = 12
Public Const CF_UNICODETEXT = 13
Public Const CF_ENHMETAFILE = 14
Public Const CF_HDROP = 15
Public Const CF_LOCALE = 16
Public Const CF_MAX = 17

Public Const CF_OWNERDISPLAY = &H80
Public Const CF_DSPTEXT = &H81
Public Const CF_DSPBITMAP = &H82
Public Const CF_DSPMETAFILEPICT = &H83
Public Const CF_DSPENHMETAFILE = &H8E

' Global Memory Flags
Public Const GMEM_FIXED = &H0
Public Const GMEM_ZEROINIT = &H40
Public Const GMEM_DDESHARE = &H2000

Public Type ENHMETAHEADER
  iType As Long
  nSize As Long
  rclBounds As RECT
  rclFrame As RECT
  dSignature As Long
  nVersion As Long
  nBytes As Long
  nRecords As Long
  nHandles As Integer
  sReserved As Integer
  nDescription As Long
  offDescription As Long
  nPalEntries As Long
  szlDevice As SIZEL
  szlMillimeters As SIZEL
End Type

' Locale Types.
' These types are used for the GetLocaleInfoW NLS API routine.
Public Const LOCALE_ILANGUAGE = &H1  ' language id
Public Const LOCALE_SLANGUAGE = &H2  ' localized name of language
Public Const LOCALE_SENGLANGUAGE = &H1001  ' English name of language
Public Const LOCALE_SABBREVLANGNAME = &H3  ' abbreviated language name
Public Const LOCALE_SNATIVELANGNAME = &H4  ' native name of language
Public Const LOCALE_ICOUNTRY = &H5  ' country code
Public Const LOCALE_SCOUNTRY = &H6  ' localized name of country
Public Const LOCALE_SENGCOUNTRY = &H1002  ' English name of country
Public Const LOCALE_SABBREVCTRYNAME = &H7  ' abbreviated country name
Public Const LOCALE_SNATIVECTRYNAME = &H8  ' native name of country
Public Const LOCALE_IDEFAULTLANGUAGE = &H9  ' default language id
Public Const LOCALE_IDEFAULTCOUNTRY = &HA  ' default country code
Public Const LOCALE_IDEFAULTCODEPAGE = &HB  ' default code page

Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

' SendMessage constants for font messages
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31

' API stock font identifier constants
Public Const OEM_FIXED_FONT = 10
Public Const ANSI_FIXED_FONT = 11
Public Const ANSI_VAR_FONT = 12
Public Const SYSTEM_FONT = 13
Public Const DEVICE_DEFAULT_FONT = 14
Public Const SYSTEM_FIXED_FONT = 16

Public Enum StockFonts
  sfOemFixed = OEM_FIXED_FONT
  sfAnsiVar = ANSI_VAR_FONT
  sfAnsiFixed = ANSI_FIXED_FONT
  sfSystemVar = SYSTEM_FONT
  sfSystemFixed = SYSTEM_FIXED_FONT
  sfDeviceDefault = DEVICE_DEFAULT_FONT
End Enum

Public lpPrevWndProc As Long

'//Static handle to next window in clipboard chain
Public m_hWndNext As Long
'//Static var to hold current clipboard format
Public m_ClipFmt As Long
'//Static var to hold priority clipboard format which should be displayed by default
Public m_PriorityClipFmt As Long

Public objForm As Form

Public Sub HookWindow(hWnd As Long, frm As Object)
  '//Get old winproc handle and store it so when
  '//we unhook we can set it back to old winproc
  lpPrevWndProc = GetWindowLong(hWnd, GWL_WNDPROC)

  '//We want to subclass messages to the form so create reference to our form
  Set objForm = frm

  '//Set new window procedure to point into this module.
  Call SetWindowLong(hWnd, GWL_WNDPROC, AddressOf HookFunc)

End Sub

Public Sub UnhookWindow(hWnd As Long)
  '//If valid, restore it to previous value.
  If (lpPrevWndProc <> 0) Then
    Call SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
  End If
End Sub

Public Function HookFunc(ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
  Const WM_DESTROY = &H2

  On Error Resume Next

  ' Call WindowProc, and return result to Windows.
  HookFunc = WindowProc(hWnd, msg, wp, lp)

  ' Unhook if the window is being destroyed to insure
  ' all resources (props) are restored to the system.
  If msg = WM_DESTROY Then Call UnhookWindow(hWnd)
End Function

' **************************************************************
' Subclassing
' **************************************************************
Public Function WindowProc(hWnd As Long, msg As Long, wp As Long, lp As Long) As Long
  '
  ' VB Windows don't normally handle clipboard messages,
  ' so go ahead and let it do what it wants to first.
  '
  ' This routine is provided for the handler to call whenever they want
  ' to pass message handling off to the default window procedure.
  WindowProc = CallWindowProc(lpPrevWndProc, hWnd, msg, wp, lp)
  '
  ' Take appropriate action based on incoming message.
  '
  ' Each window that receives the either of these messages should
  ' call the SendMessage function to pass the message on to the
  ' next window in the clipboard-viewer chain.

  Select Case msg
    Case WM_CHANGECBCHAIN
      '
      ' If the window being removed is the next window in the
      ' chain, the window specified by the m_hWndNext parameter
      ' becomes the next window and clipboard messages are
      ' passed on to it.
      '
      If wp = m_hWndNext Then
        m_hWndNext = lp
      End If
      Call SendMessage(m_hWndNext, msg, wp, lp)

    Case WM_DRAWCLIPBOARD
      ' Contents of clipboard have changed.
      ' Call routine to read.

      Call RefreshClipboardDataFormats

      Call SendMessage(m_hWndNext, msg, wp, lp)
  End Select
End Function

'//Simplify data of CF_HDROP format and display
Public Function DisplayFileList(txt As TextBox) As Boolean
  Dim hDrop As Long
  Dim nFiles As Long
  Dim i As Long
  Dim desc As String
  Dim filename As String
  Const MAX_PATH = 260

  SetStockFont txt, sfSystemFixed

  filename = Space(MAX_PATH)

  If OpenClipboard(0&) Then
    hDrop = GetClipboardData(CF_HDROP)
    nFiles = DragQueryFile(hDrop, -1&, "", 0)
    For i = 0 To nFiles - 1
      Call DragQueryFile(hDrop, i, filename, Len(filename))
      desc = desc & TrimNull(filename) & vbCrLf
    Next i
    txt.Text = desc
    Call CloseClipboard
    DisplayFileList = True
    objForm.Caption = "CF_HDROP"
  End If
End Function

'//Simplify data of CF_LOCALE format and display
Public Function DisplayLocale(txt As TextBox) As Boolean
  Dim msg As String
  Dim nRet As Long
  Dim LCID As Long

  SetStockFont txt, sfAnsiFixed

  If OpenClipboard(0&) Then
    nRet = GetClipboardData(CF_LOCALE)
    CopyMem LCID, ByVal nRet, 4
    txt.Text = LocaleDescLong(LCID)
    Call CloseClipboard
    DisplayLocale = True
    objForm.Caption = "CF_LOCALE"
  End If
End Function

Public Function DisplayText(ByVal nFmt As Long, txt As TextBox) As Boolean
  txt.Text = Clipboard.GetText()
  Select Case nFmt
    Case CF_TEXT
      SetStockFont txt, sfAnsiFixed
      objForm.Caption = "CF_TEXT"
    Case CF_UNICODETEXT
      SetStockFont txt, sfAnsiFixed
      objForm.Caption = "CF_UNICODETEXT"
    Case CF_OEMTEXT
      SetStockFont txt, sfOemFixed
      objForm.Caption = "CF_OEMTEXT"
    Case CF_DSPTEXT
      SetStockFont txt, sfDeviceDefault
      objForm.Caption = "CF_DSPTEXT"
  End Select
  DisplayText = True
End Function

Public Function DisplayPicture(ByVal nFmt As Long, pic As PictureBox) As Boolean
  Select Case nFmt
    Case CF_ENHMETAFILE
      DisplayPicture = PaintEnhMetafile(pic)
      objForm.Caption = "CF_ENHMETAFILE"
    Case CF_METAFILEPICT
      DisplayPicture = PaintMetafile(pic)
      objForm.Caption = "CF_METAFILEPICT"
    Case CF_BITMAP
      pic.Picture = Clipboard.GetData(CF_BITMAP)
      objForm.Caption = "CF_BITMAP"
      DisplayPicture = True
    Case CF_DSPBITMAP
      pic.Picture = Clipboard.GetData(CF_BITMAP)
      objForm.Caption = "CF_DSPBITMAP"
      DisplayPicture = True
    Case CF_DSPMETAFILEPICT
      DisplayPicture = PaintMetafile(pic)
      objForm.Caption = "CF_DSPMETAFILEPICT"
  End Select
End Function

Public Function DisplayPalette(pic As PictureBox) As Boolean
  DisplayPalette = PaintPalette(pic)
  objForm.Caption = "CF_PALETTE"
End Function

Public Function DisplayOwnerDisplay(pic As PictureBox) As Boolean
  Dim hWndOwner As Long
  Dim hGlb As Long
  Dim rClient As RECT
  Dim ps As PAINTSTRUCT
  Dim lpps As Long
  Dim nRet As Long

  Call GetClientRect(pic.hWnd, rClient)
  hGlb = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, Len(rClient))
  nRet = GlobalLock(hGlb)
  Call CopyMem(nRet, rClient, Len(rClient))
  hWndOwner = GetClipboardOwner()
  Call SendMessage(hWndOwner, WM_SIZECLIPBOARD, pic.Parent.hWnd, ByVal hGlb)
  Call GlobalUnlock(hGlb)
  Call GlobalFree(hGlb)

  hGlb = GlobalAlloc(GMEM_DDESHARE, Len(ps))
  lpps = GlobalLock(hGlb)

  ps.hdc = pic.hdc
  ps.fErase = True
  ps.rcPaint = rClient
  hGlb = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, Len(ps))
  nRet = GlobalLock(hGlb)
  Call CopyMem(nRet, ps, Len(ps))
  Call SendMessage(hWndOwner, WM_PAINTCLIPBOARD, pic.Parent.hWnd, ByVal hGlb)
  Call GlobalUnlock(hGlb)
  Call GlobalFree(hGlb)

  objForm.Caption = "CF_OWNERDRAW"
  DisplayOwnerDisplay = True
End Function

' ****************************************************
' Clipboard manipulation routines (Public )
' ****************************************************
Public Function PaintPalette(pic As PictureBox) As Boolean
  Dim i As Long, j As Long

  With pic
    .Picture = Clipboard.GetData(vbCFPalette)
    .ScaleWidth = 16
    .ScaleHeight = 16
    For i = 0 To 15
      For j = 0 To 15
        pic.Line (j, i)-(j + 1, i + 1), &H1000000 + (j + i * 16), BF
      Next j
    Next i
  End With
  PaintPalette = True
End Function

Public Function PaintEnhMetafile(pic As PictureBox) As Boolean
  Dim hEmf As Long
  Dim emh As ENHMETAHEADER

  If OpenClipboard(0&) Then
    hEmf = GetClipboardData(CF_ENHMETAFILE)
    Call GetEnhMetaFileHeader(hEmf, Len(emh), emh)
    PaintEnhMetafile = PlayEnhMetaFile(pic.hdc, hEmf, emh.rclBounds)
    Call CloseClipboard
    pic.Refresh
  End If
End Function

Public Function PaintMetafile(pic As PictureBox) As Boolean
  pic.Picture = Clipboard.GetData(vbCFMetafile)
  PaintMetafile = True
  '//TO DO : Draw Meta file

End Function
Public Function GetClipFormatName(ByVal nFmt As Long)
  Dim nRet
  Dim sFmt As String
  Select Case nFmt
    Case CF_TEXT
      sFmt = "CF_TEXT : Text (TXT)"
    Case CF_BITMAP
      sFmt = "CF_BITMAP : Bitmap (BMP)"
    Case CF_METAFILEPICT
      sFmt = "CF_METAFILEPICT : Metafile (WMF)"
    Case CF_SYLK
      sFmt = "CF_SYLK : Microsoft Symbolic Link (SYLK)"
    Case CF_DIF
      sFmt = "CF_DIF : Data Interchange Format (DIF)"
    Case CF_TIFF
      sFmt = "CF_TIFF : Tagged Interchange File Format (TIF)"
    Case CF_OEMTEXT
      sFmt = "CF_OEMTEXT : OEM Text"
    Case CF_DIB
      sFmt = "CF_DIB : Device Independent Bitmap (DIB)"
    Case CF_PALETTE
      sFmt = "CF_PALETTE : Palette"
    Case CF_PENDATA
      sFmt = "CF_PENDATA : Pen Data"
    Case CF_RIFF
      sFmt = "CF_RIFF : RIFF"
    Case CF_WAVE
      sFmt = "CF_WAVE : Wave"
    Case CF_UNICODETEXT
      sFmt = "CF_UNICODETEXT : Unicode Text"
    Case CF_ENHMETAFILE
      sFmt = "CF_ENHMETAFILE : Enhanced Metafile (EMF)"
    Case CF_HDROP
      sFmt = "CF_HDROP : Dropped Filelist"
    Case CF_LOCALE
      sFmt = "CF_LOCALE : Locale Identifier"
    Case Else
      sFmt = Space(256)
      nRet = GetClipboardFormatName(nFmt, sFmt, Len(sFmt))
      If nRet = 0 Then
        sFmt = "Custom : " & CStr(nFmt)
      Else
        sFmt = "Custom : " & Left$(sFmt, nRet) & " (" & CStr(nFmt) & ")"
      End If
  End Select
  GetClipFormatName = sFmt
End Function

Public Function RefreshClipboardDataFormats() As Boolean
  Dim lR As Long
  Dim iCount As Long
  Dim PriorityList(0 To 20) As Long

  Dim lSelect As Long

  objForm.List1.Clear

  If CountClipboardFormats <= 0 Then
    objForm.Caption = "ClipBoard is empty"
    Exit Function
  End If

  '//Define clipboard format priorities
  PriorityList(0) = CF_OWNERDISPLAY
  PriorityList(1) = CF_TEXT
  PriorityList(2) = CF_ENHMETAFILE
  PriorityList(3) = CF_BITMAP
  PriorityList(4) = CF_HDROP

  m_PriorityClipFmt = GetPriorityClipboardFormat(PriorityList(0), 5)

  If (OpenClipboard(objForm.hWnd)) Then

    lR = EnumClipboardFormats(0)

    If (lR <> 0) Then
      Do
        iCount = iCount + 1
        objForm.List1.AddItem GetClipFormatName(lR)
        objForm.List1.ItemData(objForm.List1.NewIndex) = lR
        '//Select This Format and display data
        If m_PriorityClipFmt = lR Then lSelect = objForm.List1.NewIndex
        lR = EnumClipboardFormats(lR)
      Loop While lR <> 0
    End If
  End If
  CloseClipboard

  objForm.List1.ListIndex = lSelect

End Function

' ****************************************************
' String manipulation routines (public)
' ****************************************************
Public Function TrimNull(ByVal StrIn As String) As String
  Dim nul As Long

  ' Truncate input string at first null.
  ' If no nulls, perform ordinary Trim.
  '
  nul = InStr(StrIn, vbNullChar)
  Select Case nul
    Case Is > 1
      TrimNull = Left(StrIn, nul - 1)
    Case 1
      TrimNull = ""
    Case 0
      TrimNull = Trim(StrIn)
  End Select
End Function

Public Function LocaleDescLong(ByVal LCID As Long) As String
  Dim buf As String
  Dim desc As String
  Dim nRet As Long

  nRet = GetLocaleInfo(LCID, LOCALE_ILANGUAGE, buf, 0)
  buf = Space$(nRet)
  Call GetLocaleInfo(LCID, LOCALE_ILANGUAGE, buf, Len(buf))
  desc = desc & "Locale ID: " & TrimNull(buf) & vbCrLf

  nRet = GetLocaleInfo(LCID, LOCALE_SCOUNTRY, buf, 0)
  buf = Space$(nRet)
  Call GetLocaleInfo(LCID, LOCALE_SCOUNTRY, buf, Len(buf))
  desc = desc & "Country: " & TrimNull(buf) & " "

  '// ....
  '// ....
  '// TO DO : Do the same for all other Local Info Types
  '// ....
  '// ....

  LocaleDescLong = desc
End Function

Function SetStockFont(txt As TextBox, sfType As StockFonts)
  Dim hFont As Long
  ' Select the stock font into the client textbox
  ' Always use DeleteObject to clean up

  hFont = GetStockObject(sfType)
  Call SendMessage(txt.hWnd, WM_SETFONT, hFont, False)
  Call DeleteObject(hFont)
End Function

- Now press F5 to run the demo. Try to copy some content from word, excel or some html page and see the application window (for most easy demo press print screen)