صفحه 1 از 2 12 آخرآخر
نمایش نتایج 1 تا 40 از 54

نام تاپیک: Mazoo Utils for VBA - کتابخانه ابزارهای سودمند برای VBA

  1. #1
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - کتابخانه ابزارهای سودمند برای VBA

    این کتابخانه شامل چند کلاس و همچنین متدهایی است که در VBA دیده نمیشود و پیاده سازی آنها با VBA خالص دشوار یا نشدنی است.

    بنابراین به توسعه دهندگان اکسس اجازه میدهد امکانات جدیدی را به برنامه های خود اضافه کنند که احتمالا پیشتر به آن دسترسی نداشته اند.

    کتابخانه بر پایه Microsoft .NET Framework 4.8 ساخته شده بنابراین نمیتوان از آن روی سیستم عامل های خیلی قدیمی XP یا Vista استفاده کرد.

    استفاده از آن در سیستم عامل های قدیمی نظیر Windows 7 و Windows 8.1 بشرط نصب بودن این فریمورک مشکلی ندارد ولی تست نشده است.

    این کتابخانه در واقع ویرایش ویژه ای از کتابخانه ای است که اولین بار روی سیستم عامل XP ساخته و به مرور آپدیت شده است.
    اینک با برداشتن بخشهایی از آن، که از کمپوننت های دات نت لایسنس دار در آن استفاده شده، و همچنین برداشتن امکانات ویژه ای که برای منظورهای خاصی طراحی شده بودند، و نیز برخی ویرایش های دیگر در فروم برنامه نویس قرار داد میشود.

    این کتابخانه رایگان است،
    هیچ نوع قفل یا محدودیتی در استفاده ندارد،
    و نیاز به اجازه یا لایسنس برای کاربردهای تجاری ندارد و میتوانید آن را در برنامه هایی که میفروشید استفاده کنید.
    همچنین هر نوع مهندسی معکوس و بیرون کشیدن کدها یا منابع از آن آزاد است!

    با این وجود در نظر داشته باشید که:
    1- پشتیبانی ندارد (مطلقا - ولی گزارش اشکالات بررسی و احتمالا برطرف خواهد شد)
    2- آپدیت های بعدی ندارد (احتمالا)
    3- راهنمایی برای نوشتن کد ندارد (باید از نمونه کدهای پیوست و رفرنس متدها و پراپرتی ها ایده بگیرید)
    4- برای افراد متخصص و باتجربه است!

    طبق یک اصل نانوشته، نصب هر نوع نرم افزار از منبع نامشخص (بخصوص رایگان و با عناوین فریبنده) با ریسک آلودگی سیستم به باج افزار یا دزدیده اطلاعات شخصی یا استفاده از سیستم قربانی برای مقاصد مخرب و ... همراه است.
    چنانچه هر نوع شک منطقی در این زمینه دارید، از دانلود و نصب این کتابخانه خودداری کنید.

    اگر به اندازه کافی تخصص دارید میتوانید آن را در یک sandbox اجرا و رفتار آن را مونیتور کنید، هر نوع دسترسی آن به شبکه و دیسک ها رو ببندید و ...
    و پس از اطمینان از آن استفاده کنید.
    ----------------

    رفع مسئولیت:

    1- این کتابخانه بصورت "همین که هست" ارائه شده،
    هیچ نوع پشتیبانی و پاسخگویی و مستندات ندارد،
    و نویسنده آن هیچ نوع تضمین و مسئولیتی در قبال درست بودن عملکرد آن ندارد.

    2- استفاده کننده از این کتابخانه بطور مشخص مسئولیت همه پیامدها را بعهده میگیرد و حق هر گونه ادعایی مبنی بر صدمه سخت افزاری یا نرم افزاری یا وارد شدن هر نوع ضرر و زیان و آسیب مادی و معنوی به خود یا هر شخص دیگر، در ارتباط با این کتابخانه را از خود سلب میکند.

  2. #2
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - روش نصب

    پس از دانلود، و باز کردن فایل rar در یک فولدر دلخواه (در اینجا D:\_MZV) و باز کردن پیوست، 4 فایل در اختیار دارید:

    1- فایل کتابخانه : mzvc.dll
    2- بچ فایل register.bat
    3- بچ فایل unregister.bat
    4- دیتابیس کدهای نمونه : MZVC_samples.accdb

    برای نصب، روی فایل register راست کلیک و run as administrator را انتخاب کنید:
    install_register.png

    پس از OK کردن پیام سیستم، برنامه regasm کتابخانه را رجیستر میکند و میتوانید موفقیت آمیز بودن آن را بررسی کنید:
    install_register_window_1.png
    install_register_window_2.png

    در پایان یک فایل mzvc.tlb هم ساخته میشود که این فایل را باید به عنوان رفرنس به برنامه خود اضافه کنین (نه فایل dll):
    install_refrence_1.png

    برای uninstall کتابخانه کافی است روی unregister.bat راست کلیک و run as administrator را انتخاب کنید:
    install_unregister.png

    1- کتابخانه در دو نسخه x86 (برای آفیس 32 بیت) و x64 (برای آفیس 64 بیت) ارائه میشود.

    2- میتوانید نام فایل dll و محل آن را به دلخواه تعیین کنید (قبل از رجیستر کردن)

    3- اسمبلی های دات نت با برنامه regasm رجیستر میشود و این برنامه باید با دسترسی ادمین اجرا شود.
    برنامه regsvr32 برای رجیستر کردن com object ها است و نباید این دو را با هم اشتباه گرفت.
    آخرین ویرایش به وسیله mazoolagh : پنج شنبه 04 خرداد 1402 در 14:03 عصر

  3. #3
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 18:33 عصر

  4. #4
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 18:53 عصر

  5. #5
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - Notifications

    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 18:57 عصر

  6. #6

  7. #7
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - TimeSpan

    کلاس 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 : پنج شنبه 04 خرداد 1402 در 14:19 عصر

  8. #8
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - TimeSpanUtils

    این کلاس در واقع مشابه 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 : پنج شنبه 04 خرداد 1402 در 17:45 عصر

  9. #9
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GregorianDate

    این کلاس فقط بخش تاریخ (روز،ماه،سال بدون ساعت) تاریخ میلادی را نمایش میدهد.
    بتنهایی چندان کاربردی ندارد و در کلاس 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 : پنج شنبه 04 خرداد 1402 در 17:53 عصر

  10. #10
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GregorianDateTime

    کلاس تاریخ میلادی با متدها و پراپرتی های کاملتر از تاریخ میلادی اکسس

    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 : پنج شنبه 04 خرداد 1402 در 17:57 عصر

  11. #11
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GregorianCalendar

    کلاس تقویم میلادی



    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 : پنج شنبه 04 خرداد 1402 در 17:59 عصر

  12. #12
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - PersianDateTime

    کلاس تاریخ خورشیدی از 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 : پنج شنبه 04 خرداد 1402 در 18:24 عصر

  13. #13
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - PersianCalendar

    کلاس تقویم خورشیدی
    متدهای این کلاس یک مقدار از نوع 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 : پنج شنبه 04 خرداد 1402 در 19:05 عصر

  14. #14
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ListOfString

    این کلاس مشابه یک 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 : پنج شنبه 04 خرداد 1402 در 20:03 عصر

  15. #15
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ListOfStringUtils

    متدهای این کلاس یک مقدار از نوع 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 : پنج شنبه 04 خرداد 1402 در 20:12 عصر

  16. #16
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowMessageBox

    متد 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

    messagebox1.png




    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

    messagebox4.png



    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

    messagebox3.jpg



    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

    messagebox2.png
    آخرین ویرایش به وسیله mazoolagh : جمعه 05 خرداد 1402 در 10:23 صبح

  17. #17
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowDatePicker

    متد 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


    dialog_persiandatepicker101.png



    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

    dialog_persiandatepicker200.png


    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

    dialog_persiandatepicker21.png
    آخرین ویرایش به وسیله mazoolagh : جمعه 05 خرداد 1402 در 11:31 صبح

  18. #18
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowSystemNotification


    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


    A.png
    آخرین ویرایش به وسیله mazoolagh : جمعه 05 خرداد 1402 در 11:56 صبح

  19. #19
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowToastNotification

    این متد یک 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

    notifications_toast1.png



    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




    notifications_toast2.jpg
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 15:33 عصر

  20. #20
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowToastNotificationDemo

    این متد یک فرم برای آزمایش همه امکانات ShowToastNotification را باز میکند و فقط کاربرد آموزشی و تست دارد.


    ShowToastNotificationDemo()


    notifications_toastdemo.jpg

    notifications_toastdemo2.jpg
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 13:26 عصر

  21. #21
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowColorDialog


    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


    dialog_color1.png


    dialog_color2.png
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 14:08 عصر

  22. #22
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowFolderBrowserDialog


    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

    dialog_folderbrowser2.png
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 14:26 عصر

  23. #23
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowFontDialog


    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


    dialog_font.png
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 14:29 عصر

  24. #24
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowOpenFileDialog


    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

    dialog_openfile1.png



    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;*.bm p;*.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


    dialog_openfile2.png
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 14:36 عصر

  25. #25
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowSaveFileDialog


    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;*.bm p;*.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

    dialog_savefile2.png
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 14:44 عصر

  26. #26
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetCDROMsInfo


    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 : یک شنبه 07 خرداد 1402 در 14:42 عصر

  27. #27
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetComputerSystemInfo


    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 : یک شنبه 07 خرداد 1402 در 14:47 عصر

  28. #28
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetDesktopMonitorsInfo


    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 : یک شنبه 07 خرداد 1402 در 14:49 عصر

  29. #29
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetDiskDrivesInfo


    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 : یک شنبه 07 خرداد 1402 در 14:58 عصر

  30. #30
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetInstalledFonts


    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 : یک شنبه 07 خرداد 1402 در 15:14 عصر

  31. #31
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetInstalledSoftwaresInfo


    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

    INSTALLED_SOFTWARE.png
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 15:12 عصر

  32. #32
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetNetworkAdaptersinfo


    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 : یک شنبه 07 خرداد 1402 در 15:27 عصر

  33. #33
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetPhysicalMemoryInfo


    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 : یک شنبه 07 خرداد 1402 در 15:30 عصر

  34. #34
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetPrintersInfo


    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 : یک شنبه 07 خرداد 1402 در 15:41 عصر

  35. #35
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetProcessorsInfo


    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 : یک شنبه 07 خرداد 1402 در 15:39 عصر

  36. #36
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetScreensInfo


    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 : یک شنبه 07 خرداد 1402 در 19:14 عصر

  37. #37
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - GetVideoControllersInfo


    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 : یک شنبه 07 خرداد 1402 در 15:43 عصر

  38. #38
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowCDROMsInfo

    این متد مشخصات همه CDROM ها را نمایش میدهد.
    فقط کاربر تست و آموزشی دارد.



    ShowCDROMsInfo()



    کد نمونه:

    Sub Example_A()


    v.ShowCDROMsInfo


    End Sub
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 15:52 عصر

  39. #39
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowComputerSystemInfo

    این متد مشخصات سیستم را نشان میدهد.
    فقط کاربرد تست و آموزشی دارد.

    ShowComputerSystemInfo()



    کد نمونه:

    Sub Example_A()


    v.ShowComputerSystemInfo

    End Sub
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 15:55 عصر

  40. #40
    کاربر دائمی آواتار mazoolagh
    تاریخ عضویت
    اردیبهشت 1384
    سن
    71
    پست
    3,030

    Mazoo Utils for VBA - ShowDesktopMonitorsInfo

    این متد مشخصات همه مونیتورها را نشان میدهد.
    فقط کاربرد تست و آموزشی دارد.
    در بعضی مواقع ممکن است در یک سیستم چند مانیتوری اطلاعات بعضی مانیتورها نمایش داده نشود.

    ShowDesktopMonitorsInfo()



    کدنمونه:

    Sub Example_A()


    v.ShowDesktopMonitorsInfo

    End Sub
    آخرین ویرایش به وسیله mazoolagh : یک شنبه 07 خرداد 1402 در 15:59 عصر

صفحه 1 از 2 12 آخرآخر

تاپیک های مشابه

  1. سوال: کاربرد dllهای : SabteAhvalLibrary , FarsiLibrary.Utils
    نوشته شده توسط y.saied در بخش VB.NET
    پاسخ: 0
    آخرین پست: چهارشنبه 16 بهمن 1392, 08:40 صبح
  2. سوال: مشکل تاریخ شمسی با کامپوننت FarsiLibrary.Utils.dll در Asp.net
    نوشته شده توسط si6arp در بخش ASP.NET Web Forms
    پاسخ: 4
    آخرین پست: سه شنبه 16 آبان 1391, 22:53 عصر
  3. حرفه ای: دانلود سورس تابلوی تبلیغاتی Led و سورس office 2007
    نوشته شده توسط farboodj1375 در بخش برنامه نویسی در 6 VB
    پاسخ: 8
    آخرین پست: شنبه 28 خرداد 1390, 11:12 صبح
  4. پاسخ: 9
    آخرین پست: یک شنبه 01 خرداد 1390, 19:11 عصر

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •