Check-in [962f843b0e]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Commit of previous version of the wallpaper cycler.
Timelines: family | v1
Files: files | file ages | folders
SHA1: 962f843b0e28c7f708dc7d5a29e194fbf8e790ac
User & Date: tinus 2009-10-22 20:43:10
Context
2009-10-22
20:43
Commit of previous version of the wallpaper cycler. Leaf check-in: 962f843b0e user: tinus tags: v1
Changes

Added .fossil-settings/binary-glob.





>
>
1
2
*.ico
*.png

Added .fossil-settings/ignore-glob.



















>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
*.~*
*.bak
*/Thumbs.db
*.dsk
*.local
*.identcache
*/__history/
*.res
out/

Added .fossil-settings/ignore-glob.no-warn.

Added WPCycler.config.

























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
<Settings>
	<Monitors>
		<Monitor index="0" id="\\.\DISPLAY1\Monitor0" name="Default Monitor" device="MEDION RADEON X740XL" primary="yes"/>
	</Monitors>
	<!--<Areas>
		<Area>
			<Monitor ref="index='0'" />
			<Coordinates use="desktop*|monitor*|workarea" left="[+-]0[%]" top="[+-]0[%]" width="[+-]0[%]" height="[+-]0[%]"/>
		</Area>
	</Areas>-->
	<Playlist index="0" next-update="2007-01-15T12:00+01:00">
		<For>
			<!--<Area ref="1"/>-->
			<Monitor ref="primary='yes'"/>
		</For>
		<Include path="F:\MM\Image\" recursive="true" />
		<Exclude path="F:\MM\Image\Icons\" recursive="true"/>
		<Exclude path="F:\MM\Image\Photos\Wijnand\Orginal\" recursive="true"/>
		<Exclude path="F:\MM\Image\Work\Privé\" recursive="true"/>
		<Exclude path="F:\MM\Image\Work\" recursive="true"/>
		<Include path="F:\MM\Image\Work\Projects\Arjen\" recursive="false"/>
		<Exclude path="F:\MM\Image\Work\Temp\" recursive="true"/>
		<Exclude path="F:\MM\Image\Zoom\" recursive="true"/>
		<Layout align="center">
			<Tile max="[+-]10[%]"/>
		</Layout>
	</Playlist>
</Settings>

Added WPCycler.in_.









































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
[Settings]
;Startup=<nothing|refresh|next>
Startup=refresh
;Every=0-99999 <seconds|minutes|hours|days|months|to 0-99999 <sec|min|hours|days|months>>
Every=4 hours
;Launch=<view|edit|run>
Launch=view
Run="C:\Program Files\MM\IrfanView\i_view32.exe" "%1"
;Delete=<recycle|kill>
Delete=recycle

[Locations]
F:\MM\Image\Downloads=*\*
F:\MM\Image=*
F:\MM\Image\Photos=*\*
F:\MM\Image\Photos\Wijnand\Orginal=
F:\MM\Image\Theme=*\*

[Playlists]
Location=C:\Documents and Settings\Martijn\Local Settings\Application Data\WallpaperCycler\Wallpaper.wcpl

Added img/Paintbrush on black.ico.

cannot compute difference between binary files

Added img/Paintbrush-16x16.png.

cannot compute difference between binary files

Added img/Paintbrush-32x32.png.

cannot compute difference between binary files

Added img/Paintbrush-48x48.png.

cannot compute difference between binary files

Added img/Paintbrush.ico.

cannot compute difference between binary files

Added src/FormSettings.dfm.



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
object frmSettings: TfrmSettings
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMaximize]
  Caption = 'Wallpaper Cycler'
  ClientHeight = 409
  ClientWidth = 516
  Color = clBtnFace
  ParentFont = True
  OldCreateOrder = False
  Position = poScreenCenter
  ShowHint = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnHide = FormHide
  OnShow = FormShow
  DesignSize = (
    516
    409)
  PixelsPerInch = 96
  TextHeight = 13
  object pgcOptions: TPageControl
    Left = 0
    Top = 0
    Width = 516
    Height = 370
    ActivePage = tsPlaylist
    Align = alTop
    Anchors = [akLeft, akTop, akRight, akBottom]
    TabOrder = 0
    object tsLocations: TTabSheet
      Caption = '&Locations'
      DesignSize = (
        508
        342)
      object btnAddFile: TBitBtn
        Left = 373
        Top = 34
        Width = 132
        Height = 25
        Anchors = [akTop, akRight]
        Caption = 'Add &file...'
        TabOrder = 2
      end
      object btnAddFolder: TBitBtn
        Left = 373
        Top = 3
        Width = 132
        Height = 25
        Anchors = [akTop, akRight]
        Caption = '&Add folder...'
        TabOrder = 1
      end
      object btnRemove: TBitBtn
        Left = 373
        Top = 65
        Width = 132
        Height = 25
        Anchors = [akTop, akRight]
        Caption = '&Remove'
        Enabled = False
        TabOrder = 3
      end
      object btnClear: TBitBtn
        Left = 373
        Top = 96
        Width = 132
        Height = 25
        Anchors = [akTop, akRight]
        Caption = '&Clear all'
        TabOrder = 4
      end
      object chkExclude: TCheckBox
        Left = 373
        Top = 144
        Width = 132
        Height = 17
        Anchors = [akTop, akRight]
        Caption = '&Skip this item'
        Enabled = False
        TabOrder = 5
      end
      object chkRecurse: TCheckBox
        Left = 373
        Top = 167
        Width = 132
        Height = 17
        Anchors = [akTop, akRight]
        Caption = '&Include subfolders'
        Enabled = False
        TabOrder = 6
      end
      object tvLocations: TTreeView
        AlignWithMargins = True
        Left = 3
        Top = 3
        Width = 364
        Height = 336
        Align = alLeft
        Anchors = [akLeft, akTop, akRight, akBottom]
        Indent = 19
        TabOrder = 0
      end
    end
    object tsPlaylist: TTabSheet
      Caption = '&Playlist'
      DesignSize = (
        508
        342)
      object TntSplitter1: TSplitter
        Left = 336
        Top = 0
        Height = 342
        ExplicitLeft = 335
      end
      object lvwPlaylist: TListView
        AlignWithMargins = True
        Left = 3
        Top = 3
        Width = 330
        Height = 336
        Align = alLeft
        Anchors = [akLeft, akTop, akRight, akBottom]
        Columns = <
          item
            Caption = 'File'
            Width = 326
          end>
        ColumnClick = False
        HideSelection = False
        OwnerData = True
        ReadOnly = True
        RowSelect = True
        PopupMenu = pmuPlaylist
        SmallImages = imlMonitors
        TabOrder = 0
        ViewStyle = vsReport
        OnData = lvwPlaylistData
        OnDataHint = lvwPlaylistDataHint
        OnDataStateChange = lvwPlaylistDataStateChange
        OnDblClick = lvwPlaylistDblClick
        OnSelectItem = lvwPlaylistSelectItem
      end
      object pnlThumbnail: TPanel
        Left = 339
        Top = 3
        Width = 166
        Height = 166
        Anchors = [akTop, akRight]
        BevelOuter = bvNone
        BorderStyle = bsSingle
        TabOrder = 1
        object imgThumbnail: TImage
          Left = 0
          Top = 0
          Width = 162
          Height = 162
          Align = alClient
          Center = True
          Proportional = True
          ExplicitLeft = 16
          ExplicitTop = 24
          ExplicitWidth = 105
          ExplicitHeight = 105
        end
      end
      object vleProperties: TValueListEditor
        Left = 339
        Top = 175
        Width = 166
        Height = 164
        Anchors = [akTop, akRight, akBottom]
        Enabled = False
        Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goColSizing]
        TabOrder = 2
        ColWidths = (
          74
          86)
      end
    end
    object tsPreferences: TTabSheet
      Caption = 'Pr&eferences'
      DesignSize = (
        508
        342)
      object grpInterval: TGroupBox
        Left = 3
        Top = 3
        Width = 502
        Height = 78
        Caption = 'Change wallpaper'
        TabOrder = 0
        object chkStartup: TCheckBox
          Left = 16
          Top = 24
          Width = 97
          Height = 17
          Caption = 'on startup'
          TabOrder = 0
          OnClick = IntervalClick
        end
        object chkEvery: TCheckBox
          Left = 16
          Top = 49
          Width = 73
          Height = 17
          Caption = 'every'
          TabOrder = 1
          OnClick = chkEveryClick
        end
        object edtInterval: TEdit
          Left = 95
          Top = 47
          Width = 41
          Height = 21
          AutoSelect = False
          BiDiMode = bdRightToLeft
          Enabled = False
          ParentBiDiMode = False
          TabOrder = 2
          Text = '2'
        end
        object updInterval: TUpDown
          Left = 136
          Top = 47
          Width = 16
          Height = 21
          Associate = edtInterval
          Enabled = False
          Max = 999
          Position = 2
          TabOrder = 3
          Thousands = False
        end
        object cbxIntervalUnit: TComboBox
          Left = 159
          Top = 47
          Width = 90
          Height = 21
          AutoDropDown = True
          AutoCloseUp = True
          Style = csDropDownList
          DropDownCount = 16
          Enabled = False
          ItemHeight = 13
          ItemIndex = 0
          TabOrder = 4
          Text = 'to'
          Items.Strings = (
            'to'
            'seconds'
            'minutes'
            'hours'
            'days'
            'months')
        end
        object chkRefresh: TCheckBox
          Left = 95
          Top = 24
          Width = 97
          Height = 17
          Caption = 'refresh only'
          TabOrder = 5
          OnClick = IntervalClick
        end
        object edtIntervalTo: TEdit
          Left = 255
          Top = 47
          Width = 41
          Height = 21
          AutoSelect = False
          BiDiMode = bdRightToLeft
          Enabled = False
          ParentBiDiMode = False
          TabOrder = 6
          Text = '4'
        end
        object updIntervalTo: TUpDown
          Left = 296
          Top = 47
          Width = 15
          Height = 21
          Associate = edtIntervalTo
          Enabled = False
          Max = 999
          Position = 4
          TabOrder = 7
          Thousands = False
        end
        object cbxIntervalToUnit: TComboBox
          Left = 319
          Top = 47
          Width = 90
          Height = 21
          AutoDropDown = True
          AutoCloseUp = True
          Style = csDropDownList
          DropDownCount = 16
          Enabled = False
          ItemHeight = 13
          ItemIndex = 2
          TabOrder = 8
          Text = 'hours'
          Items.Strings = (
            'seconds'
            'minutes'
            'hours'
            'days'
            'months')
        end
      end
      object grpFiles: TGroupBox
        Left = 3
        Top = 87
        Width = 502
        Height = 130
        Anchors = [akLeft, akTop, akRight]
        Caption = 'Files'
        TabOrder = 1
        DesignSize = (
          502
          130)
        object lblOpenWith: TLabel
          Left = 16
          Top = 24
          Width = 54
          Height = 13
          Caption = 'Open using'
        end
        object optAssociatedViewer: TRadioButton
          Left = 95
          Top = 23
          Width = 114
          Height = 17
          Caption = 'associated viewer'
          Checked = True
          TabOrder = 0
          TabStop = True
          OnClick = optOpenWithClick
        end
        object optAssociatedEditor: TRadioButton
          Left = 95
          Top = 46
          Width = 114
          Height = 17
          Caption = 'associated editor'
          TabOrder = 1
          OnClick = optOpenWithClick
        end
        object optApplication: TRadioButton
          Left = 95
          Top = 69
          Width = 114
          Height = 17
          Caption = 'this application:'
          TabOrder = 2
          OnClick = optOpenWithClick
        end
        object edtApplication: TEdit
          Left = 215
          Top = 67
          Width = 244
          Height = 21
          Anchors = [akLeft, akTop, akRight]
          Enabled = False
          TabOrder = 3
        end
        object btnSelectApplication: TBitBtn
          Left = 459
          Top = 65
          Width = 32
          Height = 25
          Anchors = [akTop, akRight]
          Caption = '...'
          Enabled = False
          TabOrder = 4
        end
        object chkRecycle: TCheckBox
          Left = 16
          Top = 96
          Width = 473
          Height = 17
          Caption = 'Use Recycle Bin when deleting files from local hard drive'
          Checked = True
          State = cbChecked
          TabOrder = 5
        end
      end
    end
  end
  object btnOK: TBitBtn
    Left = 210
    Top = 376
    Width = 94
    Height = 25
    Anchors = [akRight, akBottom]
    TabOrder = 1
    Kind = bkOK
  end
  object btnCancel: TBitBtn
    Left = 410
    Top = 376
    Width = 98
    Height = 25
    Anchors = [akRight, akBottom]
    TabOrder = 3
    OnClick = btnCancelClick
    Kind = bkCancel
  end
  object btnApply: TBitBtn
    Left = 310
    Top = 376
    Width = 94
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Appl&y'
    ModalResult = 5
    TabOrder = 2
    Glyph.Data = {
      DE010000424DDE01000000000000760000002800000024000000120000000100
      0400000000006801000000000000000000001000000000000000000000000000
      80000080000000808000800000008000800080800000C0C0C000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00344446333334
      44433333FFFF333333FFFF33000033AAA43333332A4333338833F33333883F33
      00003332A46333332A4333333383F33333383F3300003332A2433336A6633333
      33833F333383F33300003333AA463362A433333333383F333833F33300003333
      6AA4462A46333333333833FF833F33330000333332AA22246333333333338333
      33F3333300003333336AAA22646333333333383333F8FF33000033444466AA43
      6A43333338FFF8833F383F330000336AA246A2436A43333338833F833F383F33
      000033336A24AA442A433333333833F33FF83F330000333333A2AA2AA4333333
      333383333333F3330000333333322AAA4333333333333833333F333300003333
      333322A4333333333333338333F333330000333333344A433333333333333338
      3F333333000033333336A24333333333333333833F333333000033333336AA43
      33333333333333833F3333330000333333336663333333333333333888333333
      0000}
    NumGlyphs = 2
  end
  object pmuTray: TPopupMenu
    Left = 72
    Top = 360
    object miTrayExit: TMenuItem
      Action = actExit
    end
    object N3: TMenuItem
      Caption = '-'
    end
    object miTrayShowHide: TMenuItem
      Action = actShowHide
    end
    object N1: TMenuItem
      Caption = '-'
    end
    object miTrayFiles: TMenuItem
      AutoHotkeys = maManual
      Caption = 'Files'
      object miTrayFileName: TMenuItem
        Caption = '(path && name)'
        object Open1: TMenuItem
          Caption = '&Open'
          Hint = 'Open the source image'
          OnClick = Open1Click
        end
        object Removefromplaylist1: TMenuItem
          Caption = '&Remove from playlist'
          object File1: TMenuItem
            Caption = '&File'
          end
          object Entirefolder1: TMenuItem
            Caption = '&Entire folder'
          end
          object Foldersubfolders1: TMenuItem
            Caption = 'Folder + &subfolders'
          end
        end
        object Deletefromdisk1: TMenuItem
          Caption = '&Delete from disk...'
          object File2: TMenuItem
            Caption = '&File'
          end
          object Entirefolder2: TMenuItem
            Caption = '&Entire folder'
          end
          object Foldersubfolders2: TMenuItem
            Caption = 'Folder + &subfolders'
          end
        end
      end
    end
    object miTrayPauseResume: TMenuItem
      Action = actPauseResume
    end
    object miTrayNextWallpaper: TMenuItem
      Action = actChangeWallpaper
      Default = True
    end
  end
  object ActionList: TActionList
    Left = 264
    object actChangeWallpaper: TAction
      Caption = '&Change Wallpaper'
      OnExecute = actChangeWallpaperExecute
    end
    object actExit: TAction
      Caption = 'E&xit'
      OnExecute = actExitExecute
    end
    object actShowHide: TAction
      Caption = 'S&how'
      OnExecute = actShowHideExecute
    end
    object actPauseResume: TAction
      Caption = 'Pa&use'
      Enabled = False
    end
    object actOpen: TAction
      Caption = '&Open'
      Hint = 'Open the source image'
    end
  end
  object tmrChangeWallpaper: TTimer
    Enabled = False
    OnTimer = tmrChangeWallpaperTimer
    Left = 400
  end
  object AppEvents: TApplicationEvents
    OnException = AppEventsException
    Left = 208
  end
  object TrayIcon: TTrayIcon
    PopupMenu = pmuTray
    Visible = True
    OnClick = TrayIconClick
    OnDblClick = TrayIconDblClick
    Left = 16
    Top = 360
  end
  object imlMonitors: TImageList
    Left = 128
    Top = 360
  end
  object pmuPlaylist: TPopupMenu
    Left = 16
    Top = 312
  end
end

Added src/FormSettings.pas.

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
unit FormSettings;

// TODO: make the ListView virtual (OwnerData = True; fill it using OnDataHint, OnData, OnDataFind etc...)

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShellAPI, ActnList, TntActnList, Menus, TntMenus, StdActns, TntStdActns, StdCtrls,
  TntStdCtrls, Buttons, TntButtons, ComCtrls, TntComCtrls, Grids, ValEdit, ExtCtrls, TntExtCtrls,
  WallpaperChangerUnit, AppEvnts, ImgList;

const
  WM_ICONTRAY = WM_USER + 1;

type
  TfrmSettings = class(TForm)
    pmuTray: TPopupMenu;
    ActionList: TActionList;
    actChangeWallpaper: TAction;
    pgcOptions: TPageControl;
    tsLocations: TTabSheet;
    tsPlaylist: TTabSheet;
    tsPreferences: TTabSheet;
    btnAddFile: TBitBtn;
    btnAddFolder: TBitBtn;
    btnRemove: TBitBtn;
    btnClear: TBitBtn;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    chkExclude: TCheckBox;
    btnApply: TBitBtn;
    lvwPlaylist: TListView;
    pnlThumbnail: TPanel;
    vleProperties: TValueListEditor;
    actExit: TAction;
    miTrayNextWallpaper: TMenuItem;
    N1: TMenuItem;
    miTrayPauseResume: TMenuItem;
    miTrayShowHide: TMenuItem;
    N3: TMenuItem;
    miTrayExit: TMenuItem;
    grpInterval: TGroupBox;
    chkStartup: TCheckBox;
    chkEvery: TCheckBox;
    edtInterval: TEdit;
    updInterval: TUpDown;
    cbxIntervalUnit: TComboBox;
    actShowHide: TAction;
    grpFiles: TGroupBox;
    lblOpenWith: TLabel;
    optAssociatedViewer: TRadioButton;
    optAssociatedEditor: TRadioButton;
    optApplication: TRadioButton;
    edtApplication: TEdit;
    btnSelectApplication: TBitBtn;
    chkRecycle: TCheckBox;
    chkRecurse: TCheckBox;
    actPauseResume: TAction;
    TntSplitter1: TSplitter;
    miTrayFiles: TMenuItem;
    miTrayFileName: TMenuItem;
    Open1: TMenuItem;
    Removefromplaylist1: TMenuItem;
    Deletefromdisk1: TMenuItem;
    File1: TMenuItem;
    Entirefolder1: TMenuItem;
    Foldersubfolders1: TMenuItem;
    File2: TMenuItem;
    Entirefolder2: TMenuItem;
    Foldersubfolders2: TMenuItem;
    actOpen: TAction;
    tmrChangeWallpaper: TTimer;
    imgThumbnail: TImage;
    chkRefresh: TCheckBox;
    edtIntervalTo: TEdit;
    updIntervalTo: TUpDown;
    cbxIntervalToUnit: TComboBox;
    AppEvents: TApplicationEvents;
    TrayIcon: TTrayIcon;
    imlMonitors: TImageList;
    pmuPlaylist: TPopupMenu;
    tvLocations: TTreeView;
    procedure TrayIconDblClick(Sender: TObject);
    procedure TrayIconClick(Sender: TObject);
    procedure AppEventsException(Sender: TObject; E: Exception);
    procedure lvwPlaylistDataStateChange(Sender: TObject; StartIndex, EndIndex: Integer; OldState,
      NewState: TItemStates);
    procedure lvwPlaylistDataHint(Sender: TObject; StartIndex, EndIndex: Integer);
    procedure lvwPlaylistData(Sender: TObject; Item: TListItem);
    procedure lvwPlaylistSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure tmrChangeWallpaperTimer(Sender: TObject);
    procedure lvwPlaylistDblClick(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure IntervalClick(Sender: TObject);
    procedure optOpenWithClick(Sender: TObject);
    procedure chkEveryClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure actShowHideExecute(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure actChangeWallpaperExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);

    procedure WallpaperSectionChange(ASender: TObject; AIndex: integer; AFilename: WideString);

    procedure TimerMessage(var Msg: TMessage); message WM_TIMER;
    procedure SystemSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
    procedure SystemPowerEvent(var Message: TMessage); message WM_POWERBROADCAST;
  private
    FTrayClickCount: integer;
    FWPC: TWallpaperChanger;
    FNextChangeTime: TDateTime;

    { Private declarations }
    procedure ToggleVisibility();
  public
    { Public declarations }
  end;

var
  frmSettings: TfrmSettings;

implementation
  uses
    IniFiles,
    FreeBitmap, PlaylistUnit, FreeImage;

{$R *.dfm}

{ TfrmSettings }

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.FormCreate(Sender: TObject);
var
  i: integer;
  Marker: TBitmap;
  R: TRect;
begin
  for i := 0 to Screen.MonitorCount - 1 do begin
    Marker := TBitmap.Create;
    Marker.SetSize(16, 16);
    Marker.Canvas.Brush.Color := clFuchsia;
    R.Right := Marker.Width;
    R.Bottom := Marker.Height;
    Marker.Canvas.FillRect(R);
    Marker.Canvas.Brush.Color := clHighlight;
    Marker.Canvas.Ellipse(0, 0, 16, 16);
    Marker.Canvas.FloodFill(7, 7, clBlue, fsSurface);
    Marker.Canvas.Font.Color := clHighlightText;
    with Marker.Canvas.TextExtent(IntToStr(i + 1)) do begin
      Marker.Canvas.TextOut((Marker.Width - cx) div 2, (Marker.Height - cy) div 2, IntToStr(i + 1));
    end;
    imlMonitors.AddMasked(Marker, clFuchsia);
  end;

  // TODO: initialise the playlist's popup menu
//  for i := 0 to miTrayFileName.Count - 1 do begin
//    pmuPlaylist.Items.Add();
//  end;

  // Initialise the global WallpaperCycler object
  FWPC := GetWPC;

  // Set up our event handler when a playlist selection changes
  FWPC.OnWallpaperSection := WallpaperSectionChange;

  lvwPlaylist.Items.Count := FWPC.Playlist[0].Count;

  // Read the settings from INI
  case FWPC.Settings[0].StartupAction of
    saRefresh: begin
      chkStartup.Checked := True;
      chkRefresh.Checked := True;
    end;
    saNext: begin
      chkStartup.Checked := True;
      chkRefresh.Checked := False;
    end;
    else begin
      chkStartup.Checked := False;
      chkRefresh.Checked := False;
    end;
  end;

  case FWPC.Settings[0].OpenUsing of
    ouApplication: begin
      optApplication.Checked := True;
    end;
    ouEditor: begin
      optAssociatedEditor.Checked := True;
    end;
    else begin
      optAssociatedViewer.Checked := True;
    end;
  end;

  edtApplication.Text := FWPC.Settings[0].CommandLine;

  chkRecycle.Checked := FWPC.Settings[0].RecycleFiles;

  // Notify ourselves of the current file
  WallpaperSectionChange(FWPC, FWPC.Playlist[0].CurrentIndex, FWPC.Playlist[0].CurrentFile);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.FormDestroy(Sender: TObject);
begin
//  Shell_NotifyIcon(NIM_DELETE, @FTrayIconData);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.FormHide(Sender: TObject);
begin
  actShowHide.Caption := 'S&how';
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.FormShow(Sender: TObject);
begin
  actShowHide.Caption := '&Hide';
  if Assigned(lvwPlaylist.ItemFocused) then begin
    lvwPlaylist.ItemFocused.MakeVisible(False);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.IntervalClick(Sender: TObject);
begin
  actPauseResume.Enabled := (chkStartup.Checked or chkEvery.Checked);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.lvwPlaylistData(Sender: TObject; Item: TListItem);
//var
//  i: Integer;
begin
  //Item.Data := @WPC.PlayList[0].[Item.Index];
  Item.Caption := FWPC.PlayList[0].Files[Item.Index];
  Item.Checked := (Item.Index = FWPC.Playlist[0].CurrentIndex);
  // TODO: indicate if this item is the one currently on display on this monitor
//  for i := 0 to Screen.MonitorCount - 1 do begin
    if Item.Index = FWPC.Playlist[0].CurrentIndex then begin
      Item.ImageIndex := Screen.MonitorCount - 1;
    end;
//  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.lvwPlaylistDataHint(Sender: TObject; StartIndex, EndIndex: Integer);
//var
//  i: Integer;
begin
//  for i := StartIndex to EndIndex - 1 do begin
//    lvwPlaylist.Items[i].Data := @PlayList[i];
//    lvwPlaylist.Items[i].Caption := WPC.PlayList[0].Files[i];
//  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.lvwPlaylistDataStateChange(Sender: TObject;
                                                  StartIndex, EndIndex: Integer;
                                                  OldState, NewState: TItemStates);
begin
  
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.lvwPlaylistDblClick(Sender: TObject);
var
  Index: integer;
begin
  if lvwPlaylist.Selected <> nil then begin
    //Index := integer(TObject(lvwPlaylist.Selected.Data));
    Index := lvwPlaylist.Selected.Index;
    FWPC.Playlist[0].CurrentIndex := Index;
    FWPC.SetWallpapers();
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.lvwPlaylistSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
var
  FBM: TFreeWinBitmap;
//  FIMD: Pointer;
//  Tag: TFreeTag;
begin
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;

  vleProperties.Strings.Clear;
  if Selected = false then begin
    imgThumbnail.Picture.Bitmap.ReleaseHandle;
    imgThumbnail.Repaint;
  end else begin
    FBM := TFreeWinBitmap.Create();
    if FBM.Load(Item.Caption) then begin
      if imgThumbnail.Picture.Bitmap.HandleAllocated then begin
        imgThumbnail.Picture.Bitmap.ReleaseHandle;
      end;

//      Tag := TFreeTag.Create;
//      try
//        FIMD := FBM.FindFirstMetadata(FIMD_EXIF_MAIN, Tag);
//        while Assigned(FIMD) AND FBM.FindNextMetadata(FIMD, Tag) do begin
//          vleProperties.Values[Tag.Key] := Tag.ToString(FIMD_EXIF_MAIN);
//        end;
//        FBM.FindCloseMetadata(FIMD);
//      finally
//        FreeAndNil(Tag);
//      end;

      TWallpaperChanger.Rescale(FBM, imgThumbnail.Width, imgThumbnail.Height);
      imgThumbnail.Picture.Bitmap.Handle := FBM.CopyToBitmapH;
    end else begin
      imgThumbnail.Picture.Bitmap.ReleaseHandle;
      imgThumbnail.Repaint;
    end;
  end;
  Screen.Cursor := crDefault;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.Open1Click(Sender: TObject);
var
  MenuItem: TMenuItem;
  FilePath: WideString;
  ReturnValue: integer;
begin
  MenuItem := TMenuItem(Sender);
  FilePath := TMenuItem(MenuItem.Parent).Caption;
  ReturnValue := ShellExecuteW(Self.Handle, nil, @FilePath[1], nil, nil, SW_SHOWNORMAL);
  if ReturnValue <= 32 then begin
    RaiseLastOSError(ReturnValue);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.optOpenWithClick(Sender: TObject);
var
  OpenWithApp: boolean;
begin
  OpenWithApp := optApplication.Checked;
  edtApplication.Enabled := OpenWithApp;
  btnSelectApplication.Enabled := OpenWithApp;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.WallpaperSectionChange(ASender: TObject; AIndex: integer; AFilename: WideString);
begin
  lvwPlaylist.ItemIndex := FWPC.Playlist[0].CurrentIndex;
  lvwPlaylist.ItemFocused := lvwPlaylist.Items.Item[lvwPlaylist.ItemIndex];
  lvwPlaylist.ItemFocused.MakeVisible(False);
  miTrayFileName.Caption := FWPC.Playlist[0].CurrentFile;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.actExitExecute(Sender: TObject);
begin
  Self.Close;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.btnCancelClick(Sender: TObject);
begin
  // TODO: undo changes
  Self.Hide;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.chkEveryClick(Sender: TObject);
var
  CheckByInterval: boolean;
begin
  CheckByInterval := TCheckBox(Sender).Checked;
  edtInterval.Enabled := CheckByInterval;
  updInterval.Enabled := CheckByInterval;
  cbxIntervalUnit.Enabled := CheckByInterval;
  IntervalClick(Sender);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.actChangeWallpaperExecute(Sender: TObject);
begin
  FWPC.ChangeToNext();
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.actShowHideExecute(Sender: TObject);
begin
  Self.Visible := not Self.Visible;
end;

procedure TfrmSettings.AppEventsException(Sender: TObject; E: Exception);
begin
  ShowException(E, nil);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.TrayIconClick(Sender: TObject);
begin
  if FTrayClickCount = 0 then begin
    if SetTimer(Self.Handle, WM_ICONTRAY, GetDoubleClickTime, nil) = 0 then begin
      ToggleVisibility;
      FTrayClickCount := -1;
    end;
  end;
  FTrayClickCount := FTrayClickCount + 1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.TrayIconDblClick(Sender: TObject);
begin
  FTrayClickCount := 0;
  actChangeWallpaper.Execute;
  if Self.Visible then begin
    SetForegroundWindow(Handle);
  end;
end;

//////////////////////////////////////////////////////////////////////////////////////////////////////
//procedure TfrmSettings.TrayMessage(var Msg: TMessage);
//var
//  CursorPos: TPoint;
//begin
//  case Msg.lParam of
//    WM_LBUTTONUP: begin
//      if FTrayClickCount = 0 then begin
//        if SetTimer(Self.Handle, WM_ICONTRAY, GetDoubleClickTime, nil) = 0 then begin
//          ToggleVisibility;
//          FTrayClickCount := -1;
//        end;
//      end;
//      FTrayClickCount := FTrayClickCount + 1;
//    end;
//    WM_RBUTTONUP: begin
//      GetCursorPos(CursorPos);
//      SetForegroundWindow(Handle);
//      pmuTray.Popup(CursorPos.X, CursorPos.Y);
//      PostMessage(Handle, WM_NULL, 0, 0);
//    end;
//    WM_LBUTTONDBLCLK: begin
//      actChangeWallpaper.Execute;
//    end;
//  end;
//end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.TimerMessage(var Msg: TMessage);
begin
  case Msg.WParam of
    WM_ICONTRAY: begin
      if FTrayClickCount = 1 then begin
        ToggleVisibility;
      end;
      FTrayClickCount := 0;
    end{WM_ICONTRAY};
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.tmrChangeWallpaperTimer(Sender: TObject);
begin
  if Now >= FNextChangeTime then begin
    FWPC.ChangeToNext();
  end else begin
    // TODO: redo this
    tmrChangeWallpaper.Interval := 60000;
    if FNextChangeTime - Now < tmrChangeWallpaper.Interval then begin
      tmrChangeWallpaper.Interval := Round((FNextChangeTime - Now) * 86400000); // milliseconds
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.ToggleVisibility;
begin
  Self.Visible := not Self.Visible;
  if Self.Visible then
    SetForegroundWindow(Self.Handle);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.SystemSettingChange(var Message: TMessage);
begin
  case Message.WParam of
    SPI_SETBORDER, SPI_SETWORKAREA: begin
      // refresh the current wallpaper(s)
    end;
    SPI_SETDESKPATTERN, SPI_SETDESKWALLPAPER: begin
      // what to do with this? -- provided we didn't cause it, at least
    end;
    SPI_SETLOWPOWERACTIVE: begin
      if Message.LParam = 1 then begin
        //TODO: go to 'auto-pause' mode
      end else begin
        //TODO: if in 'auto-pause' mode, then resume
      end;
    end;
  end;
  Message.Result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TfrmSettings.SystemPowerEvent(var Message: TMessage);
begin
  case Message.WParam of
    PBT_APMQUERYSTANDBY, PBT_APMQUERYSUSPEND, PBT_APMSTANDBY, PBT_APMSUSPEND: begin
      //TODO: go to 'auto-pause' mode
    end;
    PBT_APMQUERYSTANDBYFAILED, PBT_APMQUERYSUSPENDFAILED,
    PBT_APMRESUMESTANDBY , PBT_APMRESUMESUSPEND: begin
      //TODO: if in 'auto-pause' mode, then resume
    end;
  end;
  // we don't want to deny any request
  Message.Result := Integer(True);
end;


end.

Added src/Main.bas.

























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Attribute VB_Name = "modMain"
Option Explicit

Public FSO As New Scripting.FileSystemObject

Private ixmlSettings As MSXML2.DOMDocument40
Private iclsPlaylist As clsPlaylist

Public Sub Main()
    Set ixmlSettings = New MSXML2.DOMDocument40
    With ixmlSettings
        .async = False
        .setProperty "SelectionLanguage", "XPath"
        If Not .Load(App.Path & "\" & App.EXEName & ".config") Then
            Err.Raise vbObjectError, App.EXEName & ".config", .parseError.reason
        End If
    End With
    
    Set iclsPlaylist = New clsPlaylist
    iclsPlaylist.Update
    
    
End Sub


Public Property Get Settings() As MSXML2.DOMDocument40
    Set Settings = ixmlSettings
End Property

Added src/Playlist.bas.



>
1
Attribute VB_Name = "modPlaylist"

Added src/Playlist.cls.

































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPlaylist"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long)

Private istrPlaylist() As String
Private ilngPlaylistCount As Long
Private ilngPlaylistIndex As Long
Private istrNewFiles() As String
Private ilngNewFilesCount As Long

Private Sub Class_Initialize()
    ReDim istrPlaylist(0 To 100)
    ilngPlaylistCount = 0
End Sub


Public Sub Update()
    Dim lxmlLocation As MSXML2.IXMLDOMElement
    Dim llngIndex As Long
    
    ' Make sure all paths have the same capitalization
    NormalizeLocations
    
    ' TODO:TEMP
    Load
    ' TODO:TEMP
    
    ReDim istrNewFiles(1 To 100)
    ilngNewFilesCount = 0
    For Each lxmlLocation In Settings.selectNodes("/Settings/Locations/Include")
        IncludeLocation lxmlLocation.getAttribute("path"), (lxmlLocation.getAttribute("recursive") <> "true")
    Next
    
    ' Consolidate the new playlist
    ' TODO: use copymemory to make things a bit faster?
    ReDim Preserve istrPlaylist(0 To ilngPlaylistCount + ilngNewFilesCount)
    For llngIndex = ilngPlaylistCount + 1 To ilngPlaylistCount + ilngNewFilesCount
        istrPlaylist(llngIndex) = istrNewFiles(llngIndex - ilngPlaylistCount)
    Next
    ilngPlaylistCount = ilngPlaylistCount + ilngNewFilesCount
    
    ' Discard the new files list
    ReDim istrNewFiles(1 To 1)
    ilngNewFilesCount = 0
    
    ' TODO:TEMP
    Save
    ' TODO:TEMP
    
    ' TODO: Randomize everything after the current playlist index
    Shuffle istrPlaylist(), ilngPlaylistIndex
    
    ' TODO:TEMP
    Save
    ' TODO:TEMP
    
End Sub

Public Sub Load()
    Dim lobjStream As Object
    
    Set lobjStream = CreateObject("ADODB.Stream")
    lobjStream.Type = 2 'adTypeText
    lobjStream.Charset = "UTF-8"
    lobjStream.Open
    lobjStream.LoadFromFile App.Path & "\" & App.EXEName & ".playlist"
    istrPlaylist = Split(lobjStream.ReadText(), vbNewLine)
    lobjStream.Close
    Set lobjStream = Nothing
    
    ilngPlaylistCount = UBound(istrPlaylist) - LBound(istrPlaylist)
End Sub

Public Sub Save()
    Dim lobjStream As Object
    
    If FSO.FileExists(App.Path & "\" & App.EXEName & ".playlist") Then
        Kill App.Path & "\" & App.EXEName & ".playlist"
    End If
    
    Set lobjStream = CreateObject("ADODB.Stream")
    lobjStream.Type = 2 'adTypeText
    lobjStream.Charset = "UTF-8"
    lobjStream.Open
    lobjStream.WriteText Join$(istrPlaylist, vbNewLine) & vbNewLine
    lobjStream.SaveToFile App.Path & "\" & App.EXEName & ".playlist"
    lobjStream.Close
    Set lobjStream = Nothing
End Sub

Private Sub NormalizeLocations()
    Dim lxmlLocation As MSXML2.IXMLDOMElement
    
    For Each lxmlLocation In Settings.selectNodes("/Settings/Locations/Include|/Settings/Locations/Exclude")
        lxmlLocation.setAttribute "path", NormalizeLocation(lxmlLocation.getAttribute("path"))
    Next
End Sub

Public Function NormalizeLocation(ByVal astrPath As String) As String
    Dim lstrPath As String
    
    lstrPath = modFilePath.GetLongPath(modFilePath.GetFullPath(astrPath))
    If Len(lstrPath) > 3 And Right$(lstrPath, 1) = "\" Then
        lstrPath = Left$(lstrPath, Len(lstrPath) - 1)
    End If
    
    NormalizeLocation = lstrPath
End Function

Private Function IncludeLocation(ByVal astrPath As String, _
                                 Optional ByVal ablnSkipSubfolders As Boolean = False) As Long
    Dim lobjFolder As Scripting.Folder
    Dim lobjFile As Scripting.File
    Dim lxmlExcluded As MSXML2.IXMLDOMElement
    Dim llngClearedLength As Long
    
    If FSO.FileExists(astrPath) Then
        AddFile astrPath
    ElseIf FSO.FolderExists(astrPath) Then
        Set lobjFolder = FSO.GetFolder(astrPath)
        
        Set lxmlExcluded = GetExclusion(astrPath, llngClearedLength)
        If lxmlExcluded Is Nothing Then
            ReserveSpace istrNewFiles, ilngNewFilesCount, lobjFolder.Files.Count
            For Each lobjFile In lobjFolder.Files
                AddFile lobjFile.Path, llngClearedLength
            Next
        ElseIf lxmlExcluded.getAttribute("recursive") = "true" Then
            ablnSkipSubfolders = True
        End If
    
        If ablnSkipSubfolders = False Then
            For Each lobjFolder In lobjFolder.SubFolders
                IncludeLocation lobjFolder.Path, ablnSkipSubfolders
            Next
        End If
    Else
        ' TODO: raise warning: nonexistent path
        Stop
    End If
End Function

Private Function AddFile(ByVal astrPath As String, _
                         Optional ByVal alngClearedLength As Long = 0) As Boolean
    Dim lxmlExcluded As MSXML2.IXMLDOMElement
    Dim lxmlIncluded As MSXML2.IXMLDOMElement
    Dim llngPathLength As Long
    Dim llngIndex As Long
    
    astrPath = NormalizeLocation(astrPath)
    Set lxmlExcluded = GetExclusion(astrPath, alngClearedLength)
    If Not lxmlExcluded Is Nothing Then
        AddFile = False
        Exit Function
    End If
    
    For llngIndex = LBound(istrPlaylist) To UBound(istrPlaylist)
        If LenB(astrPath) = LenB(istrPlaylist(llngIndex)) Then
            If astrPath = istrPlaylist(llngIndex) Then
                AddFile = False
                Exit Function
            End If
        End If
    Next
    For llngIndex = LBound(istrNewFiles) To UBound(istrNewFiles)
        If LenB(astrPath) = LenB(istrNewFiles(llngIndex)) Then
            If astrPath = istrNewFiles(llngIndex) Then
                AddFile = False
                Exit Function
            End If
        End If
    Next
    
    ReserveSpace istrNewFiles, ilngNewFilesCount, 1
    ilngNewFilesCount = ilngNewFilesCount + 1
    istrNewFiles(ilngNewFilesCount) = astrPath
    AddFile = True
End Function

Private Function GetExclusion(ByVal astrPath As String, _
                              Optional ByRef alngClearedLength As Long = 0) As MSXML2.IXMLDOMElement
    Dim lxmlNode As MSXML2.IXMLDOMElement
    Dim llngPathLength As Long
    Dim llngMaxLength As Long
    Dim lxmlExcluded As MSXML2.IXMLDOMElement
    Dim lxmlIncluded As MSXML2.IXMLDOMElement
    
    llngMaxLength = 0
    For Each lxmlNode In Settings.selectNodes("/Settings/Locations/Exclude[starts-with(""" & astrPath & """, @path)][string-length(@path) >= " & alngClearedLength & "]")
        llngPathLength = Len(lxmlNode.getAttribute("path"))
        If llngPathLength > llngMaxLength Then
            Set lxmlExcluded = lxmlNode
            llngMaxLength = llngPathLength
        End If
    Next
    
    If Not lxmlExcluded Is Nothing Then
        For Each lxmlNode In Settings.selectNodes("/Settings/Locations/Include[contains(""" & astrPath & """, @path)][string-length(@path) >= " & llngMaxLength & "]")
            llngPathLength = Len(lxmlNode.getAttribute("path"))
            If llngPathLength >= llngMaxLength Then
                Set lxmlIncluded = lxmlNode
                llngMaxLength = llngPathLength
            End If
        Next
        If lxmlIncluded Is Nothing Then
            Set GetExclusion = lxmlExcluded
        Else
            alngClearedLength = llngMaxLength
        End If
    End If
End Function

Private Sub ReserveSpace(ByRef astrArray() As String, _
                         ByVal alngCount As Long, _
                         Optional ByVal alngAddCount As Long = 100)
    If UBound(astrArray) - alngCount < alngAddCount Then
        ReDim Preserve astrArray(LBound(astrArray) To alngCount + alngAddCount)
    End If
End Sub

Private Sub Shuffle(ByRef astrArray() As String, _
                    Optional ByVal alngStartIndex As Long = -2147483647, _
                    Optional ByVal alngEndIndex As Long = 2147483647)
    Dim llngCount As Long
    Dim llngIndex As Long
    Dim llngNewIndex As Long
    Dim lstrTemp As String
    
    If alngStartIndex < LBound(astrArray) Then alngStartIndex = LBound(astrArray)
    If alngEndIndex > UBound(astrArray) Then alngEndIndex = UBound(astrArray)
    
    llngCount = alngEndIndex - alngStartIndex + 1
    For llngIndex = alngStartIndex To alngEndIndex
        llngNewIndex = alngStartIndex + Rnd() * llngCount
        
        lstrTemp = astrArray(llngIndex)
        astrArray(llngIndex) = astrArray(llngNewIndex)
        astrArray(llngNewIndex) = lstrTemp
    Next
End Sub

Added src/PlaylistUnit.pas.



























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
unit PlaylistUnit;

interface
  uses
    Classes,
    L_GetFileList, WideStrings;


  type
    // Forward declarations
    TPlaylist = class;

    // Event declarations

    // Enumerations
    TPathInclusion = (piInclude, piIncludeRecursive, piExclude, piExcludeRecursive);

    // Class definitions

    TDefinition = class
      private
        FPath: WideString;
        FInclusion: TPathInclusion;
      public
        constructor Create(APath: WideString; AInclude: TPathInclusion = piIncludeRecursive);
      published
        property Path: WideString           read FPath      write FPath;
        property Inclusion: TPathInclusion  read FInclusion write FInclusion;
    end;

    TDefinitionList = class(TList)
      protected
        FParent: TPlaylist;

        function GetDefinition(AIndex: integer): TDefinition;
        function InclusionFromString(AText: string): TPathInclusion;
      public
        constructor Create(AParent: TPlaylist);
        destructor  Destroy(); override;

        function  Add(APath: WideString; AInclude: TPathInclusion = piIncludeRecursive): integer; overload;
        function  Add(APaths: TWideStringList; AInclude: TPathInclusion = piIncludeRecursive): integer; overload;
        procedure Assign(ALocations: TStringList); overload;
        procedure Assign(ALocations: TWideStringList); overload;

        property Items[Index: integer]: TDefinition read GetDefinition; default;
    end;

    TEntry = class
      protected
        FDefinition: TDefinition;
        FParent: TEntry;
        FPath: WideString;
        FLastDateTime: TDateTime;
        FPlaylistIndex: integer;
        function GetName(): WideString;
      public
        constructor Create(ADefinition: TDefinition; APath: WideString); overload;
        constructor Create(AParent: TEntry; AName: WideString); overload;
        destructor Destroy; override;

        property Path: WideString read FPath write FPath;
        property Name: WideString read GetName;
        property Definition: TDefinition read FDefinition;
    end;

    TFile = class(TEntry)
    end;

    TFolder = class(TEntry)
      private
        FFiles: array of TFile;
        FFolders: array of TFolder;

        function GetEntry(AIndex: integer): TEntry;
        function GetFolder(AIndex: integer): TFolder;
      public
        procedure Update;

        property Entry[Index: integer]: TEntry read GetEntry; default;
    end;

    // TODO: use TEntry descendants
    TPlaylistFile = WideString;

    TFileEvent = procedure(ASender: TObject; AFile: TPlaylistFile; AIndex: integer) of object;
    TMoveEvent = procedure(ASender: TObject; APreviousIndex: integer) of object;

    TPlaylist = class
      private
        FDefinitions: TDefinitionList;
        FFiles: array of TEntry;
        FIndex, FPrevIndex: integer;
        FIsRandom: boolean;

        FOnAddFile: TFileEvent;
        FOnRemoveFile: TFileEvent;
        FOnChange: TMoveEvent;

        FFileList: TWideStringList; // TODO: get rid of this, use a TList of TFile objects

        function  GetDefaultPath(): string;
        procedure ValidateIndex(var AValue: integer);
        procedure SetIndex(AValue: integer);
        function  GetCount(): integer;
        function  GetFile(AIndex: integer): WideString;
        function  GetCurrentFile(): WideString;
      public
        constructor Create();
        destructor  Destroy(); override;

        function  Load(APath: WideString = ''): boolean;
        procedure Refresh(AForceImmediate: boolean = false);
        function  Save(APath: WideString = ''): boolean;

        procedure Shuffle(AStartIndex: integer = -1; AEndIndex: integer = -1);

        function GetNextFile(): WideString;
        function GetPreviousFile(): WideString;

        property DefaultPath: string                read GetDefaultPath;
        property Definitions: TDefinitionList       read FDefinitions;
        property Random: boolean                    read FIsRandom      write FIsRandom;
        property Count: integer                     read GetCount;
        property CurrentIndex: integer              read FIndex         write SetIndex;
        property CurrentFile: WideString            read GetCurrentFile;
        property Files[Index: integer]: WideString  read GetFile;

        // TODO: allow multiple event handlers
        property OnAddFile: TFileEvent      read FOnAddFile     write FOnAddFile;
        property OnRemoveFile: TFileEvent   read FOnRemoveFile  write FOnRemoveFile;
        property OnChangeIndex: TMoveEvent  read FOnChange      write FOnChange;

    end;

implementation
  uses
    SysUtils, Forms,
    Windows, ShFolder;

////////////////////////////////////////////////////////////////////////////////////////////////////
  function GetLocalAppDataPath(): string;
  const
     SHGFP_TYPE_CURRENT = 0;
  var
     Path: array [0..MAX_PATH] of char;
     RetVal: HResult;
  begin
    RetVal := SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
    if RetVal = S_OK then begin
       result := path;
    end else begin
      result := '';
    end;
  end;

{ TPlaylist }


////////////////////////////////////////////////////////////////////////////////////////////////////

{ TDefinition }

constructor TDefinition.Create(APath: WideString; AInclude: TPathInclusion);
begin
  FPath := APath;
  FInclusion := AInclude;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////

{ TDefinitionList }

constructor TDefinitionList.Create(AParent: TPlaylist);
begin
  FParent := AParent;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TDefinitionList.Destroy;
begin
  FParent := nil;
end;
{ ------------------------------------------------------------------------------------------------ }
function TDefinitionList.Add(APath: WideString; AInclude: TPathInclusion): integer;
var
  New: TDefinition;
begin
  New := TDefinition.Create(APath, AInclude);

  result := inherited Add(New);
end;
{ ------------------------------------------------------------------------------------------------ }
function TDefinitionList.Add(APaths: TWideStringList; AInclude: TPathInclusion): integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to APaths.Count - 1 do begin
    Result := Self.Add(APaths.Strings[i], AInclude);
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TDefinitionList.InclusionFromString(AText: string): TPathInclusion;
begin
  if AText = '*\*' then
    Result := piIncludeRecursive
  else if AText = '*' then
    Result := piInclude
  else if AText = '' then
    Result := piExcludeRecursive
  else if AText = '\*' then
    Result := piExclude
  else
    Result := piIncludeRecursive;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TDefinitionList.Assign(ALocations: TStringList);
var
  i: integer;
begin
  for i := 0 to ALocations.Count - 1 do begin
    Self.Add(ALocations.Names[i], InclusionFromString(ALocations.ValueFromIndex[i]));
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TDefinitionList.Assign(ALocations: TWideStringList);
var
  i: integer;
begin
  for i := 0 to ALocations.Count - 1 do begin
    Self.Add(ALocations.Names[i], InclusionFromString(ALocations.ValueFromIndex[i]));
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TDefinitionList.GetDefinition(AIndex: integer): TDefinition;
begin
  result := TDefinition(inherited Get(AIndex));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////

{ TEntry }

constructor TEntry.Create(ADefinition: TDefinition; APath: WideString);
begin
  FDefinition := ADefinition;
  FParent := nil;
  FPath := APath;
end;
{ ------------------------------------------------------------------------------------------------ }
constructor TEntry.Create(AParent: TEntry; AName: WideString);
begin
  FDefinition := AParent.Definition;
  FParent := AParent;
  FPath := IncludeTrailingPathDelimiter(AParent.Path) + AName;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TEntry.Destroy;
begin

  inherited;
end;
{ ------------------------------------------------------------------------------------------------ }
function TEntry.GetName: WideString;
var
  CharPos: integer;
begin
  CharPos := Pos(FPath, '\');
  if CharPos = 0 then begin
    result := FPath;
  end else begin
    result := Copy(FPath, CharPos + 1);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////

{ TFolder }

function TFolder.GetEntry(AIndex: integer): TEntry;
begin
  if AIndex > Length(FFolders) - 1 then begin
    Result := FFiles[AIndex - Length(FFolders)];
  end else begin
    Result := FFolders[AIndex];
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TFolder.GetFolder(AIndex: integer): TFolder;
begin
  Result := FFolders[AIndex];
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TFolder.Update;
begin
  // TODO
end;

////////////////////////////////////////////////////////////////////////////////////////////////////

{ TPlaylist }

constructor TPlaylist.Create;
begin
  SetLength(FFiles, 0);
  FDefinitions := TDefinitionList.Create(Self);

  FFileList := TWideStringList.Create;
  FIndex := -1;
end;
{ ------------------------------------------------------------------------------------------------ }
destructor TPlaylist.Destroy;
begin
  if Assigned(FDefinitions) then
    FreeAndNil(FDefinitions);
  SetLength(FFiles, 0);

  FreeAndNil(FFileList);
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.GetDefaultPath: string;
begin
  Result := ChangeFilePath(ChangeFileExt(Application.ExeName, ''), GetLocalAppDataPath());
  ForceDirectories(Result);
  Result := IncludeTrailingPathDelimiter(Result) + 'Wallpaper.wcpl';
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.GetCount: integer;
begin
  Result := FFileList.Count;
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.GetFile(AIndex: integer): WideString;
begin
  ValidateIndex(AIndex);
  if AIndex > -1 then begin
    result := FFileList.Strings[AIndex];
  end else begin
    result := '';
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.GetCurrentFile: WideString;
begin
  if FIndex > -1 then begin
    Result := FFileList.Strings[FIndex];
  end else begin
    Result := '';
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.GetNextFile: WideString;
var
  NewIndex: integer;
begin
  NewIndex := FIndex + 1;
  if NewIndex >= FFileList.Count then begin
    if FIsRandom then
      Self.Shuffle();
    SetIndex(0);
  end else begin
    SetIndex(NewIndex);
  end;
  Result := Self.GetCurrentFile;
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.GetPreviousFile: WideString;
begin
  // we can't cross the boundary when going backwards
  SetIndex(FIndex - 1);
  Result := Self.GetCurrentFile;
end;

{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.Load(APath: WideString): boolean;
begin
  if APath = '' then
    APath := Self.DefaultPath;
  FFileList.LoadFromFile(APath);
  Result := True;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TPlaylist.Refresh(AForceImmediate: boolean = false);
var
  i: Integer;
  FolderFiles: TWideStringList;
begin
  // TODO: have this done on a separate thread, preferably during idle time
  // Only force it now when we have no files at all in here

  // TODO: actually perform an UPDATE instead of removing everything, and loading it again;
  //  and keep the shuffled order. If there's new files, add them at the end, and reshuffle
  //  everything after the current index.

  if Assigned(FFileList) then begin
    if Assigned(FOnRemoveFile) then begin
      // raise event for each file
      for i := 0 to FFileList.Count - 1 do begin
        FOnRemoveFile(Self, FFileList.Strings[i], i);
      end;
    end;
    FreeAndNil(FFileList);
  end;
  FFileList := TWideStringList.Create;

  if FDefinitions.Count > 0 then begin
    for i := 0 to FDefinitions.Count - 1 do begin
      FolderFiles := GetFileList(IncludeTrailingPathDelimiter(FDefinitions[i].Path) + '*.jpg', False, True, FDefinitions[i].Inclusion = piIncludeRecursive, True);
      FFileList.AddStrings(FolderFiles);
      FreeAndNil(FolderFiles);
    end;

    if Assigned(FOnAddFile) then begin
      // raise event for each file
      for i := 0 to FFileList.Count - 1 do begin
        FOnAddFile(Self, FFileList.Strings[i], i);
      end;
    end;
  end;

  if AForceImmediate and FIsRandom then begin
    Shuffle();
  end;


  if (FIndex < 0) or (FIndex >= FDefinitions.Count) then begin
    SetIndex(0);
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
function TPlaylist.Save(APath: WideString): boolean;
begin
  if APath = '' then
    APath := Self.DefaultPath;
  FFileList.SaveToFile(APath);
  Result := True;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TPlaylist.SetIndex(AValue: integer);
begin
  FPrevIndex := FIndex;
  ValidateIndex(AValue);
  FIndex := AValue;
  if Assigned(FOnChange) then
    FOnChange(Self, FPrevIndex);
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TPlaylist.Shuffle(AStartIndex, AEndIndex: integer);
var
  i: Integer;
  Index: Integer;
  TempStr: WideString;
begin
  if AStartIndex = -1 then
    AStartIndex := 0;
  if AEndIndex = -1 then
    AEndIndex := FFileList.Count - 1;

  if AEndIndex > AStartIndex then begin
    for i := AStartIndex to AEndIndex do begin
      Index := i + System.Random(AEndIndex - i + 1);
      if i = FIndex then FIndex := Index;

      TempStr := FFileList.Strings[i];
      FFileList.Strings[i] := FFileList.Strings[Index];
      FFileList.Strings[Index] := TempStr;
    end;
    SetIndex(FIndex);
  end;
end;
{ ------------------------------------------------------------------------------------------------ }
procedure TPlaylist.ValidateIndex(var AValue: integer);
begin
  if FFileList.Count = 0 then begin
    AValue := -1;
  end else if AValue < 0 then begin
    AValue := 0;
  end else if AValue >= FFileList.Count then begin
    AValue := FFileList.Count - 1;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }

////////////////////////////////////////////////////////////////////////////////////////////////////

initialization
begin
  Randomize;
end;

end.

Added src/WPCycler.config.































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
<Settings>
	<Locations>
		<Include path="F:\MM\Image\" recursive="true" />
		<Exclude path="F:\MM\Image\Icons\" recursive="true"/>
		<Exclude path="F:\MM\Image\Photos\Wijnand\Orginal\" recursive="true"/>
		<Exclude path="F:\MM\Image\Work\Privé\" recursive="true"/>
		<Exclude path="F:\MM\Image\Work\" recursive="true"/>
		<Include path="F:\MM\Image\Work\Projects\Arjen\" recursive="false"/>
		<Exclude path="F:\MM\Image\Work\Temp\" recursive="true"/>
		<Exclude path="F:\MM\Image\Zoom\" recursive="true"/>
	</Locations>
	<Status>
		<Playlist index="0"/>
	</Status>
</Settings>

Added src/WPCycler.playlist.

more than 10,000 changes

Added src/WPCycler.vbp.









































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINDOWS\system32\scrrun.dll#Microsoft Scripting Runtime
Reference=*\G{F5078F18-C551-11D3-89B9-0000F81FE221}#4.0#0#C:\WINDOWS\system32\msxml4.dll#Microsoft XML, v4.0
Module=modMain; Main.bas
Module=modFilePath; ..\..\..\..\..\..\Common\VB6\FilePath.bas
Module=modError; ..\..\..\..\..\..\Common\VB6\Error.bas
Class=clsPlaylist; Playlist.cls
Module=MFreeImage; ..\..\..\..\..\..\Common\VB6\MFreeImage.bas
Startup="Sub Main"
HelpFile=""
Command32=""
Name="WPCycler"
HelpContextID="0"
Description="Wallpaper Cycler"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

Added src/WPCycler.vbw.











>
>
>
>
>
1
2
3
4
5
modMain = 129, 103, 1000, 731, 
modFilePath = 129, 103, 1157, 935, C
modError = 129, 103, 576, 935, C
clsPlaylist = 173, 126, 1083, 750, 
MFreeImage = 0, 0, 0, 0, C

Added src/WallpaperChangerUnit.pas.





























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
unit WallpaperChangerUnit;

interface
  uses
    Windows, IniFiles,
    FreeBitmap,
    PlaylistUnit;

  type
    // Forward declarations
    TSettings = class;
    TMonitorWallpaper = class;

    // Enumerations
    TWallpaperStyleEnum = (wpsTile = 0, wpsCenter = 1, wpsStretch = 2, wpsPosition = 3, wpsPositionedTile = 4, wpsUnchanged = -1);
    TStartupActionEnum = (saNothing, saRefresh, saNext);
    TOpenUsingEnum = (ouViewer, ouEditor, ouApplication);

    // Routines
    TFilenameEvent = procedure(ASender: TObject; AFilename: WideString) of object;
    TIndexFilenameEvent = procedure(ASender: TObject; AIndex: integer; AFilename: WideString) of object;

    // Classes
    TWallpaperChanger = class
      private
        FPlaylists: array of TPlaylist;
        FSettings:  array of TSettings;
        FMonitors:  array of TMonitorWallpaper;

        FOutputFileName: string;

        FWorking: integer;

        FConfig: TIniFile;

        FOnWallpaperSet: TFilenameEvent;
        FOnWallpaperSection: TIndexFilenameEvent;

        class function  GetCurrentWallpaper(): WideString; static;
        class procedure SetCurrentWallpaper(const AFilename: WideString); static;

        function        GetPlaylist(const AIndex: integer = 0): TPlaylist;
        function        GetSettings(const AIndex: integer = 0): TSettings;
        function        GetRescaledImage(AFilename: WideString;
                                         AWorkArea: TRect): TFreeBitmap;

        procedure       PlaylistChangeIndex(ASender: TObject; APreviousIndex: integer);
      public
        constructor Create();
        destructor  Destroy(); override;
        procedure   ChangeToPrevious(const AMonitorIndex: integer = -1);
        procedure   ChangeToNext(const AMonitorIndex: integer = -1);
        procedure   SetWallpapers();

        property    Playlist[const Index: integer = 0]: TPlaylist read GetPlaylist;
        property    Settings[const Index: integer = 0]: TSettings read GetSettings;

        property    OnWallpaperSection: TIndexFilenameEvent read FOnWallpaperSection write FOnWallpaperSection;
        property    OnWallpaperSet: TFilenameEvent  read FOnWallpaperSet write FOnWallpaperSet;

        class function  Rescale(APicture: TFreeBitmap;
                                AMaxWidth, AMaxHeight: integer;
                                AStretch: boolean = false): boolean;
        class function  GetWallpaper(out AStyle: TWallpaperStyleEnum;
                                     out AXPosition, AYPosition: Integer): WideString;
        class procedure SetWallpaper(AFilename: WideString;
                                     AStyle: TWallpaperStyleEnum = wpsCenter;
                                     AXPosition: Integer = 0;
                                     AYPosition: Integer = 0);
        class property  Wallpaper: WideString read GetCurrentWallpaper write SetCurrentWallpaper;
    end;

    TMonitorWallpaper = class
      private
        FFilename:      WideString;
        FPosition:      TWallpaperStyleEnum;
        FWorkAreaOnly:  boolean;
        FDesktopRect:   TRect;
      public
        property    Filename: WideString          read FFilename      write FFilename;
        property    Position: TWallpaperStyleEnum read FPosition      write FPosition;
        property    WorkAreaOnly: boolean         read FWorkAreaOnly  write FWorkAreaOnly;
        property    DesktopPortion: TRect         read FDesktopRect   write FDesktopRect;
    end;

    TSettings = class
      protected
        FStartupAction: TStartupActionEnum;
        FIntervalMin:   UInt64;
        FIntervalMax:   UInt64;
        FPosition:      TWallpaperStyleEnum;
        FWorkAreaOnly:  boolean;
        FOpenUsing:     TOpenUsingEnum;
        FCommandLine:   WideString;
        FRecycleFiles:  boolean;
      public
        property    StartupAction: TStartupActionEnum read FStartupAction write FStartupAction;
        property    MinimumInterval: UInt64           read FIntervalMin   write FIntervalMin;
        property    MaximuMaxterval: UInt64           read FIntervalMax   write FIntervalMax;
        property    WorkAreaOnly: boolean             read FWorkAreaOnly  write FWorkAreaOnly;
        property    Position: TWallpaperStyleEnum     read FPosition      write FPosition;
        property    OpenUsing: TOpenUsingEnum         read FOpenUsing     write FOpenUsing;
        property    CommandLine: WideString           read FCommandLine   write FCommandLine;
        property    RecycleFiles: boolean             read FRecycleFiles  write FRecycleFiles;
    end;

  function GetWPC: TWallpaperChanger;

implementation
uses
  Forms, SysUtils, Registry, Classes,
  FreeImage,
  L_ShellFolders;

var
  FWPC: TWallpaperChanger;

function GetWPC: TWallpaperChanger;
begin
  if not Assigned(FWPC) then begin
    FWPC := TWallpaperChanger.Create;
  end;
  Result := FWPC;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////
{ TWallpaperChanger }

constructor TWallpaperChanger.Create;
var
  i: Integer;
  StringValue: string;
  LocationsList: TStringList;
begin
  FWorking := 0;

  SetLength(FPlaylists, 1);
  FPlaylists[0] := TPlaylist.Create;
  FPlaylists[0].OnChangeIndex := PlaylistChangeIndex;

  SetLength(FSettings, 1);
  FSettings[0] := TSettings.Create;
  FSettings[0].WorkAreaOnly := True;

  SetLength(FMonitors, Screen.MonitorCount);
  for i := 0 to Screen.MonitorCount - 1 do begin
    FMonitors[i] := TMonitorWallpaper.Create;
    FMonitors[i].Filename := '';
    FMonitors[i].Position := FSettings[0].Position;
    FMonitors[i].WorkAreaOnly := FSettings[0].WorkAreaOnly;
  end;

  FOutputFileName := IncludeTrailingPathDelimiter(GetFolderPath(CSIDL_LOCAL_APPDATA));
  if ForceDirectories(FOutputFileName + Application.Name) then begin
    FOutputFileName := IncludeTrailingPathDelimiter(FOutputFileName + Application.Name) + 'Wallpaper.bmp';
  end else begin
    FOutputFileName := FOutputFileName + 'Wallpaper.bmp';
  end;

  // Read the settings from INI
  // TODO: Create a TAppSettings class to handle conversion of values to enums
  FConfig := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
  StringValue := LowerCase(FConfig.ReadString('Settings', 'Startup', 'nothing'));
  if StringValue = 'refresh' then begin
    FSettings[0].StartupAction := saRefresh;
  end else if StringValue = 'next' then begin
    FSettings[0].StartupAction := saNext;
  end else begin
    FSettings[0].StartupAction := saNothing;
  end;

  StringValue := LowerCase(FConfig.ReadString('Settings', 'Launch', 'view'));
  if StringValue = 'edit' then begin
    FSettings[0].OpenUsing := ouEditor;
  end else if StringValue = 'run' then begin
    FSettings[0].OpenUsing := ouApplication;
  end else begin
    FSettings[0].OpenUsing := ouViewer;
  end;

  FSettings[0].CommandLine := FConfig.ReadString('Settings', 'Run', '');

  StringValue := LowerCase(FConfig.ReadString('Settings', 'Delete', 'recycle'));
  FSettings[0].RecycleFiles := not ((StringValue = 'erase') or (StringValue = 'kill') or (StringValue = 'delete'));

  // Initialize the playlist
  LocationsList := TStringList.Create;
  LocationsList.NameValueSeparator := '=';
  try
    FConfig.ReadSectionValues('Locations', LocationsList);
    FPlaylists[0].Definitions.Assign(LocationsList);
  finally
    FreeAndNil(LocationsList);
  end;

  FPlaylists[0].Random := FConfig.ReadBool('Playlist', 'Shuffle', False);

  if FileExists(FPlaylists[0].DefaultPath) then begin
    FPlaylists[0].Load();
    FPlaylists[0].CurrentIndex := FConfig.ReadInteger('Playlist', 'CurrentIndex', -1);
//      FPlaylists[0].Refresh(); // TODO: put this back when refreshing actually refreshes
  end else begin
    FPlaylists[0].Refresh(True);
    FPlaylists[0].Save();
  end;

end;

{ ------------------------------------------------------------------------------------------------ }

destructor TWallpaperChanger.Destroy;
var
  i: Integer;
begin
  for i := 0 to High(FMonitors) do begin
    FMonitors[i].Free;
  end;
  SetLength(FMonitors, 0);

  for i := 0 to High(FPlaylists) do
    FPlaylists[i].Free;
  SetLength(FPlaylists, 0);

  for i := 0 to High(FSettings) do
    FSettings[i].Free;
  SetLength(FSettings, 0);

  if Assigned(FConfig) then
    FreeAndNil(FConfig);

  inherited;
end;

{ ------------------------------------------------------------------------------------------------ }

function TWallpaperChanger.GetPlaylist(const AIndex: integer): TPlaylist;
begin
  Result := FPlaylists[AIndex];
end;

{ ------------------------------------------------------------------------------------------------ }

function TWallpaperChanger.GetSettings(const AIndex: integer): TSettings;
begin
  Result := FSettings[AIndex];
end;

{ ------------------------------------------------------------------------------------------------ }

procedure TWallpaperChanger.ChangeToNext(const AMonitorIndex: integer);
var
  i: Integer;
begin
  if AMonitorIndex < 0 then begin
    Inc(FWorking);
    for i := 0 to High(FMonitors) do begin
      ChangeToNext(i);
    end;
    Dec(FWorking);
  end else begin
    Inc(FWorking);
    FMonitors[AMonitorIndex].Filename := FPlaylists[0].GetNextFile();
    if Assigned(FOnWallpaperSection) then
      FOnWallpaperSection(Self, AMonitorIndex, FMonitors[AMonitorIndex].Filename);
    Dec(FWorking);
  end;
  if FWorking = 0 then begin
    SetWallpapers;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }

procedure TWallpaperChanger.ChangeToPrevious(const AMonitorIndex: integer);
var
  i: Integer;
begin
  if AMonitorIndex < 0 then begin
    Inc(FWorking);
    for i := 0 to High(FMonitors) do begin
      ChangeToNext(i);
    end;
    Dec(FWorking);
  end else begin
    Inc(FWorking);
    FMonitors[AMonitorIndex].Filename := FPlaylists[0].GetPreviousFile();
    if Assigned(FOnWallpaperSection) then
      FOnWallpaperSection(Self, AMonitorIndex, FMonitors[AMonitorIndex].Filename);
    Dec(FWorking);
  end;
  if FWorking = 0 then begin
    SetWallpapers;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }

procedure TWallpaperChanger.SetWallpapers;
const
  MaxTries: integer = 10;
var
  FirstAttempt: boolean;
  Background: TFreeBitmap;
  Wallpaper: TFreeBitmap;
  FileName: WideString;
  MonitorIndex: Integer;
  Area: TRect;
  isOK: boolean;
  Counter: byte;
begin
  // TODO: check error value of ALL FreeImage operations, and see if we can extract the latest error

  Inc(FWorking);

  // Optimization: if only one picture on one monitor, then skip background picture
  // and position rescaled file directly using SetWallpaper's X and Y params
  Background := nil;
  try
    if Screen.MonitorCount = 1 then begin
      if FMonitors[Screen.PrimaryMonitor.MonitorNum].WorkAreaOnly then begin
        Area := Screen.PrimaryMonitor.WorkareaRect;
      end else begin
        Area := Screen.PrimaryMonitor.BoundsRect;
      end;

      // try for a maximum of n times
      isOK := false;
      FirstAttempt := True;
      Counter := 0;
      repeat
        try
          try
            if FirstAttempt then begin
              FileName := Playlist[0].CurrentFile;
              FirstAttempt := False;
            end else begin
              FileName := Playlist[0].GetNextFile();
            end;

            Wallpaper := GetRescaledImage(FileName, Area);
            isOK := true;
          except
            on E: Exception do begin
              OutputDebugString(PAnsiChar(Format('%s with %s', [E.Message, FileName])));
              isOK := false;
            end;
          end;
        finally
          Inc(Counter);
        end;
      until isOK or (Counter >= MaxTries);

      if isOK then begin
        FConfig.WriteInteger('Playlist', 'CurrentIndex', FPlaylists[0].CurrentIndex);
        FConfig.WriteString('Playlist', 'CurrentFile', FMonitors[Screen.PrimaryMonitor.MonitorNum].Filename);
        if Wallpaper.Save(FOutputFileName) then begin
          SetWallpaper(FOutputFileName, wpsPosition,
                       Round(((Area.Left + Area.Right) / 2) - (Wallpaper.GetWidth / 2)),
                       Round(((Area.Top + Area.Bottom) / 2) - (Wallpaper.GetHeight / 2)));
          OutputDebugString(PAnsiChar(Format('monitor[%d]: %s', [Screen.PrimaryMonitor.MonitorNum, FileName])));
          if Assigned(FOnWallpaperSet) then
            FOnWallpaperSet(Self, Filename);
        end else begin
          OutputDebugString(PAnsiChar(Format('monitor[%d]: Failed to write to file "%s".', [Screen.PrimaryMonitor.MonitorNum, FOutputFileName])));
        end;
      end else begin
        OutputDebugString(PAnsiChar(Format('monitor[%d]: failed to set wallpaper within %d tries.', [Screen.PrimaryMonitor.MonitorNum, MaxTries])));
      end;

    end else begin
      // There's more than one monitor:
      // Create a wallpaper which spans full extent of desktop (including all monitors)

      // TODO: Optimization: check minimum size used on desktop
      // TODO: create wallpaper in system's desktop background color
      Background := TFreeBitmap.Create(FIT_BITMAP, Screen.DesktopWidth, Screen.DesktopHeight, 24);
      // Paste a random wallpaper image into each monitor's work area
      for MonitorIndex := 0 to Screen.MonitorCount - 1 do begin
        Area := Screen.Monitors[MonitorIndex].WorkareaRect;

        // try for a maximum of n times for each monitor
        // TODO: make this a setting, it's now hard-coded to MaxTries
        isOK := false;
        FirstAttempt := True;
        Counter := 0;
        repeat
          // get a random wallpaper image for each monitor
          try
            if FirstAttempt then begin
              FileName := Playlist[0].CurrentFile;
              FirstAttempt := False;
            end else begin
              FileName := Playlist[0].GetNextFile();
            end;

            Wallpaper := GetRescaledImage(FileName, Area);
            try
              // Paste it onto the wallpaper
              if Background.PasteSubImage(Wallpaper, Round(((Area.Left + Area.Right) / 2) - (Wallpaper.GetWidth / 2)),
                                       Round(((Area.Top + Area.Bottom) / 2) - (Wallpaper.GetHeight / 2))) then begin
                isOK := true;
              end else begin
                {$IFDEF DEBUG}
                Wallpaper.Save(Format('F:\Temp\Wallpaper-monitor%d-attempt_%d.bmp', [MonitorIndex, Counter + 1])); // TEMP
                {$ENDIF}
                raise Exception.CreateFmt('Failed to paste image for monitor %d onto wallpaper', [MonitorIndex]);
              end;
            finally
              FreeAndNil(Wallpaper);
            end;
          except
            on E: Exception do begin
              OutputDebugString(PAnsiChar(Format('%s with %s', [E.Message, FileName])));
              isOK := false;
            end;
          end;

          // Keep track of the number of tries
          Counter := Counter + 1;
        until (isOK or (Counter >= MaxTries));

        if isOK then begin
          FConfig.WriteInteger('Playlist', 'CurrentIndex', FPlaylists[0].CurrentIndex);
          FConfig.WriteString('Playlist', 'CurrentFile', FMonitors[MonitorIndex].Filename);
          OutputDebugString(PAnsiChar(Format('monitor[%d]: %s', [MonitorIndex, FileName])));
        end else begin
          OutputDebugString(PAnsiChar(Format('monitor[%d]: failed to set wallpaper within %d tries.', [MonitorIndex, MaxTries])));
        end;
      end;{MonitorIndex}

      if Background.Save(FOutputFileName) then begin
        SetWallpaper(FOutputFileName, wpsPositionedTile, Screen.DesktopLeft, Screen.DesktopTop);
        if Assigned(FOnWallpaperSet) then
          FOnWallpaperSet(Self, FOutputFileName);
      end else begin
        OutputDebugString(PAnsiChar(Format('Failed to write to file "%s".', [FOutputFileName])));
      end;

    end;
  finally
    if Assigned(Background) then begin
      FreeAndNil(Background);
    end;
    Dec(FWorking);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }

function TWallpaperChanger.GetRescaledImage(AFilename: WideString;
                                            AWorkArea: TRect): TFreeBitmap;
var
  isOK: boolean;
begin
  isOK := false;
  Result := TFreeBitmap.Create();
  try
    // Resize the image and paste it onto the wallpaper
    if result.LoadU(AFileName) = false then begin
      raise Exception.CreateFmt('Failed to load file "%s"', [AFileName]);
    end else begin
      // (freeimage v3.90 can't paste an image with higher bit depth)
      if result.GetBitsPerPixel > 24 then
        result.ConvertTo24Bits;

      if Rescale(result, AWorkArea.Right - AWorkArea.Left, AWorkArea.Bottom - AWorkArea.Top) = false then begin
        raise Exception.Create('Failed to rescale image');
      end else begin
        isOK := true;
      end;
    end;
  finally
    if isOK = false then
      FreeAndNil(result);
  end;
end{GetRescaledImage};

{ ------------------------------------------------------------------------------------------------ }

procedure TWallpaperChanger.PlaylistChangeIndex(ASender: TObject; APreviousIndex: integer);
begin
  if Assigned(FOnWallpaperSection) then
    FOnWallpaperSection(Self, TPlaylist(ASender).CurrentIndex, TPlaylist(ASender).CurrentFile);
  if FWorking = 0 then
    SetWallpapers;
end;

{ ------------------------------------------------------------------------------------------------ }

class function TWallpaperChanger.Rescale(APicture: TFreeBitmap;
                                         AMaxWidth, AMaxHeight: integer;
                                         AStretch: boolean): boolean;
const
  MinWidthPercentage: single = 2 / 3;
  MinHeightPercentage: single = 2 / 3;
var
  OrgWidth, OrgHeight: integer;
  OrgRatio, TargetRatio: double;
begin
  OrgWidth := APicture.GetWidth;
  OrgHeight := APicture.GetHeight;

  // Only resize image if bigger than target, or more than 75% of the target's size
  if (OrgWidth > AMaxWidth) or (OrgHeight > AMaxHeight) or (OrgWidth / AMaxWidth >= MinWidthPercentage) or (OrgHeight / AMaxHeight >= MinHeightPercentage) then begin
    OrgRatio := OrgWidth / OrgHeight;
    TargetRatio := AMaxWidth / AMaxHeight;

    if AStretch or (Abs(TargetRatio - OrgRatio) < 1e-10) then begin
      // just use the target size
    end else if OrgRatio > TargetRatio then begin
      // adjust the height to maintain the aspect ratio
      AMaxHeight := Round(AMaxWidth / OrgRatio);
    end else begin
      // adjust the width to maintain the aspect ratio
      AMaxWidth := Round(AMaxHeight * OrgRatio);
    end;
    Result := APicture.Rescale(AMaxWidth, AMaxHeight, FILTER_LANCZOS3);
  end else begin
    Result := True;
  end;
end{Rescale};

{ ------------------------------------------------------------------------------------------------ }

class function TWallpaperChanger.GetWallpaper(out AStyle: TWallpaperStyleEnum;
                                              out AXPosition, AYPosition: Integer): WideString;
var
  Tile, Style: String;
  Reg: TRegistry;
begin
  // read the values from registry
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.Openkey('\Control Panel\Desktop', True);
    Result := Reg.ReadString('Wallpaper');
    Tile := Reg.ReadString('TileWallpaper');
    Style := Reg.ReadString('WallpaperStyle');

    if Tile = '1' then begin
      AStyle := wpsTile;
      AXPosition := Low(AXPosition);
      AYPosition := Low(AYPosition);
    end else if Reg.ValueExists('WallpaperOriginX')
                and Reg.ValueExists('WallpaperOriginY')
                and TryStrToInt(Reg.ReadString('WallpaperOriginX'), AXPosition)
                and TryStrToInt(Reg.ReadString('WallpaperOriginY'), AYPosition)
                then begin
      AStyle := wpsPosition;
    end else begin
      AStyle := TWallpaperStyleEnum(StrToInt(Style));
      AXPosition := Low(AXPosition);
      AYPosition := Low(AYPosition);
    end;
  finally
    Reg.Free;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }

class function TWallpaperChanger.GetCurrentWallpaper: WideString;
var
  Style: TWallpaperStyleEnum;
  X, Y: integer;
begin
  Result := GetWallpaper(Style, X, Y);
end;

{ ------------------------------------------------------------------------------------------------ }

class procedure TWallpaperChanger.SetCurrentWallpaper(const AFilename: WideString);
begin
  SetWallpaper(AFilename);
end;

{ ------------------------------------------------------------------------------------------------ }

class procedure TWallpaperChanger.SetWallpaper(AFilename: WideString;
                                               AStyle: TWallpaperStyleEnum;
                                               AXPosition, AYPosition: Integer);
var
  Tile, Style: String;
  Reg: TRegistry;
begin
  If AStyle in [wpsTile, wpsPositionedTile] then Tile := '1' else Tile := '0';
  if AStyle = wpsPosition then Style := '0' else Style := IntToStr(Ord(AStyle));

  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.Openkey('\Control Panel\Desktop', True);
    Reg.WriteString('Wallpaper', AFilename);
    Reg.WriteString('TileWallpaper', Tile);
    Reg.WriteString('WallpaperStyle', Style);
    if AStyle = wpsPosition then begin
      Reg.WriteString('WallpaperOriginX', IntToStr(AXPosition));
      Reg.WriteString('WallpaperOriginY', IntToStr(AYPosition));
    end else begin
      Reg.DeleteValue('WallpaperOriginX');
      Reg.DeleteValue('WallpaperOriginY');
    end;
  finally
    Reg.Free;
  end;

  if SystemParametersInfoW(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDCHANGE or SPIF_UPDATEINIFILE) = false then
    RaiseLastOSError;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////

initialization
  FWPC := nil;

finalization
  if Assigned(FWPC) then begin
    FreeAndNil(FWPC);
  end;

end.

Added src/WallpaperCycler.bdsproj.















































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
	<PersonalityInfo>
		<Option>
			<Option Name="Personality">Delphi.Personality</Option>
			<Option Name="ProjectType"></Option>
			<Option Name="Version">1.0</Option>
			<Option Name="GUID">{FF42CFF2-F963-4510-B0AC-A023BFBBCEA3}</Option>
		</Option>
	</PersonalityInfo>
	<Delphi.Personality>
		<Source>
			<Source Name="MainSource">WallpaperCycler.dpr</Source>
		</Source>
		<FileVersion>
			<FileVersion Name="Version">7.0</FileVersion>
		</FileVersion>
		<Compiler>
			<Compiler Name="A">8</Compiler>
			<Compiler Name="B">0</Compiler>
			<Compiler Name="C">1</Compiler>
			<Compiler Name="D">1</Compiler>
			<Compiler Name="E">0</Compiler>
			<Compiler Name="F">0</Compiler>
			<Compiler Name="G">1</Compiler>
			<Compiler Name="H">1</Compiler>
			<Compiler Name="I">1</Compiler>
			<Compiler Name="J">0</Compiler>
			<Compiler Name="K">0</Compiler>
			<Compiler Name="L">1</Compiler>
			<Compiler Name="M">0</Compiler>
			<Compiler Name="N">1</Compiler>
			<Compiler Name="O">0</Compiler>
			<Compiler Name="P">1</Compiler>
			<Compiler Name="Q">1</Compiler>
			<Compiler Name="R">1</Compiler>
			<Compiler Name="S">0</Compiler>
			<Compiler Name="T">0</Compiler>
			<Compiler Name="U">0</Compiler>
			<Compiler Name="V">1</Compiler>
			<Compiler Name="W">0</Compiler>
			<Compiler Name="X">1</Compiler>
			<Compiler Name="Y">2</Compiler>
			<Compiler Name="Z">1</Compiler>
			<Compiler Name="ShowHints">True</Compiler>
			<Compiler Name="ShowWarnings">True</Compiler>
			<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
			<Compiler Name="NamespacePrefix"></Compiler>
			<Compiler Name="GenerateDocumentation">False</Compiler>
			<Compiler Name="DefaultNamespace"></Compiler>
			<Compiler Name="SymbolDeprecated">True</Compiler>
			<Compiler Name="SymbolLibrary">True</Compiler>
			<Compiler Name="SymbolPlatform">True</Compiler>
			<Compiler Name="SymbolExperimental">True</Compiler>
			<Compiler Name="UnitLibrary">True</Compiler>
			<Compiler Name="UnitPlatform">True</Compiler>
			<Compiler Name="UnitDeprecated">True</Compiler>
			<Compiler Name="UnitExperimental">True</Compiler>
			<Compiler Name="HResultCompat">True</Compiler>
			<Compiler Name="HidingMember">True</Compiler>
			<Compiler Name="HiddenVirtual">True</Compiler>
			<Compiler Name="Garbage">True</Compiler>
			<Compiler Name="BoundsError">True</Compiler>
			<Compiler Name="ZeroNilCompat">True</Compiler>
			<Compiler Name="StringConstTruncated">True</Compiler>
			<Compiler Name="ForLoopVarVarPar">True</Compiler>
			<Compiler Name="TypedConstVarPar">True</Compiler>
			<Compiler Name="AsgToTypedConst">True</Compiler>
			<Compiler Name="CaseLabelRange">True</Compiler>
			<Compiler Name="ForVariable">True</Compiler>
			<Compiler Name="ConstructingAbstract">True</Compiler>
			<Compiler Name="ComparisonFalse">True</Compiler>
			<Compiler Name="ComparisonTrue">True</Compiler>
			<Compiler Name="ComparingSignedUnsigned">True</Compiler>
			<Compiler Name="CombiningSignedUnsigned">True</Compiler>
			<Compiler Name="UnsupportedConstruct">True</Compiler>
			<Compiler Name="FileOpen">True</Compiler>
			<Compiler Name="FileOpenUnitSrc">True</Compiler>
			<Compiler Name="BadGlobalSymbol">True</Compiler>
			<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
			<Compiler Name="InvalidDirective">True</Compiler>
			<Compiler Name="PackageNoLink">True</Compiler>
			<Compiler Name="PackageThreadVar">True</Compiler>
			<Compiler Name="ImplicitImport">True</Compiler>
			<Compiler Name="HPPEMITIgnored">True</Compiler>
			<Compiler Name="NoRetVal">True</Compiler>
			<Compiler Name="UseBeforeDef">True</Compiler>
			<Compiler Name="ForLoopVarUndef">True</Compiler>
			<Compiler Name="UnitNameMismatch">True</Compiler>
			<Compiler Name="NoCFGFileFound">True</Compiler>
			<Compiler Name="ImplicitVariants">True</Compiler>
			<Compiler Name="UnicodeToLocale">True</Compiler>
			<Compiler Name="LocaleToUnicode">True</Compiler>
			<Compiler Name="ImagebaseMultiple">True</Compiler>
			<Compiler Name="SuspiciousTypecast">True</Compiler>
			<Compiler Name="PrivatePropAccessor">True</Compiler>
			<Compiler Name="UnsafeType">False</Compiler>
			<Compiler Name="UnsafeCode">False</Compiler>
			<Compiler Name="UnsafeCast">False</Compiler>
			<Compiler Name="OptionTruncated">True</Compiler>
			<Compiler Name="WideCharReduced">True</Compiler>
			<Compiler Name="DuplicatesIgnored">True</Compiler>
			<Compiler Name="UnitInitSeq">True</Compiler>
			<Compiler Name="LocalPInvoke">True</Compiler>
			<Compiler Name="MessageDirective">True</Compiler>
			<Compiler Name="CodePage"></Compiler>
		</Compiler>
		<Linker>
			<Linker Name="MapFile">0</Linker>
			<Linker Name="OutputObjs">0</Linker>
			<Linker Name="GenerateHpps">False</Linker>
			<Linker Name="ConsoleApp">1</Linker>
			<Linker Name="DebugInfo">False</Linker>
			<Linker Name="RemoteSymbols">False</Linker>
			<Linker Name="GenerateDRC">False</Linker>
			<Linker Name="MinStackSize">16384</Linker>
			<Linker Name="MaxStackSize">1048576</Linker>
			<Linker Name="ImageBase">4194304</Linker>
			<Linker Name="ExeDescription"></Linker>
		</Linker>
		<Directories>
			<Directories Name="OutputDir">F:\MM\Code\Projects\Voronwe\GUI\Applications\WPCycler\out</Directories>
			<Directories Name="UnitOutputDir">F:\MM\Code\Projects\Voronwe\GUI\Applications\WPCycler\out\dcu</Directories>
			<Directories Name="PackageDLLOutputDir"></Directories>
			<Directories Name="PackageDCPOutputDir"></Directories>
			<Directories Name="SearchPath">..\Src;..\..\..\..\..\External\Libraries\FreeImage\Wrapper\Delphi\src</Directories>
			<Directories Name="Packages">vcl;rtl;vclx;dbrtl;vcldb;adortl;dbxcds;dbexpress;xmlrtl;vclactnband;inet;IntrawebDB_80_100;Intraweb_80_100;vclie;inetdbbde;inetdbxpress;IndyCore;IndySystem;dclOfficeXP;VclSmp;soaprtl;dsnap;IndyProtocols;bdertl;teeui;teedb;tee;vcldbx;dsnapcon;websnap;webdsnap;TntUnicodeVcl;vclshlctrls</Directories>
			<Directories Name="Conditionals">DEBUG</Directories>
			<Directories Name="DebugSourceDirs"></Directories>
			<Directories Name="UsePackages">False</Directories>
		</Directories>
		<Parameters>
			<Parameters Name="RunParams"></Parameters>
			<Parameters Name="HostApplication"></Parameters>
			<Parameters Name="Launcher"></Parameters>
			<Parameters Name="UseLauncher">False</Parameters>
			<Parameters Name="DebugCWD"></Parameters>
			<Parameters Name="Debug Symbols Search Path"></Parameters>
			<Parameters Name="LoadAllSymbols">True</Parameters>
			<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
		</Parameters>
		<Language>
			<Language Name="ActiveLang"></Language>
			<Language Name="ProjectLang">$00000000</Language>
			<Language Name="RootDir"></Language>
		</Language>
		<VersionInfo>
			<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
			<VersionInfo Name="AutoIncBuild">True</VersionInfo>
			<VersionInfo Name="MajorVer">0</VersionInfo>
			<VersionInfo Name="MinorVer">0</VersionInfo>
			<VersionInfo Name="Release">1</VersionInfo>
			<VersionInfo Name="Build">147</VersionInfo>
			<VersionInfo Name="Debug">True</VersionInfo>
			<VersionInfo Name="PreRelease">True</VersionInfo>
			<VersionInfo Name="Special">False</VersionInfo>
			<VersionInfo Name="Private">False</VersionInfo>
			<VersionInfo Name="DLL">False</VersionInfo>
			<VersionInfo Name="Locale">1043</VersionInfo>
			<VersionInfo Name="CodePage">1252</VersionInfo>
		</VersionInfo>
		<VersionInfoKeys>
			<VersionInfoKeys Name="CompanyName">Voronwë</VersionInfoKeys>
			<VersionInfoKeys Name="FileDescription">Wallpaper Cycler application</VersionInfoKeys>
			<VersionInfoKeys Name="FileVersion">0.0.1.147</VersionInfoKeys>
			<VersionInfoKeys Name="InternalName">WallpaperCycler</VersionInfoKeys>
			<VersionInfoKeys Name="LegalCopyright">© Martijn Coppoolse</VersionInfoKeys>
			<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
			<VersionInfoKeys Name="OriginalFilename">ChangeWallpaper.exe</VersionInfoKeys>
			<VersionInfoKeys Name="ProductName">Wallpaper Cycler</VersionInfoKeys>
			<VersionInfoKeys Name="ProductVersion">0.1.0.0</VersionInfoKeys>
			<VersionInfoKeys Name="Comments"></VersionInfoKeys>
		</VersionInfoKeys>  
    
    
    
    <Excluded_Packages>
      <Excluded_Packages Name="C:\Program Files\Prog\Borland\BDS\4.0\Bin\vclshlctrls100.bpl">Win32 Shell Controls</Excluded_Packages>
    </Excluded_Packages>
  </Delphi.Personality>
	<StarTeamAssociation></StarTeamAssociation>
	<StarTeamNonRelativeFiles></StarTeamNonRelativeFiles>
</BorlandProject>

Added src/WallpaperCycler.cfg.



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O-
-$P+
-$Q+
-$R+
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$Y+
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E"F:\MM\Code\Projects\Voronwe\GUI\Applications\WPCycler\out"
-N0"F:\MM\Code\Projects\Voronwe\GUI\Applications\WPCycler\out\dcu"
-LE"C:\Program Files\Prog\Borland\BDS\4.0\Bin"
-LN"F:\MM\Code\Projects\Borland\Bpl"
-U"..\Src;..\..\..\..\..\External\Libraries\FreeImage\Wrapper\Delphi\src"
-O"..\Src;..\..\..\..\..\External\Libraries\FreeImage\Wrapper\Delphi\src"
-I"..\Src;..\..\..\..\..\External\Libraries\FreeImage\Wrapper\Delphi\src"
-R"..\Src;..\..\..\..\..\External\Libraries\FreeImage\Wrapper\Delphi\src"
-DDEBUG
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

Added src/WallpaperCycler.dpr.































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
program WallpaperCycler;

(*

  TODO:
  - Bouw voorziening voor meerdere TAreas; vooralsnog 1 TArea per monitor of workarea
  - Maak TPlaylistWalker om door playlist te lopen, zodat later elke area z'n playlist kan hebben
  - Zet timer aan voor automatisch bijwerken van achtergrond
  - Lees TPlaylist in, en update 'm op basis van de mappen op schijf
  - Maak TPlaylist serializable, zodat-ie makkelijk van schijf gelezen kan worden
  - Maak TWallpaperCycler class, die de huidige status bijhoudt, events afvuurt e.d.
  - Maak nieuwe form speciaal voor tray icon, zodat niet heel frmSettings continu geladen hoeft te zijn
  - Maak TAppSettings class aan die .ini-bestand uitleest
  - Maak mogelijkheid voor willekeurige interval (tussen ... en ... uren/minuten/dagen)
  - Maak frmSettings.lvwPlaylist.OwnerData := True voor betere performance

*)

uses
  Forms,
  PlaylistUnit in 'PlaylistUnit.pas',
  FreeBitmap,
  FreeImage,
  FreeUtils,
  L_GetLongPath,
  L_GetFileList,
  WallpaperChangerUnit in 'WallpaperChangerUnit.pas',
  FormSettings in 'FormSettings.pas' {frmSettings},
  L_ShellFolders,
  CheckPrevious;

{$R *.res}

begin
  Randomize;

  if not CheckPrevious.RestoreIfRunning(Application.Handle) then begin
    Application.Initialize;
    Application.Title := 'Wallpaper Cycler';
    Application.Name := 'WallpaperCycler';
    Application.ShowMainForm := False;

    Application.CreateForm(TfrmSettings, frmSettings);
    Application.Run;
  end;
end.

Added src/u_ChangeWallpaper.pas.

























































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
unit u_ChangeWallpaper;

(* TODO:

  For now:
  - Save and recall settings
  - Remember the current wallpapers, and check those on startup (unless 'change on startup' is checked)
  - Set up timer for automatic changing of wallpaper(s)
  - Provide opportunity to change only one specific monitor to a specific playlist entry
    (and make it work for multimon setup as well!)
  - Create singleton TWallpaperChanger object with properties & methods to set and retrieve current
    wallpaper info

  Much later:
  - Provide opportunity to change a specific monitor to an image not in the playlist?
*)

interface
  uses
    Forms, Windows, Classes,
    TntComCtrls,
    FreeBitmap;

  type TWallpaperStyle = (wpsTile = 0, wpsCenter = 1, wpsStretch = 2, wpsPosition = 3);

  procedure InitFileList(const ALocations: TStrings; AIndex: integer);
  procedure ChangeWallpapers();
  procedure ChangeWallpaper(AMonitor: integer; APlaylistIndex: integer);
  function GetRescaledImage(AWorkArea: TRect; var AFilename: WideString): TFreeBitmap;
  procedure WriteToLog(const AText: WideString);

  function Rescale(APicture: TFreeBitmap; AWidth, AHeight: integer; AStretch: boolean = false): boolean;
  procedure SetWallpaper(AFilename: WideString;
                         AStyle: TWallpaperStyle = wpsCenter;
                         AXPosition: Integer = 0;
                         AYPosition: Integer = 0);
  function GetLocalAppDataPath(): string;

implementation
  uses
    SysUtils,
    ShFolder, Registry, IniFiles,
    FreeImage, FreeUtils, PlaylistUnit, FormSettings,
    L_GetFileList, WideStrings;

  var
    Log: TFileStream;
    WorkPath: string;
    LogFilename: string;
    OutputFilename: string;
    FileMode: WORD;
    Playlist: TPlaylist;

////////////////////////////////////////////////////////////////////////////////////////////////////
  procedure PlaylistChangeIndex(ASender: TObject; APreviousIndex: integer);
  var
    Config: TIniFile;
  begin
    frmSettings.miTrayFileName.Caption := Playlist.CurrentFile;
    With frmSettings.lvwPlaylist do begin
      ItemIndex := Playlist.CurrentIndex;
      ItemFocused := frmSettings.lvwPlaylist.Items[ItemIndex];
      ItemFocused.MakeVisible(True);
    end;

    Config := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));
    try
      Config.WriteInteger('Playlist', 'CurrentIndex', Playlist.CurrentIndex);
      Config.WriteString('Playlist', 'CurrentFile', Playlist.CurrentFile);
      Config.WriteString('Playlist', 'Location', Playlist.DefaultPath);
    finally
      FreeAndNil(Config);
    end;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////
  procedure InitFileList(const ALocations: TStrings; AIndex: integer);
  var
    i: Integer;
    Inclusion: TPathInclusion;
  begin
    Playlist := TPlaylist.Create;
//    Playlist.OnAddFile := PlaylistAddFile;
    if FileExists(Playlist.DefaultPath) then begin
      Playlist.Load();
//      Playlist.Refresh();
    end else begin
      for i := 0 to ALocations.Count - 1 do begin
        if ALocations.ValueFromIndex[i] = '*\*' then
          Inclusion := piIncludeRecursive
        else if ALocations.ValueFromIndex[i] = '*' then
          Inclusion := piInclude
        else if ALocations.ValueFromIndex[i] = '' then
          Inclusion := piExcludeRecursive
        else if ALocations.ValueFromIndex[i] = '\*' then
          Inclusion := piExclude
        else
          Inclusion := piIncludeRecursive;

        Playlist.Definitions.Add(ALocations.Names[i], Inclusion);
      end;
//      Playlist.Definitions.Add('F:\MM\Image');
//      Playlist.Definitions.Add('F:\MM\Image\Icons', piExcludeRecursive);
//      Playlist.Definitions.Add('F:\MM\Image\Sites', piExcludeRecursive);
//      Playlist.Definitions.Add('F:\MM\Image\Work', piExcludeRecursive);
//      Playlist.Definitions.Add('F:\MM\Image\Work\Projects\Arjen\', piIncludeRecursive);
//      Playlist.Definitions.Add('F:\MM\Image\Zoom', piExcludeRecursive);
//      Playlist.Save();
      Playlist.Refresh(False); // *** Careful! Can be very disk- and time-intensive! ***
      Playlist.Shuffle();
      Playlist.Save();
    end;
    for i := 0 to Playlist.Count - 1 do begin
      frmSettings.lvwPlaylist.AddItem(Playlist.Files[i], TObject(i));
    end;
    frmSettings.lvwPlaylist.Column[0].Width := -1;
    Playlist.OnChangeIndex := PlaylistChangeIndex;
    Playlist.CurrentIndex := AIndex;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////
  procedure ChangeWallpaper(AMonitor: integer; APlaylistIndex: integer);
  var
    Area: TRect;
    Filename: WideString;
    Wallpaper: TFreeBitmap;
    isOK: boolean;
  begin
    Wallpaper := nil;
    Area := Screen.Monitors[AMonitor].WorkareaRect;
    Filename := Playlist.Files[APlaylistIndex];
    try
      Wallpaper := GetRescaledImage(Area, FileName);
      isOK := true;
    except
      on E: Exception do begin
        WriteToLog(E.Message + ' with ' + FileName);
        isOK := false;
      end;
    end;

    if isOK then begin
      if Wallpaper.Save(OutputFilename) then begin
        SetWallpaper(OutputFilename, wpsPosition,
                     Round(((Area.Left + Area.Right) / 2) - (Wallpaper.GetWidth / 2)),
                     Round(((Area.Top + Area.Bottom) / 2) - (Wallpaper.GetHeight / 2)));
        WriteToLog('monitor[' + IntToStr(Screen.PrimaryMonitor.MonitorNum) + ']: ' + FileName);
        frmSettings.miTrayFileName.Caption := Filename;
      end else begin
        WriteToLog('monitor[' + IntToStr(Screen.PrimaryMonitor.MonitorNum) + ']: Failed to write to file ' + OutputFilename);
      end;
    end else begin
      WriteToLog('monitor[' + IntToStr(Screen.PrimaryMonitor.MonitorNum) + ']: failed to set wallpaper within 10 tries.');
    end;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////
  procedure ChangeWallpapers();
  var
//    i: Integer;
    Background: TFreeBitmap;
    Wallpaper: TFreeBitmap;
    FileName: WideString;
    MonitorIndex: Integer;
    Area: TRect;
    isOK: boolean;
    Counter: byte;
  begin
    // TODO: check error value of ALL FreeImage operations, and see if we can extract the latest error

    // uncheck all previously checked files; TODO: have this done using TPlaylist
//    for i := 0 to frmSettings.lvwPlaylist.Items.Count - 1 do begin
//      frmSettings.lvwPlaylist.Items[i].Checked := False;
//    end;

    // Optimization: if only one picture on one monitor, then skip background picture
    // and position rescaled file directly using SetWallpaper's X and Y params
    Background := nil;
    try
      if Screen.MonitorCount = 1 then begin
        Area := Screen.PrimaryMonitor.WorkareaRect;

        // try for a maximum of n times
        isOK := false;
        Counter := 0;
        repeat
          try
            FileName := '';
            Wallpaper := GetRescaledImage(Area, FileName);
            isOK := true;
          except
            on E: Exception do begin
              WriteToLog(E.Message + ' with ' + FileName);
              isOK := false;
            end;
          end;
        until isOK or (Counter >= 10);

        if isOK then begin
          if Wallpaper.Save(OutputFilename) then begin
            SetWallpaper(OutputFilename, wpsPosition,
                         Round(((Area.Left + Area.Right) / 2) - (Wallpaper.GetWidth / 2)),
                         Round(((Area.Top + Area.Bottom) / 2) - (Wallpaper.GetHeight / 2)));
            WriteToLog('monitor[' + IntToStr(Screen.PrimaryMonitor.MonitorNum) + ']: ' + FileName);
            frmSettings.miTrayFileName.Caption := Filename;
          end else begin
            WriteToLog('monitor[' + IntToStr(Screen.PrimaryMonitor.MonitorNum) + ']: Failed to write to file ' + OutputFilename);
          end;
        end else begin
          WriteToLog('monitor[' + IntToStr(Screen.PrimaryMonitor.MonitorNum) + ']: failed to set wallpaper within 10 tries.');
        end;

      end else begin

        // There's more than one monitor:
        // TODO: Optimization: check minimum size of used desktop

        // Create a wallpaper which spans full extent of desktop (including all monitors)
        // TODO: create wallpaper in system's desktop background color
        Background := TFreeBitmap.Create(FIT_BITMAP, Screen.DesktopWidth, Screen.DesktopHeight, 24);
        // Paste a random wallpaper image into each monitor's work area
        for MonitorIndex := 0 to Screen.MonitorCount - 1 do begin
          Area := Screen.Monitors[MonitorIndex].WorkareaRect;

          // try for a maximum of n times for each monitor
          // TODO: make this a setting, it's now hard-coded to 10
          isOK := false;
          Counter := 0;
          repeat
            // get a random wallpaper image for each monitor
            try
              FileName := '';
              Wallpaper := GetRescaledImage(Area, FileName);
              try
                // Paste it onto the wallpaper
                if Background.PasteSubImage(Wallpaper, Round(((Area.Left + Area.Right) / 2) - (Wallpaper.GetWidth / 2)),
                                         Round(((Area.Top + Area.Bottom) / 2) - (Wallpaper.GetHeight / 2))) then begin
                  isOK := true;
                end else begin
                  {$IFDEF DEBUG}
                  Wallpaper.Save('F:\Temp\Wallpaper-monitor' + IntToStr(MonitorIndex) + '-attempt_' + IntToStr(Counter + 1) + '.bmp'); // TEMP
                  {$ENDIF}
                  raise Exception.Create('Failed to paste image onto wallpaper');
                end;
              finally
                FreeAndNil(Wallpaper);
              end;
            except
              on E: Exception do begin
                WriteToLog(E.Message + ' with ' + FileName);
                isOK := false;
              end;
            end;

            // Keep track of the number of tries
            Counter := Counter + 1;
          until (isOK or (Counter >= 10));

          if isOK then begin
            WriteToLog('monitor[' + IntToStr(MonitorIndex) + ']: ' + FileName);
          end else begin
            WriteToLog('monitor[' + IntToStr(MonitorIndex) + ']: failed to set wallpaper within 10 tries.');
          end;
        end;{MonitorIndex}

        if Background.Save(OutputFilename) then begin
          SetWallpaper(OutputFilename, wpsPosition, Screen.DesktopLeft, Screen.DesktopTop);
        end else begin
          WriteToLog('Failed to write to file "' + OutputFilename + '".');
        end;

      end;
    finally
      if Assigned(Background) then begin
        FreeAndNil(Background);
      end;
    end;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////
  function GetRescaledImage(AWorkArea: TRect; var AFilename: WideString): TFreeBitmap;
  var
    isOK: boolean;
  begin
    if AFilename = '' then begin
      AFilename := Playlist.GetNextFile;
      // TODO: select and check the current file in the listView
//      frmSettings.lvwPlaylist.Selected := frmSettings.lvwPlaylist.FindData(0, Playlist.CurrentIndex, True, False) as TTntListItem;
//      frmSettings.lvwPlaylist.Selected.Checked := True;
//      frmSettings.lvwPlaylist.Selected.MakeVisible(False);
    end;

    isOK := false;
    result := TFreeBitmap.Create();
    try
      // Resize the image and paste it onto the wallpaper
      if result.LoadU(AFileName) = false then begin
        raise Exception.Create('Failed to load file "' + AFileName + '"');
      end else begin
        // (we can't paste an image with higher bit depth)
        if result.GetBitsPerPixel > 24 then
          result.ConvertTo24Bits;

        if Rescale(result, AWorkArea.Right - AWorkArea.Left, AWorkArea.Bottom - AWorkArea.Top) = false then begin
          raise Exception.Create('Failed to rescale image');
        end else begin
          isOK := true;
        end;
      end;
    finally
      if isOK = false then
        FreeAndNil(result);
    end;
  end{GetRescaledImage};

////////////////////////////////////////////////////////////////////////////////////////////////////
  procedure WriteToLog(const AText: WideString);
  var
    LogText: WideString;
  begin
    LogText := DateTimeToStr(Now) + ': ' + AText + #13#10;
    Log.WriteBuffer(LogText[1], Length(LogText) * 2);
  end;


////////////////////////////////////////////////////////////////////////////////////////////////////
  function Rescale(APicture: TFreeBitmap; AWidth, AHeight: integer; AStretch: boolean = false): boolean;
  var
    OrgWidth, OrgHeight: integer;
    OrgRatio, TargetRatio: double;
  begin
    OrgWidth := APicture.GetWidth;
    OrgHeight := APicture.GetHeight;

    // Only resize image if bigger than target, or more than 75% of the target's size
    if (OrgWidth > AWidth) or (OrgHeight > AHeight) or (OrgWidth / AWidth >= 0.75) or (OrgHeight / AHeight >= 0.6666666666666) then begin
      OrgRatio := OrgWidth / OrgHeight;
      TargetRatio := AWidth / AHeight;

      if AStretch or (Abs(TargetRatio - OrgRatio) < 1e-10) then begin
        // just use the target size
      end else if OrgRatio > TargetRatio then begin
        // adjust the height to maintain the aspect ratio
        AHeight := Round(AWidth / OrgRatio);
      end else begin
        // adjust the width to maintain the aspect ratio
        AWidth :=Round(AHeight * OrgRatio);
      end;
      Result := APicture.Rescale(AWidth, AHeight, FILTER_LANCZOS3);
    end else begin
      Result := True;
    end;

  end;

////////////////////////////////////////////////////////////////////////////////////////////////////
  procedure SetWallpaper(AFilename: WideString;
                         AStyle: TWallpaperStyle = wpsCenter;
                         AXPosition: Integer = 0;
                         AYPosition: Integer = 0);
  var
    Tile, Style: String;
    Reg: TRegistry;
  begin
    If AStyle = wpsTile then Tile := '1' else Tile := '0';
    if AStyle = wpsPosition then Style := '0' else Style := IntToStr(Ord(AStyle));

    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      Reg.Openkey('\Control Panel\Desktop', True);
      Reg.WriteString('Wallpaper', AFilename);
      Reg.WriteString('TileWallpaper', Tile);
      Reg.WriteString('WallpaperStyle', Style);
      if AStyle = wpsPosition then begin
        Reg.WriteString('WallpaperOriginX', IntToStr(AXPosition));
        Reg.WriteString('WallpaperOriginY', IntToStr(AYPosition));
      end else begin
        Reg.DeleteValue('WallpaperOriginX');
        Reg.DeleteValue('WallpaperOriginY');
      end;
    finally
      Reg.free;
    end;

    if SystemParametersInfoW(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDCHANGE or SPIF_UPDATEINIFILE) = false then
      RaiseLastOSError;

  end;

////////////////////////////////////////////////////////////////////////////////////////////////////
  function GetLocalAppDataPath(): string;
  const
     SHGFP_TYPE_CURRENT = 0;
  var
     Path: array [0..MAX_PATH] of char;
     RetVal: HResult;
  begin
    RetVal := SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, @Path[0]);
    if RetVal = S_OK then begin
       result := path;
    end else begin
      result := '';
    end;
  end;

initialization
  WorkPath := ChangeFileExt(ChangeFilePath(Application.ExeName, GetLocalAppDataPath()), '');
  ForceDirectories(WorkPath);
  LogFilename := IncludeTrailingPathDelimiter(WorkPath) + ChangeFileExt(ExtractFileName(Application.ExeName), '.log');
  OutputFilename := IncludeTrailingPathDelimiter(WorkPath) + 'Wallpaper.bmp';

  if FileExists(LogFilename) then
    FileMode := fmOpenReadWrite
  else
    FileMode := fmCreate;

  Log := TFileStream.Create(LogFilename, FileMode, fmShareDenyWrite);
  if FileMode <> fmCreate then begin
    Log.Seek(Log.Size, soFromBeginning);
  end;

finalization
  if Assigned(Log) then
    FreeAndNil(Log);

end.

Added todo.txt.











































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
> On startup
	- Check if wallpaper needs to be replaced
		- if so: ChangeWallpaper()
	- Check if playlist needs to be updated
		- if so: PlayList.Update() in a background thread
	
* ChangeWallpaper:
	- Playlist.GetNextFile()
	- Open image;
		- (if bigger than desktop) resize to fit <desktop | working area>
		- (if specified) perform any additional adjustments (filters and such)
		- save as BMP in %temp% folder
	- Update registry key HKEY_CURRENT_USER\Control Panel\Desktop\WallPaper
	- Notify the system using SPI_SETDESKWALLPAPER
	
* Playlist.GetNextFile()
	- Increase playlist index
	- Check if file at new index exists; if not, increase index
	- (if the index exceeds the playlist count) reset index and Playlist.Update()
	- Return the file name at that index

* Playlist.Update()
	- Create an empty list (linked list?) to mirror current list, and a list for new files
	- Loop through specified locations, and add each matching file to the mirror list
	- If a file already exists in the current list, move it to that index in the new list
	- Afterwards, loop through new playlist; remove all empty slots, and add all new files
	! Make the filelist hierarchical (xml?), and group the files by folder (more efficient lookup)
	! Make the actual filelist point to the index[es] of the hierarchical filelist.
	
	"Folder"
		- file1
		- file2
		- ...
		- "Folder"
		- "Folder"
			- files
			- folders