?
Solved

Automatic alarm

Posted on 2003-03-11
6
Medium Priority
?
423 Views
Last Modified: 2010-04-04
Hello All,

I want write a program which sounds an alarm at predefined times.
USER SHOULD BE ABLE TO:-
* enter start date and time (DateTimePicker) and end date time (DateTimePicker).
* select the sound file to play.
* enter the duration of the sound.
* select interval between each alarm.(SpinEdit)
* select dates on which the alarm should keep quiet.(should have a DateTimePicker to pick the dates)

Grateful if you could provide some sample codes.
Any Help Please..
Thanks
0
Comment
Question by:Deluxion
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 11

Expert Comment

by:robert_marquardt
ID: 8110138
This is not really a Delphi question.
The main task is to design a user interface for entering alarm times.

* enter start date and time (DateTimePicker) and end date time (DateTimePicker).
  This is silly. You want an alarm which is a time point not a duration.

* select the sound file to play.
  Needs a "preview" button to play the selected file.
* enter the duration of the sound.
  The duration is determined by the WAV file. Duration is therefore silly.
 
* select interval between each alarm.(SpinEdit)
  Here the user interface needs to be carefully designed.
  You want to enter two different task kinds. Single shot alarms and repeated alarms.
* select dates on which the alarm should keep quiet.(should have a DateTimePicker to pick the dates)
  This is a task list of its own.

You need at first two lists of tasks.
One for the alarms and one for the alarm suppression.
Each list can take either single shot elements or repeating elements.

From the alarm list the next outstanding alarm point is generated and waited for.

When firing the suppression list is asked if the alarm should play or not.
The sound is played or not.

Back to next outstanding alarm point.
0
 

Author Comment

by:Deluxion
ID: 8112384
I agree that this is not a Delphi specific question, however I am going to write this program in Delphi. (so that makes it delphi question, atleast for me :-)).

Anyways thanks for your comments robert.

Actually it should read "automatic bell" and not "automatic alarm".

Well it is kind of an automatic bell program that I am going to write, which, once you program it then it keeps sounding the bell whenever neccessary.

Thanks
any body has sample codes please....
0
 
LVL 4

Expert Comment

by:cjm30305
ID: 8113950
I have some, but you need to be more specific.  Mine actaully is a scheuler.  What it does is launch an application at a specific time, or interval, that you specify.  It could be modified though to sound an alarm.  I will put some code in for you.  

/////////////////////////////////

unit
......

  public
    TimeToExecute  : String;
    DateToExecute  : String;

procedure TForm1.btnExecuteClick(Sender: TObject);
begin

 Timer1.Enabled := False;

 if CheckBox1.State = cbChecked then
  WaitOnProcess := True;
 if CheckBox1.State = cbUnChecked then
  WaitOnProcess := False;

  TimeToExecute := TimeToStr(dtpTime.Time);
  DateToExecute := DateToStr(dtpDate.Date);

  Timer1.Interval := 200;
  Timer1.Enabled := True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 if (TimeToExecute = TimeToStr(Time)) and
    (DateToExecute = DateToSTr(Date))
  then
   begin
    StartExecution;
   end;
end;

procedure TForm1.StartExecution;
var
 Count: Integer;
 CurrentExe: String;
begin
 try
  //Sound your alarm!!!!!!
  SysUtils.Beep; // Beep or call multimedia now!
  Label1.Caption := 'Last run status: Success';
 except
  MessageDlg('Internal Error: TForm1.StartExecution ' + #13#10 + 'Could not sound alarm!', mtError, [mbOK], 0);
 end;
end;
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Accepted Solution

by:
krukmat earned 2000 total points
ID: 8114729
There are 2 units: the ufmain where is the part fo configuration and uThreadAlarm which is the alarm. If you want the sources give me your mail and i ll send u.
One thing: The application will be iconified in the taskbar.
unit uFMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, MPlayer,uAlarmThread, Menus,ShellAPI,ExtCtrls;
const
  WM_ICONTRAY = WM_USER + 1;   // User-defined message

type
  TSilentDates = array [0..2000] of TDateTime;
  TConfigRecord = record
    startDate,endDate:TDateTime;
    fileWAV:string;
    durationsound:word; //seconds
    intervalSound:word; //seconds
    numSilentDates:word; //see TSilentDates
  end;

  TfMain = class(TForm)
    dtStart: TDateTimePicker;
    Label1: TLabel;
    dtEnd: TDateTimePicker;
    Label2: TLabel;
    WavButton: TButton;
    WavDialog: TOpenDialog;
    dtSilentDate: TDateTimePicker;
    Label3: TLabel;
    eDuration: TEdit;
    Label4: TLabel;
    eInterval: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    btnExecute: TButton;
    btnChangeSeetings: TButton;
    cboxSilentDates: TComboBox;
    eWAVSel: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    PopupMenu1: TPopupMenu;
    Exit1: TMenuItem;
    Restaure1: TMenuItem;
    procedure WavButtonClick(Sender: TObject);
    procedure btnAddSilentDateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnChangeSeetingsClick(Sender: TObject);
    procedure btnChangeDurationClick(Sender: TObject);
    procedure btnChangeIntervalAlarmClick(Sender: TObject);
    procedure btnExecuteClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Restaure1Click(Sender: TObject);
  private
    { Private declarations }
   alarm:TAlarmThread;
   change:boolean;
   procedure UpdateConfigFiles;
   procedure UpdateConfigRecord;
   procedure AddSilentDate;
   procedure LoadConfigFileInRecord;
   procedure SomethingWrongInFiles;
   procedure DefaultConfigValues;
   procedure IConize;
   procedure CloseMainForm(Sender:TObject);
  public
    { Public declarations }
   function inInterval(myDate:TDateTime):boolean;
   function isSilentDay(mDate:TDateTime):boolean;
   procedure Icontray(var Msg: TMessage); message WM_ICONTRAY;
  end;

var
  fMain: TfMain;
  ConfigRecord:TConfigRecord;
  SilentDates:TSilentDates;
  NotifyIconData: TNotifyIconData;

implementation
uses
  DateUtils,Types;
const
  CONFFILE= 'C:\MyConfigAlarm.dat';
  SILENTFILE= 'C:\SilentDates.dat';


{$R *.dfm}


function TfMain.isSilentDay;
var
  i:word;
begin
  result:=false;
  i:=1;
  while (i<=ConfigRecord.numSilentDates) and (not result) do
  begin
    result:=int(SilentDates[i])=Int(mDate);
    inc(i);
  end;


end;

procedure TfMain.SomethingWrongInFiles;
begin
   ShowMessage('Problems Loading/Saving in Config Files');
   Application.Terminate;
end;

procedure TfMain.UpdateConfigFiles;
var
  ConfigFile:TextFile;
  i:word;
begin
  try
    AssignFile(ConfigFile,CONFFILE);
    rewrite(ConfigFile);
    writeln(ConfigFile,DateToStr(ConfigRecord.startDate));
    writeln(ConfigFile,DateToStr(ConfigRecord.endDate));
    writeln(ConfigFile,ConfigRecord.FileWAV);
    writeln(ConfigFile,IntToStr(ConfigRecord.durationsound));
    writeln(ConfigFile,IntToStr(ConfigRecord.intervalSound));
    writeln(ConfigFile,IntToStr(ConfigRecord.numSilentDates));
    closefile(ConfigFile);
    AssignFile(ConfigFile,SILENTFILE);
    rewrite(ConfigFile);
    for i:=1 to ConfigRecord.numSilentDates do
      writeln(ConfigFile,DateToStr(SilentDates[i]));
    closefile(ConfigFile);
  except
    SomethingWrongInFiles;
  end;
end;


procedure TfMain.UpdateConfigRecord;
begin
  ConfigRecord.startDate:=dtStart.DateTime;
  ConfigRecord.endDate:=dtEnd.DateTime;
  ConfigRecord.fileWAV:=WavDialog.FileName;
  ConfigRecord.durationsound:=StrToInt(eDuration.Text);
  ConfigRecord.intervalSound:=StrToInt(eInterval.Text);
  Change:=true;
end;
procedure TfMain.AddSilentDate;
begin
  ConfigRecord.numSilentDates:=ConfigRecord.numSilentDates+1;
  SilentDates[ConfigRecord.numSilentDates]:=dtSilentDate.DateTime;
  Change:=true;
end;
procedure TfMain.LoadConfigFileInRecord;
var
  ConfigFile:TextFile;
  tmpString:string;
  i:word;
begin
  if not FileExists(CONFFILE) then
  begin
    DefaultConfigValues;
    exit;
  end;
  try
    AssignFile(ConfigFile,CONFFILE);
    reset(ConfigFile);
    readln(ConfigFile,tmpString);
    ConfigRecord.startDate:=StrToDate(tmpString);
    dtStart.DateTime:=ConfigRecord.startDate;
    readln(ConfigFile,tmpString);
    ConfigRecord.endDate:=StrToDate(tmpString);
    dtEnd.DateTime:=ConfigRecord.endDate;
    readln(ConfigFile,tmpString);
    ConfigRecord.FileWAV:=tmpString;
    WavDialog.FileName:=ConfigRecord.FileWAV;
    eWAVSel.Text:=ConfigRecord.FileWAV;
    readln(ConfigFile,tmpString);
    ConfigRecord.durationsound:=StrToInt(tmpString);
    eDuration.Text:=tmpString;
    readln(ConfigFile,tmpString);
    ConfigRecord.intervalSound:=StrToInt(tmpString);
    eInterval.Text:=tmpString;
    readln(ConfigFile,tmpString);
    ConfigRecord.numSilentDates:=StrToInt(tmpString);
    closefile(ConfigFile);
    AssignFile(ConfigFile,SILENTFILE);
    reset(ConfigFile);
    for i:=1 to ConfigRecord.numSilentDates do
    begin
      readln(ConfigFile,tmpString);
      SilentDates[i]:=StrToDate(tmpString);
      cboxSilentDates.Items.Add(tmpString);
    end;
    closefile(ConfigFile);
  except
    SomethingWrongInFiles;
  end;
end;

procedure TfMain.DefaultConfigValues;
begin
  UpdateConfigRecord;
  ConfigRecord.numSilentDates:=0;
end;

function TfMain.inInterval(myDate:TDateTime):boolean;
var
  bool:boolean;
begin
  bool:=CompareDate(myDate,ConfigRecord.startDate) = GreaterThanValue;
  bool:=bool and (CompareDate(myDate,ConfigRecord.endDate)= LessThanValue);
  result:=bool;
end;

procedure TfMain.WavButtonClick(Sender: TObject);
begin
  if WavDialog.Execute then
  begin
    UpdateConfigRecord;
    eWAVSel.Text:=ConfigRecord.fileWAV;
  end;
end;

procedure TfMain.btnAddSilentDateClick(Sender: TObject);
begin
  if inInterval(dtSilentDate.DateTime) then
    AddSilentDate
  else
    ShowMessage('You should select between '+DateToStr(ConfigRecord.startDate)+' and '+DateToStr(ConfigRecord.endDate));
end;


procedure TFMain.Iconize;
begin
  with NotifyIconData do
  begin
    hIcon := Icon.Handle;
    StrPCopy(szTip, Application.Title);
    Wnd := Handle;
    uCallbackMessage := WM_ICONTRAY;
    uID := 1;
    uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
    cbSize := sizeof(TNotifyIconData);
  end;
  with TTimer.Create(self) do
  begin
    enabled:=false;
    Interval:=10;
    OnTimer:=CloseMainForm;
    enabled:=true;
  end;

end;

procedure TFMain.CloseMainForm(Sender:TObject);
begin
  close;
  (Sender as TTimer).Free;
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
   alarm:=nil;
   LoadConfigFileInRecord;
   cboxSilentDates.ItemIndex:=0;
   Change:=false;
   IConize;
end;

procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caNone;
  Hide;
  Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
end;

procedure TfMain.btnChangeSeetingsClick(Sender: TObject);
begin
  UpdateConfigRecord;
end;

procedure TfMain.btnChangeDurationClick(Sender: TObject);
begin
  UpdateConfigRecord;
end;

procedure TfMain.btnChangeIntervalAlarmClick(Sender: TObject);
begin
  UpdateConfigRecord;
end;

procedure TfMain.btnExecuteClick(Sender: TObject);
begin
  alarm:=TAlarmThread.Create;
end;


procedure TFMain.Icontray(var Msg: TMessage);
var
  CursorPos : TPoint;
begin
  if Msg.lParam = WM_RBUTTONDOWN then begin
  begin
    GetCursorPos(CursorPos);
    PopupMenu1.Popup(CursorPos.x, CursorPos.y);
  end
  end else
    inherited;
end;


procedure TfMain.Exit1Click(Sender: TObject);
begin
  if alarm<>nil then alarm.Terminate;
  if (Change) and (MessageDlg('Apply last changes?',
    mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
       UpdateConfigFiles;
  Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
  Application.ProcessMessages;
  Application.Terminate;
end;

procedure TfMain.Restaure1Click(Sender: TObject);
begin
  Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
  Show;
end;

end.


Here is the other unit:


unit UAlarmThread;

interface

uses
  Windows,Classes,MPlayer;

type
  TAlarmThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;

implementation
uses
  uFMain,SysUtils,Controls,DateUtils,idGlobal,MMSystem;

{ uAlarmThread }

constructor TAlarmThread.Create;
begin
  inherited Create(false);
  FreeOnTerminate:=true;
  priority:=tpLowest;
end;

procedure TAlarmThread.Execute;
var
  count:int64;
begin
  while not terminated do
  begin
    if (fMain.inInterval(Now)) and (not fMain.isSilentDay(Now)) then
    begin
      while (not terminated) do
      begin
        count:=getTickCount;
        while (not terminated) and (getTickCount-count<ConfigRecord.durationsound*1000) do
           PlaySound(PChar(ConfigRecord.fileWAV),0,SND_FILENAME);
        sleep(ConfigRecord.intervalSound*1000);
      end;
    end
    else
      sleep(5000);
  end;
  { Place thread code here }
end;

end.
 
0
 

Author Comment

by:Deluxion
ID: 8116660
krukmat, Thanks for your help, my email is deluxion@hotmail.com.
0
 

Author Comment

by:Deluxion
ID: 8116673
your help is appreciated :-)
0

Featured Post

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Suggested Courses
Course of the Month9 days, 15 hours left to enroll

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question