Check-in [a88a240ac7]

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

Overview
Comment:Adjusted the date's font size to be a bit larger. Hide the cursor on create, and restore it on close. In case of preview, reparent the form to the given parent handle.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a88a240ac709ec527644dd09c1d3187c497d4ead
User & Date: MCO 2014-09-08 12:24:36
Context
2014-09-08
12:26
Disabled config form; it's not really necessary anyway. check-in: c55b899d8b user: MCO tags: trunk
12:24
Adjusted the date's font size to be a bit larger. Hide the cursor on create, and restore it on close. In case of preview, reparent the form to the given parent handle. check-in: a88a240ac7 user: MCO tags: trunk
12:22
Streamlined code for config form. check-in: 1ab08a4219 user: MCO tags: trunk
Changes

Changes to src/F_Main.dfm.

12
13
14
15
16
17
18

19
20
21
22
23
24
25
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  FormStyle = fsStayOnTop
  KeyPreview = True
  OldCreateOrder = False
  Position = poScreenCenter

  OnCreate = FormCreate
  OnKeyDown = FormKeyDown
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object gpnlDate: TGridPanel
    Left = 0







>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
  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

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
...
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
unit F_Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 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);

  private
    { Private declarations }
    FLastMousePos: TPoint;
    FInitialFontSize: Integer;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;


implementation
uses
  ScreenSaverUtils;

{$R *.dfm}


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

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

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

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

  tmrUpdateTimer(tmrUpdate);

  if Self = frmMain then begin
    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 begin
      // TODO: reparent this form to the given handle?

    end;
  end else begin
    // TODO: code only for non-primary monitors
  end;

  FormResize(Self);


  Show;
end;








procedure TfrmMain.FormResize(Sender: TObject);

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

var
  Size: Integer;
  MaxWidth, MaxHeight: Integer;
................................................................................
      TLabel(Ctl.Control).ParentFont := True;
  end;

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

    // 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 * 3;
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);
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;





|
>
|







 







>










>







>





>







|


<
<











|
|
>






>
>



>
>
>
>
>
>
>







 







|







 







|


>







>






>







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
...
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
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);
  private
    { Private declarations }
    FLastMousePos: TPoint;
    FInitialFontSize: Integer;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Settings: TIniFile;

implementation
uses
  ScreenSaverUtils;

{$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
    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'}

var
  Size: Integer;
  MaxWidth, MaxHeight: Integer;
................................................................................
      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;
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);
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;