WebBrowser1: TWebBrowser;
StatusBar1: TStatusBar;
ProgressBar1: TProgressBar;
OpenDialog1: TOpenDialog;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton6: TToolButton;
ComboBox1: TComboBox;
ToolButton8: TToolButton;
ToolButton1: TToolButton;
Timer1: TTimer;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
procedure ComboBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure WebBrowser1StatusTextChange(Sender: TObject;
const Text: WideString);
procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ToolButton7Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure ToolButton8Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{procedure ExecWB(cmdID: OLECMDID; cmdexecopt:OLECMDEXECOPT); overload;}
{ Public declarations }
end;
var
Form37: TForm37;
z,time1:integer;m:string;
implementation
uses Unit19, kontr;
{$R *.DFM}
procedure TForm37.ComboBox1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
{if Key = VK_RETURN then
WebBrowser1.Navigate(ComboBox1.Text);}
end;
procedure TForm37.ToolButton1Click(Sender: TObject);
begin
{ if OpenDialog1.Execute then
begin
WebBrowser1.Navigate(OpenDialog1.FileName);
ComboBox1.Text := OpenDialog1.FileName;
end;}
timer1.Enabled:=false;
close;
end;
procedure TForm37.ToolButton2Click(Sender: TObject);
begin
z:=z+1;
WebBrowser1.GoBack;
ToolButton3.Enabled:=true;
end;
procedure TForm37.ToolButton3Click(Sender: TObject);
begin
z:=z–1;
if z>–1 then WebBrowser1.GoForward else ToolButton3.Enabled:=false;
end;
procedure TForm37.ToolButton4Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;
procedure TForm37.ToolButton5Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;
procedure TForm37.ToolButton6Click(Sender: TObject);
var
PostData, Headers: OLEvariant;
begin
WebBrowser1.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, PostData,Headers);
end;
procedure TForm37.WebBrowser1StatusTextChange(Sender: TObject;const Text: WideString);
begin
StatusBar1.SimpleText := Text;
end;
procedure TForm37.WebBrowser1ProgressChange(Sender: TObject; Progress,ProgressMax: Integer);
begin
ProgressBar1.Max := ProgressMax;
ProgressBar1.Position := Progress;
end;
procedure TForm37.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false;
Form37.Hide;
ElektKursInf.Show;
ElektKursInf.Button1.Enabled:=true;
end;
procedure TForm37.ToolButton7Click(Sender: TObject);
const CGID_WebBrowser: TGUID = '{ED016940–BD5B–11cf–BA4E–00C04FD70816}';
{var
CmdTarget : IOleCommandTarget;
vaIn, vaOut: OleVariant;
PtrGUID: PGUID;}
begin
{New(PtrGUID);
PtrGUID^ := CGID_WebBrowser;
if WebBrowser1.Document <> nil then
try
WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
if CmdTarget <> nil then
try
CmdTarget.Exec( PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
finally
CmdTarget._Release;
end;
except
// nothing
end;
Dispose(PtrGUID);}
end;
procedure TForm37.FormShow(Sender: TObject);
begin
time1:=0;
timer1.Enabled:=true;
Form37.Caption:=ElektKursInf.ListBox2.Items.Strings[ElektKursInf.ListBox2.ItemIndex];
end;
procedure TForm37.WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
var l:integer;
begin
end;
procedure TForm37.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Combobox1.Text:=WebBrowser1.LocationURL;
if (ElektKursInf.ListBox1.Items.Strings[ElektKursInf.ListBox1.ItemIndex]<>WebBrowser1.LocationURL)then ToolButton2.Enabled:=true else ToolButton2.Enabled:=false;
end;
procedure TForm37.ToolButton8Click(Sender: TObject);
begin
Form2.Show;
Form37.Hide;
end;
procedure TForm37.Timer1Timer(Sender: TObject);
begin
time1:=time1+timer1.interval;
end;
procedure TForm37.N1Click(Sender: TObject);
begin
close;
end;
end.
5. Модуль контрольного тестирования
unit tester_;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ExtCtrls,
jpeg, Gauges;
type
TForm1 = class(TForm)
// вопрос
Label5: TLabel;
// альтернативныеответы
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
// радиокнопкивыбораответа
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
Image1: TImage; // областьвыводаиллюстрации
Button1: TButton;
Panel1: TPanel;
RadioButton5: TRadioButton;
Gauge1: TGauge;
Timer1: TTimer;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure RadioButtonClick(Sender: TObject);
// Эти объявления вставлены сюда вручную
procedure Info;
procedure VoprosToScr;
procedure ShowPicture; // выводитиллюстрацию
procedure ResetForm; // "очистка" формы перед выводом очередного вопроса
procedure Itog;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject); // результаттестирования
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1; // форма
implementation
uses Unit19, Unit1, Unit44;
{$R *.DFM}
const
N_LEV=4; // четыре уровня оценки
N_ANS=4; // четыре варианта ответов
var
f,fil1:TextFile;
fn:string; // имяфайлавопросов
level:array[1..N_LEV] of integer; // сумма, соответствующаяуровню
mes:array[1..N_LEV] of string; // сообщение, соответствующееуровню
score:array[1..N_ANS] of integer; // оценказавыборответа
summa:integer; // набраноочков
vopros:integer; // номертекущеговопроса
otv:integer; // номер выбранного ответа
// вывод информации о тесте
procedure Tform1.Info;
var
s,buf:string;
begin
readln(f,s);
Form1.Caption := s;
buf:='';
repeat
readln(f,s);
if s[1] <> '.'
then buf := buf +s + #13;
until s[1] ='.';
Label5.caption:=buf;
end;
// прочитать информацию об оценках за тест
Procedure GetLevel;
var
i:integer;
buf:string;
begin
i:=1;
repeat
readln(f,buf);
if buf[1] <> '.' then begin
mes[i]:=buf; // сообщение
readln(f,level[i]); // оценка
i:=i+1;
end;
until buf[1]='.';
end;
// масштабированиеиллюстрации
Procedure TForm1.ShowPicture;
var
w,h: integer; // максимально возможные размеры картинки
begin
// вычислить допустимые размеры картинки
w:=ClientWidth–10;
h:=ClientHeight
– Panel1.Height –10
– Label5.Top
– Label5.Height – 10;
// вопросы
if Label1.Caption <> ''
then h:=h–Label1.Height–10;
if Label2.Caption <> ''
then h:=h–Label2.Height–10;
if Label3.Caption <> ''
then h:=h–Label3.Height–10;
if Label4.Caption <> ''
then h:=h–Label4.Height–10;
// если размер картинки меньше w на h,
// тоонанемасштабируется
Image1.Top:=Form1.Label5.Top+Label5.Height+10;
if Image1.Picture.Bitmap.Height > h
then Image1.Height:=h
else Image1.Height:= Image1.Picture.Height;
if Image1.Picture.Bitmap.Width > w
then Image1.Width:=w
else Image1.Width:=Image1.Picture.Width;
Image1.Visible := True;
end;
// вывестивопрос
Procedure TForm1.VoprosToScr;
var
i:integer;
s,buf:string;
ifn:string; // файлиллюстрации
begin
vopros:=vopros+1;
caption:='Вопрос ' + IntToStr(vopros);
// прочитатьвопрос
buf:='';
repeat
readln(f,s);
if (s[1] <> '.') and (s[1] <> '\')
then buf:=buf+s+' ';
until (s[1] ='.') or (s[1] ='\');
Label5.caption:=buf; // вывести вопрос
{Иллюстрацию прочитаем, но выведем только послетого, как прочитаем альтернативные ответыи определим максимально возможный размеробласти формы, который можно использоватьдля ее вывода.}
if s[1] <> '\'
then Image1.Tag:=0 // к вопросу нет иллюстрации
else // к вопросу есть иллюстрация
begin
Image1.Tag:=1;
ifn:=copy(s,2,length(s));
try
Image1.Picture.LoadFromFile(ifn);
except
on E:EFOpenError do
Image1.Tag:=0;
end;
end;
// Читаем варианты ответов
i:=1;
repeat
buf:='';
repeat // читаем текст варианта ответа
readln(f,s);
if (s[1]<>'.') and (s[1] <> ',')
then buf:=buf+s+' ';
until (s[1]=',')or(s[1]='.');
// прочитан альтернативный ответ
score[i]:= StrToInt(s[2]);
case i of
1: Label1.caption:=buf;
2: Label2.caption:=buf;
3: Label3.caption:=buf;
4: Label4.caption:=buf;
end;
i:=i+1;
until s[1]='.';
// здесь прочитана иллюстрация и альтернативные ответы
// текст вопроса уже выведен
if Image1.Tag =1 // есть иллюстрация к вопросу
then ShowPicture;
// выводальтернативныхответов
if Form1.Label1.Caption <> ''
then begin
if Form1.Image1.Tag =1
then Label1.top:=Image1.Top+Image1.Height+10
else Label1.top:=Label5.Top+Label5.Height+10;
RadioButton1.top:=Label1.top;
Label1.visible:=TRUE;
RadioButton1.visible:=TRUE;
end;
if Form1.Label2.Caption <> ''
then begin
Label2.top:=Label1.top+ Label1.height+10;
RadioButton2.top:=Label2.top;
Label2.visible:=TRUE;
RadioButton2.visible:=TRUE;
end;
if Form1.Label3.Caption <> ''
then begin
Label3.top:=Label2.top+ Label2.height+10;
RadioButton3.top:=Label3.top;
Label3.visible:=TRUE;
RadioButton3.visible:=TRUE;
end;
if Form1.Label4.Caption <> ''
then begin
Label4.top:=Label3.top+ Label3.height+10;
RadioButton4.top:=Label4.top;
Label4.visible:=TRUE;
RadioButton4.visible:=TRUE;
end;
end;
Procedure TForm1.ResetForm;
begin // сделать невидимыми все метки и радиокнопки
Label1.Visible:=FALSE;
Label1.caption:='';
Label1.width:=ClientWidth–Label1.left–5;
RadioButton1.Visible:=FALSE;
Label2.Visible:=FALSE;
Label2.caption:='';
Label2.width:=ClientWidth–Label2.left–5;
RadioButton2.Visible:=FALSE;
Label3.Visible:=FALSE;
Label3.caption:='';
Label3.width:=ClientWidth–Label3.left–5;
RadioButton3.Visible:=FALSE;
Label4.Visible:=FALSE;
Label4.caption:='';
Label4.width:=ClientWidth–Label4.left–5;
RadioButton4.Visible:=FALSE;
Label5.width:=ClientWidth–Label5.left–5;
Image1.Visible:=FALSE;
end;
// определение достигнутого уровня
procedure TForm1.Itog;
var
i:integer;
buf:string;
begin
buf:='';
buf:='Результаты тестирования'+ #13
+'Всего баллов: '+ IntToStr(summa);
i:=1;
while (summa < level[i]) and (i<N_LEV) do
i:=i+1;
buf:=buf+ #13+mes[i];
Label5.Top:=20;
Label5.caption:=buf;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
end;
// щелчокнакнопке Button1
procedure TForm1.Button1Click(Sender: TObject);
var s,s2,s1,s3,s4,s5,s6,s7,k,tim1:string;i,j,l,l1,l2:integer;tim:integer;
begin
case Button1.tag of
0: begin
Button1.caption:='Дальше';
Button1.tag:=1;
RadioButton5.Checked:=TRUE;
// выводпервоговопроса
Timer1.Enabled:=true;
Gauge1.Visible:=true;
Button1.Enabled:=False;
ResetForm;
VoprosToScr;
end;
1: begin // выводостальныхвопросов
summa:=summa+score[otv];
RadioButton5.Checked:=TRUE;
Button1.Enabled:=False;
ResetForm;
if not eof(f)
then VoprosToScr
else
begin
summa:=summa+score[otv];
closefile(f);
Button1.caption:='Ok';
Form1.caption:='Результат';
Button1.tag:=2;
Button1.Enabled:=TRUE;
Itog; // вывестирезультат
end;
end;
2: begin // завершениеработы
Timer1.Enabled:=false;
s:='';
assignfile(fil1,'bd\result.txt');
reset(fil1);
s:='';
while not eof(fil1) do
begin
readln(fil1,s2);
s:=s+s2;
end;
closefile(fil1);
s1:='';
for i:=1 to length(s) do begin
if (s[i] = '*') then begin
if s1=zagl.Edit1.Text then begin
j:=i+1;
s3:='';
while s[j]<>'#' do begin
if s[j]='&' then begin
tim:=time1+StrToInt(s3);
delete(s,i+1,j–1–i–1);
tim1:=FloatToStr(tim);
insert(tim1,s,i+1);
s3:='';
end;
if s[j]='$' then begin
if summa>=7 then begin
l:=StrToInt(s[j–1])+1;
delete(s,j–1,1);
s7:=IntToStr(l);
insert(s7,s,j–1);
s3:='';
end
else l:=StrToInt(s[j–1]);
if summa>=7 then begin
s5:=s[j+1]+s[j+2];
l2:=StrToInt(s5);
delete(s,j+1,2);
l2:=l2+summa;
s6:=IntToStr(l2);
if length(s6)=1 then s6:=' '+s6;
insert(s6,s,j+1);
end;
end;
s3:=s3+s[j];
j:=j+1;
end;
end;
end;
s1:=s1+s[i];
if (s[i]='#') then s1:='';
end;
rewrite(fil1);
s4:='';
for i:=1 to length(s) do
begin
s4:=s4+s[i];
if s[i]='#' then begin
writeln(fil1,s4);
s4:='';
end;
end;
closefile(fil1);
assignfile(fil1,'bd\result1.txt');
reset(fil1);
s:='';
while not eof(fil1) do
begin