Attribute VB_Name = "Module1"
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const SYNCHRONIZE = &H100000
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

'API type definition
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

'API imported funtions
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Global Const RESIZE_TYPE = 0
Global Const RESIZEREGION_TYPE = 1

Global Const PAINT_AUTO = 0
Global Const PAINT_FIXED = 1
Global Const PAINT_NETSCAPE = 2

Global Const SO_LEAD = 0
Global Const SO_JFIF = 1
Global Const SO_JTIF = 2
Global Const SO_AWD = 3
Global Const SO_CALS = 4
Global Const SO_CUR = 5
Global Const SO_CCITT = 6
Global Const SO_DIC_GRAY = 7
Global Const SO_DIC_COLOR = 8
Global Const SO_EXIF = 9
Global Const SO_FAX = 10
Global Const SO_EPS = 11
Global Const SO_FPX = 12
Global Const SO_GEM = 13
Global Const SO_GIF = 14
Global Const SO_ICO = 15
Global Const SO_IOCA = 16
Global Const SO_PCT = 17
Global Const SO_MAC = 18
Global Const SO_MSP = 19
Global Const SO_OS2 = 20
Global Const SO_PCX = 21
Global Const SO_PNG = 22
Global Const SO_PSD = 23
Global Const SO_RAS = 24
Global Const SO_TGA = 25
Global Const SO_TIF = 26
Global Const SO_WBMP = 27
Global Const SO_WBMP_RLE = 28
Global Const SO_WFX = 29
Global Const SO_WMF = 30
Global Const SO_WPG = 31
Global Const NUM_SAVE_TYPES = 32
Global Const NUM_OPEN_TYPES = 25

Global Const QF_CUSTOM = 9

Global gDitheringType As Integer
Global gBitonalScaling As Integer
Global gPaintScaling As Integer
Global gPalette As Integer
Global gUseNetscape As Boolean
Global gNumChildren As Integer
Global gInProcess As Integer
Global gEndApp As Integer
Global gLoadRepaint As Boolean

Public Const BITSPIXEL = 12
Public Const PLANES = 14

Global Const IDM_TOOLNONE = 0
Global Const IDM_TOOLRECT = 1
Global Const IDM_TOOLELLIPSE = 2
Global Const IDM_TOOLRNDRECT = 3
Global Const IDM_TOOLFREEHAND = 4

Global Kids() As Variant

#If Win32 Then
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal aint As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#Else
Declare Function GetWindowText Lib "User" (ByVal hwnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer
Declare Function GetDeviceCaps Lib "GDI" (ByVal hdc As Integer, ByVal nIndex As Integer) As Integer
Declare Function GetDC Lib "User" (ByVal hwnd As Integer) As Integer
Declare Function ReleaseDC Lib "User" (ByVal hwnd As Integer, ByVal hdc As Integer) As Integer
#End If

Global Const UNITS_PER_INCH = 1000

'Stores iVal (1000ths of inches or pixels) in string szVal
Public Function UnitToString(ByVal iVal As Long, ByVal bInches As Boolean) As String
    Dim szVal As String
    Dim dVal As Double
   
    If (bInches = True) Then
        dVal = iVal / UNITS_PER_INCH
        szVal = CStr(dVal)
    Else 'pixels
        dVal = iVal
        szVal = CStr(dVal)
    End If
    UnitToString = szVal
End Function

'Converts szVal to 1000ths of inches or pixels
Public Function StringToUnit(iVal As Long, szVal As String, ByVal bInches As Boolean) As Boolean
    Dim dVal As Double
    Dim bRet As Boolean

    bRet = False
On Error GoTo STRTOUNITERR
    dVal = CDbl(szVal)
    bRet = True
On Error GoTo 0
    If (bInches = True) Then
        iVal = dVal * UNITS_PER_INCH
    Else
        iVal = dVal
    End If
STRTOUNITERR:
    StringToUnit = bRet
End Function

Public Function InchesToPixels(ByVal iInches As Long, ByVal iRes As Long) As Long
    Dim iPixels As Long

    iPixels = iInches * iRes / UNITS_PER_INCH
    InchesToPixels = iPixels
End Function

Public Function PixelsToInches(ByVal iPixels As Long, ByVal iRes As Long) As Long
    Dim iInches As Long

    iInches = iPixels * UNITS_PER_INCH / iRes
    PixelsToInches = iInches
End Function

Public Sub RegisterServerName(ByVal sServerName As String)
On Error GoTo ErrHandler

   Dim sExeFileName, sDefaultIcon, sOpen As String

   ''''''''''''''''''''''''''''''''''''''''''''''''
   sExeFileName = App.Path + "\" + App.EXEName + ".exe"
   sOpen = """" + sExeFileName + """ ""%1"""
   sDefaultIcon = """" + sExeFileName + """," + Str(-101)
   ''''''''''''''''''''''''''''''''''''''''''''''''
   
   Dim sRegisterKey(2) As String
   Dim sRegisterKeyDefaultValues(2) As String
   
   sRegisterKey(1) = "\shell\open\command"
   sRegisterKey(2) = "\DefaultIcon"
   
   sRegisterKeyDefaultValues(1) = sOpen
   sRegisterKeyDefaultValues(2) = sDefaultIcon
   
   'CREATE SERVER NODE
   Dim lRegKeyHandle As Long
   Dim lDisp As Long
   Dim SecurityAttr As SECURITY_ATTRIBUTES

   SecurityAttr.nLength = 0
   SecurityAttr.lpSecurityDescriptor = 0
   SecurityAttr.bInheritHandle = 0
   
   If 0 <> RegCreateKeyEx(&H80000000, sServerName, 0, "", 0, KEY_WRITE, SecurityAttr, lRegKeyHandle, lDisp) Then
      Exit Sub
   End If
   
   Call RegCloseKey(lRegKeyHandle)
   
   For k = 1 To 2
      Dim sKey As String
      
      sKey = sServerName + sRegisterKey(k)
      
      If 0 <> RegCreateKeyEx(&H80000000, sKey, 0, "", 0, KEY_WRITE, SecurityAttr, lRegKeyHandle, lDisp) Then
         Exit Sub
      End If
      
      Call RegSetValueEx(lRegKeyHandle, "", 0, 1, ByVal sRegisterKeyDefaultValues(k), Len(sRegisterKeyDefaultValues(k)))
      
      Call RegCloseKey(lRegKeyHandle)
      
   Next k

ErrHandler:

End Sub