اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search
SEMO.Pa3x

تشغيل ملف صوت في الاكسس

Recommended Posts

Option Compare Database
Option Explicit

Const SND_ALIAS_SYSTEMASTERISK      As String = "SystemAsterisk"
Const SND_ALIAS_SYSTEMDEFAULT       As String = "SystemDefault"
Const SND_ALIAS_SYSTEMEXCLAMATION   As String = "SystemExclamation"
Const SND_ALIAS_SYSTEMEXIT          As String = "SystemExit"
Const SND_ALIAS_SYSTEMHAND          As String = "SystemHand"
Const SND_ALIAS_SYSTEMQUESTION      As String = "SystemQuestion"
Const SND_ALIAS_SYSTEMSTART         As String = "SystemStart"
Const SND_ALIAS_SYSTEMWELCOME       As String = "SystemWelcome"
Const SND_ALIAS_YouGotMail          As String = "MailBeep"

' playsound Params
Const SND_LOOP = &H8
Const SND_ALIAS = &H10000
Const SND_NODEFAULT = &H2 ' silence if no sound associated with event
Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing)

Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long


  
Private Sub Form_Close()
PlaySound vbNullString, ByVal 0&, SND_NODEFAULT
End Sub

Private Sub Form_Load()
PlaySound CurrentProject.Path & "\" & "DB_FILES\About.wav", vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC Or SND_LOOP
End Sub

 

اي سؤال انا حاضر، اتمنى الفائدة للجميع.

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

السلام عليكم

شكرا جزيلا أستاذ على هذا المثال الرائع 

و هذه طريقة أخرى وجدتها في منتدانا الغالي و أظنها للأخ محمد سوداني 

إضافة هذا الكود إلى وحدة نمطية

Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long

Function Playsound(sWavFile As String)
   If apisndPlaySound(sWavFile, 1) = 1 Then
   End If
End Function

و  نضع هذا الكود خلف زر أمر أو أي حدث آخر

Playsound (Application.CurrentProject.Path & "\ringin.wav")

 

شارك هذه المشاركه


رابط المشاركه
شارك
15 ساعات مضت, صالح حمادي said:

السلام عليكم

شكرا جزيلا أستاذ على هذا المثال الرائع 

و هذه طريقة أخرى وجدتها في منتدانا الغالي و أظنها للأخ محمد سوداني 

إضافة هذا الكود إلى وحدة نمطية


Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long

Function Playsound(sWavFile As String)
   If apisndPlaySound(sWavFile, 1) = 1 Then
   End If
End Function

و  نضع هذا الكود خلف زر أمر أو أي حدث آخر


Playsound (Application.CurrentProject.Path & "\ringin.wav")

 

 

حياك الله استاذ @صالح حمادي

وشكرا على اثرائك للموضوع.

للمزيد حول دالة sndPlaySoundA اضغط على اسم الدالة.

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

أسمحو لي بمداخله بسيطة .. تشبة مثال أستاذي @صالح حمادي لكن بشكل أخر

حالياً استخدم هذا الكود .. وجدة في هذا المنتدى العريق

ضع هذا الكود في راس مديول صفحة النموذج

Dim a As Boolean
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

 

وضع هذا الكود تحت زر أو أي أمر

R = sndPlaySound("C:\WINDOWS\MEDIA\ButtonQathi.wav", 1)

لاحظ أن مسار الملف الصوت هو C:\WINDOWS\MEDIA\Qathi.wav

وأسم ملف الصوت هو Qathi.wav

شارك هذه المشاركه


رابط المشاركه
شارك
2 دقائق مضت, qathi said:

أسمحو لي بمداخله بسيطة .. تشبة مثال أستاذي @صالح حمادي لكن بشكل أخر

حالياً استخدم هذا الكود .. وجدة في هذا المنتدى العريق

ضع هذا الكود في راس مديول صفحة النموذج


Dim a As Boolean
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

 

وضع هذا الكود تحت زر أو أي أمر


R = sndPlaySound("C:\WINDOWS\MEDIA\ButtonQathi.wav", 1)

لاحظ أن مسار الملف الصوت هو C:\WINDOWS\MEDIA\Qathi.wav

وأسم ملف الصوت هو Qathi.wav

 

اين الجديد في ردك اخي؟ نفس الدالة طرحها الاخ @صالح حمادي

 

اقتباس

Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long

 

شارك هذه المشاركه


رابط المشاركه
شارك

أخي @SEMO.Pa3x لا تستعجل بالرد

 أقراء الكود جيداً فهو مختلف جدا في صياغته ..

الجديد أن الكود أستاذي الغالي صالح حمادي كما قال أنك تظع دالة  Function في مديول .. والكود الذي اعطيتك ياخي .. يوضع في راس صفحة الفجول للنموذج الحالي وليس في مديول

كما أن استدعاء ملف الصوت واضح الاختلاف

فأن أصبت فمن الله وأن أخطأت فمن نفسي والشيطان ..

شارك هذه المشاركه


رابط المشاركه
شارك
6 ساعات مضت, qathi said:

أخي @SEMO.Pa3x لا تستعجل بالرد

 أقراء الكود جيداً فهو مختلف جدا في صياغته ..

الجديد أن الكود أستاذي الغالي صالح حمادي كما قال أنك تظع دالة  Function في مديول .. والكود الذي اعطيتك ياخي .. يوضع في راس صفحة الفجول للنموذج الحالي وليس في مديول

كما أن استدعاء ملف الصوت واضح الاختلاف

فأن أصبت فمن الله وأن أخطأت فمن نفسي والشيطان ..

اخي لا تناقش بما ليس لك به علم.

اقتباس

 أقراء الكود جيداً فهو مختلف جدا في صياغته ..

الدالة نفس الدالة

Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

 

لا تغرك مسميات البراميترات وغيرها مجرد مسميات لكن تبقى الدالة هي ( sndPlaySoundA ) ضمن فضاء المكتبة ( winmm.dll )

 

اقتباس

الجديد أن الكود أستاذي الغالي صالح حمادي كما قال أنك تظع دالة  Function في مديول .. والكود الذي اعطيتك ياخي .. يوضع في راس صفحة الفجول للنموذج الحالي وليس في مديول

 كما أن استدعاء ملف الصوت واضح الاختلاف

ان وضعت الكود في ( Module ) او في رأس الصفحة او في نهاية الصفحة.. سيعمل لانك تتعامل مع winAPI والذي يحدد ذلك طبيعة الدالة ( Private ) او ( Public ).

اما القيمة ( Boolean ) لكي ترجعلك قيم منطقية في حال تشغيل الصوت أو لا.

 

شارك هذه المشاركه


رابط المشاركه
شارك
في ٢٣‏/٤‏/٢٠١٩ at 23:33, SEMO.Pa3x said:

اخي لا تناقش بما ليس لك به علم.

لم أنتبه لردك ألا الأن 

غرور بالرد .. وغلضة .. ماهذا ؟؟
أين التواضع ؟؟؟

شاركت ما معي كما شارك الأخوة 
أخذت الكود من هذا المنتدى الشامخ .. فأن كان خطاء أو لا يعجبك فليس خطائي بل خطاء من قام بأنشأة ووضعة بالمنتدى
تحملت عناء وضع رد لمشاركتك حتى نثري موضوعك .. واعطيتك نتاج بحثي .. 

وكان ردك لي دون سواي هكذا .. أهاكذا يكون خلق المسلم؟

هل بردك هذا تريد أن تذل الناس .. هل هذا  من أدب الحديث؟

أما كان منك أن تضع كلام طيب فأن المسلم لا يفوح منه ألا الطيب
هب أني لا أفقة شيء وأخطاءت .. أهاكذا يكون ردك؟ 

من لا يشكر الناس لا يشكر الله

 

ثم بالله عليك كيف أعلم أني مخطئ  أن لم أناقش ؟؟؟ .. وهل يولد المرء عالماً ؟؟
 

في الأخير أقول لك جزاك الله خير .. فأنتم قدوة

تم تعديل بواسطه qathi
فأنتم قدوة

شارك هذه المشاركه


رابط المشاركه
شارك
1 دقيقه مضت, qathi said:

لم أنتبه لردك ألا الأن 

غرور بالرد .. وغلضة .. ماهذا ؟؟
أين التواضع ؟؟؟

شاركت ما معي كما شارك الأخوة 
أخذت الكود من المنتدى الشامخ .. فأن كان خطاء أو لا يعجبك فليس خطائي بل خطاء من قام بأنشأة ووضعة بالمنتدى
تحملت عناء وضع رد لمشاركتك حتى نثري موضوعك .. واعطيتك نتاج بحثي .. 

وكان ردك لي دون سواي هكذا .. أهاكذا يكون خلق المسلم؟

هل بردك هذا تريد أن تذل الناس .. هل هذا  من أدب الحديث؟

أما كان منك أن تضع كلام طيب فأن المسلم لا يفوح منه ألا الطيب
هب أني لا أفقة شيء وأخطاءت .. أهاكذا يكون ردك؟ 

من لا يشكر الناس لا يشكر الله

 

ثم بالله عليك كيف أعلم أني مخطئ  أن لم أناقش ؟؟؟ .. وهل يولد المرء عالماً ؟؟
 

في الأخير أقول لك جزاك الله خير .. فأنتم قدة

 

اعتذر ان كان ردي جارح بالنسبة الك، لان بصراحة ردك كان استفزازي جدا بالنسبة لي

لان خلال 12 سنة قضيتها في معظم لغات البرمجة لم اسمع عن كود تكون له افضلية عن غيره لانه يوضع برأس الصفحة

او في ( Module ) او دوال اثنان يختلفان في اسماء البراميترات لكن تبقى لهما نفس الوظيفة فقط الاختلاف بالمسميات.

 

اقتباس

الجديد أن الكود أستاذي الغالي صالح حمادي كما قال أنك تظع دالة  Function في مديول .. والكود الذي اعطيتك ياخي .. يوضع في راس صفحة الفجول للنموذج الحالي وليس في مديول

 كما أن استدعاء ملف الصوت واضح الاختلاف

 

ان وضعت الكود في ( Module ) او في رأس الصفحة او في نهاية الصفحة.. سيعمل لانك تتعامل مع winAPI والذي يحدد ذلك طبيعة الدالة ( Private ) او ( Public ).

اما القيمة ( Boolean ) لكي ترجعلك قيم منطقية في حال تشغيل الصوت أو لا.

 

  • Like 2

شارك هذه المشاركه


رابط المشاركه
شارك
5 دقائق مضت, SEMO.Pa3x said:

اعتذر ان كان ردي جارح بالنسبة الك

أعتذارك مقبول أخي

11 دقائق مضت, SEMO.Pa3x said:

ان وضعت الكود في ( Module ) او في رأس الصفحة او في نهاية الصفحة.. سيعمل لانك تتعامل مع winAPI والذي يحدد ذلك طبيعة الدالة ( Private ) او ( Public ).

اما القيمة ( Boolean ) لكي ترجعلك قيم منطقية في حال تشغيل الصوت أو لا.

وشكرا على التذكير والتنبية لهذه المعلومة 

 

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

السلام عليكم 🙂

 

متابع دردشة الشباب ، في موضوع شيّق 🙂

 

جعفر

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك
32 دقائق مضت, jjafferr said:

السلام عليكم 🙂

 

متابع دردشة الشباب ، في موضوع شيّق 🙂

وعليكم السلام 

أهلاً وسهلاً بأستاذنا الكبير .. والغالي في نفوسنا .. ما أحلى الدردشة عنما تكون بيننا

 

شارك هذه المشاركه


رابط المشاركه
شارك
3 ساعات مضت, qathi said:

أعتذارك مقبول أخي

وشكرا على التذكير والتنبية لهذه المعلومة 

 

شكرا لسعة صدرك واعتذر منك مرة اخرى.

  • Like 2

شارك هذه المشاركه


رابط المشاركه
شارك
3 ساعات مضت, SEMO.Pa3x said:

شكرا لسعة صدرك واعتذر منك مرة اخرى.

 

6 ساعات مضت, qathi said:

أعتذارك مقبول أخي

وشكرا على التذكير والتنبية لهذه المعلومة

برافو عليكم شباب هكذا تكون الأخوة و حسن المعاملة

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

بعد اذن اخوانى واحبائى الكرام
اولا لى تعقيب صغير من وجهة نظرى المتواضعة
ليس معنى ان يطرح احد الاخوة او احد الاساتذة الافاضل شئ ان الكل يعلمه او العكس
وليس معنى ان يتم طرح النتيجة باسلوب مخلف فى الرد انهما متشابهين او مختلفين او ان لاحدهما افضلية

كل الطرق تؤدى الى رومها 

ثم لكل شيخ طريقته 
ولكل معلم اسلوبه

ولكل مبرمج او مصمم خياله وافكارة المختلفه عن الاخر فى طريقة تناولة للكود ومعالجته حسب خياله وافكاره طبقا لمتطلباته

وهنا طريقة انا استخدمتها نفس النتيجه لكن الاسلوب فى التناول للاكواد محتلف

كل الشكر لاساتذتنا الكرام
- الاستاذ @SEMO.Pa3x :fff:

- الاستاذ @صالح حمادي :fff:

-الاستاذ @خالد سيسكو :fff:

-الاستاذ @qathi :fff:

api play sound.rar

  • Like 2

شارك هذه المشاركه


رابط المشاركه
شارك

طريقة اخرى لتشغيل الصوت بدون winAPI

 

Call Shell("C:\windows\Sndrec32.exe /play ""C:\My Documents\alarm2.wav"" /close ", 0)

 

يتم تحديد مكان الصوت واسمه داخل الجهاز كما هو مبين في هذا المثال
"C:\My Documents\alarm2.wav"

مكان الصوت في المثال هذا هو
C:\My Documents

اسم الصوت في المثال
alarm2.wav

نوع الصوت
wav

 

للأمانة منقول من الاخ فهد الدوسري

  • Like 2

شارك هذه المشاركه


رابط المشاركه
شارك
الان, SEMO.Pa3x said:

طريقة اخرى لتشغيل الصوت بدون winAPI

 


Call Shell("C:\windows\Sndrec32.exe /play ""C:\My Documents\alarm2.wav"" /close ", 0)

 

يتم تحديد مكان الصوت واسمه داخل الجهاز كما هو مبين في هذا المثال
"C:\My Documents\alarm2.wav"

مكان الصوت في المثال هذا هو
C:\My Documents

اسم الصوت في المثال
alarm2.wav

نوع الصوت
wav

 

للأمانة منقول من الاخ فهد الدوسري

انا احبذ وافضل تشغيل الصوت بالـ winAPI :yes: u  وهذا من وجهة نظرى انا التى افضلها

شكرا على المجهود الرائع فى الطرح المميز استاذ @SEMO.Pa3x :fff::signthankspin:

تم تعديل بواسطه ابا جودى

شارك هذه المشاركه


رابط المشاركه
شارك
5 دقائق مضت, ابا جودى said:

انا احبذ وافضل تشغيل الصوت بالـ winAPI :yes: u  وهذا من وجهة نظرى انا التى افضلها

شكرا على المجهود الرائع فى الطرح المميز استاذ @SEMO.Pa3x :fff::signthankspin:

 

اكيد وانا ايضا افضل الـ winAPI لانها الاسرع تنفيذا بالذاكرة.

  • Haha 1

شارك هذه المشاركه


رابط المشاركه
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • محتوي مشابه

    • بواسطه SEMO.Pa3x
      Public Class CenteredComboBox Inherits ComboBox Sub New() Me.DrawMode = Windows.Forms.DrawMode.OwnerDrawFixed Me.DropDownStyle = ComboBoxStyle.DropDownList End Sub Private Sub CenteredComboBox_DrawItem(ByVal sender As Object, ByVal e As System.Windows.Forms.DrawItemEventArgs) Handles Me.DrawItem e.DrawBackground() Dim txt As String = "" If e.Index >= 0 Then txt = Me.Items(e.Index).ToString TextRenderer.DrawText(e.Graphics, txt, e.Font, e.Bounds, e.ForeColor, TextFormatFlags.HorizontalCenter) e.DrawFocusRectangle() End Sub End Class  
      ضع الاكواد في كلاس واعمل كومبايل، وستظهر لك اداة كومبوبوكس جديدة قم بإستخدامها وستجد ان النص اصبح في الوسط
      بالتوفيق للجميع.
       
       
    • بواسطه SEMO.Pa3x
      السلام عليكم ورحمة الله وبركاته.
      كنت قد طرحت سابقا موضوع لتشغيل ملفات الصوت في الاكسس
      وكان الموضوع يتناول تشغيل الملفات التي تكون بصيغة WAV حصرا
       
      رابط الموضوع:
       
       
      درس اليوم هو حول تشغيل ملفات الصوت بصيغة MP3 في الاكسس.
       
      الدوال المستخدمة:
      mciSendStringA
      GetShortPathNameA
       
      بعض الحقوق لأصحابها
      اتمنى منكم الدعاء لي ولوالدي.
      حسنين
      Mp3Sounds_SEMO_Pa3x.accdb
    • بواسطه SEMO.Pa3x
      السلام عليكم.
      بعد جهد كبير وسهر ليالي كثيرة, وكلها محاولات بائت بالفشل لربط الـ Visual Studio .NET وقراءة البيانات بالاكسس
      وكانت متمثلة بمكتبة dll او tlb للاسف كانت هنالك عوائق ومنها لكي يتم استخدام مكتبة من نوع tlb
      كان يجب اعطائها صلاحيات مسؤول لكي تتمكن من تسجيل هذه المكتبة في HKEY_CLASSES_ROOT في الريجستري. وتستخدمها على شكل References
      وفي حال استخدام مكتبة من نوع dll كان يتطلب استخدام دالة LoadLibraryA وهذه سيعتبرها الانتي فايروس كـ ملف مريب
      خصوصا لانها تقوم بتحميل المكتبة في الذاكرة وبدون توقيع رقمي..الخ
      اليوم قمت ببرمجة شيء مختلف ومميز عبارة عن تطبيق صغير بلغة NET. يتم تمرير البيانات من الاكسس لهذه التطبيق لكي يقوم بعدها الاكسس باقتناص المخرجات من التطبيق
      بواسطة الي remote shell ثم عرضها في الاكسس مرة اخرى وكان التطبيق على تحويل التاريخ الميلادي الى هجري لكن هذه المرة بصورة ادق وافضل.
       

       
      كما نعرف جميعنا ان التاريخ الهجري يكون غير مضبوط زيادة يوم او يومين او نقصان يوم او يومين او لا يوجد زيادة او نقصان
      لذلك قمت بوضع ComboBox لهذا الأمر..
      اكتب التاريخ الميلادي في الحقل الاول ثم اكتب فارق الايام ان وجدت زيادة او نقصان او اتركها صفر كما هي او لم يوجد تغيير
       
       
      السورس كود التطبيق بلغة NET. لمن يريده.
       
      Module SEMO_Pa3x '-------------------------------------------------------- 'c0ded bY : SEMO.Pa3x 'skype : security.najaf 'facebook : https://www.facebook.com/Nisr.Aln3jaf 'gmail : isec2090@gmail.com 'last edit : 26/4/2019 '-------------------------------------------------------- Sub Main() For Each arg As String In My.Application.CommandLineArgs If arg.StartsWith("/SEMO/") Then Dim rep As String Dim splt() As String rep = arg.Replace("/SEMO/", "") splt = Split(rep, ",") Dim GET_date, GET_args As String GET_date = splt(0) GET_args = splt(1) Dim ConvertToDate As DateTime ConvertToDate = DateTime.Parse(GET_date) DateFormating(ConvertToDate.AddDays(GET_args)) DateConvert(ConvertToDate.AddDays(GET_args)) Console.WriteLine(ArabicWeekdayString(Weekday(GET_date)) & "," & LongDateString) End If Next End Sub Public LongDateString As String = String.Empty '#Region " DateConverter (dateValue As String) As String " #Region " DateConverter (dateValue As String) As String " Public Function DateConvert(ByVal dateValue As String) As String LongDateString = "" ' الاحتفاظ بالإعدادت الحالية Dim currentCulture As Globalization.CultureInfo = Threading.Thread.CurrentThread.CurrentCulture Dim con As String = "" If DateFormating(dateValue) <> "" Then dateValue = DateFormating(dateValue) '---------------------------------- Dim y As String = IIf(dateValue <> "", dateValue.Split("/")(2), "") Dim mmm() As String If y > "1300" And y < "1451" Then con = GetGregorianDate(dateValue) mmm = Split(GetGregorianDate(dateValue), "/") LongDateString = ArabicWeekdayString(Weekday(GetGregorianDate(dateValue))) & " " & mmm(0) & " " & GregorianMonthString(Val(mmm(1))) & ", " & mmm(2) End If If y > "1883" And y < "2029" Then con = GetHijriDate(dateValue) mmm = Split(con, "/") LongDateString = mmm(0) & "," & HiriMonthString(Val(mmm(1))) & "," & mmm(2) & "H" End If End If ' إستعادة الإعدادت Threading.Thread.CurrentThread.CurrentCulture = currentCulture Return con End Function #End Region #Region " GetHijriDate(GregorianDate As String) As String " Private Function GetHijriDate(ByVal GregorianDate As String) As String Try Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo("ar-eg") Dim hijriDate As String = String.Empty 'Start Date is 10-31-1883 Dim DaysPan As Integer = DateDiff(DateInterval.Day, New System.DateTime(1883, 10, 31), CDate(GregorianDate)) + 1 Dim i As Integer = 0 Do While (DaysPan > 29 + Val(UmmUlquraHijriMonths.Chars(i))) DaysPan = DaysPan - 29 - Val(UmmUlquraHijriMonths.Chars(i)) i = i + 1 Loop hijriDate = Format$(DaysPan, "00") + "/" + Format((i Mod 12) + 1, "00") + "/" + CStr(1301 + (i \ 12)) Return hijriDate Catch ex As Exception ' MessageBox.Show("تأكد من التاريخ الميلادي.", "خطأ في التاريخ الميلادي", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing End Try End Function #End Region #Region " GetGregorianDate(HijriDate As String) As Date " Private Function GetGregorianDate(ByVal HijriDate As String) As String Try Threading.Thread.CurrentThread.CurrentCulture = New Globalization.CultureInfo("ar-eg") Dim gregorianDate As String = String.Empty Dim MonthsPan As Integer MonthsPan = (12 * (CInt(Mid(HijriDate, 7, 4)) - 1301)) + CInt(Mid(HijriDate, 4, 2)) Dim TempDaysPan As Integer Dim i As Integer For i = 0 To MonthsPan - 2 TempDaysPan = TempDaysPan + 29 + Val(UmmUlquraHijriMonths.Chars(i)) Next i If CInt(Mid(HijriDate, 1, 2)) > 29 + Val(UmmUlquraHijriMonths.Chars(i)) Then ' MessageBox.Show("رقم اليوم لهذا الشهر يجب أن لا يتجاوز 29", "خطأ اليوم الشهري للتاريخ الهجري", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing Else TempDaysPan = TempDaysPan + CInt(Mid(HijriDate, 1, 2)) End If 'Start Date is 10-31-1883 gregorianDate = CStr(DateAdd(DateInterval.Day, TempDaysPan - 1, New System.DateTime(1883, 10, 31))) Return gregorianDate Catch ex As Exception ' MessageBox.Show("تأكد من التاريخ الهجري.", "خطأ في التاريخ الهجري", MessageBoxButtons.OK, MessageBoxIcon.Error, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign Or MessageBoxOptions.RtlReading) Return Nothing End Try End Function #End Region #Region " UmmUlquraHijriMonths " 'UmmUlquraHijriMonths Private Function UmmUlquraHijriMonths() As String Dim HijriMonthSequence As String = "" 'Create the Months data from 1301H to 1450H - (150years) HijriMonthSequence += "111010010011" 'Year 1301H HijriMonthSequence += "011101001001" 'Year 1302H HijriMonthSequence += "011101100100" 'Year 1303H HijriMonthSequence += "101101101010" 'Year 1304H HijriMonthSequence += "010101110101" 'Year 1305H HijriMonthSequence += "010010110110" 'Year 1306H HijriMonthSequence += "101001010110" 'Year 1307H HijriMonthSequence += "101101001010" 'Year 1308H HijriMonthSequence += "110110100100" 'Year 1309H HijriMonthSequence += "110111010010" 'Year 1310H HijriMonthSequence += "010111011001" 'Year 1311H HijriMonthSequence += "001011011100" 'Year 1312H HijriMonthSequence += "100101011101" 'Year 1313H HijriMonthSequence += "010010101101" 'Year 1314H HijriMonthSequence += "101001010101" 'Year 1315H HijriMonthSequence += "101101001010" 'Year 1316H HijriMonthSequence += "101101101001" 'Year 1317H HijriMonthSequence += "010101110100" 'Year 1318H HijriMonthSequence += "100101110110" 'Year 1319H HijriMonthSequence += "010010110111" 'Year 1320H HijriMonthSequence += "001001010111" 'Year 1321H HijriMonthSequence += "010100101011" 'Year 1322H HijriMonthSequence += "011010010101" 'Year 1323H HijriMonthSequence += "011011001010" 'Year 1324H HijriMonthSequence += "101011010101" 'Year 1325H HijriMonthSequence += "010101011011" 'Year 1326H HijriMonthSequence += "001001011101" 'Year 1327H HijriMonthSequence += "100100101101" 'Year 1328H HijriMonthSequence += "110010010101" 'Year 1329H HijriMonthSequence += "110101001010" 'Year 1330H HijriMonthSequence += "111010100101" 'Year 1331H HijriMonthSequence += "011011010010" 'Year 1332H HijriMonthSequence += "101011010101" 'Year 1333H HijriMonthSequence += "010101011010" 'Year 1334H HijriMonthSequence += "101010101011" 'Year 1335H HijriMonthSequence += "010101001011" 'Year 1336H HijriMonthSequence += "011010100101" 'Year 1337H HijriMonthSequence += "011101010010" 'Year 1338H HijriMonthSequence += "101110101001" 'Year 1339H HijriMonthSequence += "001101110100" 'Year 1340H HijriMonthSequence += "101010110110" 'Year 1341H HijriMonthSequence += "010101010110" 'Year 1342H HijriMonthSequence += "101010101010" 'Year 1343H HijriMonthSequence += "110101010010" 'Year 1344H HijriMonthSequence += "110110101001" 'Year 1345H HijriMonthSequence += "010111010100" 'Year 1346H HijriMonthSequence += "101011101010" 'Year 1347H HijriMonthSequence += "010011011101" 'Year 1348H HijriMonthSequence += "001001101110" 'Year 1349H HijriMonthSequence += "100100101110" 'Year 1350H HijriMonthSequence += "101010100110" 'Year 1351H HijriMonthSequence += "110101010100" 'Year 1352H HijriMonthSequence += "110110101010" 'Year 1353H HijriMonthSequence += "010110110101" 'Year 1354H HijriMonthSequence += "001010110110" 'Year 1355H HijriMonthSequence += "100100110111" 'Year 1356H HijriMonthSequence += "010010011011" 'Year 1357H HijriMonthSequence += "101001001011" 'Year 1358H HijriMonthSequence += "101100100101" 'Year 1359H HijriMonthSequence += "101101010100" 'Year 1360H HijriMonthSequence += "101101101010" 'Year 1361H HijriMonthSequence += "010101101101" 'Year 1362H HijriMonthSequence += "010010101101" 'Year 1363H HijriMonthSequence += "101001010101" 'Year 1364H HijriMonthSequence += "110100100101" 'Year 1365H HijriMonthSequence += "111010010010" 'Year 1366H HijriMonthSequence += "111011001001" 'Year 1367H HijriMonthSequence += "011011010100" 'Year 1368H HijriMonthSequence += "101011101010" 'Year 1369H HijriMonthSequence += "010101101011" 'Year 1370H HijriMonthSequence += "010010101011" 'Year 1371H HijriMonthSequence += "011010010101" 'Year 1372H HijriMonthSequence += "101101001001" 'Year 1373H HijriMonthSequence += "101110100100" 'Year 1374H HijriMonthSequence += "101110110010" 'Year 1375H HijriMonthSequence += "010110110101" 'Year 1376H HijriMonthSequence += "001010111010" 'Year 1377H HijriMonthSequence += "100101011011" 'Year 1378H HijriMonthSequence += "010010101011" 'Year 1379H HijriMonthSequence += "010101010101" 'Year 1380H HijriMonthSequence += "011010110010" 'Year 1381H HijriMonthSequence += "011011011001" 'Year 1382H HijriMonthSequence += "001011101100" 'Year 1383H HijriMonthSequence += "100101101110" 'Year 1384H HijriMonthSequence += "010010101110" 'Year 1385H HijriMonthSequence += "101001010110" 'Year 1386H HijriMonthSequence += "110100101010" 'Year 1387H HijriMonthSequence += "110101010101" 'Year 1388H HijriMonthSequence += "010110101010" 'Year 1389H HijriMonthSequence += "101010110101" 'Year 1390H HijriMonthSequence += "010010111011" 'Year 1391H HijriMonthSequence += "001001011011" 'Year 1392H HijriMonthSequence += "100100101011" 'Year 1393H HijriMonthSequence += "101010010101" 'Year 1394H HijriMonthSequence += "101101001010" 'Year 1395H HijriMonthSequence += "101110100101" 'Year 1396H HijriMonthSequence += "010110101010" 'Year 1397H HijriMonthSequence += "101010110101" 'Year 1398H HijriMonthSequence += "010101010110" 'Year 1399H HijriMonthSequence += "101010010110" 'Year 1400H HijriMonthSequence += "110101001010" 'Year 1401H HijriMonthSequence += "111010100101" 'Year 1402H HijriMonthSequence += "011101010010" 'Year 1403H HijriMonthSequence += "011011101001" 'Year 1404H HijriMonthSequence += "001101101010" 'Year 1405H HijriMonthSequence += "101010101101" 'Year 1406H HijriMonthSequence += "010101010101" 'Year 1407H HijriMonthSequence += "101010100101" 'Year 1408H HijriMonthSequence += "101101010010" 'Year 1409H HijriMonthSequence += "101110101001" 'Year 1410H HijriMonthSequence += "010110110100" 'Year 1411H HijriMonthSequence += "100110111010" 'Year 1412H HijriMonthSequence += "010011011011" 'Year 1413H HijriMonthSequence += "001001011101" 'Year 1414H HijriMonthSequence += "010100101101" 'Year 1415H HijriMonthSequence += "101010100101" 'Year 1416H HijriMonthSequence += "101011010100" 'Year 1417H HijriMonthSequence += "101011101010" 'Year 1418H HijriMonthSequence += "010101101101" 'Year 1419H HijriMonthSequence += "010010111101" 'Year 1420H HijriMonthSequence += "001000111101" 'Year 1421H HijriMonthSequence += "100100011101" 'Year 1422H HijriMonthSequence += "101010010101" 'Year 1423H HijriMonthSequence += "101101001010" 'Year 1424H HijriMonthSequence += "101101011010" 'Year 1425H HijriMonthSequence += "010101101101" 'Year 1426H HijriMonthSequence += "001010110110" 'Year 1427H HijriMonthSequence += "100100111011" 'Year 1428H HijriMonthSequence += "010010011011" 'Year 1429H HijriMonthSequence += "011001010101" 'Year 1430H HijriMonthSequence += "011010101001" 'Year 1431H HijriMonthSequence += "011101010100" 'Year 1432H HijriMonthSequence += "101101101010" 'Year 1433H HijriMonthSequence += "010101101100" 'Year 1434H HijriMonthSequence += "101010101101" 'Year 1435H HijriMonthSequence += "010101010101" 'Year 1436H HijriMonthSequence += "101100101001" 'Year 1437H HijriMonthSequence += "101110010010" 'Year 1438H HijriMonthSequence += "101110101001" 'Year 1439H HijriMonthSequence += "010111010100" 'Year 1440H HijriMonthSequence += "101011011010" 'Year 1441H HijriMonthSequence += "010101011010" 'Year 1442H HijriMonthSequence += "101010101011" 'Year 1443H HijriMonthSequence += "010110010101" 'Year 1444H HijriMonthSequence += "011101001001" 'Year 1445H HijriMonthSequence += "011101100100" 'Year 1446H HijriMonthSequence += "101110101010" 'Year 1447H HijriMonthSequence += "010110110101" 'Year 1448H HijriMonthSequence += "001010110110" 'Year 1449H HijriMonthSequence += "101001010110" 'Year 1450H Return HijriMonthSequence End Function #End Region ' Function DateFormating(ByVal _Date As String) As String #Region " DateFormating( _Date As String) As String " Public Function DateFormating(ByVal _Date As String) As String ' / تجزئة نص التاريخ من الفاصل Dim dt() As String = Split(_Date, "/") '------------------------------------------------------ ' في حالة عدم وجود فاصل تاريخ أصلا فيتم المغادرة If dt.Length <> 3 Then Return "" '------------------------------------------------------ ' التأكد أن أجزاء التاريخ هي أرقام فعلا For i = 0 To dt.Length - 1 If Not IsNumeric(dt(i)) Then Return "" End If Next i '------------------------------------------------------ ' ترتيب التاريخ بحيث يبدأ باليوم وينتهي السنة If Val(dt(0)) > 999 And Val(dt(2)) < 99 Then Dim a As String = Val(dt(0)) Dim b As String = Val(dt(2)) dt(0) = b : dt(2) = a End If '------------------------------------------------------ ' التأكد من عدم تجاوز كل جزء الحدود المسموح له If Val(dt(2)) < 1301 Or Val(dt(2)) > 2029 Then Return "" ' عدم تجاوز الشهر عن 12 If Val(dt(1)) < 1 _ Or Val(dt(1)) > 12 Then Return "" End If ' عدم تجاوز اليوم الهجري عن 30 If Val(dt(2)) >= 1301 _ And Val(dt(2)) <= 1450 Then If Val(dt(0)) < 1 Or Val(dt(0)) > 30 Then Return "" End If '------------------------------------------------------ Dim y As Integer, m As Integer, d As Integer d = Val(dt(0)).ToString("00") m = Val(dt(1)).ToString("00") y = Val(dt(2)).ToString("0000") Return Val(dt(0)).ToString("00") _ & "/" & Val(dt(1)).ToString("00") _ & "/" & Val(dt(2)).ToString("0000") End Function #End Region '#End Region #Region " ArabicWeekdayString " Private Function ArabicWeekdayString(ByVal weekdayValue As Integer) Dim w As String = String.Empty Select Case weekdayValue Case 7 w = "Saturday" Case 1 w = "Sunday" Case 2 w = "Monday" Case 3 w = "Tuesday" Case 4 w = "Wednesday" Case 5 w = "Thursday" Case 6 w = "Friday" End Select Return w End Function #End Region #Region " HiriMonthString " Private Function HiriMonthString(ByVal hijriMonthValue As Integer) Dim m As String = String.Empty Select Case hijriMonthValue Case 1 m = "Muharram" Case 2 m = "Safar" Case 3 m = "Rabi al-Awwal" Case 4 m = "Rabi ath-Thani" Case 5 m = "Jumada al-Ula" Case 6 m = "Jumada al-Akhirah" Case 7 m = "Rajab" Case 8 m = "Shaaban" Case 9 m = "Ramadan" Case 10 m = "Shawwal" Case 11 m = "Dhu al-Qaadah" Case 12 m = "Dhu al-Hijjah" End Select Return m End Function #End Region #Region " GregorianMonthString " Private Function GregorianMonthString(ByVal gregorianMonthValue As Integer) Dim m As String = String.Empty Select Case gregorianMonthValue Case 1 m = "January" Case 2 m = "February" Case 3 m = "March" Case 4 m = "April" Case 5 m = "May" Case 6 m = "June" Case 7 m = "July" Case 8 m = "August" Case 9 m = "September" Case 10 m = "October" Case 11 m = "November" Case 12 m = "December" End Select Return m End Function #End Region End Module ملاحظة: حقوق بعض الاكواد من google
      ارجو ان ينال موضوعي اعجابكم.
       
      حسنين
       
       
      Hijri_SEMO_Pa3x.rar
  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×
×
  • اضف...