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 (commented out, not needed
'   10    LoadResEx_Data
'   20    LoadResEx_Data (manualhandle)
'   40    LoadResLanguageFile
'  100    LoadResEx_DialogStrings 'tooltips?
' 1000    LoadResEx_Menu + All generic API
' 7FFF  = max!

Option Explicit
Option Base 0

Private Const MissingPrefix As String = "#"
Private Declare Function LoadStringA Lib "user32" (ByVal hInstance As Long, ByVal wID As Long, lpBuffer As Any, ByVal nBufferMax As Long) As Long
Private Declare Function LoadStringW Lib "user32" (ByVal hInstance As Long, ByVal wID As Long, lpBuffer As Any, ByVal nBufferMax As Long) As Long

#If (LoadResEx_FlagA And &H40&) = &H40& Then
  Private LoadResEx_LanguageFile_hModul As Long
  #End If

#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 GetWindowTextW 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, ByVal lpString As String) As Long
  Private Declare Function SetWindowTextW Lib "user32.dll" (ByVal hWnd As Long, lpString As Any) As Long
  #End If

Public ptrTemp As Long
Private Const ptrTempSize As Long = 32000 ' int (signed?), so crashes with some apis
Public Const ptrTempSizeX As Long = ptrTempSize - 1&
Public Const ptrTempSizeXW As Long = (ptrTempSize \ 2&) - 1&

#If Not (LoadResEx_FlagA And &H60&) = &H0& 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
  Private Declare Function LoadMenuA Lib "user32" (ByVal hInstance As Long, ByVal lpString As String) As Long
  Private 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
  Private 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
  Private 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
  Private 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
  Private 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, ByVal 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
  Private Declare Function GetMenuStringA Lib "user32" (ByVal hMenu As Long, ByVal wIDItem As Long, lpString As Any, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
  Private Declare Function GetMenuStringW Lib "user32" (ByVal hMenu As Long, ByVal wIDItem As Long, lpString As Any, 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 Declare Function SetClassLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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

Public IsUnicode 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
  Dim xLong4 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

    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 SendMessage(hWnd, &H80&, 0&, xLong3)
            'Call SendMessage(hwnd, &H80&, 1&, xLong3)
            xLong4 = LoadImageA(App.hInstance, "#" & CStr(IconResID + xLong1 + 15), 1&, 32&, 32&, &H8000&)
            'xLong4 = LoadImageA(LoadResEx_LanguageFile_hModul, "#" & CStr(IconResID + xLong1 + 15&), 1&, 32&, 32&, &H8000&)
            If Not xLong4 = 0& Then
              'Call SetClassLongA(hwnd, -14&, xLong4)
              Call SendMessage(hWnd, &H80&, 1&, xLong4)
              Call DestroyIcon(xLong4)
              End If

            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 Unicode Then
      'LoadResEx_Menu = LoadMenuW(LoadResEx_LanguageFile_hModul, ByVal VarPtr("#" & CStr(MenuID)))
      LoadResEx_Menu = LoadMenuW(LoadResEx_LanguageFile_hModul, ByVal StrPtr("#" & CStr(MenuID)))
      Else
      LoadResEx_Menu = LoadMenuA(LoadResEx_LanguageFile_hModul, ByVal "#" & CStr(MenuID))
      End If
    End Function
  #End If

#If (LoadResEx_FlagA And &H40&) = &H40& Then
  Public Function LoadResEx_SetLanguageFile(Optional ByVal Filename As String, Optional ByVal IdentifyString As String) As Boolean
    If Not LoadResEx_LanguageFile_hModul = App.hInstance Then
      Call FreeLibrary(LoadResEx_LanguageFile_hModul)
      LoadResEx_LanguageFile_hModul = App.hInstance
      End If
    If Not Len(Filename) = 0& Then
      LoadResEx_LanguageFile_hModul = LoadLibrary(Filename)
      If LoadResEx_LanguageFile_hModul = 0& Then
        LoadResEx_LanguageFile_hModul = App.hInstance
        Else
        If Len(IdentifyString) = 0& Then
          LoadResEx_SetLanguageFile = True
          ElseIf LoadResEx_String(1&, False) = IdentifyString Then
          LoadResEx_SetLanguageFile = True
          Else
          FreeLibrary LoadResEx_LanguageFile_hModul
          LoadResEx_LanguageFile_hModul = App.hInstance
          End If
        LoadResEx_SetLanguageFile = True
        End If
      End If
    End Function
  #End If

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

  If IsUnicode Then
    xLong1 = LoadStringW(LoadResEx_LanguageFile_hModul, ResID, ByVal ptrTemp, ptrTempSizeXW)
    Else
    xLong1 = LoadStringA(LoadResEx_LanguageFile_hModul, ResID, ByVal ptrTemp, ptrTempSizeX)
    End If
  If xLong1 = 0& Then
    LoadResEx_String = MissingPrefix + CStr(ResID)
    Else
    LoadResEx_String = PeekS(ptrTemp, xLong1)
    If CanBeMultiLine Then
      LoadResEx_String = Replace(Replace(Replace(LoadResEx_String, "&|", vbNullChar), "|", vbCr), vbNullChar, "|")
      End If
    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
    
    xLong1 = LocalLock(ptrTemp)
    If Not xLong1 = 0& Then
      For Each xObj1 In xWindow.Controls
        If (TypeOf xObj1 Is Label) Or (TypeOf xObj1 Is Menu) Then
          If Len(xObj1.Caption) > 1& Then
            If Left(xObj1.Caption, 1&) = ReplaceExString Then
              xLong2 = Val(Mid(xObj1.Caption, 2&))
              
              #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
                  If IsUnicode Then
                    xLong3 = LoadStringA(LoadResEx_LanguageFile_hModul, xLong2, ByVal xLong1, ptrTempSizeX)
                    Else
                    xLong3 = LoadStringW(LoadResEx_LanguageFile_hModul, xLong2, ByVal xLong1, ptrTempSizeXW)
                    End If
                  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)
      Call LocalUnlock(ptrTemp)
      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"
    If IsUnicode Then
      xLong1 = GetWindowTextW(hWnd, ByVal xParam, ptrTempSizeX)
      Else
      xLong1 = GetWindowTextA(hWnd, ByVal xParam, ptrTempSizeX)
      End If
    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
          If IsUnicode Then
            xLong2 = LoadStringW(LoadResEx_LanguageFile_hModul, xLong1, ByVal xParam, ptrTempSizeXW)
            xChar1 = MissingPrefix + CStr(xLong1)
            If xLong2 = 0& Then
              Call SetWindowTextW(hWnd, ByVal StrPtr(xChar1))
              Else
              Call SetWindowTextA(hWnd, ByVal xChar1)
              End If
            Else
            xLong2 = LoadStringA(LoadResEx_LanguageFile_hModul, xLong1, ByVal xParam, ptrTempSizeX)
            xChar1 = MissingPrefix + CStr(xLong1)
            If xLong2 = 0& Then
              
              Call SetWindowTextA(hWnd, ByVal xChar1)
              Else
              Call SetWindowTextA(hWnd, ByVal xParam)
              End If
            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 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) As Boolean
  '  #End If
'
    Dim xLong1 As Long
    
    On Error GoTo Er1
    For xLong1 = LoadResex_Caps_WinDIcon To 0& Step -1&
      If IsUseable(xLong1, LoadResex_Caps_WinDIcon) Then
        eObject.Picture = LoadResPicture(ResID + xLong1, 1& + CLng(BmpNotIcon))
        LoadResEx_Picture = True
        Exit For
        End If
Rs1:
      Next
    If Not LoadResEx_Picture Then
      On Error Resume Next
      eObject.Picture = LoadPicture()
      End If
    On Error GoTo 0
    GoTo lbl1

Er1:
    Resume Rs1
lbl1:
    End Function
  #End If



#If Not (LoadResEx_FlagA And &H30&) = &H0& Then
  #If (LoadResEx_FlagA And &H20&) = &H20& Then
    Public Function LoadResEx_Data(ByVal resName As Variant, Optional ByVal resType As Variant = "BIN", Optional ByVal hModul As Long = -1&) As String
    #Else
    #If (LoadResEx_FlagA And &H40&) = &H40& Then
      Public Function LoadResEx_Data(ByVal resName As Variant, Optional ByVal resType As Variant = "BIN", Optional ByVal LoadFromLanguageFile As Boolean) As String
      #Else
      Public Function LoadResEx_Data(ByVal resName As Variant, Optional ByVal resType As Variant = "BIN") As String
      #End If
    #End If

'  #End If
  
    Dim xByteA1() As Byte
    Dim xLong1 As Long
    Dim xLong2 As Long
    Dim xLong3 As Long
      
  #If (LoadResEx_FlagA And &H20&) = &H20& Then
    Dim xChar1 As String
    Dim xChar2 As String
    
    If hModul = -1& Then hModul = LoadResEx_LanguageFile_hModul
    If Not hModul = 0& Then
      If VarType(resName) = vbString Then
        xChar1 = resName
        Else
        xChar1 = "#" + CStr(Val(resName))
        End If
      If VarType(resType) = vbString Then
        xChar2 = resType
        Else
        xChar2 = "#" + CStr(Val(resType))
        End If
      
      xLong1 = FindResourceA(hModul, xChar1, xChar2)
      If Not xLong1 = 0& Then
        xLong2 = LoadResource(hModul, xLong1)
        If Not xLong2 = 0& Then
          xLong3 = SizeofResource(hModul, xLong1)
          If Not xLong3 = 0& Then
            hModul = LockResource(xLong2)
            If Not hModul = 0& Then
              LoadResEx_Data = String(xLong3, vbNullChar)
              Call RtlMoveMemory(ByVal LoadResEx_Data, ByVal hModul, xLong3)
              End If
            End If
          End If
        End If
      End If
    If xLong3 = 0& And (hModul = 0& Or hModul = LoadResEx_LanguageFile_hModul) Then
    #Else
    #If (LoadResEx_FlagA And &H40&) = &H40& Then
      Dim xChar1 As String
      Dim xChar2 As String
      
      If LoadFromLanguageFile Then
        If VarType(resName) = vbString Then
          xChar1 = resName
          Else
          xChar1 = "#" + CStr(Val(resName))
          End If
        If VarType(resType) = vbString Then
          xChar2 = resType
          Else
          xChar2 = "#" + CStr(Val(resType))
          End If
        xLong1 = FindResourceA(LoadResEx_LanguageFile_hModul, xChar1, xChar2)
        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
              xLong2 = LockResource(xLong2)
              If Not xLong2 = 0& Then
                LoadResEx_Data = String(xLong3, vbNullChar)
                Call RtlMoveMemory(ByVal LoadResEx_Data, ByVal xLong2, xLong3)
                End If
              End If
            End If
          End If
        End If
      If xLong3 = 0& Then
      #End If
    #End If
      
'#If Not (LoadResEx_FlagA And &H60&) = &H0& Then
'    If xLong3 = 0& Then
'#End If

      On Error GoTo Er1
      xByteA1() = LoadResData(xChar1, resType)
      xLong1 = UBound(xByteA1()) + 1&
      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 Not (LoadResEx_FlagA And &H60&) = &H0& Then
      End If
#End If

Rs1:
    On Error GoTo 0
    Exit Function

Er1:
    Resume Rs1
    End Function
  #End If




#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&)
        'LoadResEx_Icon = LoadImageA(LoadResEx_LanguageFile_hModul, "#" + 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

Public Sub LoadResEx_Init(Optional ByVal MaxIconSupport As Long = 0&)
  Dim xType1 As OSVERSIONINFO
  Dim xLong1 As Long
  
  If ptrTemp = 0& Then
    ptrTemp = LocalAlloc(0&, ptrTempSize)
 '   Debug.Print "Init:", ptrTemp
    LoadResEx_LanguageFile_hModul = App.hInstance
    
    
  
    If MaxIconSupport > 0& Then
      xLong1 = GetDC(0&)
      If Not xLong1 = 0& Then
        LoadResEx_IsHighColor = (GetDeviceCaps(xLong1, 12&) > 15&)
        Call ReleaseDC(0&, xLong1)
        
        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
              'IsUnicode = True
              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
              'IsUnicode = True
              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
            IsUnicode = True
            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
        End If
      End If
    End If
  End Sub

Public Sub LoadResEx_Close()
  If Not ptrTemp = 0& Then
    Call LocalFree(ptrTemp)
    ptrTemp = 0&
    End If
  End Sub

#If (LoadResEx_FlagA And &H1000&) = &H1000& Then
  Public Function LoadResEx_Menu_GetCaption(ByVal hMenu As Long, ByVal MenuID As Long) As String
    If IsUnicode Then
      MenuID = GetMenuStringW(hMenu, MenuID, ByVal ptrTemp, ptrTempSizeXW, 0&)
      Else
      MenuID = GetMenuStringA(hMenu, MenuID, ByVal ptrTemp, ptrTempSizeX, 0&)
      End If
    If Not MenuID = 0& Then LoadResEx_Menu_GetCaption = PeekS(ptrTemp, MenuID)
    End Function
  
  Public Function LoadResEx_Menu_MakePopupMenu(ByRef hMenu As Long, Optional ByVal KeepAnyWay As Boolean = False) As Long
    If Not hMenu = 0& Then
      LoadResEx_Menu_MakePopupMenu = CreatePopupMenu()
      If LoadResEx_Menu_MakePopupMenu = 0& Then
        If Not KeepAnyWay Then
          DestroyMenu hMenu
          hMenu = 0&
          End If
        ElseIf IsUnicode Then
        Call InsertMenuW(LoadResEx_Menu_MakePopupMenu, -1&, &H410&, hMenu, ByVal 0&)
        Else
        Call InsertMenuA(LoadResEx_Menu_MakePopupMenu, -1&, &H410&, hMenu, ByVal 0&)
        End If
      End If
    End Function
  
  Public Sub LoadResEx_Menu_Add(ByVal hMenu As Long, ByVal MenuID As Long, ByVal Caption As String, Optional ByVal InsertAfter As Long = -1&)
    If Not hMenu = 0& Then
      If IsUnicode Then
        Call InsertMenuW(hMenu, InsertAfter, 0&, MenuID, ByVal StrPtr(Caption))
        Else
        Call InsertMenuA(hMenu, InsertAfter, 0&, MenuID, ByVal Caption)
        End If
      End If
    End Sub
  
  Public Sub LoadResEx_Menu_AddSeperator(ByVal hMenu As Long, Optional ByVal MenuID As Long = 0&, Optional ByVal InsertAfter As Long = -1&)
    If Not hMenu = 0& Then
      If IsUnicode Then
        Call InsertMenuW(hMenu, InsertAfter, &H800&, MenuID, ByVal 0&)
        Else
        Call InsertMenuA(hMenu, InsertAfter, &H800&, MenuID, ByVal 0&)
        End If
      End If
    End Sub
  
  Public Sub LoadResEx_Menu_SetCaption(ByVal hMenu As Long, ByVal MenuID As Long, ByVal Caption As String, Optional ByVal NewMenuID As Long = -1&)
    Dim xLong1 As Long
    
    If NewMenuID = -1& Then NewMenuID = MenuID
    
    xLong1 = GetMenuState(hMenu, MenuID, 0&)
    If Not xLong1 = -1& Then
      If IsUnicode Then
        Call ModifyMenuW(hMenu, MenuID, xLong1, NewMenuID, ByVal StrPtr(Caption))
        Else
        Call ModifyMenuA(hMenu, MenuID, xLong1, NewMenuID, ByVal Caption)
        End If
      End If
    End Sub
  
  #End If






