Advertisement
Guest User

Untitled

a guest
Feb 27th, 2012
43
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.58 KB | None | 0 0
  1. unit UnitMain;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8. Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  9. StdCtrls, MMSystem;
  10. {MMSystem used for PlaySound}
  11. type
  12.  
  13. { TfrmMain }
  14.  
  15. TfrmMain = class(TForm)
  16. btnSubmit: TButton;
  17. edMin: TEdit;
  18. edHour: TEdit;
  19. Label1: TLabel;
  20. Label2: TLabel;
  21. Label3: TLabel;
  22. lblSound: TLabel;
  23. lblCorrect: TLabel;
  24. procedure btnSubmitClick(Sender: TObject);
  25. procedure edHourKeyPress(Sender: TObject; var Key: char);
  26. procedure edMinKeyPress(Sender: TObject; var Key: char);
  27. procedure FormCreate(Sender: TObject);
  28. procedure FormPaint(Sender: TObject);
  29. procedure lblSoundClick(Sender: TObject);
  30. procedure lblSoundMouseEnter(Sender: TObject);
  31. procedure lblSoundMouseLeave(Sender: TObject);
  32. private
  33. { private declarations }
  34. public
  35. hour:integer; {Holds the Hour Time}
  36. min:integer; {Holds the Minute Time}
  37. correct:integer; {Holds the number correctly answered}
  38. question:integer; {Holds the number Of questions asked}
  39. SoundOn:boolean; {Holds the value if the sound is on or not}
  40. NewQuestion:boolean; {Holds the value to allow a new question to be asked}
  41. SoundMissing:boolean; {Holds the value if the soundfiles are missing or not}
  42. procedure GetHourMin; {Gets the random min and hour for the hands}
  43. procedure DrawClock; {Draws the clock to the form}
  44. procedure CheckAnswer; {Checks the answer}
  45. end;
  46.  
  47. var
  48. frmMain: TfrmMain;
  49.  
  50. implementation
  51.  
  52. { TfrmMain }
  53.  
  54. procedure TfrmMain.CheckAnswer;
  55. begin
  56. try
  57. begin
  58. if (hour = StrToInt(edHour.Text)) and (min = StrToInt(edMin.Text)) then
  59. begin {if answer is correct}
  60. correct := correct + 1;
  61. if (SoundOn = True) and (SoundMissing = False) then
  62. PlaySound('Sound/Claps.wav',0,SND_ASYNC);
  63. end
  64. else {answer not correct}
  65. begin
  66. if (SoundOn = True) and (SoundMissing = False) then
  67. PlaySound('Sound/Oops.wav',0,SND_ASYNC);
  68. if min = 0 then
  69. ShowMessage ('The Time Is: ' + IntToStr(hour) + ' : 00')
  70. else if min = 5 then
  71. ShowMessage ('The Time Is: ' + IntToStr(hour) + ' : 05')
  72. else
  73. ShowMessage ('The Time Is: ' + IntToStr(hour) + ' : ' + IntToStr(min));
  74. end;
  75. question := question + 1;
  76.  
  77. lblCorrect.Caption := 'Correct: ' + IntToStr(Correct) + '/' + IntToStr(Question);
  78.  
  79. edMin.Clear; {clears edit min box}
  80. edHour.Clear; {clears hour box}
  81. edHour.SetFocus; {sets text cursor to hour box}
  82.  
  83. NewQuestion := True; {allows a new question to be asked}
  84. refresh; {refreshes the form}
  85. end {try}
  86. Except {if a non-number was placed in edMin or edHour}
  87. ShowMessage('Something Other Than A Number Was Entered - The Answer Boxes Are Cleared - Please Try Again');
  88. edMin.Clear; {clears the edMin box}
  89. edHour.Clear; {clears the edHour box}
  90. edHour.SetFocus; {the text cursor is placed in edHour - ready for input}
  91. end; {end except}
  92. end; {end procedure Check Answer}
  93.  
  94. procedure TfrmMain.DrawClock;
  95.  
  96. var
  97. AdjHours:real; {AdjHours is used to move the hour hand partly around the clock
  98. based upon how many mins there are in the question.
  99. Example 6:30 the hour hand will be half way between 6 and 7}
  100.  
  101. const
  102. Pi = 3.14;
  103.  
  104. begin
  105. Canvas.Pen.Color := clBlack;
  106. Canvas.Pen.Width := 10;
  107. Canvas.Brush.Color := clInactiveCaptionText; {fills in the clock}
  108. Canvas.Ellipse(50,50,500,500); {draws the circle}
  109. Canvas.Font.Size := 30; {Sets font size used in TextOut}
  110. Canvas.TextOut(254,59, '12'); {x and y coorinates then text}
  111. Canvas.TextOut(363,83, '1');
  112. Canvas.TextOut(425,153, '2');
  113. Canvas.TextOut(457,250, '3');
  114. Canvas.TextOut(425,347, '4');
  115. Canvas.TextOut(362,417, '5');
  116. Canvas.TextOut(260,440, '6');
  117. Canvas.TextOut(165,417, '7');
  118. Canvas.TextOut(96,347, '8');
  119. Canvas.TextOut(70,250, '9');
  120. Canvas.TextOut(95,153, '10');
  121. Canvas.TextOut(165,83, '11');
  122.  
  123. AdjHours := hour + min /60;
  124.  
  125. {Draws Hour Hand}
  126. Canvas.Pen.Color := clRed;
  127. Canvas.Pen.Width := 25;
  128. Canvas.Line(275,275,trunc(130*cos((Pi) / 180*(30*AdjHours-90))+275) , trunc(135*Sin((Pi) / 180*(30*AdjHours - 90))+275));
  129.  
  130. {Draws Min Hand}
  131. Canvas.Pen.Color := clGreen;
  132. Canvas.Pen.Width := 10;
  133. Canvas.Line(275,275,trunc(175*cos((Pi)/180*(6*min-90))+275), trunc(160*Sin((Pi)/180*(6*min - 90)) +275));
  134.  
  135. {Draws Black Circle in Center Of Clock}
  136. Canvas.Pen.Color := clBlack;
  137. Canvas.Pen.Width:= 20;
  138. Canvas.Ellipse(265,265,285,285);
  139.  
  140. end; {end DrawClock}
  141.  
  142. procedure TfrmMain.GetHourMin;
  143. begin
  144. randomize; {sets randomize}
  145. hour := random(12) + 1; {random(12) gets 0 - 11 so adding 1 gets 1 - 12}
  146.  
  147. randomize; {sets randomize}
  148.  
  149. repeat {repeat until min = a value that is div by 5, so not something like 3:21}
  150. min := random(60);
  151. until ((min = 0) or (min = 5) or (min = 10) or (min = 15) or (min = 20)
  152. or (min = 25) or (min = 30) or (min = 35) or (min = 40)
  153. or (min = 45) or (min = 50) or (min = 55));
  154.  
  155. end;
  156.  
  157. procedure TfrmMain.btnSubmitClick(Sender: TObject);
  158. begin {if both edit boxes are not blank}
  159. if (edHour.Text <> '') and (edMin.Text <> '') then
  160. CheckAnswer;
  161.  
  162. end;
  163.  
  164.  
  165. procedure TfrmMain.edHourKeyPress(Sender: TObject; var Key: char);
  166. begin {if both edit boxes are not blank and enter key is pressed}
  167. if (edHour.Text <> '') and (edMin.text <> '') and (Key = Chr(13)) then
  168. begin
  169. Key := ' '; {prevents a ding sound}
  170. CheckAnswer;
  171. end;
  172. end;
  173.  
  174. procedure TfrmMain.edMinKeyPress(Sender: TObject; var Key: char);
  175. begin {if both edit boxes are not blank and enter key is pressed}
  176. if (edHour.Text <> '') and (edMin.text <> '') and (Key = Chr(13)) then
  177. begin
  178. Key := ' '; {prevents a ding sound}
  179. CheckAnswer;
  180. end;
  181. end;
  182.  
  183. procedure TfrmMain.FormCreate(Sender: TObject); {When the form starts}
  184. begin
  185.  
  186. Question := 0;
  187. Correct := 0;
  188.  
  189. SoundOn := True; {Sound is turned on}
  190. SoundMissing := False; {Sound Files are Not Missing}
  191.  
  192. {Checks to see if the sound files exist}
  193. if not FileExists('Sound/claps.wav') then
  194. SoundMissing := True;
  195. if not FileExists('Sound/oops.wav') then
  196. SoundMissing := True;
  197.  
  198. {Sound files are missing}
  199. if SoundMissing = True then
  200. ShowMessage('Sound Files Are Missing. Please Re-Install The Program');
  201.  
  202. {Allows a new question to be given}
  203. NewQuestion := True;
  204. refresh; {refreshes the form so new question is given}
  205. end;
  206.  
  207. procedure TfrmMain.FormPaint(Sender: TObject);
  208. begin {use FormPaint to prevent the clock from disappearing}
  209. if NewQuestion = True then
  210. GetHourMin; {gets the min and hour for the DrawClock to draw hands}
  211.  
  212. DrawClock; {Draws the Clock}
  213. NewQuestion := False; {makes sure that the hands are not gotten until needed}
  214.  
  215. end;
  216.  
  217. procedure TfrmMain.lblSoundClick(Sender: TObject);
  218. begin {toggles the sound on and off, if clicked}
  219. if SoundOn = True then
  220. begin
  221. lblSound.Caption := 'Turn Sound On';
  222. SoundOn := False;
  223. end
  224. else
  225. begin
  226. lblSound.Caption := 'Turn Sound Off';
  227. SoundOn := True;
  228. end;
  229. end;
  230.  
  231. procedure TfrmMain.lblSoundMouseEnter(Sender: TObject);
  232. begin {cursor is like that of a cursor over a weblink}
  233. lblSound.Cursor := crHandPoint;
  234. end;
  235.  
  236. procedure TfrmMain.lblSoundMouseLeave(Sender: TObject);
  237. begin {cursor retrns to normal}
  238. lblSound.Cursor := crDefault;
  239. end;
  240.  
  241. initialization
  242. {$I unitmain.lrs}
  243.  
  244. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement