|
| |
Visual-Basic Einsteiger| Re: Speichern Dialog | |  | | Autor: Norbert | | Datum: 25.04.02 16:51 |
| Hallo, habe es selbst programmiert, hier der Code des Formulars:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTvi
Caption = "Auswahl Verzeichnis"
ClientHeight = 4056
ClientLeft = 1140
ClientTop = 1512
ClientWidth = 5352
BeginProperty Font
Name = "Arial"
Size = 10.2
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "TreeView.frx":0000
LinkTopic = "Form1"
PaletteMode = 1 'ZReihenfolge
ScaleHeight = 4056
ScaleWidth = 5352
StartUpPosition = 1 'Fenstermitte
Begin VB.CommandButton cmdAufwärts
Caption = "A&ufwärts"
Height = 375
Left = 4080
TabIndex = 4
Top = 960
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton cmdAbbruch
Caption = "&Abbruch"
Height = 375
Left = 4080
TabIndex = 2
Top = 480
Width = 1215
End
Begin VB.CommandButton cmdOk
Caption = "&Ok"
Height = 375
Left = 4080
TabIndex = 3
Top = 0
Width = 1215
End
Begin VB.DriveListBox drvLaufwerk
Height = 324
Left = 0
TabIndex = 1
Top = 0
Visible = 0 'False
Width = 3975
End
Begin MSComctlLib.TreeView tviBaum
Height = 3975
Left = 0
TabIndex = 0
Top = 0
Width = 3975
_ExtentX = 7006
_ExtentY = 7006
_Version = 393217
Indentation = 176
LabelEdit = 1
LineStyle = 1
Sorted = -1 'True
Style = 7
FullRowSelect = -1 'True
ImageList = "TreeImages"
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 10.2
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComctlLib.ImageList TreeImages
Left = 4200
Top = 2040
_ExtentX = 995
_ExtentY = 995
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "TreeView.frx":030A
Key = "closed"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "TreeView.frx":085C
Key = "open"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "TreeView.frx":0DAE
Key = "leaf"
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmTvi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'// File: frmTvi.frm
'// Version: $Id: treeview.frm,v 1.13 2001/10/09 09:41:10 deb004w7 Exp $
'// Description: Formular für die Auswahl eines Vezeichnisses zum Auspacken
'// Revision:
'// Created: 9.11.2000
'// Author: Seltmann
'// Changes:
'// Date Name Remark
'// 11.2.2002 Seltmann Resize-Ereigniss angepaßt auf Minimize
'// Description of the implemented class / method
'/**************************************************************
Option Explicit
Dim Fso As New FileSystemObject
Dim AllowExpand As Boolean
Private Sub cmdAbbruch_Click()
Prm.Auswahl = False
Unload Me
End Sub
Private Sub cmdOk_Click()
On Error GoTo mrkError
Prm.Auswahl = True
If Not (tviBaum.SelectedItem Is Nothing) Then Prm.Pfad = tviBaum.SelectedItem.FullPath
Unload Me
GoTo mrkEnde
mrkError: BkLog.ErrMessageF "frmTvi.cmdOk", "Auswahl Verzeichnis"
mrkEnde:
End Sub
' Wurzel des aktuellen Laufwerks anzeigen
Private Sub Form_Load()
Dim PLis() As String
Dim Index As Integer
ReDim PLis(SDir.DirSelectHome.Count)
For Index = 0 To UBound(PLis()) - 1
BkLog.WriteDebug "SDir.DirSelectHome.Wert(" + CStr(Index) + ") = " + SDir.DirSelectHome.Wert(Index), 1
PLis(Index) = ExpandEnv(SDir.DirSelectHome.Wert(Index))
BkLog.WriteDebug "PLis (" + CStr(Index) + ") = " + PLis(Index), 1
Next Index
InitTvi True, PLis()
End Sub
'/**************************************************************
'%FUNC
' InitTvi()
'SYNOPSIS
' InitTvi(SetPfad As Boolean, PLis() As String)
'Description
'Eine Liste von Verzeichnisnamen wird in einem Baum dargestellt
'Parameter
' SetPfad As Boolean gibt an, ob der aktuelle Pfad gesucht und expandiert werden soll
' PLis() As String Liste von Verzeichnisnamen, die im Baum angezeigt werden soll
' Verzeichnisname
'Errors
' none
'HINTS
' none
'%FEND
'**********************************************************/
Public Function InitTvi(SetPfad As Boolean, PLis() As String)
Dim NodX As Node, Drv As String, PDrv As String
Dim Index As Integer
On Error GoTo mrkError
tviBaum.Nodes.Clear
If SetPfad = True Then
For Index = 0 To UBound(PLis()) - 1
If Not (Dir(PLis(Index), vbDirectory) = "") Then
Set NodX = tviBaum.Nodes.Add(, , , PLis(Index), "closed")
AllowExpand = False
ExpandNode NodX, False
AllowExpand = True
End If
Next Index
Else
For Index = 0 To UBound(PLis()) - 1
If Not (Dir(PLis(Index), vbDirectory) = "") Then
Set NodX = tviBaum.Nodes.Add(, , , PLis(Index), "closed")
AllowExpand = False
ExpandNode NodX, False
AllowExpand = True
End If
Next Index
End If
GoTo mrkEnde
mrkError: BkLog.ErrMessageF "InitTvi", "Auswahl Verzeichnis"
mrkEnde:
End Function
'/**************************************************************
'%FUNC
' Form_Resize()
'SYNOPSIS
' Form_Resize
'Description
'Die Fenstergröße wird nach Benutzeraktion (Ziehen des Fensterrandes) verändert
'Parameter
' none
'Errors
' none
'HINTS
' none
'// Changes:
'// Date Name Remark
'%FEND
'**********************************************************/
Private Sub Form_Resize()
If ScaleHeight - tviBaum.Top > 0 Then tviBaum.Height = ScaleHeight - tviBaum.Top
If ScaleWidth - cmdAbbruch.Width - 60 > 0 Then tviBaum.Width = ScaleWidth - cmdAbbruch.Width - 60
If tviBaum.Left + tviBaum.Width + 30 > 0 Then cmdAbbruch.Left = tviBaum.Left + tviBaum.Width + 30
If tviBaum.Left + tviBaum.Width + 30 > 0 Then cmdOk.Left = tviBaum.Left + tviBaum.Width + 30
If tviBaum.Left + tviBaum.Width + 30 > 0 Then cmdAufwärts.Left = tviBaum.Left + tviBaum.Width + 30
End Sub
Private Sub tviBaum_DblClick()
cmdOk_Click
End Sub
Private Sub tviBaum_Expand(ByVal Node As MSComctlLib.Node)
CallExpandNode Node, False
End Sub
' ein Subverzeichnis einlesen
Private Sub tviBaum_NodeClick(ByVal Node As Node)
CallExpandNode Node, True
End Sub
'/**************************************************************
'%FUNC
' CallExpandNode()
'SYNOPSIS
' CallExpandNode(Node As Node, Expanded As Boolean)
'Description
'Diese Funktion wird aufgerufen, falls der Benutzer die "+"-Markierung eines Zweiges anklickt. Ist der Zweig bereits expandiert, dann wird er geschlossen, andernfalls wird er expandiert.
' ExpandChild wird aufgerufen, um die Elemente, die weitere Unterelemente haben, mit "+" zu markieren
'AllowExpand wird dazu verwendet, um rekursive Aufrufe durch die Ereignisse, die beim Expandieren aufgerufen werden, zu vermeiden
'Parameter
' SetPfad As Boolean gibt an, ob der aktuelle Pfad gesucht und expandiert werden soll
' PLis() As String Liste von Verzeichnisnamen, die im Baum angezeigt werden soll
' Verzeichnisname
'Errors
' none
'HINTS
' none
'%FEND
'**********************************************************/
Public Function CallExpandNode(Node As Node, Expanded As Boolean)
If AllowExpand = True Then
AllowExpand = False
If Node.Children = 0 Then
ExpandNode Node, True
Else
ExpandChild Node
End If
If Expanded = True Then Node.Expanded = Not (Node.Expanded)
AllowExpand = True
End If
End Function
'/**************************************************************
'%FUNC
' ExpandNode()
'SYNOPSIS
' ExpandNode(NodX1 As Node, ExpandChild As Boolean)
'Description
'Diese Funktion wird aufgerufen, falls der Benutzer die "+"-Markierung eines Zweiges anklickt. Ist der Zweig bereits expandiert, dann wird er geschlossen, andernfalls wird er expandiert.
' ExpandChild wird aufgerufen, um die Elemente, die weitere Unterelemente haben, mit "+" zu markieren
'AllowExpand wird dazu verwendet, um rekursive Aufrufe durch die Ereignisse, die beim Expandieren aufgerufen werden, zu vermeiden
' Zum angeklickten Pfad wird ein FSO-Objekt erstellt und festgestellt, welchen Inhalt dieser Pfad hat, welche Verzeichnisse darunterliegen
'Parameter
' NodX1 As Node Zweig, der angeklickt wurde und expandierd werden soll
' ExpandChild Angabe, ob die Unterelemente der durch Expansion gewonnenen Elemente ermittelt werden sollen
'Errors
' none
'HINTS
' none
'%FEND
'**********************************************************/
Sub ExpandNode(NodX1 As Node, ExpandChild As Boolean)
Dim Pfad As String, NodX As Node, CN As Node
Dim Fld As Folder, SubFld As Folder
Pfad = NodX1.FullPath
If Right(Pfad, 1) <> "\" Then Pfad = Pfad + "\"
If Not (Dir(Pfad, vbDirectory) = "") Then
Set Fld = Fso.GetFolder(Pfad) 'Folder-Objekt des aktuellen Verz.
For Each SubFld In Fld.SubFolders 'Schleife über alle Unterverzeichnisse
Set NodX = tviBaum.Nodes.Add(NodX1.Index, tvwChild, , SubFld.Name, "closed")
NodX.ExpandedImage = "open"
Next
NodX1.Sorted = True
If ExpandChild = True And NodX1.Children > 0 Then
Set CN = NodX1.Child
While Not (CN Is Nothing)
ExpandNode CN, False
Set CN = CN.Next
Wend
End If
End If
End Sub
'/**************************************************************
'%FUNC
' ExpandChild()
'SYNOPSIS
' ExpandChild(NodX1 As Node)
'Description
'Die Unterknoten eines angeklickten Pfades wird expandiert, um die Markierung der Äste anzuzeigen und zu visualisieren, ob es weitere Unterverzeichnisse gibt
'Parameter
' NodX1 As Node Zweig, der angeklickt wurde und expandierd werden soll
'Errors
' none
'HINTS
' none
'%FEND
'**********************************************************/
Public Sub ExpandChild(NodX As Node)
Dim CN As Node
If Not (NodX Is Nothing) Then
Set CN = NodX.Child
While Not (CN Is Nothing)
If CN.Children = 0 Then ExpandNode CN, False
Set CN = CN.Next
Wend
End If
End Sub | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
vb@rchiv CD Vol.6 vb@rchiv  Vol.6
Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
Online-Update-Funktion
Entwickler-Vollversionen
u.v.m.Jetzt zugreifen Tipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) sevWizard für VB5/6 
Professionelle Assistenten im Handumdrehen
Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) Weitere Infos
|
Sie sind aktuell nicht angemeldet.
