if iAvailFiles<4 then begin showmessage('You need to be in a directory with more images'); end (*no ; here*) else begin sTmp:=(FileListBox1.Items[random(iAvailFiles)]); image1.picture.loadfromfile(sTmp); end; (*else*)Now when you run the program, you should be able to see all of the images if you click the New Question button often enough. (They should come up in a random sequence. Add "Randomize" to the FormCreate handler to get a different "random" sequence each time you run the program. (That's not as daft as it seems, but a topic for another day!)
sAnswerIs:=sTmp; buAns1.caption:=sTmp;Now when you run the program and click on the New Question button, you should see the name of the displayed bitmap on the first of the three answer buttons. Assuming that your images will always be names SOMETHING.bmp, to strip off the ".bmp" part, you can modify what we just added and make it...
sAnswerIs:=copy(sTmp,1,length(sTmp)-4); buAns1.caption:=sAnswerIs;Now... what we have so far is not a very hard test! We need "distarctors", i.e wrong answers, and we should make it so that the right button to click is not always the first one!! (And we need to create handlers for the three answer buttons.
implementation {$R *.DFM}add something just to make sure the basics are okay:
procedure TDD30f1.SetUpAnswerButtonsEtc; (*Before calling this procedure.... 1) The folder the images are in must have been selected via DirectoryListBox1 and FileListBox1. 2) iAvailFiles must have been set. 3) sAnswerIs must have been set. *) begin buAns1.caption:=sAnswerIs; buAns2.caption:='Two'; buAns1.caption:='Three'; end;Now replace the last line of buNewQClick (which at present should be "buAns1.caption:=sAnswerIs;") with....
procedure TDD30f1.SetUpAnswerButtonsEtc; (*Before calling this procedure.... 1) The folder the images are in must have been selected via DirectoryListBox1 and FileListBox1. 2) iAvailFiles must have been set. 3) sAnswerIs must have been set. *) begin buAns1.caption:=sAnswerIs; repeat sTmp:=(FileListBox1.Items[random(iAvailFiles)]); sTmp:=copy(sTmp,1,length(sTmp)-4); until sTmp<>sAnswerIs; buAns2.caption:=sTmp; repeat sTmp:=(FileListBox1.Items[random(iAvailFiles)]); sTmp:=copy(sTmp,1,length(sTmp)-4); until (sTmp<>sAnswerIs) and (sTmp<>buAns2.caption); buAns3.caption:=sTmp; end;This is pretty crude, and it leaves the first button as always the right answer. When you are sure you see what is going on above, reprogram SetUpAnswerButtonsEtc again to make it the following, which is less pedestrian but more elegant, AND it "shuffles" the captions of the buttons so that the right button is not always the first button.
procedure TDD30f1.SetUpAnswerButtonsEtc; (*Before calling this procedure.... 1) The folder the images are in must have been selected via DirectoryListBox1 and FileListBox1. 2) iAvailFiles must have been set. 3) sAnswerIs must have been set. *) var sTmp2,sTmp3,sTmpTmp:string; c1:byte; begin buAns1.caption:=sAnswerIs; repeat sTmp2:=(FileListBox1.Items[random(iAvailFiles)]); sTmp2:=copy(sTmp2,1,length(sTmp2)-4); until sTmp2<>sAnswerIs; repeat sTmp3:=(FileListBox1.Items[random(iAvailFiles)]); sTmp3:=copy(sTmp3,1,length(sTmp3)-4); until (sTmp3<>sAnswerIs) and (sTmp3<>sTmp2); sTmp:=sAnswerIs; (*Shuffle (Could probably be improved!)*) if random>0.5 then begin sTmpTmp:=sTmp; sTmp:=sTmp2; sTmp2:=sTmpTmp; end; if random>0.5 then begin sTmpTmp:=sTmp; sTmp:=sTmp3; sTmp3:=sTmpTmp; end; if random>0.5 then begin sTmpTmp:=sTmp2; sTmp2:=sTmp3; sTmp3:=sTmpTmp; end; if random>0.5 then begin sTmpTmp:=sTmp; sTmp:=sTmp3; sTmp3:=sTmpTmp; end; (*Shuffle finished*) buAns1.caption:=sTmp; buAns2.caption:=sTmp2; buAns3.caption:=sTmp3; end;We're now going to create a single chunk of code to handle the clicking of any of the three answer buttons. It will need to check whether the right button was pressed, and respond accordingly. That will include generating a new question if the current question is answered correctly.
implementation {$R *.DFM}... add...
procedure TDD30f1.ChooseOne; begin end;... BUT DON'T TRY TO COMPILE OR RUN YET.
procedure TDD30f1.buAns1Click(Sender: TObject); var sPrevRight:string; begin if sender=buAns1 then sTmp:=buAns1.caption; if sender=buAns2 then sTmp:=buAns2.caption; if sender=buAns3 then sTmp:=buAns3.caption; (*I suspect that the previous three lines can be done more elegantly. sTmp:=sender.caption didn't work.*) if sTmp=sAnswerIs then begin sPrevRight:=sAnswerIs; (*Prevent same question arising twice in a row*) repeat ChooseOne; until sAnswerIs<>PrevRight; end; end;The name of that handler, buAns1Click, is misleading. DO NOT TRY TO EDIT THE NAME WITHIN THE SOURCECODE! Instead, go to the Object Inspector (press f11), get to the OnClick field for any of the answer buttons, e.g. buAns1, and edit the name in the OnClick field. All necessary changes will be made in your source code. (References to the old name, buAns1Click won't be altered, however, if they are in program comments.)
unit MGA14u1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FileCtrl, ExtCtrls, Buttons; type TMGA14f1 = class(TForm) Image1: TImage; buNewQ: TButton; FileListBox1: TFileListBox; DirectoryListBox1: TDirectoryListBox; laAvailImages: TLabel; meCopyright: TMemo; buCopyrightOK: TButton; Button1: TButton; BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn3: TBitBtn; procedure buNewQClick(Sender: TObject); procedure DirectoryListBox1Change(Sender: TObject); procedure FileListBox1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure SetUpAnswerButtonsEtc; procedure ChooseOne; procedure buAllAnsClick(Sender: TObject); procedure Button1Click(Sender: TObject); procedure buCopyrightOKClick(Sender: TObject); private { Private declarations } iAvailFiles:integer; sTmp,sAnswerIs,sPrevRight:string; public { Public declarations } end; var MGA14f1: TMGA14f1; implementation {$R *.DFM} procedure TMGA14f1.ChooseOne; begin if iAvailFiles<4 then begin BitBtn1.enabled:=false; BitBtn2.enabled:=false; BitBtn3.enabled:=false; showmessage('You need to be in a directory with more images'); end (*no ; here*) else begin BitBtn1.enabled:=true; BitBtn2.enabled:=true; BitBtn3.enabled:=true; repeat sTmp:=(FileListBox1.Items[random(iAvailFiles)]); image1.picture.loadfromfile(sTmp); sAnswerIs:=copy(sTmp,1,length(sTmp)-4); SetUpAnswerButtonsEtc; until sAnswerIs<>sPrevRight; end; (*else*) end; procedure TMGA14f1.SetUpAnswerButtonsEtc; (*Before calling this procedure.... 1) The folder the images are in must have been selected via DirectoryListBox1 and FileListBox1. 2) iAvailFiles must have been set. 3) sAnswerIs must have been set. *) var sTmp2,sTmp3,sTmpTmp:string; c1:byte; begin repeat sTmp2:=(FileListBox1.Items[random(iAvailFiles)]); sTmp2:=copy(sTmp2,1,length(sTmp2)-4); until sTmp2<>sAnswerIs; repeat sTmp3:=(FileListBox1.Items[random(iAvailFiles)]); sTmp3:=copy(sTmp3,1,length(sTmp3)-4); until (sTmp3<>sAnswerIs) and (sTmp3<>sTmp2); sTmp:=sAnswerIs; (*Shuffle (Could probably be improved!)*) if random>0.5 then begin sTmpTmp:=sTmp; sTmp:=sTmp2; sTmp2:=sTmpTmp; end; if random>0.5 then begin sTmpTmp:=sTmp; sTmp:=sTmp3; sTmp3:=sTmpTmp; end; if random>0.5 then begin sTmpTmp:=sTmp2; sTmp2:=sTmp3; sTmp3:=sTmpTmp; end; if random>0.5 then begin sTmpTmp:=sTmp; sTmp:=sTmp3; sTmp3:=sTmpTmp; end; (*Shuffle finished*) BitBtn1.caption:=sTmp; BitBtn2.caption:=sTmp2; BitBtn3.caption:=sTmp3; BitBtn1.font.color:=clBtnText; BitBtn2.font.color:=clBtnText; BitBtn3.font.color:=clBtnText; end; procedure TMGA14f1.buNewQClick(Sender: TObject); begin sPrevRight:=sAnswerIs; ChooseOne; end; procedure TMGA14f1.DirectoryListBox1Change(Sender: TObject); begin FileListBox1.Directory := DirectoryListBox1.Directory; end; procedure TMGA14f1.FileListBox1Change(Sender: TObject); begin iAvailFiles:=FileListBox1.Items.Count; laAvailImages.caption:='Available images: '+inttostr(iAvailFiles); end; procedure TMGA14f1.FormCreate(Sender: TObject); begin sPrevRight:=''; meCopyright.hide; buCopyrightOK.hide; iAvailFiles:=FileListBox1.Items.Count; Randomize end; procedure TMGA14f1.buAllAnsClick(Sender: TObject); begin if sender=BitBtn1 then sTmp:=BitBtn1.caption; if sender=BitBtn2 then sTmp:=BitBtn2.caption; if sender=BitBtn3 then sTmp:=BitBtn3.caption; (*I suspect that the previous three lines can be done more elegantly. sTmp:=sender.caption didn't work.*) if sTmp=sAnswerIs then begin (*Act on right answer*) sPrevRight:=sAnswerIs; (*Prevent same question arising twice in a row*) repeat ChooseOne; until sAnswerIs<>sPrevRight; end (*no ; here*) else (*Act on wrong answer*) begin if sender=BitBtn1 then BitBtn1.font.color:=clred; if sender=BitBtn2 then BitBtn2.font.color:=clred; if sender=BitBtn3 then BitBtn3.font.color:=clred; end;(*else*) end; procedure TMGA14f1.Button1Click(Sender: TObject); begin meCopyright.show; buCopyrightOK.show; end; procedure TMGA14f1.buCopyrightOKClick(Sender: TObject); begin meCopyright.hide; buCopyrightOK.hide; end; end.
|
Click here to visit editor's freeware, shareware page.
Page WILL BE tested for compliance with INDUSTRY (not MS-only) standards, using the free, publicly accessible validator at validator.w3.org
....... P a g e . . . E n d s .....