unit main;

{*
BINGO_Maker version 0.1.0.0
CopyRight hironori KANEMITSU 2000/03/18
BINGO CARDを作成します。
*}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ComCtrls, ToolWin, StdCtrls, FileCtrl;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

procedure gFIG_Init(aSize : integer);
procedure gFIG_Rand;
function  make_STR (N : integer)                            : string;
function  make_dSTR(aRow : integer)                         : string;
procedure make_gSTR1(nFig, cardNUM : integer);
procedure make_gSTR2(nFig, cardNUM : integer);
function  mCount (const aBP, aSTR : string)                 : integer;
function  nthCopy(const aBP, aSTR : string ; nth : integer) : string;
function  no_SAME1(const aSTR, bSTR : string)               : boolean;
function  no_SAME2(const aSTR, bSTR : string)               : boolean;
procedure out_BINGO(aRow : integer);

var
    Form1   : TForm1;
    gSTR    : TStrings;
    gFIG    : array of string;
    const dBP  = '|';

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
{* 初期化 *}
begin
    gSTR := TStringList.Create;
    Form1.Width := 206;
    Edit2.Text := IntToStr(5);
    Edit3.Text := IntToStr(24);
    Edit4.Text := IntToStr(10);
    StatusBar1.Panels[0].Text := '';
    StatusBar1.Panels[1].Text := 'CopyRight hironori';
end;

procedure TForm1.FormDestroy(Sender: TObject);
{* 終了処理 *}
begin
    gSTR.Free;
    gFIG := nil;
end;

procedure gFIG_Init(aSize : integer);
{* gFIGを初期化する *}
var
    i   : integer;
begin
    SetLength(gFIG, aSize + 1);
    for i:=1 to aSize do begin
        gFIG[i] := IntToStr(i);
    end;
end;

procedure gFIG_Rand;
{* gFIGの順列を作成する *}
var
    i,j     : integer;
    mValue  : integer;
    d       : string;
begin
    mValue := High(gFIG);
    {* exchange between i_th and j_th data *}
    for i:= mValue downto 1 do begin
        j := Random(mValue) + 1;
        d := gFIG[j];
        gFIG[j] := gFIG[i];
        gFIG[i] := d;
    end;
end;

function make_STR(N : integer) : string;
{* gFIGから文字数がN+1の文字列を作成する *}
{* FREEを真中に挿入するのでN+1となる     *}
var
    i       : integer;
begin
    Result := dBP;
    for i:=1 to (N div 2) do begin
        Result := Result + gFIG[i] + dBP;
    end;
    {* FREEを真中に挿入する *}
    Result := Result + 'FREE' + dBP;
    for i:=(N div 2)+1 to N do begin
        Result := Result + gFIG[i] + dBP;
    end;
end;

function mCount(const aBP, aSTR : string) : integer;
{* 文字列aSTRの中に区切り文字列aBPが何個含まれているか計算する *}
var
    i    : integer;
    mCnt : integer;
begin
    Result := 0;
    mCnt   := Length(aSTR);
    for i:=1 to mCnt do begin
        if aSTR[i] = aBP then
            Inc(Result);
    end;
end;

function nthCopy(const aBP, aSTR : string ; nth : integer) : string;
{* 区切り文字列aBPで囲まれたnth番目の文字列を返す *}
var
    c, mCnt, i  : integer;
    sp, ep      : integer;
begin
    mCnt := Length(aSTR);
    {* spを求める *}
    c := 0;
    i := 1;
    while (c < nth) and (i <= mCnt) do begin
        if aSTR[i] = aBP then
            Inc(c);
        Inc(i);
    end;
    sp := i ;
    {* ep を求める*}
    c := 0;
    i := 1;
    while (c < (nth + 1)) and (i <= mCnt) do begin
        if aSTR[i] = aBP then
            Inc(c);
        Inc(i);
    end;
    ep := i - 2;
    {* 結果はCopyを使用して返す *}
    Result := Copy(aSTR, sp , ep - sp + 1);
end;

function no_SAME1(const aSTR, bSTR : string) : boolean;
{* 厳密な比較 *}
{* FREE以外の全てが異なる *}
var
    aFIG, bFIG : array of string;
    BPc        : integer;
    i          : integer;
begin
    BPc := mCount('|', aSTR);
    {* dynamic arrayの大きさを決定 *}
    SetLength(aFIG, BPc);
    SetLength(bFIG, BPc);

    Result := False;
    for i:= 1 to BPc -1 do begin
        {* aFIG bFIGにそれぞれaSTR bSTRから文字列をコピー *}
        aFIG[i] := nthCopy('|', aSTR, i);
        bFIG[i] := nthCopy('|', bSTR, i);
        {* aFIGとbFIGが共にFREEの場合はTrue *}
        if (aFIG[i] = 'FREE') and (bFIG[i] = 'FREE') then
            Result := True
        {* それ以外の場合は数字として比較 *}
        else if StrToInt(aFIG[i]) = StrToInt(bFIG[i]) then
            begin
                Result := False;
                Break;
            end
        else
            Result := True;
    end;
    {* dynamic arrayを解放 *}
    aFIG := nil;
    bFIG := nil;
end;

function no_SAME2(const aSTR, bSTR : string) : boolean;
{* 緩い比較 *}
{* 少なくとも一つが異なる *}
begin
    if aSTR = bSTR then
        Result := False
    else
        Result := True;
end;

procedure make_gSTR1(nFig, cardNUM : integer);
{* noSAME1を使用してgSTRを作成する *}
var
    noFLAG  : boolean;
    wrkSTR  : string;
    i       : integer;
begin
    while gSTR.Count < CardNUM do begin
        {* 乱数を初期化 *}
        Randomize;
        gFIG_Rand;
        wrkSTR := make_STR(nFig);
        noFLAG := True;
        for i:=0 to gSTR.Count-1 do begin
            {* no_SAME1で比較 *}
            if no_SAME1(gSTR.Strings[i], wrkSTR) = False then
                begin
                    noFLAG := False;
                    Break;
                end;
        end;
        if noFLAG then
            gSTR.Append(wrkSTR);
    end;
end;

procedure make_gSTR2(nFig, cardNUM : integer);
{* noSAME2を使用してgSTRを作成する *}
var
    noFLAG  : boolean;
    wrkSTR  : string;
    i       : integer;
begin
    while gSTR.Count < CardNUM do begin
        Randomize;
        gFIG_Rand;
        wrkSTR := make_STR(nFig);
        noFLAG := True;
        for i:=0 to gSTR.Count-1 do begin
            if no_SAME2(gSTR.Strings[i], wrkSTR) = False then
                begin
                    noFLAG := False;
                    Break;
                end;
        end;
        if noFLAG = True then
            gSTR.Append(wrkSTR);
    end;
end;

function make_dSTR(aRow : integer) : string;
var
    i : integer;
begin
    Result := '+';
    for i:=1 to aRow do begin
        Result := Result + '----+';
    end;
end;


procedure out_BINGO(aRow : integer);
{* File出力処理 *}
var
    currDIR : string;
    i, j    : integer;
    aTXT    : TextFile;
    bTXT    : TextFile;
    BPc     : integer;
    aFIG    : array of string;
    wrkSTR  : string;
    dSTR    : string;
begin
    dSTR := make_dSTR(aRow);
    currDIR := GetCurrentDir;
    {* current Dir下にbingo_cardというDirを作成する *}
    if not DirectoryExists(currDIR+'\bingo_card') then
       CreateDir(currDIR+'\bingo_card');
    {* all用のTEXTFILEを開く *}
    AssignFile(aTXT, currDIR+'\bingo_card\bingo.txt');
    ReWrite(aTXT);
    for i:=0 to gSTR.Count-1 do begin
        {* each用のTEXTFILEを開く *}
        AssignFile(bTXT, currDIR+'\bingo_card\bingo'+IntToStr(i+1)+'.txt');
        ReWrite(bTXT);
        {* headerを書く *}
        WriteLn(aTXT, '['+IntToStr(i+1)+'] BINGO CARD');
        WriteLn(aTXT, dSTR);
        WriteLn(bTXT, '['+IntToStr(i+1)+'] BINGO CARD');
        WriteLn(bTXT, dSTR);

        BPc := mCount(dBP, gSTR.Strings[i]);
        SetLength(aFIG, BPc);
        wrkSTR := dBP;

        {* wrkSTRを出力用に整形 *}
        for j:=1 to BPc-1 do begin
            aFIG[j] := nthCopy(dBP, gSTR.Strings[i], j);
        if (j mod aRow) = 0 then
            begin
                if aFIG[j] = 'FREE' then
                    wrkSTR := wrkSTR + aFIG[j] + dBP
                else if StrToInt(aFIG[j]) >= 10 then
                    wrkSTR := wrkSTR + ' '  + aFIG[j] + ' ' + dBP
                else
                    wrkSTR := wrkSTR + '  ' + aFIG[j] + ' ' + dBP;
                {* wrkSTRの内容を書きこむ *}
                WriteLn(aTXT, wrkSTR);
                WriteLn(aTXT, dSTR);
                WriteLn(bTXT, wrkSTR);
                WriteLn(bTXT, dSTR);

                wrkSTR := dBP;
            end
        else
            begin
                if aFIG[j] = 'FREE' then
                    wrkSTR := wrkSTR + aFIG[j] + dBP
                else if StrToInt(aFIG[j]) >= 10 then
                    wrkSTR := wrkSTR + ' '  + aFIG[j] + ' ' + dBP
                else
                    wrkSTR := wrkSTR + '  ' + aFIG[j] + ' ' + dBP;
            end;
        end;
        CloseFile(bTXT);
    end;
    CloseFile(aTXT);
    aFIG := nil;
end;


procedure TForm1.Button1Click(Sender: TObject);
{* 作成 *}
var
    toN     : integer;
    RR      : integer;
    CardNum : integer;
begin
    {* ユーザーの入力を受け付ける *}
    RR  := StrToInt(Edit2.Text);
    toN := StrToInt(Edit3.Text);
    CardNum := StrToInt(Edit4.Text);

    StatusBar1.Panels[0].Text := '';

    gFIG_Init(toN);
    gSTR.Clear;
    {* RadioButtonで比較処理を分岐 *}
    if RadioButton1.Checked then
        make_gSTR1(RR*RR-1, CardNum)
    else
        make_gSTR2(RR*RR-1, CardNum);
    {* FILEに出力 *}
    out_BINGO(RR);
    {* 処理終了の表示 *}
    StatusBar1.Panels[0].Text := 'finished';
end;

procedure TForm1.Button2Click(Sender: TObject);
{* Formの表示変更 *}
begin
    if Form1.Width = 338 then begin
        Form1.Width := 206;
        Button2.Caption := '<<';
        end
    else begin
        Form1.Width := 338;
        Button2.Caption := '>>';
    end;
end;

procedure TForm1.Button3Click(Sender: TObject);
{* 破棄 *}
var
    currDIR : string;
    i       : integer;
    delFLAG : boolean;
begin
    currDIR := GetCurrentDir;
    {* Formの初期化 *}
    StatusBar1.Panels[0].Text := '';
    Form1.Width := 206;
    Edit2.Text := IntToStr(5);
    Edit3.Text := IntToStr(24);
    Edit4.Text := IntToStr(10);
    {* FILEの削除 *}
    {* wild cardは使用できない *}
    delFLAG := DeleteFile(currDIR+'\bingo_card\bingo.txt');
    for i:=0 to gSTR.Count-1 do begin
        delFLAG := DeleteFile(currDIR
                            +'\bingo_card\bingo'+IntToStr(i+1)+'.txt');
    end;
    {* FILEの削除処理の成否を表示 *}
    if delFLAG then
        StatusBar1.Panels[0].Text := 'deleted'
    else
        StatusBar1.Panels[0].Text := 'failed ';
end;

end.