Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / inites / testini.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-05-08 | 29.4 KB | 655 lines

VERSION 2.00 Begin Form testini BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "TEST INI FILES" ClientHeight = 6705 ClientLeft = 2325 ClientTop = 3240 ClientWidth = 10575 Height = 7110 Icon = TESTINI.FRX:0000 Left = 2265 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6705 ScaleWidth = 10575 Top = 2895 Width = 10695 Begin SSPanel Panel3D3 Alignment = 0 'Left Justify - TOP BackColor = &H00FFFFFF& BevelOuter = 1 'Inset Font3D = 0 'None Height = 6525 Left = 5310 TabIndex = 15 Top = 60 Width = 5175 Begin TextBox Contenu_Ini BorderStyle = 0 'None Height = 6510 Left = 15 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 26 Top = 15 Width = 5160 End End Begin SSPanel Panel3D1 Alignment = 1 'Left Justify - MIDDLE BackColor = &H00C0C0C0& BevelOuter = 1 'Inset Font3D = 0 'None Height = 2985 Left = 180 TabIndex = 19 Top = 3600 Width = 4995 Begin SSPanel Panel3D4 Alignment = 8 'Center - BOTTOM BackColor = &H00C0C0C0& BevelOuter = 1 'Inset Caption = "About" Font3D = 0 'None Height = 795 Left = 3480 TabIndex = 27 Top = 150 Width = 795 Begin PictureBox Pic_ApplicationIcon AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None Enabled = 0 'False Height = 480 HelpContextID = 2 Left = 150 Picture = TESTINI.FRX:0302 ScaleHeight = 480 ScaleWidth = 480 TabIndex = 28 Top = 60 Width = 480 End End Begin ComboBox Liste_Entree Height = 300 Left = 870 Sorted = -1 'True TabIndex = 4 Text = "Liste_Entree" Top = 630 Width = 1965 End Begin CommandButton Voir_Ini Caption = "See &INI" Height = 360 Left = 3360 TabIndex = 11 Top = 2070 Width = 1500 End Begin CommandButton Quitter Caption = "&Quit" Height = 360 Left = 3360 TabIndex = 12 Top = 2490 Width = 1500 End Begin CommandButton Del_Entry Caption = "DEL &Entry" Height = 360 Left = 1770 TabIndex = 10 Top = 2490 Width = 1500 End Begin CommandButton Del_Section Caption = "DEL &Section" Height = 360 Left = 1770 TabIndex = 9 Top = 2070 Width = 1500 End Begin CommandButton Write_INI Caption = "&Write INI" Height = 360 Left = 180 TabIndex = 7 Top = 2070 Width = 1500 End Begin CommandButton Send_Ini Caption = "S&end WININI" Enabled = 0 'False Height = 360 Left = 180 TabIndex = 8 Top = 2490 Width = 1500 End Begin SSPanel Panel3D2 Alignment = 1 'Left Justify - MIDDLE BackColor = &H00C0C0C0& BevelOuter = 1 'Inset Font3D = 0 'None Height = 285 Index = 1 Left = 840 TabIndex = 25 Top = 1530 Width = 4005 Begin TextBox Defaut BorderStyle = 0 'None Height = 285 Left = 30 TabIndex = 6 Top = 30 Width = 3975 End End Begin SSPanel Panel3D2 Alignment = 1 'Left Justify - MIDDLE BackColor = &H00C0C0C0& BevelOuter = 1 'Inset Font3D = 0 'None Height = 285 Index = 0 Left = 840 TabIndex = 23 Top = 1110 Width = 4005 Begin TextBox Valeur BorderStyle = 0 'None Height = 285 Left = 30 TabIndex = 5 Top = 30 Width = 3975 End End Begin ComboBox Liste_Section Height = 300 Left = 870 Sorted = -1 'True TabIndex = 3 Text = "Liste_Section" Top = 120 Width = 1965 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "&Default:" Height = 255 Index = 5 Left = 90 TabIndex = 24 Top = 1560 Width = 705 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "&Value:" Height = 255 Index = 4 Left = 90 TabIndex = 22 Top = 1140 Width = 645 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "&Entry:" Height = 255 Index = 3 Left = 60 TabIndex = 21 Top = 660 Width = 645 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "&Section:" Height = 195 Index = 2 Left = 60 TabIndex = 20 Top = 150 Width = 975 End End Begin SSPanel sss BackColor = &H00C0C0C0& BevelOuter = 1 'Inset Font3D = 0 'None Height = 3435 Left = 180 TabIndex = 13 Top = 60 Width = 4995 Begin DriveListBox Drive1 Height = 315 Left = 1890 TabIndex = 2 Top = 2940 Width = 2955 End Begin DirListBox Dir1 Height = 1830 Left = 1890 TabIndex = 1 Top = 1080 Width = 2955 End Begin FileListBox File1 Height = 2175 Left = 150 Pattern = "*.ini" TabIndex = 0 Top = 1080 Width = 1635 End Begin SSPanel Selection_Ini Alignment = 1 'Left Justify - MIDDLE BackColor = &H00FFFFFF& BevelOuter = 1 'Inset BevelWidth = 2 Font3D = 0 'None Height = 285 Left = 180 TabIndex = 16 Top = 360 Width = 4185 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "&Directories" Height = 285 Index = 1 Left = 1890 TabIndex = 18 Top = 840 Width = 1545 End Begin Label Label2 BackColor = &H00C0C0C0& Caption = "&Files" Height = 285 Index = 0 Left = 180 TabIndex = 17 Top = 840 Width = 1545 End Begin Label Label1 BackColor = &H00C0C0C0& Caption = "&Selected INI file:" Height = 195 Left = 180 TabIndex = 14 Top = 150 Width = 2415 End End Option Explicit Dim T() As String 'Liste des entr es d'une section' Dim Entree As String 'Contenu du fichier Ini ' Sub Contenu_Ini_Change () Contenu_Ini = Entree End Sub Sub Defaut_GotFocus () Defaut.SelStart = 0 Defaut.SelLength = Len(Valeur) End Sub Sub Defaut_KeyPress (KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0: Write_Ini.SetFocus End Sub Sub Del_Entry_Click () Dim A As Integer A = DelEntry(Selection_Ini, Liste_Section.Text, Liste_Entree.Text) Voir_Ini_Click End Sub Sub Del_Section_Click () Dim A As Integer A = DelSection(Selection_Ini, Liste_Section.Text) Voir_Ini_Click End Sub Sub Dir1_Change () ' ' ' ' 'On modifie le r pertoire. ' ' ' ' ' File1.Path = Dir1.Path Selection_Ini.Caption = Dir1.Path RAZ If Right$(Selection_Ini.Caption, 1) <> "\" Then Selection_Ini.Caption = Selection_Ini.Caption + "\" End Sub Sub Dir1_KeyPress (KeyAscii As Integer) Dir1.Path = Dir1.List(Dir1.ListIndex) End Sub Sub Dir1_LostFocus () Dir1.Path = Dir1.List(Dir1.ListIndex) End Sub Sub Drive1_Change () On Local Error GoTo ErrUnite Dir1.Path = Drive1.Drive Exit Sub ErrUnite: MsgBox "L'unit n'est pas disponible", 48, "Erreur S lection Unit Drive1.Drive = Dir1.Path On Error GoTo 0 Exit Sub Resume End Sub Sub File1_Click () If Right$(Dir1.Path, 1) = "\" Then Selection_Ini.Caption = Dir1.Path + File1.FileName Else Selection_Ini.Caption = Dir1.Path + "\" + File1.FileName End If RAZ End Sub Sub File1_DblClick () File1_Click Voir_Ini_Click End Sub Sub File1_GotFocus () If Right$(Dir1.Path, 1) = "\" Then Selection_Ini.Caption = Dir1.Path + File1.FileName Else Selection_Ini.Caption = Dir1.Path + "\" + File1.FileName End If RAZ End Sub Sub File1_PathChange () If Right$(Dir1.Path, 1) = "\" Then Selection_Ini.Caption = Dir1.Path + File1.FileName Else Selection_Ini.Caption = Dir1.Path + "\" + File1.FileName End If RAZ End Sub Sub Form_Load () Dim R As Integer ' ' ' ' 'Lanc e lors de l'initialisation ' ' ' ' ' Move (Mdi.Width - Width) / 2, (Mdi.Height - Height) / 2 ' ' 'Recherche du r pertoire Windows ' ' ' WinDir = Space$(256) R = GetWindowsDirectory(WinDir, 256) If R <> 0 Then WinDir = Left$(WinDir, R) If Right$(WinDir, 1) <> "\" Then WinDir = WinDir + "\" End Sub Sub Lire_Section () Dim Fiche As String Dim CRLF As String * 2 ' ' ' ' 'Cette proc dure liste les sections disponibles dans le fichier INI ' ' ' ' ' CRLF = Chr$(13) + Chr$(10) Fiche = CRLF + Entree Liste_Section.Clear Liste_Entree.Clear Valeur = "" While InStr(Fiche, CRLF + "[") <> 0 Fiche = Right$(Fiche, Len(Fiche) - InStr(Fiche, CRLF + "[") - 2) If InStr(Fiche, "]") <> 0 Then Liste_Section.AddItem Left$(Fiche, InStr(Fiche, "]") - 1) Fiche = Right$(Fiche, Len(Fiche) - InStr(Fiche, "]")) Else Fiche = "" End If Wend If Liste_Section.ListCount > 0 Then Liste_Section.ListIndex = 0 End Sub Sub Liste_Entree_Click () Dim A As String Dim B As String Dim C As String Dim D As String ' ' ' ' 'On a s lectionn une valeur d'entr e. On lit son contenu. ' ' ' ' ' A = Selection_Ini B = Liste_Section C = Liste_Entree D = Defaut Valeur = GetIni(A, B, C, D, Nsize) End Sub Sub Liste_Section_Click () Dim I As Integer Dim A As String Dim B As String ' ' ' ' 'On lit les entr es correspondantes la section ' ' ' ' ' ReDim T(0) Screen.MousePointer = 11 A = Liste_Section.Text B = Selection_Ini.Caption Call GetEntries(B, A, T()) Liste_Entree.Clear For I = 1 To UBound(T) Liste_Entree.AddItem T(I) Next I If Liste_Entree.ListCount > 0 Then Liste_Entree.ListIndex = 0 Screen.MousePointer = 1 End Sub Sub Liste_Section_KeyPress (KeyAscii As Integer) Liste_Section_Click End Sub Sub Panel3D4_Click () AboutBox.Show 1 End Sub Sub Pic_ApplicationIcon_Click () AboutBox.Show 1 End Sub Sub Quitter_Click () Unload TestIni End Sub Sub RAJ (ByVal AncienSection, ByVal AncienEntree) ' ' ' ' 'Cette proc dure permet de remettre les valeurs avant l'op ration choisie ' ' ' ' ' Dim I As Integer For I = 0 To Liste_Section.ListCount - 1 If Liste_Section.List(I) = AncienSection Then Liste_Section.ListIndex = I: Exit For Next I For I = 0 To Liste_Entree.ListCount - 1 If Liste_Entree.List(I) = AncienEntree Then Liste_Entree.ListIndex = I: Exit For Next I End Sub Sub RAZ () ' ' ' ' 'Cette proc dure remet vierge les donn es ' ' ' ' ' Defaut = "" Entree = "" Valeur = "" Contenu_Ini = "" Liste_Entree.Clear Liste_Section.Clear Send_Ini.Enabled = 0 End Sub Sub Send_Ini_Click () Dim R As Long Dim NomSection As String Dim Uaction Dim UParam Dim LpvParam Dim Tas As Integer ' ' ' ' 'On envoie le message que winini a chang ' ' ' ' ' NomSection = Liste_Section.Text Uaction = 0 Select Case UCase$(NomSection) Case "WINDOWS" Select Case UCase$(Liste_Entree.Text) Case "BEEP" Uaction = SPI_SETBEEP If Val(Valeur) <> 0 Then UParam = -1: Else UParam = 0 LpvParam = 0& Case "BORDERWIDTH" Uaction = SPI_SETBORDER UParam = Val(Valeur) LpvParam = 0& Case "DOUBLECLICKSPEED" Uaction = SPI_SETDOUBLECLICKTIME UParam = Val(Valeur) LpvParam = 0& Case "SCREENSAVEACTIVE" Uaction = SPI_SETDESKPATTERN If Val(Valeur) <> 0 Then UParam = -1: Else UParam = 0 LpvParam = 0& Case "SCREENSAVETIMEOUT" Uaction = SPI_SETDESKPATTERN UParam = Val(Valeur) LpvParam = 0& Case Else End Select Case "DESKTOP" Select Case UCase$(Liste_Entree.Text) Case "PATTERN" Uaction = SPI_SETDESKPATTERN UParam = 0 LpvParam = Valeur Case "WALLPAPER" Uaction = SPI_SETDESKWALLPAPER UParam = 0 LpvParam = Valeur Case "TILEWALLPAPER" Write_Ini_Click Liste_Entree = "WallPaper" Liste_Entree_Click Uaction = SPI_SETDESKWALLPAPER UParam = 0 LpvParam = Valeur Liste_Entree = "TileWallPaper" Liste_Entree_Click Case Else End Select Case Else End Select 'Envoi du message ' If Uaction <> 0 Then R = SystemParametersInfo(ByVal Uaction, ByVal UParam, ByVal LpvParam, SPIF_SENDWININICHANGE + SPIF_UPDATEINIFILE) Else UParam = Liste_Section R = SendMessage(ByVal HWND_BROADCAST, ByVal WM_WININICHANGE, ByVal 0, ByVal UParam) End If End Sub Sub Valeur_GotFocus () Valeur.SelStart = 0 Valeur.SelLength = Len(Valeur) End Sub Sub Valeur_KeyPress (KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0: Defaut.SetFocus End Sub Sub Voir_Ini_Click () ' ' ' ' 'Permet d'afficher le contenu du fichier INI ' ' ' ' ' Dim CRLF As String Dim A$ Dim X As Integer Dim L As Long 'Taille du fichier INI ' Dim AncienSection As String Dim AncienEntree As String CRLF = Chr$(13) + Chr$(10) On Local Error Resume Next Err = 0 Entree = "" Screen.MousePointer = 11 'Saisie de la taille du fichier ' X = FreeFile L = FileLen(Selection_Ini) 'Lecture du fichier ' Open Selection_Ini For Binary As #X Len = L If Err <> 0 Then Contenu_Ini = "" Screen.MousePointer = 1 Else Entree = Space(L) Get #1, 1, Entree Contenu_Ini = Entree Close X End If 'Remise jour des sections ' AncienSection = Liste_Section AncienEntree = Liste_Entree Lire_Section RAJ AncienSection, AncienEntree 'Mise jour de Send_Ini ' If UCase$(Selection_Ini) = UCase$(WinDir) + "WIN.INI" Then Send_Ini.Enabled = -1 Screen.MousePointer = 1 End Sub Sub Write_Ini_Click () Dim A As String Dim B As String Dim C As String Dim D As String ' ' ' ' 'On a s lectionn une valeur d'entr e. On crit son contenu. ' ' ' ' ' A = Selection_Ini B = Liste_Section C = Liste_Entree D = Valeur Valeur = WriteIni(A, B, C, D) Liste_Entree_Click Voir_Ini_Click End Sub