unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, Spin, ExtCtrls, FileCtrl, ActnList, Menus; type TForm1 = class(TForm) SG1: TStringGrid; Button1: TButton; SpinEdit1: TSpinEdit; Button2: TButton; Panel1: TPanel; Button3: TButton; Button4: TButton; Memo1: TMemo; FileListBox1: TFileListBox; Edit1: TEdit; Button5: TButton; Button6: TButton; Button9: TButton; Button7: TButton; Button8: TButton; Button10: TButton; ActionList1: TActionList; Action1: TAction; Action2: TAction; Action3: TAction; Action4: TAction; Action5: TAction; PopupMenu1: TPopupMenu; N11: TMenuItem; N21: TMenuItem; N31: TMenuItem; N41: TMenuItem; N51: TMenuItem; N61: TMenuItem; N71: TMenuItem; N81: TMenuItem; N91: TMenuItem; Action6: TAction; N12: TMenuItem; procedure Button1Click(Sender: TObject); procedure SG1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button9Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure Button10Click(Sender: TObject); procedure Action1Execute(Sender: TObject); procedure Action2Execute(Sender: TObject); procedure Action3Execute(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Action4Execute(Sender: TObject); procedure Action5Execute(Sender: TObject); procedure N11Click(Sender: TObject); procedure N21Click(Sender: TObject); procedure N31Click(Sender: TObject); procedure N41Click(Sender: TObject); procedure N51Click(Sender: TObject); procedure N61Click(Sender: TObject); procedure N71Click(Sender: TObject); procedure N81Click(Sender: TObject); procedure N91Click(Sender: TObject); procedure Button7Click(Sender: TObject); procedure N12Click(Sender: TObject); private { Private 宣言 } procedure Pop(n:integer); public { Public 宣言 } end; var Form1: TForm1; implementation uses Unit5; {$R *.DFM} const kaku='.999'; function bunri(dat,c,f:string):string; var p,l:integer; begin l:=length(dat); p:=pos(c,dat); if f='-' then bunri:=copy(dat,1,p-1); if f='+' then bunri:=copy(dat,p+1,l-p); end; function irekae(S,old,new:string):string; var p,l:integer; begin p:=pos(old,s); if p>0 then begin l:=length(old); Delete(s,p,l); Insert(new,S,p); end; irekae:=s; end; function Zen_irekae(moto,old,new:string):string; begin if pos(old,moto)>0 then repeat moto:=irekae(moto,old,new); until pos(old,moto)<=0; Zen_irekae:=moto; end; function matome_shori(dam:string):string; begin dam:=Zen_irekae(dam,' ',' '); dam:=Zen_irekae(dam,' ',' '); dam:=Zen_irekae(dam,' ','_'); dam:=Zen_irekae(dam,'-','_'); dam:=Zen_irekae(dam,'__','_'); matome_shori:=dam; end; function three_by(a:integer):integer; begin three_by:=a-(a-1) mod 3; end; function Qa(i:integer):integer; begin Qa:=((i-1) div 3)*3 +1 end; {=========================================================} var xxx,yyy:integer; procedure TForm1.Button1Click(Sender: TObject); var i,j:integer; begin for i:=1 to 9 do for j:=1 to 9 do SG1.Cells[i,j]:='123456789'; end; procedure TForm1.SG1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (x>40) and (y>40) then begin xxx:=x div 41; yyy:=y div 41; panel1.Caption:=IntToStr(xxx)+' '+IntToStr(yyy); if length(SG1.Cells[xxx,yyy])=1 then begin SpinEdit1.Value:=StrToInt(SG1.Cells[xxx,yyy]); Button2Click(Self); end; end; end; procedure TForm1.Button2Click(Sender: TObject); var ix,iy,x,y,d:integer; begin d:=SpinEdit1.Value; if pos(IntToStr(SpinEdit1.Value),SG1.Cells[xxx,yyy])>0 then begin { procedure back } memo1.Lines.Clear; for ix:=1 to 9 do for iy:=1 to 9 do memo1.Lines.Add(SG1.Cells[ix,iy]); Button5.Enabled:=true; { henkou oyobi check } SG1.Cells[xxx,yyy]:=IntToStr(SpinEdit1.Value); for ix:=1 to 9 do if ix<>xxx then SG1.Cells[ix,yyy]:=irekae(SG1.Cells[ix,yyy],IntToStr(Spinedit1.value),''); for iy:=1 to 9 do if iy<>yyy then SG1.Cells[xxx,iy]:=irekae(SG1.Cells[xxx,iy],IntToStr(Spinedit1.value),''); x:=three_by(xxx); y:=three_by(yyy); for ix:=x to x+2 do for iy:=y to y+2 do if length(SG1.Cells[ix,iy])>1 then SG1.Cells[ix,iy]:=irekae(SG1.Cells[ix,iy],IntToStr(Spinedit1.value),''); end else ShowMessage('その数字は入力できません。'); SpinEdit1.Value:=d; end; procedure TForm1.Button3Click(Sender: TObject); var x,y:integer; fn:string; begin Memo1.Lines.Clear; fn:=LowerCase(Edit1.Text); if fn=FileListBox1.Mask then ShowMessage('Input file name') else begin if pos(kaku,fn)=0 then fn:=fn+kaku; for x:=1 to 9 do for y:=1 to 9 do memo1.Lines.Add(SG1.Cells[x,y]); Memo1.Lines.SaveToFile(fn); FileListBox1.Update; Edit1.Text:=fn; Button5.Enabled:=false; end; end; procedure TForm1.Button4Click(Sender: TObject); var x,y:integer; fn:string; begin fn:=LowerCase(Edit1.Text); if fn=FileListBox1.Mask then ShowMessage('Input file name') else begin Button5.Enabled:=false; Memo1.Lines.LoadFromFile(fn); for x:=1 to 9 do for y:=1 to 9 do SG1.Cells[x,y]:=memo1.Lines[(x-1)*9+y-1]; end; end; procedure TForm1.FormCreate(Sender: TObject); const DllFile=''; DllFile2=''; Max=50; var a,b:integer; begin if FileExists(DllFile) then Memo1.Lines.LoadFromFile(DllFile) else begin Memo1.Lines.Clear; memo1.Lines.Add(IntToStr(Max)); end; a:=StrToInt(Memo1.Lines[0]); Memo1.Lines.Clear; memo1.Lines.Add(IntToStr(a-1)); Memo1.Lines.SaveToFile(DllFile); if a<6 then Caption:=Caption+' (あと'+IntToStr(a)+'回利用できます)'; if (a>Max) or (a<1) then begin ShowMessage('使用回数制限により使用できません。'); Button7.Enabled:=false; Button6.Enabled:=false; Button8.Enabled:=false; SG1.Visible:=false; end; Button5.Enabled:=false; Button1Click(self); xxx:=1; yyy:=1; panel1.Caption:=IntToStr(xxx)+' '+IntToStr(yyy); FileListBox1.Mask:='*'+kaku; end; procedure TForm1.Button5Click(Sender: TObject); var x,y:integer; begin for x:=1 to 9 do for y:=1 to 9 do SG1.Cells[x,y]:=memo1.Lines[(x-1)*9+y-1]; Button5.Enabled:=false; end; procedure TForm1.Button9Click(Sender: TObject); begin close; end; procedure TForm1.Button8Click(Sender: TObject); begin Action1Execute(Self); end; procedure TForm1.Button10Click(Sender: TObject); var x,y,ix,iy:integer; begin for x:=1 to 9 do SG1.Cells[x,yyy]:='123456789'; for y:=1 to 9 do SG1.Cells[xxx,y]:='123456789'; ix:=QA(xxx); iy:=QA(yyy); for x:=ix to ix+2 do for y:=iy to iy+2 do SG1.Cells[x,y]:='123456789'; end; procedure TForm1.Action1Execute(Sender: TObject); var x,y,xx,yy,c:integer; begin xx:=xxx; yy:=yyy; c:=0; for x:=1 to 9 do for y:=1 to 9 do if length(SG1.Cells[x,y])=1 then begin xxx:=x; yyy:=y; c:=c+1; SpinEdit1.Value:=StrToInt(SG1.Cells[x,y]); Button2Click(Self); end; xxx:=xx; yyy:=yy; Button5.Enabled:=false; if c=81 then begin Form5:=Tform5.Create(Application); Form5.Caption:=IntToStr(random(4)); Form5.ShowModal; Form5.Release; end; end; procedure TForm1.Action2Execute(Sender: TObject); var x,y,n,f :integer; su,suu:string; begin suu:='123456789'; for y:=1 to 9 do begin for x:=1 to 9 do if length(SG1.Cells[x,y])=1 then suu:=irekae(suu,SG1.Cells[x,y],''); for n:=1 to length(suu) do begin f:=0; su:=copy(suu,n,1); for x:=1 to 9 do if pos(su,SG1.Cells[x,y])>0 then f:=f+1; if f=1 then for x:=1 to 9 do if pos(su,SG1.Cells[x,y])>0 then SG1.Cells[x,y]:=su; end; end; suu:='123456789'; for x:=1 to 9 do begin for y:=1 to 9 do if length(SG1.Cells[x,y])=1 then suu:=irekae(suu,SG1.Cells[x,y],''); for n:=1 to length(suu) do begin f:=0; su:=copy(suu,n,1); for y:=1 to 9 do if pos(su,SG1.Cells[x,y])>0 then f:=f+1; if f=1 then for y:=1 to 9 do if pos(su,SG1.Cells[x,y])>0 then SG1.Cells[x,y]:=su; end; end; end; procedure TForm1.Action3Execute(Sender: TObject); var x,y,f :integer; su:string; begin su:=IntToStr(SpinEdit1.Value); for y:=1 to 9 do begin f:=0; for x:=1 to 9 do if SG1.Cells[x,y]=su then f:=1; if f=0 then SG1.Cells[0,y]:='○' else SG1.Cells[0,y]:='×'; end; for x:=1 to 9 do begin f:=0; for y:=1 to 9 do if SG1.Cells[x,y]=su then f:=1; if f=0 then SG1.Cells[x,0]:='○' else SG1.Cells[x,0]:='×'; end; end; procedure TForm1.Button6Click(Sender: TObject); begin Action5Execute(Self); end; procedure TForm1.Action4Execute(Sender: TObject); var i,x,y,ix,iy,f:integer; su:string; begin { 3x3 eria ni tandokuno monoga naika chousa } ix:=Qa(xxx); iy:=Qa(yyy); for i:=1 to 9 do begin su:=IntToStr(i); f:=0; for x:=ix to ix+2 do for y:=iy to iy+2 do if pos(su,SG1.Cells[x,y])>0 then f:=f+1; if f=1 then for x:=ix to ix+2 do for y:=iy to iy+2 do if pos(su,SG1.Cells[x,y])>0 then begin xxx:=x; yyy:=y; SpinEdit1.Value:=i; Button2Click(Self); end; end; end; procedure TForm1.Action5Execute(Sender: TObject); var x,y,dx,dy:integer; begin dx:=xxx; dy:=yyy; for x:=0 to 2 do for y:= 0 to 2 do begin xxx:=x*3+1; yyy:=y*3+1; Action4Execute(Self); end; xxx:=dx; yyy:=dy; end; procedure TForm1.Pop(n:integer); begin if (0