unit1.pas

彩票3D自动生成器。可以随机生成3D号。好用的很

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSkinData, Mask, RzEdit, RzButton, StdCtrls, RzLstBox,
  ExtCtrls, RzPanel,unit2;

type
  TForm1 = class(TForm)
    SkinData1: TSkinData;
    GroupBox1: TRzGroupBox;
    ListBox1: TRzListBox;
    Memo1: TRzMemo;
    Label2: TLabel;
    Label1: TLabel;
    GroupBox2: TRzGroupBox;
    GroupBox3: TRzGroupBox;
    Button1: TRzButton;
    Edit1: TRzEdit;
    Memo2: TRzMemo;
    Label4: TLabel;
    Edit2: TRzEdit;
    Button2: TRzButton;
    Button3: TRzButton;
    SaveDialog1: TSaveDialog;
    Button4: TButton;
    OpenDialog1: TOpenDialog;
    RzButton1: TRzButton;
    Button5: TButton;
    Label3: TLabel;
    Label5: TLabel;
    procedure Memo1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure RzButton1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
    TBuffer=array [0..16000] of char;

var
  Form1: TForm1;

implementation
  var
    filestring:string;
{$R *.dfm}

procedure TForm1.Memo1Change(Sender: TObject);
var
    i:integer;
begin
    listbox1.Clear;
    for i:=1 to memo1.Lines.Count do
    begin
    listbox1.Items.Add(inttostr(i));
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    i,j,t:integer;
    m:array [1..10] of integer;
    s:string;
begin
    s:='';
    for i:=1 to 10 do
    m[i]:=12;
    //m[1]:=random(10);
    i:=1;
    while true do
    begin
    Randomize;
    t:=random(10);
    for j:=1 to (i-1) do
    begin
        if m[j]=t then
        break;
    end;
    if j>(i-1) then
    begin
      m[i]:=t;
      inc(i);
      s:=s+inttostr(t);
    end;
    if i>10 then
    break;
    end;
    edit1.Text:=s;
end;

//----------------------------------------------------生成大底
procedure TForm1.Button2Click(Sender: TObject);
var
    zhushu,intnum,i,j,n,t,long:integer;
    a,b,c:integer;
    strnum,str1,str2,str3:string;
    mystrlist:tstringlist;
    m:array [0..6] of integer;
begin
    memo2.Lines.Clear;
    try
    zhushu:=strtoint(edit2.Text)-1;  //生成大底的组数
    except
    showmessage('请输入正确数据！');
    edit2.SetFocus;
    exit;
    end;

    mystrlist:=tstringlist.Create;
    for i:=0 to memo1.Lines.Count-1 do
      mystrlist.Add(memo1.Lines.Strings[i]);

    i:=1;
    long:=length(mystrlist.Strings[zhushu]);
    while i<long do           //对第zhushu组说求大底
    begin
      strnum:=copy(mystrlist.Strings[zhushu],i,3);
      intnum:=strtoint(strnum);
      a:=intnum div 100;
      b:=(intnum mod 100) div 10;
      c:=intnum mod 10;
      str1:=''; str2:='';str3:='';   //字符串初始化
      j:=0;
      for n:=0 to 9 do
      if (n<>a) and (n<>b) and (n<>c) then
        begin
        m[j]:=n;
        INC(j);
        end;
      for n:=0 to 6 do
      begin
//--------------比较   a  b   m[n]
      if a>m[n] then
        if a>b then
          if b>m[n] then
          begin
          t:=m[n]; m[n]:=a; a:=t;         // m[n]<b<a
          end
          else
          begin
          t:=m[n];m[n]:=a;a:=b;b:=t;      // b<m[n]<a
          end
        else
        begin
        t:=m[n]; m[n]:=b; b:=a; a:=t;     //  m[n]<a<b
        end
      else  // a< .....
        if a<b then
          if b<m[n] then
          begin
             ;                            // a<b<m[n]
          end
          else
          begin
          t:=b; b:=m[n]; m[n]:=t;         // a<m[n]<b
          end
        else
        begin
        t:=a; a:=b; b:=t;                 // b<a<m[n]
        end;
      str1:=str1+inttostr(a)+inttostr(b)+inttostr(m[n])+' ';
//--------------比较   a  c   m[n]
      if a>m[n] then
        if a>c then
          if c>m[n] then
          begin
          t:=m[n]; m[n]:=a; a:=t;    //  m[n]<c<a
          end
          else
          begin
          t:=m[n];m[n]:=a;a:=c;c:=t;
          end
        else
        begin
        t:=c; c:=m[n]; m[n]:=a; a:=t;
        end
      else
        if a<c then
          if c<m[n] then
          begin
             ;
          end
          else
          begin
          t:=c; c:=m[n]; m[n]:=t;
          end
        else
        begin
        t:=a; a:=c; c:=t;
        end;
      str2:=str2+inttostr(a)+inttostr(c)+inttostr(m[n])+' ';
//--------------比较   b  c   m[n]
      if b>m[n] then
        if b>c then
          if c>m[n] then
          begin
          t:=m[n]; m[n]:=b; b:=t;
          end
          else
          begin
          t:=m[n];m[n]:=b;b:=c;c:=t;
          end
        else
        begin
        t:=c; c:=m[n]; m[n]:=b; b:=t;
        end
      else
        if b<c then
          if c<m[n] then
          begin
             ;
          end
          else
          begin
          t:=c; c:=m[n]; m[n]:=t;
          end
        else
        begin
        t:=b; b:=c; c:=t;
        end;
      str3:=str3+inttostr(b)+inttostr(c)+inttostr(m[n])+' ';
      end;
      memo2.Lines.Add(str1+#13+#10+str2+#13+#10+str3+#13+#10);
      filestring:=filestring+str1+#13+#10+str2+#13+#10+str3+#13+#10;
      i:=i+4;
      //str1:=#13; str2:=#13;str3:=#13;
    end;//while end

end;

procedure TForm1.Button3Click(Sender: TObject);
var
    filename:string;
    filestream:Tfilestream;
    tempbuffer:TBuffer;
begin
    if savedialog1.Execute then
        filename:=savedialog1.FileName;
    if fileexists(filename) then
    begin
        if  messagedlg('该文件已存在，是否覆盖？',mtinformation,[mbyes,mbno],0)=mrno then
        exit
        else
        begin
        try
        strpcopy(tempbuffer,filestring);
        filestream:=tfilestream.Create(filename,fmopenwrite);
        filestream.Position:=0;
        filestream.Write(tempbuffer,length(filestring));
        showmessage('保存成功！');
        finally
        freeandnil(filestream);
        filestring:='';        
        end;
        end; //else end
    end
    else
    begin
    try
    strpcopy(tempbuffer,filestring);
    filestream:=tfilestream.Create(filename,fmcreate);
    filestream.Position:=0;
    filestream.Write(tempbuffer,length(filestring));
    showmessage('保存成功！');
    finally
    freeandnil(filestream);
    filestring:='';
    end
    end;

        
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
     filestring:='';
end;

procedure TForm1.Button4Click(Sender: TObject);
//var
  //  filename:string;
begin
    {if messagedlg('提示：'+
    #13+#13+'必须保证来源文件中的数据符合要求格式，否则将出现错误，'+
    #13+'如764 234 763 918 910 580 762 915 每个数据中间只有一个空格！'+
    #13+'确定要从文件获取数据吗？',mtwarning,[mbyes,mbno],0)=mryes  then
    begin
      if opendialog1.Execute then
         filename:=opendialog1.FileName;
      if filename<>'' then
      memo1.Lines.LoadFromFile(filename)
    end;}
    memo1.Clear;
    listbox1.Clear;
end;

procedure TForm1.RzButton1Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
   i:integer;
begin
    for i:=0 to listbox1.Count-1 do
    begin
    if listbox1.Selected[i] then
     begin
     edit2.Text:=inttostr(i+1);
     exit;
     end;
    end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
form2.show;
end;

end.