اذهب الي المحتوي
أوفيسنا

Foksh

الخبراء
  • Posts

    1,876
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    66

كل منشورات العضو Foksh

  1. بدايةً تأكد أخي @العبيدي رعد من صحة القيم والسجلات التي لا تظهر معك .. وفي حال لم تتوصل لمعرفة المشكلة ، ارفق ملفك هنا للإطلاع عليه ومعرفة السبب
  2. أخي الكريم @أمير ادم ، أسعد الله أوقاتك ، وأعتذر عن المحاولات السابقة إلى أن توضحت الأمور في متطلبات رمز الـ QR . من الواضح أن هيئة الزكاة تعتمد على طريقة تشفير وترميز البيانات باستخدام EncodeTLV . ثم يتم تشفير البيانات باستخدام الترميزات EncodeBase64 ، كما كان في تجربة سابقة لفهم آليه التشفير .. والحمد لله أعتقد أنني توصلت إلى حل . جرب هذا الكود كاملاً مع وظائف التشفير والإسترداد بالترميز الذي يتعرف عليه نظام الفاتورة الإلكترونية :- Option Compare Database Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Private Sub Command18_Click() On Error GoTo ErrorHandler Dim apiUrl As String Dim qrData As String Dim savePath As String Dim result As Long Dim sellerName As String Dim vatNumber As String Dim invoiceDate As String Dim totalAmount As String Dim vatAmount As String sellerName = Me.AD_Company_Vendor_Name vatNumber = Me.AD_Tax_Number invoiceDate = Me.AD_Invoice_Time_and_Date totalAmount = Me.AD_InvoiceAmountwithaddedvalue vatAmount = Me.AD_VAT Dim tlvData As String tlvData = Chr(1) & EncodeTLV(sellerName) & _ Chr(2) & EncodeTLV(vatNumber) & _ Chr(3) & EncodeTLV(invoiceDate) & _ Chr(4) & EncodeTLV(totalAmount) & _ Chr(5) & EncodeTLV(vatAmount) qrData = EncodeBase64(tlvData) apiUrl = "https://api.qrserver.com/v1/create-qr-code/?data=" & qrData & "&size=200x200" savePath = Application.CurrentProject.Path & "\qr_code.bmp" result = URLDownloadToFile(0, apiUrl, savePath, 0, 0) If result = 0 Then Me.imgQRCode.Picture = savePath Else MsgBox "Failed to download QR code image.", vbExclamation End If Exit Sub ErrorHandler: MsgBox "An error occurred: " & Err.Description, vbCritical End Sub Private Function EncodeTLV(value As String) As String EncodeTLV = Chr(Len(value)) & value End Function Private Function EncodeBase64(value As String) As String Dim bytes() As Byte Dim xmlDoc As Object Dim xmlNode As Object Dim base64Data As String Set xmlDoc = CreateObject("MSXML2.DOMDocument") Set xmlNode = xmlDoc.createElement("Base64Data") xmlNode.DataType = "bin.base64" bytes = StrConv(value, vbFromUnicode) xmlNode.nodeTypedValue = bytes base64Data = xmlNode.Text Set xmlNode = Nothing Set xmlDoc = Nothing EncodeBase64 = base64Data End Function وهذا الملف بعد التعديل Qrcode.accdb
  3. أشكرك أستاذنا الغالي @ابو البشر بعض ما عندكم يا صديقي صديقي الدكتور @الحلبي ، ربنا يوسع عليك ، أشكرك مرورك أخوك فادي
  4. أخي الكريم ليست الفكرة بالعلاقة ، ولكن حتى يتم اشاء الـ QR عندي في جهازي وأعرف السبب في عدم تشغيله بشكل صحيح ، والمشكلة وضحت الآن وهي ان هذا الاسلوب أو النظام الذي تتبعه من خلال الموقع الذي ينشئ الصورة لا تدعم اللغة العربية ، جرب اكتب بدل بنده اسم باللغة الانجليزية تجد انه يعمل بشكل صحيح 100000% في الكود الذي ارسلته لك ..
  5. ابشر ، اعتبره تم إضافة التفاعلية في اللعبة بالأصوات فكرة جميلة ، لكني ما تطرقت للتفكير بها حالياً وقلت للتحديث القادم ، لكنك سبقتني بالتصريح ههههههههه بصراحة هذه كانت الفكرة الأولى في التنفيذ !! إلا أنني تراجعت واتجهت لهذا السلوك الحالي في اللعبة بسبب عدم تحميل النموذج لود أكثر أو التسبب في بطئ اللعبة ولكن نعود لها ونجرب بطريق آخر يكون أكثر سلاسة ... بارك الله فيك مهندسنا الغالي @Moosak هذا بعض ما عندكم
  6. أخي الكريم إذا تكرمت ، ارفق لنا الملفات الثلاثة في ملف مضغوط وارفعه على جوجل درايف إذا كان الميديافاير لا يعمل عندكم في مصر ( حسب ما ذكر أحد الإخوة لي سابقاً )
  7. بطريق آخر ،، المهم نجاح الفكرة و وصولك الى حل يعالج مشكلتك ، بالتوفيق أستاذ @عبد الله قدور
  8. فهمتك أخي الكريم @أمير ادم ، ولكن على ما يبدو أنه بسبب عدم وجود البرامج التي تم تثبيتها على جهازك لم يعمل الملف معي بشكل صحيح ، لذا اضطررت الى الاتجاه على طريق آخر ،، على العموم جرب هذا الكود كمحاولة فقط لتحديد التنسيق في حقل الوقت والتاريخ . On Error Resume Next Dim apiUrl As String Dim qrData As String Dim savePath As String Dim result As Long Dim formattedDate As String formattedDate = Format(Me.AD_Invoice_Time_and_Date, "yyyy-mm-dd hh:nn:ss ampm") Me.AD_Associatedcells = Me.AD_Company_Vendor_Name & "_" & Me.AD_Tax_Number & "_" & formattedDate & "_" & Me.AD_InvoiceAmountwithaddedvalue & "_" & Me.AD_VAT qrData = Me.AD_Associatedcells.Value apiUrl = "https://api.qrserver.com/v1/create-qr-code/?data=" & qrData & "&size=200x200" savePath = Application.CurrentProject.Path & "\qr_code.bmp" result = URLDownloadToFile(0, apiUrl, savePath, 0, 0) If result = 0 Then Me.imgQRCode.Picture = savePath Else MsgBox "Failed to download QR code image.", vbExclamation End If أو ارفق لنا البرامج التي تم تثبيتها على الكمبيوتر عندك والسبب وجود مكتبات ناقصة كما في الصورة
  9. الموضوع ليس بالقديم جداً ، ولكني انصحك بفتح موضوع جديد وإرفاق ملفك الذي تريد التعديل عليه
  10. أخي الكريم @أمير ادم ، قمت بتعديل جذري على فكرتك بحيث ابتعدت عن الاعتماد على موقع يقوم بإنشاء كود QR ، واستعنت ببرنامج صغير يدعم اللغة العربية أيضاً ، وأعدت صياغة الكود كما يلي ، مع العلم أن المشكلة لديك كانت في تنسيق مربع النص AD_Invoice_Time_and_Date .. تفضل تجربتي وأخبرني بالنتيجة QR.zip
  11. نعود هنا لنقطة النقاش والمعضلة .. وهي أنك كمصمم للبرنامج ستكون ملزم بتحديد القياسات ( حجم الشاشة ) !! وهذا الأمر إلى حد ما منافٍ للمنطق والمعقول . حاول بلورة الموضوع من خلال ان تجعل الفورم يتعرف على قياسات الشاشة بشكل تلقائي وديناميكي ،، سأدلك على موضوع لي سابق كنت قد توجهت به إلى طريقة للتعرف على قياسات الشاشة بشكل تلقائي في هذا الموضوع 😉 .
  12. اخي الكريم @sm44ms كنا بدايةً في موضوع الأيقونة ، ثم اتجهنا الى كود لا يعمل ، والآن زر حفظ وتراجع ،، افتح موضوع في كل طلب حتى لا تخالف قوانين المنتدى 🥰
  13. مشاركة جانبية متأخرة مع الأساتذة ( أن تصل متأخراً خير من أن لا تصل ابدأ )، جرب هذه الفكرة اخي @عبد الله قدور ، ننشئ دالة عامة في مديول ونستخدم هذا الكود الذي يعيد تنسيق التاريخ بالشكل DD/MM/YYYY :- Public Function ParseDate(inputDate As String) As Date Dim dayPart As String Dim monthPart As String Dim yearPart As String dayPart = Mid(inputDate, 1, 2) monthPart = Mid(inputDate, 4, 2) yearPart = Mid(inputDate, 7, 4) ParseDate = DateSerial(CInt(yearPart), CInt(monthPart), CInt(dayPart)) End Function ونستدعيه على سبيل المثال كالآتي ( المتغير اختياري وعلى سبيل المثال ) :- Dim myDate As Date myDate = ParseDate("24/05/2024") ودمتم 🤗
  14. تم تحديث الملف بتعديل بعض الأكواد للأفضل ( لا زيادة على الأكواد )
  15. شكراً لمروروك صديقي @TQTHAMI ، كلامك سليم ، ولكن اللعبة هنا تحتوي على 10 صور فقط وهي ( 6 صور لأوجه حجر النرد + 4 صور بين القرعة واللاعب الأول والثاني واللعبة الجديدة )
  16. السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) طبعاً المكتوب باين من عنوانه . هي اللعبة المعروفة والتي لعبها منا على الأغلب الجميع في طفولته .. من يبدأ اللعب هو من يحصل على أعلى رقم من القرعة . اللعبة يلعبها لاعبين اثنين فقط . يتم تسجيل النقاط لكل لاعب في خانة منفصلة . طريقة التحرك بنمط حجر النرد ( ولا أعلم إن كان البعض سيقول لي أن النرد حرام ) لكنه هنا ليس حجر نرد حقيقي وإنما فكرة اختيار عشوائي لصور أوجه حجر النرد ) الأرقام ) تدل على خطوات التقدم . الصعود لأعلى عند وصول اللاعب إلى أول السلم حتى الخانة التي تمثل رأس السلم . وكما الصعود !! سيكون لدينا النزول عند وصول اللاعب إلى رأس الثعبان سينزل باتجاه الذيل نزولاً .. تسجيل الحركات الإنتقالية لكل لاعب في مربع الحركات أسفل اللعبة . في حال الوصول إلى 95 سيحتاج اللاعب للوصول إلى الهدف 100 إلى 6 نقاط أو أقل ، فلو تقدم الى 99 كمثال هنا سيحتاج الى نقطة واحدة للتحرك وللفوز . فلو كان الاختيار العشوائي للصورة فرضاً 4 فلا يتم تحقيق الفوز إلا بالرقم 1 .... وهكذا . عند فوز أحد اللاعبين ، سيتحول الزر إلى لعبة جديدة . إمكانية تكبير النموذج لملئ الشاشة أو لا ، حسب رغبتك صور من اللعبة :- ملف اللعبة مفتوح المصدر Snake3.accdb
  17. Foksh

    S1.png

    من البوم Snake

  18. Foksh

    T2.PNG

    من البوم Snake

  19. Foksh

    05.PNG

    من البوم Snake

  20. Foksh

    04.PNG

    من البوم Snake

  21. Foksh

    03.PNG

    من البوم Snake

  22. Foksh

    02.PNG

    من البوم Snake

  23. Foksh

    01.PNG

    من البوم Snake

×
×
  • اضف...

Important Information