View Full Version : حرفه ای: Mazoo Utils for VBA - کتابخانه ابزارهای سودمند برای VBA
mazoolagh
چهارشنبه 03 خرداد 1402, 14:20 عصر
این کتابخانه شامل چند کلاس و همچنین متدهایی است که در VBA دیده نمیشود و پیاده سازی آنها با VBA خالص دشوار یا نشدنی است.
بنابراین به توسعه دهندگان اکسس اجازه میدهد امکانات جدیدی را به برنامه های خود اضافه کنند که احتمالا پیشتر به آن دسترسی نداشته اند.
کتابخانه بر پایه Microsoft .NET Framework 4.8 ساخته شده بنابراین نمیتوان از آن روی سیستم عامل های خیلی قدیمی XP یا Vista استفاده کرد.
استفاده از آن در سیستم عامل های قدیمی نظیر Windows 7 و Windows 8.1 بشرط نصب بودن این فریمورک مشکلی ندارد ولی تست نشده است.
این کتابخانه در واقع ویرایش ویژه ای از کتابخانه ای است که اولین بار روی سیستم عامل XP ساخته و به مرور آپدیت شده است.
اینک با برداشتن بخشهایی از آن، که از کمپوننت های دات نت لایسنس دار در آن استفاده شده، و همچنین برداشتن امکانات ویژه ای که برای منظورهای خاصی طراحی شده بودند، و نیز برخی ویرایش های دیگر در فروم برنامه نویس قرار داد میشود.
این کتابخانه رایگان است،
هیچ نوع قفل یا محدودیتی در استفاده ندارد،
و نیاز به اجازه یا لایسنس برای کاربردهای تجاری ندارد و میتوانید آن را در برنامه هایی که میفروشید استفاده کنید.
همچنین هر نوع مهندسی معکوس و بیرون کشیدن کدها یا منابع از آن آزاد است!
با این وجود در نظر داشته باشید که:
1- پشتیبانی ندارد (مطلقا - ولی گزارش اشکالات بررسی و احتمالا برطرف خواهد شد)
2- آپدیت های بعدی ندارد (احتمالا)
3- راهنمایی برای نوشتن کد ندارد (باید از نمونه کدهای پیوست و رفرنس متدها و پراپرتی ها ایده بگیرید)
4- برای افراد متخصص و باتجربه است!
طبق یک اصل نانوشته، نصب هر نوع نرم افزار از منبع نامشخص (بخصوص رایگان و با عناوین فریبنده) با ریسک آلودگی سیستم به باج افزار یا دزدیده اطلاعات شخصی یا استفاده از سیستم قربانی برای مقاصد مخرب و ... همراه است.
چنانچه هر نوع شک منطقی در این زمینه دارید، از دانلود و نصب این کتابخانه خودداری کنید.
اگر به اندازه کافی تخصص دارید میتوانید آن را در یک sandbox اجرا و رفتار آن را مونیتور کنید، هر نوع دسترسی آن به شبکه و دیسک ها رو ببندید و ...
و پس از اطمینان از آن استفاده کنید.
----------------
رفع مسئولیت:
1- این کتابخانه بصورت "همین که هست" ارائه شده،
هیچ نوع پشتیبانی و پاسخگویی و مستندات ندارد،
و نویسنده آن هیچ نوع تضمین و مسئولیتی در قبال درست بودن عملکرد آن ندارد.
2- استفاده کننده از این کتابخانه بطور مشخص مسئولیت همه پیامدها را بعهده میگیرد و حق هر گونه ادعایی مبنی بر صدمه سخت افزاری یا نرم افزاری یا وارد شدن هر نوع ضرر و زیان و آسیب مادی و معنوی به خود یا هر شخص دیگر، در ارتباط با این کتابخانه را از خود سلب میکند.
mazoolagh
چهارشنبه 03 خرداد 1402, 14:22 عصر
پس از دانلود، و باز کردن فایل rar در یک فولدر دلخواه (در اینجا D:\_MZV) و باز کردن پیوست، 4 فایل در اختیار دارید:
1- فایل کتابخانه : mzvc.dll
2- بچ فایل register.bat
3- بچ فایل unregister.bat
4- دیتابیس کدهای نمونه : MZVC_samples.accdb
برای نصب، روی فایل register راست کلیک و run as administrator را انتخاب کنید:
154669
پس از OK کردن پیام سیستم، برنامه regasm کتابخانه را رجیستر میکند و میتوانید موفقیت آمیز بودن آن را بررسی کنید:
154670
154671
در پایان یک فایل mzvc.tlb هم ساخته میشود که این فایل را باید به عنوان رفرنس به برنامه خود اضافه کنین (نه فایل dll):
154673
برای uninstall کتابخانه کافی است روی unregister.bat راست کلیک و run as administrator را انتخاب کنید:
154672
1- کتابخانه در دو نسخه x86 (برای آفیس 32 بیت) و x64 (برای آفیس 64 بیت) ارائه میشود.
2- میتوانید نام فایل dll و محل آن را به دلخواه تعیین کنید (قبل از رجیستر کردن)
3- اسمبلی های دات نت با برنامه regasm رجیستر میشود و این برنامه باید با دسترسی ادمین اجرا شود.
برنامه regsvr32 برای رجیستر کردن com object ها است و نباید این دو را با هم اشتباه گرفت.
mazoolagh
چهارشنبه 03 خرداد 1402, 14:24 عصر
TimeSpan (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458444&viewfull=1#post2458444)
GregorianDate (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458446&viewfull=1#post2458446)
GregorianDateTime (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458447&viewfull=1#post2458447)
PersianDateTime (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458450&viewfull=1#post2458450)
ListOfString (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458452&viewfull=1#post2458452)
mazoolagh
چهارشنبه 03 خرداد 1402, 14:25 عصر
ShowDatePicker (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458455&viewfull=1#post2458455)
ShowColorDialog (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458460&viewfull=1#post2458460)
ShowFolderBrowserDialog (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458461&viewfull=1#post2458461)
ShowFontDialog (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458462&viewfull=1#post2458462)
ShowOpenFileDialog (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458463&viewfull=1#post2458463)
ShowSaveFileDialog (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458464&viewfull=1#post2458464)
mazoolagh
چهارشنبه 03 خرداد 1402, 14:25 عصر
ShowMessageBox (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458454&viewfull=1#post2458454)
ShowSystemNotification (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458457&viewfull=1#post2458457)
ShowToastNotification (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458458&viewfull=1#post2458458)
mazoolagh
چهارشنبه 03 خرداد 1402, 14:27 عصر
GetCDROMsInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458465&viewfull=1#post2458465)
GetComputerSystemInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458466&viewfull=1#post2458466)
GetDesktopMonitorsInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458467&viewfull=1#post2458467)
GetDiskDrivesInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458468&viewfull=1#post2458468)
GetInstalledFonts (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458469&viewfull=1#post2458469)
GetInstalledSoftwaresInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458470&viewfull=1#post2458470)
GetNetworkAdaptersinfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458471&viewfull=1#post2458471)
GetOperatingSystemInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458488&viewfull=1#post2458488)
GetPhysicalMemoryInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458472&viewfull=1#post2458472)
GetPrintersInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458473&viewfull=1#post2458473)
GetProcessorsInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458474&viewfull=1#post2458474)
GetScreensInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458475&viewfull=1#post2458475)
GetVideoControllersInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458476&viewfull=1#post2458476)
======================
ShowCDROMsInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458477&viewfull=1#post2458477)
ShowComputerSystemInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458478&viewfull=1#post2458478)
ShowDesktopMonitorsInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458479&viewfull=1#post2458479)
ShowDiskDrivesInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458480&viewfull=1#post2458480)
ShowInstalledSoftwaresInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458481&viewfull=1#post2458481)
ShowNetworkAdaptersInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458482&viewfull=1#post2458482)
ShowOperatingSystemInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458489&viewfull=1#post2458489)
ShowPhysicalMemoryInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458483&viewfull=1#post2458483)
ShowPrintersInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458484&viewfull=1#post2458484)
ShowProcessorsInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458485&viewfull=1#post2458485)
ShowScreensInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458486&viewfull=1#post2458486)
ShowVideoControllersInfo (https://barnamenevis.org/showthread.php?574336-Mazoo-Utils-for-VBA-%DA%A9%D8%AA%D8%A7%D8%A8%D8%AE%D8%A7%D9%86%D9%87-%D8%A7%D8%A8%D8%B2%D8%A7%D8%B1%D9%87%D8%A7%DB%8C-%D8%B3%D9%88%D8%AF%D9%85%D9%86%D8%AF-%D8%A8%D8%B1%D8%A7%DB%8C-VBA&p=2458487&viewfull=1#post2458487)
mazoolagh
چهارشنبه 03 خرداد 1402, 14:27 عصر
کلاس TimeSpan به شما اجازه میده که با دیتا از نوع زمان کار کنید (که در اکسس نیست).
متدهای این کلاس مستقیما روی ابجکتی که از این نوع تعریف شده عمل میکنند،
یعنی فرضا متدی مثل Multiply متغیر تعریف شده را در مقدار factor ضرب میکند و نتیجه هم در همان متغیر ذخیره میشود.
Class TimeSpan
' Methods
Zero()
Duration()
Negate()
Multiply(factor As Double)
Divide(factor As Double)
FromString(str As String)
FromDays(days As Double)
FromHours(hours As Double)
FromMinutes(minutes As Double)
FromSeconds(seconds As Double)
FromMilliseconds(milliseconds As Double)
FromTimeParts(
Optional days As Integer = 0,
Optional hours As Integer = 0,
Optional minutes As Integer = 0,
Optional seconds As Integer = 0,
Optional milliseconds As Integer = 0)
FromDate(time As Date)
AddDays(days As Double)
AddHours(hours As Double)
AddMinutes(minutes As Double)
AddSeconds(seconds As Double)
AddMilliSeconds(milliseconds As Double)
AddTimeParts(
Optional days As Integer = 0,
Optional hours As Integer = 0,
Optional minutes As Integer = 0,
Optional seconds As Integer = 0,
Optional milliseconds As Integer = 0)
ToString()
ShowProperties()
' Properties
Days As Integer
Hours As Integer
Minutes As Integer
Seconds As Integer
Milliseconds As Integer
TotalDays As Double
TotalHours As Double
TotalMinutes As Double
TotalSeconds As Double
TotalMilliseconds As Double
IsZero As Boolean
کد نمونه:
Sub TimeSpan_demo()
Dim ts1 As New TimeSpan
ts1.FromString "9.8:07:06.543"
Debug.Print ts1.ToString
ts1.ShowProperties
ts1.FromDate #5/13/2023 10:28:35 PM#
ts1.FromDate Now
ts1.FromDays 3.125
ts1.FromHours 8.33
ts1.FromMinutes 483.2
ts1.FromSeconds 3636.777
ts1.FromMilliseconds 12345678
ts1.FromTimeParts days:=1, hours:=2, minutes:=3, seconds:=4, milliseconds:=567
ts1.AddDays -1.5
ts1.AddHours 3.75
ts1.AddMinutes 200.66
ts1.AddSeconds 1234.987
ts1.AddMilliseconds 12345678
ts1.AddTimeParts days:=1, hours:=2, minutes:=3, seconds:=4, milliseconds:=567
ts1.Divide (10.3)
ts1.Multiply (2.7)
ts1.Negate
ts1.duration
ts1.Zero
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:29 عصر
این کلاس در واقع مشابه TimeSpan هست ولی متدهای آن یک مقدار از نوع TimeSpan برمیگردانند (function)
Class TimeSpanUtils
' Methods
Duration(ByRef TS As TimeSpan) As TimeSpan
Negate(ByRef TS As TimeSpan) As TimeSpan
Multiply(
ByRef TS As TimeSpan,
factor As Double
) As TimeSpan
Divide(
ByRef TS As TimeSpan,
factor As Double
) As TimeSpan
Add(
ByRef TS1 As TimeSpan,
ByRef TS2 As TimeSpan
) As TimeSpan
Subtract(
ByRef TS1 As TimeSpan,
ByRef TS2 As TimeSpan
) As TimeSpan
AddDays(
ByRef TS As TimeSpan,
days As Double
) As TimeSpan
AddHours(
ByRef TS As TimeSpan,
hours As Double
) As TimeSpan
AddMinutes(
ByRef TS As TimeSpan,
minutes As Double
) As TimeSpan
AddSeconds(
ByRef TS As TimeSpan,
seconds As Double
) As TimeSpan
AddMilliseconds(
ByRef TS As TimeSpan,
milliseconds As Double
) As TimeSpan
' Properties
MinValue As TimeSpan
MaxValue As TimeSpan
کد نمونه:
Sub TimeSpanUtils_demo()
Dim tu As TimeSpanUtils
Set tu = New TimeSpanUtils
Debug.Print tu.MaxValue.ToString
Debug.Print tu.MinValue.ToString
Dim ts1 As New TimeSpan
Dim ts2 As New TimeSpan
Dim ts3 As New TimeSpan
ts1.FromString "9.8:07:06.543"
Set ts2 = tu.Negate(ts1)
Set ts2 = tu.duration(ts1)
Set ts2 = tu.Multiply(ts1, 10)
Set ts2 = tu.Divide(ts1, 10)
Set ts2 = tu.AddDays(ts1, 1)
Set ts2 = tu.AddHours(ts1, 1)
Set ts2 = tu.AddMinutes(ts1, 1)
Set ts2 = tu.AddSeconds(ts1, 1)
Set ts2 = tu.AddMilliseconds(ts1, 1)
Set ts3 = tu.Add(ts1, ts2)
Set ts3 = tu.Subtract(ts1, ts2)
ts3.ShowProperties
Debug.Print ts3.ToString
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:30 عصر
این کلاس فقط بخش تاریخ (روز،ماه،سال بدون ساعت) تاریخ میلادی را نمایش میدهد.
بتنهایی چندان کاربردی ندارد و در کلاس PersianDateTime بیانگر بخش معادل تاریخ به میلادی است.
Class GregorianDate
' Methods
SetNothing()
SetDate(gdate As Date)
FromToday()
SetMinimumSupportedDate()
SetMaximumSupportedDate()
ShowProperties()
ToString()
' Properties
IsNothing As Boolean
DateTime As Date
Year As Integer
Month As Integer
Day As Integer
IsLeapYear As Boolean
DaysInMonth As Integer
DayOfYear As Integer
DayOfWeek As Integer
WeekOfYearByFirstDay As Integer
WeekOfYearByFirstFourDayWeek As Integer
WeekOfYearByFirstFullWeek As Integer
MonthName As String
MonthNameAbbreviated As String
MonthNameTransliterated As String
WeekDayName As String
WeekDayNameAbbreviated As String
WeekDayNameShortest As String
LongDate As String
ShortDate As String
MonthDay As String
YearMonth As String
RFC1123 As String
SortableDateTime As String
کد نمونه:
Sub GregorianDate_demo()
Dim gd As New GregorianDate
gd.FromToday
Debug.Print gd.ToString
gd.ShowProperties
gd.SetNothing
gd.SetDate #3/19/2022 5:08:39 PM#
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:30 عصر
کلاس تاریخ میلادی با متدها و پراپرتی های کاملتر از تاریخ میلادی اکسس
Class GregorianDateTime
' Methods
SetNothing()
SetDate(gd As Date)
SetMinimumSupportedDate()
SetMaximumSupportedDate()
FromToday()
FromNow()
FromDateParts(
year As Integer,
month As Integer,
day As Integer,
Optional hour As Integer = 0,
Optional minute As Integer = 0,
Optional second As Integer = 0,
Optional millisecond As Integer = 0)
AddYears(years As Integer)
AddMonths(months As Integer)
AddWeeks(weeks As Integer)
AddDays(days As Double)
AddHours(hours As Double)
AddMinutes(minutes As Double)
AddSeconds(seconds As Double)
AddMilliseconds(milliseconds As Double)
AddTimespan(timespan As TimeSpan)
AddDateParts(
years As Integer,
months As Integer,
days As Double,
Optional hours As Double = 0,
Optional minutes As Double = 0,
Optional seconds As Double = 0,
Optional milliseconds As Double = 0)
ToString()
ShowProperties()
' Properties
IsNothing As Boolean
DateTime As Date
Year As Integer
Month As Integer
Day As Integer
Hour As Integer
Minute As Integer
Second As Integer
Millisecond As Integer
IsLeapYear As Boolean
DaysInMonth As Integer
DaysInYear As Integer
DayOfYear As Integer
DayOfWeek As Integer
WeekOfYearByFirstDay As Integer
WeekOfYearByFirstFourDayWeek As Integer
WeekOfYearByFirstFullWeek As Integer
MonthName As String
MonthNameAbbreviated As String
MonthNameTransliterated As String
WeekDayName As String
WeekDayNameAbbreviated As String
WeekDayNameShortest As String
FullDateTime As String
LongDate As String
ShortDate As String
LongTime As String
ShortTime As String
MonthDay As String
YearMonth As String
RFC1123 As String
SortableDateTime As String
کد نمونه:
Sub GregorianDateTime_demo()
Dim gd As New GregorianDateTime
gd.FromToday
gd.FromNow
gd.FromDateParts Year:=2023, Month:=8, Day:=15, Minute:=12, Second:=37, millisecond:=719
Debug.Print gd.ToString
gd.ShowProperties
gd.SetDate #3/19/2022 5:08:39 PM#
gd.SetDate "July 11, 1953 12:30:00"
gd.AddYears -10
gd.AddMonths 200
gd.AddWeeks 4
gd.AddDays 3.5
gd.AddHours -8.2
gd.AddMinutes 3.1
gd.AddSeconds 2000
gd.AddMilliseconds 177
Dim ts1 As New TimeSpan
ts1.FromString "1.2:3:4.567"
gd.FromDateParts 1, 1, 1
gd.AddTimeSpan ts1
gd.FromDateParts 1, 1, 1
gd.AddDateParts years:=1, months:=1, days:=3, hours:=2.5, minutes:=3.3, seconds:=4.5, milliseconds:=710
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:31 عصر
کلاس تقویم میلادی
Class GregorianCalendar
' Methods
AddYears(
ByRef time As GregorianDateTime,
years As Integer
) As GregorianDateTime
AddMonths(
ByRef time As GregorianDateTime,
months As Integer
) As GregorianDateTime
AddWeeks(
ByRef time As GregorianDateTime,
weeks As Integer
) As GregorianDateTime
AddDays(
ByRef time As GregorianDateTime,
days As Double
) As GregorianDateTime
AddHours(
ByRef time As GregorianDateTime,
hours As Double
) As GregorianDateTime
AddMinutes(
ByRef time As GregorianDateTime,
minutes As Double
) As GregorianDateTime
AddSeconds(
ByRef time As GregorianDateTime,
seconds As Double
) As GregorianDateTime
AddMillieconds(
ByRef time As GregorianDateTime,
milliseconds As Double
) As GregorianDateTime
AddTimeSpan(
ByRef time As GregorianDateTime,
ByRef timespan As TimeSpan
) As GregorianDateTime
AddDateParts(
ByRef time As GregorianDateTime,
years As Integer,
months As Integer,
days As Double,
Optional hours As Double = 0,
Optional minutes As Double = 0,
Optional seconds As Double = 0,
Optional milliseconds As Double = 0
) As GregorianDateTime
Subtract(
ByRef time1 As GregorianDateTime,
ByRef time2 As GregorianDateTime
) As TimeSpan
IsLeapYear(year As Integer) As Boolean
' Properties
MinSupportedDateTime As Date
MaxSupportedDateTime As Date
کد نمونه:
Sub GregorianCalendar_demo()
Dim gc As New GregorianCalendar
Dim gd1 As New GregorianDateTime
Dim gd2 As New GregorianDateTime
Dim gd3 As New GregorianDateTime
gd1.SetDate "July 11, 1953 12:30:00"
Set gd2 = gc.AddYears(gd1, -10)
Set gd2 = gc.AddMonths(gd1, 200)
Set gd2 = gc.AddWeeks(gd1, 4)
Set gd2 = gc.AddDays(gd1, 3.5)
Set gd2 = gc.AddHours(gd1, -8.2)
Set gd2 = gc.AddMinutes(gd1, 3.1)
Set gd2 = gc.AddSeconds(gd1, 2000)
Set gd2 = gc.AddMillieconds(gd1, 177)
Set gd2 = gc.AddDateParts(gd1, years:=1, months:=2, days:=3.5, hours:=4.2, minutes:=-3.3, seconds:=1000, milliseconds:=234)
Dim ts1 As New TimeSpan
ts1.FromString "1.2:3:4.567"
ts1.ShowProperties
Set gd3 = gc.AddTimeSpan(gd1, ts1)
Set ts1 = gc.Subtract(gd3, gd1)
Dim b As Boolean
b = gc.IsLeapYear(2024)
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:32 عصر
کلاس تاریخ خورشیدی از 0001/01/01 00:00:00 تا 9378/10/13 23:59:59
بخش زمان در پراپرتی TimeOfDay از نوع TimeSpan
و معادل میلادی در پراپرتی Gregorian از نوع GregorianDate
علاوه بر متدهای متنوع عملیات روی بخشهای مختلف تاریخ و زمان،
پراپرتی های کامل نمایش و هجی تاریخ
و همچنین نام ماه در تقویم قدیمی (قاجار و قبل آن)
و ترکی و کردی نیز دیده شده است.
Class PersianDateTime
' Methods
SetNothing()
SetToMinimumSupportedDate()
SetToMaximumSupportedDate()
FromGregorianDate(gd As Date)
FromToday()
FromNow()
FromDateParts(
year As Integer,
month As Integer,
day As Integer,
Optional hour As Integer = 0,
Optional minute As Integer = 0,
Optional second As Integer = 0,
Optional millisecond As Integer = 0)
FromString(datestring As String)
AddYears(years As Integer)
AddMonths(months As Integer)
AddWeeks(weeks As Integer)
AddDays(days As Integer)
AddHours(hours As Integer)
AddMinutes(minutes As Integer)
AddSeconds(seconds As Integer)
AddMilliseconds(milliseconds As Double)
AddTimespan(timespan As MZV.TimeSpan)
AddDateParts(
years As Integer,
months As Integer,
days As Integer,
Optional hours As Integer = 0,
Optional minutes As Integer = 0,
Optional seconds As Integer = 0,
Optional milliseconds As Double = 0)
ToString()
ShowProperties()
' Properties
IsNothing As Boolean
Gregorian As GregorianDate
TimeOfDay As TimeSpan
Year As Integer
Month As Integer
Day As Integer
DayOfYear As Integer
DayOfWeek As Integer
WeekOfYearByFirstDay As Integer
WeekOfYearByFirstFourDayWeek As Integer
WeekOfYearByFirstFullWeek As Integer
IsLeapYear As Boolean
DaysInMonth As Integer
DaysInYear As Integer
MonthName As String
MonthNameOld As String
MonthNameAzeri As String
MonthNameKurdi As String
MonthNameAbbreviated As String
WeekDayName As String
WeekDayNameAbbreviated As String
WeekDayNameShort As String
ShortTime12 As String
ShortTime24 As String
LongTime12 As String
LongTime24 As String
ShortDate As String
ShortDateTime12 As String
ShortDateTime24 As String
LongDateTime12 As String
LongDateTime24 As String
SpellShortTime12 As String
SpellShortTime24 As String
SpellLongTime12 As String
SpellLongTime24 As String
SpellDate As String
SpellWeekdayDate As String
SpellMonthYear As String
SpellDayMonth As String
SpellWeekdayDayMonth As String
SortableDateTime As String
RFC1123 As String
کد نمونه:
Sub PersianDateTime_demo()
Dim pd As New PersianDateTime
pd.FromToday
pd.FromNow
pd.FromString "1412/08/15 13:8:32"
pd.ShowProperties
pd.FromGregorianDate "3/19/2022 5:08:39 AM"
pd.FromDateParts Year:=1331, Month:=4, Day:=20, Hour:=12, Minute:=30, Second:=30, millisecond:=123
pd.AddYears -10
pd.AddMonths 200
pd.AddWeeks 4
pd.AddDays 3
pd.AddHours -8
pd.AddMinutes 3
pd.AddSeconds 2000
pd.AddMilliseconds 177
Dim ts1 As New TimeSpan
ts1.FromString "1.2:3:4.567"
pd.FromDateParts 1, 1, 1
pd.AddTimeSpan ts1
pd.FromDateParts 1, 1, 1
pd.AddDateParts years:=1, months:=2, days:=3, hours:=4, minutes:=5, seconds:=6, milliseconds:=789
pd.SetToMinimumSupportedDate
Debug.Print pd.ToString
pd.SetToMaximumSupportedDate
Debug.Print pd.ToString
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:33 عصر
کلاس تقویم خورشیدی
متدهای این کلاس یک مقدار از نوع PersianDateTime یا TimeSpan برمیگردانند.
Class PersianCalendar
' Methods
AddYears(
ByRef time As PersianDateTime,
years As Integer
) As PersianDateTime
AddMonths(
ByRef time As PersianDateTime,
months As Integer
) As PersianDateTime
AddWeeks(
ByRef time As PersianDateTime,
weeks As Integer
) As PersianDateTime
AddDays(
ByRef time As PersianDateTime,
days As Integer
) As PersianDateTime
AddHours(
ByRef time As PersianDateTime,
hours As Integer
) As PersianDateTime
AddMinutes(
ByRef time As PersianDateTime,
minutes As Integer
) As PersianDateTime
AddSeconds(
ByRef time As PersianDateTime,
seconds As Integer
) As PersianDateTime
AddMillieconds(
ByRef time As PersianDateTime,
milliseconds As Double
) As PersianDateTime
AddDateParts(
ByRef time As PersianDateTime,
years As Integer,
months As Integer,
days As Integer,
Optional hours As Integer = 0,
Optional minutes As Integer = 0,
Optional seconds As Integer = 0,
Optional milliseconds As Double = 0
) As PersianDateTime
Subtract(
ByRef time1 As PersianDateTime,
ByRef time2 As PersianDateTime
) As TimeSpan
IsLeapYear(year As Integer) As Boolean
' Properties
MinSupportedDateTime As Date
MaxSupportedDateTime As Date
کد نمونه:
Sub PersianCalendar_demo()
Dim pc As New PersianCalendar
Dim pd1 As New PersianDateTime
Dim pd2 As New PersianDateTime
Dim pd3 As New PersianDateTime
pd1.FromGregorianDate "July 11, 1953 12:30:00"
Set pd2 = pc.AddYears(pd1, -10)
Set pd2 = pc.AddMonths(pd1, 200)
Set pd2 = pc.AddWeeks(pd1, 4)
Set pd2 = pc.AddDays(pd1, 3)
Set pd2 = pc.AddHours(pd1, -8)
Set pd2 = pc.AddMinutes(pd1, 3)
Set pd2 = pc.AddSeconds(pd1, 2000)
Set pd2 = pc.AddMillieconds(pd1, 177)
Set pd2 = pc.AddDateParts(pd1, years:=1, months:=2, days:=3, hours:=4, minutes:=5, seconds:=6, milliseconds:=789)
pd2.ShowProperties
Dim ts1 As New TimeSpan
Set ts1 = pc.Subtract(pd2, pd1)
Debug.Print pc.IsLeapYear(1403)
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:34 عصر
این کلاس مشابه یک array of string در VBA است.
با این تفاوت که کار با آن بسیار راحتتر و امکانات گسترده ای برای:
حذف/افزودن تکی یا دسته ای، جستجو، سورت، انتخاب زیرمجموعه و ... در آن دیده شده است.
Class ListOfString
' Methods
ShowProperties()
ToLower()
ToUpper()
Clear()
Add(item As String)
AddRange(ByRef items As String())
InsertAt(
item As String,
index As Integer)
InsertRangeAt(
ByRef items As String(),
index As Integer)
RemoveAt(index As Integer)
RemoveRange(
index As Integer,
count As Integer)
RemoveFirst(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False)
RemoveLast(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False)
RemoveAll(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False)
Reverse()
SortAscending()
SortDescending()
FromArray(ByRef items As String())
Distinct()
FindAll(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False)
CopyToArray(
ByRef array As String(),
Optional array_index As Integer = 0,
Optional list_index As Integer = 0,
Optional count As Integer = -1)
GetRange(
start_index As Integer,
count As Integer)
ToArray(
Optional list_index As Integer = 0,
Optional count As Integer = -1
) As String()
Contains(value As String) As Boolean
FindFirst(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As String
FindLast(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As String
FirstIndex(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As Integer
LastIndex(
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As Integer
ToString()
' Properties
List As String()
Count As Integer
IsEmpty As Boolean
Errors As String
Enum SearchType
StartsWith = 1
EndsWith = 2
AnyWhere = 3
Whole = 4
End Enum
کد نمونه:
Sub Example_1()
Dim los As New ListOfString
los.FromArray Cities1
Debug.Print los.ToString
Debug.Print los.Count
los.AddRange Cities2
Debug.Print los.ToString
Debug.Print los.Count
los.Reverse
Debug.Print los.ToString
los.SortAscending
Debug.Print los.ToString
los.SortDescending
Debug.Print los.ToString
los.Clear
Debug.Print los.IsEmpty
End Sub
Sub Example_2()
Dim los As New ListOfString
los.FromArray Cities1
los.Add "کرمان"
los.Add "تهران"
Debug.Print los.ToString
los.InsertAt "رشت", 4
Debug.Print los.ToString
los.AddRange Cities2
Debug.Print los.ToString
los.RemoveFirst "مشهد"
Debug.Print los.ToString
los.RemoveAt 8
Debug.Print los.ToString
los.RemoveAll Value:="کرمان", search_type:=SearchType_Whole
Debug.Print los.ToString
los.FromArray Cities1
los.GetRange start_index:=2, Count:=5
Debug.Print los.ToString
los.FromArray Cities1
los.AddRange Cities2
los.AddRange Cities1
los.RemoveAll Value:="کرمان", search_type:=SearchType_StartsWith
Debug.Print los.ToString
los.FromArray Cities1
los.AddRange Cities2
los.AddRange Cities1
los.RemoveAll Value:="ان", search_type:=SearchType_EndsWith
Debug.Print los.ToString
los.FromArray Cities1
los.AddRange Cities2
los.AddRange Cities1
los.RemoveAll Value:="ان", search_type:=SearchType_AnyWhere
Debug.Print los.ToString
End Sub
Sub Example_3()
Dim los As New ListOfString
los.FromArray Cities1
los.AddRange Cities2
los.Add "رامسر"
los.AddRange Cities1
Debug.Print los.ToString
los.Distinct
Debug.Print los.ToString
End Sub
Sub Example_4()
Dim los As New ListOfString
los.FromArray Cities1
los.AddRange Cities2
los.Add "رامسر"
los.AddRange Cities1
los.Add "کرمان"
Debug.Print los.ToString
Debug.Print los.Contains("تهران")
Debug.Print los.Contains("مشهد")
Debug.Print los.FindFirst("شهر", SearchType_AnyWhere)
Debug.Print los.FindFirst("شهر", SearchType_EndsWith)
Debug.Print los.FindLast("شهر", SearchType_StartsWith)
Debug.Print los.FindLast("شهر", SearchType_EndsWith)
los.FindAll Value:="شهر", search_type:=SearchType_StartsWith
Debug.Print los.ToString
los.FromArray Cities1
los.AddRange Cities2
los.Add "رامسر"
los.AddRange Cities1
los.Add "کرمان"
los.FindAll Value:="ان", search_type:=SearchType_EndsWith
Debug.Print los.ToString
los.FromArray Cities1
los.AddRange Cities2
los.Add "خرمشهر"
los.FindAll Value:="شهر", search_type:=SearchType_AnyWhere
Debug.Print los.ToString
End Sub
Sub Example_5()
Dim los As New ListOfString
los.FromArray Cities1
Debug.Print "Cities1=" & Join(Cities1, ",")
Dim a
a = los.ToArray
Debug.Print "a=" & Join(a, ",")
Dim b
b = los.ToArray(list_index:=3, Count:=4)
Debug.Print "b=" & Join(b, ",")
Dim c
c = los.ToArray(list_index:=8)
Debug.Print "c=" & Join(c, ",")
End Sub
Public Function Cities1() As String()
Dim x(15) As String
x(0) = "آبادان"
x(1) = "شیراز"
x(2) = "زاهدان"
x(3) = "تبریز"
x(4) = "هشتگرد"
x(5) = "مشهد"
x(6) = "کرمانشاه"
x(7) = "یاسوج"
x(8) = "یزد"
x(9) = "ورامین"
x(10) = "دهلران"
x(11) = "بهبهان"
x(12) = "اندیمشک"
x(13) = "شهرکرد"
x(14) = "شهریار"
x(15) = "خرمشهر"
Cities1 = x
End Function
Public Function Cities2() As String()
Dim x(9) As String
x(0) = "بندر ترکمن"
x(1) = "مشهد"
x(2) = "اصفهان"
x(3) = "تبریز"
x(4) = "یزد"
x(5) = "اصفهان"
x(6) = "پیرانشهر"
x(7) = "شهرکرد"
x(8) = "بهبهان"
x(9) = "ماهشهر"
Cities2 = x
End Function
mazoolagh
چهارشنبه 03 خرداد 1402, 14:34 عصر
متدهای این کلاس یک مقدار از نوع ListOfString برمیگردانند.
Class ListOfStringUtils
' Methods
Add(
list As ListOfString,
item As String
) As ListOfString
AddRange(
list As ListOfString,
ByRef items As String()
) As ListOfString
InsertAt(
list As ListOfString,
item As String, index As Integer
) As ListOfString
InsertRangeAt(
list As ListOfString,
ByRef items As String(),
index As Integer
) As ListOfString
RemoveAt(
list As ListOfString,
index As Integer
) As ListOfString
RemoveRange(
list As ListOfString,
index As Integer,
count As Integer
) As ListOfString
RemoveFirst(
list As ListOfString,
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As ListOfString
RemoveLast(
list As ListOfString,
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As ListOfString
RemoveAll(
list As ListOfString, value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As ListOfString
Concat(
list1 As ListOfString,
list2 As ListOfString
) As ListOfString
Except(
list1 As ListOfString,
list2 As ListOfString
) As ListOfString
Union(
list1 As ListOfString,
list2 As ListOfString
) As ListOfString
Intersect(
list1 As ListOfString,
list2 As ListOfString
) As ListOfString
ToLower(
list As ListOfString
) As ListOfString
ToUpper(
list As ListOfString
) As ListOfString
Reverse(
list As ListOfString
) As ListOfString
SortAscending(
list As ListOfString
) As ListOfString
SortDescending(
list As ListOfString
) As ListOfString
Distinct(
list As ListOfString
) As ListOfString
FindAll(
list As ListOfString,
value As String,
Optional search_type As SearchType = SearchType.AnyWhere,
Optional case_sensitive As Boolean = False
) As ListOfString
GetRange(
list As ListOfString,
start_index As Integer,
count As Integer
) As ListOfString
کد نمونه:
Private lu As New ListOfStringUtils
Private list1 As New ListOfString
Private list2 As New ListOfString
Private list3 As New ListOfString
Sub Example_1()
list1.FromArray Cities1
Debug.Print list1.ToString
Set list2 = lu.Add(list1, "چهاربهار")
Debug.Print list2.ToString
Set list2 = lu.AddRange(list1, Cities2)
Debug.Print list2.ToString
Set list2 = lu.InsertAt(list1, "ساری", 3)
Debug.Print list2.ToString
Set list2 = lu.InsertRangeAt(list1, Cities2, 6)
Debug.Print list2.ToString
Set list2 = lu.RemoveAt(list1, 4)
Debug.Print list2.ToString
Set list2 = lu.GetRange(list1, 3, 5)
Debug.Print list2.ToString
list1.AddRange Cities2
Set list2 = lu.RemoveFirst(Value:="شهر", List:=list1, search_type:=SearchType_StartsWith)
Debug.Print list2.ToString
Set list2 = lu.RemoveLast(Value:="مشهد", List:=list1, search_type:=SearchType_Whole)
Debug.Print list2.ToString
Set list2 = lu.RemoveAll(Value:="شهر", List:=list1, search_type:=SearchType_EndsWith)
Debug.Print list2.ToString
list2.ShowProperties
End Sub
Sub Example_2()
list1.FromArray Cities1
Set list2 = lu.Reverse(list1)
Debug.Print list2.ToString
Set list2 = lu.SortAscending(list1)
Debug.Print list2.ToString
Set list2 = lu.SortDescending(list1)
Debug.Print list2.ToString
Set list2 = lu.Distinct(list1)
Debug.Print list2.ToString
End Sub
Sub Example_3()
list1.FromArray Cities1
list1.AddRange Cities2
Set list2 = lu.FindAll(list1, "شهر", SearchType_AnyWhere)
Debug.Print list2.ToString
Set list2 = lu.FindAll(list1, "شهر", SearchType_StartsWith)
Debug.Print list2.ToString
Set list2 = lu.FindAll(list1, "شهر", SearchType_EndsWith)
Debug.Print list2.ToString
Set list2 = lu.FindAll(list1, "کرمان", SearchType_Whole)
Debug.Print list2.IsEmpty
End Sub
Sub Example_4()
list1.FromArray Cities1
list2.FromArray Cities2
Set list3 = lu.Concat(list1, list2)
Debug.Print list3.ToString
Set list3 = lu.Union(list1, list2)
Debug.Print list3.ToString
Set list3 = lu.Except(list1, list2)
Debug.Print list3.ToString
Set list3 = lu.Intersect(list1, list2)
Debug.Print list3.ToString
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:36 عصر
متد ShowMessageBox از VBAUtil برای نمایش MessageBox با امکاناتی مانند:
کلیدهای با متن فارسی
کلیدهای با متن سفارشی
کلیدهای با تصویر
انتخاب فونت و اندازه متن
تعیین راست به چپ بودن متن
تعیین نمایش آیکون و سدا
امکان تعریف تایمر برای یک کلید خاص
امکان نمایش یک چک باکس برای تعیین وضعیت نمایش پیام در دفعات بعد
Function ShowMessageBox(
Message As String,
Title As String,
Optional MessageBox_Style As MsgboxStyle = MsgboxStyle.Information,
Optional MessageBox_Type As MsgboxType = MsgboxType.OkOnly,
Optional Has_Image As Boolean = True,
Optional Has_Sound As Boolean = True,
Optional Right_To_Left As Boolean = True,
Optional Persian_Numbers As Boolean = True,
Optional Persian_Buttons As Boolean = True,
Optional Font_Name As Font_Name = Font_Name.Segoe_UI,
Optional Font_Size As Font_Size = Font_Size.Normal,
Optional Font_Bold As Boolean = False,
Optional Button_1_Text As String = "",
Optional Button_2_Text As String = "",
Optional Button_3_Text As String = "",
Optional TimeInterval As Integer = 0,
Optional TimedButton As Integer = 1,
Optional Show_SuppressNextTime As Boolean = False
) As MessageBoxResult
Class MessageBoxResult
' Properties
Result As Integer
VBA_ButtonName As String
DoNotShowAgain As Boolean
Enum MsgboxStyle As Integer
None = 0
Information = 1
Exclamation = 2
Critical = 3
Warning = 4
End Enum
Enum MsgboxType As Integer
OkOnly = 0
OkCancel = 1
YesNo = 2
RetryCancel = 3
AbortRetryIgnore = 4
YesNoCancel = 5
Custom_1_Button = 10
Custom_2_Buttons = 11
Custom_3_Buttons = 12
End Enum
Enum Font_Name As Integer
Segoe_UI = 2
Tahoma = 3
Arial = 4
Microsoft_Sans_Serif = 5
Times_New_Roman = 6
Courier_New = 7
Calibri = 8
End Enum
Enum Font_Size As Integer
Small = 1
Normal = 2
Medium = 3
Large = 4
End Enum
کد نمونه:
Option Compare Database
Option Explicit
Sub Example_1()
Dim title, message As String
title = "خطا در ارتباط با شبکه"
message = "ارتباط با سرور به آدرس 192.168.1.224 برقرار نشد." & vbCrLf & _
"برای ثبت تغییرات ارتباط با سرور الزامی است." & vbCrLf & vbCrLf & _
"دوباره سعی میکنید؟"
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox( _
message:=message, _
title:=title, _
messagebox_style:=MsgboxStyle_Warning, _
messagebox_type:=MsgboxType_RetryCancel, _
has_image:=True, _
Has_Sound:=True, _
right_to_left:=True, _
Persian_Numbers:=False, _
Persian_Buttons:=True, _
Font_Name:=Font_Name_Times_New_Roman, _
Font_Size:=Font_Size_Large, _
Font_Bold:=False, _
TimeInterval:=60, _
TimedButton:=1, _
Show_SuppressNextTime:=True)
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
154675
Sub Example_2()
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox(title:="", message:="ثبت سند با موفقیت انجام شد.")
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
154676
Sub Example_3()
Dim title, message As String
title = "غزلیات حافظ - غزل شماره26"
message = _
"زلـف‌آشفته و خوی‌کـرده و خندان‌لب و مست" & vbCrLf & _
"پیرهن‌چـاک و غزل‌خـوان و صُراحی در دسـت" & vbCrLf & _
"نرگـسـش عربـده‌جوی و لبـش افـسوس‌کـنان" & vbCrLf & _
"نیم شب دوش بـه بـالین مـن آمـد بنشست" & vbCrLf & _
"سر فـرا گـوش مـن آورد بـه آواز حزیـن" & vbCrLf & _
"گفت ای عاشــق دیرینه مـن خوابت هـست؟" & vbCrLf & _
"عاشقی را کـه چنین بـاده شبگیـر دهـند" & vbCrLf & _
"کافـر عــشق بـود گـر نشود بـاده پرست" & vbCrLf & _
"برو ای زاهــد و بر دُردکشان خرده مگیر" & vbCrLf & _
"که ندادند جز این تحفه به ما روز الست" & vbCrLf & _
"آن چه او ریخت به پیمانـه ما نـوشیدیم" & vbCrLf & _
"اگـر از خَـمر بـهشت است وگر باده مـست" & vbCrLf & _
"خـنده جـامِ مـی و زلـفِ گـره‌گـیر نگـار" & vbCrLf & _
"ای بسا توبه که چـون توبه حـافـظ بشکست"
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox( _
title:=title, _
message:=message, _
Persian_Buttons:=True, _
Has_Sound:=False, _
has_image:=False, _
Font_Name:=Font_Name_Courier_New, _
Font_Bold:=True, _
Font_Size:=Font_Size_Large, _
messagebox_type:=MsgboxType_Custom_1_Button, _
messagebox_style:=MsgboxStyle_None, _
button_1_text:="خواندم!" _
)
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
154677
Sub Example_5()
Dim title, message As String
title = "انتخاب خروجی"
message = "گزارش سالانه آماده شد."
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox( _
title:=title, _
message:=message, _
messagebox_style:=MsgboxStyle_Exclamation, _
messagebox_type:=MsgboxType_Custom_3_Buttons, _
has_image:=False, _
button_1_text:="چاپ", _
button_2_text:="فایل pdf", _
button_3_text:="ارسال به email")
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
154678
mazoolagh
چهارشنبه 03 خرداد 1402, 14:37 عصر
متد ShowDatePicker از VBAUtil یک PersianDatePicker است که تاریخ (و زمان) انتخاب شده را به صورت PersianDateTime برمیگرداند.
امکانات :
تعیین تاریخ (و زمان) اولیه
تعیین محدوده های مجاز تاریخ (و زمان)
تعیین نحوه انتخاب زمان
تعیین روزهای مجاز هفته
تعیین شکل نمایش اعداد (فارسی/لاتین)
تعیین محل باز شدن در موقعیت انتخاب شده از یک فرم معین (با ارسال form handle)
Function ShowDatePicker(
Optional InitialDate As PersianDateTime = Nothing,
Optional MinDate As PersianDateTime = Nothing,
Optional MaxDate As PersianDateTime = Nothing,
Optional MinTimeOfDay As Date = Nothing,
Optional MaxTimeOfDay As Date = Nothing,
Optional TimeSelectMode As TimeSelectMode = TimeSelectMode.None,
Optional AllowShanbeh As Boolean = True,
Optional Allow1Shanbeh As Boolean = True,
Optional Allow2Shanbeh As Boolean = True,
Optional Allow3Shanbeh As Boolean = True,
Optional Allow4Shanbeh As Boolean = True,
Optional Allow5Shanbeh As Boolean = True,
Optional AllowAdineh As Boolean = True,
Optional PersianNumbers As Boolean = True,
Optional ShowOutrangeDays As Boolean = False,
Optional fwhnd As Integer = -1,
Optional LocationTop As Integer = -1,
Optional LocationRight As Integer = -1
) As PersianDateTime
Enum TimeSelectMode As Integer
None = 0
Hours = 1
HoursMinutes = 2
HoursMinutesSeconds = 3
End Enum
کد نمونه:
Sub Example_1()
Dim pd As PersianDateTime
Set pd = v.ShowDatePicker
If pd Is Nothing Then
Debug.Print "No Date Selected!"
Else
Debug.Print "Selected Date=" & pd.ToString
'pd.ShowProperties
End If
End Sub
154686
Sub Example_2()
Dim pd As PersianDateTime
Dim init_date As New PersianDateTime
Dim min_date As New PersianDateTime
Dim max_date As New PersianDateTime
init_date.FromDateParts 1403, 4, 20
min_date.FromDateParts 1403, 1, 10
max_date.FromDateParts 1456, 12, 22
Dim mint, maxt As Date
mint = #8:10:33 AM#
maxt = #5:00:01 PM#
Set pd = v.ShowDatePicker( _
InitialDate:=init_date, _
MinDate:=min_date, _
MaxDate:=max_date, _
MinTimeOfDay:=mint, _
MaxTimeOfDay:=maxt, _
TimeSelectMode:=TimeSelectMode_HoursMinutesSeconds , _
PersianNumbers:=True, _
Allow3Shanbeh:=False, _
AllowAdineh:=False, _
showoutrangedays:=True)
If pd Is Nothing Then
Debug.Print "No Date Selected!"
Else
Debug.Print "Selected Date=" & pd.ToString
'pd.ShowProperties
End If
End Sub
154688
Private selected_date As New PersianDateTime
Private init_date As New PersianDateTime
Private Sub b1_Click() ' show datepicker
If PDate = "" Then
init_date.SetNothing
Else
init_date.FromString PDate
End If
Dim handle As LongPtr
handle = Me.Form.Hwnd ' form handle
Dim min_date As New PersianDateTime ' minimum allowed date
Dim max_date As New PersianDateTime ' maximum allowed date
min_date.FromDateParts 1390, 10, 10
max_date.FromDateParts 1418, 2, 22
Dim min_time, max_time As Date
min_time = #8:10:33 AM# ' minimum allowed time
max_time = #5:00:01 PM# ' maximum allowed time
Dim top As Long
top = Me.b1.top + Me.b1.Height ' top location of datepicker
Dim right As Long
right = Me.b1.left + Me.b1.Width ' right location of datepicker
Dim v As New VBAutils
Set selected_date = v.ShowDatePicker( _
InitialDate:=init_date, _
TimeSelectMode:=TimeSelectMode_HoursMinutesSeconds , _
PersianNumbers:=False, _
AllowAdineh:=False, _
MinDate:=min_date, _
MaxDate:=max_date, _
MinTimeOfDay:=min_time, _
MaxTimeOfDay:=max_time, _
fwhnd:=handle, _
locationtop:=top, _
locationright:=right)
If Not selected_date.IsNothing Then
Me.PDate = selected_date.ToString
End If
End Sub
Private Sub b2_Click() ' show properties grid
If PDate = "" Then
selected_date.SetNothing
Else
selected_date.FromString PDate
End If
selected_date.ShowProperties
End Sub
Private Sub b3_Click() ' clear persian_date field
selected_date.SetNothing
PDate = ""
End Sub
Private Sub Form_Load()
selected_date.SetNothing
init_date.FromString "1416/03/28 10:5:48"
PDate = init_date.ToString
End Sub
154685
mazoolagh
چهارشنبه 03 خرداد 1402, 14:37 عصر
ShowSystemNotification(
tipTitle As String,
tipText As String,
tipIcon As ToolTipIcon,
Optional duration As Integer = 10000)
Enum ToolTipIcon As Integer
None = Windows.Forms.ToolTipIcon.None
Info = Windows.Forms.ToolTipIcon.Info
Warning = Windows.Forms.ToolTipIcon.Warning
Error_ = Windows.Forms.ToolTipIcon.Error
End Enum
کد نمونه:
Sub Example_1()
v.ShowSystemNotification "کاربر {Admin}", "خوش آمديد!", ToolTipIcon_Info
End Sub
154690
mazoolagh
چهارشنبه 03 خرداد 1402, 14:38 عصر
این متد یک ToastNotification را روی اسکرین نمایش میدهد.
امکانات:
تعیین عنوان و متن
انتخاب رنگ زمینه و پس‌زمینه برای عنوان و متن
انتخاب فونت و سایز برای عنوان و متن
انتخاب استایل فونت برای عنوان و متن
انتخاب نمایش ارقام فارسی یا لاتین در عنوان و متن
انتخاب راست به چپ یا چپ به راست بودن عنوان و متن
انتخاب موقعیت نمایش نوتیفیکیشن
تعیین مدت زمان نمایش
انتخاب نوع انیمیشن برای باز شدن نوتیفیکیشن
انتخاب سدا
انتخاب آیکون
انتخاب گوشه های گرد
انتخاب gradient برای بخش متن
--------------
1- در هر یک از چهار position ، نوتیفیکیشن ها جداگانه مدیریت میشوند.
هر نوتیفیکیشن جدید به مجموعه نوتیفیکیشن های آن position اضافه میشود
و تا زمانی که برای آن تعیین شده (یا تا زمانی که روی آن کلیک شود) روی صفحه میماند.
2- هر نوتیفیکیشن یک handle برمیگرداند که از آن میتواند برای بستن با کد استفاده کرد.
نمونه استفاده از این قابلیت در تاپیک GetInstalledSoftwaresInfo استفاده شده.
Function ShowToastNotification(
title As String,
message As String,
Optional duration As Integer = 10000,
Optional animation As Animation = Animation.RollLeft,
Optional icon As Icon = Icon.stat_information,
Optional sound As Sound = Sound.wavNotify,
Optional title_rtl As Boolean = True,
Optional title_persian_numbers As Boolean = True,
Optional title_font As Font_Name = Font_Name.Segoe_UI,
Optional title_font_size As Font_Size = Font_Size.Medium,
Optional title_font_bold As Boolean = True,
Optional title_font_italic As Boolean = False,
Optional title_forecolor As WebColor = WebColor.DefaultColor,
Optional title_backcolor As WebColor = WebColor.DefaultColor,
Optional message_rtl As Boolean = True,
Optional message_persian_numbers As Boolean = True,
Optional message_centered As Boolean = True,
Optional message_font As Font_Name = Font_Name.Segoe_UI,
Optional message_font_size As Font_Size = Font_Size.Medium,
Optional message_font_bold As Boolean = True,
Optional message_font_italic As Boolean = False,
Optional message_forecolor As WebColor = WebColor.DefaultColor,
Optional message_backcolor As WebColor = WebColor.DefaultColor,
Optional rounded As Boolean = True,
Optional gradient As Boolean = True,
Optional position As Position = Position.RightDown
) As IntPtr
Enum Animation As Integer
None = 0
Fade = Anim.Fade
Center = Anim.Center
RollRight = Anim.Roll Or Anim.Right
RollLeft = Anim.Roll Or Anim.Left
RollDown = Anim.Roll Or Anim.Down
RollUp = Anim.Roll Or Anim.Up
RollRightDown = RollRight Or Anim.Down
RollRightUP = RollRight Or Anim.Up
RollLeftDown = RollLeft Or Anim.Down
RollLeftUp = RollLeft Or Anim.Up
SlideRight = Anim.Slide Or Anim.Right
SlideLeft = Anim.Slide Or Anim.Left
SlideDown = Anim.Slide Or Anim.Down
SlideUp = Anim.Slide Or Anim.Up
SlideRightDown = SlideRight Or Anim.Down
SlideRightUP = SlideRight Or Anim.Up
SlideLeftDown = SlideLeft Or Anim.Down
SlideLeftUp = SlideLeft Or Anim.Up
End Enum
Enum Sound As Integer
None = 0
wavNotify = 1
wavExclamation = 2
wavError = 3
wavCritical = 4
End Enum
Enum Position As Integer
RightDown = 1
LeftDown = 2
RightUP = 3
LeftUp = 4
End Enum
Enum Font_Name As Integer
Segoe_UI = 2
Tahoma = 3
Arial = 4
Microsoft_Sans_Serif = 5
Times_New_Roman = 6
Courier_New = 7
Calibri = 8
End Enum
Enum Font_Size As Integer
Small = 1
Normal = 2
Medium = 3
Large = 4
End Enum
Enum WebColor As Integer
DefaultColor = 0
Transparent = 27 ' &HFFFFFF
AliceBlue = 28 ' &HFFF0F8FF
AntiqueWhite = 29 ' &HFFFAEBD7
Aqua = 30 ' &HFF00FFFF
Aquamarine = 31 ' &HFF7FFFD4
Azure = 32 ' &HFFF0FFFF
Beige = 33 ' &HFFF5F5DC
Bisque = 34 ' &HFFFFE4C4
Black = 35 ' &HFF000000
BlanchedAlmond = 36 ' &HFFFFEBCD
Blue = 37 ' &HFF0000FF
BlueViolet = 38 ' &HFF8A2BE2
Brown = 39 ' &HFFA52A2A
BurlyWood = 40 ' &HFFDEB887
CadetBlue = 41 ' &HFF5F9EA0
Chartreuse = 42 ' &HFF7FFF00
Chocolate = 43 ' &HFFD2691E
Coral = 44 ' &HFFFF7F50
CornflowerBlue = 45 ' &HFF6495ED
Cornsilk = 46 ' &HFFFFF8DC
Crimson = 47 ' &HFFDC143C
Cyan = 48 ' &HFF00FFFF
DarkBlue = 49 ' &HFF00008B
DarkCyan = 50 ' &HFF008B8B
DarkGoldenrod = 51 ' &HFFB8860B
DarkGray = 52 ' &HFFA9A9A9
DarkGreen = 53 ' &HFF006400
DarkKhaki = 54 ' &HFFBDB76B
DarkMagenta = 55 ' &HFF8B008B
DarkOliveGreen = 56 ' &HFF556B2F
DarkOrange = 57 ' &HFFFF8C00
DarkOrchid = 58 ' &HFF9932CC
DarkRed = 59 ' &HFF8B0000
DarkSalmon = 60 ' &HFFE9967A
DarkSeaGreen = 61 ' &HFF8FBC8B
DarkSlateBlue = 62 ' &HFF483D8B
DarkSlateGray = 63 ' &HFF2F4F4F
DarkTurquoise = 64 ' &HFF00CED1
DarkViolet = 65 ' &HFF9400D3
DeepPink = 66 ' &HFFFF1493
DeepSkyBlue = 67 ' &HFF00BFFF
DimGray = 68 ' &HFF696969
DodgerBlue = 69 ' &HFF1E90FF
Firebrick = 70 ' &HFFB22222
FloralWhite = 71 ' &HFFFFFAF0
ForestGreen = 72 ' &HFF228B22
Fuchsia = 73 ' &HFFFF00FF
Gainsboro = 74 ' &HFFDCDCDC
GhostWhite = 75 ' &HFFF8F8FF
Gold = 76 ' &HFFFFD700
Goldenrod = 77 ' &HFFDAA520
Gray = 78 ' &HFF808080
Green = 79 ' &HFF008000
GreenYellow = 80 ' &HFFADFF2F
Honeydew = 81 ' &HFFF0FFF0
HotPink = 82 ' &HFFFF69B4
IndianRed = 83 ' &HFFCD5C5C
Indigo = 84 ' &HFF4B0082
Ivory = 85 ' &HFFFFFFF0
Khaki = 86 ' &HFFF0E68C
Lavender = 87 ' &HFFE6E6FA
LavenderBlush = 88 ' &HFFFFF0F5
LawnGreen = 89 ' &HFF7CFC00
LemonChiffon = 90 ' &HFFFFFACD
LightBlue = 91 ' &HFFADD8E6
LightCoral = 92 ' &HFFF08080
LightCyan = 93 ' &HFFE0FFFF
LightGoldenrodYellow = 94 ' &HFFFAFAD2
LightGray = 95 ' &HFFD3D3D3
LightGreen = 96 ' &HFF90EE90
LightPink = 97 ' &HFFFFB6C1
LightSalmon = 98 ' &HFFFFA07A
LightSeaGreen = 99 ' &HFF20B2AA
LightSkyBlue = 100 ' &HFF87CEFA
LightSlateGray = 101 ' &HFF778899
LightSteelBlue = 102 ' &HFFB0C4DE
LightYellow = 103 ' &HFFFFFFE0
Lime = 104 ' &HFF00FF00
LimeGreen = 105 ' &HFF32CD32
Linen = 106 ' &HFFFAF0E6
Magenta = 107 ' &HFFFF00FF
Maroon = 108 ' &HFF800000
MediumAquamarine = 109 ' &HFF66CDAA
MediumBlue = 110 ' &HFF0000CD
MediumOrchid = 111 ' &HFFBA55D3
MediumPurple = 112 ' &HFF9370DB
MediumSeaGreen = 113 ' &HFF3CB371
MediumSlateBlue = 114 ' &HFF7B68EE
MediumSpringGreen = 115 ' &HFF00FA9A
MediumTurquoise = 116 ' &HFF48D1CC
MediumVioletRed = 117 ' &HFFC71585
MidnightBlue = 118 ' &HFF191970
MintCream = 119 ' &HFFF5FFFA
MistyRose = 120 ' &HFFFFE4E1
Moccasin = 121 ' &HFFFFE4B5
NavajoWhite = 122 ' &HFFFFDEAD
Navy = 123 ' &HFF000080
OldLace = 124 ' &HFFFDF5E6
Olive = 125 ' &HFF808000
OliveDrab = 126 ' &HFF6B8E23
Orange = 127 ' &HFFFFA500
OrangeRed = 128 ' &HFFFF4500
Orchid = 129 ' &HFFDA70D6
PaleGoldenrod = 130 ' &HFFEEE8AA
PaleGreen = 131 ' &HFF98FB98
PaleTurquoise = 132 ' &HFFAFEEEE
PaleVioletRed = 133 ' &HFFDB7093
PapayaWhip = 134 ' &HFFFFEFD5
PeachPuff = 135 ' &HFFFFDAB9
Peru = 136 ' &HFFCD853F
Pink = 137 ' &HFFFFC0CB
Plum = 138 ' &HFFDDA0DD
PowderBlue = 139 ' &HFFB0E0E6
Purple = 140 ' &HFF800080
Red = 141 ' &HFFFF0000
RosyBrown = 142 ' &HFFBC8F8F
RoyalBlue = 143 ' &HFF4169E1
SaddleBrown = 144 ' &HFF8B4513
Salmon = 145 ' &HFFFA8072
SandyBrown = 146 ' &HFFF4A460
SeaGreen = 147 ' &HFF2E8B57
SeaShell = 148 ' &HFFFFF5EE
Sienna = 149 ' &HFFA0522D
Silver = 150 ' &HFFC0C0C0
SkyBlue = 151 ' &HFF87CEEB
SlateBlue = 152 ' &HFF6A5ACD
SlateGray = 153 ' &HFF708090
Snow = 154 ' &HFFFFFAFA
SpringGreen = 155 ' &HFF00FF7F
SteelBlue = 156 ' &HFF4682B4
Tan = 157 ' &HFFD2B48C
Teal = 158 ' &HFF008080
Thistle = 159 ' &HFFD8BFD8
Tomato = 160 ' &HFFFF6347
Turquoise = 161 ' &HFF40E0D0
Violet = 162 ' &HFFEE82EE
Wheat = 163 ' &HFFF5DEB3
White = 164 ' &HFFFFFFFF
WhiteSmoke = 165 ' &HFFF5F5F5
Yellow = 166 ' &HFFFFFF00
YellowGreen = 167 ' &HFF9ACD32
End Enum
Enum Icon As Integer
NoIcon = 0
abort = 101
add = 102
addons = 103
app_add_blue = 105
app_add_green = 106
app_alarm = 107
app_calendar = 108
app_cd = 109
app_clock = 110
app_comment = 111
app_config = 112
app_console = 113
app_critical = 114
app_document = 115
app_download = 116
app_favorite = 117
app_important = 118
app_information = 119
app_key = 120
app_lan = 121
app_locked = 122
app_logout = 123
app_mail = 124
app_microsoft = 125
app_ok = 126
app_power = 127
app_question = 128
app_recycle = 129
app_redo = 130
app_remove_blue = 131
app_remove_red = 132
app_reset = 133
app_run = 134
app_save = 135
app_search = 136
app_settings = 137
app_shutdown = 138
app_sms = 139
app_stopwatch = 140
app_telegram = 141
app_undo = 142
app_unlock = 143
app_update = 144
app_wireless = 145
arrow_clockwise = 147
arrow_counterclockwise = 148
at_sign = 149
attachment = 150
backup_restore = 151
barcode = 152
calendar = 153
camera = 154
cancel = 155
cd = 156
chart_bar = 157
chart_line = 158
chart_pie = 159
clock = 161
close = 162
cloud = 164
comment = 165
computer = 166
computer_laptop = 167
configure = 168
connection = 169
contact = 170
data = 171
data_add = 172
data_apply = 173
data_backup = 174
data_delete = 175
data_edit = 176
data_find = 177
data_folder = 178
data_left = 179
data_off = 180
data_redo = 181
data_remove = 182
data_right = 183
data_undo = 184
data_up = 185
database = 186
database_add = 187
database_check = 188
database_delete = 189
database_down = 190
database_left = 191
database_remove = 192
database_right = 193
database_search = 194
database_settings = 195
database_up = 196
datetime = 197
download = 198
drive_hdd = 199
drive_usb = 200
extra = 201
eye = 202
folder = 204
folder_error = 205
form = 206
go_back = 207
go_into = 208
hand = 209
hibernate = 210
hint = 211
import_export = 212
laptop = 214
link = 215
locked = 216
login = 217
logout = 218
mail = 219
ms_access = 220
ms_excel = 221
ms_infopath = 222
ms_lync = 223
ms_office = 224
ms_onenote = 225
ms_outlook = 226
ms_powerpoint = 227
ms_project = 228
ms_publisher = 229
ms_visio = 230
ms_word = 231
offline = 232
ok = 233
ok_semi = 234
online = 235
options = 237
order = 238
phone = 239
power = 240
printer = 241
printer_error = 242
process = 243
prohibit = 244
refresh = 245
remove = 246
report = 247
rules = 249
run = 250
save_to = 252
sd_mmc = 253
security_high = 255
security_low = 256
security_medium = 257
sms = 258
sms_receive = 259
sms_send = 260
star = 261
stat_critical = 262
stat_information = 263
stat_question = 264
stat_warning = 265
sync = 266
system_antivirus = 268
system_command = 269
system_locked = 272
system_logoff = 273
system_refresh = 278
system_restart = 279
system_shutdown = 280
system_standby = 282
system_sync = 283
system_uninstall = 285
table_add = 287
table_colums = 288
table_down = 289
table_edit = 290
table_lines = 291
table_next = 292
table_redo = 293
table_remove = 294
table_undo = 295
tables = 296
thumb_down = 298
thumb_up = 299
undo = 300
unlocked = 301
upload = 302
user = 303
user_accept = 304
user_add = 305
user_edit = 306
user_help = 307
user_info = 308
user_remove = 309
user_search = 310
user_warning = 311
warning = 312
wifi = 313
windows = 314
End Enum
Sub Example_1()
v.ShowToastNotification "کاربر {Admin}", "خوش آمدید!", Icon:=Icon_user_accept
End Sub
154695
Sub Example_2()
v.ShowToastNotification title:="ساخت پشتیبان", _
message:="نوشتن CD پشتیبان سیستم انبار شروع شد ...", _
duration:=0, _
Icon:=Icon_app_run, _
title_forecolor:=WebColor_Crimson, _
title_backcolor:=WebColor_BurlyWood, _
Position:=Position_LeftDown, _
Animation:=Animation_SlideRight
' ...
' ...
' ...
v.ShowToastNotification title:="ساخت پشتیبان", _
message:="CD پشتیبان از دیتابیس با موفقیت نوشته شد.", _
duration:=0, _
Icon:=Icon_app_cd, _
title_forecolor:=WebColor_Crimson, _
title_backcolor:=WebColor_BurlyWood, _
Position:=Position_LeftDown, _
Animation:=Animation_SlideRight
End Sub
154694
mazoolagh
چهارشنبه 03 خرداد 1402, 14:39 عصر
این متد یک فرم برای آزمایش همه امکانات ShowToastNotification را باز میکند و فقط کاربرد آموزشی و تست دارد.
ShowToastNotificationDemo()
154692
154693
mazoolagh
چهارشنبه 03 خرداد 1402, 14:40 عصر
Function ShowColorDialog() As WinColor
Class WinColor
' Methods
ToString()
ShowProperties()
' Properties
A As Byte
R As Byte
G As Byte
B As Byte
ARGB As Integer
Hue As Single
Saturation As Single
Brightness As Single
Name As String
KnownColorName As String
IsEmpty As Boolean
IsNamedColor As Boolean
IsKnownColor As Boolean
IsSystemColor As Boolean
CustomColors As Integer()
کد نمونه:
Sub Example_A()
Dim c As New WinColor
Set c = v.ShowColorDialog
Debug.Print c.ToString
c.ShowProperties
End Sub
154696
154697
mazoolagh
چهارشنبه 03 خرداد 1402, 14:41 عصر
Function ShowFolderBrowserDialog(
Optional title As String = "",
Optional title_rtl As Boolean = True,
Optional show_new_button As Boolean = True,
Optional root_folder As SpecialFolders = SpecialFolders.MyComputer
) As String
Enum SpecialFolders As Integer
Desktop = 0
MyComputer = 17
CommonApplicationData = 35
CommonDesktopDirectory = 25
CommonDocuments = 46
CommonMusic = 53
CommonOemLinks = 58
CommonPictures = 54
CommonProgramFiles = 43
CommonProgramFilesX86 = 44
CommonPrograms = 23
CommonStartMenu = 22
CommonStartup = 24
CommonTemplates = 45
CommonVideos = 55
Cookies = 33
DesktopDirectory = 16
AdminTools = 48
ApplicationData = 26
CDBurning = 59
CommonAdminTools = 47
Favorites = 6
Fonts = 20
History = 34
InternetCache = 32
LocalApplicationData = 28
LocalizedResources = 57
MyDocuments = 5
MyMusic = 13
MyPictures = 39
MyVideos = 14
NetworkShortcuts = 19
Personal = 5
PrinterShortcuts = 27
ProgramFiles = 38
ProgramFilesX86 = 42
Programs = 2
Recent = 8
Resources = 56
SendTo = 9
StartMenu = 11
Startup = 7
System = 37
SystemX86 = 41
Templates = 21
UserProfile = 40
Windows = 36
End Enum
Sub Example_A()
Dim folder As String
folder = v.ShowFolderBrowserDialog
Debug.Print folder
End Sub
Sub Example_B()
Dim folder As String
folder = v.ShowFolderBrowserDialog( _
title:="فولدر فایلهای Word را انتخاب کنید", _
title_rtl:=True, _
show_new_button:=False, _
root_folder:=SpecialFolders_MyComputer)
Debug.Print folder
End Sub
154698
mazoolagh
چهارشنبه 03 خرداد 1402, 14:41 عصر
Function ShowFontDialog() As WinFont
Class WinFont
' Methods
ToString()
ShowProperties()
' Properties
Name As String
FontFamily As String
OriginalFontName As String
SystemFontName As String
Bold As Boolean
Italic As Boolean
Underline As Boolean
Strikeout As Boolean
Style As String
Size As Single
SizeInPoints As Single
Unit As Integer
UnitName As String
Height As Integer
GdiCharSet As Integer
GdiCharSetName As String
GdiVerticalFont As Boolean
IsSystemFont As Boolean
IsNothing As Boolean
Sub Example_A()
Dim f As New WinFont
Set f = v.ShowFontDialog
Debug.Print f.ToString
f.ShowProperties
End Sub
154699
mazoolagh
چهارشنبه 03 خرداد 1402, 14:42 عصر
Function ShowOpenFileDialog(
Optional title As String = "فایل(ها) را انتخاب کنید:",
Optional title_rtl As Boolean = True,
Optional filter As String = "all files|*.*",
Optional filter_index As Integer = 1,
Optional initial_directory As String = "",
Optional default_extension As String = "",
Optional multiselect As Boolean = True,
Optional show_readonly As Boolean = False
) As FileDialogResults
Class FileDialogResults
' Methods
ShowProperties()
ToString()
' Properties
FileNames As String()
FileNamesFullPath As String()
SelectedFolder As String
ReadOnlyChecked As Boolean
IsNothing As Boolean
Sub Example_A()
Dim fdr As New FileDialogResults
Set fdr = v.ShowOpenFileDialog
Debug.Print fdr.ToString
fdr.ShowProperties
End Sub
154701
Sub Example_B()
Const images_filter = _
"All Pictures (*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp ;*.dib;*.rle;*.gif;*.emz;*.wmz;*.tif;*.tiff;*.svg; *.ico)" + _
"|*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp ;*.dib;*.rle;*.gif;*.emz;*.wmz;*.tif;*.tiff;*.svg; *.ico" + _
"|Windows Enhanced Metafile (*.emf)|*.emf" + _
"|Windows Metafile (*.wmf)|*.wmf" + _
"|JPEG File Interchange Format (*.jpg;*.jpeg;*.jfif;*.jpe)|*.jpg;*.jpeg;*.jfif;*. jpe" + _
"|Portable Network Graphics (*.png)|*.png" + _
"|Bitmap Image File (*.bmp;*.dib;*.rle)|*.bmp;*.dib;*.rle" + _
"|Compressed Windows Enhanced Metafile (*.emz)|*.emz" + _
"|Compressed Windows MetaFile (*.wmz)|*.wmz" + _
"|Tag Image File Format (*.tif;*.tiff)|*.tif;*.tiff" + _
"|Scalable Vector Graphics (*.svg)|*.svg" + _
"|Icon (*.ico)|*.ico"
Dim fdr As New FileDialogResults
Set fdr = v.ShowOpenFileDialog( _
title:="فایل(های) تصویری را برای پیوست به نامه انتخاب کنید:", _
title_rtl:=True, _
Filter:=images_filter, _
filter_index:=1, _
initial_directory:="k:\scanned", _
default_extension:="bmp", _
show_readonly:=True)
fdr.ShowProperties
If fdr.IsNothing Then
Debug.Print "No file selected!"
Else
Debug.Print "Selected Folder=" & fdr.SelectedFolder
Debug.Print "Selected Files:"
Dim fn
i = 0
For Each fn In fdr.FileNames
i = i + 1
Debug.Print i & ": " & fn
Next
Debug.Print "Open Readonly = " & fdr.ReadOnlyChecked
End If
End Sub
154700
mazoolagh
چهارشنبه 03 خرداد 1402, 14:43 عصر
Function ShowSaveFileDialog(
Optional title As String = "فایل به چه نامی ذخیره شود؟",
Optional title_rtl As Boolean = True,
Optional filter As String = "all files|*.*",
Optional filter_index As Integer = 1,
Optional initial_directory As String = "",
Optional default_extension As String = "",
Optional overwrite_prompt As Boolean = True
) As String
کد نمونه:
Sub Example_A()
Dim fn As String
fn = v.ShowSaveFileDialog
Debug.Print "Save Filename=" & fn
End Sub
Sub Example_B()
Const images_filter = _
"All Pictures (*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp ;*.dib;*.rle;*.gif;*.emz;*.wmz;*.tif;*.tiff;*.svg; *.ico)" + _
"|*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp ;*.dib;*.rle;*.gif;*.emz;*.wmz;*.tif;*.tiff;*.svg; *.ico" + _
"|Windows Enhanced Metafile (*.emf)|*.emf" + _
"|Windows Metafile (*.wmf)|*.wmf" + _
"|JPEG File Interchange Format (*.jpg;*.jpeg;*.jfif;*.jpe)|*.jpg;*.jpeg;*.jfif;*. jpe" + _
"|Portable Network Graphics (*.png)|*.png" + _
"|Bitmap Image File (*.bmp;*.dib;*.rle)|*.bmp;*.dib;*.rle" + _
"|Compressed Windows Enhanced Metafile (*.emz)|*.emz" + _
"|Compressed Windows MetaFile (*.wmz)|*.wmz" + _
"|Tag Image File Format (*.tif;*.tiff)|*.tif;*.tiff" + _
"|Scalable Vector Graphics (*.svg)|*.svg" + _
"|Icon (*.ico)|*.ico"
Dim fn As String
fn = v.ShowSaveFileDialog( _
Filter:=images_filter, _
filter_index:=7, _
initial_directory:="k:\scanned", _
default_extension:="bmp", _
overwrite_prompt:=False)
Debug.Print "Save Filename=" & fn
End Sub
154702
mazoolagh
چهارشنبه 03 خرداد 1402, 14:44 عصر
Function GetCDROMsInfo() As CDROMinfo()
Class CDROMinfo
' Methods
ShowProperties()
' Properties
CapabilityDescriptions As String
Caption As String
CompressionMethod As String
Description As String
DeviceID As String
Drive As String
DriveIntegrity As Boolean
FileSystemFlagsEx As Double 'Long
Id As String
Manufacturer As String
MaximumComponentLength As Double
MaxMediaSize As String
MediaLoaded As Boolean
MediaType As String
Name As String
NeedsCleaning As Boolean
NumberOfMediaSupported As Double
PNPDeviceID As String
SerialNumber As String
Size As Double
Status As String
TransferRate As Double
VolumeName As String
VolumeSerialNumber As String
کد نمونه:
Sub Example_B()
Dim cdi() As New CDROMinfo
cdi = v.GetCDROMsInfo
N = UBound(cdi)
If N >= 0 Then
Debug.Print N + 1 & " CDROMs Found!"
For i = 0 To N
Debug.Print cdi(i).Name, cdi(i).Caption
'cdi(i).ShowProperties
Next
Else
Debug.Print "No CDROMs Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:44 عصر
Function GetComputerSystemInfo() As ComputerSystemInfo
Class ComputerSystemInfo
' Methods
ShowProperties()
' Properties
BootupState As String
Caption As String
ChassisBootupState As String
ChassisSKUNumber As String
Description As String
DNSHostName As String
Domain As String
Manufacturer As String
Model As String
Name As String
NumberOfLogicalProcessors As Integer
NumberOfProcessors As Integer
PCSystemType As String
PowerState As String
PrimaryOwnerContact As String
PrimaryOwnerName As String
SystemFamily As String
SystemSKUNumber As String
SystemType As String
TotalPhysicalMemory As Double
UserName As String
Workgroup As String
UUID As String ' Win32_ComputerSystemProduct
کد نمونه:
Sub Example_B()
Dim cs_info As New ComputerSystemInfo
Set cs_info = v.GetComputerSystemInfo
Debug.Print cs_info.Manufacturer, cs_info.Model
cs_info.ShowProperties
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:45 عصر
Function GetDesktopMonitorsInfo() As DesktopMonitorInfo()
Class DesktopMonitorInfo
' Methods
ShowProperties()
' Properties
Availability As String
Caption As String
Description As String
DeviceID As String
DisplayType As String
MonitorManufacturer As String
MonitorType As String
Name As String
PixelsPerXLogicalInch As Integer
PixelsPerYLogicalInch As Integer
PNPDeviceID As String
ScreenHeight As Integer
ScreenWidth As Integer
Status As String
کد نمونه:
Sub Example_B()
Dim ddm() As New DesktopMonitorInfo
ddm = v.GetDesktopMonitorsInfo
N = UBound(ddm)
If N >= 0 Then
Debug.Print N + 1 & " Monitors Found!"
For i = 0 To N
Debug.Print ddm(i).DeviceID, ddm(i).Caption
'ddm(i).ShowProperties
Next
Else
Debug.Print "No Monitors Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:46 عصر
Function GetDiskDrivesInfo() As DiskDriveInfo()
Class DiskDriveInfo
' Methods
ShowProperties()
' Properties
BytesPerSector As Integer
Caption As String
Description As String
DeviceID As String
FirmwareRevision As String
Index As Integer
InterfaceType As String
Manufacturer As String
MediaType As String
Model As String
Name As String
Partitions As Integer
PNPDeviceID As String
SectorsPerTrack As Integer
SerialNumber As String
Signature As String
Size As Double
TotalCylinders As Double
TotalHeads As Integer
TotalSectors As Double
TotalTracks As Double
TracksPerCylinder As Integer
کد نمونه:
Sub Example_B()
Dim ddi() As New DiskDriveInfo
ddi = v.GetDiskDrivesInfo
N = UBound(ddi)
If N >= 0 Then
Debug.Print N + 1 & " Disk Drives Found!"
For i = 0 To N
Debug.Print ddi(i).Name, ddi(i).Caption
ddi(i).ShowProperties
Next
Else
Debug.Print "No Disk Drives Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:46 عصر
Function GetInstalledFonts() As String()
کد نمونه:
Sub Example_A()
Dim fonts() As String
fonts = v.GetInstalledFonts()
Dim font
For Each font In fonts
Debug.Print font
Next
Debug.Print UBound(fonts) + 1 & " Fonts Installed"
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:47 عصر
Function GetInstalledSoftwaresInfoFromRegistry() As SoftwareInfo()
Function GetInstalledSoftwaresInfoFromWMI() As SoftwareInfo()
Function GetInstalledSoftwaresInfoFromRegistryAndWMI() As SoftwareInfo()
Class SoftwareInfo
' Properties
Name As String
Version As String
Publisher As String
Size As String
کد نمونه:
Public Enum Source
Registry = 1
WMI = 2
Registry_and_WMI = 3
End Enum
Sub Example_2()
GetInstalledSoftwares (Registry)
End Sub
Sub Example_3()
GetInstalledSoftwares (WMI)
End Sub
Sub Example_4()
GetInstalledSoftwares (Registry_and_WMI)
End Sub
Sub GetInstalledSoftwares(src As Source)
Const message = "Reading list from @source ..." & vbCrLf & _
"It may takes a couple of minutes." & vbCrLf & _
"Please wait...."
Dim s As String
Dim sws() As New SoftwareInfo
Dim sw As Variant
Dim t1, t2 As Date
Dim h As LongPtr
Select Case src
Case Source.Registry
s = "Registry"
Case Source.WMI
s = "WMI"
Case Source.Registry_and_WMI
s = "Registry and WMI"
End Select
h = v.ShowToastNotification( _
title:="Installed Softwares", _
message:=Replace(message, "@source", s), _
duration:=0, _
title_rtl:=False, _
message_rtl:=False, _
message_centered:=False, _
Icon:=Icon_data_find)
t1 = Now
Select Case src
Case Source.Registry
sws = v.GetInstalledSoftwaresInfoFromRegistry
Case Source.WMI
sws = v.GetInstalledSoftwaresInfoFromWMI
Case Source.Registry_and_WMI
sws = v.GetInstalledSoftwaresInfoFromRegistryAndWMI
End Select
t2 = Now
v.CloseWindow (h)
v.ShowToastNotification _
title:="Installed Softwares", _
message:="Results are ready." & vbCrLf & _
(UBound(sws) + 1) & " Softwares found" & vbCrLf & _
"in " & DateDiff("s", t1, t2) & " seconds.", _
duration:=0, _
title_rtl:=False, _
message_rtl:=False, _
message_centered:=False, _
message_persian_numbers:=False
For Each sw In sws
Debug.Print sw.Name, sw.Version, sw.Publisher, sw.Size
Next
Debug.Print UBound(sws) + 1 & " Softwares Found!"
End Sub
154703
mazoolagh
چهارشنبه 03 خرداد 1402, 14:47 عصر
Function GetNetworkAdaptersinfo() As NetworkAdapterInfo()
Class NetworkAdapterInfo
'Methods
ShowProperties()
' Properties
Name As String
Caption As String
Description As String
ProductName As String
ServiceName As String
AdapterType As String
Manufacturer As String
MACAddress As String
NetConnectionID As String
PhysicalAdapter As Boolean
Speed As Double
InterfaceIndex As Integer
NetConnectionStatus As String
NetEnabled As Boolean
Availability As String
Status As String
کد نمونه:
Sub Example_B()
Dim nai() As New NetworkAdapterInfo
nai = v.GetNetworkAdaptersinfo
N = UBound(nai)
If N >= 0 Then
Debug.Print N + 1 & " Network Adapters Found!"
For i = 0 To N
Debug.Print nai(i).Name, nai(i).AdapterType
'nai(i).ShowProperties
Next
Else
Debug.Print "No Network Adapters Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:48 عصر
Function GetPhysicalMemoryInfo() As PhysicalMemoryInfo()
Class PhysicalMemoryInfo
' Methods
ShowProperties()
' Properties
BankLabel As String
Capacity As String
DataWidth As Integer
DeviceLocator As String
FormFactor As String
Manufacturer As String
MemoryType As String
Model As String
Name As String
PartNumber As String
SerialNumber As String
Speed As String
کد نمونه:
Sub Example_B()
Dim pm() As New PhysicalMemoryInfo
pm = v.GetPhysicalMemoryInfo
N = UBound(pm)
If N >= 0 Then
Debug.Print N + 1 & " Physical Memory(s) Found!"
For i = 0 To N
Debug.Print pm(i).BankLabel, pm(i).Capacity
'pm(i).ShowProperties
Next
Else
Debug.Print "No Physical Memory Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:49 عصر
Function GetPrintersInfo() As PrinterInfo()
Class PrinterInfo
' Methods
ShowProperties()
' Properties
Name As String
ShareName As String
Caption As String
DeviceID As String
Capabilities As String()
PaperNames As String()
PrintProcessor As String
IsDefault As Boolean
IsLocal As Boolean
IsNetwork As Boolean
IsDirect As Boolean
IsHidden As Boolean
IsShared As Boolean
HorizontalResolution As Integer
VerticalResolution As Integer
LanguagesSupported As String
PortName As String
ExtendedPrinterStatus As String
ExtendedDetectedErrorState As String
Sub Example_B()
Dim pri() As New PrinterInfo
pri = v.GetPrintersInfo
N = UBound(pri)
If N >= 0 Then
Debug.Print N + 1 & " Printers Found!"
For i = 0 To N
Debug.Print (i + 1) & ": " & pri(i).Name
'pri(i).ShowProperties
Next
Else
Debug.Print "No Printers Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:49 عصر
Function GetProcessorsInfo() As ProcessorInfo()
Class ProcessorInfo
' Methods
ShowProperties()
' Properties
Architecture As String
Caption As String
CpuStatus As String
Description As String
DeviceID As String
Family As String
Manufacturer As String
MaxClockSpeed As String
Name As String
NumberOfCores As Integer
NumberOfLogicalProcessors As Integer
PartNumber As String
ProcessorId As String
ProcessorType As String
SerialNumber As String
Status As String
کد نمونه:
Sub Example_B()
Dim prc() As New ProcessorInfo
prc = v.GetProcessorsInfo
N = UBound(prc)
Debug.Print N + 1 & " Processor(s) Found!"
For i = 0 To N
Debug.Print prc(i).Name, prc(i).Caption
'prc(i).ShowProperties
Next
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:50 عصر
Function GetScreensInfo() As ScreenInfo()
Class ScreenInfo
' Methods
ShowProperties()
ToString()
' Properties
Name As String
Primary As Boolean
BitsPerPixel As Integer
Bounds As DrawingRectangle
WorkingArea As DrawingRectangle
Class DrawingRectangle
' Methods
ToString()
' Properties
Top As Integer
Left As Integer
Bottom As Integer
Right As Integer
Width As Integer
Height As Integer
Size As DrawingSize
X As Integer
Y As Integer
Location As DrawingPoint
IsEmpty As Boolean
Class DrawingSize
' Methods
ToString()
' Properties
Width As Integer
Height As Integer
IsEmpty As Boolean
Class DrawingPoint
' Methods
ToString()
' Properties
X As Integer
Y As Integer
IsEmpty As Boolean
کد نمونه:
Sub Example_B()
Dim scr() As New ScreenInfo
scr = v.GetScreensInfo
N = UBound(scr)
If N >= 0 Then
Debug.Print N + 1 & " Screens Found!"
For i = 0 To N
Debug.Print scr(i).Name
'scr(i).ShowProperties
Next
Else
Debug.Print "No Screens Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:51 عصر
Function GetScreensInfo() As ScreenInfo()
Class ScreenInfo
' Methods
ShowProperties()
ToString()
' Properties
Name As String
Primary As Boolean
BitsPerPixel As Integer
Bounds As DrawingRectangle
WorkingArea As DrawingRectangle
Class DrawingRectangle
' Methods
ToString()
' Properties
Top As Integer
Left As Integer
Bottom As Integer
Right As Integer
Width As Integer
Height As Integer
Size As DrawingSize
X As Integer
Y As Integer
Location As DrawingPoint
IsEmpty As Boolean
Class DrawingSize
' Methods
ToString()
' Properties
Width As Integer
Height As Integer
IsEmpty As Boolean
Class DrawingPoint
' Methods
ToString()
' Properties
X As Integer
Y As Integer
IsEmpty As Boolean
کد نمونه:
Sub Example_B()
Dim scr() As New ScreenInfo
scr = v.GetScreensInfo
N = UBound(scr)
If N >= 0 Then
Debug.Print N + 1 & " Screens Found!"
For i = 0 To N
Debug.Print scr(i).Name
'scr(i).ShowProperties
Next
Else
Debug.Print "No Screens Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:52 عصر
این متد مشخصات همه CDROM ها را نمایش میدهد.
فقط کاربر تست و آموزشی دارد.
ShowCDROMsInfo()
کد نمونه:
Sub Example_A()
v.ShowCDROMsInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:52 عصر
این متد مشخصات سیستم را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowComputerSystemInfo()
کد نمونه:
Sub Example_A()
v.ShowComputerSystemInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:53 عصر
این متد مشخصات همه مونیتورها را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
در بعضی مواقع ممکن است در یک سیستم چند مانیتوری اطلاعات بعضی مانیتورها نمایش داده نشود.
ShowDesktopMonitorsInfo()
کدنمونه:
Sub Example_A()
v.ShowDesktopMonitorsInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:54 عصر
این متد مشخصات همه دیسک درایوها را نشان میدهد.
فقط کابرد تست و آموزشی دارد.
ShowDiskDrivesInfo()
کد نمونه:
Sub Example_B()
Dim ddi() As New DiskDriveInfo
ddi = v.GetDiskDrivesInfo
N = UBound(ddi)
If N >= 0 Then
Debug.Print N + 1 & " Disk Drives Found!"
For i = 0 To N
Debug.Print ddi(i).Name, ddi(i).Caption
ddi(i).ShowProperties
Next
Else
Debug.Print "No Disk Drives Found!"
End If
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:55 عصر
این متد لیست همه نرام افزارهای نصب شده را در یک فرم با امکان جستجو نشان میدهد.
اطلاعات از دو روش خواندن رجیستری و کوئری WMI آماده و با هم ترکیب میشود.
پروسه کوئری WMI زمانبر است و ممکن است تا دیدن نتایج در فرم چند دقیقه نیاز باشد.
ShowInstalledSoftwaresInfo()
کد نمونه:
Sub Example_1()
v.ShowInstalledSoftwaresInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:56 عصر
این متد مشخصات همه اینترفیس های شبکه را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowNetworkAdaptersInfo()
کد نمونه:
Sub Example_A()
v.ShowNetworkAdaptersInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:56 عصر
این متد مشخصات همه ماجول های RAM را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowPhysicalMemoryInfo()
کد نمونه:
Sub Example_A()
v.ShowPhysicalMemoryInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:57 عصر
این متد مشخصات همه پرینترها را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowPrintersInfo()
کد نمونه:
Sub Example_A()
v.ShowPrintersInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:58 عصر
این متد مشخصات همه پردازنده ها را نشان میدهد.
فقط کاربرد تست و اموزشی دارد.
ShowProcessorsInfo()
کد نمونه:
Sub Example_A()
v.ShowProcessorsInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:58 عصر
این متد مشخصات همه اسکرین ها را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowScreensInfo()
کد نمونه:
Sub Example_A()
v.ShowScreensInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 14:59 عصر
این متد مشخصات همه کنترلرهای گرافیکی را نشان میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowVideoControllersInfo()
نمونه کد:
Sub Example_A()
v.ShowVideoControllersInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 15:00 عصر
Function GetOperatingSystemInfo() As OperatingSystemInfo
Class OperatingSystemInfo
' Properties
Public ReadOnly Property BootDevice As String
Public ReadOnly Property BuildNumber As String
Public ReadOnly Property BuildType As String
Public ReadOnly Property Caption As String
Public ReadOnly Property CodeSet As String
Public ReadOnly Property CountryCode As String
Public ReadOnly Property CSDVersion As String
Public ReadOnly Property CSName As String
Public ReadOnly Property CurrentTimeZone As Integer
Public ReadOnly Property Description As String
Public ReadOnly Property Distributed As Boolean
Public ReadOnly Property EncryptionLevel As UInt32
Public ReadOnly Property FreePhysicalMemory As Double
Public ReadOnly Property FreeSpaceInPagingFiles As Double
Public ReadOnly Property FreeVirtualMemory As Double
Public ReadOnly Property InstallDate As String
Public ReadOnly Property LastBootUpTime As String
Public ReadOnly Property LocalDateTime As String
Public ReadOnly Property Locale As String
Public ReadOnly Property Manufacturer As String
Public ReadOnly Property MUILanguages As String()
Public ReadOnly Property Name As String
Public ReadOnly Property NumberOfUsers As UInt32
Public ReadOnly Property OperatingSystemSKU As String
Public ReadOnly Property Organization As String
Public ReadOnly Property OSArchitecture As String
Public ReadOnly Property OSLanguage As String
Public ReadOnly Property PortableOperatingSystem As Boolean
Public ReadOnly Property ProductType As String
Public ReadOnly Property RegisteredUser As String
Public ReadOnly Property SerialNumber As String
Public ReadOnly Property Status As String
Public ReadOnly Property SystemDevice As String
Public ReadOnly Property SystemDirectory As String
Public ReadOnly Property SystemDrive As String
Public ReadOnly Property TotalVirtualMemorySize As Double 'KB
Public ReadOnly Property TotalVisibleMemorySize As Double ' KB
Public ReadOnly Property Version As String
Public ReadOnly Property WindowsDirectory As String
کد نمونه:
Sub Example_B()
Dim os_info As New OperatingSystemInfo
Set os_info = v.GetOperatingSystemInfo
Debug.Print os_info.Caption
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 15:02 عصر
این متد مشخصات ویندوز را نمایش میدهد.
فقط کاربرد تست و آموزشی دارد.
ShowOperatingSystemInfo()
کد نمونه:
Sub Example_A()
v.ShowOperatingSystemInfo
End Sub
mazoolagh
چهارشنبه 03 خرداد 1402, 15:06 عصر
کدهای نمونه :
mazoolagh
یک شنبه 07 خرداد 1402, 18:26 عصر
نسخه X86 برای آفیس 32 بیت (https://drive.google.com/file/d/1sh66WF-akSrXpHijbPL4vJWzvsVRe-pT/view?usp=sharing)
نسخه X64 برای آفیس 64 بیت (https://drive.google.com/file/d/1EP7eRhQ1y-CIxF4JxAv3OxM3yH85jNm9/view?usp=sharing)
hamed2661
چهارشنبه 29 شهریور 1402, 11:52 صبح
با سلام و تشکر از مطلب مفیدی که به اشتراک گذاشتین. نمیدونم چرا فایل ضمیمه رو نمیتونم دانلود کنم
mazoolagh
جمعه 31 شهریور 1402, 10:26 صبح
با سلام و تشکر از مطلب مفیدی که به اشتراک گذاشتین. نمیدونم چرا فایل ضمیمه رو نمیتونم دانلود کنم
سلام و روز خوش
من همیشه پیوست ها رو در خود انجمن میگذارم ولی با توجه به محدودیت حجمی که اینجا گذاشته شده باید در 5 تکه آپلود کنم.
لینک های پست 52 از google drive و همیشگی هست.
مستقیم دانلود نمیشه و شما رو به گوگل درایو میبره و اونجا میتونین با کلیک رو آیکون دانلود کنین:
154941
با این وجود اگر باز هم مشکل هست ایمبل بدین براتون میفرستم.
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.