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

📄 main.pas

📁 对任何纯文本文件进行随机抽奖的功能
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Spin, StdCtrls, ShellAPI, ExtCtrls, Buttons, Gauges;

type
  TForm1 = class(TForm)
    TextEdit: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    Label5: TLabel;
    Button2: TButton;
    Image1: TImage;
    Label6: TLabel;
    Label7: TLabel;
    Panel1: TPanel;
    OpenDialog: TOpenDialog;
    Gauge: TGauge;
    Label8: TLabel;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Label7Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    SysPath:string;
  end;

var
  Form1: TForm1;

implementation

uses help;

{$R *.DFM}

procedure TForm1.Label7Click(Sender: TObject);
begin
  shellexecute(handle,nil,pchar('http://www.21cn.com'),nil,nil,SW_SHOWNORMAL);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
//取当前目录
  getdir(0,SysPath);
  if Length(SysPath)>3 then SysPath:=SysPath+'\base.txt';
  TextEdit.Text:=SysPath;
  TextEdit.ReadOnly:=True;
  SetCurrentDir(SysPath);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog.InitialDir:=SysPath;
  if OpenDialog.Execute then
  begin
    TextEdit.Text:=OpenDialog.FileName;
    SysPath:=TextEdit.Text;
    SetCurrentDir(SysPath);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
  BaseFile:TextFile;
  OutFile:TextFile;
  BaseStr:String;
  BaseLen:LongInt; //文本字符的长度行数
  PickNo:LongInt; //要取的获奖的人数
  RandomBaseLen:LongInt;  //文本字箱长度行数的随机数
  I:LongInt;
  J:LongInt;
  Pick:array [1..1300] of String;
  PickStr:array [1..1300] of String;
  Present: TDateTime;
  YearString, MonthString, DayString, HourString, MinString, SecString: String;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  CFileName:String;
begin
  //分解日期
  Present:= now();
  DecodeDate(Present, Year, Month, Day);
  YearString:=IntToStr(Year);
  if month<10 then
  begin
    MonthString:='0'+IntToStr(month);
  end
  else
  begin
    MonthString:=IntToStr(month);
  end;
  DayString:=IntToStr(Day);
  DecodeTime(Present, Hour, Min, Sec, MSec);
  if Hour<10 then
  begin
    HourString:='0'+IntToStr(Hour);
  end
  else
  begin
    HourString:=IntToStr(Hour);
  end;
  if Min<10 then
  begin
    MinString:='0'+IntToStr(Min);
  end
  else
  begin
    MinString:=IntToStr(Min);
  end;
  if Sec<10 then
  begin
    SecString:='0'+IntToStr(Sec);
  end
  else
  begin
    SecString:=IntToStr(Sec);
  end;

  //打开文件,取文件的长度
  AssignFile(BaseFile,TextEdit.Text);
  Reset(BaseFile);
  BaseLen:=0;
  While not eof(BaseFile) do
  begin
    Readln(BaseFile,BaseStr);
    BaseLen:=BaseLen+1;
  end;
  CloseFile(BaseFile);

  //检查样本数量与总的抽奖人数是否合理
  pickno:=StrToInt(SpinEdit1.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit4.Text);
  if pickno=0 then
  begin
    ShowMessage('您设的抽奖数量为0,程序不能执行下去!');
    Exit;
  end;

  if PickNo>BaseLen then
  begin
    ShowMessage('文本文件中的资料只有'+IntToStr(BaseLen)+'行,您设置的抽奖数量却为'+IntToStr(PickNo)+'!  请重新设置。');
    Exit;
  end;

  //产生不重复随机数存入数组
  Gauge.Progress:=0;
  for I:=1 to PickNo do
  begin
    Gauge.Progress:=50*I Div PickNo;
    j:=0;
    randomize;
    RandomBaseLen:=Random(BaseLen)+1;
    while J<I do
    begin
      if inttostr(RandomBaseLen)<>Pick[J] then
        J:=J+1
      else
      begin
        Randomize;
        RandomBaseLen:=Random(BaseLen)+1;
        J:=0
      end;
    end;
    Pick[I]:=IntToStr(RandomBaseLen);
  end;

  //产生随机数组的行的字串到PickStr数组中
  AssignFile(BaseFile,TextEdit.Text);
  Reset(BaseFile);AssignFile(BaseFile,TextEdit.Text);
  Reset(BaseFile);
  for J:=1 to BaseLen do
  begin
    Gauge.Progress:=50+50*J Div BaseLen;
    Readln(BaseFile,BaseStr);
    for I:=1 to PickNo do
    begin
    if IntToStr(J)=Pick[I] then
      begin
        if I<=StrToInt(SpinEdit1.Text) then
        begin
          PickStr[I]:=BaseStr;
          break;
        end;
        if (I<=StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) and (I>StrToInt(SpinEdit1.Text)) then
        begin
          PickStr[I]:=BaseStr;
          break;
        end;
        if (I<=StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) and (I>StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) then
        begin
          PickStr[I]:=BaseStr;
          break;
        end;
        if (I<=StrToInt(SpinEdit4.Text)+StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) and (I>StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) then
        begin
          PickStr[I]:=BaseStr;
          break;
        end;
      end;
    end;
  end;
  CloseFile(BaseFile);  
  Gauge.Progress:=100;

  //取文件名
  CFileName:=ExtractFileName(TextEdit.Text);
  CFileName:=Copy(CFileName,1,Pos('.',CFileName)-1);

  //输出获奖的文本文件
  AssignFile(OutFile,CFileName+MonthString+DayString+HourString+MinString+SecString+'.TXT');
  ReWrite(OutFile);
  for I:=1 to PickNo do
  begin
    if I<=StrToInt(SpinEdit1.Text) then
    begin
      WriteLn(OutFile,'一等奖:'+PickStr[I]);
    end;
    if (I<=StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) and (I>StrToInt(SpinEdit1.Text)) then
    begin
      WriteLn(OutFile,'二等奖:'+PickStr[I]);
    end;
    if (I<=StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) and (I>StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) then
    begin
      WriteLn(OutFile,'三等奖:'+PickStr[I]);
    end;
    if (I<=StrToInt(SpinEdit4.Text)+StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) and (I>StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit1.Text)) then
    begin
      WriteLn(OutFile,'鼓励奖:'+PickStr[I]);
    end;
  end;
  CloseFile(OutFile);

  GetDir(0,SysPath); 
  SHOWMESSAGE('抽奖结束,抽奖结果文件为:'+#13#10#13#10+SysPath+'\'+CFileName+MonthString+DayString+HourString+MinString+SecString+'.TXT');
  Gauge.Progress:=0;
  shellexecute(handle,nil,pchar(SysPath+'\'+CFileName+MonthString+DayString+HourString+MinString+SecString+'.TXT'),nil,nil,SW_SHOWNORMAL);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  helpbox.showmodal;
end;

procedure TForm1.Button4Click(Sender: TObject);
Var
  BaseFile:TextFile;
  BaseStr:String;
  BaseLen:LongInt;
begin
  //打开文件,取文件的长度
  AssignFile(BaseFile,TextEdit.Text);
  Reset(BaseFile);
  BaseLen:=0;
  While not eof(BaseFile) do
  begin
    Readln(BaseFile,BaseStr);
    BaseLen:=BaseLen+1;
  end;
  CloseFile(BaseFile);
    ShowMessage('文本文件'+TextEdit.Text+'中的资料有'+IntToStr(BaseLen)+'条!');
end;

procedure TForm1.Button5Click(Sender: TObject);
Var
  PickNo:LongInt;
begin
  //检查样本数量与总的抽奖人数是否合理
  PickNo:=StrToInt(SpinEdit1.Text)+StrToInt(SpinEdit2.Text)+StrToInt(SpinEdit3.Text)+StrToInt(SpinEdit4.Text);
  ShowMessage('现在的四个奖项的总抽奖数为'+IntToStr(PickNo));
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -