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



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



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



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


الملفات المرفقة
.rar   تحديد أكثر من عن&#.rar (الحجم : 2.59 ك ب / التحميلات : 50)
الرد }}}
تم الشكر بواسطة:
#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 .

- تحياتي لك .

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

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


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [vb6.0] كيف اجعل المستخدم التعديل على الأرقام في text1 فقط ولا يمكن مسحها ؟ Microformt 2 1,387 18-12-21, 01:41 PM
آخر رد: اسلام الكبابى
  عاجل هل يوجد اي برنامج ينفع مشروع تخرج جاهز مثال ابو عمر الشهري 1 1,635 24-11-20, 03:17 AM
آخر رد: Amir_Alzubidy
  [سؤال] مثال على حساب المجموع حسن ايت حدو 1 1,783 27-03-18, 04:13 PM
آخر رد: Omar Abd
  مثال حماية برنامجك برقم الهارد من تصمم نور نبهان وجدته في ملفاتي القديمة awidan76 2 2,314 03-02-18, 01:28 PM
آخر رد: awidan76
  [كود] التعديل على هذا الكود جزاكم الله خيراً عبد الرحمن على 15 5,318 09-05-17, 06:56 PM
آخر رد: عبد الرحمن على
  التعديل على كود انشاء ترقيم تلقائي ذاتي abouassem 14 12,053 12-04-17, 02:11 PM
آخر رد: Amir_Alzubidy
Smile سؤال بخصوص تقسيم ساعات اليوم ارجوا المشاركه استايل 10 3,985 03-11-16, 11:54 PM
آخر رد: الاصيله
  مساعده بخصوص كود منع نسخ الملفات من الجهاز nablion 9 5,641 23-08-16, 03:11 PM
آخر رد: ltfe
  [vb6.0] ارجو التعديل amer2000 2 2,193 08-08-16, 03:02 PM
آخر رد: amer2000
Smile سؤال بخصوص قراءة العدد العشري ارجوا الدخول استايل 6 4,249 28-07-16, 11:51 PM
آخر رد: استايل

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


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