unit1.~pas

根据彩票以往出现的概率综合分析,统计筛选.满足彩民的一般需求

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, StrUtils;
const
  primenumber: array[0..11] of byte = (2, 3, 5, 7, 9, 11, 13, 17, 19, 23, 29, 31);
type

  TForm1 = class(TForm)
    Memo1: TMemo;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    CheckBox1: TCheckBox;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    CheckBox2: TCheckBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    CheckBox3: TCheckBox;
    ComboBox5: TComboBox;
    ComboBox6: TComboBox;
    ComboBox7: TComboBox;
    CheckBox4: TCheckBox;
    ComboBox8: TComboBox;
    ComboBox9: TComboBox;
    CheckBox5: TCheckBox;
    ComboBox10: TComboBox;
    ComboBox11: TComboBox;
    CheckBox6: TCheckBox;
    ComboBox12: TComboBox;
    ComboBox13: TComboBox;
    CheckBox7: TCheckBox;
    ComboBox14: TComboBox;
    ComboBox15: TComboBox;
    CheckBox8: TCheckBox;
    ComboBox16: TComboBox;
    ComboBox17: TComboBox;
    CheckBox9: TCheckBox;
    ComboBox18: TComboBox;
    Button2: TButton;
    ListView1: TListView;
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Button1: TButton;
    Label10: TLabel;
    CheckBox10: TCheckBox;
    Edit1: TEdit;
    Label11: TLabel;
    ComboBox19: TComboBox;
    CheckBox11: TCheckBox;
    ComboBox20: TComboBox;
    Label12: TLabel;
    ComboBox21: TComboBox;
    CheckBox12: TCheckBox;
    ComboBox22: TComboBox;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ischeck: boolean;
    procedure combine(a: array of byte; sub: integer);
  end;

var
  Form1: TForm1;
  value: array[1..10] of integer;
  a: array of byte;
  radomcount: integer;
implementation
uses unit2;
{$R *.dfm}

procedure TForm1.combine(a: array of byte; sub: integer);
var
  I: Integer;
  j, c: Integer;
  count, total: integer;
  lcount: integer;
  order: array of integer;
  k: integer;
  flag, exitsFlag: boolean;
  s: string;
  AC: array[0..14] of byte;
  s2: string;
  tempvalue:integer;
begin

  total := sizeof(a);
  if total < sub then exit;
  setlength(order, sub + 1);
  count := 0;
  for i := 0 to sub do
    order[i] := i - 1;
  k := sub;
  flag := true;
  while (order[0] = -1) do
  begin
    s := '';
    s2 := '';
    if (flag) then
    begin
      if checkbox1.Checked then
      begin
        lcount := 0;
        for I := 1 to sub do // Iterate
        begin
          if a[order[i]] mod 2 <> 0 then
            lcount := lcount + 1;
        end; // for
        if not ((lcount >= strtoint(ComboBox1.Text)) and (lcount <= strtoint(ComboBox2.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox2.Checked then
      begin
        lcount := 0;
        for I := 1 to sub do // Iterate
        begin
          lcount := lcount + a[order[i]];
        end; // for
        if not ((lcount >= strtoint(ComboBox3.Text)) and (lcount <= strtoint(ComboBox4.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox3.Checked then
      begin
        lcount := 0;
        for I := sub downto 0 do // Iterate
        begin
          if a[order[i]] >= total div 3 * 2 then
            lcount := lcount + 1
          else
            break;
        end; // for

        if not ((lcount >= strtoint(ComboBox5.Text)) and (lcount <= strtoint(ComboBox6.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;

      if CheckBox4.Checked then
      begin
        lcount := 0;
        for I := 0 to sub do // Iterate
        begin
          lcount := lcount + a[order[i]] mod 10;
        end; // for
        if not ((lcount >= strtoint(ComboBox7.Text)) and (lcount <= strtoint(ComboBox8.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox5.Checked then
      begin
        c := 0;
        lcount := 0;
        for I := 1 to 6 do // Iterate
          for j := I + 1 to 6 do // Iterate
          begin
            AC[c] := a[order[j]] - a[order[i]];
            c := c + 1;
          end; // for
        for i := 0 to 14 do
        begin
          exitsFlag := false; // false表示没有重复
          for j := 0 to i - 1 do
          begin
            if (AC[i] = AC[j]) then
            begin
              exitsFlag := true;
              break;
            end;
          end;
          if (not exitsFlag) then
            lcount := lcount + 1;
        end;
        lcount := lcount - (6 - 1);
        if not ((lcount >= strtoint(ComboBox9.Text)) and (lcount <= strtoint(ComboBox10.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox6.Checked then
      begin
        if not ((a[order[sub]] >= strtoint(ComboBox11.Text)) and (a[order[sub]] <= strtoint(ComboBox12.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox7.Checked then
      begin
        if not ((a[order[1]] >= strtoint(ComboBox13.Text)) and (a[order[1]] <= strtoint(ComboBox14.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox8.Checked then
      begin
        lcount := 0;
        for I := 1 to sub do // Iterate
          for j := 0 to 11 do // Iterate
          begin
            if a[order[i]] = primenumber[j] then
            begin
              lcount := lcount + 1;
              break;
            end;
          end; // for
        if not ((lcount >= strtoint(ComboBox15.Text)) and (lcount <= strtoint(ComboBox16.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox9.Checked then
      begin
        lcount := 0;
        exitsFlag := false;
        for I := 1 to sub - 1 do // Iterate
        begin
          if a[order[i + 1]] = a[order[i]] + 1 then
          begin
            exitsFlag := true;
            lcount := lcount + 1;
          end
          else
            exitsFlag := false;
          if (not exitsFlag) and (lcount > 0) then
            break;
        end; // for
        if not ((lcount >= strtoint(ComboBox17.Text)) and (lcount <= strtoint(ComboBox18.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox10.Checked then //必出数条件检查。
      begin
        exitsFlag := true;
        s2 := edit1.Text;
        while Length(s2)<>0 do //
        begin
          Application.ProcessMessages;
          if pos(',', s2) > 0 then      //23,24,31
          begin
            lcount := strtoint(leftstr(s2, pos(',', s2) - 1)); //
            s2 := midstr(s2, pos(',', s2) + 1, length(s2) - pos(',', s2));
            for I := 1 to sub do // Iterate
            begin
                Application.ProcessMessages;
              if a[order[i]] = byte(lcount) then
                  break;
              if sub=i then
                exitsFlag:=false;
            end; // for
            if not exitsFlag then
              break;
          end
          else //if Length(s2)>0 then
          begin
            lcount := strtoint(s2);
            s2:='';
            for I := 1 to sub do // Iterate
            begin
                Application.ProcessMessages;
              if a[order[i]] = byte(lcount) then
                break;
            if sub=i then
              exitsFlag:=false;
            end; // for
          end;
        end; // while
        if not exitsFlag then
        begin
          flag:=false;      
          continue;
        end;
      end;
      if CheckBox11.Checked then
      begin
       lcount := 0;
        i:=1;
        while I < sub-2  do // Iterate
        begin
         lcount:= a[order[i+1]]-a[order[i]] ;
         tempvalue:= a[order[i+2]]- a[order[i+1]];
         if lcount < tempvalue then
            lcount:=tempvalue;
         i:=i+2;
        end;
         if not ((lcount >= strtoint(ComboBox19.Text)) and (lcount <= strtoint(ComboBox20.Text))) then
        begin
          flag := false;
          continue;
        end;
      end;
      if CheckBox12.Checked then
       begin
        lcount := 0;
        i:=1;
        while I < sub-2  do // Iterate
        begin
         lcount:= a[order[i+1]]-a[order[i]] ;
         tempvalue:= a[order[i+2]]- a[order[i+1]];
         if lcount > tempvalue then
            lcount:=tempvalue;
         i:=i+2;
        end;
         if not ((lcount >= strtoint(ComboBox21.Text)) and (lcount <= strtoint(ComboBox22.Text))) then
        begin
          flag := false;
          continue;
        end;
        
       end;
      for I := 1 to sub do // Iterate
        s := s + inttostr(a[order[i]]) + ' ';
      memo1.lines.add(s);
      count := count + 1;
      flag := false;
    end;
    order[k] := order[k] + 1;
    if (order[k] = total) then
    begin
      order[k] := 0;
      k := k - 1;
      continue;
    end;

    //在此加入order[k]的限制条件
    //如果条件满足,则往下执行
    //否则continue;
    if (k < sub) then
    begin
      k := k + 1;
      order[k] := order[k - 1];
      continue;
    end;

    if (k = sub) then
      flag := true;
  end;
  Label10.Caption := '共计' + inttostr(count) + '注';
  a:=nil;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  memo1.Lines.Clear;
  if ischeck then
    combine(a, 6)
  else
  begin
    setlength(a, 33);
    for I := 0 to 32 do // Iterate
    begin
      a[i] := i + 1;
    end; // for
    combine(a, 6)
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin

  ischeck := false;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  i: integer;
begin
  for I := 0 to ListView1.Items.Count - 1 do // Iterate
  begin
    ListView1.Items.Item[i].Checked := true;
  end; // for
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  i: integer;
begin
  for I := 0 to ListView1.Items.Count - 1 do // Iterate
  begin
    if ListView1.Items.Item[i].Checked then
      ListView1.Items.Item[i].Checked := false
    else
      ListView1.Items.Item[i].Checked := true;
  end; // for

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
  i: integer;
begin
  for I := 0 to ListView1.Items.Count - 1 do // Iterate
  begin
    ListView1.Items.Item[i].Checked := false;
  end; // for

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
  i: integer;
begin
  for I := 0 to ListView1.Items.Count - 1 do // Iterate
  begin
    ListView1.Items.Item[i].Checked := false;
  end; // for
  form2.ShowModal;
  for I := 0 to radomcount - 1 do // Iterate
  begin
    listview1.Items.Item[random(33)].Checked := true;
  end; // for
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, count: integer;
  icount: integer;
begin
  ischeck := true;
  icount := 0;
  count := 0;
  for I := 0 to listview1.Items.Count - 1 do // Iterate
  begin
    if listview1.Items.Item[i].Checked then
      count := count + 1;
  end; // for
  if count < 6 then
  begin
    application.messagebox('选出号应大于6个数', '错误提示！', mb_ok + mb_iconinformation);
  end;
  setlength(a, count);
  for I := 0 to listview1.Items.Count - 1 do // Iterate
  begin
    if listview1.Items.Item[i].Checked then
    begin
      a[icount] := strtoint(listview1.Items.Item[i].Caption);
      icount := icount + 1;
    end;
  end; // for
  pagecontrol1.ActivePageIndex := 1;
end;

end.