Wallpaper Cycler
Check-in [736f8b1959]
Login
HomeTimelineBranchesTagsTicketsWiki

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

Overview
Comment:Double-clicking the main form cycles the wallpapers.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 736f8b195983c9df0d8477972d9fb436ed6e6b09
User & Date: tinus 2014-12-09 17:53:14
Context
2015-02-03
13:22
Report False when we couldn't read the image size from a valid JPG image. check-in: 979234fb70 user: tinus tags: trunk
2014-12-09
17:53
Double-clicking the main form cycles the wallpapers. check-in: 736f8b1959 user: tinus tags: trunk
17:52
GetJPGSize now returns False when it's not a JPG. check-in: 7293616336 user: tinus tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/F_Main.dfm. 

8
9
10
11
12
13
14

15
16
17
18
19
20
21

  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate

  OnResize = FormResize
  DesignSize = (
    561
    369)
  PixelsPerInch = 96
  TextHeight = 13
  object pnlDesktop: TPanel








>








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDblClick = FormDblClick
  OnResize = FormResize
  DesignSize = (
    561
    369)
  PixelsPerInch = 96
  TextHeight = 13
  object pnlDesktop: TPanel

Changes to src/F_Main.pas. 

14
15
16
17
18
19
20

21
22
23
24
25
26
27
..
31
32
33
34
35
36
37

38
39
40
41
42
43
44
..
54
55
56
57
58
59
60

61
62
63
64
65
66
67
..
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
...
108
109
110
111
112
113
114

115
116
117
118
119
120
121

    shpMonitor: TShape;
    procedure pbxDesktopPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure pbxDesktopClick(Sender: TObject);

  private
    { Private declarations }
    FMonitorShape: array of TShape;
  public
    { Public declarations }
  end;

................................................................................
implementation

uses
  U_WPImages;

{$R *.dfm}


procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
  SetLength(FMonitorShape, Screen.MonitorCount);
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    if Screen.Monitors[i].Primary then begin
................................................................................
    end;
  end;
  if Screen.MonitorCount = 1 then begin
    shpMonitor.Visible := False;
  end;
end;


procedure TfrmMain.FormResize(Sender: TObject);
var
  ScaleFactor: Double;
  DR, MR: TRect;
  function ScaleR(const R: TRect): TRect;
  begin
    Result.Left := Trunc((R.Left - DR.Left) * ScaleFactor);
................................................................................
    Result.Height := Trunc(R.Height * ScaleFactor);
  end;
var
  i: Integer;
  Mon: TMonitor;
begin
  DR := Screen.DesktopRect;
  ScaleFactor := pnlDesktop.ClientWidth / DR.Width;
  pnlDesktop.Height := Trunc(DR.Height * ScaleFactor);
  for i := 0 to Screen.MonitorCount - 1 do begin
    Mon := Screen.Monitors[i];
    MR := ScaleR(Mon.WorkareaRect);
    FMonitorShape[i].SetBounds(MR.Left + pbxDesktop.Left,
                               MR.Top + pbxDesktop.Top,
                               MR.Width,
                               MR.Height);
  end;
end;









procedure TfrmMain.pbxDesktopClick(Sender: TObject);
var
  i: Integer;
begin
  // TODO: select desktop in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    FMonitorShape[i].Pen.Style := psClear;
  end;
end;


procedure TfrmMain.pbxDesktopPaint(Sender: TObject);
var
  i: integer;
  MonImg: TWPImage;
begin
  pbxDesktop.Canvas.FillRect(pbxDesktop.BoundsRect);
  if Assigned(modMain.Desktop) then
................................................................................
    MonImg := modMain.Monitors[i];
    if Assigned(MonImg) then begin
      MonImg.Draw(pbxDesktop.Canvas, FMonitorShape[i].BoundsRect);
    end;
  end;
end;


procedure TfrmMain.shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  // TODO: select given monitor in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin








>







 







>







 







>







 







|
|










>
>
>
>
>
>
>
>










>







 







>








14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
..
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
..
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
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

    shpMonitor: TShape;
    procedure pbxDesktopPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure pbxDesktopClick(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
  private
    { Private declarations }
    FMonitorShape: array of TShape;
  public
    { Public declarations }
  end;

................................................................................
implementation

uses
  U_WPImages;

{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
  SetLength(FMonitorShape, Screen.MonitorCount);
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    if Screen.Monitors[i].Primary then begin
................................................................................
    end;
  end;
  if Screen.MonitorCount = 1 then begin
    shpMonitor.Visible := False;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormResize(Sender: TObject);
var
  ScaleFactor: Double;
  DR, MR: TRect;
  function ScaleR(const R: TRect): TRect;
  begin
    Result.Left := Trunc((R.Left - DR.Left) * ScaleFactor);
................................................................................
    Result.Height := Trunc(R.Height * ScaleFactor);
  end;
var
  i: Integer;
  Mon: TMonitor;
begin
  DR := Screen.DesktopRect;
  ScaleFactor := pbxDesktop.ClientWidth / DR.Width;
  pnlDesktop.Height := Trunc(DR.Height * ScaleFactor) + (pnlDesktop.Height - pbxDesktop.ClientHeight);
  for i := 0 to Screen.MonitorCount - 1 do begin
    Mon := Screen.Monitors[i];
    MR := ScaleR(Mon.WorkareaRect);
    FMonitorShape[i].SetBounds(MR.Left + pbxDesktop.Left,
                               MR.Top + pbxDesktop.Top,
                               MR.Width,
                               MR.Height);
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormDblClick(Sender: TObject);
begin
  modMain.CycleWallpaper;
  pnlDesktop.Invalidate;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.pbxDesktopClick(Sender: TObject);
var
  i: Integer;
begin
  // TODO: select desktop in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin
    FMonitorShape[i].Pen.Style := psClear;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.pbxDesktopPaint(Sender: TObject);
var
  i: integer;
  MonImg: TWPImage;
begin
  pbxDesktop.Canvas.FillRect(pbxDesktop.BoundsRect);
  if Assigned(modMain.Desktop) then
................................................................................
    MonImg := modMain.Monitors[i];
    if Assigned(MonImg) then begin
      MonImg.Draw(pbxDesktop.Canvas, FMonitorShape[i].BoundsRect);
    end;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.shpMonitorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  // TODO: select given monitor in list
  for i := Low(FMonitorShape) to High(FMonitorShape) do begin

Changes to src/M_Main.pas. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
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

unit M_Main;

interface

uses
  System.SysUtils, System.Classes, Vcl.Menus, Vcl.ExtCtrls, Vcl.StdActns,
  System.Actions, Vcl.ActnList,
  U_WPImages;

type
  TmodMain = class(TDataModule)
    trayIcon: TTrayIcon;
    pumTray: TPopupMenu;
    aclMain: TActionList;
................................................................................
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure actListShowExecute(Sender: TObject);
    procedure actListShowUpdate(Sender: TObject);
    procedure trayIconDblClick(Sender: TObject);
  private
    { Private declarations }



    FDesktop: TWPImage;
    FMonitors: TWPImages;
    procedure SetDesktop(const Value: TWPImage);
  public
    { Public declarations }


    property Desktop: TWPImage    read FDesktop write SetDesktop;
    property Monitors: TWPImages  read FMonitors;
  end;

var
  modMain: TmodMain;

implementation
uses
  System.IOUtils, System.Types,
  Vcl.Forms,
  F_Main;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}


procedure TmodMain.DataModuleCreate(Sender: TObject);
var
  i: Integer;
  Files: TStringDynArray;
begin
  FDesktop := nil; // TWPImage.Create('C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp');
  Files := TDirectory.GetFiles('C:\MC\MM\Image\Work\Background\single', '*.jpg', TSearchOption.soAllDirectories);









  FMonitors := TWPImages.Create;
  for i := 0 to Screen.MonitorCount - 1 do begin
    FMonitors.Add(TWPImage.Create(Files[Random(Length(Files))]));

  end;

  trayIcon.Hint := Application.Title;
  trayIcon.Icon.Assign(Application.Icon);
  trayIcon.Visible := True;


end;


procedure TmodMain.DataModuleDestroy(Sender: TObject);
begin
  trayIcon.Visible := False;
end;


procedure TmodMain.SetDesktop(const Value: TWPImage);
begin
  FDesktop := Value;
end;


procedure TmodMain.trayIconDblClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to trayIcon.PopupMenu.Items.Count - 1 do begin
    if trayIcon.PopupMenu.Items[i].Default and trayIcon.PopupMenu.Items[i].Enabled then begin
      trayIcon.PopupMenu.Items[i].Action.Execute;
      Break;
    end;
  end;
end {TmodMain.trayIconDblClick};


procedure TmodMain.actListShowExecute(Sender: TObject);
begin
  frmMain.Visible := not frmMain.Visible;
end;


procedure TmodMain.actListShowUpdate(Sender: TObject);
begin
  actListShow.Checked := frmMain.Visible;
end;











































































end.






|
|







 







>
>
>





>
>









|







>



<


|
>
>
>
>
>
>
>
>
>


<
>





>
>


>





>





>












>





>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
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

unit M_Main;

interface

uses
  System.SysUtils, System.Classes, System.Types,
  Vcl.Menus, Vcl.ExtCtrls, Vcl.StdActns, System.Actions, Vcl.ActnList,
  U_WPImages;

type
  TmodMain = class(TDataModule)
    trayIcon: TTrayIcon;
    pumTray: TPopupMenu;
    aclMain: TActionList;
................................................................................
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure actListShowExecute(Sender: TObject);
    procedure actListShowUpdate(Sender: TObject);
    procedure trayIconDblClick(Sender: TObject);
  private
    { Private declarations }
    FFiles: TStringDynArray;
    FFileIndex: Integer;

    FDesktop: TWPImage;
    FMonitors: TWPImages;
    procedure SetDesktop(const Value: TWPImage);
  public
    { Public declarations }
    procedure CycleWallpaper;

    property Desktop: TWPImage    read FDesktop write SetDesktop;
    property Monitors: TWPImages  read FMonitors;
  end;

var
  modMain: TmodMain;

implementation
uses
  System.IOUtils, Generics.Collections, Generics.Defaults,
  Vcl.Forms,
  F_Main;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.DataModuleCreate(Sender: TObject);
var
  i: Integer;

begin
  FDesktop := nil; // TWPImage.Create('C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp');
  FFiles := TDirectory.GetFiles('C:\MC\MM\Image\Work\Background\single', '*.jpg', TSearchOption.soAllDirectories);
  SetLength(FFiles, Length(FFiles) + 1);
  FFiles[Length(FFiles) - 1] := 'C:\MC\MM\Image\Work\Background\composite\Chateau_de_Lassay_2.bmp';

  // randomize FFiles
  TArray.Sort<string>(FFiles, TComparer<string>.Construct(function(const Left, Right: string): Integer
                                                          begin
                                                            Result := Random(2) - 1;
                                                          end));

  FMonitors := TWPImages.Create;
  for i := 0 to Screen.MonitorCount - 1 do begin

    FMonitors.Add(nil);
  end;

  trayIcon.Hint := Application.Title;
  trayIcon.Icon.Assign(Application.Icon);
  trayIcon.Visible := True;

  CycleWallpaper;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.DataModuleDestroy(Sender: TObject);
begin
  trayIcon.Visible := False;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.SetDesktop(const Value: TWPImage);
begin
  FDesktop := Value;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.trayIconDblClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to trayIcon.PopupMenu.Items.Count - 1 do begin
    if trayIcon.PopupMenu.Items[i].Default and trayIcon.PopupMenu.Items[i].Enabled then begin
      trayIcon.PopupMenu.Items[i].Action.Execute;
      Break;
    end;
  end;
end {TmodMain.trayIconDblClick};

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.actListShowExecute(Sender: TObject);
begin
  frmMain.Visible := not frmMain.Visible;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.actListShowUpdate(Sender: TObject);
begin
  actListShow.Checked := frmMain.Visible;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TmodMain.CycleWallpaper;
var
  FileIndex: Integer;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  function GetNextWP: TWPImage;
  var
    WPFile: TFileName;
  begin
    Inc(FileIndex);
    if FileIndex >= Length(FFiles) then begin
      FileIndex := 0;
      // randomize FFiles
      TArray.Sort<string>(FFiles, TComparer<string>.Construct(function(const Left, Right: string): Integer
                                                              begin
                                                                Result := Random(2) - 1;
                                                              end));
    end;
    WPFile := FFiles[FileIndex];
    Result := TWPImage.Create(WPFile);
  end;
  { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
var
  WP: TWPImage;
  FitsDesktop: Boolean;
  i: Integer;
  RatioDT, RatioWP: Double;
begin
  FileIndex := FFileIndex;

  // load next picture
  WP := GetNextWP;

  // check if its dimensions fit the entire desktop;
  RatioDT := Screen.DesktopWidth / Screen.DesktopHeight;
  RatioWP := WP.Width / WP.Height;
  FitsDesktop := (WP.Width > (Screen.DesktopWidth * 0.75))
                  and (Abs(RatioWP - RatioDT) < 0.15);
  if Assigned(FDesktop) then
    FDesktop.Free;
  if FitsDesktop then begin
    FDesktop := WP;
    for i := 0 to FMonitors.Count - 1 do begin
      if Assigned(FMonitors[i]) then
        FMonitors[i].Free;
      FMonitors[i] := nil;
    end;
  end else begin
    FDesktop := nil;
    for i := 0 to Screen.MonitorCount - 1 do begin
      // TODO: check if its dimensions fit this monitor (as opposed to the entire desktop)
      if Assigned(FMonitors[i]) then
        FMonitors[i].Free;
      FMonitors[i] := WP;
      WP := GetNextWP
    end;
    if Assigned(WP) then begin
      WP.Free;
      Dec(FileIndex);
    end;
  end;

  FFileIndex := FileIndex;

  // TODO:  if it does fit the entire desktop, use it as desktop
  // TODO:  otherwise, try for each monitor:
  // TODO: fit the picture to the selected monitor's size
  // TODO: draw it onto the desktop canvas at the right position
  // TODO: select the next available monitor;
  // TODO:  if no more monitors, then we're done
  // TODO: load the next picture
  // TODO: end loop
end;

end.

Changes to src/WPCycler.dproj. 

1
2
3
4
5
6
7
8
9
10
11
..
36
37
38
39
40
41
42

43
44
45
46
47
48
49

<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
    <PropertyGroup>
        <ProjectGuid>{859A2EA9-B9DC-4E59-BACD-71E53F4D25CF}</ProjectGuid>
        <ProjectVersion>15.3</ProjectVersion>
        <FrameworkType>VCL</FrameworkType>
        <MainSource>WPCycler.dpr</MainSource>
        <Base>True</Base>
        <Config Condition="'$(Config)'==''">Debug</Config>
        <Platform Condition="'$(Platform)'==''">Win32</Platform>
        <TargetedPlatforms>1</TargetedPlatforms>
        <AppType>Application</AppType>
................................................................................
    </PropertyGroup>
    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
        <Cfg_2>true</Cfg_2>
        <CfgParent>Base</CfgParent>
        <Base>true</Base>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">

        <VerInfo_MajorVer>2</VerInfo_MajorVer>
        <VerInfo_PreRelease>true</VerInfo_PreRelease>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
        <DCC_UnitSearchPath>.;FreeImage;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
        <DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
        <VerInfo_Locale>1043</VerInfo_Locale>




|







 







>








1
2
3
4
5
6
7
8
9
10
11
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
    <PropertyGroup>
        <ProjectGuid>{859A2EA9-B9DC-4E59-BACD-71E53F4D25CF}</ProjectGuid>
        <ProjectVersion>16.0</ProjectVersion>
        <FrameworkType>VCL</FrameworkType>
        <MainSource>WPCycler.dpr</MainSource>
        <Base>True</Base>
        <Config Condition="'$(Config)'==''">Debug</Config>
        <Platform Condition="'$(Platform)'==''">Win32</Platform>
        <TargetedPlatforms>1</TargetedPlatforms>
        <AppType>Application</AppType>
................................................................................
    </PropertyGroup>
    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
        <Cfg_2>true</Cfg_2>
        <CfgParent>Base</CfgParent>
        <Base>true</Base>
    </PropertyGroup>
    <PropertyGroup Condition="'$(Base)'!=''">
        <SanitizedProjectName>WPCycler</SanitizedProjectName>
        <VerInfo_MajorVer>2</VerInfo_MajorVer>
        <VerInfo_PreRelease>true</VerInfo_PreRelease>
        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
        <DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
        <DCC_UnitSearchPath>.;FreeImage;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
        <DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
        <VerInfo_Locale>1043</VerInfo_Locale>

Powered by Fossil · RSS