umainfrm.pas

双色球矩阵计算程序

  dm.query.Close;
  dm.query.SQL.Text := format('select * from 历史数据 where 期数>=%s and 期数<=%s order by 期数',
    [cmbBegin.Items[cmbBegin.ItemIndex], cmbEnd.Items[cmbEnd.ItemIndex]]);
  dm.query.Open;

  lds := TCHListDataSet.Create;
  dm.cdsTemp.DisableControls;
  try
    lds.AddField('期数', 16);
    lds.AddField('中6', 6);
    lds.AddField('中5', 6);
    lds.AddField('中4', 6);
    while not dm.query.Eof do begin
      CompareResult(dm.query.Fields[1].AsInteger, dm.query.Fields[2].AsInteger, dm.query.Fields[3].AsInteger,
                    dm.query.Fields[4].AsInteger, dm.query.Fields[5].AsInteger, dm.query.Fields[6].AsInteger);
      if z6+z5+z4 <> 0 then begin
        lds.AddItem(dm.query.FieldByName('期数').AsString);
        lds.AddSubItem(IntToStr(z6));
        lds.AddSubItem(IntToStr(z5));
        lds.AddSubItem(IntToStr(z4));
      end;
      dm.query.Next;
    end;
    dm.cdsResult.LoadFromStream(lds.GetStream);
  finally
    lds.Free;
    dm.cdsTemp.EnableControls;
  end;
end;

procedure TMainFrm.GetMatrix(ACount: Integer);
var
  id: Integer;
begin
  dm.query.Close;
  dm.query.SQL.Text := format('select min(ID), count(*) from 旋转矩阵 where 球数=%d', [ACount]);
  dm.query.Open;
  id := 0;
  if not dm.query.Eof then
    if dm.query.Fields[1].AsInteger > 0 then
      id := dm.query.Fields[0].AsInteger - 1; 

  dm.aqMatrix.DisableControls;
  dm.aqMatrix.Close;
  dm.aqMatrix.SQL.Text := format('select ID-%d as 序号, 号1, 号2, 号3, 号4, 号5, 号6 from 旋转矩阵 where 球数=%d order by ID',
        [id, ACount]);
  dm.aqMatrix.Open;
  for id:=0 to dm.aqMatrix.FieldCount-1 do
    dm.aqMatrix.Fields[id].DisplayWidth := 6;
  dm.aqMatrix.EnableControls;
end;

procedure TMainFrm.cmbCountChange(Sender: TObject);
begin
  if cmbCount.ItemIndex >= 0 then GetMatrix(StrToint(cmbCount.Items[cmbCount.ItemIndex]));
end;

procedure TMainFrm.btnVerifyClick(Sender: TObject);
var
  a: array[1..6] of Integer;
  t, tend, tcount: Integer;
  z6, z5, z4, z65, z654, zall, z123: Integer;
  lds: TCHListDataSet;
  procedure CompareResult(i1, i2, i3, i4, i5, i6: Integer);
  var i, r: Integer;
  begin
    z6 := 0;
    z5 := 0;
    z4 := 0;
    if dm.aqMatrix.RecordCount > 0 then dm.aqMatrix.First;
    while not dm.aqMatrix.Eof do begin
      r := 0;
      for i:=1 to 6 do begin
        if i1 = dm.aqMatrix.Fields[i].AsInteger then Inc(r);
        if i2 = dm.aqMatrix.Fields[i].AsInteger then Inc(r);
        if i3 = dm.aqMatrix.Fields[i].AsInteger then Inc(r);
        if i4 = dm.aqMatrix.Fields[i].AsInteger then Inc(r);
        if i5 = dm.aqMatrix.Fields[i].AsInteger then Inc(r);
        if i6 = dm.aqMatrix.Fields[i].AsInteger then Inc(r);
      end;
      if r = 4 then Inc(z4);
      if r = 5 then Inc(z5);
      if r = 6 then Inc(z6);
      dm.aqMatrix.Next;
    end;
  end;
  function IsValidNum(ANum, ACount: Integer): Boolean;
  var i, x, count: Integer;
  begin
    x := 1;
    count := 0;
    for i:=1 to ACount do begin
      if (ANum and x) <> 0 then Inc(count);
      x := x * 2;
    end;
    if count <> 6 then result := false else begin
      result := true;
      count := 1;
      x := 1;
      for i:=1 to ACount do begin
        if (ANum and x) <> 0 then begin
          a[count] := i;
          Inc(count);
        end;
        x := x * 2;
      end;
    end;
  end;
begin
  Screen.Cursor := crHourGlass;

  tend := 1;
  tcount := strtoint(cmbCount.Items[cmbCount.ItemIndex]);
  for t:=1 to tcount do tend := tend * 2;

  lds := TCHListDataSet.Create;
  dm.aqMatrix.DisableControls;
  try
    lds.AddField('号码值', 16);
    lds.AddField('中6', 6);
    lds.AddField('中5', 6);
    lds.AddField('中4', 6);
    zall := 0;
    z123 := 0;
    z65 := 0;
    z654 := 0;
    for t:=63 to tend do begin
      if IsValidNum(t, tcount) then begin
        Inc(zall);
        CompareResult(a[1], a[2], a[3], a[4], a[5], a[6]);
        if z6+z5+z4 <> 0 then begin
          lds.AddItem(inttostr(a[1])+','+inttostr(a[2])+','+inttostr(a[3])+','+inttostr(a[4])+','+inttostr(a[5])+','+inttostr(a[6]));
          lds.AddSubItem(IntToStr(z6));
          lds.AddSubItem(IntToStr(z5));
          lds.AddSubItem(IntToStr(z4));
          Inc(z654);
        end
        else Inc(z123);

        if z6+z5 <> 0 then Inc(z65);
      end;
    end;
    labResult.Caption := format('验证结果统计：共验证 %d 种组合，中5,6个球的有 %d 种组合，'#13#10'中4,5,6个球的有 %d 种组合, 中4个球以下的有 %d 种组合', [zall, z65, z654, z123]);
    dm.cdsVerify.LoadFromStream(lds.GetStream);
  finally
    lds.Free;
    dm.aqMatrix.EnableControls;
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainFrm.InitcdsResult;
var
  lds: TCHListDataSet;  
begin
  lds := TCHListDataSet.Create;
  try
    lds.AddField('期数', 16);
    lds.AddField('中6', 6);
    lds.AddField('中5', 6);
    lds.AddField('中4', 6);
    dm.cdsResult.LoadFromStream(lds.GetStream);
  finally
    lds.Free;
  end;
end;

procedure TMainFrm.InitcdsVerify;
var
  lds: TCHListDataSet;  
begin
  lds := TCHListDataSet.Create;
  try
    lds.AddField('号码值', 16);
    lds.AddField('中6', 6);
    lds.AddField('中5', 6);
    lds.AddField('中4', 6);
    dm.cdsVerify.LoadFromStream(lds.GetStream);
  finally
    lds.Free;
  end;
end;

procedure TMainFrm.DBGridEh1GetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  if Column.Index = 0 then Background := clBtnFace;
end;

procedure TMainFrm.DBGridEh5GetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
var
  i: Integer;
begin
  i := Column.Index;
  if i = dm.aqHistory.FieldByName('红1').AsInteger then begin Background := clFuchsia; Exit; end;
  if i = dm.aqHistory.FieldByName('红2').AsInteger then begin Background := clFuchsia; Exit; end;
  if i = dm.aqHistory.FieldByName('红3').AsInteger then begin Background := clFuchsia; Exit; end;
  if i = dm.aqHistory.FieldByName('红4').AsInteger then begin Background := clFuchsia; Exit; end;
  if i = dm.aqHistory.FieldByName('红5').AsInteger then begin Background := clFuchsia; Exit; end;
  if i = dm.aqHistory.FieldByName('红6').AsInteger then begin Background := clFuchsia; Exit; end;
end;

procedure TMainFrm.btnAddClick(Sender: TObject);
begin
  if (not CheckNum(eNo.Text, False)) or (Length(eNo.Text) <> 7) then begin
    ErrorMsg('输入的期数不正确');
    eNo.SetFocus;
    Exit;
  end;
  if (not CheckNum(eRed1.Text, False)) or (StrToInt(eRed1.Text) > 33) or (StrToInt(eRed1.Text) < 1) then begin
    ErrorMsg('第1个号码不正确');
    eRed1.SetFocus;
    Exit;
  end;
  if (not CheckNum(eRed2.Text, False)) or (StrToInt(eRed2.Text) > 33) or (StrToInt(eRed2.Text) < 1) then begin
    ErrorMsg('第2个号码不正确');
    eRed2.SetFocus;
    Exit;
  end;
  if (not CheckNum(eRed3.Text, False)) or (StrToInt(eRed3.Text) > 33) or (StrToInt(eRed3.Text) < 1) then begin
    ErrorMsg('第3个号码不正确');
    eRed3.SetFocus;
    Exit;
  end;
  if (not CheckNum(eRed4.Text, False)) or (StrToInt(eRed4.Text) > 33) or (StrToInt(eRed4.Text) < 1) then begin
    ErrorMsg('第4个号码不正确');
    eRed4.SetFocus;
    Exit;
  end;
  if (not CheckNum(eRed5.Text, False)) or (StrToInt(eRed5.Text) > 33) or (StrToInt(eRed5.Text) < 1) then begin
    ErrorMsg('第5个号码不正确');
    eRed5.SetFocus;
    Exit;
  end;
  if (not CheckNum(eRed6.Text, False)) or (StrToInt(eRed6.Text) > 33) or (StrToInt(eRed6.Text) < 1) then begin
    ErrorMsg('第6个号码不正确');
    eRed6.SetFocus;
    Exit;
  end;
  if StrToInt(eRed1.Text) > StrToInt(eRed2.Text) then begin
    ErrorMsg('请由小到大地填写号码');
    eRed1.SetFocus;
    Exit;
  end;
  if StrToInt(eRed2.Text) > StrToInt(eRed3.Text) then begin
    ErrorMsg('请由小到大地填写号码');
    eRed2.SetFocus;
    Exit;
  end;
  if StrToInt(eRed3.Text) > StrToInt(eRed4.Text) then begin
    ErrorMsg('请由小到大地填写号码');
    eRed3.SetFocus;
    Exit;
  end;
  if StrToInt(eRed4.Text) > StrToInt(eRed5.Text) then begin
    ErrorMsg('请由小到大地填写号码');
    eRed4.SetFocus;
    Exit;
  end;
  if StrToInt(eRed5.Text) > StrToInt(eRed6.Text) then begin
    ErrorMsg('请由小到大地填写号码');
    eRed5.SetFocus;
    Exit;
  end;

  dm.query.Close;
  dm.query.SQL.Text := format('select count(*) from 历史数据 where 期数=%d', [StrToInt(eNo.Text)]);
  dm.query.Open;
  if dm.query.Fields[0].AsInteger <> 0 then begin
    if YesnoMsg('要增加的期数已存在，要覆盖吗？') = IDNO then begin
      eNo.SetFocus;
      Exit;
    end
    else
      if dm.aqHistory.Locate('期数', Variant(eNo.Text), []) then begin
        dm.aqHistory.Edit;
        dm.aqHistory.FieldByName('红1').AsInteger := StrToInt(eRed1.Text);
        dm.aqHistory.FieldByName('红2').AsInteger := StrToInt(eRed2.Text);
        dm.aqHistory.FieldByName('红3').AsInteger := StrToInt(eRed3.Text);
        dm.aqHistory.FieldByName('红4').AsInteger := StrToInt(eRed4.Text);
        dm.aqHistory.FieldByName('红5').AsInteger := StrToInt(eRed5.Text);
        dm.aqHistory.FieldByName('红6').AsInteger := StrToInt(eRed6.Text);
        dm.aqHistory.Post;
      end;
  end
  else begin
    dm.aqHistory.Append;
    dm.aqHistory.FieldByName('期数').AsInteger := StrToInt(eNo.Text);
    dm.aqHistory.FieldByName('红1').AsInteger := StrToInt(eRed1.Text);
    dm.aqHistory.FieldByName('红2').AsInteger := StrToInt(eRed2.Text);
    dm.aqHistory.FieldByName('红3').AsInteger := StrToInt(eRed3.Text);
    dm.aqHistory.FieldByName('红4').AsInteger := StrToInt(eRed4.Text);
    dm.aqHistory.FieldByName('红5').AsInteger := StrToInt(eRed5.Text);
    dm.aqHistory.FieldByName('红6').AsInteger := StrToInt(eRed6.Text);
    dm.aqHistory.Post;
  end;

  eNo.Text := '';
  eRed1.Text := '';
  eRed2.Text := '';
  eRed3.Text := '';
  eRed4.Text := '';
  eRed5.Text := '';
  eRed6.Text := '';
  eNo.SetFocus;
end;

procedure TMainFrm.btnInClick(Sender: TObject);
begin
  if od1.Execute then
    dm.cdsTemp.LoadFromFile(od1.Files[0]);
end;

procedure TMainFrm.btnOutClick(Sender: TObject);
begin
  if sd1.Execute then
    dm.cdsTemp.SaveToFile(sd1.Files[0], dfXML);
end;

procedure TMainFrm.btnPrintClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  with PrintDBGridEh1 do begin
    SetSubstitutes(['%[Today]', DateToStr(Today)]);
    PrinterPreview.Previewer.ViewMode := vm100; //100%
    Preview;
  end;
  Screen.Cursor := crDefault;
end;

end.