unit main;

{*
    BINGO_Checker for Creative Farm
    version 0.1.0.0
    last update 2000/04/08
    CopyRight hironori KANEMITSU
*}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, Grids, ToolWin, Inifiles, Math;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    ToolBar1: TToolBar;
    DrawGrid1: TDrawGrid;
    Edit1: TEdit;
    SpeedButton4: TSpeedButton;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton4Click(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormPaint(Sender: TObject);
    procedure Edit1DblClick(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    procedure CellMark(aCol, aRow : integer ;
                        rColor, cColor : TColor ; aSTR : string);
    procedure CellDraw(aCol, aRow : integer);
    procedure MakeCircle(aX, aY, aR : integer;
                        aColor : TColor; aCanvas : TCanvas);
    procedure Oh_BINGO;
  end;

function nthCopy(const aBP, aSTR : string ; nth : integer) : string;
function mCount(const aBP, aSTR : string) : integer;
function HitCount : integer;
procedure myDelay(Sec, mSec : Word);

var
  Form1: TForm1;
  {* globals *}
  gCell     : array [0..8, 0..8] of string;
  gDrawFlag : boolean;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
{* 開始処理 *}
var
    IniFile : TIniFile;
    aTXT    : TextFile;
    currDIR : string;
    aRegFLG : boolean;
    aSTR    : string;
    wrkSTR  : array [0..8] of string;
    i, j, c : integer;
    aDate   : TDateTime;
begin
    StatusBar1.Panels[0].Width := Form1.Width div 2;
    StatusBar1.Panels[1].Width := Form1.Width div 2;
    Edit1.Clear;

    currDIR := GetCurrentDir;

    try
        IniFile  := TIniFile.Create(currDIR+'\Oh_Bingo.ini');
        aRegFLG  := IniFile.ReadBool('RegStatus','registered',False);
        if aRegFLG then
            begin
                for i:=0 to 8 do begin
                    aSTR := IniFile.ReadString('RowData',IntToStr(i),'0000');
                    for j:=0 to 8 do begin
                        gCell[j, i] := Copy(aSTR, 2+j*5, 4);
                    end;
                end;
                aDate := IniFile.ReadDate('DateStatus','LastUpDate',Now);
                StatusBar1.Panels[0].Text := 'Last Check Date '
                                            +DateToStr(aDate);
            end
        else
            begin
                MessageDlg('INIFILEにビンゴデータがありません。',
                            mtConfirmation, [mbOK], 0);
                if OpenDialog1.Execute then
                    try
                        AssignFile(aTXT, OpenDialog1.FileName);
                        ReSet(aTXT);
                        c:=0;
                        while not EOF(aTXT) do begin
                            Readln(aTXT,aSTR);
                            if Pos('|',aSTR)>0 then begin
                                wrkSTR[c] := aSTR;
                                Inc(c);
                            end;
                        end;

                        for i:=0 to 8 do begin
                            for j:=0 to 8 do begin
                                gCell[j,i] := Copy(wrkSTR[i],2+j*5,4);
                                if gCell[j,i]='FREE' then
                                    gCell[j,i] := ' ** ';
                            end;
                        end;
                    finally
                        CloseFile(aTXT);
                    end;
            end;
    finally
        gDrawFlag := False;
        IniFile.Free;
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
{* 終了処理 *}
var
    IniFile : TIniFile;
    currDIR : string;
    wrkSTR  : string;
    i, j    : integer;
begin
    currDIR := GetCurrentDIR;
    if MessageDlg('INIFILEに保存しますか？',
                mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        try
            IniFile := TIniFile.Create(currDIR+'\Oh_BINGO.ini');
            for i:=0 to 8 do begin
                wrkSTR := '';
                for j:=0 to 8 do begin
                    wrkSTR := wrkSTR + '|' + gCell[j,i];
                end;
                wrkSTR := wrkSTR + '|';
                IniFile.WriteString('RowData',IntToStr(i),wrkSTR);
            end;
            IniFile.WriteBool('RegStatus','registered',True);
            IniFile.WriteDate('DateStatus','LastUpDate',Date);
        finally
            IniFile.Free;
        end
    else if MessageDlg('INIFILEを初期化しますか？',
                     mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        try
            IniFile := TIniFile.Create(currDIR+'\Oh_BINGO.ini');
            IniFile.EraseSection('RowData');
            IniFile.EraseSection('DateStatus');
            IniFile.WriteBool('RegStatus','registered',False);
        finally
            IniFile.Free;
        end
    else
        begin
            MessageDlg('INIFILEを変更しません。',
                     mtInformation, [mbOK], 0);
            Exit;
        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;
    Result := Copy(aSTR, sp , ep - sp + 1);
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;

procedure TForm1.CellMark(aCol, aRow : integer ;
                        rColor, cColor : TColor ; aSTR : string);
{* DrawGridのCellを描画する *}
var
    aRect : TRect;
    aX    : integer;
    aY    : integer;
    aR    : integer;
begin
    {* get a RECT of (aCol,aRow) *}
    aRect := DrawGrid1.CellRect(aCol, aRow);
    with DrawGrid1.Canvas do begin
        {* draw rect *}
        Pen.Color   := rColor;
        Brush.Color := rColor;
        FillRect(aRect);
        {* draw circle *}
        Pen.Color   := cColor;
        Brush.Color := cColor;
        aX := aRect.Left + 16;
        aY := aRect.Top  + 16;
        aR := 14;
        Ellipse(aX - aR, aY - aR, aX + aR , aY + aR);
        {* draw string *}
        Pen.Color   := clBlack;
        Font.Height := 16;
        aX := aRect.Left + 8;
        aY := aRect.Top  + 8;
        if Length(aSTR)=1 then
            aSTR := ' '+ aSTR;
        TextOut(aX, aY, aSTR);
    end;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
{* Edit1の数字がBINGOカードに含まれているか調査する *}
var
    tmpSTR  : string;
    wrkSTR  : string;
    cntFIG  : integer;
    i,j,k   : integer;
    hitCNT  : integer;
begin
    tmpSTR := Edit1.Text;
    tmpSTR := ','+tmpSTR+',';
    cntFIG := mCount(',', tmpSTR)-1;

    StatusBar1.Panels[0].Text := 'checked ';
    StatusBar1.Panels[1].Text := 'hit     ';

    for k:=0 to cntFIG-1 do begin
        wrkSTR := nthCopy(',', tmpSTR, k+1);
        StatusBar1.Panels[0].Text := StatusBar1.Panels[0].Text
                                        + ' ' + wrkSTR;
        for i:=0 to 8 do begin
            for j:=0 to 8 do begin
                if Trim(wrkSTR)=Trim(gCell[i,j]) then begin
                    gCell[i,j] := ' ** ';
                    CellMark(i,j,clRed,clBlue,'');
                    StatusBar1.Panels[1].Text := StatusBar1.Panels[1].Text
                                                    + ' '+ wrkSTR;
                end
            end;
        end;
    end;
    {* HitCountの数に応じて表示を変更する *}
    hitCNT := HitCount;
    if hitCNT = 9 then {* BINGOの場合       *}
        Oh_Bingo
    else               {* BINGOではない場合 *}
        ShowMessage('最低あと '+ IntToStr(9-hitCNT)+' 必要です。');
end;

procedure TForm1.CellDraw(aCol, aRow : integer);
begin
{* gCellの値に基づいてセルを表示する *}
    if (Trim(gCell[aCol,aRow])='**') then
        CellMark(aCol,aRow,clRed,clBlack,'')
    else
        CellMark(aCol,aRow,clRed,clWhite,Trim(gCell[aCol,aRow]));
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
{* DrawGridの各Cellを描画する *}
begin
    if gDrawFlag then
        CellDraw(aCol, aRow);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
    gDrawFlag := True;
end;

procedure TForm1.Edit1DblClick(Sender: TObject);
{* Editをダブルクリックすると入力を消去する *}
begin
    Edit1.Clear;
end;

function HitCount : integer;
{* gCell中の[**]を数えて最大数を返す *}
var
    i,j     : integer;
    tCnt    : integer;
    mCnt    : integer;
begin
    mCnt := 0;
    for i:=0 to 8 do begin
        tCnt := 0;
        for j:=0 to 8 do begin
            if Trim(gCell[i,j]) ='**' then
                Inc(tCnt);
        end;
        if mCnt < tCnt then
            mCnt := tCnt;
    end;

    for j:=0 to 8 do begin
        tCnt := 0;
        for i:=0 to 8 do begin
            if Trim(gCell[i,j])='**' then
                Inc(tCnt);
        end;
        if mCnt < tCnt then
            mCnt := tCnt;
    end;

    tCnt := 0;
    for i:=0 to 8 do begin
        if Trim(gCell[i,i])='**' then
            Inc(tCnt);
    end;
    if mCnt < tCnt then
        mCnt := tCnt;

    tCnt := 0;
    for i:=0 to 8 do begin
        if Trim(gCell[i,8-i])='**' then
            Inc(tCnt);
    end;
    if mCnt < tCnt then
        mCnt := tCnt;

    Result := mCnt;
end;

procedure TForm1.Oh_BINGO;
{* BINGOの場合 *}
{* DrawGridを非表示としてForm1のCanvasに描画する *}
var
    aRect   : TRect;
    i       : integer;
    aX      : integer;
    aY      : integer;
    aSTR    : string;
    aClr    : TColor;
begin
    gDrawFlag := False;
    DrawGrid1.Visible := False;
    {* *}
    aRect := Rect(0, 0, Form1.Width, Form1.Height);

    aSTR := 'BINGO';
    {* 円の中心 *}
    aX  := Form1.Width  div 2;
    aY  := Form1.Height div 2;

    Randomize;
    for i:=1 to 5 do begin
        aClr := Random(255);
        with Form1.Canvas do begin
            Brush.Color := aClr;
            FillRect(aRect);
        end;
        MakeCircle(aX,aY,96,clWhite,Form1.Canvas);
        with Form1.Canvas do begin
            Pen.Color   := clBlack;
            Font.Height := 96;
            TextOut(aX-28,aY-48,aSTR[i]);
        end;
        myDelay(1,0);
        MakeCircle(aX,aY,96,aClr,Form1.Canvas);
    end;
    ShowMessage('おめでとうございます。');
    {* 画面を元に戻す *}
    DrawGrid1.Visible := True;
    gDrawFlag := True;
end;

procedure TForm1.FormDblClick(Sender: TObject);
{* DrawGridを表示して再描画する*}
begin
    DrawGrid1.Visible := True;
    gDrawFlag := True;
end;

procedure myDelay(Sec, mSec : Word);
var
    TimeOut : TDateTime;
begin
    TimeOut := Now + EncodeTime(0, Sec div 60, sec mod 60, mSec);
    while Now < TimeOut do
        Application.ProcessMessages;
end;

procedure TForm1.MakeCircle(aX, aY, aR : integer;
                            aColor : TColor; aCanvas : TCanvas);
{* 中心[aX,aY]で半径aRの円をaColorでaCanvasに描く *}
begin
    with aCanvas do begin
        Pen.Color   := aColor;
        Brush.Color := aColor;
        Ellipse(aX-aR, aY-aR, aX+aR, aY+aR);
    end;
end;

end.