├── archiv ├── fabel358 │ ├── Form1.frx │ ├── orig │ │ ├── Form1.frx │ │ ├── Projekt1.vbp │ │ ├── Form1.frm │ │ └── Module1.bas │ ├── Mappe1.xlsm │ ├── Projekt1.vbp │ ├── Form1.frm │ └── Module1.bas ├── VBN_IFileDialog │ ├── .vs │ │ └── VBN_IFileDialog │ │ │ ├── FileContentIndex │ │ │ ├── read.lock │ │ │ └── ee7538f1-c6f0-4788-9f4c-ed10829be9b6.vsidx │ │ │ └── v17 │ │ │ └── .suo │ ├── VBN_IFileDialog │ │ ├── obj │ │ │ └── Debug │ │ │ │ ├── VBN_IFileDialog.vbproj.SuggestedBindingRedirects.cache │ │ │ │ ├── _IsIncrementalBuild │ │ │ │ ├── VBN_IFileDialog.vbproj.CoreCompileInputs.cache │ │ │ │ ├── VBN_IFileDialog.pdb │ │ │ │ ├── VBN_IFileDialog.Form1.resources │ │ │ │ ├── VBN_IFileDialog.Resources.resources │ │ │ │ ├── DesignTimeResolveAssemblyReferences.cache │ │ │ │ ├── VBN_IFileDialog.vbproj.GenerateResource.cache │ │ │ │ ├── DesignTimeResolveAssemblyReferencesInput.cache │ │ │ │ ├── VBN_IFileDialog.vbproj.AssemblyReference.cache │ │ │ │ ├── .NETFramework,Version=v4.7.2.AssemblyAttributes.vb │ │ │ │ ├── VBN_IFileDialog.xml │ │ │ │ └── VBN_IFileDialog.vbproj.FileListAbsolute.txt │ │ ├── User.ico │ │ ├── bin │ │ │ └── Debug │ │ │ │ ├── VBN_IFileDialog.pdb │ │ │ │ ├── VBN_IFileDialog.exe.config │ │ │ │ └── VBN_IFileDialog.xml │ │ ├── App.config │ │ ├── My Project │ │ │ ├── Settings.settings │ │ │ ├── Application.myapp │ │ │ ├── AssemblyInfo.vb │ │ │ ├── Application.Designer.vb │ │ │ ├── Resources.Designer.vb │ │ │ ├── Settings.Designer.vb │ │ │ └── Resources.resx │ │ ├── Form1.Designer.vb │ │ ├── VBN_IFileDialog.vbproj │ │ ├── Form1.resx │ │ ├── Form1.vb │ │ └── PickFolderDialog.vb │ └── VBN_IFileDialog.sln ├── TestShort │ ├── Form1.frm │ ├── MFileDlg.bas │ └── Projekt1.vbp ├── VBC_IFileDialog │ ├── Form1.frm │ ├── modInterface.bas │ ├── clsIFileDialog.cls │ ├── clsIFileDialog2.cls │ ├── clsIShellItem.cls │ ├── clsIEnumShellItems.cls │ ├── clsIFileDialogEvents.cls │ ├── clsIFileOpenDialog.cls │ ├── clsIFileSaveDialog.cls │ ├── clsIShellItemArray.cls │ ├── modIFileDialogEvents.bas │ ├── clsIFileDialogCustomize.cls │ ├── Project1.vbp │ └── modFunc.bas ├── VBC_Tipp0759_TiKu │ ├── Mappe1.xlsm │ ├── ISubclassedWindow.cls │ ├── Projekt1.vbp │ ├── MSubclassing.bas │ └── FMain.frm └── Standarddialoge mit undokumentierten APIs starten │ ├── www.ActiveVB.de.url │ ├── frmTest.frm │ ├── basUnsupDialogs.bas │ └── pTest.vbp ├── Resources ├── MakeRes.ps1 ├── MyRes.h ├── log.txt ├── MyRes.RES ├── PaperKind.xlsx ├── WinDialogs.png ├── Icons │ └── AppIcon.ico ├── Lorem ipsum.docx ├── Pictures │ ├── ColorDialog.png │ ├── FontDialog.png │ ├── PrintDialog.png │ ├── OpenFileDialog.png │ ├── PrintDialogEx.png │ ├── SaveFileDialog.png │ ├── FontDialogWHook.png │ ├── OpenFolderDialog.png │ ├── PageSetupDialog.png │ ├── PrintDialogWinUI.png │ ├── ReplaceDlgMSWord.png │ ├── FolderBrowserDialog.png │ ├── ReplaceDlgComdlg32.png │ ├── ReplaceDlgNotepad++.png │ ├── FolderBrowserDialog_.png │ └── OpenFileFolderDialog.png ├── MyRes.rc └── Manifest │ └── manifest.exe.manifest ├── Bild1.psp ├── Bild2.psp ├── Mappe1.xlsm ├── PrintDlg.xlsm ├── Forms ├── FMain.frm ├── FMain.frx ├── Form1.frx ├── Form2.frm └── Form1 - Kopie.frm ├── SimpleFileDlg.xlsm ├── Classes ├── FontDialog.cls ├── ColorDialog.cls ├── MyFontDialog.cls ├── PrintDialog.cls ├── TaskDialogSE.cls ├── OpenFileDialog.cls ├── PageSetupDialog.cls ├── SaveFileDialog.cls ├── FindReplaceDialog.cls ├── OpenFolderDialog.cls ├── FolderBrowser │ ├── Form1.frm │ └── Projekt1.vbp ├── FolderBrowserDialog.cls ├── archiv │ └── FolderBrowserDialog.cls ├── ICallBack.cls └── MessageBox.cls ├── Modules ├── MFileDlg.bas ├── MPrinter.bas ├── MFontDialog.bas ├── MFindReplaceDialog.bas ├── MApp.bas ├── MObjPtr.bas ├── MComDlgCtrl.bas ├── MWin.bas ├── MFont.bas └── MCallBack.bas ├── CDlgShowPrinter ├── Form1.frm └── Projekt1.vbp ├── FontDialog └── codekabinett │ ├── link.txt │ ├── Form1.frm │ ├── Projekt1.vbp │ ├── modFontDialog_Org.bas │ └── modFontDialog_VBA7.bas ├── FolderBrowser ├── ActiveVB │ ├── Form1.frm │ ├── FolderBrowserDialog.cls │ ├── ModCallBack.bas │ ├── ICallBack.cls │ └── Projekt1.vbp ├── vbarchiv │ ├── Form1.frm │ ├── Module1.bas │ └── Projekt1.vbp ├── ActiveVBW │ ├── Form1.frm │ ├── FolderBrowserDialog.cls │ ├── ModCallBack.bas │ ├── ICallBack.cls │ └── Projekt1.vbp └── SHGetPathFromIDList │ ├── Projekt1.vbp │ └── Form1.frm ├── .gitignore ├── .gitattributes ├── PWinDialogs.vbp └── README.md /archiv/fabel358/Form1.frx: -------------------------------------------------------------------------------- 1 | Text1 -------------------------------------------------------------------------------- /archiv/fabel358/orig/Form1.frx: -------------------------------------------------------------------------------- 1 | Text1 -------------------------------------------------------------------------------- /Resources/MakeRes.ps1: -------------------------------------------------------------------------------- 1 | .\rc.exe "MyRes.rc" >>log.txt -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/.vs/VBN_IFileDialog/FileContentIndex/read.lock: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /Bild1.psp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Bild1.psp -------------------------------------------------------------------------------- /Bild2.psp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Bild2.psp -------------------------------------------------------------------------------- /Mappe1.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Mappe1.xlsm -------------------------------------------------------------------------------- /PrintDlg.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/PrintDlg.xlsm -------------------------------------------------------------------------------- /Forms/FMain.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Forms/FMain.frm -------------------------------------------------------------------------------- /Forms/FMain.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Forms/FMain.frx -------------------------------------------------------------------------------- /Forms/Form1.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Forms/Form1.frx -------------------------------------------------------------------------------- /Forms/Form2.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Forms/Form2.frm -------------------------------------------------------------------------------- /Resources/MyRes.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/MyRes.h -------------------------------------------------------------------------------- /Resources/log.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/log.txt -------------------------------------------------------------------------------- /Resources/MyRes.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/MyRes.RES -------------------------------------------------------------------------------- /SimpleFileDlg.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/SimpleFileDlg.xlsm -------------------------------------------------------------------------------- /Classes/FontDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/FontDialog.cls -------------------------------------------------------------------------------- /Modules/MFileDlg.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Modules/MFileDlg.bas -------------------------------------------------------------------------------- /Modules/MPrinter.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Modules/MPrinter.bas -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.SuggestedBindingRedirects.cache: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/_IsIncrementalBuild: -------------------------------------------------------------------------------- 1 | obj\Debug\\_IsIncrementalBuild 2 | -------------------------------------------------------------------------------- /Classes/ColorDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/ColorDialog.cls -------------------------------------------------------------------------------- /Classes/MyFontDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/MyFontDialog.cls -------------------------------------------------------------------------------- /Classes/PrintDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/PrintDialog.cls -------------------------------------------------------------------------------- /Classes/TaskDialogSE.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/TaskDialogSE.cls -------------------------------------------------------------------------------- /Forms/Form1 - Kopie.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Forms/Form1 - Kopie.frm -------------------------------------------------------------------------------- /Modules/MFontDialog.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Modules/MFontDialog.bas -------------------------------------------------------------------------------- /Resources/PaperKind.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/PaperKind.xlsx -------------------------------------------------------------------------------- /Resources/WinDialogs.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/WinDialogs.png -------------------------------------------------------------------------------- /CDlgShowPrinter/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/CDlgShowPrinter/Form1.frm -------------------------------------------------------------------------------- /Classes/OpenFileDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/OpenFileDialog.cls -------------------------------------------------------------------------------- /Classes/PageSetupDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/PageSetupDialog.cls -------------------------------------------------------------------------------- /Classes/SaveFileDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/SaveFileDialog.cls -------------------------------------------------------------------------------- /FontDialog/codekabinett/link.txt: -------------------------------------------------------------------------------- 1 | https://codekabinett.com/page.php?Theme=10&Lang=2#choosefont-dialog-vba-api-x64 -------------------------------------------------------------------------------- /Resources/Icons/AppIcon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Icons/AppIcon.ico -------------------------------------------------------------------------------- /Resources/Lorem ipsum.docx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Lorem ipsum.docx -------------------------------------------------------------------------------- /archiv/TestShort/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/TestShort/Form1.frm -------------------------------------------------------------------------------- /archiv/fabel358/Mappe1.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/fabel358/Mappe1.xlsm -------------------------------------------------------------------------------- /Classes/FindReplaceDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/FindReplaceDialog.cls -------------------------------------------------------------------------------- /Classes/OpenFolderDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/OpenFolderDialog.cls -------------------------------------------------------------------------------- /archiv/TestShort/MFileDlg.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/TestShort/MFileDlg.bas -------------------------------------------------------------------------------- /Classes/FolderBrowser/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/FolderBrowser/Form1.frm -------------------------------------------------------------------------------- /Classes/FolderBrowserDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/FolderBrowserDialog.cls -------------------------------------------------------------------------------- /FolderBrowser/ActiveVB/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/FolderBrowser/ActiveVB/Form1.frm -------------------------------------------------------------------------------- /FolderBrowser/vbarchiv/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/FolderBrowser/vbarchiv/Form1.frm -------------------------------------------------------------------------------- /Modules/MFindReplaceDialog.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Modules/MFindReplaceDialog.bas -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/Form1.frm -------------------------------------------------------------------------------- /FolderBrowser/ActiveVBW/Form1.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/FolderBrowser/ActiveVBW/Form1.frm -------------------------------------------------------------------------------- /FolderBrowser/vbarchiv/Module1.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/FolderBrowser/vbarchiv/Module1.bas -------------------------------------------------------------------------------- /Resources/Pictures/ColorDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/ColorDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/FontDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/FontDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/PrintDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/PrintDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/OpenFileDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/OpenFileDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/PrintDialogEx.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/PrintDialogEx.png -------------------------------------------------------------------------------- /Resources/Pictures/SaveFileDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/SaveFileDialog.png -------------------------------------------------------------------------------- /archiv/VBC_Tipp0759_TiKu/Mappe1.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_Tipp0759_TiKu/Mappe1.xlsm -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Exclude binary files 2 | *.exe 3 | *.dll 4 | *.ocx 5 | *.zip 6 | 7 | # Exclude user-specific files 8 | *.vbw 9 | Thumbs.db -------------------------------------------------------------------------------- /Classes/archiv/FolderBrowserDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Classes/archiv/FolderBrowserDialog.cls -------------------------------------------------------------------------------- /Resources/Pictures/FontDialogWHook.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/FontDialogWHook.png -------------------------------------------------------------------------------- /Resources/Pictures/OpenFolderDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/OpenFolderDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/PageSetupDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/PageSetupDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/PrintDialogWinUI.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/PrintDialogWinUI.png -------------------------------------------------------------------------------- /Resources/Pictures/ReplaceDlgMSWord.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/ReplaceDlgMSWord.png -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/modInterface.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/modInterface.bas -------------------------------------------------------------------------------- /Resources/Pictures/FolderBrowserDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/FolderBrowserDialog.png -------------------------------------------------------------------------------- /Resources/Pictures/ReplaceDlgComdlg32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/ReplaceDlgComdlg32.png -------------------------------------------------------------------------------- /Resources/Pictures/ReplaceDlgNotepad++.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/ReplaceDlgNotepad++.png -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIFileDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIFileDialog.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIFileDialog2.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIFileDialog2.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIShellItem.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIShellItem.cls -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.CoreCompileInputs.cache: -------------------------------------------------------------------------------- 1 | 8127bd4051db33aa5857094d6b4f416f843a1211 2 | -------------------------------------------------------------------------------- /Resources/Pictures/FolderBrowserDialog_.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/FolderBrowserDialog_.png -------------------------------------------------------------------------------- /Resources/Pictures/OpenFileFolderDialog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/Resources/Pictures/OpenFileFolderDialog.png -------------------------------------------------------------------------------- /FolderBrowser/ActiveVB/FolderBrowserDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/FolderBrowser/ActiveVB/FolderBrowserDialog.cls -------------------------------------------------------------------------------- /FolderBrowser/ActiveVBW/FolderBrowserDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/FolderBrowser/ActiveVBW/FolderBrowserDialog.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIEnumShellItems.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIEnumShellItems.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIFileDialogEvents.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIFileDialogEvents.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIFileOpenDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIFileOpenDialog.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIFileSaveDialog.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIFileSaveDialog.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIShellItemArray.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIShellItemArray.cls -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/modIFileDialogEvents.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/modIFileDialogEvents.bas -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/User.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/User.ico -------------------------------------------------------------------------------- /archiv/Standarddialoge mit undokumentierten APIs starten/www.ActiveVB.de.url: -------------------------------------------------------------------------------- 1 | [InternetShortcut] 2 | URL=http://www.activevb.de/ 3 | Modified=90C5FCDED566C2012D 4 | -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/clsIFileDialogCustomize.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBC_IFileDialog/clsIFileDialogCustomize.cls -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/.vs/VBN_IFileDialog/v17/.suo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/.vs/VBN_IFileDialog/v17/.suo -------------------------------------------------------------------------------- /archiv/Standarddialoge mit undokumentierten APIs starten/frmTest.frm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/Standarddialoge mit undokumentierten APIs starten/frmTest.frm -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/bin/Debug/VBN_IFileDialog.pdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/bin/Debug/VBN_IFileDialog.pdb -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.pdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.pdb -------------------------------------------------------------------------------- /archiv/Standarddialoge mit undokumentierten APIs starten/basUnsupDialogs.bas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/Standarddialoge mit undokumentierten APIs starten/basUnsupDialogs.bas -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.Form1.resources: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.Form1.resources -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.Resources.resources: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.Resources.resources -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/DesignTimeResolveAssemblyReferences.cache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/DesignTimeResolveAssemblyReferences.cache -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.GenerateResource.cache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.GenerateResource.cache -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/App.config: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/DesignTimeResolveAssemblyReferencesInput.cache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/DesignTimeResolveAssemblyReferencesInput.cache -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.AssemblyReference.cache: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.AssemblyReference.cache -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/.vs/VBN_IFileDialog/FileContentIndex/ee7538f1-c6f0-4788-9f4c-ed10829be9b6.vsidx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OlimilO1402/Win_Dialogs/HEAD/archiv/VBN_IFileDialog/.vs/VBN_IFileDialog/FileContentIndex/ee7538f1-c6f0-4788-9f4c-ed10829be9b6.vsidx -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/bin/Debug/VBN_IFileDialog.exe.config: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/Settings.settings: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/.NETFramework,Version=v4.7.2.AssemblyAttributes.vb: -------------------------------------------------------------------------------- 1 | ' 2 | Option Strict Off 3 | Option Explicit On 4 | 5 | Imports System 6 | Imports System.Reflection 7 | 8 | -------------------------------------------------------------------------------- /FolderBrowser/ActiveVB/ModCallBack.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "ModCallBack" 2 | Option Explicit 3 | 4 | Public Function FolderBrowserDialogCallBack(ByVal hwnd As Long, ByVal msg As Long, ByVal lParam As Long, ByVal lpData As Object) As Long 5 | If Not lpData Is Nothing Then 6 | If TypeOf lpData Is ICallBack Then 7 | Call CCallBack(lpData).CallBack(hwnd, msg, lParam) 8 | End If 9 | End If 10 | End Function 11 | 12 | Public Function CCallBack(ByVal obj As Object) As ICallBack 13 | Set CCallBack = obj 14 | End Function 15 | -------------------------------------------------------------------------------- /FolderBrowser/ActiveVBW/ModCallBack.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "ModCallBack" 2 | Option Explicit 3 | 4 | Public Function FolderBrowserDialogCallBack(ByVal hwnd As Long, ByVal msg As Long, ByVal lParam As Long, ByVal lpData As Object) As Long 5 | If Not lpData Is Nothing Then 6 | If TypeOf lpData Is ICallBack Then 7 | Call CCallBack(lpData).CallBack(hwnd, msg, lParam) 8 | End If 9 | End If 10 | End Function 11 | 12 | Public Function CCallBack(ByVal obj As Object) As ICallBack 13 | Set CCallBack = obj 14 | End Function 15 | -------------------------------------------------------------------------------- /Classes/ICallBack.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ICallBack" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Public Sub CallBack(ByVal hhwnd As LongPtr, ByVal msg As LongPtr, ByVal lParam As LongPtr) 17 | 18 | End Sub 19 | -------------------------------------------------------------------------------- /Resources/MyRes.rc: -------------------------------------------------------------------------------- 1 | #include "MyRes.h" 2 | ///////////////////////////////////////////////////////////////////////////// 3 | // Program Icons 4 | // first Icon with Index 0 for the program itself 5 | // second Icon with Index 1 for a registered filetype 6 | 0 ICON "Icons\\AppIcon.ico" 7 | 8 | ///////////////////////////////////////////////////////////////////////////// 9 | // 10 | // 24 11 | //Public Declare Sub InitCommonControls Lib "comctl32.dll" () 12 | 1 RT_MANIFEST "Manifest\\manifest.exe.manifest" 13 | -------------------------------------------------------------------------------- /FolderBrowser/ActiveVB/ICallBack.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ICallBack" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Public Sub CallBack(ByVal hhwnd As Long, ByVal msg As Long, ByVal lParam As Long) 17 | 18 | End Sub 19 | -------------------------------------------------------------------------------- /FolderBrowser/ActiveVBW/ICallBack.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ICallBack" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Public Sub CallBack(ByVal hhwnd As Long, ByVal msg As Long, ByVal lParam As Long) 17 | 18 | End Sub 19 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/Application.myapp: -------------------------------------------------------------------------------- 1 | 2 | 3 | true 4 | Form1 5 | false 6 | 0 7 | true 8 | 0 9 | 0 10 | true 11 | 12 | -------------------------------------------------------------------------------- /FontDialog/codekabinett/Form1.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form1 3 | Caption = "Form1" 4 | ClientHeight = 3015 5 | ClientLeft = 120 6 | ClientTop = 465 7 | ClientWidth = 4560 8 | LinkTopic = "Form1" 9 | ScaleHeight = 3015 10 | ScaleWidth = 4560 11 | StartUpPosition = 3 'Windows-Standard 12 | End 13 | Attribute VB_Name = "Form1" 14 | Attribute VB_GlobalNameSpace = False 15 | Attribute VB_Creatable = False 16 | Attribute VB_PredeclaredId = True 17 | Attribute VB_Exposed = False 18 | Option Explicit 19 | 20 | -------------------------------------------------------------------------------- /Modules/MApp.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MApp" 2 | Option Explicit 3 | Public Const FileExtFilter As String = "Textfile (*.txt)|*.txt|html-file (*.htm, *.html)|*.htm*|All files (*.*)|*.*" 4 | 5 | Sub Main() 6 | FMain.Show 7 | End Sub 8 | 9 | Public Property Get Version() As String 10 | Version = App.Major & "." & App.Minor & "." & App.Revision 11 | End Property 12 | 13 | Public Function TaskDialog(Title As String, Instruction As String, Content As String, Optional ByVal Icon As ETaskDialogIcon, Optional ByVal Buttons As ETaskDialogButton) As TaskDialogSE 14 | Set TaskDialog = New TaskDialogSE: TaskDialog.New_ Title, Instruction, Content, Icon, Buttons 15 | End Function 16 | 17 | -------------------------------------------------------------------------------- /archiv/VBC_Tipp0759_TiKu/ISubclassedWindow.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "ISubclassedWindow" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Public Function HandleMessage(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr, ByVal scID As ESubclassID, ByRef bCallDefProc As Boolean) As Long: End Function 17 | -------------------------------------------------------------------------------- /FolderBrowser/SHGetPathFromIDList/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 4 | IconForm="Form1" 5 | Startup="Form1" 6 | Command32="" 7 | Name="Projekt1" 8 | HelpContextID="0" 9 | CompatibleMode="0" 10 | MajorVer=1 11 | MinorVer=0 12 | RevisionVer=0 13 | AutoIncrementVer=0 14 | ServerSupportFiles=0 15 | CompilationType=0 16 | OptimizationType=0 17 | FavorPentiumPro(tm)=0 18 | CodeViewDebugInfo=0 19 | NoAliasing=0 20 | BoundsCheck=0 21 | OverflowCheck=0 22 | FlPointCheck=0 23 | FDIVCheck=0 24 | UnroundedFP=0 25 | StartMode=0 26 | Unattended=0 27 | Retained=0 28 | ThreadPerObject=0 29 | MaxNumberOfThreads=1 30 | -------------------------------------------------------------------------------- /archiv/TestShort/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation 4 | Module=MFileDlg; MFileDlg.bas 5 | Startup="Form1" 6 | Command32="" 7 | Name="Projekt1" 8 | HelpContextID="0" 9 | CompatibleMode="0" 10 | MajorVer=1 11 | MinorVer=0 12 | RevisionVer=0 13 | AutoIncrementVer=0 14 | ServerSupportFiles=0 15 | CompilationType=0 16 | OptimizationType=0 17 | FavorPentiumPro(tm)=0 18 | CodeViewDebugInfo=0 19 | NoAliasing=0 20 | BoundsCheck=0 21 | OverflowCheck=0 22 | FlPointCheck=0 23 | FDIVCheck=0 24 | UnroundedFP=0 25 | StartMode=0 26 | Unattended=0 27 | Retained=0 28 | ThreadPerObject=0 29 | MaxNumberOfThreads=1 30 | -------------------------------------------------------------------------------- /archiv/fabel358/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 4 | Module=Module1; Module1.bas 5 | IconForm="Form1" 6 | Startup="Form1" 7 | Command32="" 8 | Name="Projekt1" 9 | HelpContextID="0" 10 | CompatibleMode="0" 11 | MajorVer=1 12 | MinorVer=0 13 | RevisionVer=0 14 | AutoIncrementVer=0 15 | ServerSupportFiles=0 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /Modules/MObjPtr.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MObjPtr" 2 | Option Explicit 3 | 4 | #If VBA7 = 0 Then 5 | Public Enum LongPtr 6 | [_] 7 | End Enum 8 | #End If 9 | 10 | Public Declare Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal bytLength As Long) 11 | 12 | Public Declare Sub RtlZeroMemory Lib "kernel32" (ByRef Dst As Any, ByVal bytLength As Long) 13 | 14 | Public Function CObj(ByVal ptr As Long) As Object 15 | 'Public Function PtrToObject(ByVal p As Long) As Object 16 | RtlMoveMemory ByVal VarPtr(CObj), ptr, 4 17 | End Function 18 | 19 | 'Public Sub ZeroToObject(obj As Object) 'As Object 20 | Public Sub ZeroObj(obj As Object) 'As Object 21 | RtlZeroMemory ByVal VarPtr(obj), 4 22 | End Sub 23 | -------------------------------------------------------------------------------- /FolderBrowser/vbarchiv/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 4 | Module=MFolderBrowser; Module1.bas 5 | Startup="Form1" 6 | ExeName32="Projekt1.exe" 7 | Command32="" 8 | Name="Projekt1" 9 | HelpContextID="0" 10 | CompatibleMode="0" 11 | MajorVer=1 12 | MinorVer=0 13 | RevisionVer=0 14 | AutoIncrementVer=0 15 | ServerSupportFiles=0 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /CDlgShowPrinter/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 4 | Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX 5 | IconForm="Form1" 6 | Startup="Form1" 7 | Command32="" 8 | Name="Projekt1" 9 | HelpContextID="0" 10 | CompatibleMode="0" 11 | MajorVer=1 12 | MinorVer=0 13 | RevisionVer=0 14 | AutoIncrementVer=0 15 | ServerSupportFiles=0 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /archiv/fabel358/orig/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 4 | Module=Module1; Module1.bas 5 | IconForm="Form1" 6 | Startup="Form1" 7 | ExeName32="Projekt1.exe" 8 | Command32="" 9 | Name="Projekt1" 10 | HelpContextID="0" 11 | CompatibleMode="0" 12 | MajorVer=1 13 | MinorVer=0 14 | RevisionVer=0 15 | AutoIncrementVer=0 16 | ServerSupportFiles=0 17 | CompilationType=0 18 | OptimizationType=0 19 | FavorPentiumPro(tm)=0 20 | CodeViewDebugInfo=0 21 | NoAliasing=0 22 | BoundsCheck=0 23 | OverflowCheck=0 24 | FlPointCheck=0 25 | FDIVCheck=0 26 | UnroundedFP=0 27 | StartMode=0 28 | Unattended=0 29 | Retained=0 30 | ThreadPerObject=0 31 | MaxNumberOfThreads=1 32 | -------------------------------------------------------------------------------- /FontDialog/codekabinett/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Form=Form1.frm 4 | Module=modFontDialog_Org; modFontDialog_Org.bas 5 | Module=modFontDialog_VBA7; modFontDialog_VBA7.bas 6 | Startup="Form1" 7 | Command32="" 8 | Name="Projekt1" 9 | HelpContextID="0" 10 | CompatibleMode="0" 11 | MajorVer=1 12 | MinorVer=0 13 | RevisionVer=0 14 | AutoIncrementVer=0 15 | ServerSupportFiles=0 16 | CompilationType=0 17 | OptimizationType=0 18 | FavorPentiumPro(tm)=0 19 | CodeViewDebugInfo=0 20 | NoAliasing=0 21 | BoundsCheck=0 22 | OverflowCheck=0 23 | FlPointCheck=0 24 | FDIVCheck=0 25 | UnroundedFP=0 26 | StartMode=0 27 | Unattended=0 28 | Retained=0 29 | ThreadPerObject=0 30 | MaxNumberOfThreads=1 31 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/bin/Debug/VBN_IFileDialog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | VBN_IFileDialog 6 | 7 | 8 | 9 | 10 | 11 | A strongly-typed resource class, for looking up localized strings, etc. 12 | 13 | 14 | 15 | 16 | Returns the cached ResourceManager instance used by this class. 17 | 18 | 19 | 20 | 21 | Overrides the current thread's CurrentUICulture property for all 22 | resource lookups using this strongly typed resource class. 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | VBN_IFileDialog 6 | 7 | 8 | 9 | 10 | 11 | A strongly-typed resource class, for looking up localized strings, etc. 12 | 13 | 14 | 15 | 16 | Returns the cached ResourceManager instance used by this class. 17 | 18 | 19 | 20 | 21 | Overrides the current thread's CurrentUICulture property for all 22 | resource lookups using this strongly typed resource class. 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /archiv/Standarddialoge mit undokumentierten APIs starten/pTest.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=frmTest.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation 4 | Module=basUnsupDialogs; basUnsupDialogs.bas 5 | IconForm="frmTest" 6 | Startup="frmTest" 7 | Command32="" 8 | Name="pTest" 9 | HelpContextID="0" 10 | CompatibleMode="0" 11 | MajorVer=1 12 | MinorVer=0 13 | RevisionVer=0 14 | AutoIncrementVer=0 15 | ServerSupportFiles=0 16 | VersionCompanyName="IRsoft" 17 | CompilationType=0 18 | OptimizationType=0 19 | FavorPentiumPro(tm)=0 20 | CodeViewDebugInfo=0 21 | NoAliasing=0 22 | BoundsCheck=0 23 | OverflowCheck=0 24 | FlPointCheck=0 25 | FDIVCheck=0 26 | UnroundedFP=0 27 | StartMode=0 28 | Unattended=0 29 | Retained=0 30 | ThreadPerObject=0 31 | MaxNumberOfThreads=1 32 | -------------------------------------------------------------------------------- /archiv/VBC_Tipp0759_TiKu/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 3 | Form=FMain.frm 4 | Class=ISubclassedWindow; ISubclassedWindow.cls 5 | Module=MSubClassing; MSubclassing.bas 6 | IconForm="FMain" 7 | Startup="FMain" 8 | HelpFile="" 9 | ExeName32="Projekt1.exe" 10 | Command32="" 11 | Name="Projekt1" 12 | HelpContextID="0" 13 | CompatibleMode="0" 14 | MajorVer=1 15 | MinorVer=0 16 | RevisionVer=0 17 | AutoIncrementVer=0 18 | ServerSupportFiles=0 19 | CompilationType=0 20 | OptimizationType=0 21 | FavorPentiumPro(tm)=0 22 | CodeViewDebugInfo=0 23 | NoAliasing=0 24 | BoundsCheck=0 25 | OverflowCheck=0 26 | FlPointCheck=0 27 | FDIVCheck=0 28 | UnroundedFP=0 29 | StartMode=0 30 | Unattended=0 31 | Retained=0 32 | ThreadPerObject=0 33 | MaxNumberOfThreads=1 34 | -------------------------------------------------------------------------------- /Classes/FolderBrowser/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation 3 | Form=Form1.frm 4 | Module=ModCallBack; ModCallBack.bas 5 | Class=FolderBrowserDialog; FolderBrowserDialog.cls 6 | Class=ICallBack; ICallBack.cls 7 | IconForm="Form1" 8 | Startup="Form1" 9 | ExeName32="TestFolderBrowserDialog.exe" 10 | Command32="" 11 | Name="Projekt1" 12 | HelpContextID="0" 13 | CompatibleMode="0" 14 | MajorVer=1 15 | MinorVer=0 16 | RevisionVer=0 17 | AutoIncrementVer=0 18 | ServerSupportFiles=0 19 | VersionCompanyName="MBO-Ing.com" 20 | CompilationType=0 21 | OptimizationType=0 22 | FavorPentiumPro(tm)=0 23 | CodeViewDebugInfo=0 24 | NoAliasing=0 25 | BoundsCheck=0 26 | OverflowCheck=0 27 | FlPointCheck=0 28 | FDIVCheck=0 29 | UnroundedFP=0 30 | StartMode=0 31 | Unattended=0 32 | Retained=0 33 | ThreadPerObject=0 34 | MaxNumberOfThreads=1 35 | 36 | [MS Transaction Server] 37 | AutoRefresh=1 38 | -------------------------------------------------------------------------------- /FolderBrowser/ActiveVB/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 3 | Form=Form1.frm 4 | Module=ModCallBack; ModCallBack.bas 5 | Class=FolderBrowserDialog; FolderBrowserDialog.cls 6 | Class=ICallBack; ICallBack.cls 7 | IconForm="Form1" 8 | Startup="Form1" 9 | ExeName32="TestFolderBrowserDialog.exe" 10 | Command32="" 11 | Name="Projekt1" 12 | HelpContextID="0" 13 | CompatibleMode="0" 14 | MajorVer=1 15 | MinorVer=0 16 | RevisionVer=0 17 | AutoIncrementVer=0 18 | ServerSupportFiles=0 19 | VersionCompanyName="MBO-Ing.com" 20 | CompilationType=0 21 | OptimizationType=0 22 | FavorPentiumPro(tm)=0 23 | CodeViewDebugInfo=0 24 | NoAliasing=0 25 | BoundsCheck=0 26 | OverflowCheck=0 27 | FlPointCheck=0 28 | FDIVCheck=0 29 | UnroundedFP=0 30 | StartMode=0 31 | Unattended=0 32 | Retained=0 33 | ThreadPerObject=0 34 | MaxNumberOfThreads=1 35 | 36 | [MS Transaction Server] 37 | AutoRefresh=1 38 | -------------------------------------------------------------------------------- /FolderBrowser/ActiveVBW/Projekt1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 3 | Form=Form1.frm 4 | Module=ModCallBack; ModCallBack.bas 5 | Class=FolderBrowserDialog; FolderBrowserDialog.cls 6 | Class=ICallBack; ICallBack.cls 7 | IconForm="Form1" 8 | Startup="Form1" 9 | ExeName32="TestFolderBrowserDialog.exe" 10 | Command32="" 11 | Name="Projekt1" 12 | HelpContextID="0" 13 | CompatibleMode="0" 14 | MajorVer=1 15 | MinorVer=0 16 | RevisionVer=0 17 | AutoIncrementVer=0 18 | ServerSupportFiles=0 19 | VersionCompanyName="MBO-Ing.com" 20 | CompilationType=0 21 | OptimizationType=0 22 | FavorPentiumPro(tm)=0 23 | CodeViewDebugInfo=0 24 | NoAliasing=0 25 | BoundsCheck=0 26 | OverflowCheck=0 27 | FlPointCheck=0 28 | FDIVCheck=0 29 | UnroundedFP=0 30 | StartMode=0 31 | Unattended=0 32 | Retained=0 33 | ThreadPerObject=0 34 | MaxNumberOfThreads=1 35 | 36 | [MS Transaction Server] 37 | AutoRefresh=1 38 | -------------------------------------------------------------------------------- /Resources/Manifest/manifest.exe.manifest: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | 11 | True/PM 12 | 13 | 14 | program.exe 15 | 16 | 17 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Set the default behavior, in case people don't have core.autocrlf set. 2 | # Auto detect text files and perform LF normalization 3 | * text=auto 4 | 5 | # Explicitly declare text files you want to always be normalized and converted 6 | # to native line endings on checkout. 7 | # none 8 | 9 | # Declare files that will always have CRLF line endings on checkout. 10 | *.frm text eol=crlf 11 | *.cls text eol=crlf 12 | *.bas text eol=crlf 13 | *.ctl text eol=crlf 14 | *.vbp text eol=crlf 15 | *.vbw text eol=crlf 16 | *.mak text eol=crlf 17 | *.vbg text eol=crlf 18 | *.vb text eol=crlf 19 | *.cs text eol=crlf 20 | *.rc text eol=crlf 21 | *.txt text eol=crlf 22 | *.bat text eol=crlf 23 | *.scc text eol=crlf 24 | *.ps1 text eol=crlf 25 | *.h text eol=crlf 26 | *.manifest text eol=crlf 27 | *.html text eol=crlf 28 | 29 | # Denote all files that are truly binary and should not be modified. 30 | *.frx binary 31 | *.png binary 32 | *.jpg binary 33 | *.bmp binary 34 | *.ico binary 35 | *.zip binary 36 | *.dll binary 37 | *.exe binary 38 | *.ocx binary 39 | *.tlb binary 40 | *.res binary 41 | *.exp binary 42 | *.lib binary 43 | *.xls binary 44 | *.xlsm binary 45 | *.doc binary 46 | *.docx binary 47 | *.syx binary 48 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog.sln: -------------------------------------------------------------------------------- 1 | 2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.0.32413.511 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "VBN_IFileDialog", "VBN_IFileDialog\VBN_IFileDialog.vbproj", "{48374BFE-CD4E-4E15-B3A2-1AD7BF3ADE75}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|Any CPU = Debug|Any CPU 11 | Release|Any CPU = Release|Any CPU 12 | EndGlobalSection 13 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 14 | {48374BFE-CD4E-4E15-B3A2-1AD7BF3ADE75}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 15 | {48374BFE-CD4E-4E15-B3A2-1AD7BF3ADE75}.Debug|Any CPU.Build.0 = Debug|Any CPU 16 | {48374BFE-CD4E-4E15-B3A2-1AD7BF3ADE75}.Release|Any CPU.ActiveCfg = Release|Any CPU 17 | {48374BFE-CD4E-4E15-B3A2-1AD7BF3ADE75}.Release|Any CPU.Build.0 = Release|Any CPU 18 | EndGlobalSection 19 | GlobalSection(SolutionProperties) = preSolution 20 | HideSolutionNode = FALSE 21 | EndGlobalSection 22 | GlobalSection(ExtensibilityGlobals) = postSolution 23 | SolutionGuid = {4DE5F7F2-38EF-485E-9C58-8F38E58B9B8B} 24 | EndGlobalSection 25 | EndGlobal 26 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/AssemblyInfo.vb: -------------------------------------------------------------------------------- 1 | Imports System 2 | Imports System.Reflection 3 | Imports System.Runtime.InteropServices 4 | 5 | ' Allgemeine Informationen über eine Assembly werden über die folgenden 6 | ' Attribute gesteuert. Ändern Sie diese Attributwerte, um die Informationen zu ändern, 7 | ' die einer Assembly zugeordnet sind. 8 | 9 | ' Werte der Assemblyattribute überprüfen 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 'Die folgende GUID wird für die typelib-ID verwendet, wenn dieses Projekt für COM verfügbar gemacht wird. 21 | 22 | 23 | ' Versionsinformationen für eine Assembly bestehen aus den folgenden vier Werten: 24 | ' 25 | ' Hauptversion 26 | ' Nebenversion 27 | ' Buildnummer 28 | ' Revision 29 | ' 30 | ' Sie können alle Werte angeben oder Standardwerte für die Build- und Revisionsnummern verwenden, 31 | ' indem Sie "*" wie unten gezeigt eingeben: 32 | ' 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/Project1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Form=Form1.frm 3 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SysWow64\stdole2.tlb#OLE Automation 4 | Module=modInterface; modInterface.bas 5 | Class=clsIFileDialog; clsIFileDialog.cls 6 | Class=clsIShellItem; clsIShellItem.cls 7 | Module=modFunc; modFunc.bas 8 | Class=clsIFileDialog2; clsIFileDialog2.cls 9 | Class=clsIFileOpenDialog; clsIFileOpenDialog.cls 10 | Class=clsIFileSaveDialog; clsIFileSaveDialog.cls 11 | Class=clsIShellItemArray; clsIShellItemArray.cls 12 | Class=clsIEnumShellItems; clsIEnumShellItems.cls 13 | Class=clsIFileDialogCustomize; clsIFileDialogCustomize.cls 14 | Module=modIFileDialogEvents; modIFileDialogEvents.bas 15 | Class=clsIFileDialogEvents; clsIFileDialogEvents.cls 16 | IconForm="Form1" 17 | Startup="Form1" 18 | ExeName32="Project_1.exe" 19 | Command32="" 20 | Name="Project1" 21 | HelpContextID="0" 22 | CompatibleMode="0" 23 | MajorVer=1 24 | MinorVer=0 25 | RevisionVer=0 26 | AutoIncrementVer=0 27 | ServerSupportFiles=0 28 | CompilationType=0 29 | OptimizationType=0 30 | FavorPentiumPro(tm)=0 31 | CodeViewDebugInfo=0 32 | NoAliasing=0 33 | BoundsCheck=0 34 | OverflowCheck=0 35 | FlPointCheck=0 36 | FDIVCheck=0 37 | UnroundedFP=0 38 | StartMode=0 39 | Unattended=0 40 | Retained=0 41 | ThreadPerObject=0 42 | MaxNumberOfThreads=1 43 | 44 | [RVB] 45 | DeleteClass1=clsIFileDialogEvents 46 | DeleteClass2=clsIFileDialogEvents 47 | DeleteClass3=clsIFileDialogEvents 48 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/Application.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | 15 | Namespace My 16 | 17 | 'NOTE: This file is auto-generated; do not modify it directly. To make changes, 18 | ' or if you encounter build errors in this file, go to the Project Designer 19 | ' (go to Project Properties or double-click the My Project node in 20 | ' Solution Explorer), and make changes on the Application tab. 21 | ' 22 | Partial Friend Class MyApplication 23 | 24 | _ 25 | Public Sub New() 26 | MyBase.New(Global.Microsoft.VisualBasic.ApplicationServices.AuthenticationMode.Windows) 27 | Me.IsSingleInstance = false 28 | Me.EnableVisualStyles = true 29 | Me.SaveMySettingsOnExit = true 30 | Me.ShutDownStyle = Global.Microsoft.VisualBasic.ApplicationServices.ShutdownMode.AfterMainFormCloses 31 | End Sub 32 | 33 | _ 34 | Protected Overrides Sub OnCreateMainForm() 35 | Me.MainForm = Global.VBN_IFileDialog.Form1 36 | End Sub 37 | End Class 38 | End Namespace 39 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/obj/Debug/VBN_IFileDialog.vbproj.FileListAbsolute.txt: -------------------------------------------------------------------------------- 1 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\bin\Debug\VBN_IFileDialog.exe.config 2 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\bin\Debug\VBN_IFileDialog.exe 3 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\bin\Debug\VBN_IFileDialog.pdb 4 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\bin\Debug\VBN_IFileDialog.xml 5 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.vbproj.AssemblyReference.cache 6 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.vbproj.SuggestedBindingRedirects.cache 7 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.Form1.resources 8 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.Resources.resources 9 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.vbproj.GenerateResource.cache 10 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.vbproj.CoreCompileInputs.cache 11 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.exe 12 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.xml 13 | \\SOLS_DS\Daten\GitHubRepos\VB\Win_Dialogs\archiv\VBN_IFileDialog\VBN_IFileDialog\obj\Debug\VBN_IFileDialog.pdb 14 | -------------------------------------------------------------------------------- /archiv/fabel358/Form1.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form1 3 | Caption = "Form1" 4 | ClientHeight = 6495 5 | ClientLeft = 120 6 | ClientTop = 465 7 | ClientWidth = 10935 8 | LinkTopic = "Form1" 9 | ScaleHeight = 6495 10 | ScaleWidth = 10935 11 | StartUpPosition = 3 'Windows-Standard 12 | Begin VB.TextBox Text1 13 | Height = 5895 14 | Left = 2880 15 | MultiLine = -1 'True 16 | ScrollBars = 3 'Beides 17 | TabIndex = 2 18 | Text = "Form1.frx":0000 19 | Top = 600 20 | Width = 8055 21 | End 22 | Begin VB.CommandButton Command2 23 | Caption = "Command2" 24 | Height = 375 25 | Left = 1800 26 | TabIndex = 1 27 | Top = 120 28 | Width = 1455 29 | End 30 | Begin VB.CommandButton Command1 31 | Caption = "Command1" 32 | Height = 375 33 | Left = 120 34 | TabIndex = 0 35 | Top = 120 36 | Width = 1575 37 | End 38 | Begin VB.Label Label1 39 | AutoSize = -1 'True 40 | Caption = "Label1" 41 | Height = 195 42 | Left = 120 43 | TabIndex = 3 44 | Top = 600 45 | Width = 480 46 | End 47 | End 48 | Attribute VB_Name = "Form1" 49 | Attribute VB_GlobalNameSpace = False 50 | Attribute VB_Creatable = False 51 | Attribute VB_PredeclaredId = True 52 | Attribute VB_Exposed = False 53 | Option Explicit 54 | 55 | Private Sub Command1_Click() 56 | Module1.ShowFind Me, FR_DOWN Or FR_SHOWHELP, "Find Text" 57 | End Sub 58 | 59 | Private Sub Command2_Click() 60 | Module1.ShowFind Me, FR_SHOWHELP, "Find Text", True, "Replace Text" 61 | End Sub 62 | 63 | Private Sub Form_Load() 64 | Caption = "Find/Replace dialogs" 65 | Command1.Caption = "Find" 66 | Command2.Caption = "Replace" 67 | End Sub 68 | -------------------------------------------------------------------------------- /FolderBrowser/SHGetPathFromIDList/Form1.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form1 3 | Caption = "Form1" 4 | ClientHeight = 3015 5 | ClientLeft = 120 6 | ClientTop = 465 7 | ClientWidth = 4560 8 | LinkTopic = "Form1" 9 | ScaleHeight = 3015 10 | ScaleWidth = 4560 11 | StartUpPosition = 3 'Windows-Standard 12 | Begin VB.CommandButton Command1 13 | Caption = "Command1" 14 | Height = 615 15 | Left = 240 16 | TabIndex = 0 17 | Top = 360 18 | Width = 2415 19 | End 20 | End 21 | Attribute VB_Name = "Form1" 22 | Attribute VB_GlobalNameSpace = False 23 | Attribute VB_Creatable = False 24 | Attribute VB_PredeclaredId = True 25 | Attribute VB_Exposed = False 26 | Option Explicit 27 | 28 | Private Const SpecialFolder_Personal As Long = &H5& ' = CSIDL_PERSONAL 29 | 30 | Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pIdl As Long) As Long 31 | 32 | 'Private Declare Function SHGetPathFromIDListA Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long 33 | Private Declare Function SHGetPathFromIDListW Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As Long) As Long 34 | 35 | Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByRef pv As Any) 36 | 37 | 38 | 'VB 5/6-Tipp 0061: Windows-Verzeichnisse erfassen: 'http://www.activevb.de/tipps/vb6tipps/tipp0061.html 39 | 40 | Private Sub Command1_Click() 41 | MsgBox GetSpecialFolder(SpecialFolder_Personal) 42 | End Sub 43 | 44 | Function GetSpecialFolder(ByVal spf As Long) As String 45 | Dim pIdl As Long 46 | If SHGetSpecialFolderLocation(Me.hWnd, SpecialFolder_Personal, pIdl) <> 0 Then Exit Function 47 | Dim m_Buffer As String: m_Buffer = String$(1024, vbNullChar) 48 | 'If SHGetPathFromIDListA(pIdl, m_Buffer) = 0 Then Exit Sub 49 | If SHGetPathFromIDListW(pIdl, StrPtr(m_Buffer)) = 0 Then Exit Function 50 | CoTaskMemFree pIdl 51 | Dim l As Long: l = InStr(m_Buffer, vbNullChar) - 1 52 | If l <= 0 Then Exit Function 53 | GetSpecialFolder = Left$(m_Buffer, l) 54 | End Function 55 | -------------------------------------------------------------------------------- /PWinDialogs.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Form=Forms\FMain.frm 4 | Module=MCallBack; Modules\MCallBack.bas 5 | Module=MObjPtr; Modules\MObjPtr.bas 6 | Module=MComDlgCtrl; Modules\MComDlgCtrl.bas 7 | Module=MApp; Modules\MApp.bas 8 | Module=MWin; Modules\MWin.bas 9 | Module=MFontDialog; Modules\MFontDialog.bas 10 | Module=MFont; Modules\MFont.bas 11 | Module=MPrinterPaper; Modules\MPrinter.bas 12 | Module=MFindReplaceDialog; Modules\MFindReplaceDialog.bas 13 | Class=ColorDialog; Classes\ColorDialog.cls 14 | Class=FolderBrowserDialog; Classes\FolderBrowserDialog.cls 15 | Class=FontDialog; Classes\FontDialog.cls 16 | Class=ICallBack; Classes\ICallBack.cls 17 | Class=OpenFileDialog; Classes\OpenFileDialog.cls 18 | Class=SaveFileDialog; Classes\SaveFileDialog.cls 19 | Class=OpenFolderDialog; Classes\OpenFolderDialog.cls 20 | Class=MessageBox; Classes\MessageBox.cls 21 | Class=MyFontDialog; Classes\MyFontDialog.cls 22 | Class=PrintDialog; Classes\PrintDialog.cls 23 | Class=TaskDialogSE; Classes\TaskDialogSE.cls 24 | Class=PageSetupDialog; Classes\PageSetupDialog.cls 25 | Class=FindReplaceDialog; Classes\FindReplaceDialog.cls 26 | Module=MFileDlg; Modules\MFileDlg.bas 27 | ResFile32="Resources\MyRes.RES" 28 | IconForm="FMain" 29 | Startup="Sub Main" 30 | HelpFile="" 31 | Title="PWinDialogs" 32 | ExeName32="WinDialogs.exe" 33 | Command32="" 34 | Name="PWinDialogs" 35 | HelpContextID="0" 36 | CompatibleMode="0" 37 | MajorVer=2024 38 | MinorVer=10 39 | RevisionVer=17 40 | AutoIncrementVer=0 41 | ServerSupportFiles=0 42 | VersionCompanyName="MBO-Ing.com" 43 | VersionFileDescription="Unicode Standard Windows Dialogs and MessageBox with or without using the old Common-Dialog-Control or MsgBox-function" 44 | VersionLegalCopyright="MBO-Ing.com" 45 | VersionProductName="WinDialogs" 46 | CompilationType=0 47 | OptimizationType=0 48 | FavorPentiumPro(tm)=0 49 | CodeViewDebugInfo=0 50 | NoAliasing=0 51 | BoundsCheck=0 52 | OverflowCheck=0 53 | FlPointCheck=0 54 | FDIVCheck=0 55 | UnroundedFP=0 56 | StartMode=0 57 | Unattended=0 58 | Retained=0 59 | ThreadPerObject=0 60 | MaxNumberOfThreads=1 61 | 62 | [MS Transaction Server] 63 | AutoRefresh=1 64 | 65 | [RVB] 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Win_Dialogs 2 | ## Unicode standard windows dialogs and messagebox 3 | 4 | [![GitHub](https://img.shields.io/github/license/OlimilO1402/Win_Dialogs?style=plastic)](https://github.com/OlimilO1402/Win_Dialogs/blob/master/LICENSE) 5 | [![GitHub release (latest by date)](https://img.shields.io/github/v/release/OlimilO1402/Win_Dialogs?style=plastic)](https://github.com/OlimilO1402/Win_Dialogs/releases/latest) 6 | [![Github All Releases](https://img.shields.io/github/downloads/OlimilO1402/Win_Dialogs/total.svg)](https://github.com/OlimilO1402/Win_Dialogs/releases/download/v1.0.16/WinDialogs_v1.0.16.zip) 7 | [![Follow](https://img.shields.io/github/followers/OlimilO1402.svg?style=social&label=Follow&maxAge=2592000)](https://github.com/OlimilO1402/Win_Dialogs/watchers) 8 | 9 | Project started in may 2006 10 | 11 | contains classes for the very often used typical windows dialogs: 12 | * ColorDialog 13 | * FontDialog 14 | * OpenFileDialog 15 | * SaveFileDialog 16 | * OpenFolderDialog (replaces FolderBrowserDialog) 17 | * MessageBox 18 | * PageSetupDialog 19 | * PrintDialog 20 | 21 | they work mostly the same as the correspondent classes from System.Windows.Forms. 22 | The classes are running in VB6 (aka VBC) as well as in VBA6 or VBA7 x86 or Win64. 23 | You may also have a look at the tutorial: [XL_VBanywhere](https://github.com/OlimilO1402/XL_VBanywhere) 24 | 25 | Special thanks goes to [Frank Schüler](https://foren.activevb.de/community/mitglieder/details/d32526d3b730ccd55be4fb3b72de8e03/) for his great efforts on OpenFolderDialog 26 | 27 | ![WinDialogs Image](Resources/WinDialogs.png "Windialogs Image") 28 | ![OpenFileDialog Image](Resources/Pictures/OpenFileDialog.png "OpenFileDialog Image") 29 | ![SaveFileDialog Image](Resources/Pictures/SaveFileDialog.png "SaveFileDialog Image") 30 | ![ColorDialog Image](Resources/Pictures/ColorDialog.png "ColorDialog Image") 31 | ![FontDialog Image](Resources/Pictures/FontDialog.png "FontDialog Image") 32 | ![FontDialogWHook Image](Resources/Pictures/FontDialogWHook.png "FontDialogWHook Image") 33 | ![OpenFolderDialog Image](Resources/Pictures/OpenFolderDialog.png "OpenFolderDialog Image") 34 | ![OpenFileFolderDialog Image](Resources/Pictures/OpenFileFolderDialog.png "OpenFileFolderDialog Image") 35 | ![FolderBrowserDialog Image](Resources/Pictures/FolderBrowserDialog.png "FolderBrowserDialog Image") 36 | ![PageSetupDialog Image](Resources/Pictures/PageSetupDialog.png "PageSetupDialog Image") 37 | ![PrintDialog Image](Resources/Pictures/PrintDialog.png "PrintDialog Image") 38 | ![PrintDialogEx Image](Resources/Pictures/PrintDialogEx.png "PrintDialogEx Image") 39 | ![PrintDialogWinUI Image](Resources/Pictures/PrintDialogWinUI.png "PrintDialogWinUI Image") 40 | -------------------------------------------------------------------------------- /Modules/MComDlgCtrl.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MComDlgCtrl" 2 | Option Explicit 3 | 4 | Public Function MessCommonDlgError(E As Long) As String 5 | 'Public Function MessCommonDlgError(E As MSComDlg.ErrorConstants) As String 6 | ' Dim s As String 7 | ' Select Case E 8 | ' Case cdlDialogFailure: s = "Dialog Failure" '= -32768 (&HFFFF8000) 9 | ' Case cdlHelp: s = "Help" '= 32751 (&H7FEF) 10 | ' Case cdlAlloc: s = "Alloc" '= 32752 (&H7FF0) 11 | ' Case cdlCancel: s = "Cancel" '= 32755 (&H7FF3) 12 | ' Case cdlMemLockFailure: s = "Mem Lock Failure" '= 32757 (&H7FF5) 13 | ' Case cdlMemAllocFailure: s = "Mem Alloc Failure" '= 32758 (&H7FF6) 14 | ' Case cdlLockResFailure: s = "Lock Res Failure" '= 32759 (&H7FF7) 15 | ' Case cdlLoadResFailure: s = "Load Res Failure" '= 32760 (&H7FF8) 16 | ' Case cdlFindResFailure: s = "Find Res Failure" '= 32761 (&H7FF9) 17 | ' Case cdlLoadStrFailure: s = "Load Str Failure" '= 32762 (&H7FFA) 18 | ' Case cdlNoInstance: s = "No Instance" '= 32763 (&H7FFB) 19 | ' Case cdlNoTemplate: s = "No Template" '= 32764 (&H7FFC) 20 | ' Case cdlInitialization: s = "Initialization" '= 32765 (&H7FFD) 21 | ' Case cdlInvalidPropertyValue: s = "Invalid Property Value" '= 380 (&H17C) 22 | ' Case cdlSetNotSupported: s = "Set Not Supported" '= 383 (&H17F) 23 | ' Case cdlGetNotSupported: s = "Get Not Supported" '= 394 (&H18A) 24 | ' Case cdlInvalidSafeModeProcCall: s = "Invalid Safe Mode Proc Call" '= 680 (&H2A8) 25 | ' Case cdlBufferTooSmall: s = "Buffer Too Small" '= 20476 (&H4FFC) 26 | ' Case cdlInvalidFileName: s = "Invalid FileName" '= 20477 (&H4FFD) 27 | ' Case cdlSubclassFailure: s = "Subclass Failure" '= 20478 (&H4FFE) 28 | ' Case cdlNoFonts: s = "No Fonts" '= 24574 (&H5FFE) 29 | ' Case cdlPrinterNotFound: s = "Printer Not Found" '= 28660 (&H6FF4) 30 | ' Case cdlCreateICFailure: s = "Create IC Failure" '= 28661 (&H6FF5) 31 | ' Case cdlDndmMismatch: s = "Dndm Mismatch" '= 28662 (&H6FF6) 32 | ' Case cdlNoDefaultPrn: s = "No Default Prn" '= 28663 (&H6FF7) 33 | ' Case cdlNoDevices: s = "No Devices" '= 28664 (&H6FF8) 34 | ' Case cdlInitFailure: s = "Init Failure" ' 28665 (&H6FF9) 35 | ' Case cdlGetDevModeFail: s = "Get Dev Mode Fail" '= 28666 (&H6FFA) 36 | ' Case cdlLoadDrvFailure: s = "Load Drv Failure" '= 28667 (&H6FFB) 37 | ' Case cdlRetDefFailure: s = "Ret Def Failure" '= 28668 (&H6FFC) 38 | ' Case cdlParseFailure: s = "Parse Failure" '= 28669 (&H6FFD) 39 | ' End Select 40 | ' MessCommonDlgError = s 41 | End Function 42 | 43 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/Resources.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | 15 | Namespace My.Resources 16 | 17 | 'This class was auto-generated by the StronglyTypedResourceBuilder 18 | 'class via a tool like ResGen or Visual Studio. 19 | 'To add or remove a member, edit your .ResX file then rerun ResGen 20 | 'with the /str option, or rebuild your VS project. 21 | ''' 22 | ''' A strongly-typed resource class, for looking up localized strings, etc. 23 | ''' 24 | _ 28 | Friend Module Resources 29 | 30 | Private resourceMan As Global.System.Resources.ResourceManager 31 | 32 | Private resourceCulture As Global.System.Globalization.CultureInfo 33 | 34 | ''' 35 | ''' Returns the cached ResourceManager instance used by this class. 36 | ''' 37 | _ 38 | Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager 39 | Get 40 | If Object.ReferenceEquals(resourceMan, Nothing) Then 41 | Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("VBN_IFileDialog.Resources", GetType(Resources).Assembly) 42 | resourceMan = temp 43 | End If 44 | Return resourceMan 45 | End Get 46 | End Property 47 | 48 | ''' 49 | ''' Overrides the current thread's CurrentUICulture property for all 50 | ''' resource lookups using this strongly typed resource class. 51 | ''' 52 | _ 53 | Friend Property Culture() As Global.System.Globalization.CultureInfo 54 | Get 55 | Return resourceCulture 56 | End Get 57 | Set(ByVal value As Global.System.Globalization.CultureInfo) 58 | resourceCulture = value 59 | End Set 60 | End Property 61 | End Module 62 | End Namespace 63 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/Settings.Designer.vb: -------------------------------------------------------------------------------- 1 | '------------------------------------------------------------------------------ 2 | ' 3 | ' This code was generated by a tool. 4 | ' Runtime Version:4.0.30319.42000 5 | ' 6 | ' Changes to this file may cause incorrect behavior and will be lost if 7 | ' the code is regenerated. 8 | ' 9 | '------------------------------------------------------------------------------ 10 | 11 | Option Strict On 12 | Option Explicit On 13 | 14 | 15 | Namespace My 16 | 17 | _ 20 | Partial Friend NotInheritable Class MySettings 21 | Inherits Global.System.Configuration.ApplicationSettingsBase 22 | 23 | Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings), MySettings) 24 | 25 | #Region "My.Settings Auto-Save Functionality" 26 | #If _MyType = "WindowsForms" Then 27 | Private Shared addedHandler As Boolean 28 | 29 | Private Shared addedHandlerLockObject As New Object 30 | 31 | _ 32 | Private Shared Sub AutoSaveSettings(ByVal sender As Global.System.Object, ByVal e As Global.System.EventArgs) 33 | If My.Application.SaveMySettingsOnExit Then 34 | My.Settings.Save() 35 | End If 36 | End Sub 37 | #End If 38 | #End Region 39 | 40 | Public Shared ReadOnly Property [Default]() As MySettings 41 | Get 42 | 43 | #If _MyType = "WindowsForms" Then 44 | If Not addedHandler Then 45 | SyncLock addedHandlerLockObject 46 | If Not addedHandler Then 47 | AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings 48 | addedHandler = True 49 | End If 50 | End SyncLock 51 | End If 52 | #End If 53 | Return defaultInstance 54 | End Get 55 | End Property 56 | End Class 57 | End Namespace 58 | 59 | Namespace My 60 | 61 | _ 64 | Friend Module MySettingsProperty 65 | 66 | _ 67 | Friend ReadOnly Property Settings() As Global.VBN_IFileDialog.My.MySettings 68 | Get 69 | Return Global.VBN_IFileDialog.My.MySettings.Default 70 | End Get 71 | End Property 72 | End Module 73 | End Namespace 74 | -------------------------------------------------------------------------------- /Modules/MWin.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MWin" 2 | Option Explicit 3 | 4 | 'typedef struct tagHELPINFO { 5 | ' UINT cbSize; 6 | ' int iContextType; 7 | ' int iCtrlId; 8 | ' HANDLE hItemHandle; 9 | ' DWORD_PTR dwContextId; 10 | ' POINT MousePos; 11 | '} HELPINFO, *LPHELPINFO; 12 | 13 | Private Type HelpInfo 14 | cbSize As Long 15 | iContextType As Long 16 | iCtrlId As Long 17 | hItemHandle As Long 'Ptr 18 | dwContextId As Long 19 | MousePosX As Long 20 | MousePosY As Long 21 | End Type 22 | 23 | Private m_HelpInfo As HelpInfo 24 | 25 | Public LastMsgBoxResult As String 26 | 27 | Public Function MessageBoxCallBack(lpHelpInfo As HelpInfo) As Long 28 | m_HelpInfo = lpHelpInfo 29 | End Function 30 | 31 | Public Function HelpInfo_ToStr() As String 32 | Dim s As String 33 | With m_HelpInfo 34 | s = "HelpInfo{" & vbCrLf 35 | s = s & " cbSize : " & .cbSize & vbCrLf 36 | s = s & " iContextType: " & .iContextType & vbCrLf 37 | s = s & " iCtrlId : " & .iCtrlId & vbCrLf 38 | s = s & " hItemHandle : " & .hItemHandle & vbCrLf 39 | s = s & " dwContextId : " & .dwContextId & vbCrLf 40 | s = s & " MousePosX : " & .MousePosX & vbCrLf 41 | s = s & " MousePosY : " & .MousePosY & vbCrLf 42 | s = s & "}" 43 | End With 44 | HelpInfo_ToStr = s 45 | End Function 46 | 47 | Public Function DialogResult_ToStr(ByVal VbMsgBoxOrDialogOrAnyOtherResult As Long) As String 48 | Dim e As Long: e = VbMsgBoxOrDialogOrAnyOtherResult 49 | Dim s As String 50 | Select Case e 51 | Case 1: s = "OK" 52 | Case 2: s = "Cancel" 53 | Case 3: s = "Abort" 54 | Case 4: s = "Retry" 55 | Case 5: s = "Ignore" 56 | Case 6: s = "Yes" 57 | Case 7: s = "No" 58 | Case 8: s = "Close" 59 | Case 9: s = "9" 60 | Case 10: s = "TryAgain" 61 | Case 11: s = "Continue" 62 | End Select 63 | DialogResult_ToStr = s 64 | End Function 65 | 66 | Public Function MsgBox(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As Variant, Optional HelpFile As Variant, Optional Context As Variant) As VbMsgBoxResult 67 | ' Dim mb As MessageBox: Set mb = New MessageBox 68 | ' With mb 69 | ' .MsgBoxFncType = vbNormal 70 | ' .Prompt = Prompt 71 | ' .Style = Buttons 72 | ' If Not IsMissing(Title) Then .Title = Title 73 | ' MsgBox = .Show 74 | ' LastResult = .Result_ToStr 75 | ' End With 76 | 77 | 'oder so: 78 | Dim mb As New MessageBox 79 | MsgBox = mb.Show(Prompt, Buttons, Title, HelpFile, Context) 80 | LastMsgBoxResult = mb.Result_ToStr 81 | End Function 82 | 83 | 'Property Get App_EXEName() As String 84 | '#If VBA6 Or VBA7 Then 85 | ' App_EXEName = Application.Name 86 | '#Else 87 | ' App_EXEName = App.EXEName 88 | '#End If 89 | 'End Property 90 | 'Public Function MsgBox(Prompt, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title) As VbMsgBoxResult 91 | ''Public Function MsgBox(Prompt, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title, Optional Helpfile, Optional Context) As VbMsgBoxResult 92 | ' Title = IIf(IsMissing(Title), App_EXEName, CStr(Title)) 93 | ' MsgBox = MessageBoxW(0, StrPtr(Prompt), StrPtr(Title), Buttons) 94 | 'End Function 95 | -------------------------------------------------------------------------------- /archiv/VBC_Tipp0759_TiKu/MSubclassing.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MSubClassing" 2 | Option Explicit 3 | 4 | #If VBA7 = 0 Then 5 | Public Enum LongPtr 6 | [_] 7 | End Enum 8 | #End If 9 | Public Enum ESubclassID 10 | escidFrmMain = 1 11 | 'escidFrmMainCmdOk 12 | '... 13 | End Enum 14 | 15 | 'https://learn.microsoft.com/de-de/windows/win32/api/commctrl/ 16 | 17 | 'https://learn.microsoft.com/de-de/windows/win32/api/commctrl/nf-commctrl-setwindowsubclass 18 | Private Declare Function SetWindowSubclass Lib "comctl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As Long 19 | 20 | 'https://learn.microsoft.com/de-de/windows/win32/api/commctrl/nf-commctrl-defsubclassproc 21 | 'LRESULT DefSubclassProc( [in] HWND hWnd, [in] UINT uMsg, [in] WPARAM wParam, [in] LPARAM lParam ); 22 | Public Declare Function DefSubclassProc Lib "comctl32" (ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr 23 | 24 | 'https://learn.microsoft.com/de-de/windows/win32/api/commctrl/nf-commctrl-removewindowsubclass 25 | 'BOOL RemoveWindowSubclass( [in] HWND hWnd, [in] SUBCLASSPROC pfnSubclass, [in] UINT_PTR uIdSubclass ); 26 | Private Declare Function RemoveWindowSubclass Lib "comctl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, ByVal uIdSubclass As LongPtr) As Long 27 | 28 | 'https://learn.microsoft.com/de-de/windows/win32/api/commctrl/nc-commctrl-subclassproc 29 | 'SUBCLASSPROC Subclassproc; LRESULT Subclassproc( HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam, UINT_PTR uIdSubclass, DWORD_PTR dwRefData ) {...} 30 | 31 | Public Declare Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal bytLength As Long) 32 | Public Declare Sub RtlZeroMemory Lib "kernel32" (ByRef pDst As Any, ByVal sz As Long) 33 | 34 | Public Function SubclassProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr, ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr 35 | Try: On Error GoTo Catch 36 | Dim bCallDefProc As Boolean: bCallDefProc = True 37 | If dwRefData Then 38 | Dim SCWnd As ISubclassedWindow: Set SCWnd = GetObjectFromPointer(dwRefData) 39 | If Not (SCWnd Is Nothing) Then 40 | SubclassProc = SCWnd.HandleMessage(hWnd, uMsg, wParam, lParam, uIdSubclass, bCallDefProc) 41 | End If 42 | End If 43 | On Error Resume Next 44 | If bCallDefProc Then 45 | Dim lr As LongPtr: lr = DefSubclassProc(hWnd, uMsg, wParam, lParam) 46 | End If 47 | Exit Function 48 | Catch: 49 | Debug.Print "Error in SubclassProc: ", Err.Number, Err.Description 50 | End Function 51 | 52 | Public Function SubclassWindow(ByVal hWnd As LongPtr, SCWnd As ISubclassedWindow, ByVal scID As ESubclassID) As Boolean 53 | Try: On Error GoTo Catch 54 | SubclassWindow = SetWindowSubclass(hWnd, AddressOf MSubClassing.SubclassProc, scID, ObjPtr(SCWnd)) <> 0 55 | Exit Function 56 | Catch: 57 | Debug.Print "Error in SubclassWindow: ", Err.Number, Err.Description 58 | End Function 59 | 60 | Public Function UnSubclassWindow(ByVal hWnd As LongPtr, ByVal scID As ESubclassID) As Boolean 61 | Try: On Error GoTo Catch 62 | UnSubclassWindow = RemoveWindowSubclass(hWnd, AddressOf MSubClassing.SubclassProc, scID) <> 0 63 | Exit Function 64 | Catch: 65 | Debug.Print "Error in Function UnSubclassWindow: ", Err.Number, Err.Description 66 | End Function 67 | 68 | ' returns the object points to 69 | Private Function GetObjectFromPointer(ByVal pObj As LongPtr) As Object 70 | Dim Obj As Object: RtlMoveMemory ByVal VarPtr(Obj), ByVal VarPtr(pObj), LenB(pObj) 71 | Set GetObjectFromPointer = Obj 72 | RtlZeroMemory ByVal VarPtr(Obj), LenB(pObj) 73 | End Function 74 | -------------------------------------------------------------------------------- /Modules/MFont.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MFont" 2 | Option Explicit 3 | 4 | 'Extensions to the class VBA.StdFont 5 | Function New_StdFont(s As String) As StdFont 6 | Set New_StdFont = New StdFont 7 | Dim sLines() As String: sLines = Split(s, "{") 8 | If LCase(Strings.Trim(sLines(0))) <> "stdfont" Then Exit Function 9 | sLines = Split(sLines(1), vbCrLf) 10 | Dim i As Long, sElems() As String, sKey As String, sVal As String 11 | For i = LBound(sLines) + 1 To UBound(sLines) - 1 12 | sElems() = Split(sLines(i), "=") 13 | sKey = LCase(Trim(sElems(0))) 14 | If UBound(sElems) > 0 Then 15 | sVal = Trim(sElems(1)) 16 | With New_StdFont 17 | Select Case sKey 18 | Case "name": .Name = sVal 19 | Case "bold": .Bold = Boolean_Parse(sVal) 20 | Case "charset": .Charset = CInt(sVal) 21 | Case "italic": .Italic = Boolean_Parse(sVal) 22 | Case "size": .Size = CCur(sVal) 23 | Case "strikethrough": .Strikethrough = Boolean_Parse(sVal) 24 | Case "underline": .Underline = Boolean_Parse(sVal) 25 | Case "weight": .Weight = CInt(sVal) 26 | End Select 27 | End With 28 | End If 29 | Next 30 | End Function 31 | 32 | Public Function StdFont_Clone(this As StdFont) As StdFont 33 | Dim DstF As New StdFont: StdFont_Copy DstF, this 34 | Set StdFont_Clone = DstF 'StdFont_Copy(New StdFont, this) 35 | End Function 36 | 37 | Public Sub StdFont_Copy(DstFont As StdFont, SrcFont As StdFont) 38 | With DstFont 39 | .Name = SrcFont.Name 40 | .Size = SrcFont.Size 41 | .Bold = SrcFont.Bold 42 | .Italic = SrcFont.Italic 43 | .Weight = SrcFont.Weight 44 | .Charset = SrcFont.Charset 45 | .Underline = SrcFont.Underline 46 | .Strikethrough = SrcFont.Strikethrough 47 | End With 48 | End Sub 49 | 50 | Public Function StdFont_Equals(this As StdFont, other As StdFont) As Boolean 51 | Dim b As Boolean 52 | With this 53 | b = .Name = other.Name: If Not b Then Exit Function 54 | b = .Size = other.Size: If Not b Then Exit Function 55 | b = .Bold = other.Bold: If Not b Then Exit Function 56 | b = .Italic = other.Italic: If Not b Then Exit Function 57 | b = .Weight = other.Weight: If Not b Then Exit Function 58 | b = .Charset = other.Charset: If Not b Then Exit Function 59 | b = .Underline = other.Underline: If Not b Then Exit Function 60 | b = .Strikethrough = other.Strikethrough: If Not b Then Exit Function 61 | End With 62 | StdFont_Equals = True 63 | End Function 64 | 65 | Public Function StdFont_ToStr(this As StdFont) As String 66 | Dim s As String: s = "StdFont{" & vbCrLf 67 | With this 68 | s = s & "Name: " & .Name & vbCrLf 69 | s = s & "Size: " & .Size & vbCrLf 70 | s = s & "Bold: " & .Bold & vbCrLf 71 | s = s & "Italic: " & .Italic & vbCrLf 72 | s = s & "Weight: " & .Weight & vbCrLf 73 | s = s & "Charset: " & .Charset & vbCrLf 74 | s = s & "Underline: " & .Underline & vbCrLf 75 | s = s & "Strikethrough: " & .Strikethrough & vbCrLf 76 | End With 77 | StdFont_ToStr = s & "}" 78 | End Function 79 | 80 | Function Boolean_Parse(ByVal sVal As String) As Boolean 81 | Dim b As Boolean 82 | sVal = LCase(sVal) 83 | Select Case True 84 | Case sVal = "falsch": b = False 85 | Case sVal = "false": b = False 86 | Case sVal = "nein": b = False 87 | Case sVal = "no": b = False 88 | Case sVal = "wahr": b = True 89 | Case sVal = "true": b = True 90 | Case sVal = "yes": b = True 91 | Case sVal = "ja": b = True 92 | End Select 93 | Boolean_Parse = b 94 | End Function 95 | 96 | -------------------------------------------------------------------------------- /Modules/MCallBack.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MCallBack" 2 | Option Explicit 3 | Private Const WM_USER As Long = &H400& 4 | Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100) 5 | Private Const BFFM_ENABLEOK As Long = (WM_USER + 101) '1125 6 | Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102) '1126 7 | Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103) '1127 8 | Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104) '1128 9 | 10 | Private Const BFFM_INITIALIZED As Long = 1 11 | Private Const BFFM_SELCHANGED As Long = 2 12 | 'Private Const BFFM_VALIDATEFAILEDA As Long = 3 13 | 'Private Const BFFM_VALIDATEFAILEDW As Long = 4 14 | #If VBA7 Then 15 | Private Declare PtrSafe Function SHGetPathFromIDListW Lib "shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As LongPtr) As Long 16 | Private Declare PtrSafe Function SendMessageW Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long 17 | #Else 18 | Private Declare Function SHGetPathFromIDListW Lib "shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As LongPtr) As Long 19 | Private Declare Function SendMessageW Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long 20 | #End If 21 | 22 | 'Public Function FolderBrowserDialogCallBack(ByVal hwnd As Long, ByVal msg As Long, ByVal lParam As Long, ByVal lpData As Object) As Long 23 | Public Function FolderBrowserDialogCallBack(ByVal hwnd As LongPtr, ByVal Msg As LongPtr, ByVal lParam As LongPtr, ByVal lpData As LongPtr) As LongPtr 24 | ' 'If lpData = 0 Then Exit Function 'Is Nothing Then 25 | ' 'Dim fbd As FolderBrowserDialog: Set fbd = MObjPtr.CObj(lpData) 26 | ' 'Dim icb As ICallBack: Set icb = fbd 27 | ' 'icb.CallBack hwnd, msg, lParam 28 | ' 'Set icb = Nothing 29 | ' 'MObjPtr.ZeroObj fbd 30 | ' If Not lpData Is Nothing Then 31 | ' If TypeOf lpData Is ICallBack Then 32 | ' Call CCallBack(lpData).CallBack(hwnd, msg, lParam) 33 | ' End If 34 | ' End If 35 | Try: On Error GoTo Catch 36 | 37 | 38 | 'Dim rv As LongPtr 39 | Dim hr As LongPtr 40 | 41 | Select Case Msg 42 | Case BFFM_INITIALIZED 43 | 'If (Len(mSelectedPath) > 0) Then 44 | hr = SendMessageW(hwnd, BFFM_SETSELECTIONW, 1&, ByVal lpData) 45 | 'End If 46 | Case BFFM_SELCHANGED 47 | If (lParam <> 0&) Then 48 | Dim Buffer As String: Buffer = String$(1024, vbNullChar) 49 | hr = SHGetPathFromIDListW(lParam, ByVal StrPtr(Buffer)) 50 | If hr = 1 Then 51 | hr = SendMessageW(hwnd, BFFM_ENABLEOK, 0, ByVal 1) 52 | hr = SendMessageW(hwnd, BFFM_SETSTATUSTEXTA, 0, StrPtr(Buffer)) 53 | ElseIf hr = 0 Then 54 | hr = SendMessageW(hwnd, BFFM_ENABLEOK, 0, ByVal 0) 55 | End If 56 | 'CoTaskMemFree VarPtr(lParam) 57 | End If 58 | End Select 59 | 60 | Catch: 61 | 62 | 63 | 'Code by CallunWillock: 64 | ' 65 | ' Private Function BrowseCallbackProc(ByVal hwnd As LongPtr, ByVal Msg As LongPtr, ByVal Pointer As LongPtr, ByVal Data As LongPtr) As LongPtr 66 | ' On Error Resume Next 67 | ' 68 | ' Dim Result As Long 69 | ' Dim Buffer As String 70 | ' 71 | ' Select Case Msg 72 | ' Case BFFM_INITIALIZED 73 | ' Call SendMessageW(hwnd, BFFM_SETSELECTION, 1&, Data) 74 | ' Case BFFM_SELCHANGED 75 | ' Buffer = Space(MAX_PATH) 76 | ' Result = SHGetPathFromIDListW(Pointer, StrPtr(Buffer)) 77 | ' If Result = 1 Then 78 | ' Call SendMessageW(hwnd, BFFM_SETSTATUSTEXTA, 0, StrPtr(Buffer)) 79 | ' End If 80 | ' End Select 81 | ' BrowseCallbackProc = 0 82 | ' End Function 83 | 84 | 85 | 86 | End Function 87 | 88 | 'Public Function CCallBack(ByVal obj As Object) As ICallBack 89 | ' Set CCallBack = obj 90 | 'End Function 91 | ' 92 | ' HWND unnamedParam1, 93 | ' UINT unnamedParam2, 94 | ' WPARAM unnamedParam3, 95 | ' lParam unnamedParam4 96 | 97 | Public Function FindReplaceCallBack(ByVal param1 As LongPtr, ByVal param2 As LongPtr, ByVal param3 As LongPtr, ByVal param4 As LongPtr) 98 | ' 99 | 100 | End Function 101 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/Form1.Designer.vb: -------------------------------------------------------------------------------- 1 | _ 2 | Partial Class Form1 3 | Inherits System.Windows.Forms.Form 4 | 5 | 'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. 6 | _ 7 | Protected Overrides Sub Dispose(ByVal disposing As Boolean) 8 | Try 9 | If disposing AndAlso components IsNot Nothing Then 10 | components.Dispose() 11 | End If 12 | Finally 13 | MyBase.Dispose(disposing) 14 | End Try 15 | End Sub 16 | 17 | 'Wird vom Windows Form-Designer benötigt. 18 | Private components As System.ComponentModel.IContainer 19 | 20 | 'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich. 21 | 'Das Bearbeiten ist mit dem Windows Form-Designer möglich. 22 | 'Das Bearbeiten mit dem Code-Editor ist nicht möglich. 23 | _ 24 | Private Sub InitializeComponent() 25 | Me.Button1 = New System.Windows.Forms.Button() 26 | Me.Button2 = New System.Windows.Forms.Button() 27 | Me.Button3 = New System.Windows.Forms.Button() 28 | Me.Button4 = New System.Windows.Forms.Button() 29 | Me.Button5 = New System.Windows.Forms.Button() 30 | Me.Button6 = New System.Windows.Forms.Button() 31 | Me.SuspendLayout() 32 | ' 33 | 'Button1 34 | ' 35 | Me.Button1.Location = New System.Drawing.Point(12, 12) 36 | Me.Button1.Name = "Button1" 37 | Me.Button1.Size = New System.Drawing.Size(211, 41) 38 | Me.Button1.TabIndex = 0 39 | Me.Button1.Text = "OpenFileDialog with Events and Customize" 40 | Me.Button1.UseVisualStyleBackColor = True 41 | ' 42 | 'Button2 43 | ' 44 | Me.Button2.Location = New System.Drawing.Point(229, 12) 45 | Me.Button2.Name = "Button2" 46 | Me.Button2.Size = New System.Drawing.Size(211, 41) 47 | Me.Button2.TabIndex = 1 48 | Me.Button2.Text = "OpenFileDialog" 49 | Me.Button2.UseVisualStyleBackColor = True 50 | ' 51 | 'Button3 52 | ' 53 | Me.Button3.Location = New System.Drawing.Point(12, 59) 54 | Me.Button3.Name = "Button3" 55 | Me.Button3.Size = New System.Drawing.Size(211, 41) 56 | Me.Button3.TabIndex = 2 57 | Me.Button3.Text = "SaveFileDialog" 58 | Me.Button3.UseVisualStyleBackColor = True 59 | ' 60 | 'Button4 61 | ' 62 | Me.Button4.Location = New System.Drawing.Point(230, 59) 63 | Me.Button4.Name = "Button4" 64 | Me.Button4.Size = New System.Drawing.Size(211, 41) 65 | Me.Button4.TabIndex = 3 66 | Me.Button4.Text = "PickFolderDialog" 67 | Me.Button4.UseVisualStyleBackColor = True 68 | ' 69 | 'Button5 70 | ' 71 | Me.Button5.Location = New System.Drawing.Point(12, 106) 72 | Me.Button5.Name = "Button5" 73 | Me.Button5.Size = New System.Drawing.Size(211, 41) 74 | Me.Button5.TabIndex = 4 75 | Me.Button5.Text = "Locked PickFolderDialog with Events" 76 | Me.Button5.UseVisualStyleBackColor = True 77 | ' 78 | 'Button6 79 | ' 80 | Me.Button6.Location = New System.Drawing.Point(229, 106) 81 | Me.Button6.Name = "Button6" 82 | Me.Button6.Size = New System.Drawing.Size(211, 41) 83 | Me.Button6.TabIndex = 5 84 | Me.Button6.Text = "OpenFileDialog EditorStyle without Events" 85 | Me.Button6.UseVisualStyleBackColor = True 86 | ' 87 | 'Form1 88 | ' 89 | Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) 90 | Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font 91 | Me.ClientSize = New System.Drawing.Size(453, 155) 92 | Me.Controls.Add(Me.Button6) 93 | Me.Controls.Add(Me.Button5) 94 | Me.Controls.Add(Me.Button4) 95 | Me.Controls.Add(Me.Button3) 96 | Me.Controls.Add(Me.Button2) 97 | Me.Controls.Add(Me.Button1) 98 | Me.Name = "Form1" 99 | Me.Text = "OpenFile-/SaveFile-/PickFolderDialog (Single Select)" 100 | Me.ResumeLayout(False) 101 | 102 | End Sub 103 | 104 | Friend WithEvents Button1 As Button 105 | Friend WithEvents Button2 As Button 106 | Friend WithEvents Button3 As Button 107 | Friend WithEvents Button4 As Button 108 | Friend WithEvents Button5 As Button 109 | Friend WithEvents Button6 As Button 110 | End Class 111 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/VBN_IFileDialog.vbproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Debug 6 | AnyCPU 7 | {48374BFE-CD4E-4E15-B3A2-1AD7BF3ADE75} 8 | WinExe 9 | VBN_IFileDialog.My.MyApplication 10 | VBN_IFileDialog 11 | VBN_IFileDialog 12 | 512 13 | WindowsForms 14 | v4.7.2 15 | true 16 | true 17 | 18 | 19 | AnyCPU 20 | true 21 | full 22 | true 23 | true 24 | bin\Debug\ 25 | VBN_IFileDialog.xml 26 | 27 | 28 | 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036 29 | 30 | 31 | AnyCPU 32 | pdbonly 33 | false 34 | true 35 | true 36 | bin\Release\ 37 | VBN_IFileDialog.xml 38 | 39 | 40 | 41999,42016,42017,42018,42019,42020,42021,42022,42032,42036 41 | 42 | 43 | On 44 | 45 | 46 | Binary 47 | 48 | 49 | On 50 | 51 | 52 | On 53 | 54 | 55 | User.ico 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | Form 84 | 85 | 86 | Form1.vb 87 | Form 88 | 89 | 90 | 91 | True 92 | Application.myapp 93 | 94 | 95 | True 96 | True 97 | Resources.resx 98 | 99 | 100 | True 101 | Settings.settings 102 | True 103 | 104 | 105 | 106 | 107 | 108 | Form1.vb 109 | 110 | 111 | VbMyResourcesResXFileCodeGenerator 112 | Resources.Designer.vb 113 | My.Resources 114 | Designer 115 | 116 | 117 | 118 | 119 | MyApplicationCodeGenerator 120 | Application.Designer.vb 121 | 122 | 123 | SettingsSingleFileGenerator 124 | My 125 | Settings.Designer.vb 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/My Project/Resources.resx: -------------------------------------------------------------------------------- 1 | 2 | 3 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | text/microsoft-resx 107 | 108 | 109 | 2.0 110 | 111 | 112 | System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 113 | 114 | 115 | System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 116 | 117 | -------------------------------------------------------------------------------- /archiv/VBC_IFileDialog/modFunc.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modFunc" 2 | Option Explicit 3 | 4 | ' ----==== Enums ====---- 5 | Public Enum DialogType 6 | FileOpenDialog = &H0 7 | FileSaveDialog = &H1 8 | End Enum 9 | 10 | Public Enum CDCONTROLSTATEF 11 | CDCS_INACTIVE = &H0 12 | CDCS_ENABLED = &H1 13 | CDCS_VISIBLE = &H2 14 | CDCS_ENABLEDVISIBLE = &H3 15 | End Enum 16 | 17 | Public Enum FDAP 18 | FDAP_BOTTOM = &H0 19 | FDAP_TOP = &H1 20 | End Enum 21 | 22 | Public Enum FILEOPENDIALOGOPTIONS 23 | FOS_OVERWRITEPROMPT = &H2 24 | FOS_STRICTFILETYPES = &H4 25 | FOS_NOCHANGEDIR = &H8 26 | FOS_PICKFOLDERS = &H20 27 | FOS_FORCEFILESYSTEM = &H40 28 | FOS_ALLNONSTORAGEITEMS = &H80 29 | FOS_NOVALIDATE = &H100 30 | FOS_ALLOWMULTISELECT = &H200 31 | FOS_PATHMUSTEXIST = &H800 32 | FOS_FILEMUSTEXIST = &H1000 33 | FOS_CREATEPROMPT = &H2000 34 | FOS_SHAREAWARE = &H4000 35 | FOS_NOREADONLYRETURN = &H8000 36 | FOS_NOTESTFILECREATE = &H10000 37 | FOS_HIDEMRUPLACES = &H20000 38 | FOS_HIDEPINNEDPLACES = &H40000 39 | FOS_NODEREFERENCELINKS = &H100000 40 | FOS_OKBUTTONNEEDSINTERACTION = &H200000 41 | FOS_DONTADDTORECENT = &H2000000 42 | FOS_FORCESHOWHIDDEN = &H10000000 43 | FOS_DEFAULTNOMINIMODE = &H20000000 44 | FOS_FORCEPREVIEWPANEON = &H40000000 45 | FOS_SUPPORTSTREAMABLEITEMS = &H80000000 46 | End Enum 47 | 48 | Public Enum SIGDN 49 | SIGDN_NORMALDISPLAY = &H0 50 | SIGDN_PARENTRELATIVEPARSING = &H80018001 51 | SIGDN_DESKTOPABSOLUTEPARSING = &H80028000 52 | SIGDN_PARENTRELATIVEEDITING = &H80031001 53 | SIGDN_DESKTOPABSOLUTEEDITING = &H8004C000 54 | SIGDN_FILESYSPATH = &H80058000 55 | SIGDN_URL = &H80068000 56 | SIGDN_PARENTRELATIVEFORADDRESSBAR = &H8007C001 57 | SIGDN_PARENTRELATIVE = &H80080001 58 | SIGDN_PARENTRELATIVEFORUI = &H80094001 59 | End Enum 60 | 61 | Public Enum SIATTRIBFLAGS 62 | SIATTRIBFLAGS_AND = 1 63 | SIATTRIBFLAGS_APPCOMPAT = 3 64 | SIATTRIBFLAGS_OR = 2 65 | End Enum 66 | 67 | Public Enum GETPROPERTYSTOREFLAGS 68 | GPS_DEFAULT = &H0 69 | GPS_HANDLERPROPERTIESONLY = &H1 70 | GPS_READWRITE = &H2 71 | GPS_TEMPORARY = &H4 72 | GPS_FASTPROPERTIESONLY = &H8 73 | GPS_OPENSLOWITEM = &H10 74 | GPS_DELAYCREATION = &H20 75 | GPS_BESTEFFORT = &H40 76 | GPS_NO_OPLOCK = &H80 77 | GPS_MASK_VALID = &HFF 78 | End Enum 79 | 80 | Public Enum SFGAOF 81 | SFGAO_CANCOPY = &H1 82 | SFGAO_CANMOVE = &H2 83 | SFGAO_CANLINK = &H4 84 | SFGAO_STORAGE = &H8 85 | SFGAO_CANRENAME = &H10 86 | SFGAO_CANDELETE = &H20 87 | SFGAO_HASPROPSHEET = &H40 88 | SFGAO_DROPTARGET = &H100 89 | SFGAO_CAPABILITYMASK = &H177 90 | SFGAO_ENCRYPTED = &H2000 91 | SFGAO_ISSLOW = &H4000 92 | SFGAO_GHOSTED = &H8000 93 | SFGAO_LINK = &H10000 94 | SFGAO_SHARE = &H20000 95 | SFGAO_READONLY = &H40000 96 | SFGAO_HIDDEN = &H80000 97 | SFGAO_DISPLAYATTRMASK = &HFC000 98 | SFGAO_FILESYSANCESTOR = &H10000000 99 | SFGAO_FOLDER = &H20000000 100 | SFGAO_FILESYSTEM = &H40000000 101 | SFGAO_HASSUBFOLDER = &H80000000 102 | SFGAO_CONTENTSMASK = &H80000000 103 | SFGAO_VALIDATE = &H1000000 104 | SFGAO_REMOVABLE = &H2000000 105 | SFGAO_COMPRESSED = &H4000000 106 | SFGAO_BROWSABLE = &H8000000 107 | SFGAO_NONENUMERATED = &H100000 108 | SFGAO_NEWCONTENT = &H200000 109 | SFGAO_CANMONIKER = &H400000 110 | SFGAO_HASSTORAGE = &H400000 111 | SFGAO_STREAM = &H400000 112 | SFGAO_STORAGEANCESTOR = &H800000 113 | SFGAO_STORAGECAPMASK = &H70C50008 114 | End Enum 115 | 116 | Public Enum SICHINTF 117 | SICHINT_DISPLAY = &H0 118 | SICHINT_ALLFIELDS = &H80000000 119 | SICHINT_CANONICAL = &H10000000 120 | SICHINT_TEST_FILESYSPATH_IF_NOT_EQUAL = &H20000000 121 | End Enum 122 | 123 | ' ----==== Types ====---- 124 | Public Type COMDLG_FILTERSPEC 125 | pszName As String 126 | pszSpec As String 127 | End Type 128 | 129 | Public Type GUID 130 | Data1 As Long 131 | Data2 As Integer 132 | Data3 As Integer 133 | Data4(0 To 7) As Byte 134 | End Type 135 | 136 | Public Type PROPERTYKEY 137 | fmtid As GUID 138 | pid As Long 139 | End Type 140 | 141 | ' ----==== Ole32 API-Deklarationen ====---- 142 | Public Declare Sub CoTaskMemFree Lib "ole32.dll" ( _ 143 | ByVal hMem As Long) 144 | 145 | Public Declare Function IIDFromString Lib "ole32" ( _ 146 | ByVal lpsz As Long, _ 147 | ByVal lpiid As Long) As Long 148 | 149 | Public Declare Function StringFromCLSID Lib "ole32.dll" ( _ 150 | ByRef pCLSID As GUID, _ 151 | ByRef lpszProgID As Long) As Long 152 | 153 | ' ----==== Kernel32 API-Deklarationen ====---- 154 | Public Declare Sub RtlMoveMemory Lib "kernel32" ( _ 155 | ByRef hpvDest As Any, _ 156 | ByRef hpvSource As Any, _ 157 | ByVal cbCopy As Long) 158 | 159 | Private Declare Function lstrlenW Lib "kernel32" ( _ 160 | ByVal lpString As Long) As Long 161 | 162 | ' ----==== StrPtr to String ====---- 163 | Public Function GetStringFromPointer(ByVal lpStrPointer As Long) As String 164 | 165 | Dim lLen As Long 166 | Dim bBuffer() As Byte 167 | 168 | lLen = lstrlenW(lpStrPointer) * 2 - 1 169 | 170 | If lLen > 0 Then 171 | 172 | ReDim bBuffer(lLen) 173 | 174 | Call RtlMoveMemory(bBuffer(0), ByVal lpStrPointer, lLen) 175 | 176 | Call CoTaskMemFree(lpStrPointer) 177 | 178 | GetStringFromPointer = bBuffer 179 | 180 | End If 181 | 182 | End Function 183 | 184 | ' ----==== GUID to String ====---- 185 | Public Function Guid2String(ByRef tguid As GUID) As String 186 | 187 | Dim lGuid As Long 188 | 189 | Call StringFromCLSID(tguid, lGuid) 190 | 191 | Guid2String = GetStringFromPointer(lGuid) 192 | 193 | End Function 194 | 195 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/Form1.resx: -------------------------------------------------------------------------------- 1 | 2 | 3 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | text/microsoft-resx 110 | 111 | 112 | 2.0 113 | 114 | 115 | System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 116 | 117 | 118 | System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 119 | 120 | -------------------------------------------------------------------------------- /archiv/fabel358/orig/Form1.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form Form1 3 | Caption = "Form1" 4 | ClientHeight = 8190 5 | ClientLeft = 120 6 | ClientTop = 465 7 | ClientWidth = 6600 8 | BeginProperty Font 9 | Name = "Segoe UI" 10 | Size = 8.25 11 | Charset = 0 12 | Weight = 400 13 | Underline = 0 'False 14 | Italic = 0 'False 15 | Strikethrough = 0 'False 16 | EndProperty 17 | LinkTopic = "Form1" 18 | ScaleHeight = 8190 19 | ScaleWidth = 6600 20 | StartUpPosition = 3 'Windows-Standard 21 | Begin VB.TextBox Text1 22 | BeginProperty Font 23 | Name = "Segoe UI" 24 | Size = 9.75 25 | Charset = 0 26 | Weight = 400 27 | Underline = 0 'False 28 | Italic = 0 'False 29 | Strikethrough = 0 'False 30 | EndProperty 31 | Height = 7695 32 | Left = 0 33 | MultiLine = -1 'True 34 | ScrollBars = 3 'Beides 35 | TabIndex = 2 36 | Text = "Form1.frx":0000 37 | Top = 480 38 | Width = 6615 39 | End 40 | Begin VB.CommandButton Command2 41 | Caption = "Command2" 42 | Height = 375 43 | Left = 1680 44 | TabIndex = 1 45 | Top = 120 46 | Width = 1455 47 | End 48 | Begin VB.CommandButton Command1 49 | Caption = "Command1" 50 | Height = 375 51 | Left = 120 52 | TabIndex = 0 53 | Top = 120 54 | Width = 1335 55 | End 56 | End 57 | Attribute VB_Name = "Form1" 58 | Attribute VB_GlobalNameSpace = False 59 | Attribute VB_Creatable = False 60 | Attribute VB_PredeclaredId = True 61 | Attribute VB_Exposed = False 62 | Option Explicit 63 | 64 | Private Sub Command1_Click() 65 | ShowFind Me, FR_DOWN Or FR_SHOWHELP, "henderit" 66 | End Sub 67 | 68 | Private Sub Command2_Click() 69 | ShowFind Me, FR_SHOWHELP, "henderit", True, "hendererit" 70 | End Sub 71 | 72 | Private Sub Form_Load() 73 | Caption = "Find/Replace dialogs" 74 | Command1.Caption = "Find" 75 | Command2.Caption = "Replace" 76 | Text1.Text = "Lorem ipsum dolor sit amet, consectetur adipisici elit," & vbCrLf & _ 77 | "sed eiusmod tempor incidunt ut labore et dolore magna" & vbCrLf & _ 78 | "aliqua. Ut enim ad minim veniam, quis nostrud" & vbCrLf & _ 79 | "exercitation ullamco laboris nisi ut aliquid ex ea" & vbCrLf & _ 80 | "commodi consequat. Quis aute iure reprehenderit in" & vbCrLf & _ 81 | "voluptate velit esse cillum dolore eu fugiat nulla" & vbCrLf & _ 82 | "pariatur. Excepteur sint obcaecat cupiditat non" & vbCrLf & _ 83 | "proident, sunt in culpa qui officia deserunt mollit" & vbCrLf & _ 84 | "anim id est laborum." & vbCrLf & _ 85 | "" & vbCrLf & _ 86 | "--" & vbCrLf & _ 87 | "" & vbCrLf & _ 88 | "Duis autem vel eum iriure dolor in henderit in" & vbCrLf & _ 89 | "vulputate velit esse molestie consequat, vel illum" & vbCrLf & _ 90 | "dolore eu feugiat nulla facilisis at vero eros et" & vbCrLf & _ 91 | "accumsan et iusto odio dignissim qui blandit praesent" & vbCrLf & _ 92 | "luptatum zzril delenit augue duis dolore te feugait" & vbCrLf & _ 93 | "nulla facilisi. Lorem ipsum dolor sit amet, consectetuer" & vbCrLf & _ 94 | "adipiscing elit, sed diam nonummy nibh euismod tincidunt" & vbCrLf & _ 95 | "ut laoreet dolore magna aliquam erat volutpat." 96 | 97 | 98 | 'Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse molestie consequat, vel illum dolore eu feugiat nulla facilisis at vero eros et accumsan et iusto odio dignissim qui blandit praesent luptatum zzril delenit augue duis dolore te feugait nulla facilisi. 99 | ' 100 | 'Nam liber tempor cum soluta nobis eleifend option congue nihil imperdiet doming id quod mazim placerat facer possim assum. Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. 101 | ' 102 | 'Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse molestie consequat, vel illum dolore eu feugiat nulla facilisis. 103 | ' 104 | 'At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, At accusam aliquyam diam diam dolore dolores duo eirmod eos erat, et nonumy sed tempor et et invidunt justo labore Stet clita ea et gubergren, kasd magna no rebum. sanctus sea sed takimata ut vero voluptua. est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat. 105 | ' 106 | 'Consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. 107 | End Sub 108 | -------------------------------------------------------------------------------- /archiv/VBC_Tipp0759_TiKu/FMain.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin VB.Form FMain 3 | Caption = "FMain" 4 | ClientHeight = 4860 5 | ClientLeft = 120 6 | ClientTop = 450 7 | ClientWidth = 14685 8 | LinkTopic = "FMain" 9 | ScaleHeight = 4860 10 | ScaleWidth = 14685 11 | StartUpPosition = 2 'Bildschirmmitte 12 | Begin VB.CheckBox chkHandleWindowPosChanged 13 | Caption = "Handle WM_WINDOWPOSCHANGED" 14 | Height = 255 15 | Left = 120 16 | TabIndex = 0 17 | Top = 120 18 | Width = 3255 19 | End 20 | Begin VB.CommandButton BtnSetToSmallerSize 21 | Caption = "Set to 200x350" 22 | Height = 495 23 | Left = 720 24 | TabIndex = 1 25 | Top = 600 26 | Width = 1935 27 | End 28 | Begin VB.CommandButton BtnSetToLargerSize 29 | Caption = "Set to 800x600" 30 | Height = 495 31 | Left = 720 32 | TabIndex = 2 33 | Top = 1320 34 | Width = 1935 35 | End 36 | End 37 | Attribute VB_Name = "FMain" 38 | Attribute VB_GlobalNameSpace = False 39 | Attribute VB_Creatable = False 40 | Attribute VB_PredeclaredId = True 41 | Attribute VB_Exposed = False 42 | Option Explicit 43 | Implements ISubclassedWindow 44 | 45 | Private Const MAXHEIGHT As Long = 500 46 | Private Const MAXWIDTH As Long = 600 47 | Private Const MINHEIGHT As Long = 200 48 | Private Const MINWIDTH As Long = 300 49 | 50 | Private Type RECT 51 | Left As Long 52 | Top As Long 53 | Right As Long 54 | Bottom As Long 55 | End Type 56 | 57 | Private Type WINDOWPOS 58 | hWnd As LongPtr 59 | hWndInsertAfter As LongPtr 60 | x As Long 61 | y As Long 62 | cx As Long 63 | cy As Long 64 | Flags As Long 65 | End Type 66 | 67 | Private Const WM_SIZING As Long = &H214& 68 | Private Const WM_WINDOWPOSCHANGED As Long = &H47& 69 | Private Const WMSZ_LEFT As Long = 1 70 | Private Const WMSZ_TOP As Long = 3 71 | Private Const WMSZ_TOPLEFT As Long = 4 72 | Private Const WMSZ_TOPRIGHT As Long = 5 73 | Private Const WMSZ_BOTTOMLEFT As Long = 7 74 | 75 | Private Sub Form_Load() 76 | If Not SubclassWindow(Me.hWnd, Me, ESubclassID.escidFrmMain) Then 77 | Debug.Print "Subclassing failed!" 78 | End If 79 | End Sub 80 | 81 | Private Sub Form_Resize() 82 | Me.Caption = "Size: " & CStr(Me.ScaleX(Me.Width, Me.ScaleMode, ScaleModeConstants.vbPixels)) & "x" & CStr(Me.ScaleY(Me.Height, Me.ScaleMode, ScaleModeConstants.vbPixels)) 83 | End Sub 84 | 85 | Private Sub Form_Unload(Cancel As Integer) 86 | If Not UnSubclassWindow(Me.hWnd, ESubclassID.escidFrmMain) Then 87 | Debug.Print "UnSubclassing failed!" 88 | End If 89 | End Sub 90 | 91 | Private Sub BtnSetToSmallerSize_Click() 92 | Me.Move Me.Left, Me.Top, Me.ScaleX(200, ScaleModeConstants.vbPixels, Me.ScaleMode), Me.ScaleY(350, ScaleModeConstants.vbPixels, Me.ScaleMode) 93 | End Sub 94 | 95 | Private Sub BtnSetToLargerSize_Click() 96 | Me.Move Me.Left, Me.Top, Me.ScaleX(800, ScaleModeConstants.vbPixels, Me.ScaleMode), Me.ScaleY(600, ScaleModeConstants.vbPixels, Me.ScaleMode) 97 | End Sub 98 | 99 | Private Function ISubclassedWindow_HandleMessage(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr, ByVal scID As ESubclassID, ByRef bCallDefProc As Boolean) As Long 100 | Try: On Error GoTo Catch 101 | Dim lRet As Long 102 | Select Case scID 103 | Case ESubclassID.escidFrmMain 104 | lRet = HandleMessage_Form(hWnd, uMsg, wParam, lParam, bCallDefProc) 105 | Case Else 106 | Debug.Print "FMain.ISubclassedWindow_HandleMessage: Unknown Subclassing ID " & CStr(scID) 107 | End Select 108 | Exit Function 109 | Catch: 110 | Debug.Print "Error in frmMain.ISubclassedWindow_HandleMessage (SubclassID=" & CStr(scID) & ": ", Err.Number, Err.Description 111 | End Function 112 | 113 | Private Function HandleMessage_Form(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As LongPtr, ByRef bCallDefProc As Boolean) As Long 114 | Dim lRet As Long 115 | 116 | Try: On Error GoTo Catch 117 | Select Case uMsg 118 | Case WM_SIZING 119 | Dim tRect As RECT: RtlMoveMemory ByVal VarPtr(tRect), ByVal lParam, LenB(tRect) 120 | If tRect.Right - tRect.Left < MINWIDTH Then 121 | Select Case wParam 122 | Case WMSZ_TOPLEFT, WMSZ_LEFT, WMSZ_BOTTOMLEFT 123 | tRect.Left = tRect.Right - MINWIDTH 124 | Case Else 125 | tRect.Right = tRect.Left + MINWIDTH 126 | End Select 127 | ElseIf tRect.Right - tRect.Left > MAXWIDTH Then 128 | Select Case wParam 129 | Case WMSZ_TOPLEFT, WMSZ_LEFT, WMSZ_BOTTOMLEFT 130 | tRect.Left = tRect.Right - MAXWIDTH 131 | Case Else 132 | tRect.Right = tRect.Left + MAXWIDTH 133 | End Select 134 | End If 135 | If tRect.Bottom - tRect.Top < MINHEIGHT Then 136 | Select Case wParam 137 | Case WMSZ_TOPLEFT, WMSZ_TOP, WMSZ_TOPRIGHT 138 | tRect.Top = tRect.Bottom - MINHEIGHT 139 | Case Else 140 | tRect.Bottom = tRect.Top + MINHEIGHT 141 | End Select 142 | ElseIf tRect.Bottom - tRect.Top > MAXHEIGHT Then 143 | Select Case wParam 144 | Case WMSZ_TOPLEFT, WMSZ_TOP, WMSZ_TOPRIGHT 145 | tRect.Top = tRect.Bottom - MAXHEIGHT 146 | Case Else 147 | tRect.Bottom = tRect.Top + MAXHEIGHT 148 | End Select 149 | End If 150 | RtlMoveMemory ByVal lParam, ByVal VarPtr(tRect), LenB(tRect) 151 | 152 | Case WM_WINDOWPOSCHANGED 153 | If chkHandleWindowPosChanged.Value = vbChecked Then 154 | Dim tWindowPos As WINDOWPOS: RtlMoveMemory ByVal VarPtr(tWindowPos), ByVal lParam, LenB(tWindowPos) 155 | If tWindowPos.cx < MINWIDTH Then 156 | On Error Resume Next 157 | Me.Width = ScaleX(MINWIDTH, ScaleModeConstants.vbPixels, Me.ScaleMode) 158 | ElseIf tWindowPos.cx > MAXWIDTH Then 159 | On Error Resume Next 160 | Me.Width = ScaleX(MAXWIDTH, ScaleModeConstants.vbPixels, Me.ScaleMode) 161 | End If 162 | If tWindowPos.cy < MINHEIGHT Then 163 | On Error Resume Next 164 | Me.Height = ScaleY(MINHEIGHT, ScaleModeConstants.vbPixels, Me.ScaleMode) 165 | ElseIf tWindowPos.cy > MAXHEIGHT Then 166 | On Error Resume Next 167 | Me.Height = ScaleY(MAXHEIGHT, ScaleModeConstants.vbPixels, Me.ScaleMode) 168 | End If 169 | End If 170 | End Select 171 | 172 | Exit Function 173 | Catch: 174 | Debug.Print "Error in frmMain.HandleMessage_Form: ", Err.Number, Err.Description 175 | End Function 176 | -------------------------------------------------------------------------------- /FontDialog/codekabinett/modFontDialog_Org.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modFontDialog_Org" 2 | Option Compare Database 3 | Option Explicit 4 | 5 | ' Original Code by Terry Kreft 6 | ' Modified by Stephen Lebans 7 | ' Contact Stephen@lebans.com 8 | 9 | 10 | '************ Code Start *********** 11 | Private Const GMEM_MOVEABLE = &H2 12 | Private Const GMEM_ZEROINIT = &H40 13 | Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT) 14 | 15 | Private Const LF_FACESIZE = 32 16 | 17 | Private Const FW_BOLD = 700 18 | 19 | Private Const CF_APPLY = &H200& 20 | Private Const CF_ANSIONLY = &H400& 21 | Private Const CF_TTONLY = &H40000 22 | Private Const CF_EFFECTS = &H100& 23 | Private Const CF_ENABLETEMPLATE = &H10& 24 | Private Const CF_ENABLETEMPLATEHANDLE = &H20& 25 | Private Const CF_FIXEDPITCHONLY = &H4000& 26 | Private Const CF_FORCEFONTEXIST = &H10000 27 | Private Const CF_INITTOLOGFONTSTRUCT = &H40& 28 | Private Const CF_LIMITSIZE = &H2000& 29 | Private Const CF_NOFACESEL = &H80000 30 | Private Const CF_NOSCRIPTSEL = &H800000 31 | Private Const CF_NOSTYLESEL = &H100000 32 | Private Const CF_NOSIZESEL = &H200000 33 | Private Const CF_NOSIMULATIONS = &H1000& 34 | Private Const CF_NOVECTORFONTS = &H800& 35 | Private Const CF_NOVERTFONTS = &H1000000 36 | Private Const CF_OEMTEXT = 7 37 | Private Const CF_PRINTERFONTS = &H2 38 | Private Const CF_SCALABLEONLY = &H20000 39 | Private Const CF_SCREENFONTS = &H1 40 | Private Const CF_SCRIPTSONLY = CF_ANSIONLY 41 | Private Const CF_SELECTSCRIPT = &H400000 42 | Private Const CF_SHOWHELP = &H4& 43 | Private Const CF_USESTYLE = &H80& 44 | Private Const CF_WYSIWYG = &H8000 45 | Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS) 46 | Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS 47 | 48 | Public Const LOGPIXELSY = 90 49 | 50 | Public Type FormFontInfo 51 | Name As String 52 | Weight As Integer 53 | Height As Integer 54 | UnderLine As Boolean 55 | Italic As Boolean 56 | Color As Long 57 | End Type 58 | 59 | Private Type LOGFONT 60 | lfHeight As Long 61 | lfWidth As Long 62 | lfEscapement As Long 63 | lfOrientation As Long 64 | lfWeight As Long 65 | lfItalic As Byte 66 | lfUnderline As Byte 67 | lfStrikeOut As Byte 68 | lfCharSet As Byte 69 | lfOutPrecision As Byte 70 | lfClipPrecision As Byte 71 | lfQuality As Byte 72 | lfPitchAndFamily As Byte 73 | lfFaceName(LF_FACESIZE) As Byte 74 | End Type 75 | 76 | Private Type FONTSTRUC 77 | lStructSize As Long 78 | hwnd As Long 79 | hdc As Long 80 | lpLogFont As Long 81 | iPointSize As Long 82 | Flags As Long 83 | rgbColors As Long 84 | lCustData As Long 85 | lpfnHook As Long 86 | lpTemplateName As String 87 | hInstance As Long 88 | lpszStyle As String 89 | nFontType As Integer 90 | MISSING_ALIGNMENT As Integer 91 | nSizeMin As Long 92 | nSizeMax As Long 93 | End Type 94 | 95 | Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" _ 96 | (pChoosefont As FONTSTRUC) As Long 97 | Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 98 | Private Declare Function GlobalAlloc Lib "kernel32" _ 99 | (ByVal wFlags As Long, ByVal dwBytes As Long) As Long 100 | Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 101 | (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) 102 | Private Declare Function GetDeviceCaps Lib "gdi32" _ 103 | (ByVal hdc As Long, ByVal nIndex As Long) As Long 104 | Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 105 | 106 | 107 | Private Function MulDiv(In1 As Long, In2 As Long, In3 As Long) As Long 108 | Dim lngTemp As Long 109 | On Error GoTo MulDiv_err 110 | If In3 <> 0 Then 111 | lngTemp = In1 * In2 112 | lngTemp = lngTemp / In3 113 | Else 114 | lngTemp = -1 115 | End If 116 | MulDiv_end: 117 | MulDiv = lngTemp 118 | Exit Function 119 | MulDiv_err: 120 | lngTemp = -1 121 | Resume MulDiv_err 122 | End Function 123 | Private Function ByteToString(aBytes() As Byte) As String 124 | Dim dwBytePoint As Long, dwByteVal As Long, szOut As String 125 | dwBytePoint = LBound(aBytes) 126 | While dwBytePoint <= UBound(aBytes) 127 | dwByteVal = aBytes(dwBytePoint) 128 | If dwByteVal = 0 Then 129 | ByteToString = szOut 130 | Exit Function 131 | Else 132 | szOut = szOut & Chr$(dwByteVal) 133 | End If 134 | dwBytePoint = dwBytePoint + 1 135 | Wend 136 | ByteToString = szOut 137 | End Function 138 | 139 | Private Sub StringToByte(InString As String, ByteArray() As Byte) 140 | Dim intLbound As Integer 141 | Dim intUbound As Integer 142 | Dim intLen As Integer 143 | Dim intX As Integer 144 | intLbound = LBound(ByteArray) 145 | intUbound = UBound(ByteArray) 146 | intLen = Len(InString) 147 | If intLen > intUbound - intLbound Then intLen = intUbound - intLbound 148 | For intX = 1 To intLen 149 | ByteArray(intX - 1 + intLbound) = Asc(Mid(InString, intX, 1)) 150 | Next 151 | End Sub 152 | 153 | 154 | Public Function DialogFont(ByRef f As FormFontInfo) As Boolean 155 | Dim LF As LOGFONT, FS As FONTSTRUC 156 | Dim lLogFontAddress As Long, lMemHandle As Long 157 | 158 | LF.lfWeight = f.Weight 159 | LF.lfItalic = f.Italic * -1 160 | LF.lfUnderline = f.UnderLine * -1 161 | LF.lfHeight = -MulDiv(CLng(f.Height), GetDeviceCaps(GetDC(hWndAccessApp), LOGPIXELSY), 72) 162 | Call StringToByte(f.Name, LF.lfFaceName()) 163 | FS.rgbColors = f.Color 164 | FS.lStructSize = Len(FS) 165 | 166 | ' To be modal must be valid Hwnd 167 | FS.hwnd = Application.hWndAccessApp 168 | 169 | lMemHandle = GlobalAlloc(GHND, Len(LF)) 170 | If lMemHandle = 0 Then 171 | DialogFont = False 172 | Exit Function 173 | End If 174 | 175 | lLogFontAddress = GlobalLock(lMemHandle) 176 | If lLogFontAddress = 0 Then 177 | DialogFont = False 178 | Exit Function 179 | End If 180 | 181 | CopyMemory ByVal lLogFontAddress, LF, Len(LF) 182 | FS.lpLogFont = lLogFontAddress 183 | FS.Flags = CF_SCREENFONTS Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT 184 | If ChooseFont(FS) = 1 Then 185 | CopyMemory LF, ByVal lLogFontAddress, Len(LF) 186 | f.Weight = LF.lfWeight 187 | f.Italic = CBool(LF.lfItalic) 188 | f.UnderLine = CBool(LF.lfUnderline) 189 | f.Name = ByteToString(LF.lfFaceName()) 190 | f.Height = CLng(FS.iPointSize / 10) 191 | f.Color = FS.rgbColors 192 | 193 | DialogFont = True 194 | Else 195 | DialogFont = False 196 | End If 197 | End Function 198 | 199 | Function test_DialogFont(ctl As Control) As Boolean 200 | Dim f As FormFontInfo 201 | With f 202 | .Color = 0 203 | .Height = 12 204 | .Weight = 700 205 | .Italic = False 206 | .UnderLine = False 207 | .Name = "Arial" 208 | End With 209 | Call DialogFont(f) 210 | With f 211 | Debug.Print "Font Name: "; .Name 212 | Debug.Print "Font Size: "; .Height 213 | Debug.Print "Font Weight: "; .Weight 214 | Debug.Print "Font Italics: "; .Italic 215 | Debug.Print "Font Underline: "; .UnderLine 216 | Debug.Print "Font COlor: "; .Color 217 | 218 | ctl.FontName = .Name 219 | ctl.FontSize = .Height 220 | ctl.FontWeight = .Weight 221 | ctl.FontItalic = .Italic 222 | ctl.FontUnderline = .UnderLine 223 | ctl = .Name & " - Size:" & .Height 224 | End With 225 | test_DialogFont = True 226 | End Function 227 | '************ Code End *********** -------------------------------------------------------------------------------- /archiv/fabel358/orig/Module1.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Module1" 2 | Option Explicit 3 | 4 | ' fabel358: 5 | ' https://www.vbforums.com/showthread.php?902963-Find-Replace-Dialog 6 | ' To Work, it works... but, too long! 7 | ' i don 't remember where I found this code; I found it among my material. 8 | 9 | 10 | Type FINDREPLACE 11 | lStructSize As Long 12 | hwndOwner As Long 13 | hInstance As Long 14 | flags As Long 15 | lpstrFindWhat As Long 16 | lpstrReplaceWith As Long 17 | wFindWhatLen As Integer 18 | wReplaceWithLen As Integer 19 | lCustData As Long 20 | lpfnHook As Long 21 | lpTemplateName As String 22 | End Type 23 | 24 | Type Msg 25 | hwnd As Long 26 | message As Long 27 | wParam As Long 28 | lParam As Long 29 | time As Long 30 | ptX As Long 31 | ptY As Long 32 | End Type 33 | 34 | Private Declare Function FindText Lib "comdlg32" Alias "FindTextA" (pFindreplace As Long) As Long 35 | Private Declare Function ReplaceText Lib "comdlg32" Alias "ReplaceTextA" (pFindreplace As Long) As Long 36 | Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long 37 | Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long 38 | Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long 39 | Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long 40 | Private Declare Function IsDialogMessage Lib "user32" Alias "IsDialogMessageA" (ByVal hDlg As Long, lpMsg As Msg) As Long 41 | Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) 42 | Private Declare Function CopyPointer2String Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long 43 | Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 44 | Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 45 | Private 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 46 | Private Declare Function GetProcessHeap& Lib "kernel32" () 47 | Private Declare Function HeapAlloc& Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) 48 | Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long 49 | 50 | Private Const GWL_WNDPROC = (-4) 51 | Private Const HEAP_ZERO_MEMORY = &H8 52 | Public Const FR_DIALOGTERM = &H40 53 | Public Const FR_DOWN = &H1 54 | Public Const FR_ENABLEHOOK = &H100 55 | Public Const FR_ENABLETEMPLATE = &H200 56 | Public Const FR_ENABLETEMPLATEHANDLE = &H2000 57 | Public Const FR_FINDNEXT = &H8 58 | Public Const FR_HIDEMATCHCASE = &H8000 59 | Public Const FR_HIDEUPDOWN = &H4000 60 | Public Const FR_HIDEWHOLEWORD = &H10000 61 | Public Const FR_MATCHCASE = &H4 62 | Public Const FR_NOMATCHCASE = &H800 63 | Public Const FR_NOUPDOWN = &H400 64 | Public Const FR_NOWHOLEWORD = &H1000 65 | Public Const FR_REPLACE = &H10 66 | Public Const FR_REPLACEALL = &H20 67 | Public Const FR_SHOWHELP = &H80 68 | Public Const FR_WHOLEWORD = &H2 69 | 70 | Const FINDMSGSTRING = "commdlg_FindReplace" 71 | Const HELPMSGSTRING = "commdlg_help" 72 | Const BufLength = 256 73 | Public hDialog As Long, OldProc As Long 74 | Dim uFindMsg As Long, uHelpMsg As Long, lHeap As Long 75 | Public RetFrs As FINDREPLACE, TMsg As Msg 76 | Dim arrFind() As Byte, arrReplace() As Byte 77 | 78 | 'Private m_FRS As FINDREPLACE 79 | 80 | Public Sub ShowFind(fOwner As Form, lFlags As Long, sFind As String, Optional bReplace As Boolean = False, Optional sReplace As String = "") 81 | If hDialog > 0 Then Exit Sub 82 | Dim FRS As FINDREPLACE 83 | Dim i As Integer 84 | arrFind = StrConv(sFind & Chr$(0), vbFromUnicode) 85 | arrReplace = StrConv(sReplace & Chr$(0), vbFromUnicode) 86 | With FRS 87 | .lStructSize = LenB(FRS) '&H20 ' 88 | .lpstrFindWhat = VarPtr(arrFind(0)) 89 | .wFindWhatLen = BufLength 90 | .lpstrReplaceWith = VarPtr(arrReplace(0)) 91 | .wReplaceWithLen = BufLength 92 | .hwndOwner = fOwner.hwnd 93 | .flags = lFlags 94 | .hInstance = App.hInstance 95 | End With 96 | lHeap = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, FRS.lStructSize) 97 | CopyMemory ByVal lHeap, FRS, Len(FRS) 98 | uFindMsg = RegisterWindowMessage(FINDMSGSTRING) 99 | uHelpMsg = RegisterWindowMessage(HELPMSGSTRING) 100 | OldProc = SetWindowLong(fOwner.hwnd, GWL_WNDPROC, AddressOf WndProc) 101 | If bReplace Then 102 | hDialog = ReplaceText(ByVal lHeap) 103 | Else 104 | hDialog = FindText(ByVal lHeap) 105 | End If 106 | MessageLoop 107 | End Sub 108 | 109 | Private Sub MessageLoop() 110 | Do While GetMessage(TMsg, 0&, 0&, 0&) And hDialog > 0 111 | If IsDialogMessage(hDialog, TMsg) = False Then 112 | TranslateMessage TMsg 113 | DispatchMessage TMsg 114 | End If 115 | Loop 116 | End Sub 117 | 118 | Public Function WndProc(ByVal hOwner As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 119 | Select Case wMsg 120 | Case uFindMsg 121 | CopyMemory RetFrs, ByVal lParam, Len(RetFrs) 122 | If (RetFrs.flags And FR_DIALOGTERM) = FR_DIALOGTERM Then 123 | SetWindowLong hOwner, GWL_WNDPROC, OldProc 124 | HeapFree GetProcessHeap(), 0, lHeap 125 | hDialog = 0: lHeap = 0: OldProc = 0 126 | Else 127 | DoFindReplace RetFrs 128 | End If 129 | Case uHelpMsg 130 | MsgBox "Here is your code to call your help file", vbInformation + vbOKOnly, "Heeeelp!!!!" 131 | Case Else 132 | WndProc = CallWindowProc(OldProc, hOwner, wMsg, wParam, lParam) 133 | End Select 134 | End Function 135 | 136 | Private Sub DoFindReplace(fr As FINDREPLACE) 137 | Dim sTemp As String 138 | sTemp = "Here is your code for Find/Replace with parameters:" & vbCrLf & vbCrLf 139 | sTemp = sTemp & "Find string: " & PointerToString(fr.lpstrFindWhat) & vbCrLf 140 | sTemp = sTemp & "Replace string: " & PointerToString(fr.lpstrReplaceWith) & vbCrLf & vbCrLf 141 | sTemp = sTemp & "Current Flags: " & vbCrLf & vbCrLf 142 | sTemp = sTemp & "FR_FINDNEXT = " & CheckFlags(FR_FINDNEXT, fr.flags) & vbCrLf 143 | sTemp = sTemp & "FR_REPLACE = " & CheckFlags(FR_REPLACE, fr.flags) & vbCrLf 144 | sTemp = sTemp & "FR_REPLACEALL = " & CheckFlags(FR_REPLACEALL, fr.flags) & vbCrLf 145 | sTemp = sTemp & "FR_DOWN = " & CheckFlags(FR_DOWN, fr.flags) & vbCrLf 146 | sTemp = sTemp & "FR_MATCHCASE = " & CheckFlags(FR_MATCHCASE, fr.flags) & vbCrLf 147 | sTemp = sTemp & "FR_WHOLEWORD = " & CheckFlags(FR_WHOLEWORD, fr.flags) 148 | MsgBox sTemp, vbOKOnly + vbInformation, "Find/Replace parameters" 149 | End Sub 150 | 151 | Private Function PointerToString(p As Long) As String 152 | Dim s As String 153 | s = String(BufLength, Chr$(0)) 154 | CopyPointer2String s, p 155 | PointerToString = Left(s, InStr(s, Chr$(0)) - 1) 156 | End Function 157 | 158 | Private Function CheckFlags(flag As Long, flags As Long) As Boolean 159 | CheckFlags = ((flags And flag) = flag) 160 | End Function 161 | -------------------------------------------------------------------------------- /FontDialog/codekabinett/modFontDialog_VBA7.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "modFontDialog_VBA7" 2 | Option Compare Database 3 | Option Explicit 4 | 5 | ' Original Code by Terry Kreft 6 | ' Modified by Stephen Lebans (http://lebans.com/) 7 | ' 8 | ' This code was revised on 2019-01-26 in a hurry 9 | ' by Philipp Stiefel (http://codekabinett.com) to 10 | ' make it run in x64 VBA-Applications. 11 | ' This is just the code that "worked for me" with 12 | ' a few superficial tests. I did not conduct a 13 | ' serious code review and do not take any 14 | ' responsibility for any defects in the code. 15 | 16 | 17 | '************ Code Start *********** 18 | Private Const GMEM_MOVEABLE = &H2 19 | Private Const GMEM_ZEROINIT = &H40 20 | Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT) 21 | 22 | Private Const LF_FACESIZE = 32 23 | 24 | Private Const FW_BOLD = 700 25 | 26 | Private Const CF_APPLY = &H200& 27 | Private Const CF_ANSIONLY = &H400& 28 | Private Const CF_TTONLY = &H40000 29 | Private Const CF_EFFECTS = &H100& 30 | Private Const CF_ENABLETEMPLATE = &H10& 31 | Private Const CF_ENABLETEMPLATEHANDLE = &H20& 32 | Private Const CF_FIXEDPITCHONLY = &H4000& 33 | Private Const CF_FORCEFONTEXIST = &H10000 34 | Private Const CF_INITTOLOGFONTSTRUCT = &H40& 35 | Private Const CF_LIMITSIZE = &H2000& 36 | Private Const CF_NOFACESEL = &H80000 37 | Private Const CF_NOSCRIPTSEL = &H800000 38 | Private Const CF_NOSTYLESEL = &H100000 39 | Private Const CF_NOSIZESEL = &H200000 40 | Private Const CF_NOSIMULATIONS = &H1000& 41 | Private Const CF_NOVECTORFONTS = &H800& 42 | Private Const CF_NOVERTFONTS = &H1000000 43 | Private Const CF_OEMTEXT = 7 44 | Private Const CF_PRINTERFONTS = &H2 45 | Private Const CF_SCALABLEONLY = &H20000 46 | Private Const CF_SCREENFONTS = &H1 47 | Private Const CF_SCRIPTSONLY = CF_ANSIONLY 48 | Private Const CF_SELECTSCRIPT = &H400000 49 | Private Const CF_SHOWHELP = &H4& 50 | Private Const CF_USESTYLE = &H80& 51 | Private Const CF_WYSIWYG = &H8000 52 | Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS) 53 | Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS 54 | 55 | Public Const LOGPIXELSY = 90 56 | 57 | Public Type FormFontInfo 58 | Name As String 59 | Weight As Integer 60 | Height As Integer 61 | UnderLine As Boolean 62 | Italic As Boolean 63 | Color As Long 64 | End Type 65 | 66 | Private Type LOGFONT 67 | lfHeight As Long 68 | lfWidth As Long 69 | lfEscapement As Long 70 | lfOrientation As Long 71 | lfWeight As Long 72 | lfItalic As Byte 73 | lfUnderline As Byte 74 | lfStrikeOut As Byte 75 | lfCharSet As Byte 76 | lfOutPrecision As Byte 77 | lfClipPrecision As Byte 78 | lfQuality As Byte 79 | lfPitchAndFamily As Byte 80 | lfFaceName(LF_FACESIZE) As Byte 81 | End Type 82 | 83 | Private Type FONTSTRUC 84 | lStructSize As Long 85 | hwnd As LongPtr 86 | hdc As LongPtr 87 | lpLogFont As LongPtr 88 | iPointSize As Long 89 | Flags As Long 90 | rgbColors As Long 91 | lCustData As LongPtr 92 | lpfnHook As LongPtr 93 | lpTemplateName As String 94 | hInstance As LongPtr 95 | lpszStyle As String 96 | nFontType As Integer 97 | MISSING_ALIGNMENT As Integer 98 | nSizeMin As Long 99 | nSizeMax As Long 100 | End Type 101 | 102 | Private Declare PtrSafe Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" _ 103 | (pChoosefont As FONTSTRUC) As Long 104 | Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr 105 | Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" _ 106 | (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr 107 | Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ 108 | (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) 109 | Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" _ 110 | (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long 111 | Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr 112 | 113 | 114 | Private Function MulDiv(In1 As Long, In2 As Long, In3 As Long) As Long 115 | Dim lngTemp As Long 116 | On Error GoTo MulDiv_err 117 | If In3 <> 0 Then 118 | lngTemp = In1 * In2 119 | lngTemp = lngTemp / In3 120 | Else 121 | lngTemp = -1 122 | End If 123 | MulDiv_end: 124 | MulDiv = lngTemp 125 | Exit Function 126 | MulDiv_err: 127 | lngTemp = -1 128 | Resume MulDiv_err 129 | End Function 130 | Private Function ByteToString(aBytes() As Byte) As String 131 | Dim dwBytePoint As Long, dwByteVal As Long, szOut As String 132 | dwBytePoint = LBound(aBytes) 133 | While dwBytePoint <= UBound(aBytes) 134 | dwByteVal = aBytes(dwBytePoint) 135 | If dwByteVal = 0 Then 136 | ByteToString = szOut 137 | Exit Function 138 | Else 139 | szOut = szOut & Chr$(dwByteVal) 140 | End If 141 | dwBytePoint = dwBytePoint + 1 142 | Wend 143 | ByteToString = szOut 144 | End Function 145 | 146 | Private Sub StringToByte(InString As String, ByteArray() As Byte) 147 | Dim intLbound As Integer 148 | Dim intUbound As Integer 149 | Dim intLen As Integer 150 | Dim intX As Integer 151 | intLbound = LBound(ByteArray) 152 | intUbound = UBound(ByteArray) 153 | intLen = Len(InString) 154 | If intLen > intUbound - intLbound Then intLen = intUbound - intLbound 155 | For intX = 1 To intLen 156 | ByteArray(intX - 1 + intLbound) = Asc(Mid(InString, intX, 1)) 157 | Next 158 | End Sub 159 | 160 | 161 | Public Function DialogFont(ByRef f As FormFontInfo) As Boolean 162 | Dim LF As LOGFONT, FS As FONTSTRUC 163 | Dim lLogFontAddress As LongPtr, lMemHandle As LongPtr 164 | 165 | LF.lfWeight = f.Weight 166 | LF.lfItalic = f.Italic * -1 167 | LF.lfUnderline = f.UnderLine * -1 168 | LF.lfHeight = -MulDiv(CLng(f.Height), GetDeviceCaps(GetDC(hWndAccessApp), LOGPIXELSY), 72) 169 | Call StringToByte(f.Name, LF.lfFaceName()) 170 | FS.rgbColors = f.Color 171 | FS.lStructSize = LenB(FS) 172 | 173 | ' To be modal must be valid Hwnd 174 | FS.hwnd = Application.hWndAccessApp 175 | 176 | lMemHandle = GlobalAlloc(GHND, LenB(LF)) 177 | If lMemHandle = 0 Then 178 | DialogFont = False 179 | Exit Function 180 | End If 181 | 182 | lLogFontAddress = GlobalLock(lMemHandle) 183 | If lLogFontAddress = 0 Then 184 | DialogFont = False 185 | Exit Function 186 | End If 187 | 188 | CopyMemory ByVal lLogFontAddress, LF, LenB(LF) 189 | FS.lpLogFont = lLogFontAddress 190 | FS.Flags = CF_SCREENFONTS Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT 191 | Dim apiRetVal As Long 192 | apiRetVal = ChooseFont(FS) 193 | If apiRetVal = 1 Then 194 | CopyMemory LF, ByVal lLogFontAddress, LenB(LF) 195 | f.Weight = LF.lfWeight 196 | f.Italic = CBool(LF.lfItalic) 197 | f.UnderLine = CBool(LF.lfUnderline) 198 | f.Name = ByteToString(LF.lfFaceName()) 199 | f.Height = CLng(FS.iPointSize / 10) 200 | f.Color = FS.rgbColors 201 | 202 | DialogFont = True 203 | Else 204 | DialogFont = False 205 | End If 206 | End Function 207 | 208 | Function test_DialogFont(ctl As Control) As Boolean 209 | Dim f As FormFontInfo 210 | With f 211 | .Color = 0 212 | .Height = 12 213 | .Weight = 700 214 | .Italic = False 215 | .UnderLine = False 216 | .Name = "Arial" 217 | End With 218 | Call DialogFont(f) 219 | With f 220 | Debug.Print "Font Name: "; .Name 221 | Debug.Print "Font Size: "; .Height 222 | Debug.Print "Font Weight: "; .Weight 223 | Debug.Print "Font Italics: "; .Italic 224 | Debug.Print "Font Underline: "; .UnderLine 225 | Debug.Print "Font COlor: "; .Color 226 | 227 | ctl.FontName = .Name 228 | ctl.FontSize = .Height 229 | ctl.FontWeight = .Weight 230 | ctl.FontItalic = .Italic 231 | ctl.FontUnderline = .UnderLine 232 | ctl = .Name & " - Size:" & .Height 233 | End With 234 | test_DialogFont = True 235 | End Function 236 | '************ Code End *********** 237 | 238 | -------------------------------------------------------------------------------- /archiv/fabel358/Module1.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Module1" 2 | Option Explicit 3 | 4 | #If VBA7 = 0 Then 5 | Public Enum LongPtr 6 | [_] 7 | End Enum 8 | #End If 9 | 10 | Type FINDREPLACE 11 | lStructSize As Long 12 | hwndOwner As LongPtr 13 | hInstance As LongPtr 14 | flags As Long 15 | lpstrFindWhat As LongPtr 16 | lpstrReplaceWith As LongPtr 17 | wFindWhatLen As Integer 18 | wReplaceWithLen As Integer 19 | lCustData As Long 20 | lpfnHook As LongPtr 21 | lpTemplateName As LongPtr 'String 22 | End Type 23 | 24 | Type Msg 25 | hwnd As LongPtr 26 | message As Long 27 | wParam As Long 28 | lParam As Long 29 | time As Long 30 | ptX As Long 31 | ptY As Long 32 | End Type 33 | 34 | 35 | #If VBA7 Then 36 | 37 | Private Declare PtrSafe Function FindTextW Lib "comdlg32" (pFindreplace As Any) As Long 38 | Private Declare PtrSafe Function ReplaceTextW Lib "comdlg32" (pFindreplace As Any) As Long 39 | 40 | Private Declare PtrSafe Function RegisterWindowMessageW Lib "user32" (ByVal lpString As LongPtr) As Long 41 | Private Declare PtrSafe Function DispatchMessageW Lib "user32" (lpMsg As Msg) As Long 42 | Private Declare PtrSafe Function GetMessageW Lib "user32" (lpMsg As Msg, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long 43 | Private Declare PtrSafe Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long 44 | Private Declare PtrSafe Function IsDialogMessageW Lib "user32" (ByVal hDlg As LongPtr, lpMsg As Msg) As Long 45 | Private Declare PtrSafe Function SetWindowLongW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 46 | Private Declare PtrSafe Function GetWindowLongW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long 47 | Private Declare PtrSafe Function CallWindowProcW Lib "user32" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 48 | 49 | Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal cbCopy As Long) 50 | Private Declare PtrSafe Function lstrcpyW Lib "kernel32" (ByVal NewString As LongPtr, ByVal OldString As LongPtr) As Long 51 | Private Declare PtrSafe Function GetProcessHeap Lib "kernel32" () As LongPtr 52 | Private Declare PtrSafe Function HeapAlloc Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long 53 | Private Declare PtrSafe Function HeapFree Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, lpMem As Any) As Long 54 | Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr 55 | 56 | #Else 57 | 58 | Private Declare Function FindTextW Lib "comdlg32" (pFindreplace As Any) As Long 59 | Private Declare Function ReplaceTextW Lib "comdlg32" (pFindreplace As Any) As Long 60 | 61 | Private Declare Function RegisterWindowMessageW Lib "user32" (ByVal lpString As LongPtr) As Long 62 | Private Declare Function DispatchMessageW Lib "user32" (lpMsg As Msg) As Long 63 | Private Declare Function GetMessageW Lib "user32" (lpMsg As Msg, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long 64 | Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long 65 | Private Declare Function IsDialogMessageW Lib "user32" (ByVal hDlg As LongPtr, lpMsg As Msg) As Long 66 | Private Declare Function SetWindowLongW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 67 | Private Declare Function GetWindowLongW Lib "user32" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long 68 | Private Declare Function CallWindowProcW Lib "user32" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 69 | 70 | Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal cbCopy As Long) 71 | Private Declare Function lstrcpyW Lib "kernel32" (ByVal NewString As LongPtr, ByVal OldString As LongPtr) As Long 72 | Private Declare Function GetProcessHeap Lib "kernel32" () As LongPtr 73 | Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long 74 | Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As LongPtr, ByVal dwFlags As Long, lpMem As Any) As Long 75 | Private Declare Function GetDesktopWindow Lib "user32" () As LongPtr 76 | 77 | #End If 78 | 79 | 'Private Declare Function FindTextW Lib "comdlg32" (pFindreplace As Long) As Long 80 | 'Private Declare Function ReplaceTextW Lib "comdlg32" (pFindreplace As Long) As Long 81 | ' 82 | 'Private Declare Function RegisterWindowMessageW Lib "user32" (ByVal lpString As Long) As Long 83 | 'Private Declare Function DispatchMessageW Lib "user32" (lpMsg As Msg) As Long 84 | 'Private Declare Function GetMessageW Lib "user32" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long 85 | 'Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long 86 | 'Private Declare Function IsDialogMessageW Lib "user32" (ByVal hDlg As Long, lpMsg As Msg) As Long 87 | 'Private Declare Function SetWindowLongW Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 88 | 'Private Declare Function GetWindowLongW Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 89 | 'Private Declare Function CallWindowProcW Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 90 | ' 91 | 'Private Declare Sub RtlMoveMemory Lib "kernel32" (ByRef pDst As Any, ByRef pSrc As Any, ByVal cbCopy As Long) 92 | 'Private Declare Function lstrcpyW Lib "kernel32" (ByVal NewString As Long, ByVal OldString As Long) As Long 93 | 'Private Declare Function GetProcessHeap Lib "kernel32" () As Long 94 | 'Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long 95 | 'Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long 96 | 97 | Private Const GWL_WNDPROC As Long = (-4) 98 | Private Const HEAP_ZERO_MEMORY As Long = &H8 99 | 100 | Public Const FR_DOWN As Long = &H1 101 | Public Const FR_WHOLEWORD As Long = &H2 102 | Public Const FR_MATCHCASE As Long = &H4 103 | Public Const FR_FINDNEXT As Long = &H8 104 | Public Const FR_REPLACE As Long = &H10 105 | Public Const FR_REPLACEALL As Long = &H20 106 | Public Const FR_DIALOGTERM As Long = &H40 107 | Public Const FR_SHOWHELP As Long = &H80 108 | 109 | Public Const FR_ENABLEHOOK As Long = &H100 110 | Public Const FR_ENABLETEMPLATE As Long = &H200 111 | Public Const FR_NOUPDOWN As Long = &H400 112 | Public Const FR_NOMATCHCASE As Long = &H800 113 | 114 | Public Const FR_NOWHOLEWORD As Long = &H1000 115 | Public Const FR_ENABLETEMPLATEHANDLE As Long = &H2000 116 | Public Const FR_HIDEUPDOWN As Long = &H4000 117 | Public Const FR_HIDEMATCHCASE As Long = &H8000 118 | Public Const FR_HIDEWHOLEWORD As Long = &H10000 119 | 120 | Const FINDMSGSTRING As String = "commdlg_FindReplace" 121 | Const HELPMSGSTRING As String = "commdlg_help" 122 | Const BufLength As Long = 256 123 | 124 | Public hDialog As LongPtr 125 | Public OldProc As LongPtr 126 | 127 | Dim uFindMsg As Long 128 | Dim uHelpMsg As Long 129 | Dim lHeap As LongPtr 130 | 131 | Public RetFrs As FINDREPLACE 132 | Public TMsg As Msg 133 | 134 | Dim arrFind() As Byte 135 | Dim arrReplace() As Byte 136 | 137 | Public Sub ShowFind(fOwner As Object, lFlags As Long, sFind As String, Optional bReplace As Boolean = False, Optional sReplace As String = "") 138 | If hDialog > 0 Then Exit Sub 139 | Dim FRS As FINDREPLACE 140 | 'Dim i As Integer 141 | arrFind = sFind & Chr$(0) 'StrConv(sFind & Chr$(0), vbUnicode) 142 | 'Debug.Print arrFind 143 | arrReplace = sReplace & Chr$(0) 'StrConv(sReplace & Chr$(0), vbUnicode) 144 | 'Debug.Print arrReplace 145 | Dim fOwner_hwnd As Long: fOwner_hwnd = GetDesktopWindow 146 | With FRS 147 | .lStructSize = LenB(FRS) '&H20 ' 148 | .lpstrFindWhat = VarPtr(arrFind(0)) 149 | .wFindWhatLen = BufLength 150 | .lpstrReplaceWith = VarPtr(arrReplace(0)) 151 | .wReplaceWithLen = BufLength 152 | .hwndOwner = fOwner_hwnd 153 | .flags = lFlags 154 | '.hInstance = App.hInstance 155 | End With 156 | lHeap = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, FRS.lStructSize) 157 | RtlMoveMemory ByVal lHeap, FRS, LenB(FRS) 158 | uFindMsg = RegisterWindowMessageW(StrPtr(FINDMSGSTRING & Chr(0))) 159 | uHelpMsg = RegisterWindowMessageW(StrPtr(HELPMSGSTRING & Chr(0))) 160 | OldProc = SetWindowLongW(fOwner.hwnd, GWL_WNDPROC, AddressOf WndProc) 161 | If bReplace Then 162 | hDialog = ReplaceTextW(ByVal lHeap) 163 | Else 164 | hDialog = FindTextW(ByVal lHeap) 165 | End If 166 | MessageLoop 167 | End Sub 168 | 169 | Private Sub MessageLoop() 170 | Do While GetMessageW(TMsg, 0&, 0&, 0&) And hDialog > 0 171 | If IsDialogMessageW(hDialog, TMsg) = False Then 172 | TranslateMessage TMsg 173 | DispatchMessageW TMsg 174 | End If 175 | Loop 176 | End Sub 177 | 178 | Public Function WndProc(ByVal hOwner As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 179 | Select Case wMsg 180 | Case uFindMsg 181 | RtlMoveMemory RetFrs, ByVal lParam, LenB(RetFrs) 182 | If (RetFrs.flags And FR_DIALOGTERM) = FR_DIALOGTERM Then 183 | SetWindowLongW hOwner, GWL_WNDPROC, OldProc 184 | HeapFree GetProcessHeap(), 0, lHeap 185 | hDialog = 0 186 | lHeap = 0 187 | OldProc = 0 188 | Else 189 | DoFindReplace RetFrs 190 | End If 191 | Case uHelpMsg 192 | Form1.Label1.Caption = "Here is your code to call your help file" ', vbInformation + vbOKOnly, "Heeeelp!!!!" 193 | Case Else 194 | WndProc = CallWindowProcW(OldProc, hOwner, wMsg, wParam, lParam) 195 | End Select 196 | End Function 197 | 198 | Private Sub DoFindReplace(fr As FINDREPLACE) 199 | Dim s As String 200 | s = "Here is your code for Find/Replace" & vbCrLf & "with parameters:" & vbCrLf & vbCrLf 201 | s = s & "Find string: " & PointerToString(fr.lpstrFindWhat) & vbCrLf 202 | s = s & "Replace string: " & PointerToString(fr.lpstrReplaceWith) & vbCrLf & vbCrLf 203 | s = s & "Current Flags: " & vbCrLf & vbCrLf 204 | s = s & "FR_FINDNEXT = " & CheckFlags(FR_FINDNEXT, fr.flags) & vbCrLf 205 | s = s & "FR_REPLACE = " & CheckFlags(FR_REPLACE, fr.flags) & vbCrLf 206 | s = s & "FR_REPLACEALL = " & CheckFlags(FR_REPLACEALL, fr.flags) & vbCrLf 207 | s = s & "FR_DOWN = " & CheckFlags(FR_DOWN, fr.flags) & vbCrLf 208 | s = s & "FR_MATCHCASE = " & CheckFlags(FR_MATCHCASE, fr.flags) & vbCrLf 209 | s = s & "FR_WHOLEWORD = " & CheckFlags(FR_WHOLEWORD, fr.flags) 210 | 'MsgBox s, vbOKOnly + vbInformation, "Find/Replace parameters" 211 | Form1.Label1.Caption = s 212 | End Sub 213 | 214 | 'Private Function PointerToString(p As Long) As String 215 | ' Dim s As String: s = String(BufLength, Chr$(0)) 216 | ' lstrcpyW StrPtr(s), p 217 | ' PointerToString = Left(s, InStr(s, Chr$(0)) - 1) 218 | 'End Function 219 | ' 220 | 'Private Function CheckFlags(flag As Long, flags As Long) As Boolean 221 | ' CheckFlags = ((flags And flag) = flag) 222 | 'End Function 223 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/Form1.vb: -------------------------------------------------------------------------------- 1 | Public Class Form1 2 | 3 | Private Const LockedFolder As String = "C:\Windows" 4 | 5 | Private WithEvents OFD As New FileDialog 6 | Private WithEvents PFD_Locked As New FileDialog(FileDialog.DialogType.PicFolderDialog) 7 | Private ReadOnly OpenFileTypes As FileDialog.COMDLG_FILTERSPEC() = New FileDialog.COMDLG_FILTERSPEC(4) {} 8 | Private ReadOnly SaveFileTypes As FileDialog.COMDLG_FILTERSPEC() = New FileDialog.COMDLG_FILTERSPEC(3) {} 9 | 10 | Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load 11 | 12 | OpenFileTypes(0) = New FileDialog.COMDLG_FILTERSPEC("JPEG Files", "*.jpg") 13 | OpenFileTypes(1) = New FileDialog.COMDLG_FILTERSPEC("GIF Files", "*.gif") 14 | OpenFileTypes(2) = New FileDialog.COMDLG_FILTERSPEC("BITMAP Files", "*.bmp") 15 | OpenFileTypes(3) = New FileDialog.COMDLG_FILTERSPEC("IMAGE Files", "*.bmp; *.gif; *.jpg") 16 | OpenFileTypes(4) = New FileDialog.COMDLG_FILTERSPEC("All Files", "*.*") 17 | 18 | SaveFileTypes(0) = New FileDialog.COMDLG_FILTERSPEC("JPEG Files", "*.jpg") 19 | SaveFileTypes(1) = New FileDialog.COMDLG_FILTERSPEC("GIF Files", "*.gif") 20 | SaveFileTypes(2) = New FileDialog.COMDLG_FILTERSPEC("BITMAP Files", "*.bmp") 21 | SaveFileTypes(3) = New FileDialog.COMDLG_FILTERSPEC("All Files", "*.*") 22 | 23 | OFD.SetFileTypes(OpenFileTypes) 24 | OFD.SetFileTypeIndex(3) 25 | 26 | OFD.SetTitle("Dialog Title") 27 | OFD.SetOkButtonLabel("OK Button Label") 28 | OFD.SetCancelButtonLabel("Cancel Button Label") 29 | OFD.SetFileNameLabel("FileName Label") 30 | 31 | OFD.StartVisualGroup(1, "ComboBox:") 32 | OFD.AddComboBox(100) 33 | OFD.AddControlItem(100, 101, "ComboBoxItem 1") 34 | OFD.AddControlItem(100, 102, "ComboBoxItem 2") 35 | OFD.AddControlItem(100, 103, "ComboBoxItem 3") 36 | OFD.AddControlItem(100, 104, "ComboBoxItem 4") 37 | OFD.SetSelectedControlItem(100, 101) 38 | OFD.EndVisualGroup() 39 | 40 | OFD.StartVisualGroup(2, "Menu:") 41 | OFD.AddMenu(200, "Menu") 42 | OFD.AddControlItem(200, 201, "MenuItem 1") 43 | OFD.AddControlItem(200, 202, "MenuItem 2") 44 | OFD.AddControlItem(200, 203, "MenuItem 3") 45 | OFD.AddControlItem(200, 204, "MenuItem 4") 46 | OFD.EndVisualGroup() 47 | 48 | OFD.StartVisualGroup(3, "RadioButtonList:") 49 | OFD.AddRadioButtonList(300) 50 | OFD.AddControlItem(300, 301, "RadioButton 1") 51 | OFD.AddControlItem(300, 302, "RadioButton 2") 52 | OFD.AddControlItem(300, 303, "RadioButton 3") 53 | OFD.AddControlItem(300, 304, "RadioButton 4") 54 | OFD.SetSelectedControlItem(300, 304) 55 | OFD.EndVisualGroup() 56 | 57 | OFD.StartVisualGroup(4, "Other Controls:") 58 | OFD.AddEditBox(400, "EditBox") 59 | OFD.AddText(401, "Text 1") 60 | OFD.AddSeparator(402) 61 | OFD.AddText(403, "Text 2") 62 | OFD.EndVisualGroup() 63 | 64 | OFD.StartVisualGroup(5, "CheckBoxes:") 65 | OFD.AddCheckButton(500, "CheckBox 1") 66 | OFD.AddCheckButton(501, "CheckBox 2") 67 | OFD.AddCheckButton(502, "CheckBox 3") 68 | OFD.AddCheckButton(503, "CheckBox 4") 69 | OFD.EndVisualGroup() 70 | 71 | OFD.AddPushButton(600, "PushButton") 72 | OFD.MakeProminent(600) ' macht ein Control oder VisualGroup prominent (links neben den Standard Buttons) 73 | 74 | 75 | ' Optional: 76 | OFD.SetOptions(OFD.GetOptions Or FileDialog.FILEOPENDIALOGOPTIONS.FOS_FORCEPREVIEWPANEON) 77 | 78 | ' Systemordner 79 | ' "::{645FF040-5081-101B-9F08-00AA002F954E}" = Papierkorb 80 | ' "::{F02C1A0D-BE21-4350-88B0-7367FC96EF3C}" = Netzwerk 81 | ' "::{031E4825-7B94-4DC3-B131-E946B44C8DD5}" = Bibliotheken 82 | ' und andere Sytemordner... 83 | 84 | 'OFD.SetFolder("C:") '<- oder auch Systemordner 85 | 'OFD.SetDefaultFolder("C:") '<- oder auch Systemordner 86 | 'OFD.SetNavigationRoot("C:") 87 | 88 | ' zusätzlicher Ordner links im TreeView (Projektname mit dem User.ico) mit zwei Unterordner 89 | OFD.AddPlace("C:\Windows\System32") 90 | OFD.AddPlace("C:\Windows\SoftwareDistribution") 91 | 92 | ' ohne diese Zeile werden Einstellungen des Dialoges, wie zB. der zuletzt ausgewählte Pfad, Standardmäßig für diese Anwendung gespeichert oder 93 | ' mit dieser Zeile und GUID = Einstellungen des Dialoges, wie der zuletzt ausgewählte Pfad, werden Standardmäßig für diese Anwendung zu dieser GUID gespeichert 94 | ' und stehen nach einem erneutem Start der Applikation dem Dialog wieder zu Verfügung 95 | 'OFD.SetClientGuid([hier eine erzeugte GUID eintragen]) 96 | 97 | End Sub 98 | 99 | Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 100 | 101 | OFD.SetEditBoxText(400, "EditBox") 102 | 103 | If OFD.Show Then 104 | 105 | Debug.Print(OFD.GetResult) 106 | 'Debug.Print(OFD.GetResult(FileDialog.SIGDN.SIGDN_NORMALDISPLAY)) 107 | Debug.Print(OFD.GetFolder) 108 | 'Debug.Print(OFD.GetFolder(FileDialog.SIGDN.SIGDN_NORMALDISPLAY)) 109 | 110 | End If 111 | 112 | ' Optional: 113 | ' löscht die gespeicherten Einstellungen dieses Dialoges wie den zuletzt gewählten Pfad 114 | ' entwerder Standard oder für die GUID (SetClientGuid) 115 | OFD.ClearClientData() 116 | 117 | End Sub 118 | 119 | Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click 120 | 121 | Using OFD1 As New FileDialog 122 | 123 | OFD1.SetFileTypes(OpenFileTypes) 124 | OFD1.SetFileTypeIndex(3) 125 | 126 | If OFD1.Show Then 127 | 128 | Debug.Print(OFD1.GetResult) 129 | 130 | End If 131 | 132 | End Using 133 | 134 | End Sub 135 | 136 | Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click 137 | 138 | Using SFD As New FileDialog(FileDialog.DialogType.SaveFileDialog) 139 | 140 | SFD.SetFileTypes(SaveFileTypes) 141 | SFD.SetFileTypeIndex() 142 | 143 | SFD.SetFileName("NewFile") 144 | SFD.SetDefaultExtension() 145 | 146 | If SFD.Show Then 147 | 148 | Debug.Print(SFD.GetResult) 149 | 150 | End If 151 | 152 | End Using 153 | 154 | End Sub 155 | 156 | Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click 157 | 158 | Using PFD As New FileDialog(FileDialog.DialogType.PicFolderDialog) 159 | 160 | If PFD.Show Then 161 | 162 | Debug.Print(PFD.GetResult) 163 | 164 | End If 165 | 166 | End Using 167 | 168 | End Sub 169 | 170 | 171 | Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click 172 | 173 | PFD_Locked.SetTitle("Hinweis: Es können nur Ordner und Unterordner von '" & LockedFolder & "' ausgwählt werden!") 174 | 175 | PFD_Locked.SetNavigationRoot(LockedFolder) 176 | 177 | If PFD_Locked.Show Then 178 | 179 | Debug.Print(PFD_Locked.GetResult) 180 | 181 | End If 182 | 183 | End Sub 184 | 185 | Private Sub PFD_Locked_FolderChanging(Folder As String) Handles PFD_Locked.FolderChanging 186 | 187 | ' hier setzen wir einfach wieder den LockedFolder wenn es nicht der Ordner selbst 188 | ' oder ein Unterordner von LockedFolder ist 189 | 190 | If Folder.Length < LockedFolder.Length Then 191 | 192 | PFD_Locked.SetFolder(LockedFolder) 193 | 194 | ElseIf Folder.Substring(0, LockedFolder.Length) <> LockedFolder Then 195 | 196 | PFD_Locked.SetFolder(LockedFolder) 197 | 198 | End If 199 | 200 | End Sub 201 | 202 | Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click 203 | 204 | Using OFD1 As New FileDialog 205 | 206 | Dim EditorFileTypes As FileDialog.COMDLG_FILTERSPEC() = New FileDialog.COMDLG_FILTERSPEC(1) {} 207 | EditorFileTypes(0) = New FileDialog.COMDLG_FILTERSPEC("Textdateien", "*.txt") 208 | EditorFileTypes(1) = New FileDialog.COMDLG_FILTERSPEC("Alle Dateien", "*.*") 209 | 210 | OFD1.SetFileTypes(EditorFileTypes) 211 | OFD1.SetFileTypeIndex() 212 | 213 | OFD1.StartVisualGroup(1, "Codierung:") 214 | OFD1.AddComboBox(100) 215 | OFD1.AddControlItem(100, 101, "Automatische Erkennung") 216 | OFD1.AddControlItem(100, 102, "Ansi") 217 | OFD1.AddControlItem(100, 103, "UTF-16 LE") 218 | OFD1.AddControlItem(100, 104, "UTF-16 BE") 219 | OFD1.AddControlItem(100, 105, "UTF-8") 220 | OFD1.AddControlItem(100, 106, "UTF-8 mit BOM") 221 | OFD1.SetSelectedControlItem(100, 101) 222 | OFD1.EndVisualGroup() 223 | 224 | If OFD1.Show Then 225 | 226 | Debug.Print(OFD1.GetResult) 227 | 228 | End If 229 | 230 | End Using 231 | 232 | End Sub 233 | 234 | '----==== Events IFileDialogEvents ====---- 235 | Private Sub OFD_FileOK() Handles OFD.FileOK 236 | Debug.Print("FileOK") 237 | End Sub 238 | 239 | Private Sub OFD_FolderChange() Handles OFD.FolderChange 240 | Debug.Print("FolderChange") 241 | End Sub 242 | 243 | Private Sub OFD_FolderChanging(Folder As String) Handles OFD.FolderChanging 244 | Debug.Print("FolderChanging: " & Folder) 245 | End Sub 246 | 247 | Private Sub OFD_Overwrite(Name As String, Response As FileDialog.FDE_OVERWRITE_RESPONSE) Handles OFD.Overwrite 248 | Debug.Print("Overwrite: " & Name & " Response: " & Response.ToString) 249 | End Sub 250 | 251 | Private Sub OFD_SelectionChange() Handles OFD.SelectionChange 252 | Debug.Print("SelectionChange: " & OFD.GetCurrentSelection) 253 | End Sub 254 | 255 | Private Sub OFD_ShareViolation(Name As String, Response As FileDialog.FDE_SHAREVIOLATION_RESPONSE) Handles OFD.ShareViolation 256 | Debug.Print("ShareViolation: " & Name & " Response: " & Response.ToString) 257 | End Sub 258 | 259 | Private Sub OFD_TypeChange() Handles OFD.TypeChange 260 | Debug.Print("TypeChange") 261 | End Sub 262 | 263 | 264 | '----==== Events IFileDialogControlEvents ====---- 265 | Private Sub OFD_ButtonClicked(CtlID As Integer) Handles OFD.ButtonClicked 266 | Debug.Print("ButtonClicked CtlID: " & CtlID.ToString) 267 | End Sub 268 | 269 | Private Sub OFD_CheckButtonToggled(CtlID As Integer, Checked As Boolean) Handles OFD.CheckButtonToggled 270 | Debug.Print("CheckButtonToggled CtlID: " & CtlID.ToString & " Checked: " & Checked.ToString) 271 | End Sub 272 | 273 | Private Sub OFD_ControlActivating(CtlID As Integer) Handles OFD.ControlActivating 274 | Debug.Print("ControlActivating CtlID: " & CtlID.ToString) 275 | End Sub 276 | 277 | Private Sub OFD_ItemSelected(CtlID As Integer, ItemID As Integer) Handles OFD.ItemSelected 278 | Debug.Print("ItemSelected CtlID: " & CtlID.ToString & " ItemID: " & ItemID.ToString) 279 | 280 | If CtlID = 300 Then 281 | Select Case ItemID 282 | Case 301 283 | OFD.SetEditBoxText(400, "Option 1") 284 | Case 302 285 | OFD.SetEditBoxText(400, "Option 2") 286 | Case 303 287 | OFD.SetEditBoxText(400, "Option 3") 288 | Case 304 289 | OFD.SetEditBoxText(400, "Option 4") 290 | End Select 291 | End If 292 | End Sub 293 | 294 | End Class 295 | -------------------------------------------------------------------------------- /Classes/MessageBox.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "MessageBox" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | Private Const IDOK As Long = 1 ' The selected button was OK 16 | Private Const IDCANCEL As Long = 2 ' The selected button was Cancel 17 | Private Const IDABORT As Long = 3 ' The selected button was Abort 18 | Private Const IDRETRY As Long = 4 ' The selected button was Retry 19 | Private Const IDIGNORE As Long = 5 ' The selected button was Ignore 20 | Private Const IDYES As Long = 6 ' The selected button was Yes 21 | Private Const IDNO As Long = 7 ' The selected button was No 22 | Private Const IDTRYAGAIN As Long = 10 ' The selected button was Try-Again 23 | Private Const IDCONTINUE As Long = 11 ' The selected button was Continue 24 | 25 | Public Enum MsgBoxResult ' compare: vbMsgBoxResult 26 | vbOK = 1 ' = vbMsgBoxResult.vbOK '' OK 27 | vbCancel = 2 ' = vbMsgBoxResult.vbCancel '' Abbrechen 28 | vbAbort = 3 ' = vbMsgBoxResult.vbAbort '' Abbrechen 29 | vbRetry = 4 ' = vbMsgBoxResult.vbRetry '' Wiederholen 30 | vbIgnore = 5 ' = vbMsgBoxResult.vbIgnore '' Ignorieren 31 | vbYes = 6 ' = vbMsgBoxResult.vbYes '' Ja 32 | vbNo = 7 ' = vbMsgBoxResult.vbNo '' Nein 33 | vbTryAgain = 10 ' '' Wiederholen 34 | vbContinue = 11 ' '' Weiter 35 | End Enum 36 | 37 | Private Const MB_USERICON As Long = &H80& 38 | 39 | 'Table 1 40 | 'To indicate the buttons displayed in the message box, specify one of the following values. 41 | Private Const MB_OK As Long = &H0& ' The message box contains one push button : OK. This is the default. 42 | Private Const MB_OKCANCEL As Long = &H1& ' The message box contains two push buttons: OK and Cancel. 43 | Private Const MB_ABORTRETRYIGNORE As Long = &H2& ' The message box contains three push buttons: Abort, Retry, and Ignore. 44 | Private Const MB_YESNOCANCEL As Long = &H3& ' The message box contains three push buttons: Yes, No, and Cancel. 45 | Private Const MB_YESNO As Long = &H4& ' The message box contains two push buttons : Yes and No. 46 | Private Const MB_RETRYCANCEL As Long = &H5& ' The message box contains two push buttons : Retry and Cancel. 47 | Private Const MB_CANCELTRYCONTINUE As Long = &H6& ' The message box contains three push buttons: Cancel, Try Again, Continue. Use this message box type instead of MB_ABORTRETRYIGNORE. 48 | Private Const MB_HELP As Long = &H4000& ' Adds a Help button to the message box. When the user clicks the Help button or presses F1, the system sends a WM_HELP message to the owner. 49 | 50 | 51 | 'Table 2 52 | 'To display an icon in the message box, specify one of the following values. 53 | Private Const MB_ICONSTOP As Long = &H10& ' A stop-sign icon appears in the message box. 54 | Private Const MB_ICONERROR As Long = &H10& ' A stop-sign icon appears in the message box. 55 | Private Const MB_ICONHAND As Long = &H10& ' A stop-sign icon appears in the message box. 56 | Private Const MB_ICONQUESTION As Long = &H20& ' A question-mark icon appears in the message box. The question-mark message icon is no longer recommended because it does not clearly represent a specific type of message and because the phrasing of a message as a question could apply to any message type. In addition, users can confuse the message symbol question mark with Help information. Therefore, do not use this question mark message symbol in your message boxes. The system continues to support its inclusion only for backward compatibility. 57 | Private Const MB_ICONEXCLAMATION As Long = &H30& ' An exclamation-point icon appears in the message box. 58 | Private Const MB_ICONWARNING As Long = &H30& ' An exclamation-point icon appears in the message box. 59 | Private Const MB_ICONINFORMATION As Long = &H40& ' An icon consisting of a lowercase letter i in a circle appears in the message box. 60 | Private Const MB_ICONASTERISK As Long = &H40& ' An icon consisting of a lowercase letter i in a circle appears in the message box. 61 | 62 | 'Table 3 63 | 'To indicate the default button, specify one of the following values. 64 | Private Const MB_DEFBUTTON1 As Long = &H0& ' The first button is the default button. 65 | ' MB_DEFBUTTON1 is the default unless MB_DEFBUTTON2, MB_DEFBUTTON3, or MB_DEFBUTTON4 is specified. 66 | Private Const MB_DEFBUTTON2 As Long = &H100& ' The second button is the default button. 67 | Private Const MB_DEFBUTTON3 As Long = &H200& ' The third button is the default button. 68 | Private Const MB_DEFBUTTON4 As Long = &H300& ' The fourth button is the default button. 69 | 70 | 'Table 4 71 | 'To indicate the modality of the dialog box, specify one of the following values. 72 | Private Const MB_APPLMODAL As Long = &H0& ' The user must respond to the message box before continuing work in the window identified by the hWnd parameter. However, the user can move to the windows of other threads and work in those windows. 73 | ' Depending on the hierarchy of windows in the application, the user may be able to move to other windows within the thread. All child windows of the parent of the message box are automatically disabled, but pop-up windows are not. 74 | ' MB_APPLMODAL is the default if neither MB_SYSTEMMODAL nor MB_TASKMODAL is specified. 75 | Private Const MB_SYSTEMMODAL As Long = &H1000& ' Same as MB_APPLMODAL except that the message box has the WS_EX_TOPMOST style. Use system-modal message boxes to notify the user of serious, potentially damaging errors that require immediate attention (for example, running out of memory). This flag has no effect on the user's ability to interact with windows other than those associated with hWnd. 76 | Private Const MB_TASKMODAL As Long = &H2000& ' Same as MB_APPLMODAL except that all the top-level windows belonging to the current thread are disabled if the hWnd parameter is NULL. Use this flag when the calling application or library does not have a window handle available but still needs to prevent input to other windows in the calling thread without suspending other threads. 77 | 78 | 79 | 'Table 5 80 | 'To specify other options, use one or more of the following values. 81 | Private Const MB_SETFOREGROUND As Long = &H10000 ' The message box becomes the foreground window. Internally, the system calls the SetForegroundWindow function for the message box. 82 | Private Const MB_DEFAULT_DESKTOP_ONLY As Long = &H20000 ' Same as desktop of the interactive window station. For more information, see Window Stations. 83 | ' If the current input desktop is not the default desktop, MessageBox does not return until the user switches to the default desktop. 84 | Private Const MB_TOPMOST As Long = &H40000 ' The message box is created with the WS_EX_TOPMOST window style. 85 | Private Const MB_RIGHT As Long = &H80000 ' The text is right-justified. 86 | Private Const MB_RTLREADING As Long = &H100000 ' Displays message and caption text using right-to-left reading order on Hebrew and Arabic systems. 87 | Private Const MB_SERVICE_NOTIFICATION As Long = &H200000 ' The caller is a service notifying the user of an event. The function displays a message box on the current active desktop, even if there is no user logged on to the computer. 88 | ' Terminal Services: If the calling thread has an impersonation token, the function directs the message box to the session specified in the impersonation token. 89 | ' If this flag is set, the hWnd parameter must be NULL. This is so that the message box can appear on a desktop other than the desktop corresponding to the hWnd. 90 | ' For information on security considerations in regard to using this flag, see Interactive Services. In particular, be aware that this flag can produce interactive content on a locked desktop and should therefore be used for only a very limited set of scenarios, such as resource exhaustion. 91 | 92 | Public Enum MsgBoxStyle 93 | 94 | 'Button-style 95 | vbOKOnly = 0 96 | vbOKCancel = 1 97 | vbAbortRetryIgnore = 2 98 | vbYesNoCancel = 3 99 | vbYesNo = 4 100 | vbRetryCancel = 5 101 | vbCancelTryContinue = 6 102 | vbMsgBoxHelpButton = 16384 '(&H4000) 103 | 104 | 'modality-style 105 | vbApplicationModal = 0 106 | vbSystemModal = &H1000& ' 4096 (&H1000) 107 | vbTaskModal = &H2000& 108 | 109 | 'Icon-style 110 | vbCritical = 16 '(&H10) 111 | vbQuestion = 32 '(&H20) 112 | vbExclamation = 48 '(&H30) 113 | vbInformation = 64 '(&H40) 114 | 115 | 'Default button when pressing Enter 116 | vbDefaultButton1 = 0 117 | vbDefaultButton2 = 256 '(&H100) 118 | vbDefaultButton3 = 512 '(&H200) 119 | vbDefaultButton4 = 768 '(&H300) 120 | 121 | vbMsgBoxSetForeground = 65536 '(&H10000) 122 | vbMsgBoxRight = 524288 '(&H80000) 123 | vbMsgBoxRtlReading = 1048576 '(&H100000) 124 | 125 | End Enum 126 | 127 | Public Enum MsgBoxFncType 128 | vbNormal = 0 129 | vbExtra = 1 130 | vbIndirect = 2 131 | End Enum 132 | 133 | 'Maybe copy this to a module 134 | #If VBA7 = 0 Then 135 | Private Enum LongPtr 136 | [_] 137 | End Enum 138 | #End If 139 | 140 | Private Type MSGBOXPARAMS 141 | cbSize As Long 142 | hwndOwner As LongPtr 'Long 143 | hInstance As LongPtr 'Long 144 | lpszText As LongPtr 'String 145 | lpszCaption As LongPtr 'String 146 | dwStyle As Long ' = wType = uType Type: UINT 'The contents and behavior of the dialog box. This parameter can be a combination of flags from the following groups of flags, see table 1-5 147 | lpszIcon As LongPtr 'String 'lpszIcon Type: LPCTSTR 148 | 'Identifies an icon resource. This parameter can be either a null-terminated string or an integer resource identifier passed to the MAKEINTRESOURCE macro. 149 | 'To load one of the standard system-defined icons, set the hInstance member to NULL and set lpszIcon to one of the values listed with the LoadIcon function. 150 | 'This member is ignored if the dwStyle member does not specify the MB_USERICON flag. 151 | dwContextHelpId As Long 152 | lpfnMsgBoxCallback As LongPtr 'Type: MSGBOXCALLBACK 153 | 'A pointer to the callback function that processes help events for the message box. The callback function has the following form: 154 | 'VOID CALLBACK MsgBoxCallback(LPHELPINFO lpHelpInfo); 155 | 'If this member is NULL, then the message box sends WM_HELP messages to the owner window when help events occur. 156 | dwLanguageId As Long 157 | End Type 158 | 159 | #If VBA7 Then 160 | Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hwnd As LongPtr, ByRef lpText As Any, ByRef lpCaption As Any, ByVal wType As Long) As Long 161 | Private Declare PtrSafe Function MessageBoxExW Lib "user32" (ByVal hwnd As LongPtr, ByRef lpText As Any, ByVal lpCaption As Any, ByVal uType As Long, ByVal wLanguageId As Long) As Long 162 | Private Declare PtrSafe Function MessageBoxIndirectW Lib "user32" (ByRef lpMsgBoxParams As Any) As Long 163 | #Else 164 | Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As LongPtr, ByRef lpText As Any, ByRef lpCaption As Any, ByVal wType As Long) As Long 165 | Private Declare Function MessageBoxExW Lib "user32" (ByVal hwnd As LongPtr, ByRef lpText As Any, ByVal lpCaption As Any, ByVal uType As Long, ByVal wLanguageId As Long) As Long 166 | Private Declare Function MessageBoxIndirectW Lib "user32" (ByRef lpMsgBoxParams As Any) As Long 167 | #End If 168 | 169 | Private m_MsgBoxFncType As MsgBoxFncType 170 | Private m_MsgBoxParams As MSGBOXPARAMS 171 | Private m_Title As String 'aka Caption 172 | Private m_Text As String 'aka Prompt 173 | Private m_Result As MsgBoxResult 174 | 175 | Private Sub Class_Initialize() 176 | With m_MsgBoxParams 177 | .cbSize = LenB(m_MsgBoxParams) 178 | .dwStyle = vbOKOnly 179 | '.hwndOwner = ActiveWindow 180 | '.hInstance = App.hInstance 181 | m_Title = App.EXEName 182 | End With 183 | End Sub 184 | 185 | Public Property Get HIcon() As Long 186 | HIcon = m_MsgBoxParams.lpszIcon 187 | End Property 188 | Public Property Let HIcon(ByVal Value As Long) 189 | m_MsgBoxParams.lpszIcon = Value 190 | End Property 191 | 192 | Public Property Get Prompt() As String 193 | Prompt = m_Text 'aka Text 194 | End Property 195 | Public Property Let Prompt(ByVal Value As String) 196 | m_Text = Value 'aka Text 197 | End Property 198 | Public Property Get Text() As String 199 | Text = m_Text 'aka Prompt 200 | End Property 201 | Public Property Let Text(ByVal Value As String) 202 | m_Text = Value 'aka Prompt 203 | End Property 204 | 205 | Public Property Get Title() As String 206 | Title = m_Title 'aka Caption 207 | End Property 208 | Public Property Let Title(ByVal Value As String) 209 | m_Title = Value 'aka Caption 210 | End Property 211 | Public Property Get Caption() As String 212 | Caption = m_Title 'aka Title 213 | End Property 214 | Public Property Let Caption(ByVal Value As String) 215 | m_Title = Value 'aka Title 216 | End Property 217 | 218 | Public Property Get Style() As MsgBoxStyle 219 | Style = m_MsgBoxParams.dwStyle 220 | End Property 221 | Public Property Let Style(ByVal Value As MsgBoxStyle) 222 | m_MsgBoxParams.dwStyle = Value 223 | End Property 224 | 225 | Public Property Get MsgBoxFncType() As MsgBoxFncType 226 | MsgBoxFncType = m_MsgBoxFncType 227 | End Property 228 | Public Property Let MsgBoxFncType(ByVal Value As MsgBoxFncType) 229 | m_MsgBoxFncType = Value 230 | End Property 231 | 232 | Public Property Get LanguageID() As Long 233 | LanguageID = m_MsgBoxParams.dwLanguageId 234 | End Property 235 | Public Property Let LanguageID(ByVal Value As Long) 236 | m_MsgBoxParams.dwLanguageId = Value 237 | End Property 238 | 239 | Private Function FncPtr(pFnc As LongPtr) As LongPtr 240 | FncPtr = pFnc 241 | End Function 242 | 243 | Public Function Show(Optional aPrompt, Optional BtnsAndStyle, Optional aTitle, Optional aHelpFile, Optional aContext) As MsgBoxResult 244 | 'Optional BtnsAndStyle As MsgBoxStyle = vbOKOnly 245 | If Not IsMissing(aPrompt) Then m_Text = CStr(aPrompt) 246 | If Not IsMissing(aTitle) Then m_Title = CStr(aTitle) 247 | With m_MsgBoxParams 248 | .lpfnMsgBoxCallback = FncPtr(AddressOf MWin.MessageBoxCallBack) 249 | .lpszCaption = StrPtr(m_Title) 250 | .lpszText = StrPtr(m_Text) 251 | If Not IsMissing(BtnsAndStyle) Then 252 | .dwStyle = CLng(BtnsAndStyle) 253 | End If 254 | '.lpszIcon = hIcon 255 | 256 | Select Case m_MsgBoxFncType 257 | Case 0: m_Result = MessageBoxW(.hwndOwner, ByVal .lpszText, ByVal .lpszCaption, .dwStyle) 258 | Case 1: m_Result = MessageBoxExW(.hwndOwner, ByVal .lpszText, ByVal .lpszCaption, .dwStyle, .dwLanguageId) 259 | Case 2: m_Result = MessageBoxIndirectW(m_MsgBoxParams) 260 | End Select 261 | 262 | End With 263 | Show = m_Result 264 | End Function 265 | 266 | Public Function Result_ToStr(Optional aMsgBoxResult) As String 267 | Dim s As String 268 | Dim r As MsgBoxResult: r = IIf(IsMissing(aMsgBoxResult), m_Result, CLng(aMsgBoxResult)) 269 | Select Case r 270 | Case vbOK: s = "OK" 271 | Case vbCancel: s = "Cancel" 272 | Case vbAbort: s = "Abort" 273 | Case vbRetry: s = "Retry" 274 | Case vbIgnore: s = "Ignore" 275 | Case vbYes: s = "Yes" 276 | Case vbNo: s = "No" 277 | Case vbTryAgain: s = "TryAgain" 278 | Case vbContinue: s = "Continue" 279 | End Select 280 | Result_ToStr = s 281 | End Function 282 | 283 | 'Function MyMsgbox(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As Variant, Optional HelpFile As Variant, Optional Context As Variant) As VbMsgBoxResult 284 | -------------------------------------------------------------------------------- /archiv/VBN_IFileDialog/VBN_IFileDialog/PickFolderDialog.vb: -------------------------------------------------------------------------------- 1 | Option Strict On 2 | Option Explicit On 3 | 4 | Imports System.Runtime.InteropServices 5 | 6 | Public Class PickFolderDialog 7 | Implements IDisposable 8 | Implements IFileDialogEvents 9 | 10 | #Region "New" 11 | Public Sub New() 12 | 'Dim eFILEOPENDIALOGOPTIONS As FILEOPENDIALOGOPTIONS 13 | m_FileOpenDialog = Activator.CreateInstance(Type.GetTypeFromCLSID(New Guid(CLSID_FileOpenDialog))) 14 | If m_FileOpenDialog IsNot Nothing Then 15 | 'If CType(m_FileOpenDialog, IFileDialog2).GetOptions(eFILEOPENDIALOGOPTIONS) = S_OK Then 16 | ' eFILEOPENDIALOGOPTIONS = eFILEOPENDIALOGOPTIONS Or FILEOPENDIALOGOPTIONS.FOS_PICKFOLDERS 17 | ' If CType(m_FileOpenDialog, IFileDialog2).SetOptions(eFILEOPENDIALOGOPTIONS) = S_OK Then 18 | If CType(m_FileOpenDialog, IFileDialog2).Advise(Me, m_Cookie) = S_OK Then 19 | End If 20 | ' End If 21 | 'End If 22 | End If 23 | End Sub 24 | #End Region 25 | 26 | #Region "API" 27 | 28 | Private Shared Function SHCreateItemFromParsingName(<[In], MarshalAs(UnmanagedType.LPWStr)> pszPath As String, 29 | <[In]> pbc As IntPtr, 30 | <[In], MarshalAs(UnmanagedType.LPStruct)> riid As Guid, 31 | ByRef pUnk As IntPtr) As Integer 32 | End Function 33 | #End Region 34 | 35 | #Region "Enum" 36 | Public Enum FILEOPENDIALOGOPTIONS As Integer 37 | FOS_OVERWRITEPROMPT = &H2 38 | FOS_STRICTFILETYPES = &H4 39 | FOS_NOCHANGEDIR = &H8 40 | FOS_PICKFOLDERS = &H20 41 | FOS_FORCEFILESYSTEM = &H40 42 | FOS_ALLNONSTORAGEITEMS = &H80 43 | FOS_NOVALIDATE = &H100 44 | FOS_ALLOWMULTISELECT = &H200 45 | FOS_PATHMUSTEXIST = &H800 46 | FOS_FILEMUSTEXIST = &H1000 47 | FOS_CREATEPROMPT = &H2000 48 | FOS_SHAREAWARE = &H4000 49 | FOS_NOREADONLYRETURN = &H8000 50 | FOS_NOTESTFILECREATE = &H10000 51 | FOS_HIDEMRUPLACES = &H20000 52 | FOS_HIDEPINNEDPLACES = &H40000 53 | FOS_NODEREFERENCELINKS = &H100000 54 | FOS_OKBUTTONNEEDSINTERACTION = &H200000 55 | FOS_DONTADDTORECENT = &H2000000 56 | FOS_FORCESHOWHIDDEN = &H10000000 57 | FOS_DEFAULTNOMINIMODE = &H20000000 58 | FOS_FORCEPREVIEWPANEON = &H40000000 59 | FOS_SUPPORTSTREAMABLEITEMS = &H80000000 60 | End Enum 61 | 62 | Public Enum SIGDN As Integer 63 | SIGDN_NORMALDISPLAY = &H0 64 | SIGDN_PARENTRELATIVEPARSING = &H80018001 65 | SIGDN_DESKTOPABSOLUTEPARSING = &H80028000 66 | SIGDN_PARENTRELATIVEEDITING = &H80031001 67 | SIGDN_DESKTOPABSOLUTEEDITING = &H8004C000 68 | SIGDN_FILESYSPATH = &H80058000 69 | SIGDN_URL = &H80068000 70 | SIGDN_PARENTRELATIVEFORADDRESSBAR = &H8007C001 71 | SIGDN_PARENTRELATIVE = &H80080001 72 | SIGDN_PARENTRELATIVEFORUI = &H80094001 73 | End Enum 74 | 75 | Private Enum FDAP As Integer 76 | FDAP_BOTTOM = 0 77 | FDAP_TOP = 1 78 | End Enum 79 | 80 | Private Enum FDE_SHAREVIOLATION_RESPONSE As Integer 81 | FDESVR_DEFAULT = &H0 82 | FDESVR_ACCEPT = &H1 83 | FDESVR_REFUSE = &H2 84 | End Enum 85 | Private Enum FDE_OVERWRITE_RESPONSE As Integer 86 | FDEOR_DEFAULT = &H0 87 | FDEOR_ACCEPT = &H1 88 | FDEOR_REFUSE = &H2 89 | End Enum 90 | #End Region 91 | 92 | #Region "Const" 93 | Private Const S_OK As Integer = 0 94 | 95 | Private Const IID_IShellItem As String = "43826d1e-e718-42ee-bc55-a1e261c37bfe" 96 | Private Const IID_IFileDialog2 As String = "61744fc7-85b5-4791-a9b0-272276309b13" 97 | Private Const IID_IFileDialogEvents As String = "973510db-7d7f-452b-8975-74a85828d354" 98 | 99 | Private Const CLSID_FileOpenDialog As String = "dc1c5a9c-e88a-4dde-a5a1-60f82a20aef7" 100 | #End Region 101 | 102 | #Region "Variable" 103 | Private m_DisposedValue As Boolean 104 | Private m_Cookie As Integer 105 | Private m_FileOpenDialog As Object 106 | #End Region 107 | 108 | #Region "Structure" 109 | Public Structure COMDLG_FILTERSPEC 110 | Dim pszName As String 111 | Dim pszSpec As String 112 | Sub New(Name As String, Spec As String) 113 | pszName = Name 114 | pszSpec = Spec 115 | End Sub 116 | End Structure 117 | #End Region 118 | 119 | #Region "Public Functions" 120 | Public Function Show() As Boolean 121 | Dim bolRet As Boolean = False 122 | If m_FileOpenDialog IsNot Nothing Then 123 | If CType(m_FileOpenDialog, IFileDialog2).Show(Form.ActiveForm.Handle) = S_OK Then 124 | bolRet = True 125 | End If 126 | End If 127 | Return bolRet 128 | End Function 129 | 130 | Public Function SetFileTypes(FilterSpec As COMDLG_FILTERSPEC()) As Boolean 131 | Dim bolRet As Boolean = False 132 | If m_FileOpenDialog IsNot Nothing Then 133 | If CType(m_FileOpenDialog, IFileDialog2).SetFileTypes(FilterSpec.Length, FilterSpec) = S_OK Then 134 | bolRet = True 135 | End If 136 | End If 137 | Return bolRet 138 | End Function 139 | 140 | Public Function SetFileTypeIndex(FileTypeIndex As Integer) As Boolean 141 | Dim bolRet As Boolean = False 142 | If m_FileOpenDialog IsNot Nothing Then 143 | If CType(m_FileOpenDialog, IFileDialog2).SetFileTypeIndex(Math.Abs(FileTypeIndex) + 1) = S_OK Then 144 | bolRet = True 145 | End If 146 | End If 147 | Return bolRet 148 | End Function 149 | 150 | Public Function GetFileTypeIndex() As Integer 151 | Dim FileTypeIndex As Integer = -1 152 | If m_FileOpenDialog IsNot Nothing Then 153 | If CType(m_FileOpenDialog, IFileDialog2).GetFileTypeIndex(FileTypeIndex) = S_OK Then 154 | FileTypeIndex -= 1 155 | End If 156 | End If 157 | Return FileTypeIndex 158 | End Function 159 | 160 | Public Function SetOptions(DialogOptions As FILEOPENDIALOGOPTIONS) As Boolean 161 | Dim bolRet As Boolean = False 162 | If m_FileOpenDialog IsNot Nothing Then 163 | If CType(m_FileOpenDialog, IFileDialog2).SetOptions(DialogOptions) = S_OK Then 164 | bolRet = True 165 | End If 166 | End If 167 | Return bolRet 168 | End Function 169 | 170 | Public Function GetOptions() As FILEOPENDIALOGOPTIONS 171 | Dim DialogOptions As New FILEOPENDIALOGOPTIONS 172 | If m_FileOpenDialog IsNot Nothing Then 173 | CType(m_FileOpenDialog, IFileDialog2).GetOptions(DialogOptions) 174 | End If 175 | Return DialogOptions 176 | End Function 177 | 178 | Public Function SetDefaultFolder(Optional Folder As String = Nothing) As Boolean 179 | Dim bolRet As Boolean = False 180 | If m_FileOpenDialog IsNot Nothing Then 181 | Dim pIShellItem As IntPtr 182 | If Folder Is Nothing Then Folder = Convert.ToChar(0) 183 | If SHCreateItemFromParsingName(Folder, IntPtr.Zero, 184 | New Guid(IID_IShellItem), 185 | pIShellItem) = S_OK Then 186 | If CType(m_FileOpenDialog, IFileDialog2).SetFolder(pIShellItem) = S_OK Then 187 | bolRet = True 188 | End If 189 | Marshal.Release(pIShellItem) 190 | End If 191 | End If 192 | Return bolRet 193 | End Function 194 | 195 | Public Function SetFolder(Optional Folder As String = Nothing) As Boolean 196 | Dim bolRet As Boolean = False 197 | If m_FileOpenDialog IsNot Nothing Then 198 | Dim pIShellItem As IntPtr 199 | If Folder Is Nothing Then Folder = Convert.ToChar(0) 200 | If SHCreateItemFromParsingName(Folder, IntPtr.Zero, 201 | New Guid(IID_IShellItem), 202 | pIShellItem) = S_OK Then 203 | If CType(m_FileOpenDialog, IFileDialog2).SetFolder(pIShellItem) = S_OK Then 204 | bolRet = True 205 | End If 206 | Marshal.Release(pIShellItem) 207 | End If 208 | End If 209 | Return bolRet 210 | End Function 211 | 212 | Public Function GetFolder(Optional sign As SIGDN = SIGDN.SIGDN_DESKTOPABSOLUTEPARSING) As String 213 | Dim strRet As String = String.Empty 214 | If m_FileOpenDialog IsNot Nothing Then 215 | Dim psi As IShellItem = Nothing 216 | If CType(m_FileOpenDialog, IFileDialog2).GetFolder(psi) = S_OK Then 217 | Dim pszName As IntPtr 218 | If psi.GetDisplayName(sign, pszName) = S_OK Then 219 | strRet = Marshal.PtrToStringUni(pszName) 220 | Marshal.FreeCoTaskMem(pszName) 221 | End If 222 | Marshal.ReleaseComObject(psi) 223 | End If 224 | End If 225 | Return strRet 226 | End Function 227 | 228 | ' Function GetCurrentSelection( ByRef ppsi As IShellItem) As Integer 229 | ' Function SetFileName(<[In], MarshalAs(UnmanagedType.LPWStr)> pszName As String) As Integer 230 | ' Function GetFileName( ByRef pszName As String) As Integer 231 | ' Function SetTitle(<[In], MarshalAs(UnmanagedType.LPWStr)> pszTitle As String) As Integer 232 | ' Function SetOkButtonLabel(<[In], MarshalAs(UnmanagedType.LPWStr)> pszText As String) As Integer 233 | ' Function SetFileNameLabel(<[In], MarshalAs(UnmanagedType.LPWStr)> pszLabel As String) As Integer 234 | 235 | Public Function GetResult(Optional sign As SIGDN = SIGDN.SIGDN_DESKTOPABSOLUTEPARSING) As String 236 | Dim strRet As String = String.Empty 237 | If m_FileOpenDialog IsNot Nothing Then 238 | Dim ShellItem As IShellItem = Nothing 239 | If CType(m_FileOpenDialog, IFileDialog2).GetResult(ShellItem) = S_OK Then 240 | Dim pszName As IntPtr 241 | If ShellItem.GetDisplayName(sign, pszName) = S_OK Then 242 | strRet = Marshal.PtrToStringUni(pszName) 243 | Marshal.FreeCoTaskMem(pszName) 244 | End If 245 | Marshal.ReleaseComObject(ShellItem) 246 | End If 247 | End If 248 | Return strRet 249 | End Function 250 | 251 | 252 | ' Function AddPlace(<[In]> psi As IntPtr, <[In]> fdap As FDAP) As Integer 253 | ' Function SetDefaultExtension(<[In], MarshalAs(UnmanagedType.LPWStr)> pszDefaultExtension As String) As Integer 254 | Public Function Close() As Boolean 255 | Dim bolRet As Boolean = False 256 | If m_FileOpenDialog IsNot Nothing Then 257 | If CType(m_FileOpenDialog, IFileDialog2).Close = S_OK Then 258 | bolRet = True 259 | End If 260 | End If 261 | Return bolRet 262 | End Function 263 | 264 | Public Function SetClientGuid(guid As Guid) As Boolean 265 | Dim bolRet As Boolean = False 266 | If m_FileOpenDialog IsNot Nothing Then 267 | If CType(m_FileOpenDialog, IFileDialog2).SetClientGuid(guid) = S_OK Then 268 | bolRet = True 269 | End If 270 | End If 271 | Return bolRet 272 | End Function 273 | 274 | Public Function ClearClientData() As Boolean 275 | Dim bolRet As Boolean = False 276 | If m_FileOpenDialog IsNot Nothing Then 277 | If CType(m_FileOpenDialog, IFileDialog2).ClearClientData = S_OK Then 278 | bolRet = True 279 | End If 280 | End If 281 | Return bolRet 282 | End Function 283 | 284 | ' Function SetCancelButtonLabel(<[In], MarshalAs(UnmanagedType.LPWStr)> pszLabel As String) As Integer 285 | ' Function SetNavigationRoot(<[In]> psi As IntPtr) As Integer 286 | 287 | 288 | 289 | #End Region 290 | 291 | 292 | #Region "Interface IShellItem" 293 | 294 | 295 | 296 | Private Interface IShellItem 297 | Function BindToHandler() As Integer 298 | Function GetParent() As Integer 299 | Function GetDisplayName(<[In]> sigdnName As SIGDN, 300 | ByRef ppszName As IntPtr) As Integer 301 | Function GetAttributes() As Integer 302 | Function Compare() As Integer 303 | End Interface 304 | #End Region 305 | 306 | #Region "Interface IFileDialog2" 307 | 308 | 309 | 310 | Private Interface IFileDialog2 311 | ' ----==== Interface IModalWindow ====---- 312 | Function Show(<[In]> hwndOwner As IntPtr) As Integer 313 | 314 | ' ----==== IFileDialog ====---- 315 | Function SetFileTypes(<[In]> cFileTypes As Integer, 316 | <[In], MarshalAs(UnmanagedType.LPArray)> rgFilterSpec As COMDLG_FILTERSPEC()) As Integer 317 | Function SetFileTypeIndex(<[In]> iFileType As Integer) As Integer 318 | Function GetFileTypeIndex( ByRef piFileType As Integer) As Integer 319 | Function Advise(<[In], MarshalAs(UnmanagedType.Interface)> pfde As IFileDialogEvents, 320 | ByRef pdwCookie As Integer) As Integer 321 | Function Unadvise(<[In]> dwCookie As Integer) As Integer 322 | Function SetOptions(<[In]> fos As FILEOPENDIALOGOPTIONS) As Integer 323 | Function GetOptions( ByRef pfos As FILEOPENDIALOGOPTIONS) As Integer 324 | Function SetDefaultFolder(<[In]> psi As IntPtr) As Integer 325 | Function SetFolder(<[In]> psi As IntPtr) As Integer 326 | Function GetFolder( ByRef ppsi As IShellItem) As Integer 327 | Function GetCurrentSelection( ByRef ppsi As IShellItem) As Integer 328 | Function SetFileName(<[In], MarshalAs(UnmanagedType.LPWStr)> pszName As String) As Integer 329 | Function GetFileName( ByRef pszName As String) As Integer 330 | Function SetTitle(<[In], MarshalAs(UnmanagedType.LPWStr)> pszTitle As String) As Integer 331 | Function SetOkButtonLabel(<[In], MarshalAs(UnmanagedType.LPWStr)> pszText As String) As Integer 332 | Function SetFileNameLabel(<[In], MarshalAs(UnmanagedType.LPWStr)> pszLabel As String) As Integer 333 | Function GetResult( ByRef ppsi As IShellItem) As Integer 334 | Function AddPlace(<[In]> psi As IntPtr, <[In]> fdap As FDAP) As Integer 335 | Function SetDefaultExtension(<[In], MarshalAs(UnmanagedType.LPWStr)> pszDefaultExtension As String) As Integer 336 | Function Close() As Integer 337 | Function SetClientGuid(<[In], MarshalAs(UnmanagedType.LPStruct)> guid As Guid) As Integer 338 | Function ClearClientData() As Integer 339 | 340 | 'Deprecated. SetFilter is no longer available for use as of Windows 7 341 | Function SetFilter() As Integer 342 | 343 | ' ----==== IFileDialog2 ====---- 344 | Function SetCancelButtonLabel(<[In], MarshalAs(UnmanagedType.LPWStr)> pszLabel As String) As Integer 345 | Function SetNavigationRoot(<[In]> psi As IntPtr) As Integer 346 | End Interface 347 | #End Region 348 | 349 | #Region "Interface IFileDialogEvents" 350 | 351 | 352 | 353 | Private Interface IFileDialogEvents 354 | Function OnFileOk(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object) As Integer 355 | Function OnFolderChanging(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object, 356 | <[In], MarshalAs(UnmanagedType.Interface)> psiFolder As Object) As Integer 357 | Function OnFolderChange(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object) As Integer 358 | Function OnSelectionChange(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object) As Integer 359 | Function OnShareViolation(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object, 360 | <[In], MarshalAs(UnmanagedType.Interface)> psi As Object, 361 | ByRef pResponse As Integer) As Integer 362 | Function OnTypeChange(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object) As Integer 363 | Function OnOverwrite(<[In], MarshalAs(UnmanagedType.Interface)> pfd As Object, 364 | <[In], MarshalAs(UnmanagedType.Interface)> psi As Object, 365 | ByRef pResponse As Integer) As Integer 366 | End Interface 367 | #End Region 368 | 369 | 370 | #Region "Implements IDisposable" 371 | Protected Overridable Sub Dispose(disposing As Boolean) 372 | If Not m_DisposedValue Then 373 | If disposing Then 374 | ' TODO: Verwalteten Zustand (verwaltete Objekte) bereinigen 375 | End If 376 | 377 | If m_FileOpenDialog IsNot Nothing Then 378 | 379 | If m_Cookie <> 0 Then 380 | If CType(m_FileOpenDialog, IFileDialog2).Unadvise(m_Cookie) = S_OK Then 381 | m_Cookie = 0 382 | End If 383 | End If 384 | 385 | If Marshal.ReleaseComObject(m_FileOpenDialog) = 0 Then 386 | m_FileOpenDialog = Nothing 387 | End If 388 | End If 389 | 390 | m_DisposedValue = True 391 | End If 392 | End Sub 393 | 394 | Public Sub Dispose() Implements IDisposable.Dispose 395 | Dispose(disposing:=True) 396 | GC.SuppressFinalize(Me) 397 | End Sub 398 | #End Region 399 | 400 | #Region "Implements IFileDialogEvents" 401 | Public Function OnFileOk(<[In]> pfd As Object) As Integer Implements IFileDialogEvents.OnFileOk 402 | Debug.Print("OnFileOk") 403 | Return S_OK 404 | End Function 405 | Public Function OnFolderChanging(<[In]> pfd As Object, 406 | <[In]> psiFolder As Object) As Integer Implements IFileDialogEvents.OnFolderChanging 407 | Debug.Print("OnFolderChanging") 408 | Return S_OK 409 | End Function 410 | Public Function OnFolderChange(<[In]> pfd As Object) As Integer Implements IFileDialogEvents.OnFolderChange 411 | Debug.Print("OnFolderChange") 412 | Return S_OK 413 | End Function 414 | Public Function OnSelectionChange(<[In]> pfd As Object) As Integer Implements IFileDialogEvents.OnSelectionChange 415 | Debug.Print("OnSelectionChange") 416 | Return S_OK 417 | End Function 418 | Public Function OnShareViolation(<[In]> pfd As Object, 419 | <[In]> psi As Object, 420 | ByRef pResponse As Integer) As Integer Implements IFileDialogEvents.OnShareViolation 421 | Debug.Print("OnShareViolation") 422 | Return S_OK 423 | End Function 424 | Public Function OnTypeChange(<[In]> pfd As Object) As Integer Implements IFileDialogEvents.OnTypeChange 425 | Debug.Print("OnTypeChange") 426 | Return S_OK 427 | End Function 428 | Public Function OnOverwrite(<[In]> pfd As Object, 429 | <[In]> psi As Object, 430 | ByRef pResponse As Integer) As Integer Implements IFileDialogEvents.OnOverwrite 431 | Debug.Print("OnOverwrite") 432 | Return S_OK 433 | End Function 434 | #End Region 435 | 436 | End Class 437 | --------------------------------------------------------------------------------