Check-in [bf57bb5520]

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

Overview
Comment:Attempted to include the auto-updater thread, but that seems to lock up the entire thing. Will try to fix later.
Timelines: family | ancestors | trunk
Files: files | file ages | folders
SHA1: bf57bb55201864d6a473e254842e0eb4f504b65a
User & Date: tinus 2014-10-10 15:44:13
Context
2014-10-10
15:44
Attempted to include the auto-updater thread, but that seems to lock up the entire thing. Will try to fix later. Leaf check-in: bf57bb5520 user: tinus tags: trunk
15:42
Use TryStrToInt instead of raising an exception. check-in: 5cfb19ef2b user: tinus tags: trunk
Changes

Changes to src/F_Main.dfm.

12
13
14
15
16
17
18

19
20

21

22
23
24
25
26
27
28
...
104
105
106
107
108
109
110
111






112

  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  KeyPreview = True
  OldCreateOrder = False
  Position = poScreenCenter

  OnClose = FormClose
  OnCreate = FormCreate

  OnKeyDown = FormKeyDown

  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object gpnlDate: TGridPanel
    Left = 0
    Top = 0
    Width = 434
................................................................................
    end
  end
  object tmrUpdate: TTimer
    Interval = 60000
    OnTimer = tmrUpdateTimer
    Left = 16
    Top = 16
  end






end








>


>

>







 








>
>
>
>
>
>
|
>
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  KeyPreview = True
  OldCreateOrder = False
  Position = poScreenCenter
  OnActivate = FormActivate
  OnClose = FormClose
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnKeyDown = FormKeyDown
  OnMouseMove = gpnlDateMouseMove
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object gpnlDate: TGridPanel
    Left = 0
    Top = 0
    Width = 434
................................................................................
    end
  end
  object tmrUpdate: TTimer
    Interval = 60000
    OnTimer = tmrUpdateTimer
    Left = 16
    Top = 16
  end
  object tmrAutoUpdate: TTimer
    Enabled = False
    Interval = 900000
    OnTimer = tmrAutoUpdateTimer
    Left = 368
    Top = 264
  end
end

Changes to src/F_Main.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
...
101
102
103
104
105
106
107

108
109
110
111
112
113
114
...
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
unit F_Main;

interface

uses
  System.SysUtils, System.Variants, System.Classes, System.IniFiles,
  Winapi.Windows, Winapi.Messages,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;


type
  TfrmMain = class(TForm)
    gpnlDate: TGridPanel;
    lblWeekday: TLabel;
    lblTime: TLabel;
    lblDate: TLabel;
    tmrUpdate: TTimer;

    procedure tmrUpdateTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure gpnlDateMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApplicationException(Sender: TObject; E: Exception);
    procedure ApplicationDeactivate(Sender: TObject);




  private
    { Private declarations }
    FLastMousePos: TPoint;
    FInitialFontSize: Integer;

  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Settings: TIniFile;

implementation
uses

  ScreenSaverUtils,
  U_AutoUpdate;


{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormCreate(Sender: TObject);
var
  i: Integer;
  frmSub: TfrmMain;
begin





  Screen.Cursor := crNone;
  {$IFDEF DEBUG}
  frmMain.FormStyle := fsNormal;
  {$ENDIF}

  FLastMousePos.x := -1;
  FLastMousePos.y := -1;

  // remember the initial font size
  FInitialFontSize := Font.Size;


  if Self = frmMain then begin
    Application.OnException := ApplicationException;
    Application.OnDeactivate := ApplicationDeactivate;













    if ScreenSaverMode = ssRun then begin
      // create forms for all other screens
      for i := 0 to Screen.MonitorCount - 1 do begin
        if not Screen.Monitors[i].Primary then begin
          Application.CreateForm(TfrmMain, frmSub);

          frmSub.Position := poDesigned;
          frmSub.Left := Screen.Monitors[i].Left;
          frmSub.WindowState := wsMaximized;

        end;
      end;
    end else if ParentSaverHandle <> 0 then begin
      // reparent this form to the given handle?
      Winapi.Windows.SetParent(Self.Handle, ParentSaverHandle);
    end;
  end else begin
    // TODO: code only for non-primary monitors
  end;



  FormResize(Self);
  tmrUpdateTimer(tmrUpdate);

  Show;

end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin

  Screen.Cursor := crDefault;















end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormResize(Sender: TObject);

  {$MESSAGE WARN 'TODO: write routine to evaluate width and height of given cell — MCO 03-09-2014'}

................................................................................
  Size: Integer;
  MaxWidth, MaxHeight: Integer;
  i: Integer;
  Ctl: TControlItem;
  Fits: Boolean;
  Lbl: TLabel;
begin

  // TODO: figure out the maximum font size where all elements fit without wrapping,
  //  and where the current time has twice the font size of the other elements
  Size := FInitialFontSize;
  Font.Size := Size;
  MaxWidth := gpnlDate.Width div gpnlDate.ColumnCollection.Count;
  MaxHeight := gpnlDate.Height div gpnlDate.RowCollection.Count;

................................................................................
          Break;
      end;
    end;
  end;
  Dec(Size);
  Font.Size := Size;
  lblTime.Font.Size := Size * 2;

end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.tmrUpdateTimer(Sender: TObject);
begin



  lblWeekday.Caption := FormatDateTime('dddd', Now);
  lblTime.Caption := FormatDateTime('HH:nn', Now);
  lblDate.Caption := FormatDateTime('d mmmm yyyy', Now);
  if Self = frmMain then begin
    SetActiveWindow(Self.Handle);



  end;
















end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Application.Terminate;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.gpnlDateMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);


begin
  // TODO: if Sender <> Self then translate X and Y to form (or screen) positions





  if (FLastMousePos.X = -1) and (FLastMousePos.Y = -1) then begin
    FLastMousePos.X := X;
    FLastMousePos.Y := Y;
  end else begin
    if (Abs(X - FLastMousePos.X) > 5) and (Abs(Y - FLastMousePos.Y) > 5) then begin
      FLastMousePos.X := X;
      FLastMousePos.Y := Y;
      Application.Terminate;
    end;
  end;

end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.ApplicationException(Sender: TObject; E: Exception);
var
  i: Integer;
begin

  for i := 0 to Screen.FormCount - 1 do begin
    Screen.Forms[i].FormStyle := fsNormal;
  end;
  Application.ShowException(E);
  if not Application.Terminated then
    Application.Terminate;

end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.ApplicationDeactivate(Sender: TObject);
begin

  Application.Terminate;

end;

end.







|
>








>









>
>
>
>




>










>

<
>





<
<
<

>
>
>
>
>


|







>

<
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
<
>
|
|
|
>
|
|
|
|
|
|
<
<
<
>
>


<
<
<
>





>

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







 







>







 







>





>
>
>



<
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>
>

<
>
>
>
>
>

|
<

|
|
<



>







>






>





>

>



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
...
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
...
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
unit F_Main;

interface

uses
  System.SysUtils, System.Variants, System.Classes, System.IniFiles,
  Winapi.Windows, Winapi.Messages,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  U_AutoUpdate;

type
  TfrmMain = class(TForm)
    gpnlDate: TGridPanel;
    lblWeekday: TLabel;
    lblTime: TLabel;
    lblDate: TLabel;
    tmrUpdate: TTimer;
    tmrAutoUpdate: TTimer;
    procedure tmrUpdateTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure gpnlDateMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApplicationException(Sender: TObject; E: Exception);
    procedure ApplicationDeactivate(Sender: TObject);
    procedure tmrAutoUpdateTimer(Sender: TObject);
    procedure AutoUpdaterTerminate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    FLastMousePos: TPoint;
    FInitialFontSize: Integer;
    FAutoUpdater: TAutoUpdateThread;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Settings: TIniFile;

implementation
uses
  System.Types,
  ScreenSaverUtils,

  F_Sub;

{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormCreate(Sender: TObject);



begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormCreate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));

  Application.OnException := ApplicationException;
  Application.OnDeactivate := ApplicationDeactivate;

  Screen.Cursor := crNone;
  {$IFDEF DEBUG}
  FormStyle := fsNormal;
  {$ENDIF}

  FLastMousePos.x := -1;
  FLastMousePos.y := -1;

  // remember the initial font size
  FInitialFontSize := Font.Size;
  tmrUpdateTimer(tmrUpdate);


//  Show;


  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormCreate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormActivate(Sender: TObject);
var
  i: Integer;
  frmSub: TfrmSub;
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormActivate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  OnActivate := nil;

  if ScreenSaverMode = ssRun then begin
    // create forms for all other screens
    for i := 0 to Screen.MonitorCount - 1 do begin
      if not Screen.Monitors[i].Primary then begin

        frmSub := TfrmSub.Create(Application);
        frmSub.Position := poDesigned;
        frmSub.Left := Screen.Monitors[i].Left;
        frmSub.WindowState := wsMaximized;
        frmSub.Show;
      end;
    end;
  end else if ParentSaverHandle <> 0 then begin
    // reparent this form to the given handle?
    Winapi.Windows.SetParent(Self.Handle, ParentSaverHandle);
  end;



  tmrAutoUpdate.Enabled := True;
  tmrAutoUpdate.OnTimer(tmrAutoUpdate);

  FormResize(Self);



  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormActivate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormClose', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  Screen.Cursor := crDefault;
  Action := caFree;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormClose', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormDestroy', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  if Assigned(FAutoUpdater) then begin
    FAutoUpdater.OnTerminate := nil;
    FAutoUpdater.Terminate;
    FAutoUpdater.WaitFor;
    FreeAndNil(FAutoUpdater);
  end;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormDestroy', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormResize(Sender: TObject);

  {$MESSAGE WARN 'TODO: write routine to evaluate width and height of given cell — MCO 03-09-2014'}

................................................................................
  Size: Integer;
  MaxWidth, MaxHeight: Integer;
  i: Integer;
  Ctl: TControlItem;
  Fits: Boolean;
  Lbl: TLabel;
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormResize', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  // TODO: figure out the maximum font size where all elements fit without wrapping,
  //  and where the current time has twice the font size of the other elements
  Size := FInitialFontSize;
  Font.Size := Size;
  MaxWidth := gpnlDate.Width div gpnlDate.ColumnCollection.Count;
  MaxHeight := gpnlDate.Height div gpnlDate.RowCollection.Count;

................................................................................
          Break;
      end;
    end;
  end;
  Dec(Size);
  Font.Size := Size;
  lblTime.Font.Size := Size * 2;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormResize', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.tmrUpdateTimer(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): tmrUpdateTimer', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  Self.OnResize := nil;
  TTimer(Sender).Enabled := False;
  lblWeekday.Caption := FormatDateTime('dddd', Now);
  lblTime.Caption := FormatDateTime('HH:nn', Now);
  lblDate.Caption := FormatDateTime('d mmmm yyyy', Now);

  SetActiveWindow(Self.Handle);
  TTimer(Sender).Enabled := True;
  self.OnResize := FormResize;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /tmrUpdateTimer', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.tmrAutoUpdateTimer(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): tmrAutoUpdateTimer', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  tmrAutoUpdate.Interval := 86400000;
  FAutoUpdater := TAutoUpdateThread.Create(True);
  FAutoUpdater.OnTerminate := AutoUpdaterTerminate;
  FAutoUpdater.Start;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /tmrAutoUpdateTimer', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.AutoUpdaterTerminate(Sender: TObject);
begin
  FreeAndNil(FAutoUpdater);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Application.Terminate;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.gpnlDateMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MousePos: TPoint;
begin

  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): MouseMove(%s)', [Handle, Self.Name, TThread.CurrentThread.ThreadID, (Sender as TComponent).Name])));
  MousePos := Point(X, Y);
  if (Sender is TControl) and Assigned(TControl(Sender).Parent) then begin
    MousePos := TControl(Sender).Parent.ClientToScreen(MousePos);
  end;
  if (FLastMousePos.X = -1) and (FLastMousePos.Y = -1) then begin
    FLastMousePos := MousePos;

  end else begin
    if (Abs(MousePos.X - FLastMousePos.X) > 5) and (Abs(MousePos.Y - FLastMousePos.Y) > 5) then begin
      FLastMousePos := MousePos;

      Application.Terminate;
    end;
  end;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /MouseMove(%s)', [Handle, Self.Name, TThread.CurrentThread.ThreadID, (Sender as TComponent).Name])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.ApplicationException(Sender: TObject; E: Exception);
var
  i: Integer;
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): ApplicationException(%s)', [Handle, Self.Name, TThread.CurrentThread.ThreadID, E.ClassName])));
  for i := 0 to Screen.FormCount - 1 do begin
    Screen.Forms[i].FormStyle := fsNormal;
  end;
  Application.ShowException(E);
  if not Application.Terminated then
    Application.Terminate;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /ApplicationException(%s)', [Handle, Self.Name, TThread.CurrentThread.ThreadID, E.ClassName])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmMain.ApplicationDeactivate(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): ApplicationDeactivate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  Application.Terminate;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /ApplicationDeactivate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

end.

Added src/F_Sub.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
object frmSub: TfrmSub
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu]
  BorderStyle = bsNone
  Caption = 'Datum+'
  ClientHeight = 282
  ClientWidth = 418
  Color = clBlack
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWhite
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  KeyPreview = True
  OldCreateOrder = False
  OnActivate = FormActivate
  OnCreate = FormCreate
  OnMouseMove = FormMouseMove
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object gpnlDate: TGridPanel
    Left = 0
    Top = 0
    Width = 418
    Height = 282
    Align = alClient
    BevelOuter = bvNone
    ColumnCollection = <
      item
        Value = 100.000000000000000000
      end>
    ControlCollection = <
      item
        Column = 0
        Control = lblWeekday
        Row = 0
      end
      item
        Column = 0
        Control = lblTime
        Row = 1
      end
      item
        Column = 0
        Control = lblDate
        Row = 2
      end>
    ParentBackground = False
    ParentColor = True
    RowCollection = <
      item
        Value = 20.000000000000000000
      end
      item
        Value = 60.000000000000000000
      end
      item
        Value = 20.000000000000000000
      end>
    TabOrder = 0
    DesignSize = (
      418
      282)
    object lblWeekday: TLabel
      Left = 196
      Top = 21
      Width = 26
      Height = 13
      Anchors = []
      Caption = '(dag)'
      ShowAccelChar = False
      ExplicitLeft = 181
      ExplicitTop = 35
    end
    object lblTime: TLabel
      Left = 197
      Top = 134
      Width = 23
      Height = 13
      Anchors = []
      Caption = '(tijd)'
      ShowAccelChar = False
      ExplicitLeft = 185
      ExplicitTop = 141
    end
    object lblDate: TLabel
      Left = 190
      Top = 247
      Width = 38
      Height = 13
      Anchors = []
      Caption = '(datum)'
      ShowAccelChar = False
      ExplicitLeft = 163
      ExplicitTop = 248
    end
  end
  object tmrUpdate: TTimer
    Interval = 60000
    OnTimer = tmrUpdateTimer
    Left = 16
    Top = 16
  end
end

Added src/F_Sub.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
unit F_Sub;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TfrmSub = class(TForm)
    gpnlDate: TGridPanel;
    lblWeekday: TLabel;
    lblTime: TLabel;
    lblDate: TLabel;
    tmrUpdate: TTimer;
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tmrUpdateTimer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    FLastMousePos: TPoint;
    FInitialFontSize: Integer;
  public
    { Public declarations }
  end;

var
  frmSub: TfrmSub;

implementation
uses
  System.Types;

{$R *.dfm}

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmSub.FormCreate(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormCreate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  tmrUpdateTimer(tmrUpdate);
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormCreate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmSub.FormActivate(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormActivate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  OnActivate := nil;
  FormResize(Sender);
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormActivate', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmSub.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  MousePos: TPoint;
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): MouseMove(%s)', [Handle, Self.Name, TThread.CurrentThread.ThreadID, (Sender as TComponent).Name])));
  MousePos := Point(X, Y);
  if (Sender is TControl) and Assigned(TControl(Sender).Parent) then begin
    MousePos := TControl(Sender).Parent.ClientToScreen(MousePos);
  end;
  if (FLastMousePos.X = -1) and (FLastMousePos.Y = -1) then begin
    FLastMousePos := MousePos;
  end else begin
    if (Abs(MousePos.X - FLastMousePos.X) > 5) and (Abs(MousePos.Y - FLastMousePos.Y) > 5) then begin
      FLastMousePos := MousePos;
      Application.Terminate;
    end;
  end;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /MouseMove(%s)', [Handle, Self.Name, TThread.CurrentThread.ThreadID, (Sender as TComponent).Name])));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmSub.FormResize(Sender: TObject);
var
  Size: Integer;
  MaxWidth, MaxHeight: Integer;
  i: Integer;
  Ctl: TControlItem;
  Fits: Boolean;
  Lbl: TLabel;
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): FormResize', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  // TODO: figure out the maximum font size where all elements fit without wrapping,
  //  and where the current time has twice the font size of the other elements
  Size := FInitialFontSize;
  Font.Size := Size;
  MaxWidth := gpnlDate.Width div gpnlDate.ColumnCollection.Count;
  MaxHeight := gpnlDate.Height div gpnlDate.RowCollection.Count;

  for i := 0 to gpnlDate.ControlCollection.Count - 1 do begin
    Ctl := gpnlDate.ControlCollection[i];
    if Ctl.Control is TLabel then
      TLabel(Ctl.Control).ParentFont := True;
  end;

  Fits := True;
  while Fits do begin
    Inc(Size);
    Font.Size := Size;
    lblTime.Font.Size := Size * 2;

    // figure out if all labels in the control collection still fit
    for i := 0 to gpnlDate.ControlCollection.Count - 1 do begin
      Ctl := gpnlDate.ControlCollection[i];
      if Ctl.Control is TLabel then begin
        Lbl := TLabel(Ctl.Control);
        Fits := (Lbl.Width <= MaxWidth) and (Lbl.Height <= MaxHeight);
        if not Fits then
          Break;
      end;
    end;
  end;
  Dec(Size);
  Font.Size := Size;
  lblTime.Font.Size := Size * 2;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /FormResize', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

procedure TfrmSub.tmrUpdateTimer(Sender: TObject);
begin
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): tmrUpdateTimer', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
  Self.OnResize := nil;
  TTimer(Sender).Enabled := False;
  lblWeekday.Caption := FormatDateTime('dddd', Now);
  lblTime.Caption := FormatDateTime('HH:nn', Now);
  lblDate.Caption := FormatDateTime('d mmmm yyyy', Now);
  TTimer(Sender).Enabled := True;
  self.OnResize := FormResize;
  OutputDebugString(PChar(Format('Wnd %x, %s (thread %x): /tmrUpdateTimer', [Handle, Self.Name, TThread.CurrentThread.ThreadID])));
end;

end.

Changes to src/U_AutoUpdate.pas.

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
  LatestVersion, OwnVersion: string;
  CurrentExe, CurrentExePath, BackupExe: string;
  rexVersion: System.RegularExpressions.TRegEx;
  Match: TMatch;
  Zip: TZipFile;
  i: Integer;
begin

  xmlDoc := TNativeXml.Create;
  try
    Stream := Download('http://fossil.2of4.net/simple_date_ss/timeline.rss?y=ci&tag=publish');
    try

      xmlDoc.LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
    xmlItems := xmlDoc.SelectNodes('/rss/channel/item/title');
    try
      rexVersion.Create('(\d\.)+\d', [roCompiled]);
      LatestVersion := '';
      for xmlItem in xmlItems do begin
        Match := rexVersion.Match(xmlItem.AsString);
        if Match.Success then begin
          LatestVersion := Match.Groups[0].Value;
          Break;
        end;
        if LatestVersion = '' then exit;
      end{for};
    finally
      xmlItems.Free;
    end;
  finally
    xmlDoc.Free;
  end;
  CurrentExe := ParamStr(0);
  with TFileVersionInfo.Create(CurrentExe) do begin
    OwnVersion := FileVersion;
    Free;
  end;
  if CompareVersions(LatestVersion, OwnVersion) > 0 then begin
    Stream := Download('http://fossil.2of4.net/simple_date_ss/zip/ss_datum.zip?uuid=publish');
    try

      CurrentExePath := TPath.GetDirectoryName(CurrentExe);
      Zip := TZipFile.Create;
      try
        Zip.Open(Stream, zmRead);
        for i := 0 to Zip.FileCount - 1 do begin
          try
            if SameFileName(TPath.GetFileName(Zip.FileName[i]), TPath.GetFileName(CurrentExe)) then begin
              BackupExe := ChangeFileExt(CurrentExe, '_v' + ownVersion + ExtractFileExt(CurrentExe));
              TFile.Move(CurrentExe, BackupExe);
            end;
            Zip.Extract(i, CurrentExePath, False);
          except
            // TODO: what to do with the exception?
          end;
        end;
      finally
        Zip.Free;
      end;
    finally
      Stream.Free;
    end;
  end{if};



end {TAutoUpdateThread.Execute};

end.







>
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>



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
  LatestVersion, OwnVersion: string;
  CurrentExe, CurrentExePath, BackupExe: string;
  rexVersion: System.RegularExpressions.TRegEx;
  Match: TMatch;
  Zip: TZipFile;
  i: Integer;
begin
  try
    xmlDoc := TNativeXml.Create;
    try
      Stream := Download('http://fossil.2of4.net/simple_date_ss/timeline.rss?y=ci&tag=publish');
      try
        if Self.Terminated then exit;
        xmlDoc.LoadFromStream(Stream);
      finally
        Stream.Free;
      end;
      xmlItems := xmlDoc.SelectNodes('/rss/channel/item/title');
      try
        rexVersion.Create('(\d\.)+\d', [roCompiled]);
        LatestVersion := '';
        for xmlItem in xmlItems do begin
          Match := rexVersion.Match(xmlItem.AsString);
          if Match.Success then begin
            LatestVersion := Match.Groups[0].Value;
            Break;
          end;
          if LatestVersion = '' then exit;
        end{for};
      finally
        xmlItems.Free;
      end;
    finally
      xmlDoc.Free;
    end;
    CurrentExe := ParamStr(0);
    with TFileVersionInfo.Create(CurrentExe) do begin
      OwnVersion := FileVersion;
      Free;
    end;
    if CompareVersions(LatestVersion, OwnVersion) > 0 then begin
      Stream := Download('http://fossil.2of4.net/simple_date_ss/zip/ss_datum.zip?uuid=publish');
      try
        if Self.Terminated then exit;
        CurrentExePath := TPath.GetDirectoryName(CurrentExe);
        Zip := TZipFile.Create;
        try
          Zip.Open(Stream, zmRead);
          for i := 0 to Zip.FileCount - 1 do begin
            try
              if SameFileName(TPath.GetFileName(Zip.FileName[i]), TPath.GetFileName(CurrentExe)) then begin
                BackupExe := ChangeFileExt(CurrentExe, '_v' + ownVersion + ExtractFileExt(CurrentExe));
                TFile.Move(CurrentExe, BackupExe);
              end;
              Zip.Extract(i, CurrentExePath, False);
            except
              // TODO: what to do with the exception?
            end;
          end;
        finally
          Zip.Free;
        end;
      finally
        Stream.Free;
      end;
    end{if};
  except
    // Eat the exception for now
  end;
end {TAutoUpdateThread.Execute};

end.

Changes to src/ssdatum.dpr.

1
2
3
4
5
6

7
8
9

10
11
12
13
14
15
16
..
31
32
33
34
35
36
37

38
39
40
41
42
program ssdatum;

uses
  WinApi.Windows,
  Vcl.Forms,
  F_Main in 'F_Main.pas' {frmMain},

  SingleInstance in 'SingleInstance.pas',
  ScreenSaverUtils in 'ScreenSaverUtils.pas' (*,
  F_Config in 'F_Config.pas' {frmConfig}*);


{$R *.res}

begin
{$IFDEF DEBUG}
  ReportMemoryLeaksOnShutdown := True;
{$ENDIF}
................................................................................

//  if ScreenSaverMode = ssConfigure then begin
//    // Create the configure form to configure the screen saver
//    Application.CreateForm(TfrmConfig, frmConfig);
//  end else begin
    // We are either doing a preview or actually running the screen saver
    Application.CreateForm(TfrmMain, frmMain);

  frmMain.Left := Screen.PrimaryMonitor.Left;
    frmMain.WindowState := wsMaximized;
//  end;
  Application.Run;
end.






>

|
<
>







 







>
|




1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
..
32
33
34
35
36
37
38
39
40
41
42
43
44
program ssdatum;

uses
  WinApi.Windows,
  Vcl.Forms,
  F_Main in 'F_Main.pas' {frmMain},
  F_Sub in 'F_Sub.pas' {frmSub},
  SingleInstance in 'SingleInstance.pas',
  ScreenSaverUtils in 'ScreenSaverUtils.pas';



{$R *.res}

begin
{$IFDEF DEBUG}
  ReportMemoryLeaksOnShutdown := True;
{$ENDIF}
................................................................................

//  if ScreenSaverMode = ssConfigure then begin
//    // Create the configure form to configure the screen saver
//    Application.CreateForm(TfrmConfig, frmConfig);
//  end else begin
    // We are either doing a preview or actually running the screen saver
    Application.CreateForm(TfrmMain, frmMain);
    frmMain.Top := Screen.PrimaryMonitor.Top + 1;
    frmMain.Left := Screen.PrimaryMonitor.Left + 1;
    frmMain.WindowState := wsMaximized;
//  end;
  Application.Run;
end.

Changes to src/ssdatum.dproj.

99
100
101
102
103
104
105



106
107
108
109
110
111
112
113
114
115
116
117
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="F_Main.pas">
            <Form>frmMain</Form>



        </DCCReference>
        <DCCReference Include="SingleInstance.pas"/>
        <DCCReference Include="ScreenSaverUtils.pas">
            <Form>*,
  F_Config in &apos;F_Config.pas&apos; {frmConfig}*</Form>
        </DCCReference>
        <None Include="ssdatum.sample.ini"/>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">







>
>
>




|







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    </PropertyGroup>
    <ItemGroup>
        <DelphiCompile Include="$(MainSource)">
            <MainSource>MainSource</MainSource>
        </DelphiCompile>
        <DCCReference Include="F_Main.pas">
            <Form>frmMain</Form>
        </DCCReference>
        <DCCReference Include="F_Sub.pas">
            <Form>frmSub</Form>
        </DCCReference>
        <DCCReference Include="SingleInstance.pas"/>
        <DCCReference Include="ScreenSaverUtils.pas">
            <Form>*,
  F_Config in &apos;F_Config.pas&apos; {frmConfig}; *</Form>
        </DCCReference>
        <None Include="ssdatum.sample.ini"/>
        <BuildConfiguration Include="Release">
            <Key>Cfg_2</Key>
            <CfgParent>Base</CfgParent>
        </BuildConfiguration>
        <BuildConfiguration Include="Base">