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: |
736f8b195983c9df0d8477972d9fb436 |
User & Date: | tinus 2014-12-09 17:53:14.333 |
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
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 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | 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; var frmMain: TfrmMain; 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 | > > | 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 | 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; var frmMain: TfrmMain; 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 |
︙ | ︙ | |||
54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | 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.Top := Trunc((R.Top - DR.Top) * ScaleFactor); Result.Width := Trunc(R.Width * ScaleFactor); Result.Height := Trunc(R.Height * ScaleFactor); end; var i: Integer; Mon: TMonitor; begin DR := Screen.DesktopRect; | > | | > > > > > > > > > > | 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 | 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.Top := Trunc((R.Top - DR.Top) * ScaleFactor); Result.Width := Trunc(R.Width * 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 modMain.Desktop.Draw(pbxDesktop.Canvas, pbxDesktop.BoundsRect); for i := 0 to modMain.Monitors.Count - 1 do begin 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 | unit M_Main; interface uses | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 | 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; |
︙ | ︙ | |||
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | 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 | > > > > > | > < | > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | 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 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> <PropertyGroup> <ProjectGuid>{859A2EA9-B9DC-4E59-BACD-71E53F4D25CF}</ProjectGuid> | | | 1 2 3 4 5 6 7 8 9 10 11 | <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> |
︙ | ︙ | |||
36 37 38 39 40 41 42 43 44 45 46 47 48 49 | </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> | > | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | </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> |
︙ | ︙ |