点名器，Delphi

zwy12138 · 发表于 2016-1-25 10:37:13

马上注册，结交更多好友，享用更多功能^_^

您需要登录才可以下载或查看，没有账号？立即注册

x

unit u2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, MPlayer;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Timer1: TTimer;
CheckBox1: TCheckBox;
Label9: TLabel;
Label10: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton3Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure stop();
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
num:Integer;
InList:Boolean; //是否是最后一次点名（按下button）,加入already
circle:Boolean =False; //是否不重复
picking1:String='None';//与picking2构成“不重复”的帮助条件
picking2:Integer=1; //1.点名模式，如果是不重复且切换了模式则警告 2.是否是第一次当前模式
status:Integer=0; //0-全班，默认全班点名
already:Array of Integer;
names:Array [1..43] of String;
procedure mode_changed(x: String);
begin
if ((picking2=0) and (picking1 <> x)) then
begin
SetLength(already,0);
picking1:=x;
MessageBox(0,'本次更改点名范围会导致下次重新回到本模式时重新开始新的一轮点名。' ,'警告',MB_OK or MB_ICONWARNING);
end;
if (picking2=1) then
begin
picking1:=x;
picking2:=0;
end;
end;
procedure TForm1.stop();
begin
SetLength(already,0);
MessageBox(0,'已经循环一遍。' ,'警告',MB_OK or MB_ICONSTOP);
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
circle:=not circle;
if(circle=False) then //circle现在是False : 刚才是True，不重复->要重复，要警告会导致。。。
begin
MessageBox(0,'本次更改是否重复会导致下次重新回到本模式时重新开始新的一轮点名。' ,'警告',MB_OK or MB_ICONWARNING);
SetLength(already,0); //already初始化
end;
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
t:Integer;
c:String;
begin
if ((Timer1.Enabled) and (circle=True))then //circle=1:要不循环模式
InList:=True
else
InList:=False; //即，如果已被激活，说明是最后一次，要InList。反之亦然。
Timer1.Enabled:=not Timer1.Enabled;
Label10.Caption:=BoolToStr(InList);
//Debug
Label8.Caption:=IntToStr(status);
Label7.Caption:=IntToStr(Length(already));
If(Length(already)=0) then
Label6.Caption:='NULL'
else
begin
c:='';
For t:=0 to Length(already)-1 do
begin
c:=c+IntToStr(already[t])+',';
end;
Label6.Caption:=c;
end;
if(InList=True) then
begin
SetLength(already,Length(already)+1);
already[Length(already)-1]:=num;//length反回长度，长度-1为最后一个
end;
//Debug Show Labels
Label8.Caption:=IntToStr(status);
Label7.Caption:=IntToStr(Length(already));
If(Length(already)=0) then
Label6.Caption:='NULL'
else
begin
c:='';
For t:=0 to Length(already)-1 do
begin
c:=c+IntToStr(already[t])+',';
end;
Label6.Caption:=c;
end;
//End Debug.
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//定义数组names
names[1]:='XX';
names[2]:='XX';
names[3]:='XX';
names[4]:='XX';
names[5]:='XX';
names[6]:='XX';
names[7]:='XX';
……………………………………………………
names[39]:='X';
names[40]:='X';
names[41]:='X';
names[42]:='XXX';
names[43]:='XXX';
end;
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
status:=0; //全班
if(Timer1.Enabled) then
Timer1.Enabled:=False;
end;
procedure TForm1.RadioButton3Click(Sender: TObject);
begin
status:=2; //双班
if(Timer1.Enabled) then
Timer1.Enabled:=False;
end;
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
status:=1; //单班
if(Timer1.Enabled) then
Timer1.Enabled:=False;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
temp,mark:Integer;
content:String;
begin
//Debug
Randomize;
num:=Random(42)+1;
if (circle=False) then //如果可重复
begin
if (status=0) then
Randomize;
num:=Random(42)+1;
if (status=1) then
while (num Mod 2)<>1 do
begin
Randomize;
num:=Random(42)+1;
end;
if (status=2) then
while (num Mod 2)<>0 do
begin
Randomize;
num:=Random(43)+1;
end;
content:='No. '+IntToStr(num)+' '+names[num];
Label1.Caption:=content;
end //还有else，没了';'
else //circle=True,要“不循环”
begin
if (status=0) then
begin
mode_changed('全班') ;
while (True) do
begin
if (Length(already)=43) then
begin
stop();
break;
end;
Randomize;
num:=Random(43)+1; //0-42+1 -- 1-43
//本段太高频
mark:=0; //初始化标志位
For temp:=0 to (Length(already)-1) do
begin
if (num=already[temp]) then
Begin
mark:=1;
break;
end; //如果在就标1
end;
//end。
if (mark=0) then //mark=0: "num not in already"(python)
begin
content:='No. '+IntToStr(num)+' '+names[num];
Label1.Caption:=content ;
break;
end;
end;
end;
if (status=1) then
begin
mode_changed('单班') ;
while (True) do
begin
if (Length(already)=22) then
begin
stop();
break;
end;
Randomize;
num:=Random(43)+1; //0-42+1 -- 1-43
//本段太高频
mark:=0; //初始化标志位
For temp:=0 to (Length(already)-1) do
begin
if (num=already[temp]) then
mark:=1; //如果在就标1
end;
//end。
if ((mark=0) and (num Mod 2=1)) then //如果是奇数
begin
content:='No. '+IntToStr(num)+' '+names[num];
Label1.Caption:=content;//显示
break;
end;
end;
end;
if (status=2) then
begin
mode_changed('双班');
while (True) do
begin
if (Length(already)=21) then
begin
stop();
break;
end;
Randomize;
num:=Random(43)+1; //0-42+1 -- 1-43
//本段太高频
mark:=0; //初始化标志位
For temp:=0 to (Length(already)-1) do
begin
if (num=already[temp]) then
mark:=1; //如果在就标1
end;
//end。
if ((mark=0) and (num Mod 2=0)) then //如果是偶数
begin
content:='No. '+IntToStr(num)+' '+names[num];
Label1.Caption:=content;//显示
break;
end;
end;
end;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
t:Integer;
c:String;
begin
Timer1.Enabled:=not Timer1.Enabled;
Label10.Caption:=BoolToStr(InList);
//Debug
Label8.Caption:=IntToStr(status);
Label7.Caption:=IntToStr(Length(already));
If(Length(already)=0) then
Label6.Caption:='NULL'
else
begin
c:='';
For t:=0 to Length(already)-1 do
begin
c:=c+IntToStr(already[t])+',';
end;
Label6.Caption:=c;
end;
end;
end.

复制代码

定义数组names的过程略变态，我当时用python帮忙处理一部分。

e4a · 发表于 2016-1-27 22:35:19

看看支持一下。

账号		自动登录	找回密码
密码			立即注册

[作品展示] 点名器，Delphi

马上注册，结交更多好友，享用更多功能^_^