كود اضافة صورة

[سلطوون]

السلام عليكم ورحمة الله وبركاته

لدي مشكلة في الفورم

قمت بتجهيز القاعدة وألغيت جميع الأشرطة والأدوات سواء أشرطة الأدوات أو غيرها لعدم التلاعب بها .

وفي الفورم يوجد مربع إدراج كائن (صورة) فعندما أضغط على الصورة لايمكنني إضافة صورة لبيانات الموظف ولا يعمل الزر الأيمن للماوس .

فقد كنت قبل تأمين القاعدة أضغط بالزر الأيمن وأختار إدراج كائن رسومي ، أما الآن فلا يمكنني من استخدام الزر الأيمن للماوس..

فأريد وضع زر (Brows)دليل يمكنني من إضافة الصورة في مربع الكائن الرسومي

أو دبل كليك على الصورة فيظهر لي الدليل لأضيف الصورة

أو حتى أي طريقة أخرى بسيطة تمكنني من ذلك

تم تعديل أكتوبر 1, 2003 بواسطه سلطوون

[امير عاطف]

إن شاء الله يفي هذا الكود بالغرض ...

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

    On Error GoTo Officena

    ' employee_pic اسم كائن صورة الموظف هو

    Me.employee_pic.Action = acOLEInsertObjDlg

ExitProcedure:

    Exit Sub

Officena:

   Select Case Err.Number

          Case 2001   'هذا الإجراء يقوم بإلغاء العملية السابقة

               Resume ExitProcedure

          Case Else

               MsgBox "خطأ رقم " & Err.Number & ":  " & "الرجاء ابلاغ المبرمج بالمشكلة", vbOKOnly + vbInformation, "Officena"

               Resume ExitProcedure

   End Select

مع التحية

تم تعديل أكتوبر 1, 2003 بواسطه امير عاطف

[tarekh]

السلام عليكم ورحمة الله وبركاته

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

بالضغط المزدوج بالماوس على مسار الصورة ونختار الصورة

طبعا اخونا ابو هادى يقد يطورها للافضل مثل ماعودنا فى البحث الفورى والتقويم

Mdb.rar

[ابن مسقط]

السلام عليكم ورحمة الله وبركاته

المثال المرفق "ألبوم صور" أرجو أن تستفيد من فكرته.

أنقر هنا لإنزال الملف

أنا أؤيد ما أفاد به الأستاذ الكريم/ طارق في أن أفضل طريقة لتخزين الصور ان يتم خارج القاعدة تفادياً لمضاعفة حجم القاعدة والبطىء .

Album.zip

[tarekh]

الاخ ابن مسقط

مثال جيد اكرمك الله

[ابن مسقط]

العفو يأستاذ/ طارق

المثال أكتمل بعد مساعدة الأخ المشرف/ محمد طاهر

وأبو حمود بارك الله فيهم.

يحضرني في هذا الشأن سؤال :

هل جرب أحد ذلك النوع من القواعد التي تخزن الصور خارجها ، أن تعمل في ظل شبكة مع عدة مستخدمين ؟

هل كان لها مشاكل ؟

[ابن مسقط]

للرفع

[امير عاطف]

من ناحيتي لم اجرب ذلك على شبكة عمل

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

واعتقد لتفادي تلك المشكله انه عند تحديد مسار ملف الصورة من نفس الجهاز الذي عليه ملف بيانات القاعدة ان تقوم بالدخول لمسار الصورة عن طريق الدخول اولاً للورك جروب ثم للدخول للجهاز ثم تحديد المسار سواء كنت تعمل على الجاز الذي علية قاعدة البيانات نفسها او جهاز غيره

[سلطوون]

السلام عليكم أخوتي الكرام

وأشكركم على بذلكم المجهود

لكن للأسف لم تحل المشكلة إلي الآن

واسال الله أن أجد الحل بأسرع وقت

فقد قمت بنسخ الكود التالي وأضفت زر أمر بنفس الاسم اللذي بالكود ولكن لا جدوى من ذلك

يعطيني خطأ في GetOpenFile_CLT = مسار_الصورة

ربما تكون أنت مستخدم نظام 98 وأنا مستخدم 2000بوفيشونال

وإن وجدت الحل أخي الكريم ابن مسقط أرجو منك أن ترسله

وجزاك الله خيرا

[محمد طاهر عرفه]

الأخ ابن مسقط ، لا أعتقد بوجود مشاكل علي الشبكة

الاخ سلطون ، هل جربت الطريقة فى مثال الاخ طارق ؟؟

[امير عاطف]

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

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

[ابن مسقط]

أخي الأستاذ/ أمير

أخي المهندس/محمد طاهر

شكراً جزيلاً على تفاعلكما وإفادتكما في الموضوع.

بصراحة شديده ، أنا بصدد إنجاز مشروع قاعدة بيانات يعتمد على تخزين الصور خارجها (في مجلد موضوع على السيرفير أو ما يسمى الملقم) ، ولأجل ذلك قمت بتجربت ""قاعدة ألبوم الصور"" المشار إليها في الوصلة أعلاه.

للأسف الشديد واجهتني مشكله في أن network drive يختلف حرفه من جهاز إلى أخر.

فبالتالي الجهاز الذي يبدأ في تحديد وحفظ مسار الصوره هو الذي يستطيع أن يراها ، أما الأخرون فلا يتمكنون من مشاهدتها نظراً لإختلف مسارها لديهم.

فهل يوجد حل لهذه المشكلة ، مع العلم أن التطبيق مشابه لألبوم الصور ؟

[محمد طاهر عرفه]

الحرف ينتج عن عملية

Map Network Drive

فاما أن توحدها علي الاجهزة

فمثلا تجعل Z للجميع

أو ان تكتب المسار كاملا

\\ibnmasqutPC\ImageFolder

[سلطوون]

السلام عليكم ورحمة الله وبركاته

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

وأسأل الله لكم المثوبه

[ابن مسقط]

الأخ المهندس/ محمد طاهر

بشرك الله بالجنة

أنحلت المشكلة بعد توحيد الـ Network Drive في أجهزة المرتبطين.

[امير عاطف]

الحمد لله ... مبروك وصولك للحل :d

[ابن مسقط]

بارك الله فيك أستاذ/ أمير

ولا أنسى فضلك أيضاً

[محمد طاهر عرفه]

آميييييييييييييييييين

اللهم اجمعنا فيها و جميع الأخوة يارب العالمين

:fff:

[frozen]

السلام عليكم ورحمة الله وبركاته

لى سؤال أرجو الإجابـة عليه ألا وهو

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

اعتقد انه قد تم تناول الموضوع وذلك بادارج الصورة واستدعائها عن طريق مسار ملف الصورة

أى ان الذى يتم حفظه فى قاعدة البيانات هو مسار الصورة فقط وليس الصورة

قد يحدث تغير مكان ملف الصورة لذا فلن تظهر الصورة

هل توجد طريقة اخرى لادراج صورة الى قاعدة البيانات

وجزاكم الله خيرا

[محمد طاهر عرفه]

اجعل الحقل فى الجدول من نوع OLE Object

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

ثم Paste فى الجدول

فتظهر كلمة Picture

ثم عند العرض فى النموذج ستجد الصورة ظاهرة

و لكن هذا ليس هو الحل الامثل

فحل المسار هو الحل الافضل من أجل حجم القاعدة و اداؤها

[alhajri]

السلام عليكم

حل آخر :

اذا كنت تريد تخزين الصورة داخل القاعدة ودون خاصية الزر الايسر للفاره

انشأ حقل OLE في النموذج وسمه الصورة

انسخ هذا الكود وضعه في وحده نمطيه واحفظه باي اسم .

Option Compare Database

Option Explicit


Public Const adhcAccErrSuccess = 0

Public Const adhcAccErrUnknown = -1


Const adhcSP_MAXPATH = 260

Const adhcSP_MAXDRIVE = 3

Const adhcSP_MAXDIR = 256

Const adhcSP_MAXFNAME = 256

Const adhcSP_MAXEXT = 256


Public Const adhcFileExistsYes = 1

Public Const adhcFileExistsNo = 0


Declare Function adh_accFileExists Lib "msaccess.exe" Alias "#57" _

 (ByVal strSrc As String) As Integer

Declare Function adh_accFullPath Lib "msaccess.exe" Alias "#58" _

 (ByVal strAbsPath As String, ByVal strFullPath As String, _

 ByVal cchFullPathMax As Integer) As Integer

Declare Sub adh_accSplitPath Lib "msaccess.exe" Alias "#59" _

 (ByVal strPath As String, ByVal strDrive As String, _

 ByVal strDir As String, ByVal strFName As String, ByVal strExt As String)


Public Const adhcAccErrGFNCantOpenDialog = -301

Public Const adhcAccErrGFNUserCancelledDialog = -302



Public Const adhcGfniConfirmReplace = &H1

Public Const adhcGfniNoChangeDir = &H2

Public Const adhcGfniAllowReadOnly = &H4

Public Const adhcGfniAllowMultiSelect = &H8

Public Const adhcGfniDirectoryOnly = &H20

Public Const adhcGfniInitializeView = &H40


Public Const adhcGfniViewDetails = 0

Public Const adhcGfniViewPreview = 1

Public Const adhcGfniViewProperties = 2

Public Const adhcGfniViewList = 3



Type adh_accOfficeGetFileNameInfo

    hwndOwner As Long

    strAppName As String * 255

    strDlgTitle As String * 255

    strOpenTitle As String * 255

    strFile As String * 4096

    strInitialDir As String * 255

    strFilter As String * 255

    lngFilterIndex As Long

    lngView As Long

    lngFlags As Long

End Type



Type tagOPENFILENAME

     lStructSize As Long

     hwndOwner As Long

     hInstance As Long

     strFilter As String

     strCustomFilter As String

     nMaxCustFilter As Long

     nFilterIndex As Long

     strFile As String

     nMaxFile As Long

     strFileTitle As String

     nMaxFileTitle As Long

     strInitialDir As String

     strTitle As String

     flags As Long

     nFileOffset As Integer

     nFileExtension As Integer

     strDefExt As String

     lCustData As Long

     lpfnHook As Long

     lpTemplateName As String

End Type



Declare Function adh_accOfficeGetFileName Lib "msaccess.exe" _

 Alias "#56" (gfni As adh_accOfficeGetFileNameInfo, ByVal fOpen As Integer) As Long

Declare Function adh_accChooseColor Lib "msaccess.exe" _

 Alias "#53" (ByVal hwnd As Long, RGB As Long) As Long



Declare Function adh_apiGetOpenFileName Lib "comdlg32.dll" _

 Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function adh_apiGetSaveFileName Lib "comdlg32.dll" _

 Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long


Global Const adhOFN_READONLY = &H1

Global Const adhOFN_OVERWRITEPROMPT = &H2

Global Const adhOFN_HIDEREADONLY = &H4

Global Const adhOFN_NOCHANGEDIR = &H8

Global Const adhOFN_SHOWHELP = &H10

Global Const adhOFN_NOVALIDATE = &H100

Global Const adhOFN_ALLOWMULTISELECT = &H200

Global Const adhOFN_EXTENSIONDIFFERENT = &H400

Global Const adhOFN_PATHMUSTEXIST = &H800

Global Const adhOFN_FILEMUSTEXIST = &H1000

Global Const adhOFN_CREATEPROMPT = &H2000

Global Const adhOFN_SHAREAWARE = &H4000

Global Const adhOFN_NOREADONLYRETURN = &H8000

Global Const adhOFN_NOTESTFILECREATE = &H10000

Global Const adhOFN_NONETWORKBUTTON = &H20000

Global Const adhOFN_NOLONGNAMES = &H40000

Global Const adhOFN_EXPLORER = &H80000

Global Const adhOFN_NODEREFERENCELINKS = &H100000

Global Const adhOFN_LONGNAMES = &H200000


Function adhCommonFileOpenSave( _

 Optional ByRef flags As Variant, _

 Optional ByVal InitialDir As Variant, _

 Optional ByVal Filter As Variant, _

 Optional ByVal FilterIndex As Variant, _

 Optional ByVal DefaultExt As Variant, _

 Optional ByVal FileName As Variant, _

 Optional ByVal DialogTitle As Variant, _

 Optional ByVal OpenFile As Variant) As Variant



    Dim OFN As tagOPENFILENAME

    Dim strFileName As String

    Dim strFileTitle As String

    Dim fResult As Boolean


    ' Give the dialog a caption title.

    If IsMissing(InitialDir) Then InitialDir = ""

    If IsMissing(Filter) Then Filter = ""

    If IsMissing(FilterIndex) Then FilterIndex = 1

    If IsMissing(flags) Then flags = 0&

    If IsMissing(DefaultExt) Then DefaultExt = ""

    If IsMissing(FileName) Then FileName = ""

    If IsMissing(DialogTitle) Then DialogTitle = ""

    If IsMissing(OpenFile) Then OpenFile = True


    strFileName = Left(FileName & String(256, 0), 256)

    strFileTitle = String(256, 0)


    With OFN

        .lStructSize = Len(OFN)

        .hwndOwner = Application.hWndAccessApp

        .strFilter = Filter

        .nFilterIndex = FilterIndex

        .strFile = strFileName

        .nMaxFile = Len(strFileName)

        .strFileTitle = strFileTitle

        .nMaxFileTitle = Len(strFileTitle)

        .strTitle = DialogTitle

        .flags = flags

        .strDefExt = DefaultExt

        .strInitialDir = CurDir


        .hInstance = 0

        .strCustomFilter = ""

        .nMaxCustFilter = 0

        .lpfnHook = 0

    End With



    If OpenFile Then

        fResult = adh_apiGetOpenFileName(OFN)

    Else

        fResult = adh_apiGetSaveFileName(OFN)

    End If



    If fResult Then

        If Not IsMissing(flags) Then flags = OFN.flags

        adhCommonFileOpenSave = adhTrimNull(OFN.strFile)

    Else

        adhCommonFileOpenSave = Null

    End If

End Function


Function adhAddFilterItem(strFilter As String, _

 strDescription As String, Optional varItem As Variant) As String


    

    If IsMissing(varItem) Then varItem = "*.*"

    adhAddFilterItem = strFilter & _

     strDescription & vbNullChar & _

     varItem & vbNullChar

     

End Function


Function adhTrimNull(ByVal strItem As String) As String


    

    Dim intPos As Integer

    

    intPos = InStr(strItem, vbNullChar)

    If intPos > 0 Then

        adhTrimNull = Left(strItem, intPos - 1)

    Else

        adhTrimNull = strItem

    End If

    

End Function

Function adhOfficeGetFileName(gfni As adh_accOfficeGetFileNameInfo, _

 ByVal fOpen As Integer) As Long


    

    Dim lng As Long

    With gfni

        .strAppName = RTrim$(.strAppName) & vbNullChar

        .strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar

        .strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar

        .strFile = RTrim$(.strFile) & vbNullChar

        .strInitialDir = RTrim$(.strInitialDir) & vbNullChar

        .strFilter = RTrim$(.strFilter) & vbNullChar

        SysCmd acSysCmdClearHelpTopic

        lng = adh_accOfficeGetFileName(gfni, fOpen)

        .strAppName = RTrim$(adhTrimNull(.strAppName))

        .strDlgTitle = RTrim$(adhTrimNull(.strDlgTitle))

        .strOpenTitle = RTrim$(adhTrimNull(.strOpenTitle))

        .strFile = RTrim$(adhTrimNull(.strFile))

        .strInitialDir = RTrim$(adhTrimNull(.strInitialDir))

        .strFilter = RTrim$(adhTrimNull(.strFilter))

    End With

    adhOfficeGetFileName = lng

End Function

ثم انشأ زر اخر على النموذج وسمه بأي اسم . وضع هذا الكود عند الضغط على الزر

 Dim lngFlags As Long

    Dim gfni As adh_accOfficeGetFileNameInfo

        

        lngFlags = lngFlags Or adhcGfniInitializeView

    With gfni

            .lngView = 1

        .lngFlags = lngFlags

        .strFilter = "صور jpg(*.jpg)|صور bmp(*.bmp)|صور gif(*.gif)|جميع الملفات(*.*)"

        .lngFilterIndex = 3

        .strFile = ""

        .strDlgTitle = "تحديد صورة "

        .strOpenTitle = "فتح"

        .strInitialDir = ""

    End With

    If adhOfficeGetFileName(gfni, True) = adhcAccErrSuccess Then

      الصورة.SourceDoc = Trim(gfni.strFile)

      الصورة.Action = acOLECreateLink

    End If

واذا اردت مسح الصورة انشأ زر اخر وضع هذا الكود فيه عند النقر

 [الصورة] = Null

ويمكن من خصائص النموذج في التوبيب غير ذلك ستجد بند

باسم قائمة مختصره غيره من نعم الى لا

وبذلك تبطل مفعول استخدام زر الفأرة الايمن

هذا الكود من مثال للاخ ابو هاجر

هذا والله اعلم

تم تعديل ديسمبر 5, 2003 بواسطه امير عاطف