title image


Smiley Re: noch was ....
Hallo,



Wenn Du diese Zeile auskommentierst, wo bleibt dann der Kursor stehen?

' + On Error GoTo OnError



Viel Zeit habe ich zwar nicht, aber:



!!! Jeder Knoten muss ein eindeutiger Key haben !!!



::: Modul modINI :::

Option Explicit'Zweck: The GetPrivateProfileString function retrieves a string from the specified section in an initialization file. This function is provided for compatibility with 16-bit Windows-based applications.'Parameter: lpAppName        Points to a null-terminated string that specifies the section containing the key name. If this parameter is NULL, the GetPrivateProfileString function copies all section names in the file to the supplied buffer.'Parameter: lpKeyName        Pointer to the null-terminated string containing the key name whose associated string is to be retrieved. If this parameter is NULL, all key names in the section specified by the lpAppName parameter are copied to the buffer specified by the lpReturnedString parameter.'Parameter: lpDefault        Pointer to a null-terminated default string. If the lpKeyName key cannot be found in the initialization file, GetPrivateProfileString copies the default string to the lpReturnedString buffer. This parameter cannot be NULL.'Parameter: lpReturnedString Pointer to the buffer that receives the retrieved string.'Parameter: nSize            Specifies the size, in characters, of the buffer pointed to by the lpReturnedString parameter.'Parameter: lpFileName       Pointer to a null-terminated string that names the initialization file. If this parameter does not contain a full path to the file, Windows searches for the file in the Windows directory.Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long'Zweck: The WritePrivateProfileString function copies a string into the specified section of the specified initialization file.This function is provided for compatibility with 16-bit Windows-based applications.'Parameter: lpAppName  Points to a null-terminated string containing the name of the section to which the string will be copied. If the section does not exist, it is created. The name of the section is case-independent; the string can be any combination of uppercase and lowercase letters.'Parameter: lpKeyName  Points to the null-terminated string containing the name of the key to be associated with a string. If the key does not exist in the specified section, it is created. If this parameter is NULL, the entire section, including all entries within the section, is deleted.'Parameter: lpString   Points to a null-terminated string to be written to the file. If this parameter is NULL, the key pointed to by the lpKeyName parameter is deleted.'Parameter: lpFileName Points to a null-terminated string that names the initialization file.Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As LongPrivate Const nKey_Size      As Long = 1024  'Größe eines Schlüssels.'Zweck: Diese Funktion liest einen Wert aus INI-Datei raus.'Parameter: sSection Abschnitt, in dem der folgende Schlüssel existiert.'Parameter: sKey     Schlüssel, dessen Wert rausgelesen werden muss.'Parameter: sPath    Pfad einer INI-Datei.Public Function INI_Value_Read(ByVal sSection As String, _                               ByVal sKey As String, _                               ByVal sPath As String) As String   Dim sBuffer As String   Dim nSize   As Long   Dim nReturn As Long   sBuffer = Space$(nKey_Size)   nSize = Len(sBuffer)   nReturn = GetPrivateProfileString(sSection, sKey, 0, sBuffer, nSize, sPath)   If (nSize > 0) Then      INI_Value_Read = Left$(sBuffer, nReturn)   Else      INI_Value_Read = ""   End IfEnd Function'Zweck: Diese Prozedur schreibt einen Wert in eine INI-Datei rein.'Parameter: sSection Abschnitt, in dem der folgende Schlüssel existiert/angelegt wird.'Parameter: sKey     Schlüssel, dessen Wert reingelesen werden muss.'Parameter: sValue   Wert, der reingeschrieben wird.'Parameter: sPath    Pfad einer INI-Datei.Public Sub INI_Value_Write(ByVal sSection As String, _                           ByVal sKey As String, _                           ByVal sValue As String, _                           ByVal sPath As String)   Dim nPosition As Long   Dim nReturn   As Long   'chr$(0) in dem Wert suchen   nPosition = InStr(sValue, Chr$(0))   'chr$(0) aus dem Wert entfernen   Do While Not nPosition = 0      sValue = Left$(sValue, (nPosition - 1)) & Mid$(sValue, (nPosition + 1))      nPosition = InStr(sValue, Chr$(0))   Loop   nReturn = WritePrivateProfileString(sSection, sKey, sValue, sPath)End Sub



:::Hauptformular:::

Option ExplicitPrivate SelectedNode As MSComctlLib.Node ' Sicherung den ausgewählten Knoten in der Baumstruktur'Zweck: Baim Laden des Formulars wird eine Demo-Baumstruktur aufgebaut.Private Sub Form_Load()'   ' Knoten erstellen'   TreeView1.Nodes.Add , , "Node1", "Node1"'   TreeView1.Nodes.Add "Node1", MSComctlLib.tvwChild, "Node1.1", "Node1.1"'   TreeView1.Nodes.Add "Node1", MSComctlLib.tvwChild, "Node1.2", "Node1.2"'   TreeView1.Nodes.Add , , "Node2", "Node2"''   ' Knoten öffnen'   TreeView1.Nodes("Node1").Expanded = True   Call LoadTreeViewEnd SubPrivate Sub Form_Unload(Cancel As Integer)   Call SaveTreeViewEnd Sub'Zweck: Wenn die Maus über dem TreeView losgelassen wird, dann...Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)   ' Wenn nicht die rechte Maustaste losgelassen wurden dann...   If Not Button = VBRUN.MouseButtonConstants.vbRightButton Then      Exit Sub   End If   ' Knoten unter der Maus ermitteln   Set SelectedNode = TreeView1.HitTest(x, y)   ' Ist kein Knoten unter der Maus   If SelectedNode Is Nothing Then      ' dann kann man nur einen Hauptknoten anlegen      mnu_TreeView_AddNew.Visible = True      mnu_TreeView_AddSub.Visible = False      mnu_TreeView_Delete.Visible = False   Else ' es ist ein Knoten unter der Maus      ' so kann man diesen löschen, oder einen Unterknoten erstellen      mnu_TreeView_AddSub.Visible = True      mnu_TreeView_Delete.Visible = True      mnu_TreeView_AddNew.Visible = False   End If   ' Popup-Menü anzeigen   Me.PopupMenu mnu_TreeView, , TreeView1.Left + x, TreeView1.Top + yEnd Sub'Zweck: Ein Hauptknoten anlegen.Private Sub mnu_TreeView_AddNew_Click()   On Error GoTo OnError   Dim sDate As Single   Dim sTime As SingleGetNewID:   ' Eindeutige Nummer ermitteln   sDate = CSng(Date)   sTime = CSng(Time)   ' Ein Hauptknoten erstellen   TreeView1.Nodes.Add , , "NodeAt" & CStr(sDate) & CStr(sTime), _                           "Knoten " & CStr(CDate(sDate)) & " " & CStr(CDate(sTime))   Exit SubOnError:   ' Wenn zwei Knoten in einer Sekunde erstellt werden,   ' dann wird beim zweitem Beep ausgelösst   If Err.Number = 35602 Then      Beep   Else      MsgBox Err.Description, vbCritical, Err.Source & " [" & Err.Number & "]"   End IfEnd Sub'Zweck: Ein Unterknoten unter dem ausgewähltem anlegen.Private Sub mnu_TreeView_AddSub_Click()   On Error GoTo OnError   Dim sDate As Single   Dim sTime As Single   ' Wenn kein Knoten ausgewählt ist, dann...   If SelectedNode Is Nothing Then      Beep      Exit Sub   End IfGetNewID:   ' Eindeutige Nummer ermitteln   sDate = CSng(Date)   sTime = CSng(Time)   ' Ein Hauptknoten erstellen   TreeView1.Nodes.Add SelectedNode.Key, _                       MSComctlLib.tvwChild, _                       "NodeAt" & CStr(sDate) & CStr(sTime), _                       "Knoten " & CStr(CDate(sDate)) & " " & CStr(CDate(sTime))   ' Ausgewählten Knoten öffnen   SelectedNode.Expanded = True   Exit SubOnError:   ' Wenn zwei Knoten in einer Sekunde erstellt werden,   ' dann wird beim zweitem Beep ausgelösst   If Err.Number = 35602 Then      Beep   Else      MsgBox Err.Description, vbCritical, Err.Source & " [" & Err.Number & "]"   End IfEnd Sub'Zweck: Den ausgewählten Knoten löschen.Private Sub mnu_TreeView_Delete_Click()   ' Wenn kein Knoten ausgewählt ist, dann...   If SelectedNode Is Nothing Then      Beep      Exit Sub   End If   ' Ausgewählten Knoten löschen   ' Alle Unterknoten werden automatisch mitentfernt   TreeView1.Nodes.Remove SelectedNode.IndexEnd Sub'Zweck: Diese Prozedur speichert alle Hauptknoten.Private Sub SaveTreeView()   Dim lNum As Long ' Zähler der Hauptknoten   Dim oNode As MSComctlLib.Node   ' Alte Datei löschen   Open App.Path & "\data.ini" For Output As #1   Close #1   Kill App.Path & "\data.ini"   ' Alle Knoten durchgehen   For Each oNode In TreeView1.Nodes      ' Wenn der Knoten keine Unterknoten hat, dann...      If oNode.Parent Is Nothing Then         lNum = lNum + 1         modINI.INI_Value_Write "MainNodes", CStr(lNum) & "Key", oNode.Key, App.Path & "\data.ini"         modINI.INI_Value_Write "MainNodes", CStr(lNum) & "Txt", oNode.Text, App.Path & "\data.ini"         ' Alle Unterknoten speichern         SaveSubTreeNodes oNode      End If   Next oNode   ' Anzahl speichern   If lNum > 0 Then      modINI.INI_Value_Write "MainNodes", "Count", CStr(lNum), App.Path & "\data.ini"   End IfEnd Sub'Zweck: Diese Prozedur speichert alle Unterknoten eines Hauptknotens.Private Sub SaveSubTreeNodes(ByVal oNode As MSComctlLib.Node)   Dim lNum As Long ' Zähler der Hauptknoten   Dim oSubNode As MSComctlLib.Node   ' Alle Knoten durchgehen   For Each oSubNode In TreeView1.Nodes      ' Wenn der Knoten keine Unterknoten hat, dann...      If oSubNode.Parent Is oNode Then         lNum = lNum + 1         modINI.INI_Value_Write "SubNode_" & oNode.Key, CStr(lNum) & "Key", oSubNode.Key, App.Path & "\data.ini"         modINI.INI_Value_Write "SubNode_" & oNode.Key, CStr(lNum) & "Txt", oSubNode.Text, App.Path & "\data.ini"         ' Alle Unterknoten speichern         SaveSubTreeNodes oSubNode      End If   Next oSubNode   ' Anzahl speichern   If lNum > 0 Then      modINI.INI_Value_Write "SubNode_" & oNode.Key, "Count", CStr(lNum), App.Path & "\data.ini"   End IfEnd Sub'Zweck: Diese Prozedur lädt alle Hauptknoten.Private Sub LoadTreeView()   Dim lNum As Long   ' Alle Hauptknoten durchgehen   For lNum = 1 To CLng(modINI.INI_Value_Read("MainNodes", "Count", App.Path & "\data.ini"))      ' Den Knoten erstellen      TreeView1.Nodes.Add , , modINI.INI_Value_Read("MainNodes", CStr(lNum) & "Key", App.Path & "\data.ini"), _                              modINI.INI_Value_Read("MainNodes", CStr(lNum) & "Txt", App.Path & "\data.ini")      ' Alle Unterknoten finden und erstellen      LoadSubTreeNodes modINI.INI_Value_Read("MainNodes", CStr(lNum) & "Key", App.Path & "\data.ini")      ' Knoten öffnen      TreeView1.Nodes(modINI.INI_Value_Read("MainNodes", CStr(lNum) & "Key", App.Path & "\data.ini")).Expanded = True   Next lNumEnd Sub'Zweck: Diese Prozedur lädt alle Unterknoten eines Knotens.Private Sub LoadSubTreeNodes(ByVal sMainNode As String)   Dim lNum As Long   ' Alle Unterknoten eines Knotens durchgehen   For lNum = 1 To CLng(modINI.INI_Value_Read("SubNode_" & sMainNode, "Count", App.Path & "\data.ini"))      ' Unterknoten erstellen      TreeView1.Nodes.Add sMainNode, _                          MSComctlLib.tvwChild, _                          modINI.INI_Value_Read("SubNode_" & sMainNode, CStr(lNum) & "Key", App.Path & "\data.ini"), _                          modINI.INI_Value_Read("SubNode_" & sMainNode, CStr(lNum) & "Txt", App.Path & "\data.ini")      LoadSubTreeNodes modINI.INI_Value_Read("SubNode_" & sMainNode, CStr(lNum) & "Key", App.Path & "\data.ini")      ' Knoten öffnen      TreeView1.Nodes(modINI.INI_Value_Read("SubNode_" & sMainNode, CStr(lNum) & "Key", App.Path & "\data.ini")).Expanded = True   Next lNumEnd Sub

Mit freundlichen Grüßen

AndyG

E-Mail:  Andreas_Graf [öt] DevPlanet.de
Homepage:  http://www.DevPlanet.de



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: