VB - ملء TreeView مع أقراص النظام والدلائل الخاصة بهم
إليك روتين يمكن أن يملأ TreeView بأقراص النظام وأدلةها.
وصف
كانت المشكلة هي العثور على مفتاح العقد ، حيث يتم أحيانًا نشر مفتاح مرتين ، ثم وجدت حلاً:
- استخدم المسار الكامل كمفتاح وبهذه الطريقة ، من المؤكد أنه لن يكون هناك تكرار.
- لم أتمكن من اختبار محركات أقراص الشبكة
- ألغيت أدلة النظام ، وهدفي هو جعل استكشاف الصورة (متاحًا للتنزيل).
- الروتين متكرر وقصير نسبيا.
- لا تتفاجأ من الوقت الذي تستغرقه (وفقًا لنظامك) ، ولكن الروتين يكون بنفس سرعة مستكشف Windows تقريبًا باستثناء أنه لا يتم تشغيله تلقائيًا مثل بدء التشغيل.
- يمكنك تحميل المشروع استغلال صورة كاملة في VB6.
- عند النقر فوق صورة ، تعرض الرسالة الرقم والمسار الكامل للصورة.
- يمكنك أيضًا تغيير المرشحات للسماح بعرض الصور الأخرى.
يحتوي المشروع على OCX و DLL مخصص ، يجب عليك:
- بفك المجلد.
- لا تنقر على المشروع ، انتقل إلى أيقونة VB6 ، انقر بزر الماوس الأيمن على الأيقونة وافتح كمسؤول.
- في الافتتاح ، انقر فوق "موجود" وافتح مشروع LN_Explorateur.vpb
- تعديل عرض TreeView عن طريق تحريك الخط الأحمر (انقر على الخط وحركه).
- قم بتغيير حجم الصور المصغرة باستخدام المفتاح "S".
يتم تنفيذ عرض الصورة مع تخفيض Gdi + dll إلى أبسط تعبير له.
- أعتقد أن الروتين يمكن نقله بسهولة إلى VB.Net
الشفرة
الخيار صريح
Sub Initialise_TreeDir (TreeDir باسم TreeView) Dim ExpDr، Rep، Drv، S As String، N، D، a، r، Unite Dim Cle As String، sCle As String، Num As Integer، Sr As Integer Dim nodX Num = 64 تعيين ExpDr = CreateObject ("Scripting.FileSystemObject") تعيين Drv = ExpDr.Drives لكل D في Drv S = D.DriveLetter '& ":" If D.DriveType = 3 ، ثم Réseaux N = D.ShareName ElseIf D.DriveType = 1 ثم 'DD externe N = "- Média amovible - (" & D.VolumeName & ")" Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (،، Cle، S & N ، 6) AjoutRep S، Cle، TreeDir ElseIf D.DriveType = 2 Then 'DD N = D.VolumeName Incr Num: Cle = SS = S & ": \" Set nodX = TreeDir.Nodes.Add (،، Cle ، S & "- (" & N & ")"، 2) AjoutRep S، Cle، TreeDir ElseIf D.DriveType = 4 Then 'DVD On Error Resume Next N = D.VolumeName If Err = 71 Then N = "Lecteur DVD - (vide) "Else N =" Lecteur DVD - ("& N &") "End If Incr Num: Cle = Chr (Num) &" 0 "S = S &": \ - "Set nodX = TreeDir.Nodes .Add (،، Cle، S & N، 3) Else Stop End If S = "" D = "" المجموعة التالية nodX = Nothing Set ExpDr = Nothing Set Drv = Nothing End Sub Sub AjoutRep (Chem As String، Cle As String، TreeDir As TreeView) Dim Rep، sRp، Obj، sRep، sR2 Dim sCle As String، Num As Integer ، Sr كـ عدد صحيح خافت nodX مثل عقدة Dim NbsR كـ عدد صحيح ، S As String Sr = 9 Chem = Chem & IIf (يمين (Chem، 1) = "\"، ""، "\") تعيين Obj = CreateObject ("Scripting .FileSystemObject ") Set Rep = Obj.Getfolder (Chem) If Left (Rep.Name، 1) =" $ "ثم GoTo Passe2 Set sRep = Rep.subfolders لكل sRp في sRep S = UCase (sRp.Name) في حالة اليسار (S، 1) = "$" أو S = "WINDOWS" أو sRp.Attributes> 100 أو sRp.Attributes = 19 _ أو Left (S، 6) = "SYSTEM" أو Left (S، 7) = "PROGRAM" أو Left (S، 4) = "USER" _ أو Left (S، 6) = "DRIVER" أو Left (S، 5) = "TOOLS" ثم GoTo Passe On Error استئناف المجموعة التالية sR2 = sRp.subfolders NbsR = sR2 .Count If Err 0 ثم Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "\" On Error GoTo 0 'Debug.Print sRp.Name؛ ""؛ كلي. ""؛ sCle Set nodX = TreeDir.Nodes.Add (Cle، tvwChild، sCle، sRp.Name، 5، 4) If NbsR> 0 Then AjoutRep sRp.Path، sCle، TreeDir End If Passe: Next Passe2: Set Obj = Nothing Set Rep = Nothing Set sRep = Nothing Set nodX = Nothing Set sR2 = Nothing End Sub
التنزيلات
- LINK1
- LINK2