四国军旗控件（源码） (2001年4月23日).txt

自己对DELPHI学习的一点体会

四国军旗控件（源码） (2001年4月23日) 

网友更新  分类:数据库   作者:宋爽  推荐:songshuang   阅读次数:385  
(http://www.codesky.net)  

--------------------------------------------------------------------------------
//////////////////////////////////////////////////////////
// 环境：DELPHI5.0 WIN98 
//本文只提供主代码，其他单元、图片由于所限，不能提供，有兴趣的可以所要。如需调试，则出现
//错误。
//作者：宋爽
//[e-mail]
//由于本人水平所限，代码没有优化，但保证在游戏规则上是正确的。

unit SiGuo;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,ImgList,
SGConst;

type

TSiGuo = class(TCustomControl)
private
FPieceBitmaps: TImageList;
FMove: Cardinal;
FPlaying:boolean;
FIsTurn:boolean;
FZhadDilei:boolean;
FBoardBitmap: TBitmap;
FOnBecaptured:TDefeatedEvent;
FPlayerColor:byte;
//FSGMapData:string;

DragStarPoint,SrcPosClick:TPoint;

procedure Move(StartPos, EndPos: TPoint);

function IntTOCtrlint(x,y:integer):TPoint;
function CtrlintToInt(point:TPoint):Tpoint;
function CheckValidPoint(pointx,pointy:byte):boolean;
function CheckValidLine(starpos,endpos:TPoint):boolean;
function CheckIfHavePiece(starpos,endpos:TPoint):boolean;
procedure UndoMove;
procedure SetStartGame(Value:boolean);
procedure Becaptured(color:byte );

function IfDiXian(starpos,endpos:TPoint):boolean;
function IfJunying(starpos,endpos:TPoint):boolean;
function IfYewo(starpos,endpos:TPoint):boolean;
function IFWin(MovePiece,EndposPiece:TPieceInfo):TWarResult;
function GBValidLine(starpos,endpos:TPoint):boolean;
function IfLiangbi(pcTmp:TPoint):boolean;
function IfYinhan(pcTmp:TPoint):boolean;
function IfSiding(pcTmp:TPoint):boolean;
procedure SGInishie;

protected
TempPiece:TPieceInfo;
TempPieceX,TempPieceY,NewPointX,NewPointY:integer;
procedure Paint; override;
// procedure loaded;override;
procedure MouseDown(Button:TMouseButton; Shift:TShiftState;X,Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure DragDrop(Source: TObject; X, Y: Integer);override;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);override;
procedure SetPlayerColor(Value:byte);

{ Protected declarations }
public
FGameBoard: TGameBoard;
SGTurnColor:byte;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawPiece(ACanvas: TCanvas; TopLeft: TPoint; Piece: TPieceInfo);
procedure ClearBoardPos(Pos:TPoint);
procedure LoadFromMapfile(path:string);
procedure SaveMapfile(path:string);
procedure PainCtrlClient;
function GetSingleMapData:string;
procedure PainPieceBitmap;
property SGSingleData:string read GetSingleMapData;
property GameBoard:TGameBoard read FGameBoard write FGameBoard;
{ Public declarations }
published
property Playing: boolean read FPlaying write SetStartGame;
property IsTurn: boolean read FIsTurn write FIsTurn default false;
property ZhadDilei: boolean read FZhadDilei write FZhadDilei default false;
property PieceBitmaps: TImageList read FPieceBitmaps write FPieceBitmaps;
property OnBecaptured: TDefeatedEvent read FOnBecaptured write FOnBecaptured;
property PlayerColor:byte read FPlayerColor write SetPlayerColor;

{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('OtherComp', [TSiGuo]);
end;

{ TSiGuo }

function TSiGuo.CheckValidPoint(pointx, pointy: byte): boolean;
begin
result:=false;
if playing then
begin
if ((pointx>5) and (pointx<11) and (pointy>10)) and (pointy<17) then //east
begin
result:=true;
exit;
end;

if ((pointy>5) and (pointy<11) and (pointx<6)) then //nouth
begin
result:=true;
exit;
end;

if ((pointx>5) and (pointx<11) and (pointy<6)) then //west
begin
result:=true;
exit;
end;

if ((pointy>5) and (pointy<11) and (pointx>10)) and (pointx<17) then //north
begin
result:=true;
exit;
end;

if ((pointx=6)and(pointy=6)) or ((pointx=6)and(pointy=8)) or ((pointx=6)and(pointy=10))
or ((pointx=8)and(pointy=6)) or ((pointx=8)and(pointy=8)) or ((pointx=8)and(pointy=10))
or ((pointx=10)and(pointy=6)) or ((pointx=10)and(pointy=8)) or ((pointx=10)and(pointy=10))then
begin
result:=true;
exit;
end; 
end else
begin //not playing do
if ((pointx>5) and (pointx<11) and (pointy>10)) and (pointy<17) then //east
begin
result:=true;
if (((pointx=7) and (pointy=12)) or ((pointx=9) and (pointy=12)) //军营内不许放旗子
or ((pointx=7) and (pointy=14)) or ((pointx=9) and (pointy=14))
or ((pointx=8) and (pointy=13))) then
result:=false;
end;

end;//playing
end;

constructor TSiGuo.Create(AOwner: TComponent);
begin
inherited;
DragCursor := crHandPoint;//移动鼠标风格
Width := 800;
Height := 600;
FBoardBitmap := TBitmap.Create;
FBoardBitmap.LoadFromFile('E:\siguo\bmp\siguomaps.bmp'); 
FPieceBitmaps := TImageList.Create(Self);
SGInishie;
FMove:=0;
TempPiece.PieceType:=15;

FPlaying:=false; //初始化
SGTurnColor:=5;
end;

destructor TSiGuo.Destroy;
begin
FPieceBitmaps.Free;
FBoardBitmap.Free;
inherited;
end;

procedure TSiGuo.DragDrop(Source: TObject; X, Y: Integer);
var
temppt:Tpoint;
begin
inherited;
if Isturn then
begin
temppt:=IntTOCtrlint(X,Y);
If FPieceBitmaps.Dragging Then
begin
FPieceBitmaps.HideDragImage;
FPieceBitmaps.EndDrag;
FPieceBitmaps.DragUnlock;
end;
SrcPosClick.x :=x;
SrcPosClick.y :=y;

Move(DragStarPoint,SrcPosClick) ;
end; 
end;

procedure TSiGuo.DragOver(Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Pos: TPoint;
mid,ImgIndx: Integer;
begin
inherited;
try
Pos := IntTOCtrlint(X,Y);
mid := PieceWidth shr 1;
If (not FPieceBitmaps.Dragging) and IsTurn Then //没有移动
begin
ImgIndx:= FGameBoard[DragStarPoint.x ,DragStarPoint.y].ImageIndex ;
if Playing then
if (FGameBoard[DragStarPoint.x ,DragStarPoint.y].PieceType=10) or
(FGameBoard[DragStarPoint.x ,DragStarPoint.y].PieceType=11) then //在玩、地雷、军旗时
exit;
TempPiece:= FGameBoard[DragStarPoint.x ,DragStarPoint.y];
FGameBoard[DragStarPoint.x ,DragStarPoint.y].PieceType:=15;
TempPieceX:= DragStarPoint.x;
TempPieceY:= DragStarPoint.y;
ClearBoardPos(DragStarPoint);
FPieceBitmaps.SetDragImage(ImgIndx, 0,0);
FPieceBitmaps.DragLock(Parent.Handle,X+Self.Left-mid,Y+Self.Top-mid);
FPieceBitmaps.BeginDrag(Parent.Handle,0,0);
end;
FPieceBitmaps.DragMove(X+Self.Left-mid,Y+Self.Top-mid);
FPieceBitmaps.ShowDragImage;
Accept:=true;
except
end; 
end;

procedure TSiGuo.DrawPiece(ACanvas: TCanvas; TopLeft: TPoint;
Piece: TPieceInfo);
var
TempPt:TPoint;
begin
if Piece.PieceType<>15 then
begin
TempPt.x :=spaceleft+SpaceX*TopLeft.x;
TempPt.y :=spacetop+SpaceY*TopLeft.y;
FPieceBitmaps.Draw(ACanvas,temppt.X,temppt.Y,Piece.ImageIndex );
end;
end;

function TSiGuo.IntTOCtrlint(x, y: integer): TPoint;
var
HPoint:TPoint;
begin
HPoint.x :=round (abs((x-SpaceLeft) div SpaceX));
HPoint.y :=round (abs((y-Spacetop) div SpaceY));
result:=HPoint;
end;

function TSiGuo.CtrlintToInt(point: TPoint): Tpoint;
var
temppt,temppt1:TPoint;
begin
temppt.x:= point.x;
temppt.y:=point.y;
temppt1.x:= spaceleft+SpaceX*temppt.x;
temppt1.y:= spacetop+SpaceY*temppt.y;
result:=temppt1;
end;

procedure TSiGuo.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
TempPoint:TPoint;
begin
if IsTurn then
begin
TempPoint := IntTOCtrlint(x,y);
DragStarPoint:=TempPoint;
Begindrag(false);
end; 
end;

procedure TSiGuo.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
//
end;

procedure TSiGuo.Move(StartPos, EndPos: TPoint);
var
temppt:Tpoint;
begin
if TempPiece.PieceType<>15 then
if playing then
begin
temppt:= IntTOCtrlint(endpos.x ,endpos.y);
if CheckValidLine(startpos,temppt) then //有效路径
if CheckValidPoint(temppt.x,temppt.y) then //移动到有效点
if FGameBoard[temppt.x,temppt.y].PieceType<>15 then //如果该点有棋子
begin
if (FGameBoard[temppt.x,temppt.y].Color<>TempPiece.Color) then //非自方子
begin
case IfWin(TempPiece,FGameBoard[temppt.x,temppt.y]) of
wrWin: //吃掉敌方棋子
begin
FGameBoard[temppt.x,temppt.y]:=TempPiece;
DrawPiece(Canvas,temppt,TempPiece);
TempPiece.PieceType:=15;
exit;
end;
wrDefeated: //没有吃掉敌方棋子
begin
DrawPiece(Canvas,temppt,FGameBoard[temppt.x,temppt.y]);
TempPiece.PieceType:=15;
exit;
end;
wrSame: //全部牺牲
begin
FGameBoard[temppt.x,temppt.y].PieceType:=15;
ClearBoardPos(temppt);
TempPiece.PieceType:=15;
exit;
end;
wrNone: exit; 
end;
end ;
end else
begin //没有棋子
FGameBoard[temppt.x,temppt.y]:=TempPiece;
DrawPiece(Canvas,temppt,TempPiece);
TempPiece.PieceType:=15;
exit;
end;
UndoMove; //解除移动
end else
begin //playing is false 摆放棋子
temppt:= IntTOCtrlint(endpos.x ,endpos.y);
if CheckValidPoint(temppt.x,temppt.y) then
begin
if TempPiece.PieceType=10 then //地雷只许放后两排
if temppt.y<15 then begin UndoMove ; exit;end;
if TempPiece.PieceType=9 then //炸弹不许放第一排
if temppt.y=11 then begin UndoMove ; exit;end;
if TempPiece.PieceType=11 then //军旗只许放两点
if not ( ((temppt.x=7) and (temppt.y=16)) or ((temppt.x=9) and (temppt.y=16))) then
begin UndoMove ; exit; end;
FGameBoard[StartPos.x,StartPos.y]:=FGameBoard[temppt.x,temppt.y]; //置换棋子
DrawPiece(Canvas,StartPos,FGameBoard[StartPos.x,StartPos.y]);
FGameBoard[temppt.x,temppt.y]:=TempPiece;
DrawPiece(Canvas,temppt,TempPiece);
exit;
end;
UndoMove;
end;
end;

procedure TSiGuo.PainCtrlClient;
Var
i,j:integer;
Srect:Trect;
Point:TPoint;
temp:string;
begin
for i:=0 to MaxXPieces-1 do
for j:=0 to MaxYPieces-1 do
begin
if CheckValidPoint(i,j) then
with Canvas do
begin
Point.x :=spaceleft+SpaceX*i;
Point.y :=spacetop+SpaceY*j;
Srect:=Rect(point.x,point.y,point.x+PieceWidth,point.y+PieceHeight);
Rectangle(Srect);
temp:=inttostr(i)+':'+inttostr(j);
textout(Point.x,point.y,temp);
end;
end;
end;

procedure TSiGuo.PainPieceBitmap;
var
I, J: Cardinal;
point:Tpoint; 
begin
For I := 0 To Pred(MaxXPieces) Do
For J := 0 To Pred(MaxYPieces) Do
begin
Point.x :=spaceleft+SpaceX*i;
Point.y :=spacetop+SpaceY*j;
If FGameBoard[I,J].PieceType <> 15 Then
FPieceBitmaps.Draw(Canvas,Point.x,Point.y,FGameBoard[i,j].ImageIndex);
end;
end;

procedure TSiGuo.Paint;
begin
Canvas.Draw(0,0,FBoardBitmap);
//PainCtrlClient;
if assigned(FPieceBitmaps) then
PainPieceBitmap;
end;

procedure TSiGuo.LoadFromMapfile(path: string);
var
Mapfile:file of TGameBoard;
begin
AssignFile(Mapfile,path);
reset(Mapfile);
try
if not eof(Mapfile) then
read(Mapfile,FGameBoard);
finally
closefile(Mapfile);
end;
paint; 
end;

procedure TSiGuo.SaveMapfile(path: string);
var
Mapfile:file of TGameBoard;
begin
AssignFile(Mapfile,path);
rewrite(Mapfile);
seek(Mapfile,filesize(Mapfile));
try
write(Mapfile,FGameBoard);
finally
closefile(Mapfile);
end;
end;

procedure TSiGuo.ClearBoardPos(Pos: TPoint);
var
TempPt:TPoint;
SRect:TRect;
begin
TempPt.x :=spaceleft+SpaceX*pos.x;
TempPt.y :=spacetop+SpaceY*pos.y;
Srect:=Rect(TempPt.x,TempPt.y,TempPt.x+PieceWidth,TempPt.y+PieceHeight);
Canvas.CopyRect(Srect,FBoardBitmap.Canvas,Srect);
end;

function TSiGuo.CheckValidLine(starpos, endpos: TPoint): boolean;
var
temppt1:TPoint;
begin
result:=false;
//可以走一步的点
if IfDiXian(starpos,endpos) then //底线点
begin
if (starpos.x-endpos.x)=0 then
if abs(starpos.y-endpos.y)<2 then
result:=true;
if (starpos.y-endpos.y)=0 then
if abs(starpos.x-endpos.x)<2 then
result:=true;
exit;
end ;

if IfJunying(starpos, endpos) then //军营
begin
if (starpos.x-endpos.x)=0 then
if abs(starpos.y-endpos.y)<2 then
begin
result:=true;
exit;
end else exit;
if (starpos.y-endpos.y)=0 then
if abs(starpos.x-endpos.x)<2 then
begin
result:=true;
exit;
end else exit;
if ( (abs(starpos.x-endpos.x)<2) and (abs(starpos.y-endpos.y)<2) ) then
begin
result:=true;
exit;
end;
exit;
end ;

if IfYewo(starpos, endpos) then //掖窝点
begin
if (starpos.x-endpos.x)=0 then
if abs(starpos.y-endpos.y)<2 then
begin
result:=true;
exit;
end else exit;
if (starpos.y-endpos.y)=0 then
if abs(starpos.x-endpos.x)<2 then
begin
result:=true;
exit;
end else exit;
exit;
end;

if Temppiece.PieceType=8 then //工兵
begin
result:=GBValidLine(starpos, endpos);
exit;
end;

//边界处可以拐歪
if ( ((Starpos.x=6) and (starpos.y>10)) and ((endpos.x<6) and (endpos.y=10))
or ((Starpos.y=10) and (starpos.x<6)) and ((endpos.x=6) and (endpos.y>10)) )then
begin
temppt1.x := 6; temppt1.y :=10;
if CheckIfHavePiece(starpos, temppt1) and CheckIfHavePiece(temppt1,endpos) then
begin
result:=true;
exit;
end;
end;
if ( ((Starpos.x=10) and (starpos.y>10)) and ((endpos.x>10) and (endpos.y=10))
or ((Starpos.y=10) and (starpos.x>10)) and ((endpos.x=10) and (endpos.y>10)) ) then
begin
temppt1.x := 10; temppt1.y :=10;
if CheckIfHavePiece(starpos, temppt1) and CheckIfHavePiece(temppt1,endpos) then
begin
result:=true;
exit;
end;
end;
if( ((Starpos.x=6) and (starpos.y<6)) and ((endpos.x<6) and (endpos.y=6))
or ((Starpos.x<6) and (starpos.y=6)) and ((endpos.x=6) and (endpos.y<6)) ) then
begin
temppt1.x := 6; temppt1.y :=6;
if CheckIfHavePiece(starpos, temppt1) and CheckIfHavePiece(temppt1,endpos) then
begin
result:=true;
exit;
end;
end;
if ( ((Starpos.x=10) and (starpos.y<6)) and ((endpos.x>10) and (endpos.y=6))
or ((Starpos.x>10) and (starpos.y=6)) and ((endpos.x=10) and (endpos.y<6)) )then
begin
temppt1.x := 10; temppt1.y :=6;
if CheckIfHavePiece(starpos, temppt1) and CheckIfHavePiece(temppt1,endpos) then
begin
result:=true;
exit;
end;
end;

if CheckIfHavePiece(starpos, endpos) then //是否有棋子是否拐弯
result:=true else result:=false;
end;

procedure TSiGuo.SetStartGame(Value:boolean);
begin
if not (csDesigning in ComponentState) then
begin
if Value<>playing then
FPlaying:=Value;
if FPlaying then
begin