home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD170713142001.psc / Main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-03-11  |  8.8 KB  |  273 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fest Einfach
  4.    Caption         =   "FLOMIX Studios - Wallpaper Generator"
  5.    ClientHeight    =   4590
  6.    ClientLeft      =   150
  7.    ClientTop       =   435
  8.    ClientWidth     =   6495
  9.    Icon            =   "Main.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   4590
  13.    ScaleWidth      =   6495
  14.    StartUpPosition =   3  'Windows-Standard
  15.    Begin FDesktop.ShellIcon ShellIcon1 
  16.       Left            =   120
  17.       Top             =   1680
  18.       _ExtentX        =   847
  19.       _ExtentY        =   847
  20.       Icon            =   "Main.frx":27A2
  21.       Visible         =   -1  'True
  22.    End
  23.    Begin VB.PictureBox picPreview 
  24.       AutoRedraw      =   -1  'True
  25.       Height          =   1860
  26.       Left            =   3720
  27.       ScaleHeight     =   120
  28.       ScaleMode       =   3  'Pixel
  29.       ScaleWidth      =   160
  30.       TabIndex        =   13
  31.       Top             =   2280
  32.       Width           =   2460
  33.    End
  34.    Begin VB.PictureBox picFlomix 
  35.       AutoRedraw      =   -1  'True
  36.       AutoSize        =   -1  'True
  37.       Height          =   960
  38.       Left            =   8280
  39.       Picture         =   "Main.frx":28FC
  40.       ScaleHeight     =   60
  41.       ScaleMode       =   3  'Pixel
  42.       ScaleWidth      =   80
  43.       TabIndex        =   12
  44.       Top             =   2040
  45.       Visible         =   0   'False
  46.       Width           =   1260
  47.    End
  48.    Begin VB.PictureBox picScreen 
  49.       AutoRedraw      =   -1  'True
  50.       BackColor       =   &H00000000&
  51.       BorderStyle     =   0  'Kein
  52.       Height          =   615
  53.       Left            =   8400
  54.       ScaleHeight     =   41
  55.       ScaleMode       =   3  'Pixel
  56.       ScaleWidth      =   49
  57.       TabIndex        =   11
  58.       Top             =   3240
  59.       Visible         =   0   'False
  60.       Width           =   735
  61.    End
  62.    Begin FDesktop.StatusBar StatusBar1 
  63.       Align           =   2  'Unten ausrichten
  64.       Height          =   255
  65.       Left            =   0
  66.       TabIndex        =   8
  67.       Top             =   4335
  68.       Width           =   6495
  69.       _ExtentX        =   11456
  70.       _ExtentY        =   450
  71.    End
  72.    Begin VB.Frame Frame1 
  73.       Height          =   1335
  74.       Left            =   120
  75.       TabIndex        =   4
  76.       Top             =   240
  77.       Width           =   1815
  78.       Begin VB.OptionButton optRandom 
  79.          Caption         =   "Random"
  80.          Height          =   195
  81.          Left            =   120
  82.          TabIndex        =   10
  83.          Top             =   720
  84.          Width           =   975
  85.       End
  86.       Begin VB.OptionButton optOrder 
  87.          Caption         =   "Order"
  88.          Height          =   195
  89.          Left            =   120
  90.          TabIndex        =   9
  91.          Top             =   960
  92.          Value           =   -1  'True
  93.          Width           =   975
  94.       End
  95.       Begin VB.TextBox Text1 
  96.          Height          =   285
  97.          Left            =   840
  98.          TabIndex        =   6
  99.          Text            =   "0"
  100.          Top             =   360
  101.          Width           =   735
  102.       End
  103.       Begin VB.Timer Timer1 
  104.          Enabled         =   0   'False
  105.          Interval        =   1000
  106.          Left            =   1200
  107.          Tag             =   "0"
  108.          Top             =   240
  109.       End
  110.       Begin VB.CheckBox Check1 
  111.          Caption         =   "Update"
  112.          Height          =   215
  113.          Left            =   120
  114.          TabIndex        =   5
  115.          Top             =   0
  116.          Width           =   825
  117.       End
  118.       Begin VB.Label Label1 
  119.          Caption         =   "Minutes:"
  120.          Height          =   255
  121.          Left            =   120
  122.          TabIndex        =   7
  123.          Top             =   360
  124.          Width           =   615
  125.       End
  126.    End
  127.    Begin VB.CommandButton cmdNext 
  128.       Caption         =   "Next"
  129.       Height          =   375
  130.       Left            =   2160
  131.       TabIndex        =   3
  132.       Top             =   840
  133.       Width           =   1455
  134.    End
  135.    Begin VB.CommandButton cmdRnd 
  136.       Caption         =   "Random"
  137.       Height          =   375
  138.       Left            =   2160
  139.       TabIndex        =   2
  140.       Top             =   360
  141.       Width           =   1455
  142.    End
  143.    Begin VB.CommandButton cmdUpdate 
  144.       Caption         =   "Update List"
  145.       Height          =   375
  146.       Left            =   2160
  147.       TabIndex        =   1
  148.       Top             =   1320
  149.       Width           =   1455
  150.    End
  151.    Begin VB.ListBox List1 
  152.       Height          =   2010
  153.       Left            =   3720
  154.       Sorted          =   -1  'True
  155.       TabIndex        =   0
  156.       Top             =   120
  157.       Width           =   2655
  158.    End
  159.    Begin VB.Menu mnuPopup 
  160.       Caption         =   "mnuPopup"
  161.       Visible         =   0   'False
  162.       Begin VB.Menu mnuNext 
  163.          Caption         =   "Next"
  164.       End
  165.    End
  166. Attribute VB_Name = "frmMain"
  167. Attribute VB_GlobalNameSpace = False
  168. Attribute VB_Creatable = False
  169. Attribute VB_PredeclaredId = True
  170. Attribute VB_Exposed = False
  171. Dim MyPath As String
  172. Dim WallPath As String
  173. Dim Edit As Boolean
  174. Private Sub Check1_Click()
  175.     Timer1.Tag = 0
  176.     Timer1.Enabled = Check1
  177. End Sub
  178. Private Sub cmdNext_Click()
  179.     Timer1.Tag = 0
  180.     If List1.ListCount Then List1.ListIndex = (List1.ListIndex + 1) Mod List1.ListCount
  181. End Sub
  182. Private Sub cmdRnd_Click()
  183.     List1.ListIndex = Int(Rnd * List1.ListCount)
  184. End Sub
  185. Private Sub cmdUpdate_Click()
  186.     Dim OldFile As String
  187.     Dim File As String
  188.     OldFile = List1
  189.     List1.Clear
  190.     File = Dir(WallPath)
  191.     Do While Len(File)
  192.         List1.AddItem File
  193.         File = Dir
  194.     Loop
  195.     List1 = OldFile
  196. End Sub
  197. Private Sub SetPicture(ByVal Filename As String)
  198.     On Error GoTo Fehler
  199.     Dim xFile As String
  200.     StatusBar1.Label1 = "Loading picture..."
  201.     xFile = WinPath & "FlomixWall.bmp"
  202.     If 1 = 2 Then
  203.         picScreen.Cls
  204.         picScreen.PaintPicture LoadPicture(Filename), 0, 0, picScreen.ScaleWidth, picScreen.ScaleHeight
  205.         'FoxAlphaBlend picScreen.HDC, picScreen.ScaleWidth - picFlomix.ScaleWidth, picScreen.ScaleHeight - picFlomix.ScaleHeight - 30, picFlomix.ScaleWidth, picFlomix.ScaleHeight, picFlomix.HDC, 0, 0, 128, 0, 1
  206.     Else
  207.         Set picScreen.Picture = LoadPicture(Filename)
  208.     End If
  209.     'Picture zu Image
  210.     picPreview.PaintPicture picScreen.Picture, 0, 0, picPreview.ScaleWidth, picPreview.ScaleHeight
  211.     picPreview.Refresh
  212.     SavePicture picScreen.Picture, xFile
  213.     StatusBar1.Label1 = "Setting picture..."
  214.     SystemParametersInfo SPI_SETDESKWALLPAPER, 0&, ByVal xFile, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE
  215.     StatusBar1.Label1 = "Ready."
  216. Fehler:
  217. End Sub
  218. Private Sub Form_Load()
  219.     On Error Resume Next
  220.     Edit = True
  221.     MyPath = App.Path
  222.     If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
  223.     WallPath = MyPath & "Wallpapers\"
  224.     If LCase(Command) = "autostart" Then WindowState = 1
  225.     picScreen.Width = Screen.Width
  226.     picScreen.Height = Screen.Height
  227.     Me.StatusBar1.Label1 = "Ready."
  228.     cmdUpdate_Click
  229.     List1 = GetSetting("FLOMIX Studios", "Wallpaper Generator", "Current", "")
  230.     Text1 = GetSetting("FLOMIX Studios", "Wallpaper Generator", "Update Delay", 1)
  231.     Me.Check1 = GetSetting("FLOMIX Studios", "Wallpaper Generator", "Update", 1)
  232.     Edit = False
  233. End Sub
  234. Private Sub Form_Resize()
  235.     If WindowState = 1 Then Hide Else Show
  236. End Sub
  237. Private Sub List1_Click()
  238.     If Not Edit Then
  239.         SetPicture WallPath & List1.List(List1.ListIndex)
  240.         SaveSetting "FLOMIX Studios", "Wallpaper Generator", "Current", List1
  241.     End If
  242. End Sub
  243. Private Sub mnuNext_Click()
  244.     cmdNext_Click
  245. End Sub
  246. Private Sub ShellIcon1_DblClick(Button As Integer)
  247.     If Button = 1 Then WindowState = 0: Show: AppActivate Caption, wait
  248. End Sub
  249. Private Sub ShellIcon1_SingleClick(Button As Integer)
  250.     PopupMenu mnuPopup, 2
  251. End Sub
  252. Private Sub Text1_Validate(Cancel As Boolean)
  253.     Dim Text As String, Pos As Long
  254.     Text = Val(Text1)
  255.     Pos = InStr(Text, ",")
  256.     If Pos Then Text = Left(Text, Pos - 1) & "." & Mid(Text, Pos + 1)
  257.     Text1 = Text
  258.     SaveSetting "FLOMIX Studios", "Wallpaper Generator", "Update Delay", Text
  259. End Sub
  260. Private Sub Timer1_Timer()
  261.     On Error Resume Next
  262.     If Val(Text1) <= 0 Then Exit Sub
  263.     Timer1.Tag = Timer1.Tag + 1
  264.     StatusBar1.StatusText = TimeString(Int(Val(Text1) * 60) - Timer1.Tag)
  265.     StatusBar1.Label2 = List1
  266.     ShellIcon1.ToolTipText = List1 & " (change in " & StatusBar1.StatusText & ".)"
  267.     StatusBar1.Status = Timer1.Tag * 100 / Int((Val(Text1) * 60))
  268.     If Timer1.Tag >= Int(Val(Text1) * 60) Then
  269.         Timer1.Tag = 0
  270.         If optOrder.Value = True Then cmdNext_Click Else cmdRnd_Click
  271.     End If
  272. End Sub
  273.