📄 main.~pas
字号:
procedure TMainForm.SelectATestPaper(Num:Integer);//抽出一套卷子
var
SelRecordCount,RandNum,i,j:Integer;
PSelItem:TPSelRateItem;
RecordNums:set of 0..255;
PaperFileName:String;
begin
PaperQuery.Close;
ADOCom.CommandText :='DELETE FROM SELECTTABLE';
ADOCom.Execute;
PaperQuery.Open;
for i:=0 to SelRateList.Count -1 do
begin
with SelQuery do
begin
PSelItem:=TPSelRateItem(SelRateList.Items[i]);
Close;
SQL.Clear;
SQL.Add('SELECT 索引,题目,主观答案,客观答案,选中标志 FROM '+PSelItem^.TableName);
ExecSQL;
Open;
SelRecordCount:=(PSelItem^.CheckRate*RecordCount) div 100;
RecordNums:=[];
for j:=0 to SelRecordCount-1 do
begin
repeat
RandNum:=Random(RecordCount);
until not (RandNum in RecordNums);
RecordNums:=RecordNums+[RandNum];
end;
First;
for j:=0 to RecordCount-1 do
begin
if j in RecordNums then
begin
PaperQuery.AppendRecord([nil,FieldByName('题目'),FieldByName('主观答案').AsVariant,FieldByName('客观答案').AsString]);
end;
Next;
end;
end;
end;
PaperFileName:=APPPATH+'TESTDBS\PAPER'+IntToStr(Num)+'.QI';
PaperQuery.SaveToFile(PaperFileName);
PaperFileStream[Num]:=TFileStream.Create(PaperFileName,fmOpenRead);
end;
procedure TMainForm.AddZGButtonClick(Sender: TObject);
var
C:TClipboard;
begin
C:=ClipBoard;
if C.HasFormat(CF_METAFILEPICT) or C.HasFormat(CF_BITMAP)
then AnsImage.Picture.Assign(C);
SubTreeQuery.Edit;
ImageSaveToBlobField(AnsImage,TBlobField(SubTreeQuery.FieldByName('主观答案')));
SubTreeQuery.Post;
end;
procedure TMainForm.AddKGButtonClick(Sender: TObject);
var
Answer:String;
i:Integer;
begin
Answer:='';
for i:=1 to 5 do
begin
with TCheckBox(Self.FindComponent('CheckBox'+IntToStr(i))) do
begin
if Checked then Answer:=Answer+Caption;
end;
end;
with SubTreeQuery do
begin
Edit;
FieldByName('客观答案').AsString:=Answer;
Post;
end;
end;
procedure TMainForm.EditButtonClick(Sender: TObject);
var
C:TClipboard;
begin
C:=ClipBoard;
if C.HasFormat(CF_METAFILEPICT) or C.HasFormat(CF_BITMAP)
then FieldImage.Picture.Assign(C);
SubTreeQuery.Edit;
ImageSaveToBlobField(FieldImage,TBlobField(SubTreeQuery.FieldByName('题目')));
SubTreeQuery.Post;
end;
procedure TMainForm.quit1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TMainForm.OkButtonClick(Sender: TObject);
var
i:Integer;
begin
StuCountEdit.Enabled:=False;
InitProgressBar('Loading.....');
PB1.Step:=100 div StuCountEdit.Value;
for i:=1 to StuCountEdit.Value do
begin
SelectATestPaper(i);
PB1.StepIt;
end;
OkButton.Enabled :=False;
InitProgressBar('WIZARDGROUP');
end;
procedure TMainForm.InitConnection;
begin
with DMForm do
begin
ADOC1.ConnectionString:=CONNECTSTR+APPPATH+'TESTDBS\TESTDB.MDB';
ADOC1.Open;
end;
StuTable.Open;
end;
procedure TMainForm.RegStuDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
Buffer:array[0..255] of Char;
PStuInf:TPStudentInf;
NumLen:String;
begin
RegStu.ReadBuffer(Buffer,NumberBytes);
if Buffer='Who is Teacher?' then
begin
Buffer:='I am.';
RegStu.RemoteHost:=FromIP;
RegStu.SendBuffer(Buffer,Length(Buffer));
end
else
begin
PStuInf:=@Buffer;
if PStuInf^.IDD = REGIDD then
begin
if CheckStuInfo(PStuInf) then
begin
StudentList.Items.Add('姓名:'+PStuInf^.Name+'---学号:'+PStuInf^.Num);
StudentList.Items.Add('-----'+FromIP);
SelectPaperNum:=Random(StuCountEdit.Value)+1;
NumLen:=IntToStr(PaperFileStream[SelectPaperNum].Size);
ZeroMemory(@RegistedOK,64);
RegistedOK:=RegOK;
CopyMemory(@RegistedOK[Length(RegOK)],PChar(NumLen),Length(NumLen));
NumLen:=TimeEdit.Text;
CopyMemory(@RegistedOK[Length(RegOK)+11],PChar(NumLen),Length(NumLen));
RegStu.SendBuffer(RegistedOK,Length(RegOK)+20);
end
else
begin
RegistedNO:=RegNO;
RegStu.SendBuffer(RegistedNO,Length(RegistedNO));
end;
end
end;
end;
procedure TMainForm.QuesSockClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
PaperFileStream[SelectPaperNum].Position :=0;
Socket.SendStream(PaperFileStream[SelectPaperNum]);
end;
procedure TMainForm.About1Click(Sender: TObject);
begin
TAboutForm.Create(Application).ShowModal;
end;
procedure TMainForm.AnsUdpDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
ScoreStr:array[0..20] of Char;
begin
AnsUdp.ReadBuffer(ScoreStr,NumberBytes);
SaveScore(FromIP,ScoreStr);
end;
procedure TMainForm.SaveScore(FromIP,ScoreStr: String);
var
StuIndex:Integer;
begin
with StudentList do
begin
with ScoreMemo.Lines do
begin
StuIndex:=Items.IndexOf('-----'+FromIP)-1;
if StuIndex>=0 then
begin
Add(Items[StuIndex]);
Add('考试分数为:'+ScoreStr+'分!');
Add('------------------------------------');
end;
end;
end;
end;
procedure TMainForm.RefreshDepList;
var
DepName:String;
begin
DepTab.Tabs.Clear;
DepEdit.Clear;
ClassEdit.Clear;
with DepQuery do
begin
Close;
SQL.Clear;
SQL.Add('SELECT DISTINCT 系别 FROM STUDENT ');
ExecSQL;
Open;
while not Eof do
begin
DepName:=FieldByName('系别').AsString;
DepTab.Tabs.Add(DepName);
DepEdit.Items.Add(DepName);
Next;
end;
Close;
end;
with ClassQuery do
begin
Close;
SQL.Clear;
SQL.Add('SELECT DISTINCT 班级 FROM STUDENT ');
ExecSQL;
Open;
while not Eof do
begin
DepName:=FieldByName('班级').AsString;
ClassEdit.Items.Add(DepName);
Next;
end;
Close;
end;
DepEdit.ItemIndex:=0;
ClassEdit.ItemIndex:=0;
DepTab.TabIndex:=0;
end;
procedure TMainForm.RefreshClassList(DepName: String);
begin
ClassCheckList.Clear;
with ClassQuery do
begin
Close;
SQL.Clear;
SQL.Add('SELECT DISTINCT 班级 FROM STUDENT WHERE 系别=''' + DepName +'''');
ExecSQL;
Open;
while not Eof do
begin
ClassCheckList.Items.Add(DepName+'-'+FieldByName('班级').AsString);
Next;
end;
Close;
end;
end;
procedure TMainForm.DepTabChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
RefreshClassList(DepTab.Tabs[Newtab]);
end;
procedure TMainForm.InitProgressBar(TEXT:String);
var
Rgn1,Rgn2:HRGN;
Ca:TCanvas;
begin
PB1.Position :=0;
RightBottomL.Caption:=TEXT;
LeftTopL.Caption:=TEXT;
Ca:=TCanvas.Create;
Ca.Handle:=GetWindowDC(PB1.Handle);
Ca.Font :=RightBottomL.Font;
PB1.Width :=Ca.TextWidth(TEXT);
PB1.Height :=Ca.TextHeight(TEXT)+3;
BeginPath(Ca.Handle);
Ca.TextOut(0,0,TEXT);
EndPath(Ca.Handle);
Rgn1:=PathToRegion(Ca.Handle);
Rgn2:=CreateRectRgn(0,0,PB1.Width,PB1.Height);
CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
SetWindowRgn(PB1.Handle,Rgn1,True);
RightBottomL.Refresh;
LeftTopL.Refresh;
DeleteObject(Rgn1);
DeleteObject(Rgn2);
end;
procedure TMainForm.AddToClassList;
var
i:Integer;
begin
with ClassCheckList do
begin
for i:=0 to Count -1 do
begin
if Selected[i] and (ClassList.Items.IndexOf(Items[i])<0) then
begin
ClassList.Items.Add(Items[i]);
end;
end;
end;
end;
procedure TMainForm.DelFromClassList;
var
i:Integer;
begin
with ClassList do
begin
for i:=0 to Count -1 do
begin
if Selected[i] then
begin
Items.Delete(i);
end;
end;
end;
end;
procedure TMainForm.AddToButtonClick(Sender: TObject);
begin
AddToClassList;
end;
procedure TMainForm.DelFromButtonClick(Sender: TObject);
begin
DelFromClassList;
end;
function TMainForm.CheckStuInfo(PStuInf: TPStudentInf):Boolean;
begin
Result:=False;
with CheckQuery do
begin
Close;
SQL.Clear;
SQL.Add('SELECT 系别,班级 FROM STUDENT WHERE 学号='''+PStuInf^.Num+'''');
ExecSQL;
Open;
if RecordCount>0 then
begin
if ClassList.Items.IndexOf((FieldByName('系别').AsString+'-'+FieldByName('班级').AsString))>=0 then
begin
Result:=True;
end;
end;
end;
end;
procedure TMainForm.NameEditKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then NumEdit.SetFocus;
end;
procedure TMainForm.NumEditKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then DepEdit.SetFocus;
end;
procedure TMainForm.DepEditKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then ClassEdit.SetFocus;
end;
procedure TMainForm.ClassEditKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then AddStuBtn.SetFocus ;
end;
procedure TMainForm.AddStuBtnClick(Sender: TObject);
begin
StuTable.AppendRecord([nil,NameEdit.Text,NumEdit.Text,DepEdit.Text,ClassEdit.Text]);
end;
procedure TMainForm.DelStuBtnClick(Sender: TObject);
begin
StuTable.Delete;
end;
procedure TMainForm.FindTabChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
FindEdit.Clear;
end;
procedure TMainForm.FindStuBtnClick(Sender: TObject);
begin
if StuTable.Locate(FindTab.Tabs[FindTab.TabIndex],FindEdit.Text,[loPartialKey]) then
begin
DBGrid1.SetFocus;
end
else
begin
MessageBox(0,'没有找到!','警告!',MB_ICONWARNING)
end;
end;
procedure TMainForm.OkTimeBtnClick(Sender: TObject);
begin
ST3.SetFocus;
end;
procedure TMainForm.S2Click(Sender: TObject);
begin
ScoreMemo.Lines.SaveToFile(APPPATH + '\分数.TXT');
end;
procedure TMainForm.SaveTimerTimer(Sender: TObject);
begin
S2Click(Sender);
end;
procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
SaveTimer.Enabled:=True;
SaveTimer.Interval:=SaveTimeEdit.Value *1000;
end;
procedure TMainForm.xpcheckClick(Sender: TObject);
begin
XPMenu1.Active :=xpcheck.Checked;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -