Subversion Repositories delphiutils

Rev

Rev 75 | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 75 Rev 76
Line 19... Line 19...
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
Line 81... Line 65...
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
Line 95... Line 134...
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;
99 
 
 138 
 
- 
 
 139 
function TMDIChild.TimerIsRunning: boolean;
- 
 
 140 
begin
- 
 
 141 
  result := CompareValue(StartTime, 0) <> 0;
- 
 
 142 
end;
- 
 
 143 
 
100 
end.
 144 
end.