تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مثال لاختيار الملفات ارجوا التعديل عليه
#1
[COLOR="#0000FF"]السلام عليكم ورحمة الله



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



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



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


الملفات المرفقة
.rar   تحديد أكثر من عن&#.rar (الحجم : 2.59 ك ب / التحميلات : 29)
الرد }}}}
تم الشكر بواسطة:
#2
السلام عليكم

كود :
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
الرد }}}}
تم الشكر بواسطة:
#3
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


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

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

جاري التجربة
الرد }}}}
تم الشكر بواسطة:
#4
السلام عليكم

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

- تحياتي لك .
الرد }}}}
تم الشكر بواسطة:
#5
VB_Coder كتب :السلام عليكم

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

- تحياتي لك .

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

تم عمل اللازم
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Smile سؤال بخصوص تقسيم ساعات اليوم ارجوا المشاركه استايل 10 258 03-11-16, 11:54 PM
آخر رد: الاصيله
  مساعده بخصوص كود منع نسخ الملفات من الجهاز nablion 9 1,198 23-08-16, 03:11 PM
آخر رد: ltfe
  [vb6.0] ارجو التعديل amer2000 2 132 08-08-16, 03:02 PM
آخر رد: amer2000
Smile سؤال بخصوص قراءة العدد العشري ارجوا الدخول استايل 6 194 28-07-16, 11:51 PM
آخر رد: استايل
Sad مشكلة في msgbox ارجوا الدخول استايل 4 169 23-07-16, 04:45 AM
آخر رد: استايل
  وضع علامة ونص على الصورة وحفظها بعد التعديل أبو عمر 4 271 03-10-15, 02:24 PM
آخر رد: أبو عمر
  التعديل على كود انشاء ترقيم تلقائي ذاتي abouassem 12 3,424 07-04-15, 11:30 AM
آخر رد: الرجاء الوفيه
  نسخ مجموعة من الملفات alglad 1 311 07-05-14, 10:31 PM
آخر رد: سعود
  تغير لون النص الكوماند عند مرور المؤشر عليه ويرجع اللون الى اصله عند ابتعاد المؤشر عنه علي عبد الوهاب 2 603 31-07-13, 09:21 PM
آخر رد: عبد الله190
  تعيير لون textboxعند الكتابة عليه AHMED213 3 450 15-07-13, 10:51 PM
آخر رد: samee119485r

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم