login.pas

信息技术考试系统单机版数据库中附有两套练习——《高一信息技术期中练习》、《高一信息技术期中练习》

unit login;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, TFlatButtonUnit, WinSkinData, DB,
  ADODB, DosMove, TFlatPanelUnit, Grids, DBGrids, DBGrid3D, DBCtrls,
  TFlatGroupBoxUnit, TFlatCheckBoxUnit, TFlatEditUnit, TFlatSpeedButtonUnit,
  MSNPopUp, TFlatScrollbarUnit;

type
  TfrmLogin = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    ADOConnection1: ConnectionString;
    ADOQuery1: TADOQuery;
    DsTest: TDataSource;
    Timer1: TTimer;
    ADOQuery2: TADOQuery;
    procedure FlatButton2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FlatButton1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnMinClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FlatSpeedButton2Click(Sender: TObject);
    procedure ADOQuery1AfterScroll(DataSet: TDataSet);
    procedure ChkAClick(Sender: TObject);
    procedure ChkBClick(Sender: TObject);
    procedure ADOQuery1BeforeScroll(DataSet: TDataSet);
    procedure BtnEndClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FlatScrollbar1Scroll(Sender: TObject; ScrollPos: Integer);
  private
    { Private declarations }
  public
   { Public declarations }
  end;
//考生信息
Type student=Record
       Name:string[8];     //姓名
       MyClass:string[4];  //班级
       TestPaper:string;    //试卷
       Score:Integer;       //得分
       Feedback:string[1];     //反馈否
       BeginTime:string;    //开始时间
       ExamTime:integer;     //考试时间
       bk:integer;          //补考次数
end;
//考生答案
Type answer=Record
       standard:string[4];     //标准答案
       examinee:string[4];  //考生答案
       result:integer;    //正确否
end;
var
  frmLogin: TfrmLogin;

implementation
//全局变量
var
  stu:student;
  ans:array of answer;
  countDown:integer;
  examCount:integer;
  //拖动无标题窗口
   Opos, Cpos: Tpoint;
   Flag: boolean = false;

{$R *.dfm}


procedure TfrmLogin.FlatButton2Click(Sender: TObject);
begin
close;
application.Terminate;
end;

procedure TfrmLogin.FormActivate(Sender: TObject);
begin
ComboBox1.Items.Clear;
with ADOQuery1 do
  begin
  close;
  sql.clear;
  sql.Add('select 考试名称 from 设置');
  open;
  First;
  while not ADOQuery1.Eof do
  begin
    combobox1.Items.Add(trim(FieldValues['考试名称']));
    Next;
  end;
  end;
end;

procedure TfrmLogin.FlatButton1Click(Sender: TObject);
var
  p:boolean;
  i:integer;
  kl:string;  //考试口令
begin
edit1.Text:=trim(edit1.Text);
edit2.Text:=trim(edit2.Text);
edit3.Text:=trim(edit3.Text);
if edit1.Text='' then
  begin
  Application.MessageBox('请输入你的姓名。', '信息', 64);
  edit1.SetFocus;
  abort;
  end;
//姓名必须是汉字
p:=true;
for i:=1 to strlen(pchar(edit1.text)) do
  if ByteType(edit1.Text,i) = mbSingleByte then p:=false;//中文字符
if p=false then
  begin
  Application.MessageBox('姓名必须全部由汉字组成。', '信息', 64);
  edit1.SetFocus;
  abort;
  end;

if edit2.Text='' then
  begin
  Application.MessageBox('请输入你的班别。', '信息', 64);
  edit2.SetFocus;
  abort;
  end;
if ComboBox1.Text='' then
  begin
  Application.MessageBox('请选择试卷。', '信息', 64);
  ComboBox1.SetFocus;
  abort;
  end;
//根据选择的试卷验证口令是否正确
with ADOQuery1  do
  begin
  close;
  sql.clear;
  sql.Add('select * from 设置 where 考试名称=:p1');
  parameters.ParamByName('p1').Value:=ComboBox1.Text;
  open;

  //是否为补考
  ADOQuery2.Close;
  ADOQuery2.SQL.Clear;
  ADOQuery2.SQL.Add('select 姓名 from 成绩 where 姓名=:p1 and 班别=:p2 and 试卷=:p3');
  ADOQuery2.parameters.ParamByName('p1').Value:=edit1.Text;
  ADOQuery2.parameters.ParamByName('p2').Value:=edit2.Text;
  ADOQuery2.parameters.ParamByName('p3').Value:=combobox1.Text;
  ADOQuery2.Open;
  stu.bk:=ADOQuery2.RecordCount;
  ADOQuery2.Close;
  
  //允许补考吗？
  if (stu.bk>0) and (FieldByName('可补考次数').Value<1) then
    begin
    Application.MessageBox('对不起，本次考试不允许进行补考。', '信息', 64);
    edit3.SetFocus;
    abort;
    end;
  //如果是补考，补考是否已超次数
  if stu.bk>(FieldByName('可补考次数').Value)  then
    begin
    Application.MessageBox(pchar('对不起，你已经进行了'+trim(inttostr(stu.bk-1))+'次补考。不能再次补考。'), '信息', 64);
    edit3.SetFocus;
    abort;
    end;

  btnBK.Visible:=false;
  kl:=trim(FieldByName('口令').AsString);
  //如果允许补考，且次数未超，则进行补考
  if (FieldByName('可补考次数').Value>0) and (stu.bk>0) and  (stu.bk<=(FieldByName('可补考次数').Value))  then
    begin
    kl:=trim(FieldByName('补考口令').AsString);
    btnBK.Caption:='第'+trim(inttostr(stu.bk))+'次补考';
    btnBK.Visible:=true;
    end;

  if edit3.Text<>kl  then
    begin
    if  stu.bk>0 then
      Application.MessageBox('你进行的是补考，请输入正确的补考口令。', '信息', 64)
    else
      Application.MessageBox('口令不正确。', '信息', 64);
    edit3.SetFocus;
    abort;
    end
  else
    begin
    stu.Name:=edit1.Text;
    stu.MyClass:=edit2.Text;
    stu.TestPaper:=combobox1.Text;
    stu.Score:=0;
    stu.Feedback:=FieldByName('反馈否').AsString;
    stu.ExamTime:=FieldValues['考试时间'];
    lblInfo.Caption:='考生姓名：'+ stu.Name+'    班级：'+stu.MyClass+'    试卷：'+stu.TestPaper;
    //进入考试须知
    if  FieldValues['显示否']='1' then
       Application.MessageBox(pchar(trim(FieldValues['考试须知'])), '考试须知', 64);
    //运行否
    if  FieldValues['运行否']<>'1' then
       begin
       close;
       application.Terminate;
       end
    else
      //运行
      begin
      panLogin.Visible:=false;
      stu.BeginTime:=TimeToStr(Now);

      //取题目
      close;
      sql.clear;
      sql.Add('select * from '+stu.TestPaper+' order by 题号');
      open;

      DBMemo1.DataSource:=DsTest;
      DBText1.DataSource:=DsTest;
      DBText1.DataField:='题号';
      DBText2.DataSource:=DsTest;
      DBText2.DataField:='标准答案';

      //倒计时，开考
      countdown:=stu.ExamTime;
      Timer1.Enabled:=true;
      lblCount.Caption:='倒计时：'+inttostr(countdown);
      panInfo.Visible:=true;  //考生信息栏可见
      panTest.Visible:=true;  //试卷区可见

      //根据题量设置考生答案的数组大小
      examCount:=RecordCount;
      SetLength(ans,examCount+1);

      first;
      end;

    end;
  end;

end;

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.