هشدار مهم پلیس فتا

بهمن 1400 : 

هشدار مهم: هر پیام حاوی لینک از شماره شخصی با مضمون شکایت علیه شما جعلی و به قصد خالی کردن حساب شماست. لطفا کلیک نکنید.

از صحت درگاه ها حتما اطمینان حاصل کنید و ترجیحا از کارتی استفاده کنید که مبلغ پول خیلی کمی در آن دارید

هشدار: سامانه ثنا از شماره شخصی پیامک ارسال نمی‌کند، به هیچ وجه روی لینک‌های ارسالی کلیک نکنید، بدانید که: کلیک=خالی شدن حساب

در نشست خبری فیلم سینمایی «نمور» که در در واپسین روز چهلمین جشنواره فیلم فجر برگزار شد، یکی‌از خبرنگاران حاضر در نشست از نوشین معراجی نویسنده فیلم «نمور» پرسید: باتوجه به حلال‌زاده نبودن یکی از شخصیت‌های فیلم، چرا این اثر به مقام مادر تقدیم شده است؟ و معراجی در پاسخ گفت: «وقتی دو نفر همدیگر را دوست دارند، عشقی که بین‌شان وجود داشته، آن قدر حرمت دارد که به‌نظر من بچه‌ای که از آن‌ها به دنیا می‌آید حلال‌زاده است! »

عیدی دولت و حکومت در تولید ملی  : بهمن 1400

مبلغ وام فرزندآوری به ازای فرزند اول ۲۰ میلیون تومان، به ازای فرزند دوم ۴۰ میلیون تومان، به ازای فرزند سوم ۶۰ میلیون تومان، به ازای فرزند چهارم ۸۰ میلیون تومان و به ازای فرزند پنجم و بیشتر  از آن، ۱۰۰ میلیون تومان است.

فرمانده سپاه ثارالله استان کرمان با اشاره به اینکه ترویج مکتب شهید سلیمانی مصونیت آور است و برای جامعه وحدت ایجاد می‌کند گفت: مدیر اسلامی باید در بین مردم حضور داشته باشد و به مردم نوکری کند و مدیری که به‌دنبال آقایی کردن باشد ( روحانی نعوذ بالله) به درد حکومت اسلامی نمی‌خورد.

حجت الاسلام مسعود عالی استاد حوزه در اظهاراتی از نوشین معراجی، فیلمنامه‌نویس «نمور» در پی مواضع اخیرش در خصوص روابط زن و مرد به شدت انتقاد کرد و گفت: آن خانم داوری که در جشنواره حرف ازدواج سفید را زد، مسئولین ارشاد تو دهنش باید می‌زدند. تو غلط میکنی ...

مراسم ازدواج نازنین جعفریان مدل ایرانی الاصل پر زرق و برق ترین مراسمی بود که با ثروتمندترین سیاه پوست برگزار کرد.

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

سه مدیر دولتی که قبلا به عنوان متهم در پرونده اتوبوس خبرنگاران معرفی شده بودند، از سوی بازپرس ارومیه تبرئه شدند.

سید علی خشگمین می شود ، 28 بهمن 1400 : رهبر معظم انقلاب فرمودند: امروز نوبت سپاه است که ، به سپاه تهمت بزنند و لجن‌پراکنی کنند و در ضمن به شهید بزرگ شهید سلیمانی، و اگر جرات می کردند و از خشم مردم نمی‌ترسیدند به امام هم اهانت می‌کردند.

حمید حسینی، عضو اتاق بازرگانی: مدیران برخی شرکت هایی که کار مهاجرت انجام می‌دهند، شخصا به من اعلام کردند که قبلا هفته ای سی تا چهل درخواست برای مهاجرت داشتند که از سوی افرادی با تخصص های بالا و درس خوانده ارائه می شد اما در شرایط فعلی تعداد این درخواست برای این شرکت‌های معمولی به ۱۸۰ درخواست رسیده است که نشان از افزایش میل به مهاجرت در ایران دارد.جالب است در میان متقاضیان مهاجرت از لوله کش تا کابینت‌ساز و آشپز و برق کار و آرایشگر و ... نیز دیده می شوند،این یعنی اگر تا دیروز فقط درس خوانده‌ها می خواستند از ایران بروند، امروز صاحبان حرف و افرادی که حرفه‌ای را بلدند نیز متقاضی مهاجرت هستند و این نشانه‌های باید سیاستگذار را نگران کند.

روح الامینی، نماینده مجلس گفت: قبلا توقع‌ها کمتر بود؛ مردم از سرویس‌های بهداشتی مشترک استفاده میکردند. الان همه به دنبال تجهیزات و وسایل مستقل هستند. توقع‌ها باید تنظیم شود.

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

رستم قاسمی : به خانوارهایی که سه تا چهار فرزند داشته باشند، زمین مجانی برای ساخت مسکن داده می‌شود.

البته رستم خان قاسمی فکر نکرده که قشر کارگر حقوق بگیر ۵ میلیونی با ۳ تا ۵ فرزند چطوری و با کدام درآمد می تواند هزینه  ساخت و ساز را فراهم نماید.

تصویر زیر گویای این است که نگران نباشید ، همیشه ، حتی در سختی ها لبخند بزنید تا همه چیز درست شود چون بنیان درست است.

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

همسران بخوانند ( تجسس در گوشی ) 

► حضرت آیت الله العظمی شبیری زنجانی:

• تنها با دلیل محکم خوف از معصیت جایز است.

► حضرت آیت الله العظمی خامنه ای:

• بدون اذن و رضایت ایشان جایز نیست.

► آیت الله العظمی مکارم شیرازی:

• تجسس در گوشی دیگران حرام است.

سجاد غریبی ۲۹ ساله، ملقب به هالک ایرانی به حریف انگلیسی خود، مارتین فورد که به ترسناک‌ترین مرد جهان معروف است، هشدار دارد که مبارزه را روی برانکارد ترک خواهد کرد.

4001127100

مدیر کل خیلی جوان !!!

29 بهمن 1400 : در پی اهانت یک افسر هندی به سردار سلیمانی و رهبر انقلاب،  مردم منطقه بدگام کشمیر به خیابان‌ها ریختند و در حمایت از سردار سلیمانی شعار سردادند و با ماموران پلیس درگیر شدند و اقدام مامور هتاک را محکوم کردند. یکی از افسران هندی در حین عملیات سرشماری یکی از شهرهای کشمیر با ورود به منزل یکی از شهروندان عکس شهید سلیمانی و رهبرانقلاب را که در خانه او بود به آتش می‌کشد. 

۲۸ بهمن ۱۴۰۰ گفتگو با رفیق دوست : ( هویدا ) گفت من هنوز هم بر عقیده خودم هستم! جنگی بین ما و شما بود و شما بردید و ما را هم می‌کشید! آن وقت که این چهار نفر را برای اعدام می‌بردند، او باز سر موضعش بود! وقتی می‌خواست از پله‌ها بالا برود، گفت دست‌ها و چشم‌های مرا نبندید و همان طور هم اعدام شد. بقیه را از زیر بغل‌هایشان می‌کشیدند و می‌بردند! یادم است که خسروداد، آنچنان می‌لرزید که زانوهایش به هم می‌خورد! خسرودادی که معروف بود از دیوار راست بالا می‌رود و از ارتفاع ۱۰ متری می‌پرد، آنچنان خودش را باخته بود که حساب نداشت!...».

حرف های ضد و نقیض و گفته زیر در سایتی دیگر : کشته شد اعدام نشد

دست‌کم بر اساس گزارش روزنامه‌های وقت از جمله آیندگان می‌دانیم که جلسه دادگاه تا ساعت ۶ و نیم به طول انجامید و باز گزارش همین روزنامه می‌گوید که هویدا در ساعت ۷ و ۲۵ دقیقه هدف گلوله قرار گرفت. یعنی چیزی حدود یک ساعت از اتمام جلسه دادگاه تا تیر خوردن او فاصله بوده است. پس احتمال قریب به یقین او را به سلولش منتقل کرده بودند و شلیک گلوله از جانب خلخالی یا شخص دیگری در زمانی اتفاق افتاده که او در سلولش به سر می‌برده و نه هنگامی که در حال انتقال به سلول بوده است.

یا ممکن است از سوی ضدانقلاب بوده باشد عمال رجوی چون اوایل انقلاب مملکت حساب و کتاب و قانون درستی نداشته .

هندی‌ها بار دیگر توقیف کشتی‌ها و محموله هایی که از مبدا یا به مقصد ایران هستند، از سر گرفته‌اند.

طبق اعلام یک منبع آگاه به ایلنا ، کشتی «کابل» متعلق به شرکت ادمیرال با مالکیت «برادران شمخانی» به بهانه نقص مدارک از تقریبا ١٠ روز پیش همراه با تمام باری که در حال حمل آن بوده، به حکم یک دادگاه هندی در بندر کاندلا توقیف شده‌ است. 

رادیو پس فردا : بهمن 1400 - یکی از مسئولان سازمان بنادر و دریانوردی در همین زمینه به ایلنا گفته است از آنجایی که این کشتی با پرچم ایران در حال تردد نیست، بنابراین سازمان بنادر و دریانوردی امکان ورود به این موضوع را ندارد.

او توضیح نداده است که کشتی «کابل» با پرچم چه کشوری در حال تردد بوده، اما داده‌های «مرین ترفیک» نشان می‌دهد که این کشتی ایرانی با پرچم جمهوری لیبریا، از کشورهای آفریقای غربی، در حال تردد بوده است.

در این اطلاعیه آمده‌است: ساعت ۳ و ۲۷ دقیقه بامداد یک شنبه اول اسفند ماه راننده یک دستگاه خودروی تریلی که دچار ناراحتی روحی شده بود، اقدام به شکستن درب ۶ مسجد مقدس جمکران کرد و قصد ورود به صحن جامع مهدوی را داشت که ماشین وی متوقف و از حرکت باز ماند.

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

گفتنی است این حادثه خسارت خاصی به همراه نداشت و نیروهای امنیتی در حال بررسی چرایی این اقدام راننده هستند

6 اسفند 1400 : عضو شورای مرکزی موتلفه:خانواده‌های ولایی باید با لبیک به رهبری و فرزند آوری، دشمن را ناامید کنند

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

9 اسفند 1400 : 

نماینده دوآتشه حامی طرح صیانت در توئیتی منتقدان و مخالفان این طرح را گرگ‌های مجازی و سگ‌های قلاده بلند خطاب کرد.

در ۲۱:۵۶ سه شنبه ۱۰ اسفند ۱۴۰۰

[;database;path;pwd].[tbl]

ویژگی رنگ پشت زمینه ردیف ها یک در میان در سکشن Detail

B3

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Me.Section("Detail").AlternateBackColor = RGB(240, 240, 240)

End Sub

به نمای دیزاین بروید روی سکشن Detail کلیک کنید و بر گه پراپرتی آن را بیاورید به تب Format بروید و بگردید دنبال  AlternateBackColor  از اونجا می توانید گزینه ای را انتخاب کنید یا رنگ دلخواهتون رو از جداول RGB استخراج کنید و به هگزادسیمال در این تکست باکس وارد کنید .

RGB =RED , GREEN , BLUE 

RGB(255,255,255)=#FFFFFF

اعداد داخل پرانتز به دسیمال است برای تبدیل دسیمال به هگزادسیمال عدد را بر 16  تقسیم می کنید  عدد های  خارج قسمت و مانده را در کنار هم می گذاریم البته معادل آنها را  ،  مثل A برابر 10 ، B برابر 11 تا F برابر 15 و زیر 10 همان خود عدد در نظر گرفته میشود 

255÷16=15

255-15×16=15

1515=FF

Decimal : 109

109÷16=6

109-6×16=13

Hex : 6 13 =6D  ' هگزا میشود معادل 6 و 13 کنار هم 

RGB(109,109,109)=#6D6D6D

در لینک زیر امتحان کنید 

www.w3schools.com/colors/colors_rgb

اعداد دسیمال  را داخل پرانتز جانمایی کنید و روی لینک Use this color in our Color Picker بزنید هگزا و رنگ در باکس نمایش داده خواهد شد

برای White شدن یا ازبین بردن کالر ردیف های یک در میان  ، داخل تکست باکس ویژگی  Alternative در تب Format سکشن Detail یا Blank کنید اگر ارور ندهد یا FFFFFF# را وارد کنید یعنی (RGB(255,255,255 معادل رنگ سیفید

حال برای اینکه روی هر ردیف که کلیک می کنید کل فیلدهاش BackColor یکسان بگیرند از ConditionalFormatting یا قالب بندی شرطی استفاده می کنند البته برای هر فیلد باید یک شرط نوشت !!! نسخه اکسس تا کنون قابلیت اینکه تمام فیلدهای ردیف را رنگی یا Coloured بنماید ندارد. چه شرطی بنویسید ؟!!! روش کار : باید حتما در فرمتان یک آیدی وجود داشته باشد !!! یا کد یونیک !!! یک تکست باکس در Header تعبیه کنید و در رویداد Current فرم آنرا معادل فیلد ID یا فیلد عددی قرار دهید سپس چک کنید هر وقت به رکوردهای دیگر می روید آن تکست باکس همان ID که در آن هستید را به شما نشان می دهد ... حال به Conditional Formatting فیلد مورد نظر بروید در حالت LayOutView هم تنظیم امکانپذیر است. در آنجا یک شرط ایجاد کنید باکس مربوطه را به Expression تنظیم نمائید . عبارت شرطی شما ،  اگر نام فیلد در فرم کانتینیوس  ID و نام تکست Txt1 باشد می شود

[ID]=[Txt1]

با روش FormatConditions.Add می توان یک قالب شرطی به فیلد اضافه نمود. برای اصلاح از روش Modify بهره ببرید.

expression.Add (Type, Operator, Expression1, Expression2)

مثال : 

Field1.FormatConditions.Add acFieldValue,acEqula,"id Mod 2=0)
Field1.BackColor=RGB(255,255,255)
Field1.ForeColor=RGB(240,240,240)

 یک پراپرتی Count هم دارد که تعداد آیتم های موجود در قالب شرطی هر فیلد را میشمرد و بر پایه صفر یا Zero Base است یعنی از صفرشروع و  تا پراپرتی Count منهای یک ادامه می یابد البته تعداد آیتم ها محدود است

در Load فرم اگر لوپی در TextBox و TextBox مربوط به ComboBox لوپ می زنید که کاندیشنال فرمتینگ به فیلدها اضافه بنماید می توانید قبلش با پراپرتی Count فیلد چک کنید اگر صفر بود اضافه کند البته اگر کاندیشنال ضروری دیگری در آن نداشته باشید.

برای تعیین رنگ BackColor آیتم خاص در کاندیشنال فرمتینگ هر فیلد از پراپرتی Item که ایندکس از صفر شروع میشود استفاده کنید . نحوه استفاده (Module.Item(0 با (Module(0 فرقی نمیکنند. ایندکس کنترل ها هم Zero Base است

Controls("ID").FormatConditions.Item(0).BackColor=(0,100,200)

یک Type کاندیشنال به نام DataBar هم دارد که داده عددی را بصورت میله ای نمایش می دهد.

کافئین منجر به کم آبی بدن می‌شود و در نتیجه افزایش لخته شدن خون و همچنین کاهش عناصر کمیاب خون مانند پتاسیم می‌شود که بر عملکرد قلب و سیستم قلبی عروقی تاثیر منفی می‌گذارد. اگر اُمیکرون گرفتید از خوردن چای پرهیز کنید !!!

22 بهمن 1400 : 

23 بهمن 1400  : صبح امروز به دلیل اتصال شبکه برقِ جنبِ بازار کفاشانِ تهران ، دچار آتش سوزی شد که خوشبختانه هیچکدام از مغازه های کفش آسیب ندیده و این حادثه متوجه صنف لوازم خانگی بوده است.

23 بهمن 1400 ( مسکن ملی - مجردها ) محمودزاده در پاسخ به این سئوال که آیا در زمان برگشت پول و آورده اولیه به مجردهایی که نتوانستند در مدت زمان معین متاهل شوند، بحث پرداخت سود برای خواب سپرده و پول افراد در نظر گرفته شده، گفت: خیر، برگشت پول به افراد بدون سود است چراکه بنگاه معاملاتی باز نکرده‌ایم که واحدی را از کسی بخریم و به فرد دیگر بفروشیم و از این محل سودی کسب کنیم.

گزارش-میدانی-آیا-مردم-از-انقلاب-پشیمان/

23 بهمن 1400 : یک استاد دانشگاه در اهواز که تمایلی به معرفی خود ندارد می‌گوید: «مسئله‌ی امروز ما انقلاب نیست که بگوییم مردم پشیمان شده‌اند یا نه، بلکه موضوع اصلی این است که نظام سیاسی که پس از انقلاب بر سر کار آمد به درستی انتخاب نشد و اشکالات و تناقضات موجود در قانون اساسی نیز دقیقا به همین دلیل به وجود آمده است. ریشه‌ی بسیاری از مشکلات امروز به همین موضوع بازمی‌گردد که اصطلاحا مردم می‌دانستند چه نمی‌خواهند اما نمی‌دانستند چه می‌خواهند، حتی رهبران انقلاب هم نمی‌دانستند که پس از انقلاب باید چه کار کرد و به همین دلیل این وضعیت به وجود آمده است».

هشدار: پیامک حاوی لینک دانلود اپلیکیشن از شماره‌های شخصی، جعلی و به قصد سرقت از حساب شماست، به هیچ وجه کلیک نکنید.

در اختتامیه جشنواره فیلم فجر، اُمیکرون؛ رفته بود گل بچیند!

22 بهمن 1400 : میثم مطیعی امروز در مراسم جشن پیروزی انقلاب، در شعرش گفت: «حق مردم نه چنین صنعت خودروسازی‌ست» و سپس بینندگان با قطع ناگهانی پخش زنده مواجه شدند.

بدون سقف !!!

[;Database;Path;Pwd=].[T1]

بازیابی یا گرفتن متن داخل کنترل Edit در جعبه InputBox ( کلاس 32770# )

لطفا در صورتِ "استفاده" حتما در نظر سنجی شرکت و فاتحه ای برای پدر مرحومم قرائت بفرمائید.

فروش مطالب ارزنده زیر به غیر ممنوع و اشکال شرعی دارد ( پیوند دادن منعی ندارد ) لطفا رعایت نمائید !!!

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

Case WM_NCLBUTTONDBLCLK  '&HA3   Client درمنظقه بیرون 

        SetWindowTextA hWnd, "Dbl Clicked"

WM_NCRBUTTONDOWN 'constant : &HA4  Client درمنطقه بیرون 

Using SetWindowTextA 

EXIT FUNCTION

تبدیل متن فارسی به کدهای یونیکد برای استفاده ، در پیوندها با عنوان "کاراکتر فارسی" قرار داده شده که می توانید از آن بهره ببرید.البته کد Space را نمی دهد و کد آن 0020 است.

edit-controls

تنظیم و بازیابی تکست درتکست باکس ادیت کنترل : 

با تابع SetWindowText می توان متنی به کنترل ویرایش ارسال کرد

یک برنامه می تواند متن کنترل ویرایش را با استفاده از توابع SetWindowText یا SetDlgItemText و یا با ارسال پیام WM_SETTEXT ، تنظیم نماید. طبق این گفته با SetWindowText می توان متن به کنترل ویرایش ارسال نمود.

SetWindowTextA wparam(hwnd),"Hi Mr/Mrs"

An application installs the hook procedure by specifying the WH_CBT hook type and a pointer to the hook procedure in a call to the SetWindowsHookEx function.

برای بازیابی تمام متن داخل کنترل ویرایش اول از تابع GetWindowTextLength یا پیام WM_GETTEXTLENGTH برای تعیین اندازه بافر مورد نیاز برای نگهداری تکست استفاده بنمائید.بعد با استفاده از تابع GetWindowText یا GetDlgItemText یا پیام WM_GETTEXT برای گرفتن یا بازیابی متن اقدام نمائید.

EM_GETTEXT :

Rich Edit: If the text to be copied exceeds 64K, use either the EM_STREAMOUT or EM_GETSELTEXT message

تغییر فونت مورد استفاده در کنترل ویرایش ( Edit ) :

یک برنامه توانایی تغییر فونت را با استفاده از ارسال پیام WM_SETFONT دارد.اکثر برنامه ها این کار را در زمان فرآیند پیام WM_INITDIALOG انجام می دهند.تغییر فونت اندازه کنترل ویراش را عوض نمی کند ؛ 

محدودیت کاربر در ورود متن :

بعنوان مثالی از کاربرد EM_SETLIMITTEX (Edit Message)  و ( EN_MACTEXT  ( Edit Notification ، فرض کنید برنامه بایستی کاربر را به ورود بیشتر از 4 کاراکتر در کنترل ویرایش محدود کند . برنامه از EM_SETLIMITTEXT برای مشخص نمودن محدودیت 4 کاراکتر استفاده می نماید.اگر کاربر سعی به وارد کردن پنجمین کاراکتر نماید دستگاه کد اعلان EM_MAXTEXT را به برنامه ارسال می نماید.

پیمایش متن در کنترل ویرایش : 

ایجاد Style مورد نظر یعنی WS_VSCROLL با حذف کنترل ویرایش با استفاده از DestroyWindow و جایگزینی آن با ایجاد این کنترل در مختصات قبلی ( CreateWindowEx ) 

Dim p1,p2 As POINTAPI

Dim  EditRect As Rect

hFont=SendMessageA(hEdit,WM_GETFONT,0,0)

GetWindowRect hEdit,EditRect

DestroyWindow hEdit

With EditRect

p1.x=.Left : p1.y=.Top

p2.x=.Right :p2.y=.Bottom

ScreenToClient EditRect,p1

ScreenToClient EditRect,p2

.Left=p1.x : .Top=p1.y

.Rigth=p2.x : .Botton=p2.y

 End With  ' Edit Control Types and Style

برای اضافه کردن Scroll bar افقی از استایل WS_HSCROLL و اسکرول بار عمودی از WS_VSCROLL استفاده بنمائید.یک کنترل ویرایش با اسکرول بارها پیام های اسکرول بار خودش را انجام می دهد یا پروسس می کند.

 Scroll Bars

سیستم سه پیام  که برنامه می تواند به کنترل ویر ایش دارای Scroll bar ها ارسال کند را فراهم می نماید.پیام EM_LINESCROLL می تواند بصورت هم افقی و هم عمودی در کنترل ویرایش چند خطه ( MUTILINE ) پیمایش کند ( در خطوط جابجا شود ) . پارامتر lParam شماره تعداد؟ خطوط برای پیمایش عمودی که از خط جاری شروع می شود را مشخص می کند و پارامتر wParam تعداد کاراکترها برای پیمایش افقی ، شروع از کاراکتر جاری را مشخص می نماید. کنترل ادیت پیام دانش تشخیص پیمایش افقی ، اگر استایل EM_CENTER یا EM_RIGHT داشته باشد را ندارد.

پیام EM_LINESCROLL فقط در کنترهای ویرایش چند خطه کاربرد دارد.

پیام EM_SCROLL  کنترل ادیت را عمودی پیمایش می کند.پارامتر wParam عمل پیمایش را مشخص می نماید.پیام EM_SCROLL فقط در کنترهای ادیت چند خطه کاربرد دارد. EM_SCROLL همان اثر پیام WM_VSCROLL دارد.

پیام EM_SCROLLCARET چیست ؟ 

SendMessage RichEdit1.handle, WM_VSCROLL, SB_BOTTOM, 0

تغییر مستطیل قالب بندی Formatting Rectangle :

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

یک برنامه می تواند مختصات مستطیل قالب بندی کنترل ویرایش را با ارسال پیام EM_SETRECT تنظیم بنماید. پیام EM_SETRECT همچنین بطور خودجوش متن کنترل ویرایش را دوباره ترسیم می نماید.برای تعیین مختصات مستطیل قالب بندی بدون ترسیم مجدد متن کنترل ، یک برنامه می تواند یک پیام EM_SETRECTNP برای کنترل ارسال نماید.برای بازیابی یا گرفتن مختصات مستطیل قالب بندی ، یک برنامه می تواند یک پیام EM_GETRECT به کنترل ارسال نماید. این پیام ها فقط برای کنترل های ویرایش چند خطی کاربرد دارد.

EM_GETLINE :

یک خط از متن کنترل ویرایش را کپی کرده و داخل بافر مشخص شده قرار می دهد. پارامتر wParam درکنترل ویرایش چندخطه یا MultiLine ایندکس لاین است که Zero Base است یعنی ایندکس اولین خط صفر است و اعداد ترتیبی است و برای خط تکی یا SingleL ine از این پارامتر صرفنظر می شود و صفر را قرار می دهید . پارامتر lParam یک بافر است ، برای سیستم Ansi تعداد به Byte نمایش داده میشود و برای unicode تعداد کاراکترهای کپی شده.

برای تنظیم رنگ BackGround برای یک کنترل ویرایش از پیام EM_SETBKGNDCOLOR استفاده بنمائید.

EM_SETCUEBANNER : '&H1501

تنظیم یک تکست محوشو در ادیت کنترل.

نشانه متنی یا Tip که توسط کنترل ویرایش نمایش داده می شود را تنظیم می نماید تا از کاربر اطلاعاتی را درخواست بنماید. در wparam یکی از دو کلمه False یا True استفاده می شود و در پارامتر lparam یک String .

در پارامتر wParam اگر True قرار دهید banner یا نشانه هر وقت که کنترلِ ویرایش فوکس میگیرد می بایست نمایش داده شود.False پیش فرض است و زمانیکه کاربر در کنترل کلیک میکند محو می شود. البته از SendMessageW فقط استفاده کنید چون unicode string هم ارسال می کند مثلا کاراکترهای فارسی که می بایست از Chrw و کد Html مربوطه هر کاراکتر استفاده کنید و حتما داخل StrPtr برای ارسال کدهای Unicode مثل زبان شیرین فارسی !!!

StrPtr : This is often used when passing in UNICODE strings.

EM_LIMITTEXT : '&HC5   محدودیت دروارد کردن کاراکتر

 SendMessageA hEdit, &HC5, 5, 0 'lparam not be used

EM_SETPASSWORDCHAR : ' &HCC 'تنظیم نمایش کاراکتردلخواه بجای کاراکترورودی

'Password InputBox

SendMessageA hEdit, &HCC, Asc("*"), 0 'EM_SETPASSWORDCHAR

تغییر رنگ کنترل Static یا Prompt پنجره با کلاس 32770# :( در اکسس 2016 )

در Caption یا Title پنجره متنی حاوی Num و Typing را ملاحظه می نمائید . با SubClass کردن کنترل ویرایش و استفاده از پیغام با کد دسیمال 258 یا WM_CHAR و با استفاده از تابع SetWindowTextA اینکار صورت گرفته.جلوی Num جواب پیام WM_GETTEXT است که با تابع SendMessageA ارسال شده ( تعداد کاراکترهای کپی شده به متغیر بافر ) و جلوی Typing نیز کد اسکی کاراکتر که wparam است قید می شود البته در اینجا از ((Chr(Clng(wparam استفاده شده  برای مشخص کردن کاراکتر، الیته یونیکد را پشتیبانی نمی کند.

Case WM_CTLCOLORSTATIC ',WM_CTLCOLORDLG

        'Set the Colors

        SetBkMode wParam, 1 

      SetTextColor wParam, RGB(255, 10, 100)

 Dim lfont

 lfont = CreateFont(22, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, "Time New Roman")

SelectObject wParam, lfont

 InputBoxProcEx = CreateSolidBrush(RGB(80, 0, 180))

        Exit Function

پس  با توابع API می توان  کاراکترها در  کنترل Edit که ماسک  شده اند ( یا پوشیده شده زیر کاراکتر دیگر مثل " * ") را گرفته یا بازیابی کرد. "هک"

تغییر رنگ در کنترل ویرایش  :

Case WM_CREATE

hBrush=CreateSolidBrush(RGB(255,255,255))

CASE &H133 'WM_CTLCOLOREDIT 307

SetTextColor wParam,cl ' RGB(100,0,250)

InputBoxProc=hBrush

Exit Function ' It Needs

Case WM_DESTROY

DeleteObject hBrush

Sample : InputBoxEx "Hi am here to do somthing !!!","Title",vbRed,"Arial"

CHARFORMATA Structure :

حاوی اطلاعات درباره قالب بندی کاراکتر در یک کنترل rich edit

Type CHARFORMATA
cbSize As Long
dwMask As Long
yHeight As Long
yOffset As Long
crTextColor As Long
End Type

SendMessageA hEdit, EM_SETSEL, start_pos, end_pos
Dim cf As CHARFORMATA

With cf
.cbSize=LenB(cf)
.dwMask=CFM_COLOR
.crTextColor=RGB(255,0,0)
End With

SendMessageA hEdit , EM_SETCHARFORMAT, SCF_SELECTION, cf

yHeight : Character height, in twips (1/1440 of an inch or 1/20 of a printer's point).

wm-command

طبق جدول لینک بالا ،  پارامتر lParam در کنترل هندلی است به پنجره آن البته نوتیفیکیشن یا اعلان نیز می فرستد چه زمان فوکس گرفتن ،  تغییر و به روز رسانی ، در EN_CHANGE  پیام هایی که دریافت شده را ملاحظه بفرمائید.

' If lparam=hRichEdit Then

'1398/07/15

SendMessageA hEdit, EM_GETCHARFORMAT,SCF_SELECTION,cf_old
cf_old.dwMask=CFM_COLOR
SendMessageA hEdit,EM_SETSEL, -1, -1
SendMessageA hEdit,EM_SETCHARFORMAT, SCF_SELECTION,cf)
SendMessageA hEdit,EM_REPLACESEL, FALSE,text
SendMessageA hEdit,EM_SETSEL, -1, -1
SendMessageA hEdit, EM_SETCHARFORMAT,SCF_SELECTION,cf_old

Debug.Print SendMessageA(lParam, 177, 0, 1)  '1
 Debug.Print SendMessageA(lParam, 176, 0, 0) '65536=1 اگر دو کاراکترانتخاب شده باشد عدد *2 می شود 

?196608/3 =65536  'سه کاراکتر انتخاب شده

  : CHARFORMAT2

Contains information about character formatting in a rich edit control. CHARFORMAT2 is a Microsoft Rich Edit 2.0 extension of the CHARFORMAT structure. Microsoft Rich Edit 2.0 allows you to use either structure with the EM_GETCHARFORMAT and EM_SETCHARFORMAT messages.

BALLOONTIP : em-showballoontip

Type EDITBALLOONTIP
cbStruct As Long 'LenB
pszTitle As String
pszText As String
ttiIcon As Long
END TYPE

EN_CHANGE & EN_UPDATE : &H300,&H400

wParam : قسمت loword حاوی شناسه کنترل ویرایش است و قسمت hiword آن مشخص کننده کد اعلان یا notification code است.

lParam : هندلی به کنترل ویرایش

پیام EN_CHANGE زمان استفاده از  استایل ES_MULTILINE ارسال نمی شود و متن از طریق پیام WM_SETTEXT ارسال می گردد.

پیام EN_UPDATE زمانی ارسال می شود که کنترل ویرایش میخواد خودش را Redraw یا ترسیم بنماید . این کد اعلان بعد از اینکه کنترل متن را قالب بندی یا Formatted کرد ، اما قبل از نمایش متن ارسال می گردد. این امکان تغییر اندازه پنجره کنترل ویرایش را در صورت لزوم فراهم می کند. پنجره والدِ ( Parent Window ) کنترل ویرایش این کد اعلان را از طریق یک پیام WM_COMMAND دریافت می نماید

Select Case uMsg

         Case WM_COMMAND

                     If Hiword(wParam)=EN_CHANGE Then 'Hex(wparam \ &H10000)

                           SetWindowTextA hwnd,"EN_CHANGE"

                  End If     

End Select

در زیر کدهای اعلان  کنترل ویرایش با شناسه 4900 گرفته شده که در نهایت باتن ok فشرده شده و صفر یعنی بسته شدن پنجره 

4900...100 ' const EN_SETFOCUS = &H100

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...501  'const EN_MAXTEXT = &H501

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

4900...400

4900...300

1...0 'Push Ok Button

4900...200 ' const EN_KillFOCUS = &H200

بعنوان پیش فرض تابع DefWindowProc رنگ های پیش فرض سیستم را برای کنترل ویرایش انتخاب می کند. کنترل های ویرایش فقط خواندنی یا غیرفعال پیام WM_CTLCOLOREDIT را ارسال نمی نمایند بجای آن ، آنها پیام WM_CTLCOLORSTATIC را ارسال می نمایند.

WM_COMMAND

Case WM_INITDIALOG

 m_redcolor=RGB(255,0,0) 'red m_bluecolor=RGB(0,0,255) 'blue m_textcolor=RGB(255,255,255) 'white text m_redbrush=CreateSolidBrush(m_redcolor)'red background m_bluebrush=CreateSolidBrush(m_bluecolor) 'blue background

Case CTLCOLOR_EDIT, CTLCOLOR_MSGBOX

  Select Case GetDlgCtrlID(hWnd)

       Case 4900 'Edit

          SetBkColor hDC,bluecolor

          SetTextColor hDC,textcolor

             hbr=m_bluebrush

          Exit Function

   End Select

RED        RGB(127,  0,  0)
GREEN      RGB(  0,127,  0)
BLUE       RGB(  0,  0,127)
LIGHTRED   RGB(255,  0,  0)
LIGHTGREEN RGB(  0,255,  0)
LIGHTBLUE  RGB(  0,  0,255)
BLACK      RGB(  0,  0,  0)
WHITE      RGB(255,255,255)
GRAY       RGB(192,192,192)

ارسال پیام به کنترل ویرایش در subClass کردن پنجره InputBox و قرار دادن در WM_SETCURSOR پارامتر wParam  هندلی است به کنترل 

Case WM_SETCURSOR  '32   
SetWindowLongPtr wStatic, GWL_STYLE, GetWindowLongPtr(wStatic, GWL_STYLE) And WS_TABSTOP
'id=4900 is for Edit Control in window Calss #32770 .... use StrPtr To Transfer Unidoe string
If wParam = OkBtn Then 'Use GetDlgIten
           SendMessageA hEdit,WM_SETTEXT, 0, ByVal   StrPtr()  'lParam as any  WM_TEXT:&HC
          ElseIf wParam = CancelBtn Then
          SendMessageA hEdit, WM_SETTEXT, 0, ByVal     'lParam as any
          ElseIf wParam = wStatic Then
          SendMessageA hEdit,WM_SETTEXT, 0, ByVal    'lParam as any  
          Else
          SendMessageA hEdit,WM_SETTEXT, 0, ByVal  'lParam as any
 End If

When you move or click the mouse over a static child window, the child window traps the WM_NCHITTEST message and returns a value of HTTRANSPARENT to Windows

WindowFromPoint : 

The return value is a handle to the window that contains the point. If no window exists at the given point, the return value is NULL. If the point is over a static text control, the return value is a handle to the window under the static text control.

if you change any of the frame styles, you must call SetWindowPos with the SWP_FRAMECHANGED flag for the cache to be updated properly

موقعیت باتن Cancel در Screen  :

GetWindowRect hhcl, btnr
    With btnr
     p1.x = .Left: p1.y = .Top
     p2.x = .Right: p2.y = .Bottom
     ScreenToClient hhwnd, p1
     ScreenToClient hhwnd, p2
     .Left = p1.x: .Right = p2.x
     .Top = p1.y: .Bottom = p2.y
     padding = (.Bottom - .Top) + 5
End With

ساخت لینک در ناحیه Static :

بدست آوردن موقعیت ناحیه Static با ID 4901 ( طبق روش بالا ) و تخریب پنجره با DestroyWindow و سپس ساخت کنترل جدید با نام SysLink و ID جدید 

syslink-control-reference-structures

طبق داکیومنت دو پیام اعلان با کنترل SysLink در ارتباطند یکی برای Mouse با کد 2- و دیگری برای KeyBoard با کد 4- یعنی NM_RETURN 

There are two notification messages associated with the SysLink control—one for the mouse (NM_CLICK (syslink)), and one for the keyboard (NM_RETURN).

طبق داکیومنت ساختار NMLINK  حاوی اطلاعات اعلان یا نوتیفیکیشن است . این ساختار را با پیام های NM_CLICK یا NM_RETURN ارسال کنید.

The NMLINK Contains notification information. Send this structure with the NM_CLICK or NM_RETURN messages.

HTNML Code : 

StrLink="<a href="https://www.w3schools.com/">Visit W3Schools.com!</a>"

<a href="https://www.qries.com/"><img alt="Qries" src="https://www.qries.com/images/banne _logo.png" width=150" height="70"></a>

Static Style

WM_NOTIFY

توسط یک Common Control به پنجره والدش زمانیکه رویدادی رخ می دهد ارسال می شود.

Sent by a common control to its parent window when an event has occurred or the control requires some information.

قسمت lParam به ساختار NMHDR اشاره می کند که شامل کد اعلان است.

EN_LINK Notification Code

Dim el As NMLINK
     CopyMemory el, ByVal lParam, LenB(el)
         Select Case el.hdr.nCode
            Case (-2)
               SetWindowTextA hWnd, el.item.iLink
         End Select
CopyMemory lParam,ByVal el, LenB(lParam)

       If el.item.iLink = 0 Then ShellExecute 0, "Open", "D:\pik.png", 0, 0, 4

use-syslink-notifications

در لینک بالا استفاده از اعلان های SysLink بیان شده در تصویر زیر نیز nCode استراکچر NMHDR در پنجره immediate window VBE چاپ شده و تصویر زیرین آن از کد 2- استفاده شده وقتی روی هر کدام از لینک ها کلیک می شود کد index ( ساختار LITEM ) مربوطه در Caption و کنترل Edit نمایش داده می شود . ( با موفقیت تست شده با تصویر ارائه گردید.)

Const NM_CLICK = -2
Const NM_DBLCLK = -3
Const NM_RETURN = -4
Const NM_SETFOCUS = -7
Const NM_SETCURSOR = -17
Const NM_CUSTOMDRAW = -12
Const NM_HOVER = -13
Const NM_LDOWN = -20
Const NM_RDOWN = -21

COMCTL

Free Memory

CopyMemory lParam, ByVal nmh, LenB(lParam)
CopyMemory lParam, ByVal nml, LenB(lParam)
CopyMemory nml.item, ByVal tItem, LenB(nml.item)

WM_NOTIFY'

 Case (-1249)

            SetWindowTextA hWnd, nmh.idFrom

            End Select

تغییر رنگ تمام HyperLink ها در WM_NOTIFY و استفاده از ساختار NMCUSTOMDRAW

lhittestinfo

lm-hittest   :  

If the LM_HITTEST message succeeds, the system fills in LITEM.iLink and LITEM.szID. If the LM_HITTEST message fails, do not assume that any information in LITEM is valid

about-rich-edit-controls

LITEM item{};
    item.mask = LIF_ITEMINDEX | LIF_ITEMID | LIF_URL | LIF_STATE;
    item.state = LIS_ENABLED | LIS_FOCUSED | LIS_HOTTRACK;
    item.stateMask = LIS_ENABLED | LIS_FOCUSED | LIS_HOTTRACK;
'StringcChCopyA
    wcscpy_s(item.szUrl, L_MAX_URL_LENGTH, L"http://www.google.com");
    SendMessage(syslink_handle, LM_SETITEM, 0, (LPARAM)&item);


creating-a-hyperlink

SendMessagewParam,WM_NEXTDLGCTL, 

GetDlgItem(wParam,loword(CLng(SendMessage(wParam, DM_GETDEFID, 0, 0)))), True
            

WM_NEXTDLGCTL : 

ارسال می شود به پروسیجور دیالوگ باکس برای تنظیم فوکس

کیبوردبه کنترل متفاوت در دیالوگ باکس   

DM_GETDEFID : &H400

پیام ویندوزی : بازیابی شناسه کنترل باتن فشاری پیش فرض

 برای دیالوگ باکس ،wParam و lParam در اینجا استفاده نمی شود.

اگر موفقیت آمیز باشد قسمت loword حاوی شناسه کنترل است

GetDlgItem : 

تابعی برای بدست آوردن هندل کنترل دو آرگومان دارد

اولی هندلی به دیالوگ باکس حاوی کنترل و دومی شناسه

کنترل مثلا در InputBox آیدی کنترل Ok یک و Cancel 

دو می باشد 

add-a-hyperlink-to-a-dialog

ساخت Popup Menu :

Type CHARRANGE
cpMin As Long,cpMax As Long
End Type

Type FORMATRANGE
hdc As LongPtr
hdcTarget As LongPtr
rc As RECT
rcPage As RECT
chrg As CHARRANGE
End Type

Type NMHDR
hwndFrom As Longptr
idFrom As Longptr
nCode As Long 'notification code
End Type

Type ELINK
nmh As NMHDR
Msg As Long
wParam As LongPtr,lParam As LongPtr
chrg As CHARRANGE
End Type

Dim lNMH As NMHDR
Dim lLink As ENLINK
Case WM_NOTIFY
    CopyMemory lNMH,ByVal lParam,Len(lNMH)
     Select Case lNMH.code
        Case EN_MSGFILTER
    CopyMemorylLink, ByVal lParam, Len(lLink)
If (lLink.Msg = WM_RBUTTONDOWN) Then
lhMenu=CreatePopupMenu()
 AppendMenu lhMenu, MF_STRING, 1, "&Action1"
AppendMenu lhMenu, MF_STRING, 2, "&Action2"
GetCursorPos lPt
lResult=TrackPopupMenuEx(lhMenu, TPM_LEFTALIGN Or TPM_RETURNCMD _ Or TPM_RIGHTBUTTON,lPt.x, lPt.Y,hwnd, ByVal 0&)
DestroyMenu lhMenu

Select Case lResult
Case 1
Case 2
End Select
End If
Case EN_LINK
CopyMemoru lLink,Byval lParam,LenB(lLink)
if lLink.Msg=WM_LBUTTONUP) Then
lText=GetPlainText(hwnd)
ltext=Mid(ltext,lLink.chrg.cpMin + 1, lLink.chrg.cpMax - lLink.chrg.cpMin) ShellE
ShellExecute ...
End If
End Select
Case WM_PAINT

تابع تبدیل Twips به PixelX :

Private Function TwipsToPixelX(pTwipsX As Long) As Long
Static Mult As Long
Dim hdc
If Mult = 0 Then
hdc = GetDC(0)
Mult = 1440 / GetDeviceCaps(hdc, LOGPIXELSX)
ReleaseDC 0, hdc
End If
TwipsToPixelX=CLng(pTwipsX / Mult)

End Function

Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim ps As PAINTSTRUCT
    Dim hdc As Long
    Dim strMessage As String
    strMessage = "Hello, Win32 GUI(VBA) World!"
 
    Select Case uMsg
    Case WM_PAINT
        hdc = BeginPaint(hwnd, ps)
        TextOut hdc, 0, 0, strMessage, Len(strMessage)
        EndPaint hwnd, ps
    Case WM_DESTROY
        Call PostQuitMessage(0)
    Case Else
        WindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
        Exit Function
    End Select
    WindowProc = 0
End Function
 

shell_notifyicona : 

Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const MAX_TOOLTIP As Integer = 64 '128
Public Const GWL_WNDPROC = (-4)

'loadiconmetric

Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
dwState As Long
dwStateMask As Long
szInfo As String * 256
uTimeout As Long
szInfoTitle As String * 64
dwInfoFlags As Long
End Type

Public nfIconData As NOTIFYICONDATA

' list the icon types for the balloon message..
Public Const vbNone = 0
Public Const vbInformation = 1
Public Const vbExclamation = 2
Public Const vbCritical = 3

Public Sub RemoveIconFromTray()
Shell_NotifyIcon NIM_DELETE, nfIconData
End Sub

Public Sub AddIconToTray(MeHwnd As Long, MeIcon As Long, MeIconHandle As Long, Tip As String)
With nfIconData
.hWnd = MeHwnd
.uID = MeIcon
.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
.uCallbackMessage = WM_RBUTTONUP
.dwState = NIS_SHAREDICON
.hIcon = MeIconHandle
.szTip = Tip & Chr$(0)
.cbSize = NOTIFYICONDATA_V3_SIZE
End With

Shell_NotifyIcon NIM_ADD, nfIconData

End Sub

Public Sub BalloonPopUp()

' ok, create a balloon popup..

With nfIconData

.dwInfoFlags = vbInformation

.uFlags = NIF_INFO

.szInfoTitle = "ToolTip" & vbNullChar

.szInfo = "Message" & vbNullChar

End With

' ok, write it to the system tray icon

Shell_NotifyIcon NIM_MODIFY, nfIconData

End Sub

NIF_INFO (0x00000010) :

0x00000010. Display a balloon notification. The szInfo, szInfoTitle, dwInfoFlags, and uTimeout members are valid. Note that uTimeout is valid only in Windows 2000 and Windows XP.

برای نمایش اعلان بالن  NIF_INFO و متن را در szInfo مشخص نمائید.

برای حذف اعلان بالن ، NIF_INFO و رشته خالی را در szInfo مشخص نمائید.

برای اضافه نمودن آیکون ناحیه اعلان بدون نمایش اعلان پرچم یا نشانه NIF_INFO را تنظیم ننمائید.

TTM_ADDTOOLW (Unicode) and TTM_ADDTOOLA (ANSI)

Private Sub AddToolTip()
Dim tCaretPos As POINTAP
RemoveToolTip

if IsWindow(hToolTip)=0 Then

InitCommonControls

hToolTip = CreateWindowEx(0, "tooltips_class32", 0, WS_POPUP Or TTS_BALLOON,0, 0,0,0, 0, 0, GetModuleHandle(vbNullString), 0)

 If hToolTip Then  'False 

  With tToolInfo   'Structure

.cbSize = LenB(tToolInfo)

GetWindowRect(GetFocus, .cRect) ' گرفتن ابعاد مستطیل پنجره

.hWnd = GetFocus ' گرفتن هندل کنترل 

.uFlags = TTF_TRACK 'Or TTF_ABSOLUTE

.uId = GetFocus

.lpszText = "Balloon Text "

SendMessageA hToolTip, TTM_SETTITLEA, lBallonIcon, ByVal sBallonTitle)

End With

SendMessageA hToolTip, TTM_ADDTOOL, 0, tToolInfo 

ClientToScreen GetFocus, tCaretPos 

GetCaretPos(tCaretPos)

With tCaretPos

.y = .y + 10

SendMessageA hToolTip, TTM_TRACKACTIVATE, True, tToolInfo

SendMessageA hToolTip, TTM_TRACKPOSITION, ByVal 0&,

End With 

'SetTimer Application.hWndAccessApp,0,,0,AddressOf MonitorInputBoxPos)

End If

End If

End Sub

Private Sub RemoveToolTip()
   ' bInputBoxInactive = False
   ' KillTimer Application.hWndAccessApp, 0
    DestroyWindow hToolTip
End Sub

Private hHook A Long

Function CallWndProc(ByVal nCode As Long, ByVal wParam As Long, lParam As CWPSTRUCT) As Long
If lParam.uMsg=WM_CREATE Then Debug.Print "The handle is: " & lParam.hWnd
End If
CallWndProc=CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

'As Per MSDN Documentary

Function NewWindow(ByVal lngCode As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As Long
if lngCode<0 Then 
NewWindow=CallNextHook(hHook,lngCode,wParam,lParam)
Exit Function
End If 
CallNextHook hHook,lngCode,wParam,lParam
End Function

switch (message)  'ownerdraw button
{
case WM_MOUSELEAVE:
SetWindowText(hwnd, "Leave!");
break;
case WM_MOUSEMOVE:
SetWindowText(hwnd, "Move!");
tme.cbSize = sizeof(TRACKMOUSEEVENT);
tme.dwFlags = TME_HOVER+TME_LEAVE
tme.dwHoverTime = 1;
tme.hwndTrack = hwnd;
TrackMouseEvent(&tme);
break;
case WM_MOUSEHOVER:
SetWindowText(hwnd, "Over!");
break;

خبر فوری : رهبر انقلاب فرمودند: دشمن میگوید هدفش علی خامنه‌ای است؛ ولی دروغ میگوید؛ هدف دشمن، ملت ایران است.راست میگه اگه سید علی هم نباشه بالاخره سپاه هست که امورات رو بدست بگیره بنده خدا سید علی اون دنیا هم بره مظلوم واقع میشه. 

عبداله محمدی : هشدار یک امام جمعه درباره افزایش قیمت برنج ایرانی تا کیلویی یک میلیون ریال / گرانی افسار گسیخته و مشکلات معیشتی مردم را در رنج و مشقت قرار داده است ( دهم بهمن 1400 )

کیومرث اشتریان استاد علوم سیاسی دانشگاه تهران در روزنامه شرق نوشت:«هرچه به غرب نزدیک شوید از ما دور می‌شوید». این منطق روسیه است که به‌ نظر می‌آید در فاصله معنادار «میز روسی»، در ملاقات اخیر «سران» دو کشور، هویدا شده است؛ یعنی چهره‌ای دیگر از سیاست خارجی روسیه و تحکیم پیوند روسی-اسرائیلی در مواجهه با ایران.

 بنظرم کیفیت رو باید ببرند بالا حتی اگر متریال خوب با قیمت بالا استفاده شود و آنوقت ببینیم آقا چه تدبیری خواهند نمود.به قول معروف هر چقدر پول بدهی آش میخوری !!! ( یا فراموش کرده یا .... )

ده بهمن 1400 : برخی از رسانه‌های داخل ایران اعلام کردند که تزریق واکسن آسترازنکا در مشهد ممنوع شده است که به دلیل یک مورد فوتی پس از تزریق این واکسن بوده است. اما روابط عمومی دانشگاه علوم پزشکی مشهد اعلام کرد که شایعات درباره آسیب‌زا بودن واکسن آسترازنکا واقعیت ندارد و توقف موقت تزریق آسترازنکا در مشهد به دلیل عدم موجودی مقطعی آن است.....یکی از عوارض نادر التهاب در ستون فقرات است !!!

یازده بهمن 1400 : محمد هاشمی در صفحه توییترش نوشت:« واکسن آسترازنکا از جمله واکسن‌های موثر علیه بیماری کرونا است که صدها میلیون دوز آن در دنیا و حدود ۱۱ میلیون دوز در ایران استفاده شده است. از ابتدا وزارت بهداشت اعلام کرده بود که به دلیل برخی عوارض نادر، در گروه سنی زیر ۵۰ سال سایر واکسن‌ها ارجح هستند.»

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

11 بهمن 1400 : سرپرست شرکت عمران شهرهای جدید با بیان اینکه طبق بررسی‌ها قیمت ساخت واحدهای نهضت ملی مسکن ۴ میلیون و ۷۰۰ هزار تومان در هر متر مربع تعیین شده است گفت: اولویت ما در اجرای پروژه، سازندگان داخلی هستند ولی به منظور ارتقای تکنولوژی ساخت و کاهش سرعت اجرا مذاکراتی با شرکتهای چینی و ترکیه‌ای داشته‌ایم.

11 بهمن 1400 : محمدرضا خباز در گفتگویی درباره ادعای انقلابی‌گری برخی وزرا گفت: از رفتار برخی وزرا احساس می شود، آنها نه انقلابی هستند، نه حق الناس سرشان می شود و نه حقوق مردم برای آنها ارزش دارد. چندی پیش همسر یکی از وزرای دولت سیزدهم که خیلی ادعایش نیز بالاست، برای زایمان به یکی از بیمارستان های خصوصی تهران رفت

وی افزود: نوزاد متولد شده آقای وزیر چون زودتر از موعد به دنیا آمد، تا مدت ها در دستگاه بود بنابراین هزینه بیمارستان زیاد شد. نخست انتظار داشتیم که اگر وزرای دولت سیزدهم انقلابی هستند خود و بستگان‌شان به بیمارستان های دولتی مراجعه کنند، نه به بیمارستان خصوصی پرهزینه. ثانیا با وجود تخفیف فراوان، بیمارستان نهایتا فاکتور ۲۸۰ میلیون تومانی برای آقای وزیر صادر کرد که او باید این مبلغ را پرداخت می کرد اما آقای وزیر فقط با پرداخت یک میلیون تومان، نوزاد را ترخیص کرد.

ملت چه پول هایی که ندارند ماشالله کدوم بیمه است که سقف زایمانش 280 میلیونه یا هزینه بیمارستانیش ؟؟؟؟ و مشخصه به بیمارستان دولتی اعتقادی ندارند چرا چون همه آموزشی اند دکتر باسواد و باتجربه در بیمارستان دولتی یا جراحی نمی کنه یا بعنوان نمادین و دریافا تسهیلات دولتی مجبور به این کاره !!!

12 بهمن 1400 : روز گذشته خبر رسید که یک نفر ۳۰۰۰ واحد مسکن مهر در اختیار دارد؛ این در حالی است که ارزش این تعداد واحد در اوایل دهه ۹۰ به کمتر از ۸۰ میلیارد تومان می‌رسید، حالا اما به دلیل برخورداری مالک این تعداد واحد از زیرساخت‌ها و امکانات دولتی، صاحب حدود ۳۰۰۰ میلیارد تومان سرمایه است. احمدی نژاد و روحانی انقلابی مبارک باد دهه زجر!!!

14 بهمن 1400 : این در حالی بود که امروز بنا به درخواست رئیس جمهور، سیدحسن خمینی قبل از وی به ایراد سخن پرداخت اما در همین هنگام شبکه خبر ضمن قطع برنامه زنده، به پخش ادامه برنامه‌های عادی پرداخت و پس از شروع سخنان رئیس‌جمهور، مجددا پخش زنده را از سر گرفت!

14 بهمن 1400 : فرزندان شهید سلیمانی به عیادت محمد کاسبی بازیگر پیشکسوت سینما و تلویزیون رفتند و انگشتر سردار دلها را به این هنرمند اهدا کردند.

بهمن 1400 : احمدی نژاد در دیدار با جمعی از فرهنگیان که پنجشنبه گذشته، هفتم بهمن انجام شد، اخراج برخی اساتید دانشگاه را به شدت مورد انتقاد قرار داد

بهمن 1400 : حمله یکی از اراذل و اوباش در شیراز به یک مامور پلیس و بریدن شاهرگ او، در فضای مجازی بسیار پربحث شده است. انتشار فیلم تکان‌دهنده این حادثه، این سوال را برای مخاطبان ایجاد کرده است که واقعا چرا سروان علی‌اکبر رنجبر با وجود اینکه اسلحه در دست داشت، به سمت مهاجم مسلح شلیک نکرد؟ پیش از این اتفاق نیز اخبار متعدد از گرفتاری بسیاری از محیط‌بان‌ها بدلیل شلیک به سمت شکارچیان غیرمجاز، این گزاره را پررنگ‌تر می‌کند که اساسا محافظان محیط زیست سلاح دارند ولی گویی نباید از آن استفاده کنند.

۱۷ بهمن 1400 :  با وجود سیر نزولی قیمت دلار، نرخ خرده فروشی انواع برنج خارجی در بازار مصرف همچنان در حال افزایش است به‌نحوی که قیمت برنج هندی و پاکستانی به مرز ۳۳تا ۳۵هزار تومان رسیده است. پیش از این نرخ برخی انواع برنج مرغوب ایرانی از ۹۵هزار تومان عبور کرده بود.

18 بهمن : علیرضا مرندی وزیر پیشین بهداش، درمان و آموزش پزشکی در یک برنامه تلویزیونی در شبکه سلامت ضمن دعوت از مردم برای دریافت دزهای واکسن کرونا، از دریافت دُز سوم واکسن کرونا توسط رهبر انقلاب خبر داد و گفت: همانطور که مقام معظم رهبری سه نوبت واکسن‌شان را تزریق کرده‌اند و واکسن ایرانی و برکت هم زدند، ما هم باید همین‌کار را بکنیم، آن‌هایی که واکسن نزدند عجله کنند.

تبدیل تاریخ میلادی شمسی - اختلاف روزهای شمسی از سال 1300 تا کنون

امام جمعه قم ( حسینی همدانی ) با اشاره به اقامه نماز رییس جمهوری اسلامی ایران در کاخ کرملین گفت: احتمال این وجود دارد که رییس جمهور ما در کاخ سفید هم نماز بخواند زیرا این نمازی که در کاخ کرملین خوانده شد پیام های مهمی در پی داشت.

بررسی روش های تبدیل میلادی به شمسی و معایب آن بصورت کاملا تخصصی 

بررسی اختلافِ روزها از  سال 1300 تا تاریخ شمسی بزرگتر از این تاریخ

بررسی روزِ هفته یِ تاریخ شمسی مورد نظر و مروری بر تابع پربرکت WeekDay در اکسس

بررسی تابع بابرکت Choose  در اکسس 

بررسی سن فرد

با ما باشید حتی اگر Vba نمی دانید مباحث در انتها شیرین خواهد شد 

دوستان گرامی لطفا پس از مطالعه در نظرسنجی شرکت کرده و در صورت لزوم زیر مطلب نظر دهید با تشکر

dDate : "2021/01/04"  ....  1400/10/14

گرفتن سال ، ماه و روز بصورت جداگانه با توابعی که اکسس در اختیار ما قرار داده 

YY=Year(dDate)=2021

MM=Month(dDate)=1

DD=Day(dDate)=4

 Every year that is exactly divisible by four is a leap year, except for years that are exactly divisible by 100, but these centurial years are leap years if they are exactly divisible by 400. For example, the years 1700, 1800, and 1900 are not leap years, but the years 1600 and 2000 are

هر سالی که دقیقا بر 4 بخش پذیر باشد ، سال کبیسه است ( Leap Year ) ، جز سال هایی که بر یک قرن که 100 سال است بخش پذیر باشد . اینها در صورتی کبیسه هستند که  دقیقا بر 400 بخش پذیر باشند. مثلا سال های 1700 ، 1800 و 1900 کبیسه نیستند ولی 1600 و 2000 کبیسه هستند.

پس سال 2022 کبیسه نیست و ماه فوریه 28 روز است .

 تابع زیر تاریخ میلادی را داخل دابل کوتیشن می گیرد و مقدار Boolean را بر می گرداند.اگر کبیسه نباشد مقدار برگشتی False است.

IsLeapYear(dDate As Date) As Boolean

Dim GetYear As Long

GetYear=Year(dDate)

IsLeapYear=?

'select  iif(612 mod 100=0,iif(612 mod '400=0,True,False),iif(612 mod 4=0,True,False))

?IsLeapYear("2021/01/04"

False

Leap years within your range:1600~2004

1600, 1604, 1608, 1612, 1616, 1620, 1624, 1628, 1632, 1636, 1640, 1644, 1648, 1652, 1656, 1660, 1664, 1668, 1672, 1676, 1680, 1684, 1688, 1692, 1696, 1704, 1708, 1712, 1716, 1720, 1724, 1728, 1732, 1736, 1740, 1744, 1748, 1752, 1756, 1760, 1764, 1768, 1772, 1776, 1780, 1784, 1788, 1792, 1796, 1804, 1808, 1812, 1816, 1820, 1824, 1828, 1832, 1836, 1840, 1844, 1848, 1852, 1856, 1860, 1864, 1868, 1872, 1876, 1880, 1884, 1888, 1892, 1896, 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, 2000, 2004

سرآغاز گاهشماری ایران روز جمعه «۱ فروردین سال ۱ هجری خورشیدی» (۲۹ شعبان ۱ سال پیش از هجرت)^[۷] برابر با ۱۹ مارس ۶۲۲ میلادی قدیم (یولیانی) و ۲۲ مارس ۶۲۲ میلادی جدید (گرگوری) است؛ یعنی، ۱۱۹ روز پیش از مبدأ گاه‌شماری هجری قمری و ۱۷۹ روز پیش از هجرت.^[۸]

کبیسه گیری گاه شمار رسمی ایران : 

تقویم رسمی کنونی ایران معمولاً هر چهار سال یکبار کبیسه می‌شود و برای جبران کسر سال حقیقی، در آغاز هر دورهٔ ۲۹، ۳۳ یا ۳۷ساله، یک کبیسه پنج ساله وجود دارد. در یک فراز پنج هزارساله، ما به ازای هر دورهٔ ۳۷ساله، نزدیک به پنج دورهٔ ۲۹ساله و تقریباً ۲۰ دورهٔ ۳۳ساله وجود دارد. ترتیب و توالی کبیسه‌ها قاعده‌مند نیست. چنانچه لحظه تحویل سال خورشیدی بعد از ظهر ۳۶۶اُمین روز از سال باشد، آن سال کبیسه و روز بعد نوروز است.^[۱۴]

برای تشخیص سال‌های کبیسه در گاهشماری رسمی ایران شیوه کاملاً یکنواختی وجود ندارد. برای سال‌های ۱۲۴۴ تا ۱۳۴۲ چنانچه باقی‌ماندهٔ حاصل تقسیم سال مورد نظر بر عدد ۳۳، یکی از اعداد (۱، ۵، ۹، ۱۳، ۱۷، ۲۱، ۲۶ و ۳۰) باشد آن سال کبیسه خواهد بود.^[۷] و برای سال‌های اخیر (سال‌های ۱۳۴۳ تا ۱۴۷۲)، به‌جای ۲۱، باقی‌ماندهٔ ۲۲ ملاک خواهد بود

جدول اعداد تعیین‌کننده کبیسه «تقویم حسابی بهروز-بیرشک» تا سال ۳۲۹۳ هجری خورشیدی حسابی

۰ – ۴ – ۸ – ۱۲ – ۱۶ – ۲۰ – ۲۴ (۲۵) – ۲۹ – ۳۳ – ۳۷ – ۴۱ – ۴۵ – ۴۹ – ۵۳ – ۵۷ (۵۸) – ۶۲ – ۶۶ – ۷۰ – ۷۴ – ۷۸ – ۸۲ – ۸۶ – ۹۰ (۹۱) – ۹۵ – ۹۹ – ۱۰۳ – ۱۰۷ – ۱۱۱ – ۱۱۵ – ۱۱۹ (۱۲۰) – ۱۲۴

مانده سال شمسی مورد نظر تقسیم بر 128 اگر یکی از اعداد بالا بود آن سال کبیسه است و برای سال های 1 تا 473 گفته اعداد داخل کمان مد نظر است.

البته گفته شده چون در چند دوره 33 ساله قرار گرفته ایم مانده عدد تقسیم بر عدد 33 اگر اعدادی در بازه 1 ، 5 ، 9 ، 13 ، 17 ، 21 ، 26 ، 30  بود آن سال کبیسه است البته اگر عدد 22 شد کبیسه ۵ ساله می شود.

سال 1300، 1304 ، 1309 کبیسه هستند.

128 : 1,309−1,280=29 

1,375−1,280=95

33    : 1,309−33×39=22    کبیسه پنج ساله

33    : 1,375−41×33=22   کبیسه پنج ساله

سالهای 1399 و 1403 کبیسه 4 ساله و سال 1408 کبیسه پنج ساله هستند چون مانده  تقسیم  1408 بر 33 عدد 22 است.

1,408−42×33=22

1,408−11×128=0  طبق جدول

یک راه قرار دادی دیگر که رایانه ای است و سریع قابل محاسبه است نیز داده شده 

(۱۳۹۱+۲۳۴۶)×(۰/۲۴۲۱۹۸۵۸۱۵۶) =۹۰۵/۰۹۶۰۹۹۲۹۱

اگر عدد اعشار که درمثال بالا 0.096099291 از عدد 0.24219858156 کمتر بود آن سال کبیسه است یا 

(1,408+2,346)×0.2421985815=909.213474951 

که عدد اعشاری کمتر از عدد اعشاری ضرب شده است و بنابراین سال کبیسه است البته تا 2346 اعتبار دارد.

پس طبق موارد گفته شده در بالا هر کدام که بهتر بود را انتخاب نموده و تابعی بنویسید تا کبیسه بودن یا نبودن را مشخص نماید 

تاریخ 1/1/1 برابر است با 22 مارس 622 میلادی ... برای بدست آوردن اختلاف روز میلادی در دو بازه این تاریخ و تاریخ میلادی مد نظر را بدست می آورید و بعد می توانید از یک Counter استفاده کنید که یکی یکی increment شود و به 1/1/1 اضافه شود واگر سالی کبیسه بود برج 12 آن 30 روزه در نظر گرفته شود.

Function IsShamsiLeapYears(y As Integer) As Boolean

Select Case y Mod 33

     Case 1, 5, 9, 13, 17, 21,22, 26, 30  'No : 22  Leap 5 

     IsShamsiLeapYears = True

End Select

End Function

?IsShamsiLeapYears("1407")

False

?IsShamsiLeapYears("1408")

True

Function IsShamsiLeapYears1(y As Integer) As Boolean

Select Case y Mod 128 And (y <= 3293 or y>473)

     Case 0, 4, 8, 12, 16, 20, 24, 29, 33, 37, 41, 45, 49, 53, 57, 62, 66, 70, 74, 78, 82, 86, 90, 95, 99, 103, 107, 111, 115, 119, 124

     IsShamsiLeapYears1 = True

End Select

Select Case y Mod 128 And (y>1 Or y <= 473)

     Case 25, 58, 91, 120

     IsShamsiLeapYears1 = True

End Select

End Function

Function GetMiladiDays(M)

Select Case M

   Case 1, 3, 5, 7, 8, 10, 12: DD = 31: Case 4, 6, 9, 11: DD = 30: Case 2: DD = 28

End Select

GetMiladiDays = DD

End Function

Function GetShamsiDays(M)

Select Case M: Case 1 To 6: DD = 31: Case 1 To 11: DD = 30: Case 12: DD = 29: End Select

GetShamsiDays = DD

End Function

غیر از روش Counter بالا که یکم کند ولی دقیق است ،  راه دیگری پیشنهاد شده ولی می بایست در صحت و سقم آن کنکاش بیشتری نمود

روش به این ترتیب گفته شده که در حالتی که دو تاریخ کبیسه نیستند .تعداد روزها از اول فروردین تا 10 دی برای سال های غیر کبیسه میلادی که میشود 

6×31+3×30+10=286

تعداد روزها از اول فروردین تا 11 دی برای سال های کبیسه میلادی که میشود 

6×31+3×30+11=287

365-286=79

365-287=78

البته12 هم اول ژانویه میشود مثل سال 1293 میلادی  پس در عملکرد مناسب ماژول زیر باید کنکاش بیشتری کرد.

در نتیجه چون دو سال 1293 میلادی و 671 شمسی کبیسه نیستند لذا اول ژانویه بایدبرابر 10 دی شود درحالیکه 12 دی شد پس محاسبه زیرین قطعا به مشکل برخواهد خورد .

فرضا میخواهید معادل شمسی تاریخ میلادی 1997/01/20 را بیابید مراحل زیر را طی کنید البته در بعضی موارد با اختلاف یک روز می دهد  که بعدا شرح می دهیم 

1-بدست آوردن روزهای سپری شده از ماه میلادی  ، چون سال 1997  کبیسه است لذا ماه فوریه می بایست 29  در نظر گرفته شود. در اینجا 20 روز گذشته و به ماه فوریه که 2 میلادی است ربطی ندارد ولی حتما برای ماه های دیگر این نکته فراموش نشود.

Dim YY,MM,DD As single

Dim i As Integer

YY=Year(dDate)

MM=Month(dDate)

DD=Day(dDate)

For i=1 To MM

x=x+iif(i=MM And DD<GetMiladiDays(MM),DD,GetMiladiDays(MM))

Next

Debug.Print x

2-برای تعیین سال شمسی  اگر روزهای گذشته میلادی از 79 ( اختلاف اول ژانویه تا آخر اسفند در صورتیکه دو تا کبیسه نباشند ) کوچکتر بود سال میلادی را منهای 622 می نمائیم .در غیر اینصورت 621 و شاید حالات دیگر هم وجود داشته باشد می بایست چک شود. در اینجا چون کوچکتر است سال شمسی میشود 1375

if x<79 Then y=YY-622 Else y=YY-621

3-اگر سال شمسی کبیسه بود که در اینجا 1375 سال کبیسه است جمع روزهای سال شمسی 366 در نظر گرفته میشود ، در غیر اینصورت 365  .. درنهایت 79 را از آن کم کرده و به روزهای سپری شده میلادی می افزائیم در نتیجه عدد بدست آمده میشود 307=20+79-366

4-عدد 307 بدست آمده را باید در روزهای شمسی سرچ کنید که در کدام ماه می افتد در این مورد جمع ماه ها تا برج  10 عدد 306 است و تا برج 11 عدد 336 پس در ماه 11 قرار دارد ... لوپ زیر بدست آوردن ماه Simulate شده ( cc جمع ماه ها است و این لوپ به انداره مقدار ii برای تابع GetMiladiDays و شرط ادامه پیدا می کند ، شرط : تا زمانیکه جمع ترتیبی ماه های شمسی از یک تا ... کوچکتر از 307 باشد و باصطلاح False شود )  ff در اینجا 307 است.

307>306 ( 10 ) که می شود True  و بعد 307> 336(11) و می شود False و در ii=11 این لوپ خاتمه می یابد.

اگر در یک Function استفاده می کنید چون i یکبار در بالا ذکر شده در این لوپ ii استفاده کنید یا i را برابر صفر قرار دهید ( اگر صفر نکنید همان مقدار i در بالا را نقطه شروع قرار میدهد.

Dim ii As Integer

ii = 0

Do While cc < ff  '366<366 = False Exit Loop

ii = ii + 1

cc = cc + IIf(ii = 12 And IsShamsiLeaped = True, 30, GetShamsiDays(ii))

Loop

Debug.Print "Shamsi Month :" & ii

ff=307

ii=1    cc=31

ii=2   cc=62

.

.

.

ii=10  cc=306  cc<ff  306<307 True

ii=11 cc=336  cc<ff  336<307  False 'Exit Here

So ii=11 And cc=336

5-برای بدست آوردن روز باید روزهای ماه های شمسی را باهم جمع بزند تا به عددی برسد که اختلافش  با عدد 307 مثبت باشد.

ff-cc>0  307-306>0       1   True

ff-cc>0  307-336>0  -29 False

?(307-306>0)

True

?(366-336>0)

True

?(366-366>0)

False

خب روش بالا خالی از شکال نیست چون 12 دی 1293 برابر 1 ژانویه است نه 10 یا 11 دیماه که در یکسری وبلاگ ها بیان شده ... پس 12 دی برابر اول ژانویه هم می تواند باشد که بود .... با با حساب می توانید چک کنید.

در تابع زیر تعداد کبیسه های میلادی همانطور که در مطالب بالا گفته شد ، بیان شده فرضا از 1 تا سال 622 میلادی 150 کبیسه وجود دارد که از آن برای محاسبات استفاده می نمایند.

Function NumberOfLeapYears(Year As Long)

For i = 1 To Val(Year) Step 1

c = c + (IIf(i Mod 100 = 0, IIf(i Mod 400 = 0, 1, 0), IIf(i Mod 4 = 0, 1, 0)))

Next

Debug.Print c

End Function

?NumberOfLeapYears(622)

 150

?NumberOfLeapYears(2022)

 490 

در روش دیگر می توانید مبنا را بگذارید بر تاریخ خاصی 

سال های کبیسه شمسی بین 1300 تا 1441 : 

1300,1304,1309,1313,1317,1321,1325,1329,

1333,1337,1342,1346,1350,1354,1358,1362,

1366,1370,1375,1379,1383,1387,1391,1395,

1399,1403,1408,1412,1416,1420,1424,1428,

1432,1436,1441

سال های 1309 ، 1342 ، 1375 ، 1408 و  1441 جزء کبیسه های 5 ساله اند که باقیمانده تقسیم آنها به 33 عدد 22 است.

Like : 1300/01/01=1921/03/21

با تابع DateDiff در اکسس اختلاف تا تاریخ روز میلادی فرضا 2022/01/06 گرفته شد و عدد 36816 بدست آمد :

?DateDiff("d","1921/03/21","2022/01/06")

 36816

تعداد سال های کبیسه بین مبدا قراردادی ما یعنی از 1921 تا 2022 شد 25 سال : 

?NumberOfLeapYearsRange(1921,2022)

 25 

?(36816-25*366+1)-((36816-25*366)\365+1)*365

292 

OR 

?(36816-25*366+1)-75*365

 292 

?292-6*31-3*30  

 16 

1300+25+75=1400 ' سال 

10 ' ماه

16 ' روز

1978/09/11  = 1357/06/20

?(20993-14*366+1)-((20993-14*366+1)\365)*365

 175 

?175-5*31 ' 5+1 =6 ماه

 20 'روز  

1300+14+43=1357 ' سال

1981/07/20=1360/04/29

?datediff("d","1921/03/21","1981/07/20")

 22036 ' اختلاف روزهای میلادی

?NumberOfLeapYearsRange(1921,1981)

 15  ' تعداد کبیسه های میلادی دو بازه 1921تا 1981

?(22036-15*366+1)-((22036-15*366+1)\365)*365 

 122 

?(22036-15*366)\365

 45 

?122-3*31 ' 3+1=4 ماه شمسی

 29  ' روز شمسی

1300+15+45=1360 ' سال شمسی

1996/03/20=1375/01/01

?dateDiff("d","1921/03/21","1996/03/20")

 27393 

?NumberOfLeapYearsRange(1921,1996)

 19 ' تعداد کبیسه های میلادی بین 1921 تا 1996

 ?(27393-19*366+1)\365 

 56 

?(27393-19*366+1)-((27393-19*366+1)\365)*365

 0 ' چون صفر شد ماه یک و روز یک را درنظر می گیریم

?1300+19+56=1375 ' سال شمسی

 

2013/03/20=1391/12/30

?NumberOfLeapYearsRange(1921,2013) 

 23  ' تعداد سال های کبیسه 1921 تا 2013

?dateDiff("d","1921/03/21","2013/03/20")

 33602 ' اختلاف دو تاریخ میلادی که 1921 مبدا قرار دادیم

 ?(33602-23*366+1)-((33602-23*366+1)\365)*365  

 0   ?????

?(33602-23*366+1)\365

 69  ?????

 ?1300+23+69

 1392 ?????

باز هم به بن بست خوردیم 

یک راه دیگر :  اختلاف دو بازه میلادی یعنی 1921/03/21 و تاریخ جاری رابدست می آوریم و تقسیم بر 364.25 می نمائیم که تعداد سالهایی که به عدد 1300 اضافه می کنیم بدست آید.

27393\365.24=75

1300+75=1375

27393-75×365.24=0

عدد صفر بدست آمد که ماه و روز را یک میگیریم

1996/03/26=1375/01/07

27,399÷365.24=75

1300+75=1375 ' سال شمسی 

27399-75×365.24=6 '6+1 =7 روز شمسی

عدد 6 را با عدد یک جمع می کنیم میشود روز هفتم 

33602/365.24=91.999

1300+91=1391 ' سال شمسی

33602-91×365.24=365.16

همانطور که گفته شد مبدا محاسبه ما برای اضافه کردن 1300/01/01 قرار گرفت ( یعنی تعداد اختلاف روزهای میلادی 1921/03/20 و تاریخ میلادی روز یا بزرگتر از 1921 را با DateDiff در اکسس بدست آورده و با Counter به 1300/01/01 اضافه می نمائیم )

20993/365.24=57.47

1300+57=1357 ' سال شمسی

20993-57×365.24=174.32 'int(174.32)=174

174+1=175 ' با روز یک سال 1300 جمع شد

175-5×31=20 ' روز شمسی 

5+1=6 ' ماه شمسی

2016/10/31=1395/08/10
DateDiff : 34923 Days 

34923/365.24=95.61

1300+95=1395 ' سال شمسی

34923-95×365.24=225.2 ' int(225.2)=225

225+1+6×31-1×30=10 ' روز شمسی

6+1+1=8 ' ماه شمسی

'همانطور که در بالا اشاره شد مبدا 1921/03/21

1992/09/30=???

'select 'datediff("d","1921/03/21","1992/09/30")

26126 ' اختلاف روزهای میلادی 

26126/365.24=71.53

1300+71=1371 ' سال شمسی

26,126−365.24×71=193.96 'int(193.96)

193+1-6×31=8 ' روز شمسی

6+1=7 ' ماه شمسی

1921/03/21=?

'select 'datediff("d","1921/03/21","1921/03/21")

0

0\365.24=0

برای این موارد که صفر است هم باید در نظر گرفته شود که عدد بدست آمده باضافه یک شود و در لوپ جمع روزهای سال شمسی قرار بگیرد و ماه مورد نظر و روز را بدست آورد 

Function ShamsiDate(dDate As Date)

Dim Miladi As Date, Shamsi

Dim DaysDiff As Long

Miladi = "1921/03/21"

Shamsi = "1300/01/01"

DaysDiff = DateDiff("d", Miladi, dDate)

debug.Print DaysDiff

?shamsiDate("2016/10/31")

 34923 

البته تابع بالا کامل نشده و فقط اعلام شده که DaysDiff که ازتابع DateDiff گرفته شده پرینت شود.همانطور که ملاحظه می فرمائید خروجی عدد 34923 بدست آمد و این عدد باید به 1300/01/01 اضافه شود.

جمع بندی برای محاسبه از طریق 365.24 

34,923÷365.2421985815 =95.618

(34923+1)-95×365.2421985815=225.99

  226      1395/08/10

22,036÷365.2421985815 =60 .33

(22036+1)-365.2421985815×60 =122.46       

122      1360/04/29

27,393÷365.2421985815=74.99

 (27,393+1)−365.2421985815×74=366.07

 366       1375/01/01

33,602÷365.2421985815=91.99

(33,602+1)−365.2421985815×91=365.95          

 365   1391/12/30

20,993÷365.2421985815÷57.47

(20,993+1)−365.2421985815×57 =175. 19

175   1357/06/20

26,126÷365.2421985815=71.53

(26,126+1)-365.2421985815×71=194.80

194  1371/07/08

روش بالا هم بی اشکال نیست چون یک روز اختلاف در آن اجتناب ناپذیر است اگر روش شما تست نشود مثل تصویر زیر خواهد شد که اختلاف یکروز را منجر خواهد  شد:

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

1921/03/21 'مبنای ما 1300/01/01

1996/03/20 ' تاریخی که باید تبدیل شود

DateDiff=27393

NumberOfLeapYearsInRange(1921,1996)=19

19-1=18

(27393-18×366)÷365=57

57-1=56

(27393-18×366)-56×365=365

365+1=366 'چون 1300 کبیسه بود

1300+18+56=1374

1374 ' کبیسه نیست  و 365 روز دارد

چون عدد 366 بدست آمد به 1374 می افزائیم در نتیجه چون سال 74 کبیسه نیست پس 365 روز و معادل یکسال است در نتیجه سال 75 میشود و یک روز اینجا باقی میماند که میشود روز یکم فروردین 

1375/01/01

2013/03/20 

NumberOfLeapYearsInRange(1921,2013)=23

DateDiff=33602

23-1=22

(33602-22×366)÷365=70

70-1=69

(33602-22×366)-365×69=365

365+1=366

1300+22+69=1391  ' کبیسه است 

چون 1391 کبیسه است لذا 366 روزه است و در نتیجه سال همان 1391  باقی می ماند و ماه سال میشود 12 و روز نیز میشود 30 اُم ...... پس تاریخ میلادی 2013/03/20 معادل 1391/12/30 شد.

2000/03/20 =????? 137901/01

1921/03/21~2000/03/20

DaysDiff=28854

NumberOfLeapYersInRange(1921,2000)=18

18-1=17

(28854-17×366)÷365=62.005

62-1=61

(28854-17×366)-365×61=367

1300+17+61=1378

خب باروش بالا هم به بن بست خوردیم  

پس دقیق ترین روش استفاده از Counter است که تعداد اختلاف روزها را به 1300/01/01 اضافه کنیم و اینکار اگر بخواهد یک روز یک روز به این تاریخ اضافه کند یک مقدار زمانبر است ولی خب بسیار دقیق است البته کبیسه گیری شمسی نیز در این امر بسیار مهم است !!!

در مثال زیر تعداد کبیسه های شمسی از 1300 تا 1391 23 تاست که کبیسه اول ( چون اختلاف اول فروردین تا 30 اسفند 1300 ،  365 روز است ) و آخر ( سال 91 ) از آن کم شده که تا تقریبا یکسال قبلش بدست آید  91=70+21 ، سال 1391 و کبیسه است پس 366 روز میشود  همان 12/30

71-1=70

(33,602−21×366)−70×365=366

(6,574−3×366)÷365=15

15-1=14

(6,574−3×366)-14×365=366

1300+3+14=1317  ' کبیسه است 

1317/12/30

(6,575−3×366)−14×365=367

1300+3+14=1317 ' کبیسه است 

366 '1317/12/30

1         '1318/01/01

نوشتن لوپ برای کم کردن 365 یا 366 روز از اختلاف روزهای میلادی 

'1978/09/11=1357/06/20

ii=0

DaysDiff=DateDiff("d","1921/03/21","1978/09/11")

Diff=DaysDiff

Do

x=Diff-iif(IsLeapYears1(1300+i)=True,366,365)

Y=Year(dDate)+1  ' تابع  Year("1978/09/11")=1978

YY=1300+i

ii=ii+1

Loop Until Y=Year(dDate)-1

Debug.Print x

Debug.Print YY

???? Maybe Use But Not Reliable

(6,575−4×366)−13×365=366 '1300+4+13=1317/12/30

از 1921 تا 2013 =92 

Right Way   '2013/03/20

(33,602+1−22×366)−69×365=366 '1300+22×69=1391/12/30

' Loop : To Get jalali leap years from 1300

t=1300+(2013-1)-(1921+1) '1390

For i = 1300 To t '1390

x = x + IIf(IsShamsiLeapYears1(i) = True, 1, 0)

DoEvents

Num=x

If IsShamsiLeapYears1((1390)) = True Then Num = x - 1

Next

Debug.Print Num 

?ShamsiDate()

22

کابرد Doevents  : اگر Loop نامناسبی نوشته شد که درجا بزند و انتهایی نداشته باشد  دقیقا بعلت اشتباه غلط خودمون بتوانیم با Stop از لوپ خارج شویم وگرنه سیستم هنگ می کند چون لوپ بی نهیت میخواهد اجرا شود.

e = Int((DaysDiff+1 - Num * 366) / 365) - 1

Y=1300+e+Num '1300+22+69

Debug.Print "Contant :" & e

diff = (DaysDiff+1 - Num * 366) - e * 365

Debug.Print "Diff :" & diff

?ShamsiDate("1939/03/21")

DaysDiff :6574

Y  :1317

Contant :14

Diff :366

از یک لوپ بعنوان کانتر می شود استفاده کرد که بین 1 تا عدد 366 یا بیشتر که بدست آمد یک Counter یا شمارنده ایجاد بنماید ( حالت افزایشی تکی ) .Increment مثل عبارت Counter استفاده شده در AutoNumber .

'Counter

Function ShamsiDateCounter(yy, diff)

Dim Y As Single

Dim MM, DD, i, a As Integer

For i = 1 To diff

DD = DD + 1

If DD > IIf(MM=12 And IsShamsiLeapYears1(yy) = True, 30, GetShamsiDays(MM)) Then MM = MM + 1: DD = 1

If MM > 12 Then yy = yy + 1: MM = 1

'CurrentDb.Execute ("delete from table2")

'CurrentDb.Execute ("insert into table2 (mah,rooz) values (" & MM & "," & DD & ")")

Next

Debug.Print yy & "..." & MM & "..." & DD

End Function

?ShamsiDateCounter(1378,36)

1378...2...6

?ShamsiDateCounter(1378,365)

1378...12...29

?ShamsiDateCounter(1378,366)

1379...1...1

?ShamsiDateCounter(1378,368)

1379...1...3

?ShamsiDateCounter(1378,396)

1379...2...1

از کانتر بالا نیز می توان برای چند ماه و چند روز از سال گذشته استفاده کرد . تاریخ شمسی طبق روز میلادی جاری بدست آمده و فقط یک پارامتر Optional به آن  اضافه کنید ، اگر مقدارآن True بود تاریخ شمسی را بگیرد و سپس لوپ را تا آن ماه مشخص ادامه دهد.

برای وارد کردن صحیح  ماه و روز در تکست باکس در زمان Data Entry یا زمان داده گیری ، می توان در رویداد OnExit خود تکست باکس نوشت در صورتیکه Dirty=True شد چک کند که ماه بین یک تا 12 باشد و روز هم طبق ماهی که وارد شده و کبیسه بودنش اگر نبود Undo کند و در BeforeUpdate فرم هم می توان نوشت که تکست باکس اگر خالی باشد Cance=True شود. 

پس راه من درآوردی ما بدین شکل شد :

1-مبنای محاسبه  را  تاریخ 1921/03/21 معادل 1300/01/01 قرار دادیم.

2-بدست آوردن کبیسه های شمسی بین دو بازه تاریخ میلادی البته  یک واحد از سال میلادی مورد نظر کم می کنیم و به مبنا اضافه ،  فرضا سال میلادی تبدیلی 2013 است

2012-1922=90 ' 1300+90=1390

تعداد سال های کبیسه از 1300 تا 1390 طبق لیست کبیسه ها که در بالاتر ذکر شده 22 است.اگرسال آخر کبیسه بود یک واحد از تعداد کبیسه ها کم می کنیم.

3-اختلاف روزهای دوبازه تاریخی یعنی مبنا و تاریخ تبدیلی را با تابع بسیار پربرکت DateDiff بدست می آوریم و یک واحد بخاطر جبران سال 1300 مبنا که کبیسه است و اختلاف اول فروردین آن تا 30  اسفند  آن 365 روز است ، اضافه می نمائیم . از سایت  w3Schools نیز می توانید استفاده کنید اگر سیستم ندارید مثال : 

DaysDiff=DateDiff("d","1921/03/21","2013/03/20")

پس طبق تصویر اختلاف روزهای دو تاریخ میلادی شد 33602 روز. و با یک جمع می کنید 33603

4-تعدادکبیسه در 366 را از روزهای بدست آمده کم می کنیم و بر 365 تقسیم می کنیم و عدد صحیح آنرا منهای یک می کنیم : 

(33603-22×366)/365=70.0027

Int((33603-22×366)/365)=70

70-1=69

5- 69 را با تعداد کبیسه ها جمع می کنیم میشود 91

6- حاصل عدد 69 در 365 را از حاصل تفریق تعداد کبیسه در 366 و تعداد روزها + یک میشود مانده ی ما یا Diff 

(33,603−22×366)−69×365=366

7-عدد حاصله را در یک تابع Counter گذاشتیم تا بگوید 366 روز بعد از سال 91 چه تاریخی خواهد شد .

چون 91 کبیسه است 366 اُمین روزش میشود 12/30 در نتیجه خروجی ما 1391/12/30 خواهد بود.

میشود از کانتر استفاده کرد و عدد 33602 باضافه یک  را یکی یکی اضافه کرد تا بعد از 1300 را نشان دهد ولی خب کُندِس و حدود 5 ثانیه طول میکشد تا جواب بدهد.

مثال دیگر : 2022/01/08 ( مبنا 1921/03/21 )

DaysDiff=36818

2022-1-1922=99+1300=1399

Leaps Between 1300 ~ 1399=25

چون 1399 کبیسه است پس یک واحد از تعداد کبیسه کم کنیم.

int((36,818+1−24×366)÷365)=76.80

76-1=75

(36,818+1−24×366)-75×365=660

Y=1300+24+75=1399,Diff=660

چون 1399 کبیسه است 366 از 660 کم میشود و 294 می ماند 294 اُمین روز سال هم میشود 10/18 یا 294=18+30×3+31×6 .... کانتر محاسبه بعد از 1399 را انجام خواهد داد.

1921/03/21-1939/03/20:6573

1921/03/21-1939/03/21:6574

1921/03/21-1939/03/22:6575

اول اضافه کردن یک واحد به سال مبنا که 1921 است و کسر کردن یک واحد از سال تبدیلی که 1939 است

1300+(1,939−1)−(1,921+1)=1316

مورد اول  تعداد کبیسه ها از 1300 تا 1316 ، عدد 4 است و خوشبختانه 1316 کبیسه نیست اگر بود از 4 یک واحد کسر می شد.

(6573+1-4×366)/365=14

14-1=13

(6,573+1−4×366)−13×365=365

1300+4+13=1317

سال 1317 کبیسه و 366 روزه است پس 365 اُمین روز آن 12/29 می شود 1317/12/29.

'6575

Diff=(6,575+1−4×366)−13×365=367

1300+4+13=1317 , 367 

چون 1317 کبیسه است پس 366 از 367 کم شده و یکسال به سال اضافه میشود ( تابع کانتر را ملاحظه بفرمائید ) سال میشود 1318 و روز و ماه هم یک می شود.

1318/01/01

همانطور که شرح داده شد روش آخر اگر چه حدود دو ثانیه طول می کشد ولی Reliable است البته برای زیر 365 یا 366 نیز چاره ای بیاندیشید.

در مورد زیر : 

1921/03/21~1922/03/22=366

1301/01/01

1300+1921+1-(1922-1)=1301

در 1300 تا 1301 یک کبیسه  وجود دارد

(366+1-1×366)÷365=0.002

0

if 0 Then 

Diff=DaysDiff+1 : Y=1300

End if

Counter (1300,367)

چون 1300 کبیسه است لذا 366 روزه است بعد از ارسال به کانتر باید جواب 1301/01/01 استخراج شود.

1921/03/21~1922/03/21=365

1300+(1921+1)-(1922-1)=1301

1 Leap Years ( jalali )

(365+1-1×366)=0

if 0 Then

Diff=365+1 : Y=1300

Counter(1300,365)

1300/12/30

1921/03/21~1922/06/13

DaysDiff(Use DateDiff)=449

1300+(1921+1)-(1922-1)=1301

(449+1-1×366)÷365=0

if 0 Then

Diff=449+1 : Y=1300

Counter(1300,450)

روش دیگری هم می توانید خلق کنید.

اگر روش های بالاتر را بکار ببرید اختلاف یکروز کاملا مشهود خواهد بود مثل تصویر زیر 

ملاحظه کنید کدام یک از روشها بهتر است همان را اجرا بنمائید.البته با تحقیق بیشتر و محاسبات  گوناگون !!!

لطفا پس ازاستفاده فاتحه ای برای پدر مرحومم قرائت فرمائید.

اختلاف روزهای شمسی از سال 1300 : 

شرح محاسبات  : 

1-سال شمسی را از سال مبنا که در اینجا 1300 قرار دادیم کم میکنیم 

2-تعداد کبیسه ها از 1300 تا یکسال قبل از سال شمسی مورد نظر را بدست آورده و منهای یک می کنیم 

3-اختلاف بدست آمده در مرحله یک را در 365 ضرب و به تعداد مرحله 2 می افزائیم 

4-تعداد روزهای سپری شده سال شمسی مورد نظر را بدست آورده به مرحله 3 می افزائیم . براحتی اختلاف از سال 1300بدست آمد بدون خطا ، موارد زیر نیز با DateDiff مقایسه گردید. کبیسه ها مهم هستند در محاسبات !!!

سال های کبیسه شمسی بین 1300 تا 1441 : 

1300,1304,1309,1313,1317,1321,1325,1329,

1333,1337,1342,1346,1350,1354,1358,1362,

1366,1370,1375,1379,1383,1387,1391,1395,

1399,1403,1408,1412,1416,1420,1424,1428,

1432,1436,1441

2013/03/21=1392/01/01

'jalali leap year 1300-1391=23-1=22

92×365+22+1=33603

2013/03/20=1391/12/30

'jalali leap year 1300-1390=22-1=21

91×365+21+366=33602

چون تا 12/30 میشود 366 روز لذا اضافه شده 

select datediff("d","1921/03/21","2022/01/09")

Equivalant :1400/10/19 - 2022/01/09

=36819

'jalali leap year 1300~1399=25-1=24

1400-1300=100

100×365+24=36524

36819-36524=295

295=6×31+3×30+19

100×365+24+6×31+3×30+19=36819

1357/06/20 '1978/09/11  یازدهم سپتامبر

1357-1300=57

'jalali leap year 1300~1356=14-1=13

57×365+13+(5×31+20)=20993

select datediff("d","1921/03/21","1978/09/11")

1378/10/10-1999/12/31

1378-1300=78

jalali leap years 1300~1377=19-1=18

78×365+18+(6×31+3×30+10)=28774

1378/10/11-2000/01/01

1378-1300=78

jalali leap years 1300~1377=19-1=18

78×365+18+(6×31+3×30+11)=28775

دو عدد بالا را با تصویر زیر مقایسه کنید اینهم اثبات روش 

1300~1391 'کبیسه ۲۲ منهای یک 

91×365+21+6×31+3×30+12=33524

کبیسه های میلادی از 1920 تا 2104 :

Leap years within your range:

1920, 1924, 1928, 1932, 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, 2000, 2004, 2008, 2012, 2016, 2020, 2024, 2028, 2032, 2036, 2040, 2044, 2048, 2052, 2056, 2060, 2064, 2068, 2072, 2076, 2080, 2084, 2088, 2092, 2096, 2104

 تبدیل شمسی البته بعد از سال 1300 به میلادی چون سال مبنا را 1300/01/01 معادل 1921/03/21 قراردادیم 

1921+(1391-1300)=2012

'Leap Years 1921~2011

33,524+(31+28+21)−91×365−22=367

سال 2012 کبیسه است و 366 روزه در نتیجه چون عدد 367 بدست آمد یک واحد به سال 2012 اضافه و روز و ماه نیز یک میشود  

2013/01/01

البته یادآوری میکنم تعداد کبیسه های شمسی و میلادی در بازه هایی نسبت بهم اختلاف دارند و ممکن است این اختلافات در نتیجه نهایی ما تاثیر گذار باشند مثل تصاویر اختلافی که در بالاتر قرار گرفت.

تعداد روزهای میلادی به ترتیب از سمت چپ :

31,28 or 29 31,30,31,30,31,31,30,31,30,31

1357/06/20 '1978/09/11  یازدهم سپتامبر

1357-1300=57

1921+(1357-1300)=1978

ShamsiDiff=20993

'1921/03/21=80 (31+28+31)

'Leap Years 1921~1977

20993+80-57×365-14=254

Or

20,993−365−56×365−14=174

174+80=254

1378/01/01

ShamsiDiff=28775(1300/01/01~1378/01/0)

1921+(1378-1300)=1999

'Leap Years 1921~1998=19

28775+80-78×365-19=366

سال 1999 کبیسه نیست و 365 روز دارد پس 366 اُمین روز میشود 2000/01/01

مبحث شیرینی بود پس در تبدیل ها ما 1300/01/01 را برای شمسی و معادلش 1921/03/21 را مبنا قرار دادیم و برای تبدیل شمسی به میلادی از تابعی استفاده شود که طبق معادلات قبل تر اختلاف دقیق تاریخ شمسی مد نظر با مبنا را بگیرد و در معادله بالا قرار داده شود.

بررسی تابع Weekday در اکسس

In MS Access, The weekday() function returns the weekday number for a given date. 

این تابع شماره روز هفته تاریخی را بر می گرداند که از یک یعنی یکشنبه شروع میشود و به 7 یعنی شنبه ختم میشود .در نتیجه شماره 6 میشود روز جمعه برای تاریخ میلادی مناسب است .

برای اینکه بدانیم تاریخ شمسی بدست آمده چه روزی است کافیست یک شماره به روز مبنا بدهیم ( در اینجا تاریخ میلادی مبنا روز دوشنبه 21 مارس 1921 قرار گرفت )  در تابع WeekDay که رفرنس است عدد دوشنبه 2 می باشد پس هر عددی که بدست آوردیم را باضافه این عدد می کنیم و تابعی می نویسیم که روز هفته را به فارسی بر گرداند . در تابع WeekDay عدد یکشنبه 1 است میتوان با همان تابع عدد را در متغیری ذخیره کرد .

DaysNo=Weekday(#1921/03/21#)=2

'SELECT Weekday(#1921/03/21#)

WeekDay(#1921/03/21#)=2 ' دوشنبه

جمع این عدد با  مانده تقسیم اختلاف روزها بر 7 

DaysDiff=20993 '1921/03/21~1978/09/11

2+20993 Mod 7=2+0=2 ' دوشنبه

DaysDiff=22766 '1921/03/21~1983/07/20

2+22766 Mod 7=2+2=4 ' چهارشنبه

DaysDiff=33524 '1921/03/21~2013/01/01

2+33524 Mod 7=2+1=3 ' سه شنبه

DaysDiff=31309 '1921/03/21~2006/12/09

2+31309 Mod 7=2+5=7 ' شنبه

Var1=2+DaysDiff Mod 7

Choose(Var1,"Yek","Do","3eh","4ar","5anj","jom","Shan")

از تابع Choose نیز می توان استفاده نمود :  index از یک شروع می شود.

برای بدست آوردن سن به سال ، ماه و روز می توان اختلاف تاریخ سن و تاریخ جاری  را بدست آورد و تقسیم بر 365.24 کرد و مانده را نیز تقسیم بر 30.437 نمود.

1334/03/28~1400/10/18

ShamsiDiff=24312

'jalali leap years 16

24312÷365.24=66.56  'int(66.56)=66 ' سال

24312-365.24×66=206.16

206.16÷30.437=6.64 'int(6.64)=6 ' ماه

206.16-6×30.437=23.538 'int(23.538)=23 ' روز

البته محاسبه با این روش نیز اختلاف یک یا دو روز مشهود است 

محاسبه تصویر بالا برای مشخص کردن سن بدین شکل است : 

(ShamsiDiff-jalaliLeapYears)÷365=ExtractYear

(ShamsiDiff-jalaliLeapYears)-365×int(ExtractYear)=Remain

سال مشخص شد منظور ExtractYear است . و ملاک محاسبه ماه و روز ،  ماه تولد است  یعنی اگر ماه تولد 4 باشد ماه 4 و 5 ، 31 روزه محاسبه میشود و 6 و ... ، 30 روزه . یا اگر متولد برج 7 باشید ببعد 30 روزه کم میشود می بینید باز هم احتیاج به ساخت تابع جدیدی است.یا اگر متولد فروردین باشید 1 تا 6 ، 31 روزه در نظر  گرفته خواهد شد.

اختلاف روزهای شمسی و میلادی :

1921/03/21:

1,920×365+(31+28+21)+480:1920÷4=701360

1300/01/01

1299×365+1+324:1299÷4=474460

701,360−474,460=226900

علت بازداشت وی هنوز مشخص نشده است. با این حال مرادخانی اخیرا در یک برنامه زوم شعری را به فرح پهلوی ملکه سابق ایران تقدیم کرده بود.

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

 

ایسنا نوشت:بر اساس گزارشی، یک سری ایمیل‌های افشا شده نشان می‌دهد چندین دانشمند آمریکایی و انگلیسی بر این باور بوده‌اند که ویروس کرونا به صورت تصادفی از یک آزمایشگاه ووهان به بیرون نشت کرده اما این نگرانی را داشتند که بحث بیشتر بر سر این مساله، به مبحث علم در چین آسیب وارد کند.

قبیله موسو در چین

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

چند شوهری

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

ازدواج گذری در این جامعه یکی از صورت‌های اصلی ازدواج است. به این ترتیب که زن می‌تواند همسران زیادی داشته باشد. در این قبیله مرد‌ها باید در خانه زن باشند. اما تا قبل از غروب آفتاب هر مرد باید به خانه مادرش بازگردد، اگر از این ازدواج فرزندی به‌دنیا آمد، بزرگ کردن آن به عهده خانواده مادری است.

خانه بهروز وثوقی :

امام جمعه رفسنجان عنوان کرد: جمعیت عظیمی از شهدای بسیج داریم که به‌دلیل غیرت دینی خود در صحنه به شهادت رسیدند. دشمنان دنبال این هستند که غیرت دینی را در جامعه کمرنگ کنند، اگر به جایگاه رهبری و ولایت فقیه توهین شود، برای کمرنگ‌کردن غیرت دینی است. اگر مسأله بدحجابی یا بی‌حجابی را در جامعه ترویج می‌کنند یا یک خانم را از سر بی‌دینی و نفهمی تشویق می‌کنند که دوچرخه‌سواری کند، با اینکه دوچرخه‌سواری بانوان در انظار عموم حرام است، دنبال خدشه‌دار کردن غیرت دینی مردم هستند.

وی ادامه داد: اگر افسار سگ را به دست دختر و پسر ما در کوچه و خیابان دادند برای خدشه‌دارکردن غیرت دینی است و اگر به مسائل مذهبی، نماز و روزه ما حمله کردند دیدند که غیرت دینی جامعه را از بحران‌ها نجات می‌دهد که باید خیلی به هوش باشیم و از سر این قضایا به‌سادگی نگذریم و بگوییم دختر جوان دوست دارد دورچرخه‌سواری کند! خیر، باید هوشیار باشیم و نگذاریم چنین کاری در جامعه گسترش پیدا کند.

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

لطفا نظر سنجی فراموش نشود

آیا میدانید پیامک های دارای لینک اینترنتی عمدتا به منظور کلاهبرداری و سرقت اطلاعات بصورت فیشینگ مورد استفاده قرار گرفته و سازمان ها و سایت های رسمی (مانند ثنا، عدل ایران، یارانه، واکسن و کارت سوخت) بدون اطلاع و درخواست کاربر، پیامکی دارای لینک ارسال نمی کنند؟

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