home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / srctt26 / timeunit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  15.2 KB  |  496 lines
  1. unit Timeunit;
  2. {----------------------------------------------------------------------
  3.    Written by Dan Statham, July/August 1995.
  4.    Copyright: Dan Statham, July 1995.
  5.    The program will keep track of the hours/minutes/seconds that
  6.    you are connected to an Internet provider or an online service.
  7. ------------------------------------------------------------------------}
  8.  
  9. interface
  10.  
  11. uses
  12.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  13.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus,
  14.   About, PreSetUn, FreeHrs, IniFiles, AnaClock, Balloon;
  15.  
  16. type
  17.   TMainForm = class(TForm)
  18.     MainMenu: TMainMenu;
  19.     FileExitItem: TMenuItem;
  20.     SpeedBar: TPanel;
  21.     Timer1: TTimer;
  22.     SpeedButton6: TSpeedButton;
  23.     Timer2: TMenuItem;
  24.     Start1: TMenuItem;
  25.     Stop1: TMenuItem;
  26.     Reset1: TMenuItem;
  27.     PreSet1: TMenuItem;
  28.     PopupMenu1: TPopupMenu;
  29.     StartStop1: TMenuItem;
  30.     Reset2: TMenuItem;
  31.     PreSet2: TMenuItem;
  32.     N1: TMenuItem;
  33.     About1: TMenuItem;
  34.     N2: TMenuItem;
  35.     Exit1: TMenuItem;
  36.     SetFree1: TMenuItem;
  37.     SetFreeHours1: TMenuItem;
  38.     Setup1: TMenuItem;
  39.     AnalogClock1: TAnalogClock;
  40.     BalloonHint1: TBalloonHint;
  41.     KeepLog1: TMenuItem;
  42.     KeepLog2: TMenuItem;
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure FileExit(Sender: TObject);
  45.     procedure Start1Click(Sender: TObject);
  46.     procedure Timer1Timer(Sender: TObject);
  47.     procedure Stop1Click(Sender: TObject);
  48.     procedure Reset1Click(Sender: TObject);
  49.     procedure HelpAboutItemClick(Sender: TObject);
  50.     procedure PreSet1Click(Sender: TObject);
  51.     procedure StartStop1Click(Sender: TObject);
  52.     procedure SetFree1Click(Sender: TObject);
  53.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  54.     procedure AnalogClock1Click(Sender: TObject);
  55.     procedure WinMsg(var Msg:TMsg; var Handled:Boolean);
  56.     procedure KeepLog (SpeedButton6 :TSpeedButton; DiffTime, MyTime :String);
  57.     procedure KeepLog1Click(Sender: TObject);
  58.   private
  59.    procedure SetMyTime (Hours, Minutes, Seconds : Integer;
  60.       Hr, Min, Sec :String; var MyTime : String);
  61.    procedure FindRealHours (var RealHours : Real);
  62.   end;
  63.  
  64. var
  65.   MainForm                                 : TMainForm;
  66.   Hours ,Minutes, Seconds                  : Integer;
  67.   StartHour, StartMinutes, StartSeconds    : Integer;
  68.   StopHour, StopMinutes, StopSeconds       : Integer;
  69.   DiffHour, DiffMinutes, DiffSeconds       : Integer;
  70.   BeginHour, BeginMinutes, BeginSeconds    : Integer;
  71.   EndHour, EndMinutes, EndSeconds          : Integer;
  72.   Hr, Min, Sec, MyTime, Hour               : String;
  73.   WarnMessage, FrHrs                       : String;
  74.   AddCostText                              : String;
  75.   BeginTime, EndTime                       : String;
  76.   DiffTime                                 : String;
  77.   NewItem                                  : String;
  78.   DiffH, DiffM, DiffS                      : String;
  79.   AdditionalCost                           : Real;
  80.   RealHours                                : Real;
  81.   TotalSeconds                             : Real;
  82.   NotShown                                 : Boolean;
  83.   MenuFlag                                 : Boolean;
  84.   KeepLogBool                              : Boolean;
  85.   hSysMenu                                 : HMenu;
  86.   Log                                      : Text;
  87. implementation
  88.  
  89. {$R *.DFM}
  90. const ItemID=99;
  91.  
  92. procedure TMainForm.FormCreate(Sender: TObject);
  93. begin
  94.   Application.OnMessage:=WinMsg;
  95.   hSysMenu := GetSystemMenu (MainForm.Handle, False);
  96.   AppendMenu (hSysMenu, MF_SEPARATOR, $A9, nil);
  97.   AppendMenu (hSysMenu, MF_STRING, ItemID, 'Start Timer');
  98.   AppendMenu (hSysMenu, MF_STRING, ItemID+1, 'About');
  99.   RealHours := 0.0;
  100.   TotalSeconds := 0;
  101.   with TIniFile.Create ('Win.Ini') do
  102.     try
  103.       Hours := ReadInteger ('OnLineTime Tracker', 'Hours', 0);
  104.       Minutes := ReadInteger ('OnLineTime Tracker', 'Minutes', 0);
  105.       Seconds := ReadInteger ('OnLineTime Tracker', 'Seconds', 0);
  106.       FreeHours := ReadInteger ('OnLineTime Tracker', 'FreeHours', 40);
  107.       WarningLevel := ReadInteger ('OnLineTime Tracker',
  108.         'WarningLevel', 90);
  109.       PerHourCost := ReadInteger ('OnLineTime Tracker', 'PerHourCost', 195);
  110.       Left  := ReadInteger ('OnLineTime Tracker', 'Left', 354);
  111.       Top  := ReadInteger ('OnLineTime Tracker', 'Top', 118);
  112.       Width := ReadInteger ('OnLineTime Tracker', 'Width', 247);
  113.       Height := ReadInteger ('OnLineTime Tracker', 'Height', 102);
  114.       KeepLogBool := ReadBool ('OnLineTime Tracker', 'KeepLog', True);
  115.     finally
  116.       Free;
  117.   end;
  118.   Timer1.Enabled := False;
  119.   SpeedButton6.Down := False;
  120.   NotShown := True;
  121.   SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
  122.   FindRealHours (RealHours);
  123.   KeepLog1.Checked := KeepLogBool;
  124. end;
  125.  
  126. procedure TMainForm.WinMsg(var Msg :TMsg; var Handled :Boolean);
  127. {From: JCIRIELL@physiology.uwo.ca
  128. Subject:       Here is a Tip for Delphi
  129. Date:          Tue, 8 Aug 1995 10:45:07 EDT}
  130. begin
  131.   if Msg.Message=WM_Syscommand then{if the message is a system one...}
  132.     if Msg.WParam = ItemID then
  133.       AnalogClock1Click (nil)
  134.   else
  135.     if msg.wparam = ItemID + 1 then
  136.       HelpAboutItemClick (nil);
  137. end;
  138.  
  139. procedure TMainForm.FindRealHours(var RealHours : Real);
  140. begin
  141.   TotalSeconds := (Hours * 36000)/10;
  142.   TotalSeconds := TotalSeconds + (Minutes * 60);
  143.   TotalSeconds := TotalSeconds + Seconds;
  144.   RealHours := TotalSeconds / 3600;
  145. end;
  146.  
  147. procedure TMainForm.FileExit(Sender: TObject);
  148. begin
  149.   Close;
  150. end;
  151.  
  152. procedure TMainForm.Start1Click(Sender: TObject);
  153. begin
  154.   AnalogClock1.FaceColor := clBtnFace;
  155.   Timer1.Enabled := True;
  156.   SpeedButton6.Down := True;
  157.   BeginTime := TimeToStr (Time);
  158.   StartHour := Hours;
  159.   StartMinutes := Minutes;
  160.   StartSeconds := Seconds;
  161.   if Length (BeginTime) = 11 then
  162.     begin
  163.       BeginHour := StrToInt(Copy (BeginTime , 1, 2));
  164.       BeginMinutes := StrToInt(Copy (BeginTime, 4, 2));
  165.       BeginSeconds := StrToInt(Copy (BeginTime, 7, 2));
  166.     end
  167.   else
  168.     if Length (BeginTime) = 10 then
  169.       begin
  170.         BeginHour := StrToInt(Copy (BeginTime , 1, 1));
  171.         BeginMinutes := StrToInt(Copy (BeginTime, 3, 2));
  172.         BeginSeconds := StrToInt(Copy (BeginTime, 6, 2));
  173.       end;
  174. end;
  175.  
  176. procedure TMainForm.KeepLog (SpeedButton6 :TSpeedButton;
  177.           DiffTime, MyTime :String);
  178. var
  179.   I  : Integer;
  180. begin
  181.   AssignFile (Log, 'TimeTrack.Log');
  182.   try
  183.     Append (Log);
  184.   except
  185.     Rewrite (Log);
  186.     WriteLn (Log, 'OnLineTime Tracker Log':46);
  187.     WriteLn (Log, '~~~~~~~~~~~~~~~~~~~~~~':46);
  188.     WriteLn (Log, 'Connected at':13, 'Disconnected at':24,
  189.       'Connected Time':20, 'Total Time':13);
  190.     for I := 1 to 69 do
  191.       Write (Log, '~');
  192.     WriteLn (Log, '~');
  193.   end;
  194.   if SpeedButton6.Down then
  195.     Write (Log, DateTimeToStr (Now):19)
  196.   else
  197.     WriteLn (Log, DateTimeToStr (Now):21, DiffTime:11, MyTime:17);
  198.   CloseFile (Log);
  199. end;
  200.  
  201. procedure TMainForm.Timer1Timer(Sender: TObject);
  202. var
  203.   RealFreeHours, RealPerHourCost, TimeOver   : Real;
  204. begin
  205.   Inc (Seconds);
  206.   if Seconds = 60 then
  207.     begin
  208.       Seconds := 0;
  209.       Inc (Minutes);
  210.     end;
  211.   if Minutes = 60 then
  212.     begin
  213.       Minutes := 0;
  214.       Inc (Hours);
  215.     end;
  216.   RealHours := RealHours + 0.0002777777;
  217.   if FreeHours > 0 then
  218.     begin
  219.       if Hours >= FreeHours then
  220.         begin
  221.           RealFreeHours := FreeHours;
  222.           RealPerHourCost := PerHourCost;
  223.           TimeOver :=RealHours - FreeHours;
  224.           AdditionalCost := TimeOver *
  225.             (RealPerHourCost / 100);
  226.  
  227.           Str (AdditionalCost:5:2, AddCostText);
  228.  
  229.         end;
  230.       if (Hours >= FreeHours) and NotShown then
  231.         begin
  232.           NotShown := False;
  233.           Hour := IntToStr (Hours);
  234.           FrHrs := IntToStr (FreeHours);
  235.           MessageBeep (48);
  236.           WarnMessage := 'You have used up your '+ FrHrs +
  237.              ' "free" hours!  Watch the title '+
  238.              'bar to see your additional cost add up!';
  239.           MessageDlg (WarnMessage, mtWarning, [mbOK], 0);
  240.         end
  241.       else if (Hours >= (FreeHours * WarningLevel div 100))
  242.         and (NotShown) then
  243.         begin
  244.           NotShown := False;
  245.           Hour := IntToStr (Hours);
  246.           FrHrs := IntToStr (FreeHours);
  247.           MessageBeep (48);
  248.           WarnMessage := Hour + ' hours of your '+ FrHrs +
  249.              ' "free" hours have already been used up!';
  250.           MessageDlg (WarnMessage, mtWarning, [mbOK], 0);
  251.         end;
  252.     end;
  253.   SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
  254. end;
  255.  
  256. procedure TMainForm.SetMyTime (Hours, Minutes, Seconds : Integer;
  257.   Hr, Min, Sec :String; var MyTime : String);
  258. begin
  259.   Hr := IntToStr (Hours);
  260.   if Length(Hr) = 1 then
  261.     Hr := '0' + Hr;
  262.   Min := IntToStr (Minutes);
  263.   if Length (Min) = 1 then
  264.     Min := '0' + Min;
  265.   Sec := IntToStr (Seconds);
  266.   if Length (Sec) = 1 then
  267.     Sec := '0' + Sec;
  268.   if FreeHours > 0 then
  269.     if Hours >= FreeHours then
  270.       MyTime := Hr + ':' + Min + ':' + Sec +  ' $$' + AddCostText
  271.     else
  272.       MyTime := Hr + ':' + Min + ':' + Sec
  273.   else
  274.       MyTime := Hr + ':' + Min + ':' + Sec;
  275.   MainForm.Caption := MyTime;
  276. end;
  277.  
  278. procedure TMainForm.Stop1Click(Sender: TObject);
  279. begin
  280.   AnalogClock1.FaceColor := clAqua;
  281.   Timer1.Enabled := False;
  282.   SpeedButton6.Down := False;
  283.   NotShown := True;
  284.   AddCostText := '';
  285.   EndTime := TimeToStr (Time);
  286.   if Length (EndTime) = 11 then
  287.     begin
  288.       EndHour := StrToInt(Copy (EndTime , 1, 2));
  289.       EndMinutes := StrToInt(Copy (EndTime, 4, 2));
  290.       EndSeconds := StrToInt(Copy (EndTime, 7, 2));
  291.     end
  292.   else
  293.     if Length (EndTime) = 10 then
  294.       begin
  295.         EndHour := StrToInt(Copy (EndTime , 1, 1));
  296.         EndMinutes := StrToInt(Copy (EndTime, 3, 2));
  297.         EndSeconds := StrToInt(Copy (EndTime, 6, 2));
  298.       end;
  299.  
  300.   if EndHour < BeginHour then
  301.     DiffHour := (12 - BeginHour) + EndHour
  302.   else
  303.     DiffHour := EndHour - BeginHour;
  304.  
  305.   if EndMinutes < BeginMinutes then
  306.     begin
  307.       DiffMinutes := EndMinutes + (60 - BeginMinutes);
  308.       DiffHour := DiffHour -1;
  309.     end
  310.   else if EndMinutes >= BeginMinutes then
  311.     DiffMinutes := EndMinutes - BeginMinutes ;
  312.  
  313.   if EndSeconds < BeginSeconds then
  314.     begin
  315.       DiffSeconds := EndSeconds + (60 - BeginSeconds);
  316.       DiffMinutes := DiffMinutes -1;
  317.     end
  318.   else if EndSeconds >= BeginSeconds then
  319.     DiffSeconds := EndSeconds - BeginSeconds;
  320.  
  321.   Hours := StartHour + DiffHour;
  322.   Minutes := StartMinutes + DiffMinutes;
  323.   Seconds := StartSeconds + DiffSeconds;
  324.   DiffH := IntToStr (DiffHour);
  325.   if DiffHour < 10 then
  326.     DiffH := '0' + DiffH;
  327.   DiffM := IntToStr (DiffMinutes);
  328.   if DiffMinutes < 10 then
  329.     DiffM := '0' + DiffM;
  330.   DiffS := IntToStr (DIffSeconds);
  331.   if DiffSeconds < 10 then
  332.     DiffS := '0' + DiffS;
  333.  
  334.  
  335.   DiffTime := DiffH + ':' + DiffM + ':' + DiffS;
  336.   if Seconds >= 60 then
  337.     begin
  338.       Seconds := Seconds - 60;
  339.       Minutes := Minutes + 1;
  340.     end;
  341.   if Minutes >= 60 then
  342.     begin
  343.       Minutes := Minutes - 60;
  344.       Hours := Hours + 1;
  345.     end;
  346.   SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
  347.   with TIniFile.Create ('Win.Ini') do
  348.     try
  349.       WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
  350.       WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
  351.       WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
  352.       WriteInteger ('OnLineTime Tracker', 'FreeHours', FreeHours);
  353.       WriteInteger ('OnLineTime Tracker',
  354.         'WarningLevel', WarningLevel);
  355.     finally
  356.       Free;
  357.   end;
  358. end;
  359.  
  360. procedure TMainForm.Reset1Click(Sender: TObject);
  361. begin
  362.   MessageBeep (32);
  363.   if MessageDlg ('Reset your time to 00:00:00?',
  364.     mtConfirmation, mbOKCancel, 0) = mrOK then
  365.       begin
  366.         Hours := 0;
  367.         Minutes := 0;
  368.         Seconds := 0;
  369.         SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
  370.         with TIniFile.Create ('Win.Ini') do
  371.           try
  372.             WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
  373.             WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
  374.             WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
  375.           finally
  376.             Free;
  377.         end;
  378.   end;
  379. end;
  380.  
  381. procedure TMainForm.HelpAboutItemClick (Sender: TObject);
  382. begin
  383.   AboutBox := TAboutBox.Create (Self);
  384.   AboutBox.ShowModal;
  385.   AboutBox.Free;
  386. end;
  387.  
  388. procedure TMainForm.PreSet1Click(Sender: TObject);
  389. begin
  390.   BtnRightDlg := TBtnRightDlg.Create (Self);
  391.   BtnRightDlg.ShowModal;
  392.     if BtnRightDlg.ModalResult = mrOK then
  393.       begin
  394.         Hours := Hrs;
  395.         Minutes := Mins;
  396.         Seconds := Secs;
  397.         SetMyTime (Hours, Minutes, Seconds, Hr, Min, Sec, MyTime);
  398.         with TIniFile.Create ('Win.Ini') do
  399.           try
  400.             WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
  401.             WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
  402.             WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
  403.           finally
  404.             Free;
  405.           end;
  406.       end;
  407.   BtnRightDlg.Free;
  408. end;
  409.  
  410. procedure TMainForm.StartStop1Click(Sender: TObject);
  411. begin
  412.     if not SpeedButton6.Down then
  413.       begin
  414.         Start1.Click;
  415.         SpeedButton6.Down := True;
  416.       end
  417.   else
  418.     begin
  419.       Stop1.Click;
  420.       SpeedButton6.Down := false;
  421.     end;
  422.   if KeepLog1.Checked then
  423.     KeepLog (SpeedButton6, DiffTime, MyTime);
  424.  
  425. end;
  426.  
  427. procedure TMainForm.SetFree1Click(Sender: TObject);
  428. begin
  429.    FreeHoursDlg := TBtnBottomDlg.Create (Self);
  430.    FreeHoursDlg.ShowModal;
  431.    FreeHoursDlg.Free;
  432. end;
  433.  
  434. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  435. begin
  436.   with TIniFile.Create ('Win.Ini') do
  437.     try
  438.       WriteInteger ('OnLineTime Tracker', 'Hours', Hours);
  439.       WriteInteger ('OnLineTime Tracker', 'Minutes', Minutes);
  440.       WriteInteger ('OnLineTime Tracker', 'Seconds', Seconds);
  441.       WriteInteger ('OnLineTime Tracker', 'FreeHours', FreeHours);
  442.       WriteInteger ('OnLineTime Tracker',
  443.         'WarningLevel', WarningLevel);
  444.       WriteInteger ('OnLineTime Tracker', 'PerHourCost', PerHourCost);
  445.       WriteInteger ('OnLineTime Tracker', 'Left', Left);
  446.       WriteInteger ('OnLineTime Tracker', 'Top', Top);
  447.       WriteInteger ('OnLineTime Tracker', 'Width', Width);
  448.       WriteInteger ('OnLineTime Tracker', 'Height', Height);
  449.       WriteBool ('OnLineTime Tracker', 'KeepLog', KeepLogBool);
  450.     finally
  451.       Free;
  452.   end;
  453. end;
  454.  
  455. procedure TMainForm.AnalogClock1Click;
  456. begin
  457.   MenuFlag := not MenuFlag;
  458.   if not MenuFlag then
  459.     begin
  460.       DeleteMenu (hSysMenu, ItemID, MF_BYCOMMAND);
  461.       InsertMenu (hSysMenu, ItemID + 1, MF_STRING, ItemID, 'Stop Timer');
  462.     end
  463.   else
  464.     begin
  465.       DeleteMenu (hSysMenu, ItemID, MF_BYCOMMAND);
  466.       InsertMenu (hSysMenu, ItemID + 1, MF_STRING, ItemID, 'Start Timer');
  467.     end;
  468.  
  469.   if not SpeedButton6.Down then
  470.     begin
  471.       Start1.Click;
  472.       SpeedButton6.Down := True;
  473.     end
  474.   else
  475.     begin
  476.       Stop1.Click;
  477.       SpeedButton6.Down := False;
  478.     end;
  479.  if KeepLog1.Checked then
  480.     KeepLog (SpeedButton6, DiffTime, MyTime);
  481. end;
  482.  
  483. procedure TMainForm.KeepLog1Click(Sender: TObject);
  484. begin
  485.   if not SpeedButton6.Down then
  486.     begin
  487.       KeepLog1.Checked := not KeepLog1.Checked;
  488.       KeepLogBool := KeepLog1.Checked;
  489.     end;
  490. end;
  491.  
  492. initialization
  493.   MenuFlag := True;
  494.  
  495. end.
  496.