home *** CD-ROM | disk | FTP | other *** search
/ Macmaailma Vuosikerta 1994 to 1996 / TK1996_3CD.ISO / pc / k_portti / tk0895 / ajastlom.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-02  |  7KB  |  269 lines
  1. unit Ajastlom;
  2.  
  3. { Freeware, programmed by Antti Wiio }
  4.  
  5. interface
  6.  
  7. uses
  8.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  9.   Forms, Dialogs, StdCtrls, Spin, ExtCtrls, Mask;
  10.  
  11. type
  12.   TAjastinlomake = class(TForm)
  13.     ajastin: TTimer;
  14.     edTosiaika: TEdit;
  15.     Label1: TLabel;
  16.     halyAikaLbl: TLabel;
  17.     Shape1: TShape;
  18.     halyKloLbl: TLabel;
  19.     halyKloMMBtn: TSpinButton;
  20.     halyKloSSBtn: TSpinButton;
  21.     halyKloTTBtn: TSpinButton;
  22.     aikaMMBtn: TSpinButton;
  23.     AikaSSBtn: TSpinButton;
  24.     aikaTTBtn: TSpinButton;
  25.     kaynnistaBtn: TButton;
  26.     keskeytaBtn: TButton;
  27.     Panel1: TPanel;
  28.     suljeBtn: TButton;
  29.     aanimerkkiajastin: TTimer;
  30.     kuittausBtn: TButton;
  31.     Label2: TLabel;
  32.     Label3: TLabel;
  33.     edAikaHalytykseen: TEdit;
  34.     edHalytysKellonaika: TEdit;
  35.     procedure ajastinTimer(Sender: TObject);
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure aikaTTBtnDownClick(Sender: TObject);
  38.     procedure aikaTTBtnUpClick(Sender: TObject);
  39.     procedure aikaMMBtnDownClick(Sender: TObject);
  40.     procedure aikaMMBtnUpClick(Sender: TObject);
  41.     procedure AikaSSBtnDownClick(Sender: TObject);
  42.     procedure AikaSSBtnUpClick(Sender: TObject);
  43.     procedure halyKloTTBtnDownClick(Sender: TObject);
  44.     procedure halyKloMMBtnDownClick(Sender: TObject);
  45.     procedure halyKloTTBtnUpClick(Sender: TObject);
  46.     procedure halyKloMMBtnUpClick(Sender: TObject);
  47.     procedure halyKloSSBtnDownClick(Sender: TObject);
  48.     procedure halyKloSSBtnUpClick(Sender: TObject);
  49.     procedure suljeBtnClick(Sender: TObject);
  50.     procedure kaynnistaBtnClick(Sender: TObject);
  51.     procedure keskeytaBtnClick(Sender: TObject);
  52.     procedure kuittausBtnClick(Sender: TObject);
  53.     procedure aanimerkkiajastinTimer(Sender: TObject);
  54.   private
  55.     { Private declarations }
  56.   public
  57.     { Public declarations }
  58.   end;
  59.  
  60. var
  61.   Ajastinlomake: TAjastinlomake;
  62.  
  63. implementation
  64.  
  65. {$R *.DFM}
  66.  
  67. const sound = word(-1);
  68.  
  69. type
  70.   ajanyksikko  = ( sekunti, minuutti, tunti );
  71.   muutossuunta = ( eteen, taakse );
  72.   tilatieto    = ( asetus, ajastus, halytys );
  73.  
  74. var tila: tilatieto;
  75.     tosiAika, halytysKellonAika, aikaHalytykseen: TDateTime;
  76.  
  77. procedure naytaKellonajat; { Asetetaan kellonajat lomakkeella }
  78. begin
  79.   with ajastinlomake do begin
  80.     edTosiaika.text          := timeToStr( tosiaika          );
  81.     edAikaHalytykseen.text   := timeToStr( aikaHalytykseen   );
  82.     edHalytysKellonaika.text := timeToStr( halytysKellonAika );
  83.   end;
  84. end;
  85.  
  86. procedure muutaAika( Var aika: TdateTime; yksikko: ajanyksikko;
  87.                          suunta: muutosSuunta; maara:integer );
  88. var etumerkki: integer;
  89. begin
  90.   if suunta = eteen then etumerkki := 1 else etumerkki := -1;
  91.   case yksikko of
  92.     sekunti : aika := aika + strToTime('00.00.01') * maara * etumerkki;
  93.     minuutti: aika := aika + strToTime('00.01.00') * maara * etumerkki;
  94.     tunti   : aika := aika + strToTime('01.00.00') * maara * etumerkki;
  95.   end;
  96. end;
  97.  
  98.  
  99. procedure paivitaHalytysKellonAika;
  100. var aika: TDatetime;
  101. begin
  102.   halytysKellonAika := tosiaika + aikaHalytykseen;
  103.   naytaKellonajat;
  104. end;
  105.  
  106. procedure paivitaAikaHalytykseen;
  107. begin
  108.   aikaHalytykseen := halytysKellonaika - tosiaika;
  109.   naytaKellonajat;
  110. end;
  111.  
  112. procedure asetaAikapainikkeet( aukiko: boolean );
  113.  
  114. { Avataan tai suljetaan ajanasetuspainikkeet }
  115.  
  116. begin
  117.   with ajastinlomake do
  118.     begin
  119.       halyKloTTBtn.enabled := aukiko;
  120.       halyKloMMBtn.enabled := aukiko;
  121.       halyKloSSBtn.enabled := aukiko;
  122.       aikaTTBtn.enabled := aukiko;
  123.       aikaMMBtn.enabled := aukiko;
  124.       aikaSSBtn.enabled := aukiko;
  125.     end;
  126. end;
  127.  
  128. procedure TAjastinlomake.ajastinTimer(Sender: TObject);
  129. begin
  130.   tosiAika := now;
  131.   if halytysKellonaika < tosiaika
  132.     then halytysKellonAika := tosiaika;
  133.   paivitaAikaHalytykseen;
  134.  
  135.   if tila = halytys then exit;
  136.  
  137.   if (tila = ajastus) and
  138.      (edHalytysKellonAika.text = edTosiAika.text) then
  139.     begin
  140.       aanimerkkiajastin.enabled := true;
  141.       kuittausBtn.enabled := true;
  142.       keskeytaBtn.enabled := false;
  143.       tila := halytys;
  144.       messageBeep( sound );
  145.     end;
  146. end;
  147.  
  148. procedure TAjastinlomake.FormCreate(Sender: TObject);
  149. begin
  150.   tosiaika := now;
  151.   aikaHalytykseen := strToTime( '00.00.00' );
  152.   paivitaHalytysKellonaika;
  153.   keskeytaBtn.enabled := false;
  154.   kuittausBtn.enabled := false;
  155. end;
  156.  
  157. procedure TAjastinlomake.aikaTTBtnDownClick(Sender: TObject);
  158. begin
  159.   if aikaHalytykseen < strToTime( '01.00.00' ) then exit;
  160.   muutaAika( aikahalytykseen, tunti, taakse, 1 );
  161.   paivitaHalytysKellonaika;
  162. end;
  163.  
  164. procedure TAjastinlomake.aikaTTBtnUpClick(Sender: TObject);
  165. begin
  166.   muutaAika( aikahalytykseen, tunti, eteen, 1  );
  167.   paivitaHalytysKellonaika;
  168. end;
  169.  
  170. procedure TAjastinlomake.aikaMMBtnDownClick(Sender: TObject);
  171. begin
  172.   if aikaHalytykseen < strToTime( '00.01.00' ) then exit;
  173.   muutaAika( aikahalytykseen, minuutti, taakse, 1  );
  174.   paivitaHalytysKellonaika;
  175. end;
  176.  
  177. procedure TAjastinlomake.aikaMMBtnUpClick(Sender: TObject);
  178. begin
  179.   muutaAika( aikahalytykseen, minuutti, eteen, 1  );
  180.   paivitaHalytysKellonaika;
  181. end;
  182.  
  183. procedure TAjastinlomake.AikaSSBtnDownClick(Sender: TObject);
  184. begin
  185.   if aikaHalytykseen < strToTime( '00.00.01' ) then exit;
  186.   muutaAika( aikahalytykseen, sekunti, taakse, 1  );
  187.   paivitaHalytysKellonaika;
  188. end;
  189.  
  190. procedure TAjastinlomake.AikaSSBtnUpClick(Sender: TObject);
  191. begin
  192.   muutaAika( aikahalytykseen, sekunti, eteen, 1  );
  193.   paivitaHalytysKellonaika;
  194. end;
  195.  
  196. procedure TAjastinlomake.halyKloTTBtnDownClick(Sender: TObject);
  197. begin
  198.   if halytysKellonaika < tosiaika + strToTime( '01.00.00' ) then exit;
  199.   muutaAika( halytysKellonaika, tunti, taakse, 1 );
  200.   paivitaAikaHalytykseen;
  201. end;
  202.  
  203. procedure TAjastinlomake.halyKloTTBtnUpClick(Sender: TObject);
  204. begin
  205.   muutaAika( halytysKellonaika, tunti, eteen, 1  );
  206.   paivitaAikaHalytykseen;
  207. end;
  208.  
  209. procedure TAjastinlomake.halyKloMMBtnDownClick(Sender: TObject);
  210. begin
  211.   if halytysKellonaika < tosiaika + strToTime( '00.01.00' ) then exit;
  212.   muutaAika( halytysKellonaika, minuutti, taakse, 1 );
  213.   paivitaAikaHalytykseen;
  214. end;
  215.  
  216. procedure TAjastinlomake.halyKloMMBtnUpClick(Sender: TObject);
  217. begin
  218.   muutaAika( halytysKellonaika, minuutti, eteen, 1  );
  219.   paivitaAikaHalytykseen;
  220. end;
  221.  
  222. procedure TAjastinlomake.halyKloSSBtnDownClick(Sender: TObject);
  223. begin
  224.   if halytysKellonaika < tosiaika + strToTime( '00.00.01' ) then exit;
  225.   muutaAika( halytysKellonaika,sekunti, taakse, 1  );
  226.   paivitaAikaHalytykseen;
  227. end;
  228.  
  229. procedure TAjastinlomake.halyKloSSBtnUpClick(Sender: TObject);
  230. begin
  231.   muutaAika( halytysKellonaika, sekunti, eteen, 1  );
  232.   paivitaAikaHalytykseen;
  233. end;
  234.  
  235. procedure TAjastinlomake.suljeBtnClick(Sender: TObject);
  236. begin
  237.   close;
  238. end;
  239.  
  240. procedure TAjastinlomake.kaynnistaBtnClick(Sender: TObject);
  241. begin
  242.   tila := ajastus;
  243.   kaynnistaBtn.enabled := false;
  244.   keskeytaBtn. enabled := true;
  245. end;
  246.  
  247. procedure TAjastinlomake.keskeytaBtnClick(Sender: TObject);
  248. begin
  249.   tila := asetus;
  250.   kaynnistaBtn.enabled := true;
  251.   keskeytaBtn. enabled := false;
  252. end;
  253.  
  254. procedure TAjastinlomake.kuittausBtnClick(Sender: TObject);
  255. begin
  256.   tila := asetus;
  257.   kaynnistaBtn.enabled := true;
  258.   keskeytaBtn. enabled := false;
  259.   kuittausBtn. enabled := false;
  260.   aanimerkkiAjastin.enabled := false;
  261. end;
  262.  
  263. procedure TAjastinlomake.aanimerkkiajastinTimer(Sender: TObject);
  264. begin
  265.    messageBeep( sound );
  266. end;
  267.  
  268. end.
  269.