Rev 75 | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 75 | Rev 76 | ||
---|---|---|---|
1 | unit CHILDWIN; |
1 | unit CHILDWIN; |
2 | 2 | ||
3 | interface |
3 | interface |
4 | 4 | ||
5 | uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, Dialogs; |
5 | uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, Dialogs; |
6 | 6 | ||
7 | type |
7 | type |
8 | TMDIChild = class(TForm) |
8 | TMDIChild = class(TForm) |
9 | Memo1: TMemo; |
9 | Memo1: TMemo; |
10 | Label1: TLabel; |
10 | Label1: TLabel; |
11 | Button1: TButton; |
11 | Button1: TButton; |
12 | Timer1: TTimer; |
12 | Timer1: TTimer; |
13 | Button2: TButton; |
13 | Button2: TButton; |
14 | procedure FormClose(Sender: TObject; var Action: TCloseAction); |
14 | procedure FormClose(Sender: TObject; var Action: TCloseAction); |
15 | procedure Button1Click(Sender: TObject); |
15 | procedure Button1Click(Sender: TObject); |
16 | procedure Timer1Timer(Sender: TObject); |
16 | procedure Timer1Timer(Sender: TObject); |
17 | procedure FormCreate(Sender: TObject); |
17 | procedure FormCreate(Sender: TObject); |
18 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
18 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
19 | procedure Button2Click(Sender: TObject); |
19 | procedure Button2Click(Sender: TObject); |
20 | private |
20 | private |
21 | StartTime: TDateTime; |
21 | StartTime: TDateTime; |
22 | SecondsPrev: integer; |
22 | SecondsPrev: integer; |
23 | SecondsTotal: integer; |
23 | SecondsTotal: integer; |
- | 24 | public |
|
- | 25 | procedure StartTimer; |
|
- | 26 | procedure StopTimer; |
|
- | 27 | procedure ResetTimer; |
|
- | 28 | procedure StartStopTimer; |
|
- | 29 | function TimerIsRunning: boolean; |
|
24 | end; |
30 | end; |
25 | 31 | ||
26 | implementation |
32 | implementation |
27 | 33 | ||
28 | {$R *.dfm} |
34 | {$R *.dfm} |
29 | 35 | ||
30 | uses |
36 | uses |
31 | DateUtils, Math; |
37 | DateUtils, Math, Main; |
32 | 38 | ||
33 | procedure TMDIChild.Button1Click(Sender: TObject); |
39 | procedure TMDIChild.Button1Click(Sender: TObject); |
34 | begin |
40 | begin |
35 | if CompareValue(StartTime, 0) <> 0 then |
- | |
36 | begin |
- | |
37 | // Es läuft. Stoppe es |
- | |
38 | SecondsTotal := SecondsPrev + trunc((Now - StartTime) * 24*60*60); |
- | |
39 | SecondsPrev := SecondsTotal; |
- | |
40 | StartTime := 0; |
41 | StartStopTimer; |
41 | memo1.Color := clWindow; |
- | |
42 | end |
- | |
43 | else |
- | |
44 | begin |
- | |
45 | // Es läuft nicht. Starte es. |
- | |
46 | StartTime := Now; |
- | |
47 | memo1.Color := clYellow; |
- | |
48 | end; |
- | |
49 | end; |
42 | end; |
50 | 43 | ||
51 | procedure TMDIChild.Button2Click(Sender: TObject); |
44 | procedure TMDIChild.Button2Click(Sender: TObject); |
52 | begin |
45 | begin |
53 | if MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich resetten?', mtConfirmation, mbYesNoCancel, 0) = mrYes then |
46 | if MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich resetten?', mtConfirmation, mbYesNoCancel, 0) = mrYes then |
54 | begin |
47 | begin |
55 | if CompareValue(StartTime, 0) <> 0 then |
- | |
56 | begin |
- | |
57 | // Es läuft. Starte neu |
- | |
58 | StartTime := Now; |
48 | ResetTimer; |
59 | end |
- | |
60 | else |
- | |
61 | begin |
- | |
62 | // Es läuft nicht. Resette Zeit |
- | |
63 | SecondsPrev := 0; |
- | |
64 | end; |
- | |
65 | end; |
49 | end; |
66 | end; |
50 | end; |
67 | 51 | ||
68 | procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction); |
52 | procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction); |
69 | begin |
53 | begin |
70 | Action := caFree; |
54 | Action := caFree; |
71 | end; |
55 | end; |
72 | 56 | ||
73 | procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
57 | procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
74 | begin |
58 | begin |
75 | CanClose := MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich schließen?', mtConfirmation, mbYesNoCancel, 0) = mrYes; |
59 | CanClose := MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich schließen?', mtConfirmation, mbYesNoCancel, 0) = mrYes; |
76 | end; |
60 | end; |
77 | 61 | ||
78 | procedure TMDIChild.FormCreate(Sender: TObject); |
62 | procedure TMDIChild.FormCreate(Sender: TObject); |
79 | begin |
63 | begin |
80 | Constraints.MinWidth := Width; |
64 | Constraints.MinWidth := Width; |
81 | Constraints.MaxWidth := Width; |
65 | Constraints.MaxWidth := Width; |
82 | Constraints.MinHeight := Height; |
66 | Constraints.MinHeight := Height; |
83 | Constraints.MaxHeight := Height; |
67 | Constraints.MaxHeight := Height; |
84 | end; |
68 | end; |
85 | 69 | ||
- | 70 | procedure TMDIChild.ResetTimer; |
|
- | 71 | begin |
|
- | 72 | if TimerIsRunning then |
|
- | 73 | begin |
|
- | 74 | // Es läuft. Starte neu |
|
- | 75 | StartTime := Now; |
|
- | 76 | end |
|
- | 77 | else |
|
- | 78 | begin |
|
- | 79 | // Es läuft nicht. Resette Zeit |
|
- | 80 | SecondsPrev := 0; |
|
- | 81 | end; |
|
- | 82 | end; |
|
- | 83 | ||
- | 84 | procedure TMDIChild.StartStopTimer; |
|
- | 85 | begin |
|
- | 86 | if TimerIsRunning then |
|
- | 87 | begin |
|
- | 88 | // Es läuft. Stoppe es |
|
- | 89 | StopTimer; |
|
- | 90 | end |
|
- | 91 | else |
|
- | 92 | begin |
|
- | 93 | // Es läuft nicht. Starte es. |
|
- | 94 | if MainForm.NureineUhrgleichzeitig1.Checked then |
|
- | 95 | begin |
|
- | 96 | MainForm.StopAllTimers; |
|
- | 97 | end; |
|
- | 98 | ||
- | 99 | StartTimer; |
|
- | 100 | end; |
|
- | 101 | end; |
|
- | 102 | ||
- | 103 | procedure TMDIChild.StartTimer; |
|
- | 104 | begin |
|
- | 105 | if not TimerIsRunning then |
|
- | 106 | begin |
|
- | 107 | // Es läuft nicht. Starte es. |
|
- | 108 | StartTime := Now; |
|
- | 109 | memo1.Color := clYellow; |
|
- | 110 | end; |
|
- | 111 | end; |
|
- | 112 | ||
- | 113 | procedure TMDIChild.StopTimer; |
|
- | 114 | begin |
|
- | 115 | if TimerIsRunning then |
|
- | 116 | begin |
|
- | 117 | // Es läuft. Stoppe es |
|
- | 118 | SecondsTotal := SecondsPrev + trunc((Now - StartTime) * 24*60*60); |
|
- | 119 | SecondsPrev := SecondsTotal; |
|
- | 120 | StartTime := 0; |
|
- | 121 | memo1.Color := clWindow; |
|
- | 122 | end; |
|
- | 123 | end; |
|
- | 124 | ||
86 | procedure TMDIChild.Timer1Timer(Sender: TObject); |
125 | procedure TMDIChild.Timer1Timer(Sender: TObject); |
87 | begin |
126 | begin |
88 | if CompareValue(StartTime, 0) <> 0 then |
127 | if TimerIsRunning then |
89 | begin |
128 | begin |
90 | SecondsTotal := SecondsPrev + trunc((Now - StartTime) * 24*60*60); |
129 | SecondsTotal := SecondsPrev + trunc((Now - StartTime) * 24*60*60); |
91 | end |
130 | end |
92 | else |
131 | else |
93 | begin |
132 | begin |
94 | SecondsTotal := SecondsPrev; |
133 | SecondsTotal := SecondsPrev; |
95 | end; |
134 | end; |
96 | 135 | ||
97 | label1.Caption := FormatDateTime('hh:nn:ss', SecondsTotal / SecsPerDay); |
136 | label1.Caption := FormatDateTime('hh:nn:ss', SecondsTotal / SecsPerDay); |
98 | end; |
137 | end; |
- | 138 | ||
- | 139 | function TMDIChild.TimerIsRunning: boolean; |
|
- | 140 | begin |
|
- | 141 | result := CompareValue(StartTime, 0) <> 0; |
|
- | 142 | end; |
|
99 | 143 | ||
100 | end. |
144 | end. |
101 | 145 |