⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 login.pas

📁 1
💻 PAS
📖 第 1 页 / 共 2 页
字号:

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 + -