unit1.pas

一个完整的彩票软件的源代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, jpeg, Grids, DBGrids, Db, DBTables, Buttons;
const
  dsize=3;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Table1: TTable;
    Panel2: TPanel;
    Panel1: TPanel;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    DBGrid1: TDBGrid;
    Label2: TLabel;
    Bevel1: TBevel;
    Button2: TButton;
    DataSource1: TDataSource;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button7: TButton;
    Edit3: TEdit;
    Label5: TLabel;
    Button8: TButton;
    Button9: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Edit4: TEdit;
    Edit5: TEdit;
    Label6: TLabel;
    Button10: TButton;
    CheckBox1: TCheckBox;
    Query1: TQuery;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Table1AfterOpen(DataSet: TDataSet);
  private
    procedure produce;
    procedure setjl;
    procedure producehistory;
    function jlrandom(aint: integer): integer;
    procedure myKeyPress(Sender: TObject; var Key: Char);
    procedure myChange(Sender: TObject);

    procedure settable;
    procedure disall;
    { Private declarations }
  public
    { Public declarations }
  end;
  dataarray=array [1..100] of integer;
  lblarray=array [1..100] of Tlabel;
  editarray=array [1..100] of Tedit;
  sevenSegment=array[0..9,1..7] of integer;
  Segment=array[1..7,1..6] of TPoint;
  tmpseg=array[1..6] of tpoint;
var
  maxdata,maxdis:integer;
  Form1: TForm1;
  ok:boolean;
  mydata:dataarray;
//  mylbl:lblarray;
  myjl:dataarray;
  mypos:dataarray;
  totaljl:integer;
  myedit:editarray;
const
  fSevenSegment:sevenSegment= ((1, 1, 1, 0, 1, 1, 1),
                         (0, 0, 1, 0, 0, 1, 0),
                         (1, 0, 1, 1, 1, 0, 1),
                         (1, 0, 1, 1, 0, 1, 1),
                         (0, 1, 1, 1, 0, 1, 0),
                         (1, 1, 0, 1, 0, 1, 1),
                         (1, 1, 0, 1, 1, 1, 1),
                         (1, 0, 1, 0, 0, 1, 0),
                         (1, 1, 1, 1, 1, 1, 1),
                         (1, 1, 1, 1, 0, 1, 1));
  ptSegment:Segment= ( ((x:7;y:6),(x:11;Y:  2),  (x:31;y:  2),  (x:35;y:  6),  (x:31;y: 10),  (x:11;y: 10)),
                          ((x:6;y:  7), ( x:10;Y: 11), ( x:10;y: 31), (  x:6;y: 35), (  x:2;y: 31), (  x:2;y: 11)),
                         ((x:36;y:  7),  (x:40;y: 11),  (x:40;Y:31),  (x:36;y: 35),  (x:32;y: 31),  (x:32;y:11)),
                          ((x:7;y: 36),  (x:11;y:32),  (x:31;y: 32),  (x:35;y: 36),  (x:31;y: 40),  (x:11;y: 40)),
                          ((x:6;y: 37),  (x:10;y: 41),  (x:10; y:61),   (x:6;y: 65),   (x:2;y: 61),  ( x:2;y: 41)),
                         ((x:36;y: 37),  (x:40;y: 41),  (x:40;y: 61),  (x:36;y: 65),  (x:32;Y: 61),  (x:32;y: 41)),
                          ((x:7;y: 66),  (x:11;y: 62), ( x:31;y: 62),  (x:35;y: 66),  (x:31;y: 70),  (x:11;y: 70)) ) ;


implementation

uses Unit2;


{$R *.DFM}

procedure initjl;
var
  i:integer;
begin
  for i:=1 to maxdata do begin
    myjl[i]:=1;
  end;
  totaljl:=maxdata;
end;
procedure Tform1.setjl;
var
  i:integer;
begin
  table1.DisableControls;
  table1.first;
  initjl;
  while not table1.eof do begin
    for i:=1 to maxdis do begin
      if (table1.fields[i].asinteger>=1) and (table1.fields[i].asinteger<=maxdata) then begin

        myjl[mypos[table1.fields[i].asinteger]]:=myjl[mypos[table1.fields[i].asinteger]]+1;
        totaljl:=totaljl+1;
      end;
    end;
    table1.next;
  end;
  table1.EnableControls;
end;
procedure DisplayDigit(aCanvas:TCanvas;iNumber:integer;point:TPoint);
var i,j:integer;
  aseg:tmpseg;
begin

     for i :=1 to 7 do begin
          if (fSevenSegment[iNumber,i]=1) then begin
            for j:=1 to 6 do begin
              aseg[j].x:=point.x+ptsegment[i][j].x div dsize;
              aseg[j].y:=point.y+ptsegment[i][j].y div dsize;
            end;
            acanvas.Polygon(aseg ) ;

          end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  image2.Canvas.brush.color:=clbtnface;
  image2.Canvas.pen.color:=clbtnface;
  image2.Canvas.Rectangle(image2.canvas.cliprect);
  maxdata:=strtoint(edit4.text);
  maxdis:=strtoint(edit5.text);
  randomize;
  settable;
end;

procedure Tform1.settable;
var
  i:integer;

begin
  for i:=1 to maxdata do begin
    mydata[i]:=i;
    mypos[i]:=i;
  end;
    table1.close;
    table1.DatabaseName := extractfilepath(application.ExeName);
    table1.TableType := ttParadox;
    if checkbox1.checked then
     table1.TableName := 'lssj'+inttostr(maxdata)+'-'+inttostr(maxdis)+'t'
    else
    table1.TableName := 'lssj'+inttostr(maxdata)+'-'+inttostr(maxdis);
    if not Table1.Exists then begin
      with Table1 do begin
    { The Table component must not be active }
       Active := False;
    { First, describe the type of table and give }
    { it a name }
     { Next, describe the fields in the table }
       with FieldDefs do begin
        Clear;
        with AddFieldDef do begin
            Name := '期别';
            DataType := ftstring;
            Required := True;
            size:=5;
        end;

        for i:=1 to maxdis do begin
          with AddFieldDef do begin
            Name := inttostr(i);
            DataType := ftInteger;
            Required := True;
          end;
        end;
       end;
    { Call the CreateTable method to create the table }
      CreateTable;
    end;



  end;
  table1.open;
end;
function Tform1.jlrandom(aint:integer):integer;
var
  i,j,alljl:integer;
  idata:integer;
  tmp:integer;
begin

//      ipos:=i+random(maxdata-listbox2.items.count+1-i);

  setjl;
  alljl:=0;
  for i:=aint to maxdata-listbox2.items.count do begin
    alljl:=alljl+myjl[i];
  end;
  idata:=random(alljl)+1;
  tmp:=0;
  j:=-1 ;
  while tmp<idata do begin
    j:=j+1;
    tmp:=tmp+myjl[aint+j];
  end;
  result:=aint+j;
  if (result<aint) or (result>maxdata) then showmessage('begin:'+inttostr(aint)+';result:'+inttostr(result));
end;
procedure Tform1.producehistory;
var i,tmp:integer;
  ipos:integer;
begin

   for i:=1 to listbox1.Items.Count do begin
      ipos:=mypos[strtoint(listbox1.items[i-1])];
      image1.canvas.Brush.color:=clteal;
      image1.canvas.Rectangle((120 div dsize)*(i-1),0,2+(120 div dsize)*(i-1)+29,26);
      image1.canvas.Brush.color:=clred;
      displaydigit(image1.canvas,(mydata[ipos])div 10,Point((120 div dsize)*(i-1),1));
      displaydigit(image1.canvas,(mydata[ipos]) mod 10,Point((120 div dsize)*(i-1)+(50 div dsize),1));
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;
      mypos[mydata[i]]:=i;

   end;
   for i:=maxdata-listbox2.items.count+1 to maxdata do begin
      ipos:=mypos[strtoint(listbox2.items[i-(maxdata-listbox2.items.count+1)])];
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;
      mypos[mydata[i]]:=i;

   end;





   for i:=listbox1.Items.Count+1 to listbox1.Items.Count+maxdis do begin
      ipos:=jlrandom(i);
      image1.canvas.Brush.color:=clteal;
      image1.canvas.Rectangle((120 div dsize)*(i-1),0,2+(120 div dsize)*(i-1)+29,26);
      image1.canvas.Brush.color:=clred;
      displaydigit(image1.canvas,(mydata[ipos])div 10,Point((120 div dsize)*(i-1),1));
      displaydigit(image1.canvas,(mydata[ipos]) mod 10,Point((120 div dsize)*(i-1)+(50 div dsize),1));
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;
      mypos[mydata[i]]:=i;
//      mylbl[ipos].caption:=inttostr(tmp);
   end;
   setjl;
   for i:=1 to maxdis do begin
//      mylbl[i].caption:=inttostr(myjl[i])+'/'+inttostr(totaljl);
   end;

{
   for i:=1 to maxdis do begin
      ipos:=jlrandom(i);
      image1.canvas.Brush.color:=clteal;
      image1.canvas.Rectangle((120 div dsize)*(i-1),0,2+(120 div dsize)*(i-1)+29,26);
      image1.canvas.Brush.color:=clred;
      displaydigit(image1.canvas,(mydata[ipos])div 10,Point((120 div dsize)*(i-1),1));
      displaydigit(image1.canvas,(mydata[ipos]) mod 10,Point((120 div dsize)*(i-1)+(50 div dsize),1));
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;
      mypos[mydata[i]]:=i;
//      mylbl[ipos].caption:=inttostr(tmp);
   end;
   setjl;
   for i:=1 to maxdis do begin
      mylbl[i].caption:=inttostr(myjl[i])+'/'+inttostr(totaljl);
   end;
 }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  produce;
end;
procedure Tform1.produce;
var i,tmp:integer;
  ipos:integer;
begin
   for i:=1 to listbox1.Items.Count do begin
      ipos:=mypos[strtoint(listbox1.items[i-1])];
      image1.canvas.Brush.color:=clteal;
      image1.canvas.Rectangle((120 div dsize)*(i-1),0,2+(120 div dsize)*(i-1)+29,26);
      image1.canvas.Brush.color:=clred;
      displaydigit(image1.canvas,(mydata[ipos])div 10,Point((120 div dsize)*(i-1),1));
      displaydigit(image1.canvas,(mydata[ipos]) mod 10,Point((120 div dsize)*(i-1)+(50 div dsize),1));
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;
      mypos[mydata[i]]:=i;

   end;
   for i:=maxdata-listbox2.items.count+1 to maxdata do begin
      ipos:=mypos[strtoint(listbox2.items[i-(maxdata-listbox2.items.count+1)])];
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;
      mypos[mydata[i]]:=i;

   end;



   for i:=listbox1.Items.Count+1 to listbox1.Items.Count+maxdis do begin
      ipos:=i+random(maxdata-listbox2.items.count+1-i);
      image1.canvas.Brush.color:=clteal;
      image1.canvas.Rectangle((120 div dsize)*(i-1),0,2+(120 div dsize)*(i-1)+29,26);
      image1.canvas.Brush.color:=clred;
      displaydigit(image1.canvas,(mydata[ipos])div 10,Point((120 div dsize)*(i-1),1));
      displaydigit(image1.canvas,(mydata[ipos]) mod 10,Point((120 div dsize)*(i-1)+(50 div dsize),1));
      tmp:=mydata[i];
      mydata[i]:=mydata[ipos];
      mydata[ipos]:=tmp;

      mypos[mydata[ipos]]:=ipos;