Attribute VB_Name = "mod_LoadResEx"
' Copyright (C) 2004-2007 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA




' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues



'#LoadResEx_FlagA
'    1    LoadResEx_Picture
'   (2)  (LoadResEx_WinBitmap)
'    4    LoadResEx_Icon
'    8    ImageList
'   10    LoadResEx_Data
'   40    LoadResLanguageFile
'  100    LoadResEx_DialogStrings 'tooltips?
' 1000    LoadResEx_Menu + All generic API
' 7FFF  = max!

Option Explicit
Option Base 0

#Const LogWhatCaptioned = True
Private Const MissingPrefix As String = "#"

#If (LoadResEx_FlagA And &H100&) = &H100& Then
  Private Const ReplaceExString As String = "$"
  Private Const ReplaceExStringASC As Long = 36&
  Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
  Private Declare Function GetWindowTextA Lib "user32.dll" (ByVal hwnd As Long, lpString As Any, ByVal cch As Long) As Long
  Private Declare Function SetWindowTextA Lib "user32.dll" (ByVal hwnd As Long, lpString As Any) As Long
  #End If

Private Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

#If (LoadResEx_FlagA And &H40&) = &H40& Then
  Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  Private Declare Function LoadStringA Lib "user32" (ByVal hInstance As Long, ByVal wID As Long, lpBuffer As Any, ByVal nBufferMax As Long) As Long
  Public LoadResEx_LanguageFile_hModul As Long
  Private ptrTemp As Long
  #End If

#If Not (LoadResEx_FlagA And &H140&) = &H0& Or LoadResEx_FlagA = 0& Then
  Private Const ptrTempSize As Long = 6400&
  Private Const ptrTempSizeX As Long = ptrTempSize - 1&
  
  Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
  #End If

#If (LoadResEx_FlagA And &H10&) = &H10& Then
  Private Declare Function FindResourceA Lib "kernel32" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As String) As Long
  Private Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
  Private Declare Function LockResource Lib "kernel32.dll" (ByVal hResData As Long) As Long
  Private Declare Function SizeofResource Lib "kernel32.dll" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
  #End If


#If (LoadResEx_FlagA And &H1000&) = &H1000& Then
  Public Declare Function CreatePopupMenu Lib "user32" () As Long
  Public Declare Function LoadMenuA Lib "user32" (ByVal hInstance As Long, ByVal lpString As String) As Long
  Public Declare Function LoadMenuW Lib "user32" (ByVal hInstance As Long, lpString As Any) As Long
  Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
  Public Declare Function InsertMenuA Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
  Public Declare Function InsertMenuW Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, lpNewItem As Any) As Long
  Public Declare Function ModifyMenuA Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
  Public Declare Function ModifyMenuW Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, lpString As Any) As Long
  Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
  Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
  Public Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hwnd As Long, lpTPMParams As Long) As Long
  Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
  Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
  Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  Public Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
  
  ' Should not be needed in normal cases?
  Public Declare Function GetMenuStringA Lib "user32" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
  Public Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
  Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
  Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
  
  #End If

#If (LoadResEx_FlagA And &H8&) = &H8& Then
  Private Declare Function ImageList_LoadImage Lib "comctl32.dll" (ByVal hi As Long, ByVal lpbmp As String, ByVal cx As Long, ByVal cGrow As Long, ByVal crMask As Long, ByVal uType As Long, ByVal uFlags As Long) As Long
  Public Declare Function ImageList_GetImageCount Lib "comctl32.dll" (ByVal himl As Long) As Long
  Public Declare Function ImageList_Remove Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long) As Long
  Public Declare Function ImageList_Destroy Lib "comctl32.dll" (ByVal himl As Long) As Long
  #End If

Private Declare Function LoadImageA Lib "user32" (ByVal hInst As Long, ByVal lpsz As String, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long
Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Public Enum LoadResEx_IconOS
  LoadResEx_IconOS_Win95_16Color '16bit, 95NT+
  LoadResEx_IconOS_Win95 'truecolor, 95NT+
  LoadResEx_IconOS_WinNT
  LoadResEx_IconOS_Win98
  LoadResEx_IconOS_Win2000ME_16Color
  LoadResEx_IconOS_Win2000ME
  LoadResEx_IconOS_WinXP
'  LoadResEx_IconOS_WinVista_16Color
  LoadResEx_IconOS_WinVista
  End Enum

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
  End Type
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private LoadResex_Caps_TrayIcon As Long
Private LoadResex_Caps_WinDIcon As Long
Private LoadResEx_IsHighColor As Boolean

Public Function LoadResEx_WindowIcon(ByVal hwnd As Long, ByVal IconResID As Long, Optional ByVal ResolveTrayIconAndKeepAlive As Boolean = False) As Long
  Dim xLong1 As Long
  Dim xLong2 As Long
  Dim xLong3 As Long
  
  If Not (hwnd = 0& And Not ResolveTrayIconAndKeepAlive) Then
    If hwnd = 0& Then
      xLong2 = LoadResex_Caps_TrayIcon
      Else
      xLong2 = LoadResex_Caps_WinDIcon
      End If
'        Stop
    For xLong1 = xLong2 To 0& Step -1&
      If IsUseable(xLong1, xLong2) Then
        xLong3 = LoadImageA(App.hInstance, "#" & CStr(IconResID + xLong1), 1&, 16&, 16&, &H8000&)
        'xLong3 = LoadImageA(LoadResEx_LanguageFile_hModul, "#" & CStr(IconResID + xLong1), 1&, 16&, 16&, &H8000&)
        If Not xLong3 = 0& Then
          If hwnd = 0& Then
            LoadResEx_WindowIcon = xLong3
            Exit For
            Else
            Call SendMessagea(hwnd, &H80&, 0&, ByVal xLong3)
            Call SendMessagea(hwnd, &H80&, 1&, ByVal xLong3)
            If ResolveTrayIconAndKeepAlive Then
              If IsUseable(xLong1, LoadResex_Caps_TrayIcon) Then
                LoadResEx_WindowIcon = xLong3
                Exit For
                Else
                Call DestroyIcon(xLong3)
                xLong2 = LoadResex_Caps_TrayIcon
                hwnd = 0&
                End If
              Else
              Call DestroyIcon(xLong3)
              Exit For
              End If
            End If
          End If
        End If
      Next
    End If
  End Function

  
  
  
  
  
  
  
  
  

#If (LoadResEx_FlagA And &H1000&) = &H1000& Then
  Public Function LoadResEx_Menu(ByVal MenuID As Long, Optional ByVal Unicode As Boolean) As Long
    #If (LoadResEx_FlagA And &H40&) = &H40& Then
      If LoadResEx_LanguageFile_hModul = 0& Then
        If Unicode Then
          LoadResEx_Menu = LoadMenuW(App.hInstance, ByVal VarPtr("#" & CStr(MenuID)))
          Else
          LoadResEx_Menu = LoadMenuA(App.hInstance, ByVal "#" & CStr(MenuID))
          End If
        Else
        If Unicode Then
          LoadResEx_Menu = LoadMenuW(LoadResEx_LanguageFile_hModul, ByVal VarPtr("#" & CStr(MenuID)))
          Else
          LoadResEx_Menu = LoadMenuA(LoadResEx_LanguageFile_hModul, ByVal "#" & CStr(MenuID))
          End If
        End If
      'If LoadResEx_Menu = 0& Then
      '  LoadResEx_Menu = LoadMenuA(App.hInstance, ByVal "#" & CStr(MenuID))
      '  End If
      #Else
      If Unicode Then
        LoadResEx_Menu = LoadMenuW(App.hInstance, ByVal VarPtr("#" & CStr(MenuID)))
        Else
        LoadResEx_Menu = LoadMenuA(App.hInstance, ByVal "#" & CStr(MenuID))
        End If
      #End If
    End Function
  #End If

#If (LoadResEx_FlagA And &H40&) = &H40& Then
  Public Function LoadResEx_SetLanguageFile(Optional ByVal FileName As String) As Boolean
'    Stop
    If Not LoadResEx_LanguageFile_hModul = 0& Then Call FreeLibrary(LoadResEx_LanguageFile_hModul)
    If FileName = "" Then
      LoadResEx_LanguageFile_hModul = 0&
      If Not ptrTemp = 0& Then
        Call GlobalFree(ptrTemp)
        ptrTemp = 0&
        End If
      Else
      LoadResEx_LanguageFile_hModul = LoadLibraryA(FileName)
      If Not LoadResEx_LanguageFile_hModul = 0& Then
        If ptrTemp = 0& Then
          ptrTemp = GlobalAlloc(0&, ptrTempSize)
          If ptrTemp = 0& Then
            Call GlobalFree(ptrTemp)
            ptrTemp = 0&
            Else
            LoadResEx_SetLanguageFile = True
            End If
          End If
        End If
      End If
    End Function
  #End If

Public Function LoadResEx_String(ByVal ResID As Long, Optional ByVal CanBeMultiLine As Boolean = False) As String

  #If (LoadResEx_FlagA And &H40&) = &H40& Then
    Dim xLong1 As Long
    Dim xLong2 As Long
    #End If

  #If (LoadResEx_FlagA And &H40&) = &H40& Then
    If LoadResEx_LanguageFile_hModul = 0& Then
      GoTo lbl2
      Else
      xLong1 = GlobalLock(ptrTemp)
      If xLong1 = 0& Then
        LoadResEx_String = MissingPrefix + CStr(ResID)
        Else
        xLong2 = LoadStringA(LoadResEx_LanguageFile_hModul, ResID, ByVal xLong1, ptrTempSizeX)
        If xLong2 = 0& Then
          LoadResEx_String = MissingPrefix + CStr(ResID)
          Else
          LoadResEx_String = String(xLong2, vbNullChar)
          Call RtlMoveMemory(ByVal LoadResEx_String, ByVal xLong1, xLong2)
          If CanBeMultiLine Then
            LoadResEx_String = Replace(Replace(Replace(LoadResEx_String, "&|", vbNullChar), "|", vbCr), vbNullChar, "|")
            End If
          End If
        Call GlobalUnlock(ptrTemp)
        End If
      End If
    GoTo lbl1
    #Else
    On Error GoTo Er1
    If CanBeMultiLine Then
      LoadResEx_String = Replace(Replace(Replace(LoadResString(ResID), "&|", vbNullChar), "|", vbCr), vbNullChar, "|")
      Else
      LoadResEx_String = LoadResString(ResID)
      End If
    GoTo Rs1
    #End If

Er1:
  LoadResEx_String = MissingPrefix + CStr(ResID)
  Resume Rs1

  #If (LoadResEx_FlagA And &H40&) = &H40& Then
lbl2:
    On Error GoTo Er1
    If CanBeMultiLine Then
      LoadResEx_String = Replace(Replace(Replace(LoadResString(ResID), "&|", vbNullChar), "|", vbCr), vbNullChar, "|")
      Else
      LoadResEx_String = LoadResString(ResID)
      End If
    #End If

Rs1:
  On Error GoTo 0
  #If (LoadResEx_FlagA And &H40&) = &H40& Then
lbl1:
    #End If
  End Function

#If (LoadResEx_FlagA And &H100&) = &H100& Then
  Public Sub LoadResEx_DialogStrings(ByVal xWindow As Form, Optional ByVal MainIconResID As Long = -1&)
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
    Dim xObj1 As Control
    Dim xChar1 As String
    
    #If LogWhatCaptioned Then
      Debug.Print "; " + xWindow.Name
      #End If
    
    #If (LoadResEx_FlagA And &H40&) = &H40& Then
      If LoadResEx_LanguageFile_hModul = 0& Then
        xLong1 = GlobalAlloc(0&, ptrTempSize)
        Else
        xLong1 = GlobalLock(ptrTemp)
        End If
      #Else
      xLong1 = GlobalAlloc(0&, ptrTempSize)
      #End If
 '   Stop
    If Not xLong1 = 0& Then
      For Each xObj1 In xWindow.Controls
        If (TypeOf xObj1 Is Label) Or (TypeOf xObj1 Is Menu) Then
          
          
          'frmMaker.Visible = False
          'Stop
          If Len(xObj1.Caption) > 1& Then
            If Left(xObj1.Caption, 1&) = ReplaceExString Then
              xLong2 = Val(Mid(xObj1.Caption, 2&))
'              Stop
              #If LogWhatCaptioned Then
                Debug.Print xObj1.Name + ".Caption = LoadResEx_String(" + CStr(xLong2) + "&)"
                #End If
              
              #If (LoadResEx_FlagA And &H40&) = &H40& Then
                If LoadResEx_LanguageFile_hModul = 0& Then
                  On Error GoTo Er1
                  xObj1.Caption = LoadResString(xLong2)
                  On Error GoTo 0
                  Else
                  xLong3 = LoadStringA(LoadResEx_LanguageFile_hModul, xLong2, ByVal xLong1, ptrTempSizeX)
                  If xLong3 = 0& Then
                    xObj1.Caption = MissingPrefix + CStr(xLong2)
                    Else
                    xChar1 = String(xLong3, vbNullChar)
                    Call RtlMoveMemory(ByVal xChar1, ByVal xLong1, xLong3)
                    xObj1.Caption = xChar1
                    End If
                  End If
                #Else
                On Error GoTo Er1
                xObj1.Caption = LoadResString(xLong2)
                On Error GoTo 0
                #End If
              End If
            End If
          End If
        Next
      
      Call LoadResEx_DialogStrings_InternalCallback_EnumChildProc(xWindow.hwnd, xLong1)
      Call EnumChildWindows(xWindow.hwnd, AddressOf LoadResEx_DialogStrings_InternalCallback_EnumChildProc, xLong1)
      #If (LoadResEx_FlagA And &H40&) = &H40& Then
        If LoadResEx_LanguageFile_hModul = 0& Then
          Call GlobalFree(xLong1)
          Else
          Call GlobalUnlock(ptrTemp)
          End If
        #Else
        Call GlobalFree(xLong1)
        #End If
      End If
    GoTo lbl1

Er1:
    xObj1.Caption = MissingPrefix + CStr(xLong2)
    Resume Next
    
lbl1:
    If Not MainIconResID = 0& Then
      Call LoadResEx_WindowIcon(xWindow.hwnd, MainIconResID, False)
      End If
    End Sub
  
  Public Function LoadResEx_DialogStrings_InternalCallback_EnumChildProc(ByVal hwnd As Long, ByVal xParam As Long) As Long
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xByte1 As Byte
    Dim xChar1 As String
    
'Debug.Print "enter"
    xLong1 = GetWindowTextA(hwnd, ByVal xParam, ptrTempSizeX)
    Call RtlMoveMemory(xByte1, ByVal xParam, 1&)
    If CLng(xByte1) = ReplaceExStringASC And xLong1 > 1& Then
      xChar1 = String(xLong1, vbNullChar)
      Call RtlMoveMemory(ByVal xChar1, ByVal xParam, xLong1)
      xLong1 = Val(Mid(xChar1, 2&))
      'Debug.Print "ok", xLong1
      
      #If LogWhatCaptioned Then
        Debug.Print "; Unknown, hWnd = " + CStr(hwnd)
        #End If
      
      
      #If (LoadResEx_FlagA And &H40&) = &H40& Then
        If LoadResEx_LanguageFile_hModul = 0& Then
          On Error GoTo Er1
          xChar1 = LoadResString(xLong1)
          GoTo Rs1
          Else
          xLong2 = LoadStringA(LoadResEx_LanguageFile_hModul, xLong1, ByVal xParam, ptrTempSizeX)
          If xLong2 = 0& Then
            xChar1 = MissingPrefix + CStr(xLong1)
            Call SetWindowTextA(hwnd, ByVal xChar1)
            Else
            Call SetWindowTextA(hwnd, ByVal xParam)
            End If
          End If
        #Else
        On Error GoTo Er1
        xChar1 = LoadResString(xLong1)
        GoTo Rs1
        #End If
      End If
    GoTo lbl1

Er1:
    xChar1 = MissingPrefix + CStr(xLong1)
    Resume Rs1
Rs1:
    On Error GoTo 0
    Call SetWindowTextA(hwnd, ByVal xChar1)
lbl1:
    LoadResEx_DialogStrings_InternalCallback_EnumChildProc = True
    End Function
  #End If



#If (LoadResEx_FlagA And &H1&) = &H1& Then
  '#If (LoadResEx_FlagA And &H40&) = &H40& Then
  '  Public Function LoadResEx_Picture(ByVal ResID As Long, ByVal eObject As Object, Optional ByVal BmpNotIcon As Boolean = False, Optional ByVal UseBlackImage As Boolean, Optional ByVal TryLanguageFile As Boolean = False) As Boolean
  '  #Else
    Public Function LoadResEx_Picture(ByVal ResID As Long, ByVal eObject As Object, Optional ByVal BmpNotIcon As Boolean = False, Optional ByVal UseBlackImage As Boolean) As Boolean
  '  #End If
'
    Dim xLong1 As Long
    
    On Error GoTo Er2
    For xLong1 = LoadResex_Caps_WinDIcon To 0& Step -1&
      If IsUseable(xLong1, LoadResex_Caps_WinDIcon) Then
        If UseBlackImage Then
          On Error GoTo Er1
          eObject.Picture = LoadResPicture(ResID + xLong1 + 5&, 1& + CLng(BmpNotIcon))
          LoadResEx_Picture = True
          Exit For
Rs1:
          On Error GoTo Er2
          End If
        eObject.Picture = LoadResPicture(ResID + xLong1, 1& + CLng(BmpNotIcon))
        LoadResEx_Picture = True
        Exit For
        End If
Rs2:
      Next
    If Not LoadResEx_Picture Then
      On Error Resume Next
      eObject.Picture = LoadPicture()
      End If
    On Error GoTo 0
    GoTo lbl1

Er1:
    Resume Rs1
Er2:
    Resume Rs2
lbl1:
    End Function
  #End If

#If (LoadResEx_FlagA And &H10&) = &H10& Then
  #If (LoadResEx_FlagA And &H40&) = &H40& Then
    Public Function LoadResEx_Data(ByVal resFileName As Variant, Optional ByVal resType As String = "BIN", Optional ByVal TryLanguageFile As Boolean = False) As String
    #Else
    Public Function LoadResEx_Data(ByVal resFileName As Variant, Optional ByVal resType As Variant = "BIN") As String
    #End If
    
    Dim xByteA1() As Byte
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
    Dim xLong4 As Long
      
    If Not VarType(resFileName) = vbString Then resFileName = "#" + CStr(Val(resFileName))
    If Not VarType(resType) = vbString Then resType = "#" + CStr(Val(resType))
     'Stop
    #If (LoadResEx_FlagA And &H40&) = &H40& Then
      If TryLanguageFile Then
        xLong1 = FindResourceA(LoadResEx_LanguageFile_hModul, CStr(resFileName), CStr(resType))
        If Not xLong1 = 0& Then
          xLong2 = LoadResource(LoadResEx_LanguageFile_hModul, xLong1)
          If Not xLong2 = 0& Then
            xLong3 = SizeofResource(LoadResEx_LanguageFile_hModul, xLong1)
            If Not xLong3 = 0& Then
              xLong4 = LockResource(xLong2)
              If Not xLong4 = 0& Then
                LoadResEx_Data = String(xLong3, vbNullChar)
                Call RtlMoveMemory(ByVal LoadResEx_Data, ByVal xLong4, xLong3)
                End If
              End If
            End If
          End If
        End If
      #End If
#If (LoadResEx_FlagA And &H40&) = &H40& Then
    If xLong3 = 0& Then
#End If
'      Stop
      On Error GoTo Er1
      xByteA1() = LoadResData(resFileName, resType)
      xLong1 = UBound(xByteA1()) + 1&
'      Stop
      If Not xLong1 = 0& Then
        LoadResEx_Data = String(xLong1, vbNullChar)
        Call RtlMoveMemory(ByVal LoadResEx_Data, xByteA1(0), xLong1)
        End If
      On Error GoTo 0
#If (LoadResEx_FlagA And &H40&) = &H40& Then
      End If
#End If

Rs1:
    On Error GoTo 0
    Exit Function

Er1:
    Resume Rs1
    End Function
  #End If




Public Sub LoadResEx_GetCaps(Optional ByVal MaxIconSupport As Long = 0&, Optional ByVal ForceHiColorTrayIcons As Boolean)
  Dim xType1 As OSVERSIONINFO
  Dim xLong1 As Long
  
'  Stop
  If MaxIconSupport > 0& Then
    xLong1 = GetDC(0&)
    If Not xLong1 = 0& Then
      LoadResEx_IsHighColor = (GetDeviceCaps(xLong1, 12&) > 15&)
      xType1.dwOSVersionInfoSize = 148&
        
      If Not GetVersionExA(xType1) = 0& Then
        If (xType1.dwPlatformId = &H2&) Then
          'nt series
          '2003=5.2
          If xType1.dwMajorVersion > 5& Or xType1.dwMajorVersion = 5& And xType1.dwMinorVersion > 1& Then
            If LoadResEx_IsHighColor Then
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_WinVista
              Else
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win2000ME_16Color 'LoadResEx_IconOS_WinVista_16Color
              End If
            LoadResex_Caps_TrayIcon = LoadResex_Caps_WinDIcon
            ElseIf xType1.dwMajorVersion = 5& Then
            If xType1.dwMinorVersion >= 1& Then
              If LoadResEx_IsHighColor Then
                LoadResex_Caps_WinDIcon = LoadResEx_IconOS_WinXP
                Else
                LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win2000ME_16Color
                End If
              LoadResex_Caps_TrayIcon = LoadResex_Caps_WinDIcon
              Else
              If LoadResEx_IsHighColor Then
                LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win2000ME
                Else
                LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win2000ME_16Color
                End If
              LoadResex_Caps_TrayIcon = LoadResEx_IconOS_Win2000ME_16Color
              End If
            Else
            If LoadResEx_IsHighColor Then
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_WinNT
              'Else
              'LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win95_16Color
              End If
            'LoadResex_Caps_TrayIcon = LoadResEx_IconOS_Win95_16Color
            End If
          Else
          If xType1.dwMajorVersion > 4& Or xType1.dwMajorVersion = 4& And xType1.dwMinorVersion >= 90& Then
            If LoadResEx_IsHighColor Then
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win2000ME
              Else
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win2000ME_16Color
              End If
            LoadResex_Caps_TrayIcon = LoadResex_Caps_WinDIcon
            ElseIf xType1.dwMajorVersion = 4& And xType1.dwMinorVersion >= 10& Then
            If LoadResEx_IsHighColor Then
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win98
              'Else
              'LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win95_16Color
              End If
            'LoadResex_Caps_TrayIcon = LoadResEx_IconOS_Win95_16Color
            Else
            If LoadResEx_IsHighColor Then
              LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win95
              'Else
              'LoadResex_Caps_WinDIcon = LoadResEx_IconOS_Win95_16Color
              End If
            'LoadResex_Caps_TrayIcon = LoadResEx_IconOS_Win95_16Color
            End If
          End If
        End If
      If LoadResex_Caps_WinDIcon > MaxIconSupport Then
        LoadResex_Caps_WinDIcon = MaxIconSupport
        If LoadResex_Caps_TrayIcon > MaxIconSupport Then LoadResex_Caps_TrayIcon = MaxIconSupport
        End If
      If ForceHiColorTrayIcons Then LoadResex_Caps_TrayIcon = LoadResex_Caps_WinDIcon
      
      Call ReleaseDC(0&, xLong1)
      End If
    End If
  'LoadResex_Caps_WinDIcon = LoadResEx_IconOS_WinVista
  'LoadResex_Caps_TrayIcon = LoadResEx_IconOS_WinVista
  End Sub

#If (LoadResEx_FlagA And &H4&) = &H4& Then
  Public Function LoadResEx_Icon(ByVal ResID As Long, Optional ByVal DesiredSize As Long = 32&) As Long
    Dim xLong1 As Long
    
    For xLong1 = LoadResex_Caps_WinDIcon To 0& Step -1&
      If IsUseable(xLong1, LoadResex_Caps_WinDIcon) Then
        LoadResEx_Icon = LoadImageA(App.hInstance, "#" + CStr(ResID + xLong1), 1&, DesiredSize, DesiredSize, &H8000&)
        If Not LoadResEx_Icon = 0& Then Exit For
        End If
      Next
    End Function
  #End If

#If (LoadResEx_FlagA And &H8&) = &H8& Then
  Public Function LoadResEx_ImageListFromBitmap(ByVal ResID As Long) As Long
    Dim xLong1 As Long
    
    For xLong1 = LoadResex_Caps_WinDIcon To 0& Step -1&
      If IsUseable(xLong1, LoadResex_Caps_WinDIcon) Then
        LoadResEx_ImageListFromBitmap = ImageList_LoadImage(App.hInstance, "#" + CStr(ResID + xLong1), 16&, 16&, &HFF000000, 0&, &H2020&)
        If Not LoadResEx_ImageListFromBitmap = 0& Then Exit For
        End If
      Next
    End Function
  #End If

Private Function IsUseable(ByVal xCurIndex As Long, ByVal xOrigIndex As Long) As Boolean
  IsUseable = (Is16bit(xCurIndex) Or Not Is16bit(xOrigIndex))
  End Function

Private Function Is16bit(ByVal xIndex As Long) As Boolean
  Select Case xIndex
    Case LoadResEx_IconOS_Win95_16Color, LoadResEx_IconOS_Win2000ME_16Color ', LoadResEx_IconOS_WinVista_16Color
      Is16bit = True
    End Select
  End Function


#If (LoadResEx_FlagA And &H1000&) = &H1000& Then
  Public Function LoadResEx_Menu_GetCaption(ByVal hMenu As Long, ByVal MenuID As Long)
    GetMenuString
    
    End Function
  #End If

