Subversion Repositories delphiutils

Rev

Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  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;
  24.   end;
  25.  
  26. implementation
  27.  
  28. {$R *.dfm}
  29.  
  30. uses
  31.   DateUtils, Math;
  32.  
  33. procedure TMDIChild.Button1Click(Sender: TObject);
  34. 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.     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;
  50.  
  51. procedure TMDIChild.Button2Click(Sender: TObject);
  52. begin
  53.   if MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich resetten?', mtConfirmation, mbYesNoCancel, 0) = mrYes then
  54.   begin
  55.     if CompareValue(StartTime, 0) <> 0 then
  56.     begin
  57.       // Es läuft. Starte neu
  58.       StartTime := Now;
  59.     end
  60.     else
  61.     begin
  62.       // Es läuft nicht. Resette Zeit
  63.       SecondsPrev := 0;
  64.     end;
  65.   end;
  66. end;
  67.  
  68. procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
  69. begin
  70.   Action := caFree;
  71. end;
  72.  
  73. procedure TMDIChild.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  74. begin
  75.   CanClose := MessageDlg('Stoppuhr ' + Trim(Memo1.Lines.Text) + ' wirklich schließen?', mtConfirmation, mbYesNoCancel, 0) = mrYes;
  76. end;
  77.  
  78. procedure TMDIChild.FormCreate(Sender: TObject);
  79. begin
  80.   Constraints.MinWidth := Width;
  81.   Constraints.MaxWidth := Width;
  82.   Constraints.MinHeight := Height;
  83.   Constraints.MaxHeight := Height;
  84. end;
  85.  
  86. procedure TMDIChild.Timer1Timer(Sender: TObject);
  87. begin
  88.   if CompareValue(StartTime, 0) <> 0 then
  89.   begin
  90.     SecondsTotal := SecondsPrev + trunc((Now - StartTime) * 24*60*60);
  91.   end
  92.   else
  93.   begin
  94.     SecondsTotal := SecondsPrev;
  95.   end;
  96.  
  97.   label1.Caption := FormatDateTime('hh:nn:ss', SecondsTotal / SecsPerDay);
  98. end;
  99.  
  100. end.
  101.