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

نسخة كاملة : مثال لاختيار الملفات ارجوا التعديل عليه
أنت حالياً تتصفح نسخة خفيفة من المنتدى . مشاهدة نسخة كاملة مع جميع الأشكال الجمالية .
[COLOR="#0000FF"]السلام عليكم ورحمة الله



مرفق مثال لاختيار اكثر من ملف



المطلوب عند اختيار ملف واحد او اكثر من ملف يتم كتابه اسماء الملفات المختارة في قائمة ListView



وجزاكم الله خيرا[/COLOR]
السلام عليكم

كود :
Private Function GetFileName(sFile As String) As String
On Error Resume Next: Err.Clear

If InStr(1, sFile, "\") = 0 Then GetFileName = sFile: Exit Function
sFile = StrReverse(sFile)
sFile = Left$(sFile, InStr(1, sFile, "\") - 1)
GetFileName = StrReverse(sFile)

End Function


Private Function GetFilePath(gFile As String) As String
On Error Resume Next: Err.Clear

If InStr(1, gFile, "\") = 0 Then GetFilePath = gFile: Exit Function
gFile = StrReverse(gFile)
gFile = Mid$(gFile, InStr(1, gFile, "\"))
GetFilePath = StrReverse(gFile)

End Function


Private Function Is_InListView(sFileName As String) As Boolean
On Error Resume Next: Err.Clear

Dim H As Integer

For H = 1 To ListView1.ListItems.Count
    If Trim$(sFileName) = Trim$(ListView1.ListItems.Item(H).Text) Then
       Is_InListView = True
       DoEvents
       Exit Function
    End If
Next

Is_InListView = False
DoEvents

End Function

Private Sub Command1_Click()
On Error Resume Next: Err.Clear

CommonDialog1.FileName = ""
CommonDialog1.Filter = "All Files|*.*"
CommonDialog1.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly
CommonDialog1.ShowOpen

If Trim$(CommonDialog1.FileName) = "" Then Exit Sub

Dim vFiles As Variant
Dim iFile As Long
Dim zItem As ListItem
Dim zFilesPath As String

Me.MousePointer = 11

vFiles = Split(CommonDialog1.FileName, Chr$(0))
DoEvents

If UBound(vFiles) = 0 Then

   zFilesPath = GetFilePath(Trim$(vFiles(0)))
   DoEvents
   If Right$(Trim$(zFilesPath), 1) <> "\" Then zFilesPath = Trim$(zFilesPath) & "\"
  
   If Is_InListView(Trim$(GetFileName(Trim$(vFiles(0))))) = False Then
  
      Set zItem = ListView1.ListItems.Add(, , GetFileName(Trim$(vFiles(0))), 1, 1)
      DoEvents
            
   End If
  
Else

   zFilesPath = Trim$(vFiles(0))
   DoEvents
   If Right$(Trim$(zFilesPath), 1) <> "\" Then zFilesPath = Trim$(zFilesPath) & "\"
  
   For lFile = 1 To UBound(vFiles)

       If Is_InListView(Trim$(vFiles(lFile))) = False Then
      
          Set zItem = ListView1.ListItems.Add(, , Trim$(vFiles(lFile)), 1, 1)
          DoEvents
              
       End If
    
   Next

End If

Me.MousePointer = 0

End Sub
VB_Coder كتب :السلام عليكم

كود :
Private Function GetFileName(sFile As String) As String
On Error Resume Next: Err.Clear

If InStr(1, sFile, "\") = 0 Then GetFileName = sFile: Exit Function
sFile = StrReverse(sFile)
sFile = Left$(sFile, InStr(1, sFile, "\") - 1)
GetFileName = StrReverse(sFile)

End Function


Private Function GetFilePath(gFile As String) As String
On Error Resume Next: Err.Clear

If InStr(1, gFile, "\") = 0 Then GetFilePath = gFile: Exit Function
gFile = StrReverse(gFile)
gFile = Mid$(gFile, InStr(1, gFile, "\"))
GetFilePath = StrReverse(gFile)

End Function


Private Function Is_InListView(sFileName As String) As Boolean
On Error Resume Next: Err.Clear

Dim H As Integer

For H = 1 To ListView1.ListItems.Count
    If Trim$(sFileName) = Trim$(ListView1.ListItems.Item(H).Text) Then
       Is_InListView = True
       DoEvents
       Exit Function
    End If
Next

Is_InListView = False
DoEvents

End Function

Private Sub Command1_Click()
On Error Resume Next: Err.Clear

CommonDialog1.FileName = ""
CommonDialog1.Filter = "All Files|*.*"
CommonDialog1.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly
CommonDialog1.ShowOpen

If Trim$(CommonDialog1.FileName) = "" Then Exit Sub

Dim vFiles As Variant
Dim iFile As Long
Dim zItem As ListItem
Dim zFilesPath As String

Me.MousePointer = 11

vFiles = Split(CommonDialog1.FileName, Chr$(0))
DoEvents

If UBound(vFiles) = 0 Then

   zFilesPath = GetFilePath(Trim$(vFiles(0)))
   DoEvents
   If Right$(Trim$(zFilesPath), 1) <> "\" Then zFilesPath = Trim$(zFilesPath) & "\"
  
   If Is_InListView(Trim$(GetFileName(Trim$(vFiles(0))))) = False Then
  
      Set zItem = ListView1.ListItems.Add(, , GetFileName(Trim$(vFiles(0))), 1, 1)
      DoEvents
            
   End If
  
Else

   zFilesPath = Trim$(vFiles(0))
   DoEvents
   If Right$(Trim$(zFilesPath), 1) <> "\" Then zFilesPath = Trim$(zFilesPath) & "\"
  
   For lFile = 1 To UBound(vFiles)

       If Is_InListView(Trim$(vFiles(lFile))) = False Then
      
          Set zItem = ListView1.ListItems.Add(, , Trim$(vFiles(lFile)), 1, 1)
          DoEvents
              
       End If
    
   Next

End If

Me.MousePointer = 0

End Sub


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

وغفر لنا ولك ولوالديك

جاري التجربة
السلام عليكم

- إذا لم يكن في برنامجك أداة ImagList فقم بتعديل أو بإزالة الرقم 1 من أسطر الإضافة حيث أن الرقم 1 هو رقم الأيقونة في أداة الImageList .

- تحياتي لك .
VB_Coder كتب :السلام عليكم

- إذا لم يكن في برنامجك أداة ImagList فقم بتعديل أو بإزالة الرقم 1 من أسطر الإضافة حيث أن الرقم 1 هو رقم الأيقونة في أداة الImageList .

- تحياتي لك .

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

تم عمل اللازم