unit main;

interface

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

type
  TFrmMain = class(TForm)
    memInfo: TMemo;
    pnl1: TPanel;
    btnCopy: TButton;
    grp2: TGroupBox;
    link1: TCheckBox;
    link2: TCheckBox;
    link3: TCheckBox;
    link4: TCheckBox;
    link5: TCheckBox;
    f5: TCheckBox;
    f4: TCheckBox;
    f32: TCheckBox;
    f31: TCheckBox;
    f22: TCheckBox;
    f21: TCheckBox;
    f1: TCheckBox;
    lbl1: TLabel;
    edtHave: TEdit;
    edtKill: TEdit;
    lbl2: TLabel;
    edtSumLast: TEdit;
    Label1: TLabel;
    edtSpan: TEdit;
    Label2: TLabel;
    edtSum: TEdit;
    Label3: TLabel;
    btnOK: TButton;
    edtTest: TEdit;
    btnTest: TButton;
    GroupBox1: TGroupBox;
    edtD: TEdit;
    d2: TCheckBox;
    d3: TCheckBox;
    d4: TCheckBox;
    d5: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnTestClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
  private
    { Private declarations }
    FAllData: TStringList;
    procedure GetAllData;
    function NeedKill(AStick: string): Boolean;
    function NeedKillSumLast(AStick: string): Boolean;
    function NeedKillSpan(AStick: string): Boolean;
    function NeedKillLink(AStick: string): Boolean;
    function NeedKillFormat(AStick: string): Boolean;
    procedure ShowResult;
    function InDan(AStick: string): Boolean;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

function GetWord(var ASentence: string; ASeparate: string = ';'): string;
//从ASentence中截取以ASeparate为分界符以前的字符串。
//如果没有分界符，返回全部；
var
  FPos: Integer;
begin
  //注意：Pos函数大小写敏感
  FPos := Pos(UpperCase(ASeparate), UpperCase(ASentence));
  if FPos = 0 then
  begin
    Result := ASentence;        
    ASentence := '';
  end
  else begin
    Result := Trim(Copy(ASentence, 1, FPos - 1));
    ASentence := Trim(Copy(ASentence, FPos + Length(ASeparate),
    	Length(ASentence)));
  end;
end;

function  StringToList(AList: TStringList; ASentence: string;
  ASeparate: string; ReadToName: Boolean = false): Boolean;
begin
  Result := False;
  if not Assigned(AList) then exit;
  AList.Clear;
  while ASentence <> '' do
  if not ReadToName then
    AList.Add(GetWord(ASentence, ASeparate))
  else
    AList.Add(GetWord(ASentence, ASeparate)+'=');
  Result := True;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FAllData := TStringList.Create;

  btnTest.Visible := false;
  edtTest.Visible := false;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FAllData.Free;
end;

procedure TFrmMain.GetAllData;
var
  i: integer;
begin
  FAllData.Clear;
  for i := 0 to 99999 do
  begin
    FAllData.Add(Format('%.5d', [i]));
    //Application.ProcessMessages;
  end;    
end;

function IsOut(AStick: string; AOutList: TStringList): Boolean;
var
  i: Integer;
  vOut: string;

  function IsOutItem(): Boolean;
  var
    j, vIndex: integer;
    vStick: string;
  begin
    //其中一组的必出
    result := false;
    vStick := AStick;
    for j := 1 to Length(vOut) do
    begin
      vIndex := Pos(vOut[j], vStick);
      if vIndex > 0 then
        Delete(vStick, vIndex, 1)
      else
        exit;
    end;  
    result := true;
  end;

begin
  if AOutList.Count = 0 then
  begin
    result := true;
    exit;
  end;

  for i := 0 to AOutList.Count - 1 do
  begin
    vOut := AOutList.Strings[i];

    if IsOutItem() then
    begin
      Result := true;
      exit;
    end;      
  end;  
  result := false;     
end;

function TFrmMain.NeedKill(AStick: string): Boolean;
var
  i: integer;
  vKillStr: string;
begin
  result := false;
  vKillStr := Trim(edtKill.Text);
  for i := 1 to Length(vKillStr) do
  begin
    if Trim(vKillStr[i]) <> '' then
    begin
      if Pos(vKillStr[i], AStick) > 0 then
      begin
        result := true;
        exit;
      end;
    end;
  end;  
end;

function TFrmMain.NeedKillSumLast(AStick: string): Boolean;
var
  i: integer;
  vSumLast, vKillStr: string;

  function GetSumLast(): string;
  var
    vSum, j: Integer;
    vSumStr: string;
  begin
    vSum := 0;
    for j := 1 to 5 do
    begin
      vSum := vSum + StrToInt(AStick[j]);
    end;
    vSumStr := IntToStr(vSum);                   
    Result := vSumStr[Length(vSumStr)];
  end;
  
begin
  result := false;
  vSumLast := GetSumLast;

  vKillStr := Trim(edtSumLast.Text);
  for i := 1 to Length(vKillStr) do
  begin
    if Trim(vKillStr[i]) <> '' then
    begin
      if Pos(vKillStr[i], vSumLast) > 0 then
      begin
        result := true;
        exit;
      end;
    end;
  end;  
end;  

function TFrmMain.NeedKillSpan(AStick: string): Boolean;
var
  vSpan, i: integer;
  vKillStr: string;      

  function GetSpan(): integer;
  var
    i, vMin, vMax: Integer;
  begin
    vMin := StrToInt(AStick[1]);
    vMax := StrToInt(AStick[1]);
    for i := 2 to 5 do
    begin
      if StrToInt(AStick[i]) < vMin then
        vMin := StrToInt(AStick[i]);

      if StrToInt(AStick[i]) > vMax then
        vMax := StrToInt(AStick[i]);
    end;
    result := vMax - vMin;
  end;
  
begin
  result := false;
  vSpan := GetSpan;

  vKillStr := Trim(edtSpan.Text);
  for i := 1 to Length(vKillStr) do
  begin
    if Trim(vKillStr[i]) <> '' then
    begin
      if Pos(vKillStr[i], IntToStr(vSpan)) > 0 then
      begin
        result := true;
        exit;
      end;
    end;
  end;  
end;

function NeedKillSum(AStick: string; ASumList: TStringList): Boolean;
var
  i, vSum: Integer;
  vOut: string;        
begin
  result := false;

  if ASumList.Count = 0 then
    exit;

  vSum := 0;
  for i := 1 to 5 do
  begin
    vSum := vSum + StrToInt(AStick[i]);
  end;

  for i := 0 to ASumList.Count - 1 do
  begin
    vOut := ASumList.Strings[i];       
    if StrToInt(vOut) = vSum then
    begin
      Result := true;
      exit;
    end;      
  end; 
end;

function GetNextNum(ACurr: Integer): integer;
begin
  result := ACurr + 1;
  if result = 10 then
    result := 0;
end;

function GetLinkNoEx(AStick: string; AStartPos: integer): integer;
var
  i, vNext, vLinkNo: integer;
begin
  vLinkNo := 1;
  for i := AStartPos to Length(AStick) - 1 do
  begin
    vNext := GetNextNum(StrToInt(AStick[i]));
    if StrToInt(AStick[i+1]) = vNext then
      inc(vLinkNo)
    else
      Break;  
  end;
  result := vLinkNo;
end;

function GetLinkNo(AStick: string): integer;
var
  vLinkNo: integer;
  vStick: string;
begin
  result := 1;

  vStick := AStick;
  vLinkNo := GetLinkNoEx(vStick, 1);
  if vLinkNo > result then result := vLinkNo;

  vStick := AStick[2]+AStick[3]+AStick[4]+AStick[5]+AStick[1];
  vLinkNo := GetLinkNoEx(vStick, 1);
  if vLinkNo > result then
    result := vLinkNo;

  vStick := AStick[3]+AStick[4]+AStick[5]+AStick[1]+AStick[2];
  vLinkNo := GetLinkNoEx(vStick, 1);
  if vLinkNo > result then
    result := vLinkNo;

  vStick := AStick[4]+AStick[5]+AStick[1]+AStick[2]+AStick[3];
  vLinkNo := GetLinkNoEx(vStick, 1);
  if vLinkNo > result then
    result := vLinkNo;

  vStick := AStick[5]+AStick[1]+AStick[2]+AStick[3]+AStick[4];
  vLinkNo := GetLinkNoEx(vStick, 1);
  if vLinkNo > result then
    result := vLinkNo;
end;

function TFrmMain.NeedKillLink(AStick: string): boolean;
var
  vLinkNo: Integer;
begin
  result := false;
  vLinkNo := GetLinkNo(AStick); 
  case vLinkNo of
    1: result := link1.Checked;
    2: result := link2.Checked;
    3: result := link3.Checked;
    4: result := link4.Checked;
    5: result := link5.Checked;
  end;
end;

function GetStickFormat(AStick: string): Integer;
var
  vkey: TStringList;
  vVal: TList;
  i, vIndex: integer;
  vChar: string;
begin
  vkey := TStringList.Create;
  vVal := TList.Create;
  try
    for i := 1 to Length(AStick) do
    begin
      vChar := AStick[i];
      vIndex := vkey.IndexOf(vChar);
      if vIndex = -1 then
      begin
        vkey.Add(vChar);
        vVal.Add(Pointer(1));        
      end
      else begin
        vVal.Items[vIndex] := Pointer(Integer(vVal.Items[vIndex]) + 1);        
      end;                                                              
    end;

    if vkey.Count = 1 then
      result := 5
    else if vkey.Count = 2 then
    begin
      if (Integer(vVal.Items[0]) = 4) or (Integer(vVal.Items[1]) = 4) then 
        result := 4
      else
        result := 32;
    end  
    else if vkey.Count = 3 then
    begin
      if (Integer(vVal.Items[0]) = 3) or (Integer(vVal.Items[1]) = 3)
        or (Integer(vVal.Items[2]) = 3) then 
        Result := 31
      else
        result := 22;  
    end
    else if vkey.Count = 4 then 
      result := 21
    else
      result := 1;
  finally
    vkey.Free;
    vVal.Free;
  end;        
end;

function TFrmMain.NeedKillFormat(AStick: string): Boolean;
var
  vFormat: integer;
begin
  result := false;

  vFormat := GetStickFormat(AStick);
  case vFormat of
    5: result := f5.Checked;
    4: result := f4.Checked;
    32: result := f32.Checked;
    31: result := f31.Checked;
    22: result := f22.Checked;
    21: result := f21.Checked;
    1: result := f1.Checked;
  else
    begin
      ShowMessage('计算错误！');
      Abort;
    end;
  end;
end;

procedure TFrmMain.ShowResult();
var
  vList: TStringList;
  i, vCols: integer;
  vRowStr: string;
begin
  vList := TStringList.Create;
  try
    vCols := 0;
    vRowStr := '';
    for i := 0 to FAllData.Count - 1 do
    begin
      Inc(vCols);

      if vCols <= 10 then
      begin
        if vRowStr = '' then
          vRowStr := FAllData.Strings[i]
        else
          vRowStr := vRowStr + ' ' + FAllData.Strings[i];
      end;

      if vCols = 10 then
      begin
        vList.Add(vRowStr);
        vCols := 0;
        vRowStr := '';
      end;
    end;

    if vCols > 0 then
      vList.Add(vRowStr);

    memInfo.Lines.Text := vList.Text;
    Caption := IntToStr(FAllData.Count);
  finally
    vList.Free;
  end;
end;        

procedure TFrmMain.btnTestClick(Sender: TObject);
begin
  Caption := IntToStr(GetLinkNo(edtTest.Text));
end;

function TFrmMain.InDan(AStick: string): Boolean;
var
  vDan: string;
  i: integer;
  vCount: integer;
begin
  result := false;
  vDan := Trim(edtD.text);
  if vDan = '' then
  begin
    result := true;
    exit;    
  end;

  vCount := 0;
  for i := 1 to Length(vDan) do
  begin
    if Pos(vDan[i], AStick) > 0 then
      Inc(vCount);
  end;

  if d2.Checked and (vCount >= 2)
    or d3.Checked and (vCount >= 3)
    or d4.Checked and (vCount >= 4)
    or d5.Checked and (vCount >= 5) then
    result := true;    
end;

procedure TFrmMain.btnOKClick(Sender: TObject);
var
  vList: TStringList;
  i: Integer;
  vStr: string;
begin
  GetAllData;   

  // 必出
  vList := TStringList.Create;
  try
    StringToList(vList, edtHave.Text, ' ');
    for i := FAllData.Count - 1 downto 0 do
    begin
      vStr := FAllData.Strings[i];
      if IsOut(vStr, vList) then

      else
        FAllData.Delete(i);
    end;
  finally
    vList.Free;
  end;
  
  // 通杀
  for i := FAllData.Count - 1 downto 0 do
  begin
    vStr := FAllData.Strings[i];
    if NeedKill(vStr) then
      FAllData.Delete(i);      
  end;

  // 杀和尾
  for i := FAllData.Count - 1 downto 0 do
  begin
    vStr := FAllData.Strings[i];
    if NeedKillSumLast(vStr) then
      FAllData.Delete(i);      
  end;

  // 杀跨度
  for i := FAllData.Count - 1 downto 0 do
  begin
    vStr := FAllData.Strings[i];
    if NeedKillSpan(vStr) then
      FAllData.Delete(i);      
  end;     

  // 杀和值
  vList := TStringList.Create;
  try
    StringToList(vList, edtSum.Text, ' ');
    for i := FAllData.Count - 1 downto 0 do
    begin
      vStr := FAllData.Strings[i];
      if NeedKillSum(vStr, vList) then      
        FAllData.Delete(i);
    end;
  finally
    vList.Free;
  end;

  // 不连，2连......
  for i := FAllData.Count - 1 downto 0 do
  begin
    vStr := FAllData.Strings[i];
    if NeedKillLink(vStr) then
      FAllData.Delete(i);
  end;

  // AAAAA, AAAAB
  for i := FAllData.Count - 1 downto 0 do
  begin
    vStr := FAllData.Strings[i];
    if NeedKillFormat(vStr) then
      FAllData.Delete(i);
  end;

  //出胆
  for i := FAllData.Count - 1 downto 0 do
  begin
    vStr := FAllData.Strings[i];
    if not InDan(vStr) then
      FAllData.Delete(i);
  end;

  ShowResult();
end;

procedure TFrmMain.btnCopyClick(Sender: TObject);
begin
  //
  Clipboard.AsText := memInfo.Lines.Text;
end;

end.