home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / change / form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-06  |  3.3 KB  |  91 lines
  1. VERSION 2.00
  2. Begin Form ChangeForm 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Bitmap Changer"
  6.    ClientHeight    =   3720
  7.    ClientLeft      =   4590
  8.    ClientTop       =   2520
  9.    ClientWidth     =   2805
  10.    Height          =   4125
  11.    Icon            =   FORM1.FRX:0000
  12.    Left            =   4530
  13.    LinkMode        =   1  'Source
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    ScaleHeight     =   3720
  17.    ScaleWidth      =   2805
  18.    Top             =   2175
  19.    Width           =   2925
  20.    Begin CommandButton Command1 
  21.       Caption         =   "About The Changer"
  22.       Height          =   405
  23.       Left            =   0
  24.       TabIndex        =   1
  25.       Top             =   3330
  26.       Width           =   2805
  27.    End
  28.    Begin ListBox List1 
  29.       Height          =   3345
  30.       Left            =   0
  31.       Sorted          =   -1  'True
  32.       TabIndex        =   0
  33.       Top             =   0
  34.       Width           =   2805
  35.    End
  36. DefInt A-Z
  37. Declare Sub SystemParametersInfo Lib "User" (ByVal wAction%, ByVal wParam%, lParam As Any, ByVal fWinIni%)
  38. Const SPI_SETDESKWALLPAPER = 20
  39. Const SPIF_UPDATEINIFILE = 1     'update Win.ini Const
  40. Const SPIF_SENDWININICHANGE = 2  'update Win.ini and tell everyone
  41. Declare Function GetPrivateProfileString Lib "kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  42. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  43. Sub Form_Load ()
  44. redo:
  45.     If GetIni("Changer", "Dir") = "ERROR" Then
  46.     Temp$ = InputBox("Please Input A Directory", "Changer", "C:\WINDOWS\")
  47.         If Trim$(Temp$) = "" Then GoTo redo:
  48.     PutIni "Changer", "Dir", Trim$(Temp$)
  49.     End If
  50.     Temp$ = Trim$(GetIni("Changer", "Dir"))
  51.     If Right$(Temp$, 1) <> "\" Then Temp$ = Temp$ + "\"
  52.     Temp$ = Temp$ + "*.bmp"
  53.     Temp$ = Dir$(Temp$)
  54.     Do While Temp$ <> ""
  55.     Temp$ = Dir$
  56.     If Temp$ = "" Then Exit Do
  57.     list1.AddItem Temp$
  58.     Loop
  59.     list1.AddItem "(None)"
  60.     Show
  61.     list1.SetFocus
  62.     list1.ListIndex = 0
  63. End Sub
  64. Function GetIni (Appname$, Keyname$) As String
  65.     KeyDefault$ = "ERROR"
  66.     IniFile$ = "Changer.Ini"
  67.     KeyValue$ = Space$(255)
  68.     j = GetPrivateProfileString(Appname$, Keyname$, KeyDefault$, KeyValue$, Len(KeyValue$), IniFile$)
  69.     KeyValue$ = Trim$(KeyValue$)
  70.     KeyValue$ = Mid$(KeyValue$, 1, Len(KeyValue$) - 1)
  71.     GetIni = KeyValue$
  72. End Function
  73. Sub list1_dblclick ()
  74.     Temp$ = Trim$(GetIni("Changer", "Dir"))
  75.     If Right$(Temp$, 1) <> "\" Then Temp$ = Temp$ + "\"
  76.     If list1.Text = "(None)" Then
  77.     bmpfile$ = "(none)"
  78.     Else
  79.     bmpfile$ = Temp$ + Trim$(list1.Text)
  80.     End If
  81.     SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal bmpfile$, SPIF_UPDATEINIFILE
  82.     WindowState = 1
  83. End Sub
  84. Sub List1_KeyPress (KeyAscii As Integer)
  85.     If KeyAscii = 13 Then list1_dblclick
  86. End Sub
  87. Sub PutIni (Appname$, Keyname$, KeyValue$)
  88.     IniFile$ = "Changer.Ini"
  89.     status% = WritePrivateProfileString(Appname$, Keyname$, ByVal KeyValue$, IniFile$)
  90. End Sub
  91.