Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit UnitMain;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
- StdCtrls, MMSystem;
- {MMSystem used for PlaySound}
- type
- { TfrmMain }
- TfrmMain = class(TForm)
- btnSubmit: TButton;
- edMin: TEdit;
- edHour: TEdit;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- lblSound: TLabel;
- lblCorrect: TLabel;
- procedure btnSubmitClick(Sender: TObject);
- procedure edHourKeyPress(Sender: TObject; var Key: char);
- procedure edMinKeyPress(Sender: TObject; var Key: char);
- procedure FormCreate(Sender: TObject);
- procedure FormPaint(Sender: TObject);
- procedure lblSoundClick(Sender: TObject);
- procedure lblSoundMouseEnter(Sender: TObject);
- procedure lblSoundMouseLeave(Sender: TObject);
- private
- { private declarations }
- public
- hour:integer; {Holds the Hour Time}
- min:integer; {Holds the Minute Time}
- correct:integer; {Holds the number correctly answered}
- question:integer; {Holds the number Of questions asked}
- SoundOn:boolean; {Holds the value if the sound is on or not}
- NewQuestion:boolean; {Holds the value to allow a new question to be asked}
- SoundMissing:boolean; {Holds the value if the soundfiles are missing or not}
- procedure GetHourMin; {Gets the random min and hour for the hands}
- procedure DrawClock; {Draws the clock to the form}
- procedure CheckAnswer; {Checks the answer}
- end;
- var
- frmMain: TfrmMain;
- implementation
- { TfrmMain }
- procedure TfrmMain.CheckAnswer;
- begin
- try
- begin
- if (hour = StrToInt(edHour.Text)) and (min = StrToInt(edMin.Text)) then
- begin {if answer is correct}
- correct := correct + 1;
- if (SoundOn = True) and (SoundMissing = False) then
- PlaySound('Sound/Claps.wav',0,SND_ASYNC);
- end
- else {answer not correct}
- begin
- if (SoundOn = True) and (SoundMissing = False) then
- PlaySound('Sound/Oops.wav',0,SND_ASYNC);
- if min = 0 then
- ShowMessage ('The Time Is: ' + IntToStr(hour) + ' : 00')
- else if min = 5 then
- ShowMessage ('The Time Is: ' + IntToStr(hour) + ' : 05')
- else
- ShowMessage ('The Time Is: ' + IntToStr(hour) + ' : ' + IntToStr(min));
- end;
- question := question + 1;
- lblCorrect.Caption := 'Correct: ' + IntToStr(Correct) + '/' + IntToStr(Question);
- edMin.Clear; {clears edit min box}
- edHour.Clear; {clears hour box}
- edHour.SetFocus; {sets text cursor to hour box}
- NewQuestion := True; {allows a new question to be asked}
- refresh; {refreshes the form}
- end {try}
- Except {if a non-number was placed in edMin or edHour}
- ShowMessage('Something Other Than A Number Was Entered - The Answer Boxes Are Cleared - Please Try Again');
- edMin.Clear; {clears the edMin box}
- edHour.Clear; {clears the edHour box}
- edHour.SetFocus; {the text cursor is placed in edHour - ready for input}
- end; {end except}
- end; {end procedure Check Answer}
- procedure TfrmMain.DrawClock;
- var
- AdjHours:real; {AdjHours is used to move the hour hand partly around the clock
- based upon how many mins there are in the question.
- Example 6:30 the hour hand will be half way between 6 and 7}
- const
- Pi = 3.14;
- begin
- Canvas.Pen.Color := clBlack;
- Canvas.Pen.Width := 10;
- Canvas.Brush.Color := clInactiveCaptionText; {fills in the clock}
- Canvas.Ellipse(50,50,500,500); {draws the circle}
- Canvas.Font.Size := 30; {Sets font size used in TextOut}
- Canvas.TextOut(254,59, '12'); {x and y coorinates then text}
- Canvas.TextOut(363,83, '1');
- Canvas.TextOut(425,153, '2');
- Canvas.TextOut(457,250, '3');
- Canvas.TextOut(425,347, '4');
- Canvas.TextOut(362,417, '5');
- Canvas.TextOut(260,440, '6');
- Canvas.TextOut(165,417, '7');
- Canvas.TextOut(96,347, '8');
- Canvas.TextOut(70,250, '9');
- Canvas.TextOut(95,153, '10');
- Canvas.TextOut(165,83, '11');
- AdjHours := hour + min /60;
- {Draws Hour Hand}
- Canvas.Pen.Color := clRed;
- Canvas.Pen.Width := 25;
- Canvas.Line(275,275,trunc(130*cos((Pi) / 180*(30*AdjHours-90))+275) , trunc(135*Sin((Pi) / 180*(30*AdjHours - 90))+275));
- {Draws Min Hand}
- Canvas.Pen.Color := clGreen;
- Canvas.Pen.Width := 10;
- Canvas.Line(275,275,trunc(175*cos((Pi)/180*(6*min-90))+275), trunc(160*Sin((Pi)/180*(6*min - 90)) +275));
- {Draws Black Circle in Center Of Clock}
- Canvas.Pen.Color := clBlack;
- Canvas.Pen.Width:= 20;
- Canvas.Ellipse(265,265,285,285);
- end; {end DrawClock}
- procedure TfrmMain.GetHourMin;
- begin
- randomize; {sets randomize}
- hour := random(12) + 1; {random(12) gets 0 - 11 so adding 1 gets 1 - 12}
- randomize; {sets randomize}
- repeat {repeat until min = a value that is div by 5, so not something like 3:21}
- min := random(60);
- until ((min = 0) or (min = 5) or (min = 10) or (min = 15) or (min = 20)
- or (min = 25) or (min = 30) or (min = 35) or (min = 40)
- or (min = 45) or (min = 50) or (min = 55));
- end;
- procedure TfrmMain.btnSubmitClick(Sender: TObject);
- begin {if both edit boxes are not blank}
- if (edHour.Text <> '') and (edMin.Text <> '') then
- CheckAnswer;
- end;
- procedure TfrmMain.edHourKeyPress(Sender: TObject; var Key: char);
- begin {if both edit boxes are not blank and enter key is pressed}
- if (edHour.Text <> '') and (edMin.text <> '') and (Key = Chr(13)) then
- begin
- Key := ' '; {prevents a ding sound}
- CheckAnswer;
- end;
- end;
- procedure TfrmMain.edMinKeyPress(Sender: TObject; var Key: char);
- begin {if both edit boxes are not blank and enter key is pressed}
- if (edHour.Text <> '') and (edMin.text <> '') and (Key = Chr(13)) then
- begin
- Key := ' '; {prevents a ding sound}
- CheckAnswer;
- end;
- end;
- procedure TfrmMain.FormCreate(Sender: TObject); {When the form starts}
- begin
- Question := 0;
- Correct := 0;
- SoundOn := True; {Sound is turned on}
- SoundMissing := False; {Sound Files are Not Missing}
- {Checks to see if the sound files exist}
- if not FileExists('Sound/claps.wav') then
- SoundMissing := True;
- if not FileExists('Sound/oops.wav') then
- SoundMissing := True;
- {Sound files are missing}
- if SoundMissing = True then
- ShowMessage('Sound Files Are Missing. Please Re-Install The Program');
- {Allows a new question to be given}
- NewQuestion := True;
- refresh; {refreshes the form so new question is given}
- end;
- procedure TfrmMain.FormPaint(Sender: TObject);
- begin {use FormPaint to prevent the clock from disappearing}
- if NewQuestion = True then
- GetHourMin; {gets the min and hour for the DrawClock to draw hands}
- DrawClock; {Draws the Clock}
- NewQuestion := False; {makes sure that the hands are not gotten until needed}
- end;
- procedure TfrmMain.lblSoundClick(Sender: TObject);
- begin {toggles the sound on and off, if clicked}
- if SoundOn = True then
- begin
- lblSound.Caption := 'Turn Sound On';
- SoundOn := False;
- end
- else
- begin
- lblSound.Caption := 'Turn Sound Off';
- SoundOn := True;
- end;
- end;
- procedure TfrmMain.lblSoundMouseEnter(Sender: TObject);
- begin {cursor is like that of a cursor over a weblink}
- lblSound.Cursor := crHandPoint;
- end;
- procedure TfrmMain.lblSoundMouseLeave(Sender: TObject);
- begin {cursor retrns to normal}
- lblSound.Cursor := crDefault;
- end;
- initialization
- {$I unitmain.lrs}
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement