www.pudn.com > Super_richBoxall.zip > mWinGeneral.bas

Attribute VB_Name = "mGeneral" 
Option Explicit 
 
' Types 
Public Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
Public Type POINTAPI 
    x As Long 
    y As Long 
End Type 
Public Type MINMAXINFO 
    ptReserved As POINTAPI 
    ptMaxSize As POINTAPI 
    ptMaxPosition As POINTAPI 
    ptMinTrackSize As POINTAPI 
    ptMaxTrackSize As POINTAPI 
End Type 
 
' Messages: 
Public Const WM_ACTIVATE = &H6 
Public Const WM_SETFOCUS = &H7 
Public Const WM_KILLFOCUS = &H8F 
Public Const WM_SETREDRAW = &HB 
Public Const WM_GETTEXTLENGTH = &HE 
Public Const WM_PAINT = &HF 
Public Const WM_ERASEBKGND = &H14 
Public Const WM_SETCURSOR = &H20 
Public Const WM_MOUSEACTIVATE = &H21 
Public Const WM_GETMINMAXINFO = &H24 
Public Const WM_WINDOWPOSCHANGING = &H46 
Public Const WM_NOTIFY = &H4E 
Public Const WM_NCHITTEST = &H84 
Public Const WM_NCPAINT = &H85 
Public Const WM_KEYDOWN = &H100 
Public Const WM_KEYUP = &H101 
Public Const WM_CHAR = &H102 
Public Const WM_COMMAND = &H111 
Public Const WM_HSCROLL = &H114 
Public Const WM_VSCROLL = &H115 
Public Const WM_SYSCOMMAND = &H112 
Public Const WM_MOUSEMOVE = &H200 
Public Const WM_LBUTTONDOWN = &H201 
Public Const WM_LBUTTONUP = &H202 
Public Const WM_LBUTTONDBLCLK = &H203 
Public Const WM_RBUTTONDOWN = &H204 
Public Const WM_RBUTTONUP = &H205 
Public Const WM_RBUTTONDBLCLK = &H206 
Public Const WM_MBUTTONDOWN = &H207 
Public Const WM_MBUTTONUP = &H208 
Public Const WM_PARENTNOTIFY = &H210 
Public Const WM_EXITSIZEMOVE = &H232 
Public Const WM_UNDO = &H304& 
Public Const WM_CUT = &H300& 
Public Const WM_COPY = &H301& 
Public Const WM_PASTE = &H302& 
Public Const WM_USER = &H400 
 
' Memory functions: 
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 GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 
Public Declare Function GlobalReAlloc Lib "kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags 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 Const GMEM_DDESHARE = &H2000 
Public Const GMEM_DISCARDABLE = &H100 
Public Const GMEM_DISCARDED = &H4000 
Public Const GMEM_FIXED = &H0 
Public Const GMEM_INVALID_HANDLE = &H8000 
Public Const GMEM_LOCKCOUNT = &HFF 
Public Const GMEM_MODIFY = &H80 
Public Const GMEM_MOVEABLE = &H2 
Public Const GMEM_NOCOMPACT = &H10 
Public Const GMEM_NODISCARD = &H20 
Public Const GMEM_NOT_BANKED = &H1000 
Public Const GMEM_NOTIFY = &H4000 
Public Const GMEM_SHARE = &H2000 
Public Const GMEM_VALID_FLAGS = &H7F72 
Public Const GMEM_ZEROINIT = &H40 
Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT) 
Public Const GMEM_LOWER = GMEM_NOT_BANKED 
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _ 
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) 
Public Declare Sub CopyMemoryStr Lib "kernel32" Alias "RtlMoveMemory" ( _ 
    lpvDest As Any, ByVal lpvSource As String, ByVal cbCopy As Long) 
Public Declare Sub CopyMemoryToStr Lib "kernel32" Alias "RtlMoveMemory" ( _ 
    ByVal lpvDest As String, pvSource As Any, ByVal cbCopy As Long) 
 
' General WinAPI functions: 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Public Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long 
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long 
Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long 
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long 
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long 
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long 
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long 
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long 
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long 
Public Declare Function WindowFromPointXY Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long 
Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
Public Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long 
Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function ReleaseCapture Lib "user32" () As Long 
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long 
Public Declare Function InvalidateRectAsNull Lib "user32" Alias "InvalidateRect" (ByVal hwnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long 
Public Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) 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 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Any) As Long 
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long 
Public Declare Function GetFocus Lib "user32" () As Long 
Public Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE 
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED 
Public Const SWP_NOACTIVATE = &H10 
Public Const SWP_NOMOVE = &H2 
Public Const SWP_NOSIZE = &H1 
Public Const SWP_NOZORDER = &H4 
Public Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering 
 
Public Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long 
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long 
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long 
 
' Graphics sort of functions 
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long 
Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long 
Public Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long 
Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hinst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long 
Public Declare Function LoadImageLong Lib "user32" Alias "LoadImageA" (ByVal hinst As Long, ByVal lpsz As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long 
Public Const CF_BITMAP = 2 
Public Const LR_LOADMAP3DCOLORS = &H1000 
Public Const LR_LOADFROMFILE = &H10 
Public Const LR_LOADTRANSPARENT = &H20 
Public Const IMAGE_BITMAP = 0 
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long 
Public Const HORZRES = 8            '  Horizontal width in pixels 
Public Const VERTRES = 10           '  Vertical width in pixels 
Public Const LOGPIXELSX = 88        '  Logical pixels/inch in X 
Public Const LOGPIXELSY = 90        '  Logical pixels/inch in Y 
Public Const PHYSICALOFFSETX = 112 '  Physical Printable Area x margin 
Public Const PHYSICALOFFSETY = 113 '  Physical Printable Area y margin 
Public Const PHYSICALHEIGHT = 111 '  Physical Height in device units 
Public Const PHYSICALWIDTH = 110 '  Physical Width in device units 
Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long 
Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long 
Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) As Long 
Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) As Long 
Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) As Long 
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long 
Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long 
Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long 
Declare Function SetViewportOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As Any) As Long 
Public Const MM_TEXT = 1 
Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long 
 
' Printing support: 
 
' VB API VIEWER VERSION OF DOCINFO STRUCTURE IS WRONG! 
Type DOCINFO 
    cbSize As Long 
    lpszDocName As Long 
    lpszOutput As Long 
End Type 
Type PrintDlg 
    lStructSize As Long 
    hWndOwner As Long 
    hDevMode As Long 
    hDevNames As Long 
    hdc As Long 
    flags As Long 
    nFromPage As Integer 
    nToPage As Integer 
    nMinPage As Integer 
    nMaxPage As Integer 
    nCopies As Integer 
    hInstance As Long 
    lCustData As Long 
    lpfnPrintHook As Long 
    lpfnSetupHook As Long 
    lpPrintTemplateName As String 
    lpSetupTemplateName As String 
    hPrintTemplate As Long 
    hSetupTemplate As Long 
End Type 
Public Declare Function PrintDlg Lib "COMDLG32.DLL" _ 
    Alias "PrintDlgA" (prtdlg As PrintDlg) As Long 
Public Enum EPrintDialog 
    PD_ALLPAGES = &H0 
    PD_SELECTION = &H1 
    PD_PAGENUMS = &H2 
    PD_NOSELECTION = &H4 
    PD_NOPAGENUMS = &H8 
    PD_COLLATE = &H10 
    PD_PRINTTOFILE = &H20 
    PD_PRINTSETUP = &H40 
    PD_NOWARNING = &H80 
    PD_RETURNDC = &H100 
    PD_RETURNIC = &H200 
    PD_RETURNDEFAULT = &H400 
    PD_SHOWHELP = &H800 
    PD_ENABLEPRINTHOOK = &H1000 
    PD_ENABLESETUPHOOK = &H2000 
    PD_ENABLEPRINTTEMPLATE = &H4000 
    PD_ENABLESETUPTEMPLATE = &H8000 
    PD_ENABLEPRINTTEMPLATEHANDLE = &H10000 
    PD_ENABLESETUPTEMPLATEHANDLE = &H20000 
    PD_USEDEVMODECOPIES = &H40000 
    PD_USEDEVMODECOPIESANDCOLLATE = &H40000 
    PD_DISABLEPRINTTOFILE = &H80000 
    PD_HIDEPRINTTOFILE = &H100000 
    PD_NONETWORKBUTTON = &H200000 
End Enum 
 
Public Const SC_MOVE = &HF012 
 
Public Const COLOR_WINDOWFRAME = 6 
Public Const COLOR_BTNFACE = 15 
Public Const COLOR_BTNTEXT = 18 
 
Public Type PAINTSTRUCT 
   hdc As Long 
   fErase As Long 
   rcPaint As RECT 
   fRestore As Long 
   fIncUpdate As Long 
   rgbReserved(0 To 31) As Byte 
End Type 
Public Type BITMAP 
    bmType As Long 
    bmWidth As Long 
    bmHeight As Long 
    bmWidthBytes As Long 
    bmPlanes As Integer 
    bmBitsPixel As Integer 
    bmBits As Long 
End Type 
Public Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long 
Public Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long 
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long 
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long 
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long 
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long 
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long 
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long 
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long 
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long 
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long 
Public Declare Function GetDesktopWindow Lib "user32" () As Long 
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
Public Const SM_CYHSCROLL = 3 
Public Const SM_CXVSCROLL = 2 
 
'Window Styles: 
Public Const WS_CHILD = &H40000000 
Public Const WS_HSCROLL = &H100000 
Public Const WS_VSCROLL = &H200000 
Public Const WS_VISIBLE = &H10000000 
Public Const WS_CLIPCHILDREN = &H2000000 
Public Const WS_CLIPSIBLINGS = &H4000000 
Public Const WS_BORDER = &H800000 
Public Const WS_TABSTOP = &H10000 
Public Const WS_POPUP = &H80000000 
Public Const WS_SYSMENU = &H80000 
Public Const WS_THICKFRAME = &H40000 
Public Const WS_MINIMIZEBOX = &H20000 
Public Const WS_MAXIMIZEBOX = &H10000 
Public Const WS_DLGFRAME = &H400000 
 
Public Const WS_EX_TOPMOST = &H8& 
Public Const WS_EX_CLIENTEDGE = &H200& 
Public Const WS_EX_TRANSPARENT = &H20& 
 
Public Const GWL_STYLE = (-16) 
Public Const GWL_EXSTYLE = (-20) 
Public Const GWL_USERDATA = (-21) 
Public Const GWL_WNDPROC = -4 
Public Const GWL_HWNDPARENT = (-8) 
 
Public Const HWND_TOPMOST = -1 
Public Const SW_SHOW = 5 
Public Const SW_HIDE = 0 
Public Const SW_SHOWNORMAL = 1 
Public Const GW_CHILD = 5 
Public Const GW_HWNDNEXT = 2 
Public Const CW_USEDEFAULT  As Long = &H80000000 
Public Const GDI_ERROR = &HFFFF 
 
' mouse activate responses 
Public Const MA_ACTIVATE = 1 
Public Const MA_ACTIVATEANDEAT = 2 
Public Const MA_NOACTIVATE = 3 
Public Const MA_NOACTIVATEANDEAT = 4 
 
Public Const H_MAX As Long = &HFFFF + 1 
  
Private 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 
Private Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, lpParameters As Any, lpDirectory As Any, ByVal nShowCmd As Long) As Long 
Public Enum EShellShowConstants 
    essSW_HIDE = 0 
    essSW_MAXIMIZE = 3 
    essSW_MINIMIZE = 6 
    essSW_SHOWMAXIMIZED = 3 
    essSW_SHOWMINIMIZED = 2 
    essSW_SHOWNORMAL = 1 
    essSW_SHOWNOACTIVATE = 4 
    essSW_SHOWNA = 8 
    essSW_SHOWMINNOACTIVE = 7 
    essSW_SHOWDEFAULT = 10 
    essSW_RESTORE = 9 
    essSW_SHOW = 5 
End Enum 
Private Const ERROR_FILE_NOT_FOUND = 2& 
Private Const ERROR_PATH_NOT_FOUND = 3& 
Private Const ERROR_BAD_FORMAT = 11& 
Private Const SE_ERR_ACCESSDENIED = 5        ' access denied 
Private Const SE_ERR_ASSOCINCOMPLETE = 27 
Private Const SE_ERR_DDEBUSY = 30 
Private Const SE_ERR_DDEFAIL = 29 
Private Const SE_ERR_DDETIMEOUT = 28 
Private Const SE_ERR_DLLNOTFOUND = 32 
Private Const SE_ERR_FNF = 2                ' file not found 
Private Const SE_ERR_NOASSOC = 31 
Private Const SE_ERR_PNF = 3                ' path not found 
Private Const SE_ERR_OOM = 8                ' out of memory 
Private Const SE_ERR_SHARE = 26 
 
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 
' Virtual key code constants: 
Public Const VK_SHIFT = &H10& 
Public Const VK_CONTROL = &H11& 
Public Const VK_MENU = &H12& ' Alt key 
 
Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) 
Public Const MOUSEEVENTF_ABSOLUTE = &H8000 '  absolute move 
Public Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down 
Public Const MOUSEEVENTF_LEFTUP = &H4 '  left button up 
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 '  middle button down 
Public Const MOUSEEVENTF_MIDDLEUP = &H40 '  middle button up 
Public Const MOUSEEVENTF_MOVE = &H1 '  mouse move 
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 '  right button down 
Public Const MOUSEEVENTF_RIGHTUP = &H10 '  right button up 
 
Public Type OVERLAPPED 
    Internal As Long 
    InternalHigh As Long 
    offset As Long 
    OffsetHigh As Long 
    hEvent As Long 
End Type 
Public Const OFS_MAXPATHNAME = 128 
Public Type OFSTRUCT 
    cBytes As Byte 
    fFixedDisk As Byte 
    nErrCode As Integer 
    Reserved1 As Integer 
    Reserved2 As Integer 
    szPathName(OFS_MAXPATHNAME) As Byte 
End Type 
' Streaming support: 
Public Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long 'lpOverlapped As OVERLAPPED) As Long 
Public Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long 
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long 'lpOverlapped As OVERLAPPED) As Long 
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 
Public Const OF_CANCEL = &H800 
Public Const OF_CREATE = &H1000 
Public Const OF_DELETE = &H200 
Public Const OF_EXIST = &H4000 
Public Const OF_PARSE = &H100 
Public Const OF_PROMPT = &H2000 
Public Const OF_REOPEN = &H8000 
Public Const OF_SHARE_COMPAT = &H0 
Public Const OF_SHARE_DENY_NONE = &H40 
Public Const OF_SHARE_DENY_READ = &H30 
Public Const OF_SHARE_DENY_WRITE = &H20 
Public Const OF_SHARE_EXCLUSIVE = &H10 
Public Const OF_VERIFY = &H400 
Public Const OF_WRITE = &H1 
Public Const OF_READ = &H0 
Public Const OF_READWRITE = &H2 
 
 
Public Function ShellEx( _ 
        ByVal sFile As String, _ 
        Optional ByVal eShowCmd As EShellShowConstants = essSW_SHOWDEFAULT, _ 
        Optional ByVal sParameters As String = "", _ 
        Optional ByVal sDefaultDir As String = "", _ 
        Optional sOperation As String = "open", _ 
        Optional Owner As Long = 0 _ 
    ) As Boolean 
Dim lR As Long 
Dim lErr As Long, sErr As Long 
    If (InStr(UCase$(sFile), ".EXE") <> 0) Then 
        eShowCmd = 0 
    End If 
    On Error Resume Next 
    If (sParameters = "") And (sDefaultDir = "") Then 
        lR = ShellExecuteForExplore(Owner, sOperation, sFile, 0, 0, essSW_SHOWNORMAL) 
    Else 
        lR = ShellExecute(Owner, sOperation, sFile, sParameters, sDefaultDir, eShowCmd) 
    End If 
    If (lR < 0) Or (lR > 32) Then 
        ShellEx = True 
    Else 
        ' raise an appropriate error: 
        lErr = vbObjectError + 1048 + lR 
        Select Case lR 
        Case 0 
            lErr = 7: sErr = "Out of memory" 
        Case ERROR_FILE_NOT_FOUND 
            lErr = 53: sErr = "File not found" 
        Case ERROR_PATH_NOT_FOUND 
            lErr = 76: sErr = "Path not found" 
        Case ERROR_BAD_FORMAT 
            sErr = "The executable file is invalid or corrupt" 
        Case SE_ERR_ACCESSDENIED 
            lErr = 75: sErr = "Path/file access error" 
        Case SE_ERR_ASSOCINCOMPLETE 
            sErr = "This file type does not have a valid file association." 
        Case SE_ERR_DDEBUSY 
            lErr = 285: sErr = "The file could not be opened because the target application is busy. Please try again in a moment." 
        Case SE_ERR_DDEFAIL 
            lErr = 285: sErr = "The file could not be opened because the DDE transaction failed. Please try again in a moment." 
        Case SE_ERR_DDETIMEOUT 
            lErr = 286: sErr = "The file could not be opened due to time out. Please try again in a moment." 
        Case SE_ERR_DLLNOTFOUND 
            lErr = 48: sErr = "The specified dynamic-link library was not found." 
        Case SE_ERR_FNF 
            lErr = 53: sErr = "File not found" 
        Case SE_ERR_NOASSOC 
            sErr = "No application is associated with this file type." 
        Case SE_ERR_OOM 
            lErr = 7: sErr = "Out of memory" 
        Case SE_ERR_PNF 
            lErr = 76: sErr = "Path not found" 
        Case SE_ERR_SHARE 
            lErr = 75: sErr = "A sharing violation occurred." 
        Case Else 
            sErr = "An error occurred occurred whilst trying to open or print the selected file." 
        End Select 
                 
        Err.Raise lErr, , App.EXEName & ".GShell", sErr 
        ShellEx = False 
    End If 
 
End Function 
Public Function giGetShiftState() As Integer 
Dim iR As Integer 
Dim lR As Long 
Dim lKey As Long 
    iR = iR Or (-vbShiftMask * gbKeyIsPressed(VK_SHIFT)) 
    iR = iR Or (-vbAltMask * gbKeyIsPressed(VK_MENU)) 
    iR = iR Or (-vbCtrlMask * gbKeyIsPressed(VK_CONTROL)) 
    giGetShiftState = iR 
 
End Function 
Public Function giGetMouseButton() As Integer 
Dim iR As Integer 
   iR = iR Or (-vbLeftButton * gbKeyIsPressed(vbKeyLButton)) 
   iR = iR Or (-vbMiddleButton * gbKeyIsPressed(vbKeyMButton)) 
   iR = iR Or (-vbRightButton * gbKeyIsPressed(vbKeyRButton)) 
   giGetMouseButton = iR 
    
End Function 
Public Function gbKeyIsPressed( _ 
        ByVal nVirtKeyCode As KeyCodeConstants _ 
    ) As Boolean 
Dim lR As Long 
    lR = GetAsyncKeyState(nVirtKeyCode) 
    If (lR And &H8000&) = &H8000& Then 
        gbKeyIsPressed = True 
    End If 
End Function 
 
 
Public Function TranslateColor(ByVal clr As OLE_COLOR, _ 
                        Optional hPal As Long = 0) As Long 
    If OleTranslateColor(clr, hPal, TranslateColor) Then 
        TranslateColor = -1 
    End If 
End Function