unitchoujiang.~pas

用VB写的一个小小的抽奖程序

unit UnitChoujiang;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,ShellAPI;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    edtCode: TEdit;
    btnStart: TButton;
    Label2: TLabel;
    btnPSet: TButton;
    btnCodeSet: TButton;
    btnExport: TButton;
    btnClear: TButton;
    lblTitle: TLabel;
    Timer1: TTimer;
    btnStop: TButton;
    lstCode: TListBox;
    lblLeft: TLabel;
    SaveDialog1: TSaveDialog;
    btnClearText: TButton;
    btnResult: TButton;
    btnHelp: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnPSetClick(Sender: TObject);
    procedure btnCodeSetClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure btnClearTextClick(Sender: TObject);
    procedure btnResultClick(Sender: TObject);
    procedure btnHelpClick(Sender: TObject);
  private
    { Private declarations }
    
  public
    { Public declarations }
    function formatcode(t1,t2:integer):string;
  end;

var
  Form1: TForm1;
  digit:integer;
  intEnd:integer;
  intStart:integer;
  number:integer;
  filepath:string;
  
implementation

uses dlgPset, dlgCodeSet;

{$R *.dfm}




procedure TForm1.FormCreate(Sender: TObject);
var
  Init:TextFile;
  n:integer;
  s:string;
  
  addstring:string;
  name:string;
  currentpath:AnsiString ;
begin
  intstart:=0;
  currentpath:=ExtractFilePath('Application->ChouJiang.exe');
  filepath:=currentpath+'set.ini';
try
  Assignfile(Init,filepath);
  reset(Init);
  for n:=1 to 7 do
  begin
    readln(Init,s);
    case n of
    2: name:=copy(s,6,Length(s)-5);
    3: number:=strtoint(copy(s,8,Length(s)-7));
    5: digit:=strtoint(copy(s,7,Length(s)-6));
    6: intStart:=strtoint(copy(s,7,Length(s)-6));
    7: intEnd:=strtoint(copy(s,5,Length(s)-4));
    end;
  end;
finally
  closefile(Init);
end;
  lblTitle.caption:=name+ '（' + inttostr(number) + '名）' ;
  lblLeft.Caption:='已抽出奖项' + inttostr(lstcode.count)+ '个';
  addstring:=formatcode(digit,intStart);
  edtCode.text:=addstring+ inttostr(intStart);
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
   timer1.enabled:=true;
   btnStart.Enabled:=not btnStart.Enabled;
   btnstop.Enabled :=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
   addstring:string;
   getend:integer;
   sel:integer;
   isequ:boolean;
begin
   isequ:=false;
   repeat
   getend:=random(intEnd+1-intstart);
   getend:=getend+intstart;
   isequ:=false;
   for sel:=0 to lstcode.Count-1 do
   begin
      if strtoint(lstCode.Items.Strings[sel])=getend then
         isequ:=true;
   end;
   until isequ=false;
   
   addstring:=formatcode(digit,getend);
   addstring:=addstring+ inttostr(getend);
   edtCode.text:=addstring;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  timer1.Enabled:=false;
  lstCode.items.Add(edtcode.text);
  lblLeft.Caption:='已抽出奖项' + inttostr(lstcode.count)+ '个';
  btnstop.Enabled :=not btnstop.Enabled ;
  btnstart.enabled:=true;
  if  number-lstcode.count=0 then
  begin
     btnstart.Enabled:=false;
     showmessage('请点击“导出奖号”保存已抽出的号码。');
  end;
  if lstcode.count=intend-intstart+1 then
  btnstart.Enabled :=false;
end;

procedure TForm1.btnPSetClick(Sender: TObject);
begin
  OKBottomDlg.ShowModal;
end;

procedure TForm1.btnCodeSetClick(Sender: TObject);
begin
  OKBottomDlg1.ShowModal;
end;

function TForm1.formatcode(t1,t2:integer):string;
var
  n:integer;
  adds:string;
begin
  if t1>length(inttostr(t2)) then
  begin
    for n:=1 to t1-length(inttostr(t2)) do
        adds:=adds+inttostr(0);
  end;
  result:=adds;
end;

procedure TForm1.btnClearClick(Sender: TObject);

begin
   if messagedlg('确认要清空已抽出的获奖号码吗？',
   mtConfirmation, [mbYes, mbNo], 0) =mryes then
   lstcode.Clear;
   btnstart.Enabled:=true;
end;

procedure TForm1.btnExportClick(Sender: TObject);
var
   savefile:TextFile;
   path:ansistring;
   i:integer;
   s:string;
   txtpath:string;
begin
   path:=ExtractFilePath('Application->ChouJiang.exe');
   txtpath:= path+'抽奖结果.txt';
   assignfile(savefile,path+'抽奖结果.txt');
   append(savefile);
   try
        s:=lbltitle.Caption;
        writeln(savefile,s);
        for i:=0 to lstcode.Count-1 do
        begin
             s:=lstcode.items.strings[i];
             writeln(savefile,s);
        end;
        showmessage('抽奖结果已成功保存在 "'+ txtpath+ '"');
   finally
        closefile(savefile);
   end;

end;

procedure TForm1.btnClearTextClick(Sender: TObject);
var
   clearfile:TextFile;
   clearpath:ansistring;
begin
if messagedlg('清空所有导出的抽奖结果吗？',
   mtConfirmation, [mbNo,mbYes], 0) =mryes then
   try
      clearpath:=ExtractFilePath('Application->ChouJiang.exe');
      clearpath:= clearpath+'抽奖结果.txt';
      assignfile(clearfile,clearpath);
      rewrite(clearfile);
      writeln(clearfile,'');
      showmessage('"' + clearpath + '"' +' 文本里面的数据已全部清空.');
   finally
      closefile(clearfile);
   end;
end;

procedure TForm1.btnResultClick(Sender: TObject);
var
   currentdir:string;
begin
    setlength(currentdir,144);
    if getcurrentdirectory(144,Pchar(currentdir))<>0 then
    begin
      setlength(currentdir,strlen(Pchar(currentdir)));
    end;
    //showmessage(currentdir + '\抽奖结果.txt');
    ShellExeCute(handle,'open',Pchar(currentdir + '\抽奖结果.txt'),nil,nil,SW_SHOW);
end;

procedure TForm1.btnHelpClick(Sender: TObject);
var
   currentdir:string;
begin
    setlength(currentdir,144);
    if getcurrentdirectory(144,Pchar(currentdir))<>0 then
    begin
      setlength(currentdir,strlen(Pchar(currentdir)));
    end;
    //showmessage(currentdir + '\抽奖结果.txt');
    ShellExeCute(handle,'open',Pchar(currentdir + '\帮助.txt'),nil,nil,SW_SHOW);
end;

end.