Subversion Repositories delphiutils

Rev

Rev 75 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
75 daniel-mar 1 
unit CHILDWIN;
2 
 
3 
interface
4 
 
5 
uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, Dialogs;
6 
 
7 
type
8 
  TMDIChild = class(TForm)
9 
    Memo1: TMemo;
10 
    Label1: TLabel;
11 
    Button1: TButton;
12 
    Timer1: TTimer;
13 
    Button2: TButton;
14 
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
15 
    procedure Button1Click(Sender: TObject);
16 
    procedure Timer1Timer(Sender: TObject);
17 
    procedure FormCreate(Sender: TObject);
18 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
19 
    procedure Button2Click(Sender: TObject);
20 
  private
21 
    StartTime: TDateTime;
22 
    SecondsPrev: integer;
23 
    SecondsTotal: integer;
76 daniel-mar 24 
  public
25 
    procedure StartTimer;
26 
    procedure StopTimer;
27 
    procedure ResetTimer;
28 
    procedure StartStopTimer;
29 
    function TimerIsRunning: boolean;
75 daniel-mar 30 
  end;
31 
 
32 
implementation
33 
 
34 
{$R *.dfm}
35 
 
36 
uses
76 daniel-mar 37 
  DateUtils, Math, Main;
75 daniel-mar 38 
 
39 
procedure TMDIChild.Button1Click(Sender: TObject);
40 
begin
76 daniel-mar 41 
  StartStopTimer;
75 daniel-mar 42 
end;
43 
 
44 
procedure TMDIChild.Button2Click(Sender: TObject);
45 
begin
46 
  if MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich resetten?', mtConfirmation, mbYesNoCancel, 0) = mrYes then
47 
  begin
76 daniel-mar 48 
    ResetTimer;
75 daniel-mar 49 
  end;
50 
end;
51 
 
52 
procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
53 
begin
54 
  Action := caFree;
55 
end;
56 
 
57 
procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
58 
begin
59 
  CanClose := MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich schließen?', mtConfirmation, mbYesNoCancel, 0) = mrYes;
60 
end;
61 
 
62 
procedure TMDIChild.FormCreate(Sender: TObject);
63 
begin
64 
  Constraints.MinWidth := Width;
65 
  Constraints.MaxWidth := Width;
66 
  Constraints.MinHeight := Height;
67 
  Constraints.MaxHeight := Height;
68 
end;
69 
 
76 daniel-mar 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 
 
75 daniel-mar 125 
procedure TMDIChild.Timer1Timer(Sender: TObject);
126 
begin
76 daniel-mar 127 
  if TimerIsRunning then
75 daniel-mar 128 
  begin
129 
    SecondsTotal := SecondsPrev + trunc((Now - StartTime) * 24*60*60);
130 
  end
131 
  else
132 
  begin
133 
    SecondsTotal := SecondsPrev;
134 
  end;
135 
 
136 
  label1.Caption := FormatDateTime('hh:nn:ss', SecondsTotal / SecsPerDay);
137 
end;
138 
 
76 daniel-mar 139 
function TMDIChild.TimerIsRunning: boolean;
140 
begin
141 
  result := CompareValue(StartTime, 0) <> 0;
142 
end;
143 
 
75 daniel-mar 144 
end.