📄 frminsert_p.pas
字号:
unit frmInsert_P;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, StrUtils,
ShellAPI;
type
TPokeState = (PokeFace, PokeInverse, PokeNone);
TGameState = (GameStop, GameBegin, GameRunning);
TPokeMarks = (King, Spades, Hearts, Clubs, Diamonds);
TfrmInsertType = class(TForm)
imgBG: TImage;
shp1: TShape;
shp2: TShape;
imgLogo: TImage;
tmrWatchCard: TTimer;
img1: TImage;
img2: TImage;
img3: TImage;
imgBtnQuit: TImage;
tmrWatchState: TTimer;
imgBackGround: TImage;
lblMyName: TLabel;
lblMessage: TLabel;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure tmrWatchCardTimer(Sender: TObject);
procedure imgBtnQuitClick(Sender: TObject);
procedure tmrWatchStateTimer(Sender: TObject);
procedure lblMyNameClick(Sender: TObject);
private
{ Private declarations }
procedure DrawOnePoke(PokeIndex: Integer; PokeState: TPokeState; PosX: Integer; PosY: Integer);
procedure CheckSelfAllCard;
function CheckSideCardOut(SideDSAddres, OutCount: Cardinal): TStringList;
procedure SideHistory(var HistoryCardList: TStringList; CurCardList: TStringList);
procedure DrawLeaveCardAndBomb;
procedure DrawSideCardHistory;
function CheckPokeType(PokeData: string): TPokeMarks;
function CheckPokeSymbol(PokeData: string): Byte;
public
{ Public declarations }
end;
var
frmInsertType: TfrmInsertType;
GameState: TGameState;
AllOtherCardHistory, LeftCardHistory, RightCardHistory: TStringList;
PrevAllOtherHistory, PrevLeftSideHistory, PrevRightSideHistory: string;
LeftSideCardCount, RightSideCardCount: Integer;
PokeLeave, PokeOutLeft, PokeOutRight, PokeOutSelf: Cardinal;
implementation
uses
Main, DataTrack;
{$R *.dfm}
procedure TfrmInsertType.FormCreate(Sender: TObject);
var
rt: TRect;
begin
imgBackGround.Canvas.Brush.Bitmap := TBitmap.Create;
imgBackGround.Canvas.Brush.Bitmap.Width := imgBG.Width;
imgBackGround.Canvas.Brush.Bitmap.Height := imgBG.Height;
rt := Rect(0, 0, imgBG.Width, imgBG.Height);
imgBackGround.Canvas.Brush.Bitmap.Canvas.CopyRect(rt, imgBG.Canvas, rt);
GameState := GameStop;
PokeLeave := 0;
PokeOutLeft := 0;
PokeOutRight := 0;
PokeOutSelf := 0;
AllOtherCardHistory := TStringList.Create;
LeftCardHistory := TStringList.Create;
RightCardHistory := TStringList.Create;
end;
{-------------------------------------------------------------------------------
过程名: TfrmInsertType.DrawOnePoke
说明: 绘制一张扑克
作者: who&who
日期: 2005.03.11
参数: PokeIndex: Integer; PokeState: TPokeState; PosX: Integer; PosY: Integer
返回值: 无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.DrawOnePoke(PokeIndex: Integer; PokeState: TPokeState; PosX: Integer; PosY: Integer);
var
rtDest, rtSource: TRect;
begin
if PokeState = PokeInverse then
PokeIndex := 54
else if PokeState = PokeNone then
PokeIndex := 55;
rtDest := Rect(PosX, PosY, PosX + MyPokeWidth, PosY + MyPokeHeight);
rtSource := Rect(PokeIndex * MyPokeWidth, 0, PokeIndex * MyPokeWidth + MyPokeWidth, MyPokeHeight);
case Screen.Width of
1024..1399:
imgBackGround.Canvas.CopyRect(rtDest, frmMain.imgPokeBmp1024.Canvas, rtSource);
1400..2048:
imgBackGround.Canvas.CopyRect(rtDest, frmMain.imgPokeBmp1400.Canvas, rtSource);
end;
end;
{-------------------------------------------------------------------------------
过程名: TfrmInsertType.CheckSelfAllCard
说明: 检查自己手中的牌面,从而得知其他人手中所有的牌面。
作者: who&who
日期: 2005.03.11
参数: 无
返回值: 无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.CheckSelfAllCard;
var
TmpStringList: TStringList;
I, TempIndex: Integer;
TmpCount: Cardinal;
begin
if not GetDataFromRam(AdrSelfCount, TmpCount) then
Close;
TmpStringList := GetPokeListFromRam(AdrSelfPoke, TmpCount);
for I := 0 to TmpStringList.Count - 1 do
begin
TempIndex := AllOtherCardHistory.IndexOf(TmpStringList[I]);
if TempIndex >= 0 then
AllOtherCardHistory.Delete(TempIndex);
end;
DrawLeaveCardAndBomb;
end;
{-------------------------------------------------------------------------------
过程名: TfrmInsertType.CheckSideCardOut
说明: 检查某一方出牌牌面。
作者: who&who
日期: 2005.03.11
参数: SideDSAddres, OutCount: Cardinal
返回值: TStringList
-------------------------------------------------------------------------------}
function TfrmInsertType.CheckSideCardOut(SideDSAddres, OutCount: Cardinal): TStringList;
var
I, TempIndex: Integer;
begin
Result := GetPokeListFromRam(SideDSAddres, OutCount);
//将打出的牌从剩余牌队列中去除
for I := 0 to Result.Count - 1 do
begin
TempIndex := AllOtherCardHistory.IndexOf(Result[I]);
if TempIndex >= 0 then
AllOtherCardHistory.Delete(TempIndex);
end;
end;
{-------------------------------------------------------------------------------
过程名: TfrmInsertType.SideHistory
说明: 将某一方出牌情况添加到该方历史纪录。
作者: who&who
日期: 2005.03.11
参数: var HistoryCardList: TStringList; CurCardList: TStringList
返回值: 无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.SideHistory(var HistoryCardList: TStringList; CurCardList: TStringList);
var
I: Integer;
begin
for I := 0 to CurCardList.Count - 1 do
if HistoryCardList.IndexOf(CurCardList[I]) < 0 then
HistoryCardList.Add(CurCardList[I]);
HistoryCardList.Sort;
end;
{-------------------------------------------------------------------------------
过程名: TfrmInsertType.DrawLeaveCardAndBomb
说明: 绘制自己手中以外剩余的牌面以及可能的炸弹情况。
作者: who&who
日期: 2005.03.11
参数: 无
返回值: 无
-------------------------------------------------------------------------------}
procedure TfrmInsertType.DrawLeaveCardAndBomb;
var
I: Integer;
TempPokeSymbol: Byte;
TempStr: string;
begin
TempStr := AllOtherCardHistory.CommaText;
if TempStr <> PrevAllOtherHistory then
begin
PrevAllOtherHistory := TempStr;
for I := 0 to AllOtherCardHistory.Count - 1 do
begin
DrawOnePoke(StrToInt(AllOtherCardHistory[I]), PokeFace, ImgLeftExcursion + I * MyPokeWidth, ImgAllOtherPokeTop);
//如果是方块,则进行炸弹判定
if (CheckPokeType(AllOtherCardHistory[I]) = Diamonds) and (I >= 3) then
begin
//比对前三张牌面,如果相同,则为炸弹。
TempPokeSymbol := CheckPokeSymbol(AllOtherCardHistory[I]);
if CheckPokeSymbol(AllOtherCardHistory[I - 1]) = TempPokeSymbol then
if CheckPokeSymbol(AllOtherCardHistory[I - 2]) = TempPokeSymbol then
if CheckPokeSymbol(AllOtherCardHistory[I - 3]) = TempPokeSymbol then
begin
imgBackGround.Canvas.Pen.Color := clYellow;
imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + (I - 3) * MyPokeWidth, ImgBombLineTop +
MyPokeHeight);
imgBackGround.Canvas.LineTo(ImgLeftExcursion - 4 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
ImgBombLineTop +
MyPokeHeight);
imgBackGround.Canvas.Pen.Color := clBlack;
imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + 1 + (I - 3) * MyPokeWidth, ImgBombLineTop + 1 +
MyPokeHeight);
imgBackGround.Canvas.LineTo(ImgLeftExcursion - 3 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
ImgBombLineTop + 1 +
MyPokeHeight);
end;
end
else
begin
//双猫判定
if (CheckPokeType(AllOtherCardHistory[I]) = King) and (I > 0) then
if (CheckPokeType(AllOtherCardHistory[I - 1]) = King) then
begin
imgBackGround.Canvas.Pen.Color := clYellow;
imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + (I - 1) * MyPokeWidth, ImgBombLineTop +
MyPokeHeight);
imgBackGround.Canvas.LineTo(ImgLeftExcursion - 4 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
ImgBombLineTop +
MyPokeHeight);
imgBackGround.Canvas.Pen.Color := clBlack;
imgBackGround.Canvas.PenPos := Point(ImgLeftExcursion + 1 + (I - 1) * MyPokeWidth, ImgBombLineTop + 1 +
MyPokeHeight);
imgBackGround.Canvas.LineTo(ImgLeftExcursion - 3 + (I + 1) * MyPokeWidth + ImgBombLineExcursion,
ImgBombLineTop + 1 +
MyPokeHeight);
end;
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -