منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب - اضافة الصور الى ملف واسترجاعها بدون قاعدة البيانات

اريد حفظ الصور فى مجلد bin ,حفظ الصورة الاولى باسم logo1& حفظ الصورة الثانية باسم logo2&حفظ الصورة الثالثة باسم logo3

- قم بإضافة مكتبة جديدة من قائمة (Project) :
Microsoft Scriping Runtime

أمسح الأزرار وقم بإضافتها من جديد بإسماء جديدة بحسب الترتيب مع كل صورة :

cmdAdd1
cmdRemove1
---
cmdAdd2
cmdRemove2
---
cmdAdd3
cmdRemove3
---

أمسح الكود السابق واستبدله بالكود التالي :

كود :

' From Project Menu :>>  Add References :

' Microsoft Scriping Runtime

Option Explicit

Dim Fs As New FileSystemObject

Public Sub LoadImage(pImage As Image, pFileTitle As String, pKey As String)

    Dim sFilePath As String

    Dim sNewPath As String

    CommonDialog1.Filter = "Picture File JPEG Format (*.jpg,*.jpe,*.jpeg)|*.jpg;*.jpe;*.jpeg|Bitmap Files (*.bmp)|*.bmp"

    CommonDialog1.DialogTitle = "أختر الصورة المراد إضافتها"

    CommonDialog1.ShowOpen

    sFilePath = CommonDialog1.FileName

    pImage.Picture = LoadPicture(sFilePath)

    sNewPath = App.Path & "\bin\" & pFileTitle & Right(CommonDialog1.FileTitle, 4)

    Fs.CopyFile sFilePath, sNewPath

    SaveSetting App.Title, "Setting", pKey, sNewPath

    MsgBox "تمت عملية الحفظ بنجاح", vbInformation + vbMsgBoxRight, "MSGBOX"

End Sub

Private Sub Form_Load()

    Dim sPath As String

    sPath = GetSetting(App.Title, "Setting", "A", "")

    Image1.Picture = LoadPicture(sPath)

    sPath = GetSetting(App.Title, "Setting", "B", "")

    Image2.Picture = LoadPicture(sPath)

    sPath = GetSetting(App.Title, "Setting", "C", "")

    Image3.Picture = LoadPicture(sPath)

End Sub

Private Sub cmdAdd1_Click()

    LoadImage Image1, "logo1", "A"

End Sub

Private Sub cmdRemove1_Click()

    Image1 = Nothing

    Fs.DeleteFile GetSetting(App.Title, "Setting", "A", ""), True

    SaveSetting App.Title, "Setting", "A", ""

    MsgBox "تمت عملية الحذف بنجاح", vbInformation + vbMsgBoxRight, "MSGBOX"

End Sub

Private Sub cmdAdd2_Click()

    LoadImage Image2, "logo2", "B"

End Sub

Private Sub cmdRemove2_Click()

    Image2 = Nothing

    Fs.DeleteFile GetSetting(App.Title, "Setting", "B", ""), True

    SaveSetting App.Title, "Setting", "B", ""

    MsgBox "تمت عملية الحذف بنجاح", vbInformation + vbMsgBoxRight, "MSGBOX"

End Sub

Private Sub cmdAdd3_Click()

    LoadImage Image3, "logo3", "C"

End Sub

Private Sub cmdRemove3_Click()

    Image3 = Nothing

    Fs.DeleteFile GetSetting(App.Title, "Setting", "C", ""), True

    SaveSetting App.Title, "Setting", "C", ""

    MsgBox "تمت عملية الحذف بنجاح", vbInformation + vbMsgBoxRight, "MSGBOX"

End Sub

تمام اخى الغالى ...ولكن هل يمكن التعديل بحيث عند الإضافة يتم تحميل الصورة فقط ولا يتم الحفظ الا من خلال زرار حفظ الاعدادات الذى يقوم بحفظ الصور التى تم اختيارها.

اخى الغالى هل يمكن العمل على الملف المرفق وتعديل الأكواد ان أمكن علماً بأن الاكواد تعمل جيدا...وكيف يمكن حفظ المسافة بال twips ,وعرضها للمستخدم بالسنتمتر لاستخدامها فى اعدادات التقرير...وأشكرك شكراً جزيلاً

(24-01-24, 01:51 PM)haitham Muhammed كتب : [ -> ]اخى الغالى هل يمكن العمل على الملف المرفق وتعديل الأكواد ان أمكن علماً بأن الاكواد تعمل جيدا...وكيف يمكن حفظ المسافة بال twips ,وعرضها للمستخدم بالسنتمتر لاستخدامها فى اعدادات التقرير...وأشكرك شكراً جزيلاً

فى حدث عند التحميل
On Error Resume Next
Image1.Picture = LoadPicture(App.Path & "\Data\logo1.jpg")
Image2.Picture = LoadPicture(App.Path & "\Data\logo2.jpg")
Image3.Picture = LoadPicture(App.Path & "\Data\logo3.jpg")
أمر حفظ الاعدادات
If CommonDialog1.FileName <> "" Then
Fs.CopyFile CommonDialog1.FileName, App.Path & "\Data\logo1.jpg"
ElseIf Image1.Picture = 0 Then
Fs.DeleteFile (App.Path & "\Data\logo1.jpg")
End If

If CommonDialog2.FileName <> "" Then
Fs.CopyFile CommonDialog2.FileName, App.Path & "\Data\logo2.jpg"
ElseIf Image2.Picture = 0 Then
Fs.DeleteFile (App.Path & "\Data\logo2.jpg")
End If

If CommonDialog3.FileName <> "" Then
Fs.CopyFile CommonDialog3.FileName, App.Path & "\Data\logo3.jpg"
ElseIf Image3.Picture = 0 Then
Fs.DeleteFile (App.Path & "\Data\logo3.jpg")
End If

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

haitham Muhammed

Taha Okla

haitham Muhammed

haitham Muhammed