📄 login.pas
字号:
procedure TfrmLogin.Timer1Timer(Sender: TObject);
begin
dec(countdown);
lblCount.Caption:='倒计时:'+inttostr(countdown);
if countdown<=0 then
begin
//禁止答卷并自动评分与交卷
Timer1.Enabled:=false;
BtnEnd.Click;
end
else
if countdown=5 then
begin
lblCount.Font.Color:=clred;
Application.MessageBox('离考试结束还有5分钟', '信息', 64+ MB_TASKMODAL)
end;
end;
procedure TfrmLogin.btnMinClick(Sender: TObject);
begin
application.Minimize; //最小化
end;
procedure TfrmLogin.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if timer1.Enabled then
Begin
Application.MessageBox('交卷后才能退出考试系统', '信息', 64+ MB_TASKMODAL);
CanClose:=false;
end;
end;
procedure TfrmLogin.FlatSpeedButton2Click(Sender: TObject);
begin
//退出系统
close;
end;
procedure TfrmLogin.ADOQuery1AfterScroll(DataSet: TDataSet);
var
num:integer;
begin
Label6.Visible:=false;
//考试是否已开始
if (timer1.Enabled) or (BtnEnd.Caption<>'交卷') then
begin
with ADOQuery1 do
begin
num:=FieldByName('题号').Value;
//如果无考生答案显示未作答
if ans[num].examinee='' then Label6.Visible:=true;
ChkA.checked:=false;
ChkB.checked:=false;
ChkC.checked:=false;
ChkD.checked:=false;
if FieldValues['题型']='判断题' then
begin
gupBoxCheck.Visible:=true;
ChkA.Caption:='对';
ChkB.Caption:='错';
ChkC.Visible:=false;
ChkD.Visible:=false;
//根据存储的考生答案还原选区
if ans[num].examinee='对' then
ChkA.checked:=true
else
if ans[num].examinee='错' then
ChkB.checked:=true;
end
else
if FieldValues['题型']='选择题' then
begin
gupBoxCheck.Visible:=true;
ChkA.Caption:='A';
ChkB.Caption:='B';
ChkC.Visible:=true;
ChkD.Visible:=true;
if pos('A',ans[num].examinee)<>0 then ChkA.Checked:=true;
if pos('B',ans[num].examinee)<>0 then ChkB.Checked:=true;
if pos('C',ans[num].examinee)<>0 then ChkC.Checked:=true;
if pos('D',ans[num].examinee)<>0 then ChkD.Checked:=true;
end
else
if FieldValues['题型']='操作题' then
begin
Label6.Visible:=false;
gupBoxCheck.Visible:=false;
end;
end;
end;
if (BtnEnd.Caption<>'交卷') then
begin
lblright.Caption:=' ';
//反馈正确否
if (gupBoxCheck.Visible) and (DBText2.Visible) then
if (ans[num].standard=ans[num].examinee) and (ans[num].examinee<>'') then
lblright.Caption:='√'
else
lblright.Caption:='×';
end;
end;
procedure TfrmLogin.ChkAClick(Sender: TObject);
begin
if (chkA.Caption='对') and chkB.Checked and (chkA.Checked=false) then chkB.Checked :=false;
end;
procedure TfrmLogin.ChkBClick(Sender: TObject);
begin
if (chkA.Caption='对') and (chkA.Checked) and (chkB.Checked=false) then chkA.Checked :=false;
end;
procedure TfrmLogin.ADOQuery1BeforeScroll(DataSet: TDataSet);
var
num:integer;
tmp:string;
begin
//考试开始后,当记录移动前将考生答案写入数组中
if timer1.Enabled then
begin
with ADOQuery1 do
begin
num:=FieldByName('题号').Value;
tmp:='';
ans[num].result:=0;
if FieldValues['题型']<>'操作题' then
begin
if FieldValues['题型']='选择题' then
begin
if chkA.Checked then tmp:='A';
if chkB.Checked then tmp:=tmp+'B';
if chkC.Checked then tmp:=tmp+'C';
if chkD.Checked then tmp:=tmp+'D';
end
else
begin
if chkA.Checked then tmp:='对';
if chkB.Checked then tmp:='错';
end;
ans[num].examinee:=tmp;
//记录标准答案
ans[num].standard:=trim(FieldValues['标准答案']);
//正确否
if ans[num].standard=ans[num].examinee then ans[num].result:=FieldValues['分值'];
end
else
ans[num].examinee:='操作'; //操作题予以标记,以便区分未答题
end;
end;
end;
procedure TfrmLogin.BtnEndClick(Sender: TObject);
var
tmp:string; //未答题题号
i:integer;
//机名
ComputerName:string;
CNameBuffer : PChar;
fl_loaded : Boolean;
CLen : ^DWord;
begin
if BtnEnd.Caption<>'交卷' then
abort;
//检查未答题
ADOQuery1.Last;
ADOQuery1.First;
for i:=1 to high(ans) do
if ans[i].examinee='' then tmp:=tmp+trim(inttostr(i))+'-';
tmp:=copy(tmp,1,strlen(pchar(tmp))-1);
if Timer1.Enabled then // 自愿收卷 先提示有无未答题
begin
//如检查有未答题,则提示
if (tmp<>'') and (Application.MessageBox(pchar('还有'+tmp+'题未作答,是否立即交卷?'), '信息', 32+4)=7) then
abort;
//如检查无未答题
if (tmp='') and(Application.MessageBox('是否立即交卷?', '信息', 32+4)=7) then
abort;
end;
Timer1.Enabled:=false;
stu.Score:=0; //得分初始化
gupBoxCheck.Enabled:=false; //禁止答题
lblCount.Font.Color:=clRed;
//收卷
for i:=1 to high(ans) do
stu.Score:=stu.Score+ans[i].result;
//显示得分
BtnEnd.caption:='得分:'+inttostr(stu.Score);
Application.MessageBox(pchar('得分:'+inttostr(stu.Score)), '信息', 64);
//反馈
if stu.Feedback='1' then
begin
lblfeek.visible:=true;
lblright.visible:=true;
DBText2.visible:=true;
end;
GetMem(CNameBuffer,255);
New(CLen);
CLen^:= 255;
fl_loaded := GetComputerName(CNameBuffer,CLen^);
if fl_loaded then
ComputerName:= StrPas(CNameBuffer)
else
ComputerName:= 'Unkown';
FreeMem(CNameBuffer,255);
Dispose(CLen);
with ADOQuery2 do
begin
close;
sql.clear;
//'[评分时间],[姓名],[班别],[试卷],[得分],[计算机名],[错误题号]'
sql.Add('Insert into 成绩([评分时间],[姓名],[班别],[试卷],[得分],[计算机名],[错误题号],[补考次数]) values(:pf,:xm,:bj,:sj,:df,:jm,:cw,:bk)');
parameters.ParamByName('pf').Value:=dateTimeToStr(Now);
parameters.ParamByName('xm').Value:=stu.Name;
parameters.ParamByName('bj').Value:=stu.MyClass;
parameters.ParamByName('sj').Value:=stu.TestPaper;
parameters.ParamByName('df').Value:=stu.Score;
parameters.ParamByName('jm').Value:=ComputerName;
parameters.ParamByName('cw').Value:=tmp;
parameters.ParamByName('bk').Value:=stu.bk;
ExecSQL;
close;
end;
end;
procedure TfrmLogin.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//拖动无标题窗口
Flag := true;
Opos.X := X;
Opos.Y := Y;
end;
procedure TfrmLogin.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
//拖动无标题窗口
if Flag then
begin
Cpos.X := X;
Cpos.y := Y;
Left := Left + Cpos.X - Opos.X;
Top := Top + Cpos.Y - Opos.Y;
end;
end;
procedure TfrmLogin.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//拖动无标题窗口
Flag := false;
end;
procedure TfrmLogin.FlatScrollbar1Scroll(Sender: TObject;
ScrollPos: Integer);
begin
frmlogin.AlphaBlendValue:=FlatScrollbar1.Position;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -