H o w     t o ... ,

Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lparam As Long)
Private Const EC_LEFTMARGIN& = &H1&
Private Const EC_RIGHTMARGIN& = &H2&
Private Const EM_SETMARGINS = &HD3&

Private Sub SetTextMargin(T As TextBox, ByVal mLeft As Integer, ByVal mRight As Integer)
  Dim lparam As Long
  lparam = mLeft + mRight * &H10000
  SendMessageBynum T.hwnd, EM_SETMARGINS, EC_LEFTMARGIN Or EC_RIGHTMARGIN, lparam
End Sub

Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByVal lparam As Long)
Private Const EM_UNDO = &HC7&

Private Sub TextUndo(T As TextBox)
  SendMessageBynum T.hwnd, EM_UNDO, 0, 0
End Sub

Private Const HTCAPTION& = 2
Private Const WM_NCLBUTTONDOWN& = &HA1
Private Declare Function SendMessageBynum& Lib "user32" _
    Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long)
Private Declare Function ReleaseCapture& Lib "user32" ()

Public Sub StartMove(frm As Form)
  ReleaseCapture
  SendMessageBynum frm.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Private Const PLANES& = 14
Private Const BITSPIXEL& = 12
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long)

Private Function ColorDepth() As Integer
  Dim nPlanes As Integer, BitsPerPixel As Integer, dc As Long
  dc = GetDC(0)
  nPlanes = GetDeviceCaps(dc, PLANES)
  BitsPerPixel = GetDeviceCaps(dc, BITSPIXEL)
  ReleaseDC 0, dc
  ColorDepth = nPlanes * BitsPerPixel
End Function

Private Const LOCALE_USER_DEFAULT& = &H400
Private Const LOCALE_SDECIMAL& = &HE
Private Const LOCALE_STHOUSAND& = &HF
Private Declare Function GetLocaleInfo& Lib "kernel32" Alias _
    "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, _
    ByVal lpLCData As String, ByVal cchData As Long)

Private Function ThousandSeparator() As String
  Dim r As Long, s As String
  s = String(10, "a")
  r = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, s, 10)
  ThousandSeparator = Left$(s, r)
End Function

Private Function DecimalSeparator() As String
  Dim r As Long, s As String
  s = String(10, "a")
  r = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, s, 10)
  DecimalSeparator = Left$(s, r)
End Function

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      If Button = vbRightButton Then
      ' Avoid the 'disabled' gray text by locking updates
      LockWindowUpdate Text1.hWnd
      ' A disabled TextBox will not display a context menu
      Text1.Enabled = False      ' Give the previous line time to complete
      DoEvents      ' Display own context menu
      PopupMenu MyPopUpMenu
      ' Enable the control again
      Text1.Enabled = True      ' Unlock updates
      LockWindowUpdate 0&
    End If
End Sub

Private Const FORMAT_MESSAGE_FROM_SYSTEM& = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS& = &H200
Private Declare Function FormatMessage& Lib "kernel32" Alias _
    "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, _
    ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
    ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long)

Public Function APIerrorDescription(ByVal code As Long) As String
  Dim msg As String, r As Long
  msg = String(256, 0)
  r = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
    FORMAT_MESSAGE_IGNORE_INSERTS, ByVal 0, code, 0, msg, 256, ByVal 0)
  If r Then APIerrorDescription = Left$(msg, r)
End Function

Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Const DT_SINGLELINE& = &H20
Private Const DT_CENTER& = &H1
Private Const DT_VCENTER& = &H4
Private Const TRANSPARENT& = 1
Private Declare Function SetBkMode& Lib "gdi32" (ByVal hdc As Long,  _
ByVal nBkMode As Long)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function DrawText& Lib "user32" Alias "DrawTextA" _
(ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long)

Private Sub Command1_GotFocus()
  Timer1.Enabled = True
End Sub

Private Sub Command1_LostFocus()
  Timer1.Enabled = True
End Sub

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer,  _
x As Single, y As Single)
  PaintCaption Command1, 2, 2, vbRed
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, _
x As Single, y As Single)
  PaintCaption Command1, 0, 0, vbRed
End Sub

Private Sub Form_Paint()
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
  PaintCaption Command1, 0, 0, vbRed
  Timer1.Enabled = False
End Sub

Private Sub PaintCaption(btn As CommandButton, ByVal x As Long, _
ByVal y As Long, clr As Long)
  Dim dc As Long, re As RECT
  dc = GetDC(btn.hwnd)
  SetTextColor dc, clr
  SetBkMode dc, TRANSPARENT
  re.Left = x
  re.Top = y
  re.Bottom = btn.Height
  re.Right = btn.Width
  DrawText dc, btn.Tag, -1, re, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
End Sub

Private Declare Function DllRegisterServer_exemplu Lib _
  "Exemplu_dvs.ocx" Alias "DllRegisterServer" () As Long

  Dim retval As Long
  retval = DllRegisterServer_exemplu

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CLEANBOOT = 67  

Private Sub Command1_Click()
       Select Case GetSystemMetrics(SM_CLEANBOOT)
              Case 1: Label1 = "Safe Mode."
              Case 2: Label1 = "Safe Mode with Network support."
              Case Else: Label1 = "Windows is running normally."
      End Select
End Sub  

Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)

Private Const SHARD_PIDL As Long = 1
Private Const SHARD_PATH As Long = 2

Call SHAddToRecentDocs(SHARD_PATH, vbNullString)

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long)
   As Integer
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14

Private Sub Command1_Click()
    Dim Key As Integer

    Key = GetKeyState(VK_NUMLOCK)
    If Key And 1 Then
        text1.Text = "Num Lock is On"
    Else
        text1.Text = "Num Lock is Off"
    End If

    Key = GetKeyState(VK_SCROLL)
    If Key And 1 Then
        Text2.Text = "Scroll Lock is On"
    Else
        Text2.Text = "Scroll Lock is Off"
    End If

    Key = GetKeyState(VK_CAPITAL)
    If Key And 1 Then
        Text3.Text = "Caps Lock is On"
    Else
        Text3.Text = "Caps Lock is Off"
    End If
End Sub

Path is in text1 and it's ending with "\"

Private Sub Command1_Click()
FillTreeView Text1.Text
End Sub

Private Sub FillTreeView(s As String)
tv1.Nodes.Clear
tv1.Nodes.Add , , "root", s
MyPath = s  ' Set the path.
myname = Dir(MyPath, vbDirectory)   ' Retrieve the first entry.
Do While myname <> ""   ' Start the loop.
    ' Ignore the current directory and the encompassing directory.
    If myname <> "." And myname <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.

If (GetAttr(MyPath & myname) And vbDirectory) = vbDirectory Then
            'Debug.Print MyName  ' Display entry only if it
            tv1.Nodes.Add "root", tvwChild, , myname
        End If  ' it represents a directory.
    End If
    myname = Dir    ' Get next entry.
Loop
End Sub