Как случайным образом изменить обои без дубликатов в серии
У меня есть этот код в Visual Basic, который случайным образом меняет обои при первой загрузке дня:
Dim objRandom As New System.Random (CType (System.DateTime.Now.Ticks Mod System.Int32.MaxValue, Integer)) Sub Main () Dim WallpaperNumNew как целое число Dim WallpaperCurrent как целое число Dim WallpaperLastChgDate как дата Dim LoopNum как целое число при ошибке возобновить Далее ", если ни один из ключей не существует, игнорировать ошибку. Они будут созданы в конце программы. WallpaperLastChgDate = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\ Панель управления \ Рабочий стол", "WallpaperLastUpdate", ничего) "получить дату последнего изменения обоев WallpaperCurrent = My.Computer.Registry.GetValue (" HKEY_CURRENT \ Panel_CUR_ENT Desktop ", "WallpaperNumber", Nothing) 'получить текущий номер обоев при ошибке GoTo 0 Если WallpaperLastChgDate = Today (), то затем Exit Sub' предотвратить изменение обоев при каждой перезагрузке в течение дня. Do WallpaperNumNew = GetRandomNumber(1, 7) LoopNum = LoopNum + 1 Если LoopNum> 20, то Exit Do 'предотвратить цикл с бесконечным циклом, хотя WallpaperNumNew = WallpaperCurrent', если текущий и новый значения совпадают, цикл до тех пор, пока они не совпадают. Выберите Case WallpaperNumNew Case 1 My.Computer.FileSystem.CopyFile ("C: \ Windows \ Дело Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper1.jpg "," C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) 2 My.Computer.FileSystem.CopyFile ("C: \ Windows \" Дело Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper2.jpg "," C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) 3 My.Computer.FileSystem.CopyFile ("C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper3.jpg", "C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 4 My.Computer.FileSystem.CopyFile (" C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper4.jpg "," C: \ Users [имя пользователя ] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 5 My.Computer.FileSystem.CopyFile (" C: \ Windows \ Web \ WallPaper \ MyWallPaper " \ JPEGs \ Wallpaper5.jpg "," C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 6 My.Computer. FileSystem.CopyF ile ("C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper6.jpg", "C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft \ Windows \ Themes \ TranscodedWallpaper.jpg", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Случай 7 My.Computer.FileSystem.CopyFile ("C: \ Windows \ Web \ WallPaper \ MyWallPaper \ JPEGs \ Wallpaper7.jpg", "C: \ Users [имя пользователя] \ AppData \ Roaming \ Microsoft" \ Windows \ Themes \ TranscodedWallpaper.jpg ", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing) Case Else Exit Sub 'do nothing End Выберите My.Computer.Registry.SetValue (" HKEY_CURRENT_USER \ Панель управления \ Рабочий стол ", "WallpaperNumber", WallpaperNumNew) 'записать новый номер обоев в реестр My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Today()) ' записать новую дату смены обоев в реестр. Конец Sub Открытая функция GetRandomNumber(Необязательный ByVal Low As Integer = 1, необязательный ByVal High As Integer = 100) As Integer 'Возвращает случайное число между необязательным Low и High pa. rameters 'from: http://www.developerfusion.com/code/3940/random-numbers-that-work/ Возвращает objRandom.Next(Low, High + 1) End Function
Программа настроена на запуск через диспетчер задач и отлично работает, но так как она случайная, я часто получаю одни и те же обои через два или три дня. Кто-нибудь может придумать способ случайного зацикливания на семи доступных обоях, чтобы в серии не было дубликатов?
Я не ищу реальный код, а просто каким-то образом отслеживаю, какие обои были выбраны ранее, а затем исключаю их из доступного пула, пока не будут выбраны все семь. (Да, последнее не будет случайным.)
Я написал другую программу, которая может выбирать конкретные обои в зависимости от дня недели, но тогда я получал бы одни и те же обои каждый день (т.е. каждый понедельник был бы одинаковыми обоями), что было бы скучно.
Любые идеи будут приветствоваться. Спасибо
Изменить: я думаю, что я мог подумать о решении. При первом запуске кода он генерирует список из семи случайных чисел со значениями 1–7, например, 4, 7, 3, 1, 5, 2, 6, и сохраняет их в параметре реестра как: 4731526. Затем каждый раз, когда Код запускается (один раз в день), он извлекает другое значение, хранящееся в реестре, которое указывает, на какой номер цикла он включен, использует этот номер позиции из случайной строки, а затем увеличивает номер цикла. Так что в моем примере выше, в первый день он использует обои 4, затем 7, затем 3 и т. Д. Когда он достигает 6 (7- е значение), он генерирует новый набор случайных чисел, сохраняет его в реестре и устанавливает номер цикла обратно в единицу, и цикл начинается заново с новой, другой случайной строкой.
Если это сработает, я выложу как ответ, так и код.
РЕДАКТИРОВАТЬ 2: Я считаю, что у меня есть код для достижения того, что я после. Я запустил его один раз, и он сгенерировал случайное число из семи цифр. Мне просто нужно подождать до восьмого дня, чтобы увидеть, генерирует ли код новый список случайно расположенных семи цифр.
3 ответа
Это должно работать для вас:
Sub Main()
Dim WallpaperLastChgDate = Today()
Dim WallpaperCurrent = -1
On Error Resume Next 'if neither key exists, ignore error. They will get created at program end.
WallpaperLastChgDate = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Nothing) 'get the date the wallpaper was last changed
WallpaperCurrent = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperNumber", Nothing) 'get current wallpaper number
On Error GoTo 0
If WallpaperLastChgDate = Today() Then Exit Sub 'prevent changing wallpaper on every reboot during the day
WallpaperCurrent += 1
Dim objRandom As New System.Random(0)
Dim Images = { "Wallpaper1.jpg", "Wallpaper2.jpg", "Wallpaper3.jpg", "Wallpaper4.jpg", "Wallpaper5.jpg", "Wallpaper6.jpg", "Wallpaper7.jpg" }
Dim Shuffled = Enumerable.Range(0, 1000).SelectMany(Function (n) Images.OrderBy(Function (i) objRandom.NextDouble())).ToArray()
My.Computer.FileSystem.CopyFile(Shuffled(WallpaperCurrent), "C:\Users[username]\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper.jpg", FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperNumber", WallpaperCurrent) 'write new wallpaper number to registry
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Today()) 'write new wallpaper change date to registry
End Sub
Ключ здесь состоит в том, чтобы избежать всего этого мусора об истинных случайных числах. То, что вам нужно, это хорошая случайность, но вполне предсказуемый поток чисел. Начиная с New System.Random(0)
Вы гарантируете, что будете вычислять одни и те же числа каждый раз.
Итак, я просто вычислил массив из 1000 x 7 изображений с каждой серией из 7 перемешанных изображений. Затем я просто отслеживаю, по какому индексу вы находитесь каждый день, и увеличиваю, чтобы получить следующее изображение. Так что мой подход будет работать около 19,1 года.
По-прежнему существует проблема, заключающаяся в том, что последний образ серии семи может быть первым из следующего цикла. Это не будет трудно использовать .Zip
оператор, чтобы удалить эти дубликаты.
Ваши требования доказуемо невозможны. Если у вас есть семь обоев, и вам требуется, чтобы в течение любых семи дней обои не появлялись более одного раза, то, очевидно, вы должны повторить ту же последовательность из семи обоев до бесконечности.
Доказательство. Через шесть дней единственные доступные обои - это обои, которые не появлялись в предыдущие шесть дней, то есть те, которые появились ровно семь дней назад.
Возможно, я неправильно понял ваши требования. Если так, пожалуйста, поправьте меня.
У меня есть свое решение, и я проверил его. Я создаю 7-значную случайную строку и сохраняю номер цикла в реестре (среди прочего). Когда моя программа запускается, она получает номер цикла и случайную строку из реестра, а затем использует функцию MID для получения соответствующего номера обоев, например, MID(String, CycleNumber, 1). Затем я использую стандартную инструкцию Select Case, чтобы скопировать нужный файл.jpg в файл TranscodedWallpaper для Window. Если бы я хотел избавиться от описательных имен файлов (например, Frontyard_Liquidamber.jpg) и изменить их все на Wallpaper1.jpg, Wallpaper2.jpg и т. Д., Я мог бы избавиться от оператора Select Case и использовать PathName & Wallpaper Number & ".jpg". Вот код:
Module Module1
Sub Main()
Dim WallpaperNumberNew As Integer
Dim WallpaperNumberNewString As String
Dim WallpaperLastChgDate As Date
Dim WallpaperRandomList As String
Dim WallpaperCycleNumber As Integer
Dim CopyToLocation As String
Dim NumberOfWallpapers As Integer
Dim LoopNum As Integer
NumberOfWallpapers = 8
If My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", Nothing) Is Nothing Then
WallpaperRandomList = GetRandomList(NumberOfWallpapers)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", WallpaperRandomList)
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperCycleNumber", 1)
End If
WallpaperRandomList = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", Nothing)
WallpaperCycleNumber = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperCycleNumber", Nothing)
WallpaperLastChgDate = My.Computer.Registry.GetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Nothing)
If WallpaperLastChgDate = Today() Then Exit Sub 'prevent changing wallpaper on every reboot during the day
If WallpaperCycleNumber = NumberOfWallpapers + 1 Then
WallpaperNumberNewString = Mid(WallpaperRandomList, WallpaperCycleNumber - 1, 1)
WallpaperCycleNumber = 1
Do
WallpaperRandomList = GetRandomList(NumberOfWallpapers)
LoopNum = LoopNum + 1
If LoopNum > 20 Then Exit Do
Loop While Left(WallpaperRandomList, 1) = WallpaperNumberNewString 'prevent first digit of new string from repeating last digit of old string
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperRandomList", WallpaperRandomList)
End If
WallpaperNumberNewString = Mid(WallpaperRandomList, WallpaperCycleNumber, 1)
WallpaperNumberNew = CInt(WallpaperNumberNewString)
CopyToLocation = "C:\Users[username]\AppData\Roaming\Microsoft\Windows\Themes\TranscodedWallpaper.jpg"
Select Case WallpaperNumberNew
Case 1
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper1.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 2
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper2.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 3
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper3.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 4
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper4.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 5
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper5.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 6
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper6.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 7
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper7.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case 8
My.Computer.FileSystem.CopyFile("C:\Windows\Web\WallPaper\MyWallPaper\JPEGs\Wallpaper8.jpg", CopyToLocation,
FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.DoNothing)
Case Else
Exit Sub 'do nothing
End Select
WallpaperCycleNumber = WallpaperCycleNumber + 1
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperCycleNumber", WallpaperCycleNumber) 'write cycle number to registry
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperLastUpdate", Today()) 'write new wallpaper change date to registry
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "WallpaperNumber", WallpaperNumberNew)
End Sub
Public Function GetRandomList(Optional ByVal High As Integer = 100) As String
Dim StringDigit(High) As Integer
Dim NewString As String
Dim RndArray As Integer
Dim temp As Integer
For i = 1 To High
StringDigit(i) = i
Next i
Randomize() 'intialize random number generator
For i = 1 To High
RndArray = Int((UBound(StringDigit) * Rnd() + 1)) 'generate random number and store as variable RndArray
temp = StringDigit(i) 'temporarily store array element i to a variable called temp
StringDigit(i) = StringDigit(RndArray) 'set array element i equal to random array element StringDigit
StringDigit(RndArray) = temp 'set array element StringDigit to old value of array element i stored as temp
Next i
NewString = Nothing 'initialize variable NewString
For i = 1 To High
NewString = NewString & StringDigit(i) 'convert array into string NewString
Next i
Return NewString
End Function
End Module
Одним приятным побочным эффектом является то, что он копирует ваш jpeg, предположительно с минимальным сжатием, непосредственно в файл TranscodedWallpaper.jpg Window, который обходит агрессивное сжатие, которое Windows применяет к вашему файлу BMP, когда он конвертирует его в выбранные вами обои. Исследуя возможные решения моей проблемы, я обнаружил, что это раздражает многих пользователей.