Pastebin launched a little side project called HostCabi.net, check it out ;-)Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on Feb 27th, 2012  |  syntax: None  |  size: 7.58 KB  |  hits: 22  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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.