www.pudn.com > 推箱子源码.rar > Cboxword.pas
unit Cboxword;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, Menus, ComCtrls, ExtCtrls, ImgList, StdCtrls;
const
utimes=88;
type
TForm1 = class(TForm)
DrawGrid1: TDrawGrid;
MainMenu1: TMainMenu;
G1: TMenuItem;
Undo1: TMenuItem;
N1: TMenuItem;
Retry1: TMenuItem;
N2: TMenuItem;
BeepOff1: TMenuItem;
N3: TMenuItem;
GotoToWorld1: TMenuItem;
StatusBar1: TStatusBar;
ImageList1: TImageList;
Timer1: TTimer;
H1: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
A1: TMenuItem;
N4: TMenuItem;
exit1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure DrawGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DrawGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Undo1Click(Sender: TObject);
procedure BeepOff1Click(Sender: TObject);
procedure Retry1Click(Sender: TObject);
procedure GotoToWorld1Click(Sender: TObject);
procedure exit1Click(Sender: TObject);
procedure DrawGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
protime:integer;
hightscore:integer;
swinpath:string;
imagetemp:tbitmap;
manindex:integer;
undotimes:integer;
undoclick:integer;
tssystem:tstrings;
movedstep:integer;
username:string;
oldstateXY:array[0..13,0..15] of integer;
undostateXY:array[0..13,0..15,0..utimes] of integer;
undooldstateXY:array[0..13,0..15,0..utimes] of integer;
undomanindex:array[0..utimes] of integer;
undorow,undocol:array[0..utimes] of integer;
procedure setstateXY(oldx,oldy:integer);
procedure setboxstate(x,y,x1,y1,stay:integer;var canselt:boolean);
function iswin:boolean;
procedure startnewone;
function getfield(s:string;idx:integer):string;
public
{ Public declarations }
curstate:integer;
stateXY:array[0..13,0..15] of integer;
procedure initnewstate(state:integer);
procedure readblockfromfile(fname,sname:string;ts:tstrings);
end;
var
Form1: TForm1;
implementation
uses Chelp,cabout, Cdesign;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
state:integer;
s:string;
buf:array[0..60] of char;
begin
protime:=0;
username:='';
tssystem:=tstringlist.create;
getwindowsdirectory(buf,sizeof(buf));
swinpath:=buf+'\';
if not fileexists(swinpath+'gxglcy.ini') then begin
tssystem.Append('curstate=1');
tssystem.SaveToFile(swinpath+'gxglcy.ini');
end;
form1.ClientHeight:=442;
form1.ClientWidth:=482;
undotimes:=0;
undoclick:=0;
tssystem.loadfromfile(swinpath+'gxglcy.ini');
drawgrid1.Canvas.Pen.color:=clblack;
drawgrid1.Canvas.brush.color:=clblack;
imagetemp:=tbitmap.Create;
state:=1;
s:=trim(tssystem.values['curstate']);
if s<>'' then begin
try
state:=strtoint(s);
except
state:=1;
end;
end;
curstate:=state;
beepoff1.Checked:=tssystem.Values['nosound']='1';
initnewstate(state);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
timer1.Enabled:=false;
form1.OnPaint:=nil;
imagetemp.free;
tssystem.free;
end;
procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
var
currow,curcol:integer;
isin:boolean;
begin
if not form2.visible then begin
with drawgrid1 do begin
if acol<>col then begin
if acol>col then begin
manindex:=10;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
curcol:=col;
isin:=false;
while (((stateXY[row,curcol+1]=1)or(stateXY[row,curcol+1]=2))and(curcol<=acol-1)) do begin
curcol:=curcol+1;
isin:=true;
end;
// if curcol>acol then curcol:=acol;
if isin then curcol:=curcol-1;
end
else begin
manindex:=8;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
curcol:=col;
isin:=false;
while (((stateXY[row,curcol-1]=1)or(stateXY[row,curcol-1]=2))and(curcol>=acol+1)) do begin
curcol:=curcol-1;
isin:=true;
end;
// if curcolrow then begin
if arow>row then begin
manindex:=6;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
currow:=row;
isin:=false;
while (((stateXY[currow+1,curcol]=1)or(stateXY[currow+1,curcol]=2))and(currow<=arow-1)) do begin
currow:=currow+1;
isin:=true;
end;
// if currow>arow then currow:=arow;
if isin then currow:=currow-1;
end
else begin
manindex:=12;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
currow:=row;
isin:=false;
while (((stateXY[currow-1,curcol]=1)or(stateXY[currow-1,curcol]=2))and(currow>=arow+1)) do begin
currow:=currow-1;
isin:=true;
end;
// if currowrow then begin
if arow>row then begin
manindex:=6;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
currow:=row;
isin:=false;
while (((stateXY[currow+1,curcol]=1)or(stateXY[currow+1,curcol]=2))and(currow<=arow-1)) do begin
currow:=currow+1;
isin:=true;
end;
// if currow>arow then currow:=arow;
if isin then currow:=currow-1;
end
else begin
manindex:=12;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
currow:=row;
isin:=false;
while (((stateXY[currow-1,curcol]=1)or(stateXY[currow-1,curcol]=2))and(currow>=arow+1)) do begin
currow:=currow-1;
isin:=true;
end;
// if currowcol then begin
if acol>col then begin
manindex:=10;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
curcol:=col;
isin:=false;
while (((stateXY[currow,curcol+1]=1)or(stateXY[currow,curcol+1]=2))and(curcol<=acol-1)) do begin
curcol:=curcol+1;
isin:=true;
end;
// if curcol>acol then curcol:=acol;
if isin then curcol:=curcol-1;
end
else begin
manindex:=8;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
curcol:=col;
isin:=false;
while (((stateXY[currow,curcol-1]=1)or(stateXY[currow,curcol-1]=2))and(curcol>=acol+1)) do begin
curcol:=curcol-1;
isin:=true;
end;
// if curcolcurrow then begin
manindex:=6;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
end;
if arowcurcol then begin
manindex:=10;
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex;
end;
if acolacol then begin
if curcol>acol then begin
setboxstate(arow,acol-1,arow,acol,1,canselect);
end
else begin
setboxstate(arow,acol+1,arow,acol,1,canselect);
end;
end;
end
else begin
if currow<>arow then begin
if currow>arow then begin
setboxstate(arow-1,acol,arow,acol,1,canselect);
end
else begin
setboxstate(arow+1,acol,arow,acol,1,canselect);
end;
end;
end;
end;
4:begin
if currow=arow then begin
if curcol<>acol then begin
if curcol>acol then begin
setboxstate(arow,acol-1,arow,acol,2,canselect);
end
else begin
setboxstate(arow,acol+1,arow,acol,2,canselect);
end;
end;
end
else begin
if currow<>arow then begin
if currow>arow then begin
setboxstate(arow-1,acol,arow,acol,2,canselect);
end
else begin
setboxstate(arow+1,acol,arow,acol,2,canselect);
end;
end;
end;
end;
end;
end
else begin
canselect:=false;
if not beepoff1.Checked then begin
beep;
end;
end;
end
else begin
stateXY[arow,acol]:=form2.wutype;
form1.Repaint;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
protime:=protime+1;
if protime>=6 then begin
if not form2.visible then begin
stateXY[drawgrid1.Row,drawgrid1.Col]:=stateXY[drawgrid1.Row,drawgrid1.Col]+1;
if stateXY[drawgrid1.Row,drawgrid1.Col]>manindex then begin
stateXY[drawgrid1.Row,drawgrid1.Col]:=manindex-1;
end;
end;
protime:=0;
end;
form1.Repaint;
end;
procedure TForm1.DrawGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
i,j:integer;
begin
if not form2.visible then begin
case key of
71:begin
if ssctrl in shift then begin
undo1.Enabled:=false;
retry1.enabled:=false;
gototoworld1.enabled:=false;
for i:=0 to 13 do begin
for j:=0 to 15 do begin
stateXY[i,j]:=-1;
end;
end;
drawgrid1.Canvas.Rectangle(0,0,drawgrid1.width,drawgrid1.Height);
form2.left:=10;
form2.top:=30;
form1.Repaint;
form2.show;
end;
end;
end;
end;
end;
procedure TForm1.setstateXY(oldx,oldy:integer);
begin
if oldstateXY[oldx,oldy]=5 then begin
stateXY[oldx,oldy]:=1;
oldstateXY[oldx,oldy]:=1;
end
else begin
if oldstateXY[oldx,oldy]=6 then begin
stateXY[oldx,oldy]:=2;
oldstateXY[oldx,oldy]:=2;
end
else begin
stateXY[oldx,oldy]:=oldstateXY[oldx,oldy];
end;
end;
end;
procedure TForm1.setboxstate(x,y,x1,y1,stay:integer;var canselt:boolean);
var
i,j:integer;
begin
with form1 do begin
case stateXY[x,y] of
-1,0,3,4:begin
canselt:=false;
if not beepoff1.Checked then begin
beep;
end;
end;
1:begin
for i:=0 to 13 do begin
for j:=0 to 15 do begin
undostateXY[i,j,undotimes]:=stateXY[i,j];
undooldstateXY[i,j,undotimes]:=oldstateXY[i,j];
end;
end;
undomanindex[undotimes]:=manindex;
undorow[undotimes]:=drawgrid1.row;
undocol[undotimes]:=drawgrid1.col;
undoclick:=undoclick+1;
undo1.Enabled:=undoclick>0;
undotimes:=undotimes+1;
if undotimes>utimes then begin
undotimes:=0;
end;
stateXY[x,y]:=3;
oldstateXY[x,y]:=3;
stateXY[x1,y1]:=manindex-1;
oldstateXY[x1,y1]:=stay;
setstateXY(drawgrid1.row,drawgrid1.col);
movedstep:=movedstep+1;
statusbar1.Panels[0].text:='已移动步数：'+inttostr(movedstep);
form1.Repaint;
end;
2:begin
for i:=0 to 13 do begin
for j:=0 to 15 do begin
undostateXY[i,j,undotimes]:=stateXY[i,j];
undooldstateXY[i,j,undotimes]:=oldstateXY[i,j];
end;
end;
undomanindex[undotimes]:=manindex;
undorow[undotimes]:=drawgrid1.row;
undocol[undotimes]:=drawgrid1.col;
undoclick:=undoclick+1;
undo1.Enabled:=undoclick>0;
undotimes:=undotimes+1;
if undotimes>utimes then begin
undotimes:=0;
end;
stateXY[x,y]:=4;
oldstateXY[x,y]:=4;
stateXY[x1,y1]:=manindex-1;
oldstateXY[x1,y1]:=stay;
setstateXY(drawgrid1.row,drawgrid1.col);
movedstep:=movedstep+1;
statusbar1.Panels[0].text:='已移动步数：'+inttostr(movedstep);
form1.Repaint;
end;
end;
end;
end;
procedure Tform1.initnewstate(state:integer);
var
i,j:integer;
imgindex:integer;
tslevel:tstrings;
s,ss:string;
begin
movedstep:=0;
undotimes:=0;
undoclick:=0;
undo1.Enabled:=false;
timer1.enabled:=false;
drawgrid1.OnSelectCell:=nil;
drawgrid1.Canvas.Rectangle(0,0,drawgrid1.width,drawgrid1.Height);
drawgrid1.Refresh;
manindex:=6;
tslevel:=tstringlist.Create;
while tslevel.count=0 do begin
readblockfromfile('boxworld.ini',inttostr(state),tslevel);
state:=state-1;
end;
curstate:=state+1;
for i:=0 to 13 do begin
for j:=1 to 16 do begin
imgindex:=strtoint(tslevel.Strings[i][j])-1;
stateXY[i,j-1]:=imgindex;
oldstateXY[i,j-1]:=imgindex;
if imgindex>=5 then begin
drawgrid1.col:=j-1;
drawgrid1.row:=i;
end;
end;
end;
tslevel.free;
form1.caption:='推箱子--第'+inttostr(curstate)+'关';
statusbar1.Panels[0].text:='已移动步数：0';
s:='';
s:=tssystem.Values[inttostr(curstate)];
if s='' then begin
ss:='无';
hightscore:=maxint;
end
else begin
ss:=getfield(s,0)+'用了'+getfield(s,1)+'步!';
hightscore:=strtoint(getfield(s,1));
end;
statusbar1.Panels[1].text:='本局最高记录：'+ss;
tssystem.Values['curstate']:=inttostr(curstate);
tssystem.SaveToFile(swinpath+'gxglcy.ini');
drawgrid1.OnSelectCell:=DrawGrid1SelectCell;
timer1.enabled:=true;
end;
procedure Tform1.readblockfromfile(fname,sname:string;ts:tstrings);
var
i:integer;
tsfile:tstrings;
fromidx:integer;
s:string;
begin
ts.clear;
if fileexists(fname) then begin
tsfile:=tstringlist.create;
tsfile.LoadFromFile(fname);
fromidx:=tsfile.IndexOf('['+sname+']');
if fromidx<0 then begin
fromidx:=tsfile.count;
end;
for i:=fromidx+1 to tsfile.count-1 do begin
s:=trim(tsfile.strings[i]);
if s<>'' then begin
if s[1]<>'[' then begin
ts.Append(s);
end
else begin
break;
end;
end;
end;
tsfile.free;
end
else begin
ts.clear;
end;
end;
function Tform1.iswin:boolean;
var
i,j:integer;
begin
result:=true;
for i:=0 to 13 do begin
for j:=0 to 15 do begin
if stateXY[i,j]=3 then begin
result:=false;
break;
end;
end;
end;
end;
procedure TForm1.DrawGrid1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if not form2.visible then begin
case key of
37,38,39,40:begin
startnewone;
end;
end;
end;
end;
//////////////////////////////////////////////////////////////////////////////////////////
procedure TForm1.Undo1Click(Sender: TObject);
var
i,j:integer;
begin
undoclick:=undoclick-1;
undo1.Enabled:=undoclick>0;
drawgrid1.OnSelectCell:=nil;
undotimes:=undotimes-1;
if undotimes<0 then begin
undotimes:=utimes;
end;
for i:=0 to 13 do begin
for j:=0 to 15 do begin
stateXY[i,j]:=undostateXY[i,j,undotimes];
oldstateXY[i,j]:=undooldstateXY[i,j,undotimes];
end;
end;
drawgrid1.row:=undorow[undotimes];
drawgrid1.col:=undocol[undotimes];
manindex:=undomanindex[undotimes];
movedstep:=movedstep-1;
statusbar1.Panels[0].text:='已移动步数：'+inttostr(movedstep);
drawgrid1.OnSelectCell:=DrawGrid1SelectCell;
form1.Repaint;
end;
procedure TForm1.BeepOff1Click(Sender: TObject);
begin
beepoff1.Checked:=not beepoff1.checked;
if beepoff1.Checked then tssystem.Values['nosound']:='1'
else tssystem.Values['nosound']:='0';
tssystem.SaveToFile(swinpath+'gxglcy.ini');
end;
procedure TForm1.Retry1Click(Sender: TObject);
begin
initnewstate(curstate);
end;
procedure TForm1.GotoToWorld1Click(Sender: TObject);
var
s:string;
begin
s:='';
s:=trim(inputbox('选择另一局','请输入局数:',inttostr(curstate)));
if (s<>'')and(s<>inttostr(curstate)) then begin
try
curstate:=strtoint(s);
initnewstate(curstate);
except
end;
end;
end;
procedure TForm1.exit1Click(Sender: TObject);
begin
timer1.Enabled:=false;
imagetemp.free;
tssystem.free;
application.Terminate;
end;
procedure Tform1.startnewone;
begin
if iswin then begin
if movedstep'' then begin
if result[1]='|' then begin
delete(result,1,1);
end;
end;
if result<>'' then begin
if result[length(result)]='|' then begin
delete(result,length(result),1);
end;
end;
end;
procedure TForm1.DrawGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not form2.visible then startnewone;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i,j:integer;
imgindex:integer;
begin
with drawgrid1,drawgrid1.canvas do begin
for i:=0 to 13 do begin
for j:=1 to 16 do begin
imgindex:=stateXY[i,j-1];
if imgindex>=0 then begin
imagelist1.GetBitmap(imgindex,imagetemp);
draw(CellRect(j-1,i).left,CellRect(j-1,i).top,imagetemp);
end
else begin
Rectangle(CellRect(j-1,i).left,CellRect(j-1,i).top,CellRect(j-1,i).right,CellRect(j-1,i).bottom);
end;
end;
end;
end;
end;
end.