سوال بخصوص عرض الصور الموجوده في الجهاز

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

default سوال بخصوص عرض الصور الموجوده في الجهاز

مُساهمة من طرف فيجوال بيسك 6 في الإثنين أكتوبر 30, 2006 12:09 am

كيف ممكن لي أن أعرض جميع الصور الموجود في جهازي

في برنامجي ماهو الكود؟

في الجهاز وليس في مجلد محدد أو درايف محدد (( في الجهاز كامل )

تحياتي للجميع

فيجوال بيسك 6
مراقب عام
مراقب عام

عدد الرسائل : 17
تاريخ التسجيل : 22/10/2006

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة اذهب الى الأسفل

default رد: سوال بخصوص عرض الصور الموجوده في الجهاز

مُساهمة من طرف Admin في الثلاثاء أكتوبر 31, 2006 8:48 pm

بسم الله الرحمن الرحيم

اشكرك اخي على هذا السؤال

يكمن التحدي في عرض جميع الصور الموجودة على الجهاز في تحديد مكان وجود كل صورة

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


اليك الكود اخي

اولا اضف للمشروع
زر امر وسمه Command1
اداة عرض الصور وسمها Image1
قائمة وسمها List1

ثم اضف هذا الكود

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)

Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"

nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DoEvents
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
DoEvents
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
List1.AddItem path & FileName
End If
Cont = FindNextFile(hSearch, WFD) ' Get next file
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
DoEvents
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Sub Command1_Click()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Screen.MousePointer = vbHourglass
List1.Clear
For i = 99 To 110
DoEvents
SearchPath = Chr(i) & ":\"
FindStr = "*.jpg"
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Screen.MousePointer = vbDefault
Next i
End Sub

Private Sub Form_Load()
Image1.Stretch = True
End Sub

Private Sub List1_Click()
On Error GoTo errorsub
Image1.Picture = LoadPicture(List1.List(List1.ListIndex))
errorsub:
If Err.Number > 0 Then
MsgBox Err.Description, vbCritical + vbOKOnly, "Error " & Err.Number
End If
End Sub


تستطيع الإطلاع على هذا المثال عن طريق هذه الوصلة

http://www.7mlo.com/up/Photo_cod.rar

_________________
إذا أعجبك موضوع من مواضيعي فلا تقل شكـراً ...
بل قل الآتـي ::
اللهم اغفر له ولوالديه ولزوجته وابنائه ولأخوانه واخواته ولسائر المسلمين ماتقدم من ذنبهم وما تأخر..
وقِهم عذاب القبر وعذاب النار..
و أدخلهم الفردوس الأعلى مع الأنبياء والشهداء والصالحين ..
واجعل دعاءهم مستجاب في الدنيا والآخرة ..
اللـهم آميـن..اللـهم آميـن..اللـهم آميـن..

اخوكم جاد القرعان
الأردن- الطفيلة
jadquraan@yahoo.com
jad_quraansoft@hotmail.com
00962777765709
avatar
Admin
jadquraan
jadquraan

عدد الرسائل : 125
العمر : 35
تاريخ التسجيل : 19/10/2006

معاينة صفحة البيانات الشخصي للعضو http://jad4vb.lightbb.com

الرجوع الى أعلى الصفحة اذهب الى الأسفل

default رد: سوال بخصوص عرض الصور الموجوده في الجهاز

مُساهمة من طرف فيجوال بيسك 6 في الأربعاء نوفمبر 01, 2006 12:06 am

كود جميل جداً أخي جاد

تحياتي لما تقدمه في المنتدى الراقي بكم أولاً

فيجوال بيسك 6
مراقب عام
مراقب عام

عدد الرسائل : 17
تاريخ التسجيل : 22/10/2006

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى