Proj_Log - the program sources

globe

mailto:john.hysted@btinternet.com


 
Home

John's Freeware

Proj_Log

This is here for search engines. If you want the sources then download the program, the Delphi sources are there as .pas, .dpr, .dfm, .res files. This is not the current source.

program Proj_Log;

uses
  Forms,
  Windows,
  SysUtils,
  Messages,
  maincode in 'maincode.pas' {MainForm},
  aboutcode in 'aboutcode.pas' {AboutForm},
  showlogcode in 'showlogcode.pas' {ShowLogForm},
  optionscode in 'optionscode.pas' {OptionsForm},
  rescode in 'rescode.pas' {resdata: TDataModule},
  addprojcode in 'addprojcode.pas' {AddProjForm},
  osdcode in 'osdcode.pas' {OSDForm};

{$R *.RES}
var
  Mutex : THandle;

var
  MyAppName   : Array[0..255] of Char;
  MyClassName : Array[0..255] of Char;
  MyHandle    : HWnd;
  NumFound    : Integer;
  PrevInstWnd : HWnd;
  MyPopup     : HWnd;

{------------------------------------------------------------------------------}
{ This code is known to be flaky as getwindowtext asks the window itself for   }
{ its title and hung applications will fail to respond , but we only call it   }
{ for Classname = TApplication, so we don't hit all the windows, just a few    }
{ and only if there is one of us running already, but thats when the system    }
{ is probably hung anyway                                                      }
{------------------------------------------------------------------------------}

function LookAtAllWindows(Handle: HWND; Temp: LongInt): BOOL; stdcall;
var
  WindowName : Array[0..255] of Char;
  ClassName  : Array[0..255] of Char;
begin
  // Go get the windows class name
  if GetClassName(Handle,ClassName,SizeOf(ClassName)) > 0 then
    // Is the window class the same?
    if StrComp(ClassName,MyClassName) = 0 then
      // Get its window caption
      if GetWindowText(Handle,WindowName,SizeOf(WindowName)) > 0 then
        // Does this have the same window title?
        if StrComp(strupper(WindowName),strupper(MyAppName))=0 then
          begin
            inc(NumFound);
            if (handle <> MyHandle) then
               PrevInstWnd:=Handle;
          end;
  LookAtAllWindows:=true;
end;


begin
  Mutex := CreateMutex(nil, True, 'Prog_Log_Mutex');
  if (Mutex = 0) OR (GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      // First, determine what this application's title bar looks like
      GetWindowText(Application.Handle,MyAppName,SizeOf(MyAppName));
      // Now determine the class name for this application
      GetClassName(Application.Handle,MyClassName,SizeOf(MyClassName));
      // Now record what I am
      MyHandle:=Application.Handle;
      // Now count how many others out there are Delphi apps with this title
      EnumWindows(@LookAtAllWindows,0);
      //actually lets push it forward so we can see it
      MyPopup := GetLastActivePopup(PrevInstWnd);
      // Bring it to the top in the ZOrder
      BringWindowToTop(PrevInstWnd);
      // we know we respond to a double click on the tray icon
      PostMessage(PrevInstWnd, WM_USER+1, 0, WM_LBUTTONDBLCLK);
      PostMessage(Mypopup, WM_USER+1, 0, WM_LBUTTONDBLCLK);
      // Is the window iconized?
      if IsIconic(MyPopup) then
        // Restore it to its original position
        ShowWindow(MyPopup,SW_SHOW)         //or SH_Show?
      else
        // Bring it to the front
        SetForegroundWindow(MyPopup);
    end
  else
    // None running - allow this instance to continue
    begin
      // This is the code that normally would be in the project source
      // Let delphi handle this - keep its lines formatting the same

  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TAboutForm, AboutForm);
  Application.CreateForm(TShowLogForm, ShowLogForm);
  Application.CreateForm(TOptionsForm, OptionsForm);
  Application.CreateForm(TAddProjForm, AddProjForm);
  Application.CreateForm(TOSDForm, OSDForm);
  Application.Run;

      if Mutex <> 0 then
        CloseHandle(Mutex);

    end;
end.

unit maincode;

// MEMO
//             When creating a new version
//              - change the versioninfo in Project/ options
//              - change the date in the About dialog
//              - change version History in the help file and rebuild it
//              - freshen the files in the source zip file
//		- recompile help files
//              - build installshield package
{file format}
{Date at end, Time at end, Elapsed Time, project code, project name  }

{this program uses}
{Colorbutton}
{a modified version of janArrayButton}
{SortGrid}

{------------------------------------------------------------------------------}
{Started 28 November 2004                                                      }
{12/12/04 First Workable Version                                         1.0.2 }
{12/12/04 use strtotime when reading the log in showlog.handleonerecord  1.0.3 }
{12/12/04 add new Edit_Project_File button and move rebuild of data      1.0.3 }
{12/12/04 fixed copy to clipboard spurious characters                    1.0.3 }
{13/12/04 Change option field width defaults to 10,5,8,7                 1.0.3 }
{13/12/04 Change empty report line to be blank                           1.0.3 }
{13/12/04 Select the Grand Total box on the report                       1.0.3 }
{13/12/04 Funny how Monday was always zero on the report (bugs)          1.0.3 }
{13/12/04 Increase min report row height from 20 to 24                   1.0.3 }
{13/12/04 Add MouseLeave and auto justify left Code to janArrayButton    1.0.3 }
{14/12/04 Tick the current menu item                                     1.0.4 }
{14/12/04 Colour the icon in AddIcon                                     1.0.4 }
{14/12/04 AddProjForm - allow OK to exit if both boxes are blank         1.0.4 }
{14/12/04 No Code items did not get an RHS total in Report               1.0.4 }
{14/12/04 Remove Keybd Shortcuts on buttons on MainForm, add menu        1.0.4 }
{14/12/04 Introduce Rounding on report form and new HH:MM:SS choice      1.0.4 }
{14/12/04 New Edit Log button on Report form                             1.0.4 }
{14/12/04 Hide popup menu when rebuilding - it looked weird              1.0.4 }
{14/12/04 Put Panel behind mainform to show menu is a menu               1.0.4 }
{14/12/04 Adjust main window size so XP doesn't object                   1.0.5 }
{14/12/04 Modify colorbutton so that button is always down, looks better 1.0.5 }
{15/12/04 JanArrayButton - button stays down                             1.0.5 }
{15/12/04 JanArrayButton - button reverts if no mouse up                 1.0.5 }
{15/12/04 JanArrayButton - temp hack to get button to follow the mouse   1.0.5 }
{15/12/04 Design - Mainform, slight overlap of buttons and scrollbar     1.0.6 }
{19/12/04 Incorporate OSD                                                1.0.6 }
{20/12/04 Fix report include/exclude, use timeval as is, dont divide it  1.0.7 }
{21/12/04 Use MoveWindow rather than Top=,Left= when changing both       1.0.7 }
{21/12/04 Hide/Show taskbar button consistently                          1.0.7 }
{21/12/04 Put frame round OSD, but it is trashed by paint?               1.0.7 }
{22/12/04 Introduce *= and the spread concept                            1.0.7 }
{22/12/04 Put a matching border round the OSD to add contrast            1.0.8 }
{22/12/04 positions were out by one, became obvious once bordered        1.0.8 }
{23/12/04 change one-at-a-time code to use a mutex                       1.0.8 }
{23/12/04 set 66% opaque transparency on XP for the OSD                  1.0.8 }
{23/12/04 set 75% opaque transparency on XP for the OSD                  1.0.8 }
{28/12/04 play around with format of show log                            1.0.9 }
{30/12/04 move more strings into resources                               1.0.9 }

{-----------------------------------------------------------------------------}
{bugs}


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus, ShellAPI, ExtCtrls, janArrayButton,
  ColorButton, Grids;

type
  TMainForm = class(TForm)
    ShowLog_but: TButton;
    MF_RichEdit: TRichEdit;
    MainTimer: TTimer;
    Hide_but: TButton;
    Exit_but: TButton;
    About_but: TButton;
    Options_but: TButton;
    PopupMenu1: TPopupMenu;
    PMI_Restore: TMenuItem;
    PMI_About: TMenuItem;
    Help_but: TButton;
    session_mem: TColorButton;
    Button_ScrollBar: TScrollBar;
    AddProj_but: TButton;
    MainMenu1: TMainMenu;
    file1: TMenuItem;
    Exit1: TMenuItem;
    Options1: TMenuItem;
    Report1: TMenuItem;
    AddProject1: TMenuItem;
    Help1: TMenuItem;
    Contents1: TMenuItem;
    Contents2: TMenuItem;
    Panel1: TPanel;
    ArrayOfButtons: TjanArrayButton;
    procedure PMI_RestoreClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MainTimerTimer(Sender: TObject);
    procedure ShowLog_butClick(Sender: TObject);
    procedure Options_butClick(Sender: TObject);
    procedure About_butClick(Sender: TObject);
    procedure Hide_butClick(Sender: TObject);
    procedure Exit_butClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Help_butClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ArrayOfButtonsArrayButtonClicked(acol, arow: Integer);
    procedure Button_ScrollBarChange(Sender: TObject);
    procedure AddProj_butClick(Sender: TObject);
  private
    { Private declarations }
     procedure WndProc (Var Msg :TMessage) ; override;
     function ForScreen(logstring:string;ld,lt,le,lc:integer):string;
  public
    { Public declarations }
    procedure AddIcon;
    procedure BuildMenu;
    procedure BuildButtons;
    procedure Close_Cleanup;
    procedure PopupProjClick(Sender: TObject);
    procedure ReBuildProjectList;
    procedure ShowLast12;
    procedure ToggleRightButton;
  end;


var
  MainForm : TMainForm;
  Icondata : TNotifyIconData;
  {most variables are in the rescode unit}

  LogFile : TextFile;
  RcvFile : TextFile;
  ProjFile : TextFile;

  StartTicks : longint;
  LastRcvWriteTicks : longint;
  WarnTicks : longint;


  Warned: boolean;
  buttonbase : integer;
  s_uTaskbarRestart : longint;
  MF_clientwidth, AB_Width, AB_Left, BSB_Left, MF_Height : integer;

  AutoAsk : boolean;

implementation

uses aboutcode, showlogcode, optionscode, rescode,  mmsystem, addprojcode,
  osdcode;

{$R *.DFM}

{------------------------------------------------------------------------------}
{  writing to the log - this is what we are here for  }
{------------------------------------------------------------------------------}
procedure WriteLogEntry(secs : integer; what : string);
var  LogEntry    : string [255];
var  LogEntryVis : string [255];
begin
   LogEntry := DateToStr(Date) + ','
             + TimeToStr(Time) + ','
             + resdata.toHHMMSS(secs)  + ','
             + strpas(WhatProjectcode)   + ','
             + what;
   {$I-}
   AssignFile (LogFile, Resdata.Log_File_Name);
   Append (LogFile);
   if IOResult<>0 then
   begin
     Rewrite (LogFile);
     if IOResult<>0 then
     begin
       MessageDlg(msg_log_io, mtWarning, [mbOK], 0);
       Exit;
     end;
     MainForm.MF_RichEdit.lines.add(msg_create);
     if (MainForm.MF_RichEdit.lines.count) > LinesVisible then
       MainForm.MF_RichEdit.Perform(EM_SCROLL,SB_LINEDOWN,0);
   end;
   Writeln(LogFile, LogEntry);          {this is where we write to the log}
   CloseFile(LogFile);   {it will always be open at this stage}
  {$I+}
   LogEntryVis := Mainform.ForScreen(LogEntry,
                                    Resdata.Date_Chars,
                                    Resdata.Time_Chars,
                                    Resdata.Elap_Chars,
                                    Resdata.Proj_Chars);
   MainForm.MF_RichEdit.lines.add(LogEntryVis);
   if (MainForm.MF_RichEdit.lines.count) > LinesVisible then
     MainForm.MF_RichEdit.Perform(EM_SCROLL,SB_LINEDOWN,0);
   if ShowLogForm.SL_RichEdit.Visible then           {keep in step}
   begin
     If Resdata.ShowLogRaw then
       ShowLogForm.SL_RichEdit.lines.add(LogEntry)
     else
       ShowLogForm.SL_RichEdit.lines.add(LogEntryVis);
     ShowLogForm.SL_RichEdit.Perform(EM_SCROLL,SB_LINEDOWN,0);
   end;
   {else we need to update the report ?}
end;
{------------------------------------------------------------------------------}
{ the rcv log is used in case the machine crashes, it records what we were }
{ doing so that it can be written into the log when we restart }
{------------------------------------------------------------------------------}
procedure WriteRcvLogEntry(secs : integer; what : string);
var  LogEntry : string [255];
begin
   LastRcvWriteTicks := GetTickCount;
   LogEntry := DateToStr(Date) + ','
             + TimeToStr(Time) + ','
             + resdata.toHHMMSS(secs)  + ','
             + strpas(WhatProjectcode)   + ','
             + what;
   {$I-}
   AssignFile (RcvFile, Resdata.Rcv_File_Name);
   Rewrite (RcvFile);
   if IOResult<>0 then
   begin
     MessageDlg(msg_rcv_io, mtWarning, [mbOK], 0);
     Exit;
   end;
   Writeln(RcvFile, LogEntry);          {this is where we write to the RCVlog}
   CloseFile(RcvFile);
  {$I+}
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TMainForm.addicon;
var Warnmins     : longint;
    IconName     : array [0..15] of char;
begin
  with IconData do
  begin
    cbSize := sizeof(IconData);   {set up the task bar icon}
    Wnd := Handle;
    uID := 5576;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    uCallbackMessage := WM_USER + 1;
    hIcon := Application.Icon.Handle;
  end;
  StrPCopy(IconData.szTip, ' ' + Resdata.ShowElapsed(0));
  Shell_NotifyIcon(NIM_ADD, @IconData);       {tell windows about it}
  Warnmins := abs(GetTickCount - WarnTicks) div oneminute;
  if Warnmins >= Resdata.log_warn_after then
  begin
     StrPCopy(iconname,'XREDICON');
  end else
  begin
    if whatprojectcode = '' then
      StrPCopy(iconname,'XCYANICON')
    else
      StrPCopy(iconname,'XGREENICON');
  end;
  IconData.hIcon := LoadIcon(Hinstance, @iconname);
  Shell_NotifyIcon(NIM_MODIFY, @IconData);
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TMainForm.Close_Cleanup;
begin
    playsound(nil,0,0);
    MainTimerTimer(MainTimer);
    WriteLogEntry((abs(GetTickCount - LogonTicks) div onesecond),string(whatproject));
{$I-}
    AssignFile (RcvFile, Resdata.Rcv_File_Name);
    Erase(RcvFile);
{$I+}
    Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
{------------------------------------------------------------------------------}
{ read the ini file and look for code=project name }
{------------------------------------------------------------------------------}
procedure Tmainform.ReBuildProjectList;
var ProjFile : textfile;
var ProjString : string [255];
var i , j: integer;
begin
  i:=-1;
{$I-}
  AssignFile(ProjFile, Resdata.Proj_File_Name);         {read the file}
  Reset(ProjFile);
  if IOResult =0 then
  begin
    while not (eof(ProjFile)) do
    begin
      Readln(ProjFile,projstring);
      i:=i+1;
      j:=pos('=',projstring);
      if j = 0 then
        i:=i-1    {no = found so put i back again}
      else
      begin
        strpcopy(projectcodes[i],
                 trim(copy(projstring,1,min(projcodelenmax,j-1))));
        strpcopy(projects[i],
                 trim(copy(projstring,j+1,min(projnamelenmax,
                                              length(projstring)-j))));
      end;
    end;
    numprojects:=i+1;
    CloseFile(ProjFile);
  end;
{$I+}
  BuildButtons;
  BuildMenu;
end;
{------------------------------------------------------------------------------}
{ takes a string, splits on commas, trims and pads as required                 }
{------------------------------------------------------------------------------}
function TMainForm.ForScreen(logstring:string;ld,lt,le,lc:integer):string;
var m,c1,c2,c3,c4 : integer;
var doctored, stime : string[255];
var elapsedval : longint;
begin                     {find the commas}
try
  m:=length(logstring);
  c1:=pos(',',logstring);
  c2:=c1 + pos(',',copy(logstring,c1+1,m-c1));
  c3:=c2 + pos(',',copy(logstring,c2+1,m-c2));
  c4:=c3 + pos(',',copy(logstring,c3+1,m-c3));
  stime:= copy(logstring,c2+1,c3-c2-1);
  elapsedval:= resdata.GetElapsed(stime);
  doctored  := resdata.ShowElapsed(elapsedval);
  ForScreen := pad(pad(copy(logstring,1   ,c1   -1),ld),ld+1) +
               pad(pad(copy(logstring,c1+1,c2-c1-1),lt),lt+1) +
               pad(lpad(doctored                   ,le),le+1) +
               pad(pad(copy(logstring,c3+1,c4-c3-1),lc),lc+1) +
                       copy(logstring,c4+1,m-c4);;
except
  Forscreen:=msg_log_oops;
end;
end;
{------------------------------------------------------------------------------}
{ we show the last 12 entries in the log on the main screen                    }
{------------------------------------------------------------------------------}
procedure TMainForm.ShowLast12;
var logstring:string [255];
var visstring:string[255];
var keep12: array [0..(linesvisible-1)] of string[255];
var i:integer;
var last:integer;
begin
                                          {read the log and show entries}
  MainForm.MF_RichEdit.Visible:=false;
  Mainform.MF_RichEdit.Clear;
  MainForm.MF_RichEdit.color := options_but.brush.Color;
  last:=-1;
  for i:=0 to linesvisible-1 do
    keep12[i]:='';
{$I-}
  AssignFile(LogFile, Resdata.Log_File_Name);
  reset(LogFile);
  if IOResult = 0 then
  begin
    while not (eof(LogFile)) do
    begin
      readln(LogFile,logstring);
      VisString:=ForScreen(logstring,
                                   Resdata.Date_Chars,
                                   Resdata.Time_Chars,
                                   Resdata.Elap_Chars,
                                   Resdata.Proj_Chars);
      last:=((last+1) mod linesvisible);
      keep12[last] := visString;
    end;
    CloseFile(LogFile);
  end;
{$I+}
  for i:=last+1 to last+linesvisible do
  begin
    if length(keep12[i mod linesvisible])>0 then
    begin
      Mainform.MF_RichEdit.lines.add(keep12[i mod linesvisible]);
    end;
  end;
  MainForm.MF_RichEdit.Visible:=true;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TMainForm.MainTimerTimer(Sender: TObject);
var Elapsedsecs  : longint;
    Warnmins     : longint;
    wavfilename  :array [0..255] of char;
    IconName     : array [0..15] of char;
    cheese, pieceofwet : string;
begin

  {we should arrive here once a second, or whatever the timer is set to}
  Elapsedsecs := abs(GetTickCount - LogonTicks) div onesecond;
  cheese:= resdata.ShowElapsed(elapsedsecs)+'  '+
           pad(pad(strpas(WhatProjectcode),Resdata.Proj_Chars),
               Resdata.Proj_Chars+2) +
           strpas(whatproject);
  if (Session_mem.caption <> cheese) then    {only change if needed}
    Session_mem.caption:=cheese;

  If (abs(GetTickCount - LastRcvWriteTicks) >
     (Resdata.Log_Interval_Time * oneminute) ) then
  begin
    WriteRcvLogEntry((Elapsedsecs),strpas(whatproject));
  end;

  Warnmins := abs(GetTickCount - WarnTicks) div oneminute;
  if Warnmins >= Resdata.log_warn_after then     {change to red and bleep once}
  begin
    if (Session_mem.ForeColor <> CLBlack) then Session_mem.ForeColor := CLBlack;
    if (Session_mem.backcolor <> CLRed)   then Session_mem.backcolor := CLRed;
    if (Session_mem.hovercolor <> CLRed)  then Session_mem.hovercolor := CLRed;
    AutoAsk:=true;
    StrPCopy(iconname,'XREDICON');
    if not warned then
    begin
      Warned:=true;
      strpcopy(wavfilename,resdata.Sound_File_Name);
      if (resdata.warn_silent or
          (strlen(whatproject)>0) or (strlen(whatprojectcode)>0)) then
        playsound(wavfilename,0,snd_async);
    end else
    if warnmins >= (2*resdata.log_warn_after) then   {forget we bleeped}
    begin
      WarnTicks := GetTickCount-(Resdata.log_warn_after * oneminute);
      Warned:=false;
    end;
  end else
  begin
    AutoAsk:=false;
    if whatprojectcode = '' then
    begin
      if (Session_mem.ForeColor <> CLBlack) then Session_mem.ForeColor := CLBlack;
      if (Session_mem.backcolor <> CLAqua)  then Session_mem.backcolor := CLAqua;
      if (Session_mem.hovercolor <> CLAqua) then Session_mem.hovercolor := CLAqua;
      StrPCopy(iconname,'XCYANICON');
    end else
    begin
      if (Session_mem.ForeColor <> CLWhite) then Session_mem.ForeColor := CLWhite;
      if (Session_mem.backcolor <> CLGreen) then Session_mem.backcolor := CLGreen;
      if (Session_mem.hovercolor <> CLGreen) then Session_mem.hovercolor := CLGreen;
      StrPCopy(iconname,'XGREENICON');
    end;
    if warned then
    begin
      Warned:=false;
      playsound(nil,0,0);
    end;
  end;
  IconData.hIcon := LoadIcon(Hinstance, @iconname);
  StrPCopy(IconData.szTip, Resdata.ShowElapsed(Elapsedsecs)+ '  ' +
                           string(whatproject));
  Shell_NotifyIcon(NIM_MODIFY, @IconData);

If OSDExists then  {don't do this until the form exists}
  If resdata.OSD_Type = 0 then
  begin
    OSDForm.hide;
  end else
  begin
    Case resdata.OSD_Type of    {work out what the text should be}
(1),
(3): pieceofwet:=strpas(whatproject)+'  '+resdata.ShowElapsed(elapsedsecs);
(2),
(4): pieceofwet:=resdata.ShowElapsed(elapsedsecs)+'  '+strpas(whatproject);
    end;
    if (OSDForm.OSDLabel.Caption <> pieceofwet) then
    begin
      OSDForm.OSDLabel.Caption := pieceofwet;
      OSDForm.ResizeRepositionRepaint;
    end;
    if (OSDForm.OSDPOS <> resdata.OSD_Type) then
        OSDForm.OSDPOS := resdata.OSD_Type;
    if (OSDForm.OSDLabel.Font.Color <> Session_mem.ForeColor) then
        OSDForm.OSDLabel.Font.Color := Session_mem.ForeColor;
    if (OSDForm.OSDLabel.Color <> Session_mem.backcolor) then
        OSDForm.OSDLabel.Color := Session_mem.backcolor;
    if (OSDForm.Color <> Session_mem.Forecolor) then
        OSDForm.Color := Session_mem.Forecolor;
  end;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TMainForm.FormCreate(Sender: TObject);
var RcvString : string [255];
var update    : boolean;
var i :integer;
begin
  OSDExists:=False;
  AutoAsk:=False;
  MF_clientwidth:=MainForm.ClientWidth;    {store to help FormResize}
  AB_Width := ArrayOfButtons.Width;
  AB_Left := ArrayOfButtons.Left;
  BSB_Left := Button_ScrollBar.Left;
  MF_Height := MainForm.Height;
  MainForm.Caption := program_name;
  s_uTaskbarRestart := RegisterWindowMessage('TaskbarCreated');
  Resdata := Tresdata.Create(Self);
  With Resdata do
  begin
    {initialise variables}
    ShowLogRaw := true;
    Log_File_Name := RegReadStr(regdatakey,reg_file_name,
                                ExpandFileName(default_file_name));
    Rcv_File_Name := RegReadStr(regdatakey,reg_rcv_name,
                                ExpandFileName(default_rcv_name));
    Proj_File_Name := RegReadStr(regdatakey,reg_proj_name,
                                 ExpandFileName(default_proj_name));
    Sound_File_Name := RegReadStr(regdatakey,reg_sound_name,
                                  ExpandFileName(default_sound_name));
    Log_Warn_After := RegReadInt(regdatakey,reg_warn_time,default_warn_time);
    Log_Interval_Time := RegReadInt(regdatakey,reg_interval_time,
                                    default_interval_time);
    Date_Chars := RegReadInt(regdatakey,reg_date_chars,default_date_chars);
    Time_Chars := RegReadInt(regdatakey,reg_time_chars,default_time_chars);
    Elap_Chars := RegReadInt(regdatakey,reg_elap_chars,default_elap_chars);
    Proj_Chars := RegReadInt(regdatakey,reg_proj_chars,default_proj_chars);
    Show_HHMM   := RegReadInt(regdatakey,reg_show_hhmm,default_show_hhmm)=1;
    Show_HHMMSS := RegReadInt(regdatakey,reg_show_hhmmss,default_show_hhmmss)=1;
    Show_Hpoint := RegReadInt(regdatakey,reg_show_hpoint,default_show_hpoint)=1;
    Warn_Silent := RegReadInt(regdatakey,reg_warn_silent,default_warn_silent)=1;
    OSD_Type := RegReadInt(regdatakey,reg_OSD_Type,default_OSD_Type);
  end;
  BorderIcons := [biSystemMenu];      {minimal title bar, just close and icon}
  {BorderStyle := bsSingle;  }            { stops resize , but allows icon}
  buttonbase := 0;
  MainForm.ArrayOfButtons.cols:=1;
  MainForm.ArrayOfButtons.rows:=numbuttons;
  MainForm.ArrayOfButtons.colors.clear;  {clear and restore all button colors}
  MainForm.ArrayOfButtons.SetLatching(True);  {clear and restore all button colors}
  for i:=0 to (numbuttons-1) do
    MainForm.ArrayOfButtons.colors.add(colortostring(options_but.brush.Color));
  ReBuildProjectList;
  strpcopy(whatprojectcode,'');
  strpcopy(whatproject,'');
  Warned:=false;
  MainTimer.Interval := 333;  {333 milliseconds}             {set the timer}
  MainTimer.Enabled := true;
  MainForm.Hide;       {vanish}
  Mainform.MF_RichEdit.MaxLength := 2147483647;               {MAR 2002}
  MainForm.MF_RichEdit.Perform(EM_LIMITTEXT,0,$7ffffff0);  {set Richedit size }
  MainForm.MF_RichEdit.Perform(EM_EXLIMITTEXT,0,$7ffffff0);{set Richedit size }
  MainForm.MF_RichEdit.color := Mainform.Color;
  {first find out if a .rcv file exists and use it}
{$I-}
  AssignFile(RcvFile, Resdata.Rcv_File_Name);
  update:=false;
  reset(RcvFile);
  if IOResult = 0 then
  begin
    while not (eof(RcvFile)) do
    begin
      readln(RcvFile,RcvString);
      update:=true;
    end;
    CloseFile(RcvFile);
  end;

  if update then
  begin
    AssignFile (LogFile, Resdata.Log_File_Name);
    Append (LogFile);
    if IOResult<>0 then
    begin
      Rewrite (LogFile);
      if IOResult<>0 then
        MessageDlg(msg_log_io, mtWarning, [mbOK], 0);
    end;
    Writeln(LogFile, RcvString);          {this is where we write to the log}
    CloseFile(LogFile);
  end;
{$I+}

  {now open it again in read mode and show the last 12 entries}
  ShowLast12;

{  WriteLogEntry(0,msg_start);     }
  Session_mem.caption:=
         resdata.ShowElapsed(0)+'  ' +
         pad(pad('',Resdata.Proj_Chars),Resdata.Proj_Chars+2) +
         strpas(whatproject);
  StartTicks := GetTickCount;
  LogonTicks := StartTicks;
  WarnTicks := StartTicks;
  WriteRcvLogEntry(0,strpas(whatproject));   {initially blank}
  LastRcvWriteTicks := GetTickCount;
  AddIcon;
  MainTimerTimer(MainTimer);
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TMainForm.FormShow(Sender: TObject);
begin
  RebuildProjectList;
  MainTimerTimer(MainTimer);      {when we appear, check whats happening}
  if resdata.OSD_Type <> 0 then
  begin
    OSDForm.Show;             {Show the OSD Form - only do this once}
    setfocus;                 {but come back to us}
  end;
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TMainForm.FormResize(Sender: TObject);
begin
  {if resize was allowed - if BorderStyle <> BsDialog}    {fix these from form}
  ArrayOfButtons.Width:=max(MainForm.ClientWidth+(AB_Width-MF_clientwidth),
                            min_array_width);
  Button_Scrollbar.left :=max(MainForm.ClientWidth+(BSB_Left-MF_clientwidth),
                              AB_Left+min_array_width);
  Panel1.Width:=MainForm.ClientWidth-6;
  Panel1.Height:=MainForm.ClientHeight-6;
  Mainform.Height:=MF_Height;
  {ArrayofButtons.Invalidate; }    { seems not to be needed }
end;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {close should only hide, not close}
  Action := caNone;
  MainForm.Hide;
  ShowLogForm.Hide;
  showwindow(application.handle,SW_HIDE); {taskbar button}
end;

{------------------------------------------------------------------------------}
{                    BUTTONS                                                   }
{------------------------------------------------------------------------------}

procedure TMainForm.ShowLog_butClick(Sender: TObject);
begin
  ShowLogForm.Build_Arrays;
  ShowLogForm.Build_Report;
  ShowLogForm.Show;
  showwindow(application.handle,SW_Show); {taskbar button}
end;

procedure TMainForm.AddProj_butClick(Sender: TObject);
begin
  AddProjForm.ShowModal;
  RebuildProjectList;
  BuildMenu;
  Buildbuttons;
end;

procedure TMainForm.Options_butClick(Sender: TObject);
begin
  OptionsForm.Showmodal;

  If resdata.OSD_type = 0 then
    OSDForm.Hide
  else
    OSDForm.Show;
  setfocus;               { but come back to us}

  MainTimerTimer(MainTimer);    {call the timer to change icon}
                                {also fixes rcv file of length 0}
  ShowLast12;
end;

procedure TMainForm.About_butClick(Sender: TObject);
begin
   AboutForm.Showmodal;
end;

procedure TMainForm.Help_butClick(Sender: TObject);
var help_loc : array [0..255] of char;
begin
  {call help, but beware of directory searching}
  strpcopy(help_loc,paramstr(0));   {assumes xxxxx.exe}
  help_loc[strlen(help_loc)-3]:='h';
  help_loc[strlen(help_loc)-2]:='l';
  help_loc[strlen(help_loc)-1]:='p';
  winhelp(handle,help_loc,HELP_CONTENTS,0);
end;

procedure TMainForm.Hide_butClick(Sender: TObject);
begin
  MainForm.Hide;
  ShowLogForm.Hide;
  showwindow(application.handle,SW_HIDE); {taskbar button}
end;

procedure TMainForm.Exit_butClick(Sender: TObject);
begin                 {ask for confirmation first}  
  if MessageDlg(msg_quit+program_name+'?', mtConfirmation,
                [mbYes, mbNo], 0) = mrYes then
  begin
    Close_Cleanup;
    Application.ProcessMessages;
    Application.Terminate;
  end;
end;

{------------------------------------------------------------------------------}
{                                  POPUP MENU                                  }
{------------------------------------------------------------------------------}
{ the menu for right click on the system tray icon is built here }
{ for now assume unlimited capacity, the popup menu scrolls on 98              }
{------------------------------------------------------------------------------}
procedure TMainForm.BuildMenu;
var i: integer;
begin
 { popupmenu1.visible :=false;  }{ is what I want to do, but its not allowed }
  with popupmenu1, items do
  begin
    while count > 0 do delete(0);
    add(newitem(pmopenv,    0,false,true,PMI_RestoreClick,0,'vopen'));
    add(newitem(pmreportv,  0,false,true,showlog_butclick,0,'vreport'));
    add(newitem(pmaddv, 0,false,true,AddProj_butClick,0,'vadd'));
{    add(newitem('&About',   0,false,true,About_butClick,  0,'vabout'));   }
    add(newitem(pmexitv,    0,false,true,Exit_butclick,   0,'vexit'));
    add(newline);
    for i:=0 to (numprojects-1) do      {assume 0 to n are full, no gaps!}
    begin
      if strlen(projects[i]) >0 then
        if (strcomp(projects[i],whatproject)=0)
        and (strcomp(projectcodes[i],whatprojectcode)=0)
        then        {Tick the current project}
          add(newitem(string(projects[i]),0,true,true,popupprojclick,0,'filler'))
        else
          add(newitem(string(projects[i]),0,false,true,popupprojclick,0,'filler'));
    end;
  end;
end;
{------------------------------------------------------------------------------}
{ popup menu and invokes this when clicked for Restore/Open }
{------------------------------------------------------------------------------}
procedure TMainForm.PMI_RestoreClick(Sender: TObject);
begin
  MainForm.Show;
  showwindow(application.handle,SW_SHOW); {taskbar button}
end;
{------------------------------------------------------------------------------}
{ popup menu and invokes this when clicked for project items }
{------------------------------------------------------------------------------}
procedure TMainForm.PopupProjClick(Sender: TObject);
var i : integer;
begin
  i:= (sender as TMenuItem).MenuIndex-(4+1); { 4 items + 1 line at the top }
  if strcomp(whatproject,projects[i]) <> 0 then
  begin
    WriteLogEntry(abs(GetTickCount - LogonTicks) div onesecond,
                  string(whatproject));
    strpcopy(whatproject,projects[i]);
    strpcopy(whatprojectcode,projectcodes[i]);
    WriteRcvLogEntry(0,strpas(whatproject));
    LogonTicks := GetTickCount;
  end;
  Warnticks := GetTickCount;
  ToggleRightButton;
  ArrayOfButtons.invalidate;               {make sure it gets repainted}
  MainTimerTimer(MainTimer);
end;

{------------------------------------------------------------------------------}
{                              ARRAY OF BUTTONS                                }
{------------------------------------------------------------------------------}
{ array of buttons has captions, buttonbase says what button 0 represents      }
{------------------------------------------------------------------------------}
procedure Tmainform.ToggleRightButton;
var i : integer;
begin
  buttonbase := max(0,min(buttonbase,numprojects-numbuttons));
  for i:=0 to (numbuttons-1) do   {pop all the buttons up}
  begin
    MainForm.ArrayOfButtons.SetDown(0,i,False);
  end;
  for i:=buttonbase to min(numprojects-1,buttonbase+numbuttons-1) do
  begin
    if (strcomp(projects[i],whatproject)=0)
    and (strcomp(projectcodes[i],whatprojectcode)=0)
    then        {Push Down the current project}
      MainForm.ArrayOfButtons.SetDown(0,i-buttonbase,True);
  end;
end;

procedure Tmainform.BuildButtons;
var i :integer;
begin
  {we may have less projects than last time through so sanity check buttonbase}
  buttonbase := max(0,min(buttonbase,numprojects-numbuttons));
  MainForm.ArrayOfButtons.captions.clear;  {clear and restore all button tops}
  for i:=buttonbase to min(numprojects-1,buttonbase+numbuttons-1) do
  begin
    MainForm.ArrayOfButtons.captions.add(strpas(projects[i]));
  end;
  ToggleRightButton;
  if (numprojects-numbuttons) > 0 then      {adjust scrollbar to match}
  begin
    Button_scrollbar.Enabled:=true;
    Button_scrollbar.max:=(numprojects-numbuttons);
  end else
  begin
    Button_scrollbar.max:=1;
    Button_scrollbar.Enabled:=false;
  end;
  ArrayOfButtons.invalidate;               {make sure it gets repainted}
end;
{------------------------------------------------------------------------------}
{ array of buttons - handle clicks                                             }
{------------------------------------------------------------------------------}
procedure TMainForm.ArrayOfButtonsArrayButtonClicked(acol, arow: Integer);
var i : integer;
begin
  i:= arow+buttonbase;
  if i < numprojects then
  begin
    if strcomp(whatproject,projects[i]) <> 0 then
    begin
      WriteLogEntry(abs(GetTickCount - LogonTicks) div onesecond,
                    string(whatproject));
      strpcopy(whatproject,projects[i]);
      strpcopy(whatprojectcode,projectcodes[i]);
      LogonTicks := GetTickCount;
      WriteRcvLogEntry(0,strpas(whatproject));
    end;
    Warnticks := GetTickCount;
    MainTimerTimer(MainTimer);
  end;
end;
{------------------------------------------------------------------------------}
{ array of buttons - respond to scrollbar                                      }
{------------------------------------------------------------------------------}
procedure TMainForm.Button_ScrollBarChange(Sender: TObject);
begin
   buttonbase:=Button_scrollbar.position;
   Buildbuttons;
end;

{------------------------------------------------------------------------------}
{  override window proc, handles the popup menu and closedown                 }
{------------------------------------------------------------------------------}
procedure TMainForm.WndProc(var Msg : TMessage);
var
  p : TPoint;
begin
  case Msg.Msg of
    WM_USER + 1:        {this has come from the taskbar icon,encapsulated}
    case Msg.lParam of
      WM_CONTEXTMENU,
      WM_RBUTTONDOWN:
      begin
         Application.ProcessMessages;  {twinkle problems when two right clicks}
         ReBuildProjectList;
         SetForegroundWindow(Handle);
//         Application.ProcessMessages;
         GetCursorPos(p);
         PopupMenu1.Popup(p.x, p.y);
         PostMessage(Handle, WM_NULL, 0, 0);{to allow the popup to vanish again}
      end;
    {  WM_LBUTTONUP,   }   {I prefer just double click for now}
      WM_LBUTTONDBLCLK:
      begin
        SetForegroundWindow(Handle);
        MainForm.Show;
        showwindow(application.handle,SW_SHOW); {taskbar button}
      end;
    end;  {of WM_USER+1}
    WM_ENDSESSION:    {catch closedown confirm}
    begin
      if boolean(Msg.wParam) then    {it is really going to close}
      begin
        Close_Cleanup;
      end;
    end; {of WM_ENDSESSION}
  end; {of msg.msg}
  if msg.msg = s_uTaskbarRestart then
  begin
    Shell_NotifyIcon(NIM_DELETE, @IconData);
    addicon;
  end;
  inherited;
end;
{------------------------------------------------------------------------------}
{   MAIN CODE - what there is of it                                            }
{------------------------------------------------------------------------------}
begin
  {showwindow(application.handle,SW_HIDE); }
end.

unit showlogcode;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Grids, clipbrd, SortGrid, shellapi;

type
  TShowLogForm = class(TForm)
    SL_RichEdit: TRichEdit;
    Close_but: TButton;
    LogFormat_but: TButton;
    SL_DateTimePicker: TDateTimePicker;
    Report_but: TButton;
    Clip_but: TButton;
    SL_StringGrid: TSortGrid;
    hhmm_but: TButton;
    Edit_Log_but: TButton;
    ShowStar_but: TButton;
    procedure Close_butClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure LogFormat_butClick(Sender: TObject);
    procedure Report_butClick(Sender: TObject);
    procedure Clip_butClick(Sender: TObject);
    procedure SL_StringGridGetCellFormat(Sender: TObject; Col,
      Row: Integer; State: TGridDrawState;
      var FormatOptions: TFormatOptions);
    procedure hhmm_butClick(Sender: TObject);
    procedure SL_DateTimePickerChange(Sender: TObject);
    procedure Edit_Log_butClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ShowStar_butClick(Sender: TObject);
  private
    { Private declarations }
    procedure LogLine(logstring:string;ld,lt,le,lc:integer);
  public
    { Public declarations }
    procedure Build_Arrays;
    procedure Build_Report;
    procedure ShowLog(raw: boolean);
  end;

var
  ShowLogForm: TShowLogForm;

implementation

uses rescode, maincode;

{$R *.DFM}

var rep_point : TShowStyle;
var ShowStar : boolean;
var last_end : TDateTime;
{------------------------------------------------------------------------------}
{ Converts seconds to HH:MM:SS or HH.DD or HH:MM                               }
{------------------------------------------------------------------------------}
function ShowTime(x:integer;point:TShowStyle) :string;  {x in seconds}
begin
  if point=ssHHMMSS then
    ShowTime := Resdata.ToHHMMSS(x)
  else
  begin
    if (x mod 60) > 29 then      {round it up}
      x:=x+60;
    if point=ssHpoint then
      ShowTime := Resdata.ToHpoint(x)
    else
      ShowTime := Resdata.ToHHMM(x);
  end;
end;
{------------------------------------------------------------------------------}
{ takes a string, splits on commas, trims and pads as required                 }
{ checks for editing slips and marks errors in Red                             }
{------------------------------------------------------------------------------}
procedure TShowLogForm.LogLine(logstring:string;ld,lt,le,lc:integer);
var m,c1,c2,c3,c4 : integer;
var LogLineV, endday : string[255];
var elapsedval : longint;
var thetimeval, tv: TdateTime;
var yesterday : boolean;
begin                     {find the commas}
  try
    m:=length(logstring);
    c1:=pos(',',logstring);
    c2:=c1 + pos(',',copy(logstring,c1+1,m-c1));
    c3:=c2 + pos(',',copy(logstring,c2+1,m-c2));
    c4:=c3 + pos(',',copy(logstring,c3+1,m-c3));
    thetimeval:= strtotime(copy(logstring,c1+1,c2-c1-1));
    elapsedval:= resdata.GetElapsed(copy(logstring,c2+1,c3-c2-1));
    tv:=thetimeval-(elapsedval/(24*3600));
    {try to calculate when this started}
    yesterday:=(tv < 0);
    if yesterday then
    begin
      while tv < 0 do tv:=tv+1;
      endday:=pad(pad(copy(logstring,1   ,c1   -1),ld)+'-',ld+1)
    end
    else
    begin
      endday:=pad(pad(copy(logstring,1   ,c1   -1),ld),ld+1);
    end;

    LogLineV   := endday +
                  pad(pad(timetostr(tv)               ,lt),lt+1) +
                  pad(pad(copy(logstring,c1+1,c2-c1-1),lt),lt+1) +
                  pad(lpad(resdata.ShowElapsed(elapsedval),le),le+1) +
                  pad(pad(copy(logstring,c3+1,c4-c3-1),lc),lc+1) +
                          copy(logstring,c4+1,m-c4);
    {put it out in red if there is a discrepancy and not start blank record}
    if (abs(last_end - tv) > (60/(24*3600))) and ((m-c4)<>0) then
    begin
      SL_RichEdit.SelAttributes.Color := CLRed;
    end else
      SL_RichEdit.SelAttributes.Color := CLBlack;

    SL_RichEdit.lines.add(LogLineV);
    last_end:=thetimeval;
  except
    LogLineV:=msg_log_oops;
    SL_RichEdit.SelAttributes.Color := CLRed;
    SL_RichEdit.lines.add(LogLineV);
  end;
end;
{------------------------------------------------------------------------------}
{  Shows the Log in a raw or normal format using a rich_edit that is hidden    }
{------------------------------------------------------------------------------}
procedure TShowLogForm.ShowLog(raw: boolean);
var logfile : textfile;
var logstring : string [255];
begin
  SL_RichEdit.Clear;
  SL_RichEdit.Visible:=false;
  SL_RichEdit.Lines.BeginUpdate;
  SL_RichEdit.SelStart := 0;
  SL_RichEdit.SelLength := 0;

  if raw then
  begin
    LogFormat_but.caption:=sl1;
    SL_RichEdit.SelAttributes.Color := CLBlack;
  end
  else
  begin
    LogFormat_but.caption:=sl2;
    SL_RichEdit.SelAttributes.Color := CLGray;
    SL_RichEdit.lines.add(
                  pad( pad(slh1,Resdata.Date_Chars),Resdata.Date_Chars+1) +
                  pad( pad(slh2,Resdata.Time_Chars),Resdata.Time_Chars+1) +
                  pad( pad(slh3,Resdata.Time_Chars),Resdata.Time_Chars+1) +
                  pad(lpad(slh4,Resdata.Elap_Chars),Resdata.Elap_Chars+1) +
                  pad( pad(slh5,Resdata.Proj_Chars),Resdata.Proj_Chars+1) +
                           slh6);
    SL_RichEdit.SelAttributes.Color := CLBlack;
  end;
  last_end:=0;
{$I-}
  AssignFile(LogFile, Resdata.Log_File_Name);         {read the existing log}
  Reset(LogFile);
  if IOResult =0 then
  begin
    while not (eof(LogFile)) do
    begin
      Readln(LogFile,logstring);                    {format for screen}
      if raw then
      begin
        SL_RichEdit.SelAttributes.Color := CLBlack;
        SL_RichEdit.lines.add(LogString);
      end
      else
        LogLine(logstring, Resdata.Date_Chars,
                           Resdata.Time_Chars,
                           Resdata.Elap_Chars,
                           Resdata.Proj_Chars);
    end;
    CloseFile(LogFile);
  end;
{$I+}
  if not raw then
  begin
    SL_RichEdit.SelAttributes.Color := CLGray;
    SL_RichEdit.lines.add(
                  pad( pad(slh1,Resdata.Date_Chars),Resdata.Date_Chars+1) +
                  pad( pad(slh2,Resdata.Time_Chars),Resdata.Time_Chars+1) +
                  pad( pad(slh3,Resdata.Time_Chars),Resdata.Time_Chars+1) +
                  pad(lpad(slh4,Resdata.Elap_Chars),Resdata.Elap_Chars+1) +
                  pad( pad(slh5,Resdata.Proj_Chars),Resdata.Proj_Chars+1) +
                           slh6);
  end;
  // Set the caret to the last character
  SL_RichEdit.SelStart := SL_RichEdit.GetTextLen;
  // Scroll the caret into view
  SL_RichEdit.Perform(EM_SCROLLCARET, 0, 0);
  // Back up one line to hide the blank line
  SL_RichEdit.Perform(EM_SCROLL,SB_LINEUP,0);
  SL_RichEdit.Lines.EndUpdate;
  SL_RichEdit.Visible:=true;
  SL_StringGrid.Visible:=false;
  hhmm_but.Visible:=false;
  report_but.visible:=true;
end;
{------------------------------------------------------------------------------}
{ When building the report this processes one record in log format             }
{------------------------------------------------------------------------------}
procedure handle_one_record(logstring:string;firstmonday,nextmonday:TdateTime );
var thecode,theproj,stime : string;
var m,c1,c2,c3,c4 : integer;
var x,y     :integer;
var here    :integer;
var found   :boolean;
var days    : integer;
var elapsedval, theend, thestart : longint;
var thedate, thetimeval: TdateTime;
begin
  try
    m:=length(logstring);
    c1:=pos(',',logstring);
    thedate:=strtodate(copy(logstring,1   ,c1   -1));
    if thedate >= Firstmonday then
    {does it end too early}
    begin
      c2:=c1 + pos(',',copy(logstring,c1+1,m-c1));
      thetimeval:=strtotime(copy(logstring,c1+1,c2-c1-1));
      c3:=c2 + pos(',',copy(logstring,c2+1,m-c2));
      stime:= copy(logstring,c2+1,c3-c2-1);
      elapsedval:=resdata.GetElapsed(stime);
      if thedate+(thetimeval)-(elapsedval/(24*3600)) <<numreps) and not found ) do
        begin     {needs to be faster}
          if (strpas( rep_codes[y]) = thecode) and
             (strpas( rep_projs[y]) = theproj) then
          begin
            here:=y;
            found:=true;
          end else
            y:=y+1;
        end;
        if not found then
        begin
          strpcopy(rep_codes[numreps],thecode);
          strpcopy(rep_projs[numreps],theproj);
          for x:=0 to 7 do    {monday to sunday}
          begin
            rep_tots[numreps,x]:=0;
          end;
          here:=numreps;
          numreps:=numreps+1;
        end;
        {calculate offset from start of week}
        days:=round(double(thedate)-double(Firstmonday));
        theend:=(days)*(24*3600)+DateTimeToTimeStamp(thetimeval).time div 1000;
        thestart:=max(0,theend-elapsedval);
        for x:=0 to 6 do    {monday to sunday}
        begin
          rep_tots[here,x]:=rep_tots[here,x]+
          (min(max(x*24*3600,theend),(x+1)*24*3600))-
          (min(max(x*24*3600,thestart),(x+1)*24*3600));
        end;
      end; { of is the start too late }
    end; {of is the end too early}
  except
        {we do nothing}
  end;  { of outer try}
end;
{------------------------------------------------------------------------------}
{ Just builds the arrays we need from the log                                  }
{------------------------------------------------------------------------------}
procedure TShowLogForm.Build_Arrays;
var y :integer;
var firstmonday, nextmonday, request :TdateTime ;
var logfile : textfile;
var logstring : string [255];
begin
  request:=SL_DateTimePicker.date ;
  firstmonday:=1+request - DayOfWeek(request-1);
  nextmonday:=firstmonday+7;
  numreps:=0;
{$I-}
  AssignFile(LogFile, Resdata.Log_File_Name);         {read the existing log}
  Reset(LogFile);
  if IOResult =0 then
  begin
    while not (eof(LogFile)) do
    begin
      Readln(LogFile,logstring);
      handle_one_record(logstring,firstmonday,nextmonday);
    end;  { of while}
    CloseFile(LogFile);
  end;
{$I+}
  {now add in what we are doing if it is in the week required }
  logstring:=DateToStr(Date) + ','
             + TimeToStr(Time) + ','
             + resdata.toHHMMSS(abs(GetTickCount - LogonTicks) div onesecond)+ ','
             + strpas(WhatProjectcode)   + ','
             + strpas(WhatProject);
  handle_one_record(logstring,firstmonday,nextmonday);
  {now add up the totals}
  for y:=0 to numreps-1 do     { add up the right side totals}
  begin
    rep_tots[y,7] := rep_tots[y,0] +  rep_tots[y,1] +  rep_tots[y,2] +
                     rep_tots[y,3] +  rep_tots[y,4] +  rep_tots[y,5] +
                     rep_tots[y,6];
  end;
end;

{------------------------------------------------------------------------------}
{ displays the report screen in a sortgrid                                    }
{------------------------------------------------------------------------------}
procedure TShowLogForm.Build_Report;
var x,y :integer;
var tso : TSortOptions;
var firstmonday, nextmonday, request :TdateTime ;
begin
  SL_RichEdit.visible:=false;
  LogFormat_but.caption:=sl1;
  Resdata.ShowLogRaw := true;       {next click will flip}
  request:=SL_DateTimePicker.date ;
  firstmonday:=1+request - DayOfWeek(request-1);
  nextmonday:=firstmonday+7;
  with SL_StringGrid do
  begin
    Clear;
    Colcount:=10;
    Rowcount:=1;
    ClickSorting:=False;
    cells[0,0]:= datetostr(firstmonday);
    cells[1,0]:= sl3 + datetostr(nextmonday-1);
    for x:=2 to 8 do
      cells[x,0]:= copy(days,x*3-5,3);
    cells[9,0]:=total;
    { zero the totals }
    for x:=0 to 7 do
    begin
      gt[x]:=0;
      st[x]:=0;
    end;
    {do some totals}
    for y:=0 to numreps-1 do
    begin
      if strlen(rep_codes[y]) > NextMonday then
      { does it start too late}
      begin
        c4:=c3 + pos(',',copy(logstring,c3+1,m-c3));
        thecode:=copy(logstring,c3+1,c4-c3-1);
        theproj:=copy(logstring,c4+1,m-c4);
        y:=0;
        here:=-1;
        found:=false;
        while ((y> 0 then
      begin
        for x:=0 to 7 do
        begin
          gt[x]:=gt[x] +  rep_tots[y,x]; {add up the bottom totals where not null}
          if strcomp(rep_codes[y],'*') = 0 then
            st[x]:=st[x] +  rep_tots[y,x]; {add up the totals where *}
        end;
      end;
    end;
    {only show the button if there is time to * and time not to *}
    ShowStar_but.visible:=((st[7] <> 0) and ((gt[7]-st[7]) <> 0));
    If ShowStar then
    begin
      {show it all the way it is}
      for y:=0 to numreps-1 do
      if strlen(rep_codes[y]) <> 0 then
      begin
        rowcount:=rowcount+1;
        cells[0,rowcount-1] := strpas(rep_codes[y]);
        cells[1,rowcount-1] := strpas(rep_projs[y]);
        for x:=0 to 7 do
        begin
          cells[x+2,rowcount-1] := showtime(rep_tots[y,x],rep_point);
        end;
      end
    end
    else
    begin
      {spread * codes over other projects according to weekly ratio}
      for y:=0 to numreps-1 do
      if (strlen(rep_codes[y]) <> 0) and (strcomp(rep_codes[y],'*') <> 0) then
      begin
        rowcount:=rowcount+1;
        cells[0,rowcount-1] := strpas(rep_codes[y]);
        cells[1,rowcount-1] := strpas(rep_projs[y]);
        for x:=0 to 7 do
        begin
          if (gt[7]-st[7]) <> 0 then
            cells[x+2,rowcount-1] := showtime(rep_tots[y,x]+
                                     round(st[x]*rep_tots[y,7]/(gt[7]-st[7])),
                                     rep_point)
          else
            cells[x+2,rowcount-1] := showtime(rep_tots[y,x],rep_point);
        end;
      end;
    end;
    if (rowcount <= 1) then    {no projects yet - fake one in}
    begin
      rowcount:=rowcount+1;
      cells[0,rowcount-1] := '';
      cells[1,rowcount-1] := '';
      for x:=2 to colcount do
        cells[x,rowcount-1] := showtime(0,rep_point);
    end;
    AlignmentHorz := TaRightJustify;
    AlignmentVert := TaMiddle;
    SL_StringGrid.AutoSizeCol(0);
    SL_StringGrid.AutoSizeCol(1);
    with tso do
    begin
      SortStyle:= ssAlphabetic;
      SortDirection:= sdAscending;
      SortCaseSensitive:=False;
    end;
    FixedRows:=1;
    SortByColumn(1,TSO);
    SortByColumn(0,TSO);
    rowcount:=rowcount+1;
    cells[0,rowcount-1]:=total;
    cells[1,rowcount-1]:='------------';
    for x:=0 to 7 do
      cells[x+2,rowcount-1] := showtime(gt[x],rep_point);
    Selection:=TGridRect(rect(9,rowcount-1,9,rowcount-1));
    for y:=0 to numreps-1 do
    if strlen(rep_codes[y]) = 0 then
    begin
      rowcount:=rowcount+1;
      cells[0,rowcount-1] := strpas(rep_codes[y]);
      cells[1,rowcount-1] := strpas(rep_projs[y]);
      for x:=0 to 7 do
        cells[x+2,rowcount-1] := showtime(rep_tots[y,x],rep_point);
    end;
    defaultrowheight:= max(rep_row_height,((Height ) div rowcount)-2);
    SL_StringGrid.visible:=true;
    hhmm_but.visible:=true;
    report_but.visible:=false;
  end;
end;
{---------------------------------------------------------------------------}
{ FormCreate is called as the program starts, don't make it too heavy       }
{---------------------------------------------------------------------------}
procedure TShowLogForm.FormCreate(Sender: TObject);
var x:integer;
begin
  BorderIcons := [biSystemMenu];        {minimal title bar, just close icon}
  SL_RichEdit.MaxLength := 2147483647;               {MAR 2002}
  SL_RichEdit.Perform(EM_LIMITTEXT,0,$7ffffff0);  {set Richedit size }
  SL_RichEdit.Perform(EM_EXLIMITTEXT,0,$7ffffff0);  {set Richedit size }
  LogFormat_but.caption:=sl1;
  Resdata.ShowLogRaw := true;       {next click will flip}
  SL_DateTimePicker.date:=(date);
  SL_RichEdit.visible:=false;
  with SL_StringGrid do
  begin
    Clear;
    Colcount:=10;
    Rowcount:=2;
    FixedRows:=1;
    FixedRows:=1;
    ClickSorting:=False;
    defaultrowheight:= rep_row_height;
    cells[0,0]:= datetostr(date);           {should never see any of this}
    cells[1,0]:=sl3 + datetostr(date);  { but put it in there just in case}
    for x:=2 to 8 do
      cells[x,0]:= copy(days,x*3-5,3);
    cells[9,0]:=total;
    visible:=true;
  end;
  rep_point:=ssHpoint;
  hhmm_but.caption:=hhmmss;
  ShowStar:=True;
  ShowStar_but.visible:=false;
  ShowlogForm.Caption:=program_name + sl4;
end;
{------------------------------------------------------------------------------}
{ When the form resizes, adjust the positions and size of some controls        }
{------------------------------------------------------------------------------}
procedure TShowLogForm.FormResize(Sender: TObject);
begin
  {if resize is allowed - Check borderstyle}
  SL_RichEdit.Width := ShowLogForm.ClientWidth - 2;
  SL_RichEdit.Height:= ShowLogForm.ClientHeight - (Close_but.Height+10);
  with SL_StringGrid do
  begin
    Width := ShowLogForm.ClientWidth - 2;
    Height:= ShowLogForm.ClientHeight - (Close_but.Height+10);
    defaultcolwidth:= ((Width-20 ) div 12)-1;
    defaultrowheight:= max(rep_row_height,((Height ) div rowcount)-2);
    AutoSizeCol(0);
    AutoSizeCol(1);
  end;
  SL_DateTimePicker.Top := ShowLogForm.ClientHeight -
                           (SL_DateTimePicker.Height+sl_but_lift);
  hhmm_but.Top          := ShowLogForm.ClientHeight -
                           (hhmm_but.Height+sl_but_lift);
  LogFormat_but.Top     := ShowLogForm.ClientHeight -
                           (LogFormat_but.Height+sl_but_lift);
  Report_but.Top        := ShowLogForm.ClientHeight -
                           (Report_but.Height+sl_but_lift);
  ShowStar_but.Top        := ShowLogForm.ClientHeight -
                           (ShowStar_but.Height+sl_but_lift);
  Edit_log_but.Top      := ShowLogForm.ClientHeight -
                           (Edit_Log_but.Height+sl_but_lift);
  Clip_but.Top          := ShowLogForm.ClientHeight -
                           (Clip_but.Height+sl_but_lift);
  Close_but.Top         := ShowLogForm.ClientHeight -
                           (Close_but.Height+sl_but_lift);
end;
{------------------------------------------------------------------------------}
{                        BUTTONS                                               }
{------------------------------------------------------------------------------}
procedure TShowLogForm.SL_DateTimePickerChange(Sender: TObject);
begin
  Report_butClick(Sender);
end;

procedure TShowLogForm.Edit_Log_butClick(Sender: TObject);
var xxx: array[0..255] of char;
begin
  strpcopy(xxx,Resdata.Log_File_Name);
  ShellExecute(Handle, 'open', xxx , nil, nil, SW_SHOWNORMAL);
  {ignore failures}
  {dont close the form, let OK or cancel be pushed}
end;

procedure TShowLogForm.Report_butClick(Sender: TObject);
begin
  Build_Arrays;
  Build_Report;
end;

procedure TShowLogForm.hhmm_butClick(Sender: TObject);
begin
  case rep_point of
(ssHpoint):
    begin
    rep_point:=sshhmmss;
    hhmm_but.caption:=hhmm;
    end;
(sshhmmss):
    begin
    rep_point:=sshhmm;
    hhmm_but.caption:=hours;
    end;
(sshhmm):
    begin
    rep_point:=sshpoint;
    hhmm_but.caption:=hhmmss;
    end;
  end;
  Build_report;
end;

procedure TShowLogForm.LogFormat_butClick(Sender: TObject);
begin
  Resdata.ShowLogRaw := not (Resdata.ShowLogRaw);
  ShowStar_but.visible:=false;
  ShowLog(Resdata.ShowLogRaw);
end;

procedure TShowLogForm.ShowStar_butClick(Sender: TObject);
begin
  ShowStar:=not(ShowStar);
  If ShowStar then
    ShowStar_but.Caption:=sl5
  else
    ShowStar_but.Caption:=sl6;
  Build_Report;
end;

procedure TShowLogForm.Clip_butClick(Sender: TObject);
var xxx : array [0..65535] of char;
var xx  : array [0..projnamelenmax] of char;
var tab, cr : array [0..2] of char;
var x,y : integer;
begin
  if SL_StringGrid.visible then
  begin                      {report is showing}
    tab[0]:=#09;
    tab[1]:=#00;
    cr[0]:=#10;
    cr[1]:=#00;
    strpcopy(xxx,'');
    Clipboard.open;
    try
      with SL_StringGrid do
      begin
        for y:=0 to rowcount-1 do
        begin
          for x:=0 to colcount-1 do
          begin
            strpcopy(xx,cells[x,y]);
            strcat(xxx,xx);
            strcat(xxx,tab);
          end;
          strcat(xxx,cr);
        end;
      end;
      Clipboard.SetTextBuf(xxx);
    finally
      Clipboard.close;
    end;
  end else
  begin                    {log is showing}
    if SL_RichEdit.Sellength = 0 then
      SL_RichEdit.SelectAll;
    SL_RichEdit.CopyToClipBoard;
    SL_RichEdit.Sellength:=0;
  end;
end;

procedure TShowLogForm.Close_butClick(Sender: TObject);
begin
   ShowLogForm.Close;
end;

procedure TShowLogForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if not(mainform.visible) then
    showwindow(application.handle,SW_HIDE); {taskbar button}
end;

{------------------------------------------------------------------------------}
{ Sortgrid calls this to get formatting for each cell                          }
{------------------------------------------------------------------------------}
procedure TShowLogForm.SL_StringGridGetCellFormat(Sender: TObject; Col,
  Row: Integer; State: TGridDrawState; var FormatOptions: TFormatOptions);
begin
  if col=0 then
    FormatOptions.AlignmentHorz:=TaCenter
  else
  if col=1 then
    FormatOptions.AlignmentHorz:=TaLeftJustify
  else
  if row = 0 then
    FormatOptions.AlignmentHorz:=TaCenter
  else
    FormatOptions.AlignmentHorz:=TARightJustify;
end;
end.
unit rescode;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Registry;

type
  Tresdata = class(TDataModule)
  private
    { Private declarations }
  public
    { Public declarations }
    Log_File_Name : string[255];
    Rcv_File_Name : string[255];
    Proj_File_Name : string[255];
    Sound_File_Name : string[255];
    Log_Warn_After : longint;
    Log_Interval_Time : integer;
    ShowLogRaw : boolean;
    Date_Chars : integer;
    Time_Chars : integer;
    Elap_Chars : integer;
    Proj_Chars : integer;
    {default is show minutes}
    Show_HHMM  : boolean;
    Show_HHMMSS: boolean;
    Show_Hpoint: boolean;
    Warn_Silent : boolean;
    OSD_type : integer;
    function ToMins(x:integer):string;       {now in secs}
    function ToHHMM(x:integer):string;       {now in secs}
    function ToHHMMSS(x:integer):string;     {now in secs}
    function ToHpoint(x:integer):string;     {now in secs}
    Function getElapsed(stime:string):longint;
    function ShowElapsed(x:integer) :string; {now in secs}
    Function RegReadStr(key:string;which:string;defstr:string):string;
    Function RegReadInt(key:string;which:string;defval:integer):integer;
    Procedure RegWriteStr(key:string;which:string;xxx:string);
    Procedure RegWriteInt(key:string;which:string;xxx:integer);
    Procedure RegDeleteItem(key:string;which:string);
    function GetInfo: string;
  end;

var
  resdata: Tresdata;

resourcestring
  program_name      = 'Proj_Log';
{files}
  default_file_name = 'Proj_Log.log';
  default_rcv_name  = 'Proj_Log.rcv';
  default_proj_name = 'Proj_Log.ini';
  default_sound_name= 'Proj_Log.wav';
  help_file_name    = 'Proj_Log.hlp';
{registry}
  reg_name          = 'Proj_Log';
  regdatakey        = 'Software\Hystedjp\Proj_Log' ;
  reg_file_name     = 'LogName';
  reg_rcv_name      = 'RcvName';
  reg_proj_name     = 'ProjName';
  reg_sound_name    = 'SoundName';
  reg_warn_time     = 'LogWarnAfter';
  reg_interval_time = 'LogIntervalTime';
  reg_date_chars    = 'DateChars';
  reg_time_chars    = 'TimeChars';
  reg_elap_chars    = 'ElapsedChars';
  reg_proj_chars    = 'ProjChars';
  reg_show_hhmm     = 'ShowHHMM';
  reg_show_hhmmss   = 'ShowHHMMSS';
  reg_show_hpoint   = 'ShowHpoint';
  reg_warn_silent   = 'WarnSilent';
  reg_OSD_type      = 'OSD';
  regrunkey         = 'Software\Microsoft\Windows\CurrentVersion\Run';
{text}
  msg_quit          = 'Really exit ';
  msg_create        = 'Creating New Log..........';
  msg_mins          = ' mins';
  msg_log_io        = 'Unable to write to log file';
  msg_rcv_io        = 'Unable to write to recovery file';
  msg_proj_io       = 'Unable to write to project file';
  msg_log_oops      = 'Unexpected record found in log';
  msg_no_add        = 'Unable to add a project with no name';
  www_ref           = 'http://www.hystedjp.btinternet.co.uk/software/';
  days              = 'MonTueWedThuFriSatSun';
  total             = 'Total';
  hhmm              = 'HH:MM';
  hhmmss            = 'HH:MM:SS';
  hours             = 'Hours';
  sl1               = '&Show Log';
  sl2               = '&Show Raw Log';
  sl3               = '  to  ';
  sl4               = ' - Report';
  sl5               = 'No *';
  sl6               = '*';
  slh1              = 'Date';
  slh2              = 'From';
  slh3              = 'To';
  slh4              = 'Elapsed';
  slh5              = 'Code';
  slh6              = 'Project';
  op1               = ' - Options';
  ab1               = 'Version: ';
  ab2               = ' - About';
  ab3               = ' - Project Time Logging';
  pmopenv           = '&Open';
  pmreportv         = '&Report';
  pmaddv            = 'Add &Project';
  pmexitv           = '&Exit';

const
  {program limits}
  maxproj              = 255;      { can only handle 255 projects in file}
  projcodelenmax       = 63;       { code must be less tha 63 chars long}
  projnamelenmax       = 127;      { name must be less than 127 chars long}
  {user defaults}
  default_warn_time     = 30;      { change icon from green to red }
  default_interval_time = 5;       { recovery log every 5 minutes }
  default_date_chars    = 10;      { 10 chars to show a date }
  default_time_chars    = 5;       { 5 chars to show a time, chop seconds}
  default_elap_chars    = 8;       { 5 chars to show a time, chop seconds}
  default_proj_chars    = 7;       { 7 chars to show a project code}
  default_show_hhmm     = 0;       { default is show hhh:mm:ss  }
  default_show_hhmmss   = 1;       {  1 in registry }
  default_show_hpoint   = 0;       { default is show hhh:mm:ss }
  default_warn_silent   = 1;       { noisy even if blank }
  default_OSD_type      = 1;       {top left}
  {sizing defaults, beware if resizing forms at design time}
  LinesVisible          = 12;      { how many lines on the MainForm richedit}
{  ShowLinesVisible      = 26;     } { how many lines on the ShowLogForm richedit}
  NumButtons            = 10;
  sl_but_lift           = 4 ;
  rep_row_height        = 24;
  min_array_width       = 12;
  {stuff}
  OneMinute             = 60*1000; { in milliseconds for the timer}
  OneSecond             = 1000; { in milliseconds for the timer}
  EM_EXLIMITTEXT        = (WM_USER+53);

var
  WhatProjectCode  : array [0..projcodelenmax] of char;
  WhatProject      : array [0..projnamelenmax] of char;
  Projectcodes     : array [0..maxproj,0..projcodelenmax] of char;
  Projects         : array [0..maxproj,0..projnamelenmax] of char;
  numprojects      : integer;

  Rep_Codes        : array [0..maxproj,0..projcodelenmax] of char;
  Rep_Projs        : array [0..maxproj,0..projnamelenmax] of char;
  Rep_Tots         : array [0..maxproj,0..7] of Longint;
  gt               : array [0..7] of Longint;
  st               : array [0..7] of longint;
  numreps          : integer;

  LogonTicks : longint;

type
  TShowStyle = (ssmins, ssHHMM, ssHHMMSS, ssHPoint);



function min(a,b:integer):integer;
function max(a,b:integer):integer;
function pad(s:string;f:integer):string;  {pad or trim string}
function lpad(s:string;f:integer):string;  {pad or trim string}

implementation

{$R *.DFM}

function min(a,b:integer):integer;
begin
  if a<b then
  min:=b;
  else
end

function max(a
begin
  if a>b then
  max:=a
  else
  max:=b;
end;

function pad(s:string;f:integer):string;  {pad or trim string}
begin
  if length(s) < f then
  pad:=s+stringofchar(' ',f-length(s))
  else
    if length(s) > f then
      pad:=copy(s,1,f)
    else
      pad:=s;
end;

function lpad(s:string;f:integer):string;  {pad or trim string}
begin
  if length(s) < f then
  lpad:=stringofchar(' ',f-length(s)) + s
  else
    if length(s) > f then
      lpad:=copy(s,1,f)
    else
      lpad:=s;
end;
{------------------------------------------------------------------------------}
function Tresdata.ToMins(x:integer):string;
var sm : string[10];
begin
  sm := IntToStr( x div 60);
  tomins := sm;
end;

function Tresdata.ToHHMM(x:integer):string;
var sh,sm : string[10];
begin
  x:=x div 60;
  sh := IntToStr( x div 60);
  sm := '00' + IntToStr (x mod 60);
  sm := copy(sm,length(sm)-1,2);
  toHHMM := sh + ':' +sm;
end;

function Tresdata.ToHHMMSS(x:integer):string;
var sh,sm,ss : string[10];
begin
  ss:= '00' + IntToStr (x mod 60);
  ss:=copy(ss,length(ss)-1,2);
  x:=x div 60;
  sh := IntToStr( x div 60);
  sm := '00' + IntToStr (x mod 60);
  sm := copy(sm,length(sm)-1,2);
  toHHMMSS := sh + ':' +sm + ':' +ss;
end;

function Tresdata.ToHpoint(x:integer):string;
var sh,sd : string[10];
begin
  x:=x div 60;
  sh := IntToStr( x div 60);
  sd := '00' + IntToStr ((100*x) div 60);
  sd := copy(sd,length(sd)-1,2);
  toHpoint := sh + '.' +sd;
end;
{------------------------------------------------------------------------------}
function Tresdata.ShowElapsed(x:integer) :string;
begin                       {single variable and case?}
  if Show_HHMM then
    ShowElapsed := ToHHMM(x)
  else
  if Show_HHMMSS then
    ShowElapsed := ToHHMMSS(x)
  else
  if Show_Hpoint then
    ShowElapsed := ToHpoint(x)
  else
    ShowElapsed := ToMins(x);
end;
{------------------------------------------------------------------------------}
Function Tresdata.GetElapsed(stime:string):longint;
var tm,tc1,tc2 : integer;
begin
  try
    tm:=length(stime);
    tc1:=pos(':',stime);
    tc2:=tc1 + pos(':',copy(stime,tc1+1,tm-tc1));
    GetElapsed := strtointdef(copy(stime,    1,tc1    -1),0)*3600 +
                  strtointdef(copy(stime,tc1+1,tc2-tc1-1),0)*60 +
                  strtointdef(copy(stime,tc2+1,tm -tc2  ),0);
  except
    GetElapsed := strtointdef(stime,0);
  end;
end;
{------------------------------------------------------------------------------}
{   Registry handling routines                                                 }
{------------------------------------------------------------------------------}
Function Tresdata.RegReadStr(key:string;which:string;defstr:string):string;
var  Reggy     : TRegistry;
begin
  Reggy:=Tregistry.Create;
  Reggy.Rootkey:=HKEY_LOCAL_MACHINE;
  if Reggy.Keyexists(key) then
  begin
    if Reggy.OpenKey(key,false) then
    begin
      if Reggy.ValueExists(which) then
        RegReadStr:=Reggy.ReadString(which)
      else
        RegReadStr := defstr;
      Reggy.closekey;
    end else
      RegReadStr := defstr;
  end else
    RegReadStr := defstr;
  Reggy.free;
end;
{------------------------------------------------------------------------------}
Function Tresdata.RegReadInt(key:string;which:string;defval:integer):integer;
var  Reggy     : TRegistry;
begin
  Reggy:=Tregistry.Create;
  Reggy.Rootkey:=HKEY_LOCAL_MACHINE;
  if Reggy.Keyexists(key) then
  begin
    if Reggy.OpenKey(key,false) then
    begin
      if Reggy.ValueExists(which) then
        RegReadInt:=Reggy.ReadInteger(which)
      else
        RegReadInt := defval;
      Reggy.closekey;
    end else
      RegReadInt := defval;
  end else
    RegReadInt := defval;
  Reggy.free;
end;
{------------------------------------------------------------------------------}
Procedure Tresdata.RegWriteStr(key:string;which:string;xxx:string);
var  Reggy     : TRegistry;
begin
  Reggy:=Tregistry.Create;
  Reggy.Rootkey:=HKEY_LOCAL_MACHINE;
  if Reggy.OpenKey(key,true) then
  begin
    Reggy.WriteString(which,xxx);
    Reggy.closekey;
  end;
  Reggy.free;
end;
{------------------------------------------------------------------------------}
Procedure Tresdata.RegWriteInt(key:string;which:string;xxx:integer);
var  Reggy     : TRegistry;
begin
  Reggy:=Tregistry.Create;
  Reggy.Rootkey:=HKEY_LOCAL_MACHINE;
  if Reggy.OpenKey(key,true) then
  begin
    Reggy.WriteInteger(which,xxx);
    Reggy.closekey;
  end;
  Reggy.free;
end;
{------------------------------------------------------------------------------}
Procedure Tresdata.RegDeleteItem(key:string;which:string);
var  Reggy     : TRegistry;
begin
  Reggy:=Tregistry.Create;
  Reggy.Rootkey:=HKEY_LOCAL_MACHINE;
  if Reggy.OpenKey(key,true) then
  begin
    Reggy.DeleteValue(which);
    Reggy.CloseKey;
  end;
  Reggy.free;
end;
{------------------------------------------------------------------------------}
{ Extract the FileVersion from the .exe file                                   }
{ Original code by Marc Evans, marc@leviathn.demon.co.uk                       }
{ Delphi2 freeware verlab.zip ,    now shrunk out of recognition               }
{------------------------------------------------------------------------------}
function TResdata.GetInfo: string;
var dump, s: integer;
    vallen: integer;
    buffer, VersionValue: pchar;
    VersionPointer: pchar;
begin
  s := GetFileVersionInfoSize(pchar(Application.Exename), dump);
  if  s = 0 then
  begin
    Result := '< No Data Available >';
  end
  else
  begin
    buffer := StrAlloc(s+1);
    GetFileVersionInfo(Pchar(Application.Exename), 0, s, buffer);
    if VerQueryValue(buffer, pchar('\\StringFileInfo\\080904E4\\FileVersion'),
                     pointer(VersionPointer), vallen) then
    begin
      if (Vallen > 1) then
      begin
        VersionValue := StrAlloc(vallen+1);
        StrLCopy(VersionValue, VersionPointer, vallen);
        Result := VersionValue;
        StrDispose(VersionValue);
      end
      else
        Result := 'No Version Info';
    end
    else
      result := 'Error retrieving version info';
    StrDispose(Buffer);
  end;
end;

end.
unit osdcode;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ColorButton;

type
  TOSDForm = class(TForm)
    OSDTimer: TTimer;
    OSDLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure LabelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure OSDTimerTimer(Sender: TObject);
  private
   { Private declarations }
    FOSD_Pos : integer;
    procedure SetOSDPos(const Value: Integer);
    procedure screensizes(var top1,left1,width1,height1: integer);
    procedure whereshouldIbe(var T,L: integer);
    procedure normalposition;
  public
    procedure ResizeRepositionRepaint;
    { Public declarations }
  published
    property OSDPos: Integer read FOSD_Pos write SetOSDPos default 1;
  end;

var
  OSDForm: TOSDForm;
  OSDExists : boolean;    {stops the timer from playing where it should not}


implementation

uses maincode;

{$R *.DFM}

var
  top1  : integer;
  left1  : integer;
  width1 : integer;
  height1: integer;

const
 WS_EX_LAYERED = $80000;
 LWA_COLORKEY = 1;
 LWA_ALPHA    = 2;

type
 TSetLayeredWindowAttributes = function (
     hwnd : HWND;         // handle to the layered window
     crKey : TColor;      // specifies the color key
     bAlpha : byte;       // value for the blend function
     dwFlags : DWORD      // action
     ): BOOL; stdcall;

{------------------------------------------------------------------------------}
{ XP / 2000 make the OSD partially see through                                 }
{0 making the window completely transparent and 255 making it completely opaque}
{------------------------------------------------------------------------------}
procedure SetTransparentForm(AHandle : THandle; AValue : byte);
var
 Info: TOSVersionInfo;
 SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
begin
 //Check Windows version
 Info.dwOSVersionInfoSize := SizeOf(Info);
 GetVersionEx(Info);
 if (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and
    (Info.dwMajorVersion >= 5) then
   begin
     SetLayeredWindowAttributes :=
      GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
     if Assigned(SetLayeredWindowAttributes) then
     begin
       SetWindowLong(AHandle, GWL_EXSTYLE, GetWindowLong(AHandle, GWL_EXSTYLE)
                                           or WS_EX_LAYERED);
        //Make form transparent
       SetLayeredWindowAttributes(AHandle, 0, AValue, LWA_ALPHA);
     end;
   end;
end;

{------------------------------------------------------------------------------}
{ this determines the size of the screen allowing for the taskbar}
{------------------------------------------------------------------------------}
procedure TOSDForm.screensizes(var top1,left1,width1,height1: integer);
var
  TaskBarHandle: HWnd;    { Handle to the Win95 Taskbar }
  TaskBarCoord:  TRect;   { Coordinates of the Win95 Taskbar }
  CxScreen,               { Width of screen in pixels }
  CyScreen,               { Height of screen in pixels }
  CxFullScreen,           { Width of client area in pixels }
  CyFullScreen,           { Heigth of client area in pixels }
  CyCaption:     Integer; { Height of a window's title bar in pixels }
begin
  TaskBarHandle := FindWindow('Shell_TrayWnd',Nil); { Get Win95 Taskbar handle 104i}
  if TaskBarHandle = 0 then { We're running Win 3.x or WinNT w/o Win95 shell   104i}
  begin
    top1:=0;
    left1:=0;
    width1:=GetSystemMetrics(SM_CXSCREEN);
    height1:=GetSystemMetrics(SM_CYSCREEN);
  end
  else
  begin
    { Get coordinates of the Taskbar }
    GetWindowRect(TaskBarHandle,TaskBarCoord);
    { Get various screen dimensions and set form's width/height }
    CxScreen      := GetSystemMetrics(SM_CXSCREEN);
    CyScreen      := GetSystemMetrics(SM_CYSCREEN);
    CxFullScreen  := GetSystemMetrics(SM_CXFULLSCREEN);
    CyFullScreen  := GetSystemMetrics(SM_CYFULLSCREEN);
    CyCaption     := GetSystemMetrics(SM_CYCAPTION);
    Width1  := CxScreen - (CxScreen - CxFullScreen) + 1;
    Height1 := CyScreen - (CyScreen - CyFullScreen) + CyCaption + 1;
    Top1    := 0;
    Left1   := 0;      {should use locals, then set globals, but...}
    if (TaskBarCoord.Top <= 0) and (TaskBarCoord.Left <= 0) then
      { Taskbar on either top or left }
      if TaskBarCoord.Right > TaskBarCoord.Bottom then
        { Taskbar on top }
        Top1  := TaskBarCoord.Bottom
      else
        { Taskbar on left }
        Left1 := TaskBarCoord.Right;
    {Set the minimum positions and sizes}
  end;
end;

{------------------------------------------------------------------------------}
{ Where Should the OSD go 1=TopLeft 2=TopRight 3=BottomLeft 4=BottomRight      }
{------------------------------------------------------------------------------}
procedure TOSDForm.whereshouldIbe(var T,L: integer);
begin
  case FOSD_Pos of
(1): begin T:=Top1;                  L:=Left1;                end;
(2): begin T:=Top1;                  L:=Left1+Width1-Width-1; end;
(3): begin T:=Top1+Height1-Height-1; L:=Left1;                end;
(4): begin T:=Top1+Height1-Height-1; L:=Left1+Width1-Width-1; end;
else begin T:=Top1;                  L:=Left1;                end;
  end;
end;

{------------------------------------------------------------------------------}
{ Put the OSD where the OSD should go  }
{------------------------------------------------------------------------------}
procedure TOSDForm.normalposition;
var T,L : integer;
begin
  whereshouldIbe(T,L);
  movewindow(handle,L,T,Width,Height,true);
end;

{------------------------------------------------------------------------------}
{ Resize the Form to match the Label, processmessages may not be needed        }
{------------------------------------------------------------------------------}
procedure TOSDForm.ResizeRepositionRepaint;
{var R:TRect;   }
begin
//  Application.ProcessMessages;
  If (OSDLabel.width <> OSDLabel.Canvas.TextWidth(OSDLabel.Caption)) then
  begin
    OSDLabel.width:=OSDLabel.Canvas.TextWidth(OSDLabel.Caption);     {or 4}
    invalidate;
  end;
  If (width <> (OSDLabel.width+2)) then
  begin
    width:=OSDLabel.width+2;
    normalposition;
    invalidate;
  end;
//  Application.ProcessMessages;
end;

{------------------------------------------------------------------------------}
{ Create Form, set size to match label, make label transparent  }
{------------------------------------------------------------------------------}
procedure TOSDForm.FormCreate(Sender: TObject);
begin
  inherited;
  screensizes(top1,left1,width1,height1);
  Height:=OSDLabel.Height+2;
  Width:=OSDLabel.Width+2;
  normalposition;
{  canvas.brush.style:=bsClear;   }
  borderstyle:=bsNone;
  OSDLabel.transparent:=false;
  OSDLabel.Top:=1;
  osdLabel.Left:=1;
  OSDTimer.Interval:=250; {milliseconds}
  OSDExists:=true;
  SetTransparentForm(Handle, 191);    { 75% of 256 -1     }
end;

{------------------------------------------------------------------------------}
{ Set WS_EX_TOOLWINDOW to hide the extra taskbar icon this gets }
{ Set WS_EX_TOPMOST to keep this on top of its parent }
{ Set the parent to the desktop to keep it on top of everything }
{------------------------------------------------------------------------------}
procedure TOSDForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.ExStyle:= Params.ExStyle
                  {or WS_EX_TRANSPARENT}
                  {or WS_EX_AppWindow}
                   or WS_EX_TOOLWINDOW
                   or WS_EX_TOPMOST;
  Params.WndParent := GetDeskTopWindow;   { maybe 0?}
end;

{------------------------------------------------------------------------------}
{ If the mouse moves over the label/form, move it to the opposite corner  }
{------------------------------------------------------------------------------}
procedure TOSDForm.LabelMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var T,L: integer;
var
  p : TPoint;
begin
  {if this happens then the mouse is on top of the button, ie on the form}
  screensizes(top1,left1,width1,height1);
  if (top <= top1) then
    T:=top1+height1-OSDForm.height-1
  else
    T:=top1;
  if (left <= left1) then
    L:=left1+width1-OSDForm.width-1
  else
    L:=left1;
  if (T <> Top) or (L <><l) or (p.x > Left) then
  begin
   { Top:=T;
    Left:=L;   }
    movewindow(handle,L,T,Width,Height,true);
    invalidate;
    If AutoAsk then
    begin
      Application.ProcessMessages;
      MainForm.ReBuildProjectList;
      SetForegroundWindow(Handle);
      GetCursorPos(p);
      MainForm.PopupMenu1.Popup(p.x, p.y);
      PostMessage(Handle, WM_NULL, 0, 0);{to allow the popup to vanish again}
    end;
  end;
end;

{------------------------------------------------------------------------------}
{ Check often if the OSD can be moved back to its home corner and repaint }
{------------------------------------------------------------------------------}
procedure TOSDForm.OSDTimerTimer(Sender: TObject);
var p: Tpoint;
var T, L: integer;
begin
  screensizes(top1,left1,width1,height1);
  {where should the form be?}
  whereshouldIbe(T,L);
  {where is the mouse}
  getcursorpos(p);
  {is the mouse outside where the form will sit}
  if (p.x  (l+width)) or (p.y < t) or (p.y >(t+ height)) then
  begin
    if (T <> Top) or (L <> Left) then
      normalposition;          {yes - put it back where it belongs}
  end
  else
  begin
    {jumpedPosition;  }      {no - do I need to do this?}
  end;
  ResizeRepositionRepaint;
end;

{------------------------------------------------------------------------------}
{ Set the OSD Position }
{------------------------------------------------------------------------------}
procedure TOSDForm.SetOSDPos(const Value: Integer);
begin
  FOSD_Pos:=Value;
  normalposition;
end;
 
end.
unit optionscode;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TOptionsForm = class(TForm)
    Log_OpenDialog: TOpenDialog;
    LogName_ed: TEdit;
    Log_Browse_but: TButton;
    Warn_ud: TUpDown;
    OK_but: TButton;
    Cancel_but: TButton;
    LogName_lab: TLabel;
    Warn_lab: TLabel;
    Interval_lab: TLabel;
    Interval_ed: TEdit;
    Interval_ud: TUpDown;
    Warn_ed: TEdit;
    RegRun_lab: TLabel;
    Autorun_chk: TCheckBox;
    Crash_lab: TLabel;
    RcvName_ed: TEdit;
    Rcv_Browse_but: TButton;
    Rcv_OpenDialog: TOpenDialog;
    mins_w_lab: TLabel;
    mins_i_lab: TLabel;
    GroupBox1: TGroupBox;
    mins_rad: TRadioButton;
    hhmm_rad: TRadioButton;
    hpoint_rad: TRadioButton;
    Show_lab: TLabel;
    date_ed: TEdit;
    date_ud: TUpDown;
    time_ed: TEdit;
    time_ud: TUpDown;
    proj_ed: TEdit;
    proj_ud: TUpDown;
    width_lab: TLabel;
    time_lab: TLabel;
    Proj_lab: TLabel;
    date_lab: TLabel;
    SoundName_ed: TEdit;
    sound_lab: TLabel;
    Sound_OpenDialog: TOpenDialog;
    Sound_browse_but: TButton;
    ProjLab: TLabel;
    ProjName_ed: TEdit;
    Proj_OpenDialog: TOpenDialog;
    Proj_browse_but: TButton;
    hhmmss_rad: TRadioButton;
    Elapsed_lab: TLabel;
    elap_ed: TEdit;
    elap_ud: TUpDown;
    warn_silent_cb: TCheckBox;
    OSDTL_cb: TCheckBox;
    OSDTR_cb: TCheckBox;
    Label1: TLabel;
    OSDBL_cb: TCheckBox;
    OSDBR_cb: TCheckBox;
    procedure OK_butClick(Sender: TObject);
    procedure Cancel_butClick(Sender: TObject);
    procedure Log_Browse_butClick(Sender: TObject);
    procedure Rcv_Browse_butClick(Sender: TObject);
    procedure Sound_Browse_butClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Proj_Browse_butClick(Sender: TObject);
    procedure OSDTL_cbClick(Sender: TObject);
    procedure OSDTR_cbClick(Sender: TObject);
    procedure OSDBL_cbClick(Sender: TObject);
    procedure OSDBR_cbClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  OptionsForm: TOptionsForm;

implementation

uses maincode, rescode, showlogcode;

{$R *.DFM}

{------------------------------------------------------------------------------}
{ Check all the settings for sanity before storing }
{------------------------------------------------------------------------------}
procedure TOptionsForm.OK_butClick(Sender: TObject);
var LogFile : TextFile;
var RcvFile : TextFile;
begin                                             {check the warning time}
  If (Warn_ed.text <> IntToStr(Warn_ud.position)) then   {are we out of limits}
  begin
    Warn_ed.text := IntToStr(Warn_ud.position);
    Warn_ed.setfocus;
    exit;
  end;
                                                  {check the interval time}
  if (Interval_ed.text <> IntToStr(Interval_ud.position)) then  {check limits}
  begin
    Interval_ed.text := IntToStr(Interval_ud.position);
    Interval_ed.setfocus;
    exit;
  end;

  if (Date_ed.text <> IntToStr(Date_ud.position)) then  {check limits}
  begin
    Date_ed.text := IntToStr(Date_ud.position);
    Date_ed.setfocus;
    exit;
  end;

  if (Time_ed.text <> IntToStr(Time_ud.position)) then  {check limits}
  begin
    Time_ed.text := IntToStr(Time_ud.position);
    Time_ed.setfocus;
    exit;
  end;

  if (Elap_ed.text <> IntToStr(Elap_ud.position)) then  {check limits}
  begin
    Elap_ed.text := IntToStr(Elap_ud.position);
    Elap_ed.setfocus;
    exit;
  end;

  if (Proj_ed.text <> IntToStr(Proj_ud.position)) then  {check limits}
  begin
    Proj_ed.text := IntToStr(Proj_ud.position);
    Proj_ed.setfocus;
    exit;
  end;
                                                   {check the log name}
{$I-}
  AssignFile (LogFile, ExpandFileName(LogName_ed.text)); 
  Append (LogFile);                             {can we append or create?}
  if IOResult<>0 then
  begin
    Rewrite (LogFile);
    if IOResult<>0 then
    begin
      LogName_ed.setfocus;
      exit;
    end;
  end;
  CloseFile(LogFile);
{$I+}
                                               {check the crash recovery name}
{$I-}
  AssignFile (RcvFile, ExpandFileName(RcvName_ed.text)); 
  Append (RcvFile);                                {can we append or create?}
  if IOResult<>0 then         {it doesn't exist already}
  begin
    Rewrite (RcvFile);        {this will check if we can create it}
    if IOResult<>0 then
    begin
      RcvName_ed.setfocus;
      exit;
    end;                  {we may have left a file of length 0 out there}
  end;
  CloseFile(RcvFile);
{$I+}

                                                   {check the proj name}
{$I-}
  AssignFile (ProjFile, ExpandFileName(ProjName_ed.text)); {can we append?}
  Append (ProjFile);
  if IOResult<>0 then
  begin
    ProjName_ed.setfocus;
    exit;
  end;
  CloseFile(ProjFile);
{$I+}

  if (Resdata.Log_File_Name <> ExpandFileName(LogName_ed.text)) or
     (Resdata.Date_Chars <> Date_ud.Position ) or
     (Resdata.Time_Chars <> Time_ud.Position ) or
     (Resdata.Elap_Chars <> Elap_ud.Position ) or
     (Resdata.Proj_Chars <> Proj_ud.Position ) or
     (Resdata.Show_HHMM   xor hhmm_rad.checked ) or
     (Resdata.Show_HHMMSS xor hhmmss_rad.checked ) or
     (Resdata.Show_HPoint xor hpoint_rad.checked ) then  {the log needs repaint}
  begin
    Resdata.Date_Chars := Date_ud.Position;
    Resdata.Time_Chars := Time_ud.Position;
    Resdata.Elap_Chars := Elap_ud.Position;
    Resdata.Proj_Chars := Proj_ud.Position;
    Resdata.Show_HHMM   := hhmm_rad.checked;           {set it the right way}
    Resdata.Show_HHMMSS := hhmmss_rad.checked;         {set it the right way}
    Resdata.Show_HPoint := hpoint_rad.checked;         {set it the right way}
    MainForm.ShowLast12;                             {fix the front page}
    if ShowLogForm.SL_RichEdit.Visible then
       ShowLogForm.ShowLog(Resdata.ShowLogRaw);         {rewrite the showlog}
  end;

  if (Resdata.Log_File_Name <> ExpandFileName(LogName_ed.text)) then
    if ShowLogForm.SL_StringGrid.Visible then
    begin
      ShowLogForm.Build_Arrays;
      ShowLogForm.Build_Report;
    end;

  if (Resdata.Proj_File_Name <> ExpandFileName(ProjName_ed.text)) then
  begin
    Mainform.RebuildProjectList;
    Mainform.BuildMenu;
    Mainform.Buildbuttons;
  end;
  
  {if OK then store in registry}
  Resdata.Log_File_Name := ExpandFileName(LogName_ed.text);
  ResData.RegWriteStr(regdatakey,reg_file_name,Resdata.Log_File_Name);

  Resdata.Rcv_File_Name := ExpandFileName(RcvName_ed.text);
  ResData.RegWriteStr(regdatakey,reg_rcv_name,Resdata.Rcv_File_Name);

  Resdata.Proj_File_Name := ExpandFileName(ProjName_ed.text);
  ResData.RegWriteStr(regdatakey,reg_proj_name,Resdata.Proj_File_Name);

  Resdata.Sound_File_Name := ExpandFileName(SoundName_ed.text);
  ResData.RegWriteStr(regdatakey,reg_sound_name,Resdata.Sound_File_Name);

  Resdata.Log_Warn_After := Warn_ud.Position;
  ResData.RegWriteInt(regdatakey,reg_warn_time,Resdata.Log_Warn_After);

  Resdata.Log_Interval_Time := Interval_ud.Position;
  ResData.RegWriteInt(regdatakey,reg_interval_time,Resdata.Log_Interval_Time);

  Resdata.Show_HHMM := hhmm_rad.checked;
  ResData.RegWriteInt(regdatakey,reg_show_hhmm,integer(Resdata.Show_HHMM));
  Resdata.Show_HHMMSS := hhmmss_rad.checked;
  ResData.RegWriteInt(regdatakey,reg_show_hhmmss,integer(Resdata.Show_HHMMSS));
  Resdata.Show_Hpoint := hpoint_rad.checked;
  ResData.RegWriteInt(regdatakey,reg_show_hpoint,integer(Resdata.Show_Hpoint));

  Resdata.Warn_Silent := Warn_Silent_cb.checked;
  ResData.RegWriteInt(regdatakey,reg_Warn_Silent,integer(Resdata.Warn_Silent));

  if OSDTL_cb.checked then resdata.OSD_Type:=1 else
    if OSDTR_cb.checked then resdata.OSD_Type:=2 else
      if OSDBL_cb.checked then resdata.OSD_Type:=3 else
        if OSDBR_cb.checked then resdata.OSD_Type:=4 else
          resdata.OSD_Type:=0;
  ResData.RegWriteInt(regdatakey,reg_OSD_Type,integer(Resdata.OSD_Type));

  Resdata.Date_Chars := Date_ud.Position;
  ResData.RegWriteInt(regdatakey,reg_date_chars,Resdata.Date_Chars);
  Resdata.Time_Chars := Time_ud.Position;
  ResData.RegWriteInt(regdatakey,reg_time_chars,Resdata.Time_Chars);
  Resdata.Elap_Chars := Elap_ud.Position;
  ResData.RegWriteInt(regdatakey,reg_elap_chars,Resdata.Elap_Chars);
  Resdata.Proj_Chars := Proj_ud.Position;
  ResData.RegWriteInt(regdatakey,reg_proj_chars,Resdata.Proj_Chars);

  if Autorun_chk.State = cbChecked then  {insert into registry}
  begin
    ResData.RegWriteStr(regrunkey,reg_name,ParamStr(0));
  end else
  if Autorun_chk.State = cbUnchecked then  {remove from registry}
  begin
    ResData.RegDeleteItem(regrunkey,reg_name);
  end else
  if Autorun_chk.State = cbGrayed then      {don't change anything}
  begin
  end;
  OptionsForm.Close;
end;
{------------------------------------------------------------------------------}
{                              BUTTONS and checkboxes                          }
{------------------------------------------------------------------------------}
procedure TOptionsForm.Cancel_butClick(Sender: TObject);
begin
  OptionsForm.Close;
end;

procedure TOptionsForm.Log_Browse_butClick(Sender: TObject);
begin
  if Log_OpenDialog.Execute then   {opened and user chose OK}
  begin
    LogName_ed.text := Log_OpenDialog.FileName;
  end;
end;

procedure TOptionsForm.Sound_Browse_butClick(Sender: TObject);
begin
  if Sound_OpenDialog.Execute then   {opened and user chose OK}
  begin
    SoundName_ed.text := Sound_OpenDialog.FileName;
  end;
end;

procedure TOptionsForm.Proj_Browse_butClick(Sender: TObject);
begin
  if Proj_OpenDialog.Execute then   {opened and user chose OK}
  begin
    ProjName_ed.text := Proj_OpenDialog.FileName;
  end;
end;

procedure TOptionsForm.Rcv_Browse_butClick(Sender: TObject);
begin
  if Rcv_OpenDialog.Execute then   {opened and user chose OK}
  begin
    RcvName_ed.text := Rcv_OpenDialog.FileName;
  end;
end;

procedure TOptionsForm.OSDTL_cbClick(Sender: TObject);
begin
  if OSDTL_cb.checked then
  begin
    OSDTR_cb.checked:=false;
    OSDBL_cb.checked:=false;
    OSDBR_cb.checked:=false;
  end;
end;

procedure TOptionsForm.OSDTR_cbClick(Sender: TObject);
begin
  if OSDTR_cb.checked then
  begin
    OSDTL_cb.checked:=false;
    OSDBL_cb.checked:=false;
    OSDBR_cb.checked:=false;
  end;
end;

procedure TOptionsForm.OSDBL_cbClick(Sender: TObject);
begin
  if OSDBL_cb.checked then
  begin
    OSDTR_cb.checked:=false;
    OSDTL_cb.checked:=false;
    OSDBR_cb.checked:=false;
  end;
end;

procedure TOptionsForm.OSDBR_cbClick(Sender: TObject);
begin
  if OSDBR_cb.checked then
  begin
    OSDTR_cb.checked:=false;
    OSDBL_cb.checked:=false;
    OSDTL_cb.checked:=false;
  end;
end;
{------------------------------------------------------------------------------}
{                                                                              }
{------------------------------------------------------------------------------}
procedure TOptionsForm.FormActivate(Sender: TObject);
var s1 : string  [255];
begin                                         {fill the boxes}
   Log_OpenDialog.FileName := ExtractFileName(Resdata.Log_File_Name);
   Log_OpenDialog.InitialDir := ExtractFilePath(Resdata.Log_File_Name);
   LogName_ed.text := Resdata.Log_File_Name;

   Rcv_OpenDialog.FileName := ExtractFileName(Resdata.Rcv_File_Name);
   Rcv_OpenDialog.InitialDir := ExtractFilePath(Resdata.Rcv_File_Name);
   RcvName_ed.text := Resdata.Rcv_File_Name;

   Proj_OpenDialog.FileName := ExtractFileName(Resdata.Proj_File_Name);
   Proj_OpenDialog.InitialDir := ExtractFilePath(Resdata.Proj_File_Name);
   ProjName_ed.text := Resdata.Proj_File_Name;

   Sound_OpenDialog.FileName := ExtractFileName(Resdata.Sound_File_Name);
   Sound_OpenDialog.InitialDir := ExtractFilePath(Resdata.Sound_File_Name);
   SoundName_ed.text := Resdata.Sound_File_Name;

   Warn_ud.position := Resdata.Log_Warn_After;
   Warn_ed.text := IntToStr(Resdata.Log_Warn_After);

   Interval_ud.position := Resdata.Log_Interval_Time;
   Interval_ed.text := IntToStr(Resdata.Log_Interval_Time);

   Date_ud.position := Resdata.Date_Chars;
   Date_ed.text := IntToStr(Resdata.Date_Chars);
   Time_ud.position := Resdata.Time_Chars;
   Time_ed.text := IntToStr(Resdata.Time_Chars);
   Elap_ud.position := Resdata.Elap_Chars;
   Elap_ed.text := IntToStr(Resdata.Elap_Chars);
   Proj_ud.position := Resdata.Proj_Chars;
   Proj_ed.text := IntToStr(Resdata.Proj_Chars);

   hhmm_rad.checked  := (Resdata.show_hhmm);
   hhmmss_rad.checked:= (Resdata.show_hhmmss);
   hpoint_rad.checked:= (Resdata.show_hpoint);
   mins_rad.checked  :=not(hhmm_rad.checked or hhmmss_rad.checked
                                            or hpoint_rad.checked );

   Warn_Silent_cb.checked  := (Resdata.warn_silent);

   case resdata.osd_type of
   (1): OSDTL_cb.checked:=true;
   (2): OSDTr_cb.checked:=true;
   (3): OSDBL_cb.checked:=true;
   (4): OSDBR_cb.checked:=true;
   else;
   end;


   s1:=  ResData.RegReadStr(regrunkey,reg_name,'notfound') ;
   If (s1 = ParamStr(0)) then      {its there and it matches}
     Autorun_chk.State := cbChecked
   else
     if (s1 <> 'notfound') then    {its there but its another name}
       Autorun_chk.State := cbGrayed
     else                           {its not there at all}
       Autorun_chk.State := cbUnchecked ;

  OptionsForm.Caption:=program_name + op1;
end;

end.
unit addprojcode;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, shellapi;

type
  TAddProjForm = class(TForm)
    Code_ed: TEdit;
    Proj_ed: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    OK_but: TButton;
    Cancel_but: TButton;
    Edit_Project_File_but: TButton;
    procedure Cancel_butClick(Sender: TObject);
    procedure OK_butClick(Sender: TObject);
    procedure Edit_Project_File_butClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AddProjForm: TAddProjForm;

implementation

uses maincode, rescode, showlogcode;

{$R *.DFM}

{-------------------------------------------------------------------------}
{ Cancel button pressed }
{-------------------------------------------------------------------------}
procedure TAddProjForm.Cancel_butClick(Sender: TObject);
begin
  AddProjForm.Close;
end;

{-------------------------------------------------------------------------}
{ OK button pressed, check name valid and store }
{-------------------------------------------------------------------------}
procedure TAddProjForm.OK_butClick(Sender: TObject);
var xxx : string;
begin
  If length (trim(Proj_ed.text)) <> 0 then
  begin   {put it on the end of the ini file}
    xxx:=trim(Code_ed.text) + '=' + trim(Proj_ed.text);
{$I-}
    AssignFile (ProjFile, Resdata.Proj_File_Name);
    Append (ProjFile);
    if IOResult<>0 then
    begin
      Rewrite (ProjFile);
      if IOResult<>0 then
      begin
        MessageDlg(msg_Proj_io, mtWarning, [mbOK], 0);
        Exit;
      end;
    end;
    Writeln(ProjFile, xxx); {this is where we write to the project file}
    CloseFile(ProjFile);   {it will always be open at this stage}
{$I+}
    AddProjForm.Close;    {mainform will update the arrays for us}
  end else
  begin       {if there is a code then complain about missing name }
    if length (trim(Code_ed.text)) <> 0 then
    begin
       MessageDlg(msg_no_add, mtWarning, [mbOK], 0);
       proj_ed.setfocus;
    end
    else
      AddProjForm.Close;    {mainform will update the arrays for us}
  end;
end;

{-------------------------------------------------------------------------}
{ Edit Project File button pressed, invoke default 'open'er ('edit' ? ) }
{-------------------------------------------------------------------------}
procedure TAddProjForm.Edit_Project_File_butClick(Sender: TObject);
var xxx: array[0..255] of char;
begin
  code_ed.text:='';
  proj_ed.text:='';
  strpcopy(xxx,Resdata.Proj_File_Name);
  ShellExecute(Handle, 'open', xxx , nil, nil, SW_SHOWNORMAL);
  {dont close the form, let OK or cancel be pushed}
  {ignore failures}
end;

{-------------------------------------------------------------------------}
{ Clear the form each time }
{-------------------------------------------------------------------------}
procedure TAddProjForm.FormActivate(Sender: TObject);
begin
    code_ed.text:='';
    proj_ed.text:='';
    showwindow(application.handle,SW_SHOW); {taskbar button}
end;

{-------------------------------------------------------------------------}
{ When closing, hide the taskbar icon if required  }
{-------------------------------------------------------------------------}
procedure TAddProjForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if not((mainform.visible) or (showlogform.visible)) then
    showwindow(application.handle,SW_HIDE); {taskbar button}
end;

end.

unit aboutcode;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ShellAPI;

type
  TAboutForm = class(TForm)
    OK_but: TButton;
    line1_lab: TLabel;
    line3_lab: TLabel;
    iconimage: TImage;
    line4_lab: TLabel;
    WWWLink_lab: TLabel;
    version_lab: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure OK_butClick(Sender: TObject);
    procedure WWWLink_labClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Label1DblClick(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure Label3DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AboutForm: TAboutForm;

implementation

uses rescode;

{$R *.DFM}

{-------------------------------------------------------------------------}
{ OK button pressed }
{-------------------------------------------------------------------------}
procedure TAboutForm.OK_butClick(Sender: TObject);
begin
   AboutForm.Close;
end;

{-------------------------------------------------------------------------}
{  single click passes a URL to the shell, Internet Explorer should fire up  }
{-------------------------------------------------------------------------}
procedure TAboutForm.WWWLink_labClick(Sender: TObject);
var where : array [0..255] of char;
begin
  StrPCopy(@where,www_ref);
  ShellExecute(Handle, 'open', @where, nil, nil, SW_SHOW); {ignore failures}
end;

{-------------------------------------------------------------------------}
{ the URL is a resource string , overwrite the one on the form            }
{ FormCreate is called as the program starts, don't make it too heavy     }
{-------------------------------------------------------------------------}
procedure TAboutForm.FormCreate(Sender: TObject);
begin
  WWWLink_lab.Caption := www_ref;
  version_lab.Caption := ab1 + Resdata.GetInfo;
  AboutForm.Caption   := program_name + ab2;
  line1_lab.Caption   := program_name + ab3;
end;

{-------------------------------------------------------------------------}
{  double click passes a URL to the shell, Internet Explorer should fire up  }
{-------------------------------------------------------------------------}
procedure TAboutForm.Label1DblClick(Sender: TObject);
var where : array [0..63] of char;
begin
  StrPCopy(@where,'http://www.menees.com');
  ShellExecute(Handle, 'open', @where, nil, nil, SW_SHOW); {ignore failures}
end;

procedure TAboutForm.Label2Click(Sender: TObject);
var where : array [0..63] of char;
begin
  StrPCopy(@where,'http://jansfreeware.com');
  ShellExecute(Handle, 'open', @where, nil, nil, SW_SHOW); {ignore failures}
end;

procedure TAboutForm.Label3DblClick(Sender: TObject);
var where : array [0..63] of char;
begin
  StrPCopy(@where,'http://delphi.about.com');
  ShellExecute(Handle, 'open', @where, nil, nil, SW_SHOW); {ignore failures}
end;

end.

Page last updated 08 Jan 2005.