Eukalyptus
Anmeldungsdatum: 17.05.2013 Beiträge: 11
|
Verfasst am: 01.08.2019, 23:28 Titel: Windows Explorer Shell Extension |
|
|
Für ein Projekt brauchte ich die Möglichkeit, dass der User mehrere Dateien via Rechtsklick an mein Programm schicken kann.
Früher hab ich das althergebracht gelöst: entweder einen Registry Eintrag bei *\Shell (geht nur mit einer handvoll Dateien und für jede Datei wird eine eigenen Instanz meines Programms gestartet)
oder die etwas unelegante Variante mit dem Eintrag bei "sent to".
Inspiriert hat mich dieser Fund: http://users.freebasic-portal.de/freebasicru/context_menu_explorer.html
Geht leider nicht unter 64 Bit!
Auch nach vielem Suchen und Probieren, konnte ich den Fehler nicht eingrenzen.
Deshalb hab ich mich etwas eingelesen und dieses Beispiel neu geschrieben.
Derzeit getestet unter Win8_x64 Win8.1_x64 Win10_x64 und Win7_x86
Als DLL kompilieren und mit folgendem Befehl registrieren:
regsvr32 Shell_Extension.dll
Zum entfernen: regsvr32 /u Shell_Extension.dll
Achtung!: Unbedingt als Administrator ausführen, denn sonst bekommt man den Fehler 80040201 zurück!
Hier der DLL-Code:
Code: | #Define USEBITMAP
#Include Once "windows.bi"
#INCLUDE Once "win/shlobj.bi"
Static Shared As ZString * 39 zCLSID_ShellExtension = "{8845D671-65F9-428E-9226-7D6A68B55BAC}"
Static Shared As IID CLSID_ShellExtension
IIDFromString(WStr(zCLSID_ShellExtension), @CLSID_ShellExtension)
Dim Shared As IContextMenuVtbl pIContextMenuVtbl
Dim Shared As IShellExtInitVtbl pIShellExtInitVtbl
Dim Shared As IClassFactoryVtbl pIClassFactoryVtbl
Dim Shared As Long iDLLRef = 0
#Ifdef USEBITMAP
Dim Shared As HBITMAP hBMP_Menu
Declare Sub _Bitmap(ByRef hBMP As HBITMAP)
_Bitmap(hBMP_Menu)
#EndIf
'====================================================================================
' Shell Extension
'====================================================================================
Type SHELLEXT
As IContextMenu tCM
As IShellExtInit tSE
As Long iRef, iFiles
As ZString * MAX_PATH aFiles(Any)
Declare Constructor
Declare Destructor
End Type
Constructor SHELLEXT
iRef = 0
iDLLRef += 1
End Constructor
Destructor SHELLEXT
iDLLRef -= 1
End Destructor
'------------------------------------------------------------------------------------
' Shell Extension - IContextMenu Methods
'------------------------------------------------------------------------------------
Function ContextMenu_QueryInterface(ByVal pCM As IContextMenu Ptr, ByVal riid As Const IID Const Ptr, ByVal ppvObject As Any Ptr Ptr) As HRESULT
*ppvObject = NULL
Dim As SHELLEXT Ptr pThis = Cast(SHELLEXT Ptr, pCM)
If IsEqualIID(riid, @IID_IShellExtInit) Or IsEqualIID(riid, @IID_IUnknown) Then
*ppvObject = @pThis->tSE
ElseIf IsEqualIID(riid, @IID_IContextMenu) Then
*ppvObject = @pThis->tCM
EndIf
If *ppvObject Then
pThis->tCM.lpVtbl->AddRef(pCM)
Return NOERROR
EndIf
Return E_NOINTERFACE
End Function
Function ContextMenu_AddRef(ByVal pCM As IContextMenu Ptr) As ULong
Dim As SHELLEXT Ptr pThis = Cast(SHELLEXT Ptr, pCM)
pThis->iRef += 1
Return pThis->iRef
End Function
Function ContextMenu_Release(ByVal pCM As IContextMenu Ptr) As ULong
Dim As SHELLEXT Ptr pThis = Cast(SHELLEXT Ptr, pCM)
pThis->iRef -= 1
If pThis->iRef <= 0 Then
pThis->iRef = 0
Delete pThis
EndIf
Return pThis->iRef
End Function
Function ContextMenu_QueryContextMenu(ByVal pCM As IContextMenu Ptr, ByVal hmenu As HMENU, ByVal indexMenu As UINT, ByVal idCmdFirst As UINT, ByVal idCmdLast As UINT, ByVal uFlags As UINT) As HRESULT
If (uFlags And CMF_DEFAULTONLY) Then Return MAKE_HRESULT(SEVERITY_SUCCESS, FACILITY_NULL, 0 )
InsertMenu(hmenu, indexMenu, MF_BYPOSITION, idCmdFirst, "FreeBasic Test Item")
#Ifdef USEBITMAP
SetMenuItemBitmaps(hMenu, indexMenu, MF_BITMAP Or MF_BYPOSITION, hBMP_Menu, hBMP_Menu)
#EndIf
Return MAKE_HRESULT(SEVERITY_SUCCESS, FACILITY_NULL, 1)
End Function
Function ContextMenu_InvokeCommand(ByVal pCM As IContextMenu Ptr, ByVal pici As CMINVOKECOMMANDINFO Ptr) As HRESULT
Dim As SHELLEXT Ptr pThis = Cast(SHELLEXT Ptr, pCM)
Select Case Loword(pici->lpVerb)
Case 0
Dim As String sInfo = ""
For i As Long = 0 To pThis->iFiles - 1
sInfo &= pThis->aFiles(i) & !"\r\n"
Next
MessageBox(NULL, sInfo, "Selected files", MB_OK + MB_ICONINFORMATION)
Return S_OK
Case Else
Return E_INVALIDARG
End Select
End Function
Function ContextMenu_GetCommandString(ByVal pCM As IContextMenu Ptr, ByVal idCmd As UINT_PTR, ByVal uType As UINT, ByVal pReserved As UINT Ptr, ByVal pszName As ZString Ptr, ByVal cchMax As UINT) As HRESULT
Return E_NOTIMPL
End Function
'------------------------------------------------------------------------------------
' Shell Extension - IShellExtInit Methods
'------------------------------------------------------------------------------------
Function ShellExtInit_QueryInterface(ByVal pSE As IShellExtInit Ptr, ByVal riid As Const IID Const Ptr, ByVal ppvObject As Any Ptr Ptr) As HRESULT
Dim As SHELLEXT Ptr pThis_CM = Cast(SHELLEXT Ptr, pSE - 1)
Return pThis_CM->tCM.lpVtbl->QueryInterface(Cast(Any Ptr, pThis_CM), riid, ppvObject)
End Function
Function ShellExtInit_AddRef(ByVal pSE As IShellExtInit Ptr) As ULong
Dim As SHELLEXT Ptr pThis_CM = Cast(SHELLEXT Ptr, pSE - 1)
Return pThis_CM->tCM.lpVtbl->AddRef(Cast(Any Ptr, pThis_CM))
End Function
Function ShellExtInit_Release(ByVal pSE As IShellExtInit Ptr) As ULong
Dim As SHELLEXT Ptr pThis_CM = Cast(SHELLEXT Ptr, pSE - 1)
Return pThis_CM->tCM.lpVtbl->Release(Cast(Any Ptr, pThis_CM))
End Function
Function ShellExtInit_Initialize(ByVal pSE As IShellExtInit Ptr, ByVal pidlFolder As LPCITEMIDLIST, ByVal pdtobj As IDataObject Ptr, ByVal hkeyProgID As HKEY)As HRESULT
Dim As SHELLEXT Ptr pThis = Cast(SHELLEXT Ptr, pSE - 1)
Dim As FORMATETC fmt = Type(CF_HDROP, NULL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL)
Dim As STGMEDIUM stg = Type(TYMED_HGLOBAL)
Dim As HDROP hDrop
If FAILED(pdtobj->lpVtbl->GetData(pdtobj, @fmt, @stg)) Then Return E_INVALIDARG
hDrop = GlobalLock(stg.hGlobal)
If hDrop = 0 Then Return E_INVALIDARG
pThis->iFiles = 0
Dim As Long iFiles = DragQueryFile(hDrop, &hFFFFFFFF, NULL, 0)
Dim As HRESULT hr = S_OK
If iFiles <= 0 Then
GlobalUnlock(stg.hGlobal)
ReleaseStgMedium (@stg)
Return E_INVALIDARG
EndIf
ReDim pThis->aFiles(iFiles)
Dim As ZString * MAX_PATH zFile
For i As Long = 0 To iFiles - 1
If DragQueryFile(hDrop, i, @zFile, MAX_PATH) <> 0 Then
pThis->aFiles(pThis->iFiles) = zFile
pThis->iFiles += 1
EndIf
Next
GlobalUnlock(stg.hGlobal)
ReleaseStgMedium(@stg)
Return hr
End Function
pIContextMenuVtbl = Type(@ContextMenu_QueryInterface, _
@ContextMenu_AddRef, _
@ContextMenu_Release, _
@ContextMenu_QueryContextMenu, _
@ContextMenu_InvokeCommand, _
@ContextMenu_GetCommandString)
pIShellExtInitVtbl = Type(@ShellExtInit_QueryInterface, _
@ShellExtInit_AddRef, _
@ShellExtInit_Release, _
@ShellExtInit_Initialize)
'====================================================================================
' IClassFactory
'====================================================================================
Type SE_CLASSFACTORY
As IClassFactory tCF
As Long iRef
Declare Constructor
Declare Destructor
End Type
Constructor SE_CLASSFACTORY
iRef = 0
iDLLRef += 1
End Constructor
Destructor SE_CLASSFACTORY
iRef = 0
iDLLRef -= 1
End Destructor
Function SE_CLASSFACTORY_QueryInterface(ByVal pCF As IClassFactory Ptr, ByVal riid As Const IID Const Ptr, ByVal ppvObject As Any Ptr Ptr) As HRESULT
*ppvObject = NULL
If IsEqualIID(riid, @IID_IUnknown) Or IsEqualIID(riid, @IID_IClassFactory) Then
Dim As SE_CLASSFACTORY Ptr pThis = Cast(SE_CLASSFACTORY Ptr, pCF)
*ppvObject = pCF
pThis->tCF.lpVtbl->AddRef(pCF)
Return NOERROR
EndIf
Return E_NOINTERFACE
End Function
Function SE_CLASSFACTORY_AddRef(ByVal pCF As IClassFactory Ptr) As ULong
Dim As SE_CLASSFACTORY Ptr pThis = Cast(SE_CLASSFACTORY Ptr, pCF)
pThis->iRef += 1
Return pThis->iRef
End Function
Function SE_CLASSFACTORY_Release(ByVal pCF As IClassFactory Ptr) As ULong
Dim As SE_CLASSFACTORY Ptr pThis = Cast(SE_CLASSFACTORY Ptr, pCF)
pThis->iRef -= 1
If pThis->iRef <= 0 Then
pThis->iRef = 0
Delete pThis
EndIf
Return pThis->iRef
End Function
Function SE_CLASSFACTORY_CreateInstance(ByVal pCF As IClassFactory Ptr, ByVal pUnkOuter As IUnknown Ptr, ByVal riid As Const IID Const Ptr, ByVal ppvObject As Any Ptr Ptr) As HRESULT
*ppvObject = NULL
If pUnkOuter Then Return CLASS_E_NOAGGREGATION
Dim As SHELLEXT Ptr pShellExt = New SHELLEXT
If pShellExt = 0 Then Return E_OUTOFMEMORY
pShellExt->tCM.lpVtbl = @pIContextMenuVtbl
pShellExt->tSE.lpVtbl = @pIShellExtInitVtbl
Return pSHellExt->tCM.lpVtbl->QueryInterface(Cast(IContextMenu Ptr, pSHellExt), riid, ppvObject)
End Function
Function SE_CLASSFACTORY_LockServer(ByVal pThis As IClassFactory Ptr, ByVal fLock As WINBOOL) As HRESULT
Return NOERROR
End Function
pIClassFactoryVtbl = Type(@SE_CLASSFACTORY_QueryInterface, _
@SE_CLASSFACTORY_AddRef, _
@SE_CLASSFACTORY_Release, _
@SE_CLASSFACTORY_CreateInstance, _
@SE_CLASSFACTORY_LockServer)
'====================================================================================
' DLL Export
'====================================================================================
Extern "windows-ms"
#Undef DllCanUnloadNow
#Undef DllGetClassObject
#Undef DllRegisterServer
#Undef DllUnregisterServer
Function DllCanUnloadNow() As HRESULT Export
Return IIf(iDLLRef <= 0, S_OK, S_FALSE)
End Function
Function DllGetClassObject(ByVal rclsid As Const IID Const Ptr, ByVal riid As Const IID Const Ptr, ByVal ppv As LPVOID Ptr) As HRESULT Export
*ppv = NULL
If IsEqualIID(rclsid, @CLSID_ShellExtension) Then
Dim As SE_CLASSFACTORY Ptr pCF = New SE_CLASSFACTORY
pCF->tCF.lpVtbl = @pIClassFactoryVtbl
pCF->iRef = 0
Return SE_CLASSFACTORY_QueryInterface(Cast(IClassFactory Ptr, pCF), riid, ppv)
EndIf
Return CLASS_E_CLASSNOTAVAILABLE
End Function
Function DllRegisterServer() As HRESULT Export
Dim As HKEY hKey
If RegCreateKeyEx(HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FreeBasicShell", 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Null, @hKey, 0) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
RegSetValueEx(hKey, "", 0, REG_SZ, @zCLSID_ShellExtension, 38)
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
If RegCreateKeyEx(HKEY_CLASSES_ROOT, "FreeBasicShell\shellex\ContextMenuHandlers", 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Null, @hKey, 0) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
RegSetValueEx(hKey, "", 0, REG_SZ, @zCLSID_ShellExtension, 38)
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
If RegCreateKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Null, @hKey, 0) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
RegSetValueEx(hKey, zCLSID_ShellExtension, 0, REG_SZ, @"FreeBasicShell", 15)
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
Dim As ZString*MAX_PATH szBuffer
Dim As HMODULE hMod
GetModuleHandleEx(4, Cast(LPSTR, @DllRegisterServer), @hMod)
If GetModuleFileName(hMod, szBuffer, MAX_PATH)<>0 Then
If RegCreateKeyEx(HKEY_CLASSES_ROOT, "CLSID\" & zCLSID_ShellExtension, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Null, @hKey, 0) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
RegSetValueEx(hKey, "", 0, REG_SZ, @"FreeBasicShell", 15)
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
If RegCreateKeyEx(HKEY_CLASSES_ROOT, "CLSID\" & zCLSID_ShellExtension & "\InProcServer32", 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Null, @hKey, 0) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
RegSetValueEx(hKey, "", 0, REG_SZ, @szBuffer, Len(szBuffer) + 1)
RegSetValueEx(hKey, "ThreadingModel", 0, REG_SZ, @"Apartment", 10)
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
Else
Return SELFREG_E_CLASS
EndIf
Return S_OK
End Function
Function DllUnregisterServer()As HRESULT Export
Dim As HKEY hKey
If RegDeleteKey(HKEY_CLASSES_ROOT, "*\shellex\ContextMenuHandlers\FreeBasicShell") <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegDeleteKey(HKEY_CLASSES_ROOT, "FreeBasicShell\shellex\ContextMenuHandlers") <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegDeleteKey(HKEY_CLASSES_ROOT, "FreeBasicShell\shellex") <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegDeleteKey(HKEY_CLASSES_ROOT, "FreeBasicShell") <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved", 0, KEY_ALL_ACCESS, @hKey) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegDeleteValue(hKey, zCLSID_ShellExtension) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
If RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID\" & zCLSID_ShellExtension, 0, KEY_ALL_ACCESS, @hKey) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegDeleteKey(hKey, "InProcServer32") <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
If RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID", 0, KEY_ALL_ACCESS, @hKey) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If RegDeleteKey(hKey, zCLSID_ShellExtension) <> ERROR_SUCCESS Then Return SELFREG_E_CLASS
If hKey <> 0 Then RegCloseKey(hKey) : hKey = 0
Return S_OK
End Function
End Extern
'====================================================================================
' Bitmap
'====================================================================================
#Ifdef USEBITMAP
Sub _Bitmap(ByRef hBMP As HBITMAP)
Dim As UByte pBMP(1574) = {&h42, &h4D, &h26, &h06, &h00, &h00, &h00, &h00, &h00, &h00, &h36, &h00, &h00, &h00, &h28, &h00, &h00, &h00, &h19, &h00, &h00, &h00, &h14, &h00, &h00, &h00, &h01, &h00, &h18, &h00, &h00, &h00, &h00, &h00, &hF0, &h05, &h00, &h00, &hD4, &h1E, _
&h00, &h00, &hD4, &h1E, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hCE, &hCE, &hCE, &hE8, &hE8, &hE8, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hF0, &hF0, &hF0, &hB8, &hB8, &hB8, &hEA, &hEA, &hEA, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&h8C, &h8C, &h8C, &hA0, &hA0, &hA0, &hA9, &hA9, &hA9, &h05, &h05, &h05, &hC9, &hC9, &hC9, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h59, &h59, &h59, &h26, &h26, &h26, &hD5, &hD5, &hD5, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h83, &h83, &h83, &h51, &h51, &h51, &h6F, _
&h6F, &h6F, &h36, &h36, &h36, &hBE, &hBE, &hBE, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hF7, &hF7, &hF7, &h44, &h44, &h44, &hF1, &hF1, &hF1, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hAB, &hAB, &hAB, &h49, &h49, &h49, &hEB, &hEB, &hEB, &h63, &h63, &h63, &hDE, &hDE, _
&hDE, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hC8, &hC8, &hC8, &h5A, &h5A, &h5A, &hB9, &hB9, &hB9, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hF2, &hF2, &hF2, &hF7, &hF7, &hF7, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hC5, &hC5, &hC5, &h3A, &h3A, &h3A, &hF1, &hF1, &hF1, &h79, &h79, &h79, &hC5, &hC5, &hC5, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h56, &h56, &h56, &h83, &h83, &h83, &h28, &h28, &h28, &h66, &h66, &h66, &hE1, &hE1, &hE1, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hD8, &hD8, &hD8, &h9C, &h9C, &h9C, &hFF, &hFF, &hFF, &hD0, &hD0, &hD0, &h1F, &h1F, &h1F, &hD2, &hD2, &hD2, &h7F, &h7F, &h7F, &h70, &h70, &h70, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hE4, &hE4, &hE4, &h1A, &h1A, &h1A, &hE1, &hE1, &hE1, &hEC, &hEC, &hEC, &h6D, &h6D, &h6D, &h6D, &h6D, &h6D, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hE8, _
&hE8, &hE8, &h4E, &h4E, &h4E, &hFF, &hFF, &hFF, &hBD, &hBD, &hBD, &h00, &h00, &h00, &h7E, &h7E, &h7E, &h02, &h02, &h02, &h76, &h76, &h76, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &h5A, &h5A, &h5A, &h65, &h65, &h65, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hA0, &hA0, &hA0, &hAA, &hAA, &hAA, &hFE, &hFE, &hFE, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h96, &h96, &h96, &h2B, &h2B, _
&h2B, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h95, &h95, &h95, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hB5, &hB5, &hB5, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hEE, &hEE, &hEE, &hF1, &hF1, &hF1, &h97, &h97, &h97, &h01, &h01, &h01, _
&hD4, &hD4, &hD4, &hF5, &hF5, &hF5, &hEF, &hEF, &hEF, &hED, &hED, &hED, &hB2, &hB2, &hB2, &h09, &h09, &h09, &hE9, &hE9, &hE9, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hE1, &hE1, &hE1, &h0F, &h0F, &h0F, &h5C, &h5C, &h5C, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &h95, &h95, &h95, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1B, &h1B, &h1B, &h6C, &h6C, &h6C, &h41, &h41, &h41, &h15, &h15, &h15, &h1A, &h1A, &h1A, &h00, &h00, &h00, &h15, &h15, &h15, &h50, &h50, &h50, &h20, _
&h20, &h20, &h12, &h12, &h12, &h08, &h08, &h08, &h21, &h21, &h21, &h66, &h66, &h66, &hFB, &hFB, &hFB, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h62, &h62, &h62, &h00, &h00, &h00, &hC3, &hC3, &hC3, &hFE, &hFE, &hFE, &h87, &h87, &h87, &h01, _
&h01, &h01, &h00, &h00, &h00, &h01, &h01, &h01, &h02, &h02, &h02, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h23, &h23, _
&h23, &hA6, &hA6, &hA6, &hE8, &hE8, &hE8, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hD3, &hD3, &hD3, &h02, &h02, &h02, &h48, &h48, &h48, &hFF, &hFF, &hFF, &h95, &h95, &h95, &h00, &h00, &h00, &h00, &h00, &h00, &h02, &h02, _
&h02, &h07, &h07, &h07, &h09, &h09, &h09, &h0A, &h0A, &h0A, &h08, &h08, &h08, &h07, &h07, &h07, &h07, &h07, &h07, &h07, &h07, &h07, &h06, &h06, &h06, &h02, &h02, &h02, &h00, &h00, &h00, &h00, &h00, &h00, &h19, &h19, &h19, &hFA, &hFA, &hFA, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hFA, &hFA, &hFA, &h4B, &h4B, &h4B, &h00, &h00, &h00, &hB2, &hB2, &hB2, &hFF, &hFF, &hFF, &h51, &h51, &h51, &h00, &h00, &h00, &h00, &h00, &h00, &h03, &h03, &h03, &h08, &h08, &h08, _
&h0A, &h0A, &h0A, &h0E, &h0E, &h0E, &h0C, &h0C, &h0C, &h0F, &h0F, &h0F, &h10, &h10, &h10, &h10, &h10, &h10, &h0E, &h0E, &h0E, &h08, &h08, &h08, &h01, &h01, &h01, &h00, &h00, &h00, &h37, &h37, &h37, &hF6, &hF6, &hF6, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &h00, &hD2, &hD2, &hD2, &h00, &h00, &h00, &h00, &h00, &h00, &hAB, &hAB, &hAB, &hFF, &hFF, &hFF, &h83, &h83, &h83, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h04, &h04, &h04, &h06, &h06, &h06, &h06, _
&h06, &h06, &h08, &h08, &h08, &h09, &h09, &h09, &h0D, &h0D, &h0D, &h10, &h10, &h10, &h12, &h12, &h12, &h0A, &h0A, &h0A, &h01, &h01, &h01, &h02, &h02, &h02, &hBF, &hBF, &hBF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &h00, &hE4, &hE4, &hE4, &h0F, &h0F, &h0F, &h00, &h00, &h00, &h5F, &h5F, &h5F, &hFF, &hFF, &hFF, &hE8, &hE8, &hE8, &h0E, &h0E, &h0E, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, _
&h00, &h00, &h00, &h00, &h00, &h00, &h00, &h08, &h08, &h08, &h0A, &h0A, &h0A, &h09, &h09, &h09, &h00, &h00, &h00, &h40, &h40, &h40, &hFF, &hFF, &hFF, &hDE, &hDE, &hDE, &h65, &h65, &h65, &hD2, &hD2, &hD2, &hFF, &hFF, &hFF, &h00, &hFE, &hFE, _
&hFE, &h2D, &h2D, &h2D, &h00, &h00, &h00, &h03, &h03, &h03, &h50, &h50, &h50, &h63, &h63, &h63, &h1C, &h1C, &h1C, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h06, &h06, &h06, &h2A, &h2A, &h2A, &h45, &h45, &h45, &h3F, &h3F, &h3F, _
&h0D, &h0D, &h0D, &h00, &h00, &h00, &h03, &h03, &h03, &h04, &h04, &h04, &h00, &h00, &h00, &h43, &h43, &h43, &hFF, &hFF, &hFF, &h9F, &h9F, &h9F, &h00, &h00, &h00, &h79, &h79, &h79, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &h6B, &h6B, &h6B, _
&h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h77, &h77, &h77, &hD3, &hD3, &hD3, &hB3, &hB3, &hB3, &h81, &h81, &h81, &h86, &h86, &h86, &hD1, &hD1, &hD1, &hFB, &hFB, &hFB, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hB5, &hB5, &hB5, &h00, _
&h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h04, &h04, &h04, &h68, &h68, &h68, &h12, &h12, &h12, &h00, &h00, &h00, &hA6, &hA6, &hA6, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hF6, &hF6, &hF6, &hA0, &hA0, &hA0, &h72, _
&h72, &h72, &hC5, &hC5, &hC5, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFD, &hFD, &hFD, &h51, &h51, &h51, &h00, &h00, _
&h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h05, &h05, &h05, &hD6, &hD6, &hD6, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hEA, &hEA, &hEA, &h3B, &h3B, &h3B, &h00, &h00, &h00, _
&h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h16, &h16, &h16, &hF5, &hF5, &hF5, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hF5, &hF5, &hF5, &h7E, &h7E, &h7E, &h2F, &h2F, &h2F, &h19, _
&h19, &h19, &h0C, &h0C, &h0C, &h2B, &h2B, &h2B, &hA9, &hA9, &hA9, &hFE, &hFE, &hFE, &hFF, &hFF, &hFF, &h00, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, _
&hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFD, &hFD, &hFD, &hF1, &hF1, &hF1, &hE0, &hE0, _
&hE0, &hF1, &hF1, &hF1, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &h00}
Dim As BITMAPINFO Ptr pBI
Dim As BITMAPFILEHEADER Ptr pBIH = Cast(Any Ptr, @pBMP(0))
pBI = Cast(BITMAPINFO Ptr, pBIH + 1)
Dim As HDC hDC = GetDC(0)
hBMP = CreateDIBitmap(hDC, @pBI->bmiHeader, CBM_INIT, Cast(Byte Ptr, pBIH) + pBIH->bfOffBits, pBI, DIB_RGB_COLORS)
ReleaseDC(0, hDC)
End Sub
#EndIf |
LGE |
|