home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Breakthrough: Entertainment & Education
/
SharewearBreakthroughEnt_Ed.cdr
/
games
/
mcheat
/
mcheat.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-27
|
7KB
|
176 lines
PROGRAM MineCheat;
{$d Mine cheat By Keith Garner 1992}
{$R mcheat}
Uses WinTypes, WinProcs, WObjects, strings;
CONST AppName : PChar = 'MCHEAT'; { the application name }
CoverMsg: Pchar = 'Please close or move the window'^M'covering'+
' the top left corner!'^M'( Before you continue ! )';
ErrorMsg: Pchar = 'MineCheat Error!';
id_cheat = 101; { the resource number of the CHEAT button }
black = 0;
white = $ffffff;
xOff = 4; { width of left border in Minesweeper window client area - 16}
yOff = 47; { width of top border in Minesweeper window client area - 16}
TYPE
TMyApplication = OBJECT(TApplication)
PROCEDURE InitMainWindow; virtual;
END;
PCheat = ^TCheat;
TCheat = OBJECT(TDlgWindow)
MsWin: HWnd;
rpr: TRect;
PROCEDURE SendSecretMsg;
PROCEDURE SetUpWindow; Virtual;
FUNCTION GetClassName : PChar; Virtual;
PROCEDURE WMDestroy (VAR msg: TMessage); VIRTUAL wm_first + wm_Destroy;
PROCEDURE Cheat_Now (VAR msg: TMessage); VIRTUAL id_first + id_cheat;
END;
{--------------------------------------------------}
{ Support Procedures }
{--------------------------------------------------}
procedure WaitIdle; {It's impolite to hog the CPU}
var m: TMsg;
begin
while PeekMessage(m, 0, 0, 0, pm_Remove) do begin
if m.message = wm_Quit then HALT(m.wParam);
TranslateMessage(m);
DispatchMessage(m);
end;
end;
function MyGetPixel(TheWin:HWnd;x,y:Integer;Compare:LongInt):Boolean;
var msDC: HDC;
begin
msDC := GetDC(TheWin);
MyGetPixel := compare = GetPixel(msDC,x,y); { get a pixel & compare }
ReleaseDC(TheWin, msDC);
end;
{--------------------------------------------------}
{ TCheat's methods }
{--------------------------------------------------}
PROCEDURE TCheat.Cheat_Now (VAR msg: TMessage);
VAR I, J: integer;
st: ARRAY[0..32] OF CHAR;
Wn: HWnd;
TmpRpr: TRect;
procedure Click(btnDown, btnUp: WORD); { send a simulated mouse click }
begin
PostMessage(msWin, btnDown, 0, MakeLong(xOff + 16*I, yOff + 16*J));
PostMessage(msWin, btnUp, 0, MakeLong(xOff + 16*I, yOff + 16*J));
end; {Click}
BEGIN
{ Step #1 if MineSweeper is still on the screen AND it's size has changed:
Change the dimenions. }
if (msWin <> 0 ) then begin
getClientRect(Mswin,TmpRpr);
if (TmpRpr.top<>Rpr.top)or(TmpRpr.left<>Rpr.left)or
(TmpRpr.right<>Rpr.right)or(TmpRpr.bottom<>Rpr.bottom) then
getClientRect(Mswin,Rpr);
end;
{ Step #2 Find MineSweeper ( if not found allready ) and then send
the secret code ! "x y z z y <return> <shift>+<return>" }
if (MsWin = 0) or (not iswindow(MsWin)) then begin
MsWin := 0;
Wn := GetWindow(hWindow, gw_HWndFirst);
WHILE (Wn <> 0 ) and (MsWin = 0 ) DO BEGIN
Wn := GetNextWindow(Wn, gw_HWndNext);
GetWindowText(Wn, st, 32);
IF StrComp(st, 'Minesweeper') = 0 THEN BEGIN
MsWin := Wn;
SendSecretMsg;
GetClientRect(MsWin, rpr); { get the MineSweeper size }
END;
END;
end;
{ Step #3 Make sure that the MineSweeper window is known and that
the top left square is up ( not solved ) }
if (MSWin=0) or (not MyGetPixel(MsWin,xOff+9,yOff+16,white)) then
MessageBox(hwindow,'Minesweeper not ready!',ErrorMsg,mb_ok)
else for J := 1 to ((rpr.bottom - 67) DIV 16) do
for I := 1 to ((rpr.right - 24) DIV 16) do begin
{ Step # 4 for every square :
Move the mouse to the square.
if the square has allready been marked, skip it.
Read the color from the top corner of the screen.
Mark or step on a square }
PostMessage(MsWin, WM_MouseMove,0, MakeLong(xOff+16*I,yOff+16*J));
WaitIdle;
if (J=1) and (I=1) then
Click(WM_LBUTTONDOWN,WM_LBUTTONUP)
else if MyGetPixel(0,0,0,black) then
Click(WM_RBUTTONDOWN,WM_RBUTTONUP)
else if MyGetPixel(MsWin,xOff-7+16*I,yOff+0+16*J,white) then
Click(WM_LBUTTONDOWN,WM_LBUTTONUP);
end;
END;
PROCEDURE TCheat.WMDestroy(VAR msg: TMessage);
BEGIN
SendSecretMsg;
TDlgWindow.WMDestroy(msg);
END;
PROCEDURE TCheat.SendSecretMsg;
BEGIN
PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('x')), $2d0001);
PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('y')), $150001);
PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('z')), $2c0001);
PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('z')), $2c0001);
PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('y')), $150001);
PostMessage(MsWin, WM_KEYDOWN,vk_return, $1c0001);
PostMessage(MsWin, WM_KEYDOWN,vk_shift, $360001);
PostMessage(MsWin, WM_KEYDOWN,vk_return, $1c0001);
WaitIdle;
END;
PROCEDURE TCheat.SetUpWindow;
var st: ARRAY[0..80] OF CHAR;
TmpWin : HWnd;
p : tpoint;
BEGIN
TDlgWindow.SetUpWindow;
SetClassWord(hWindow, GCW_HICON, LoadIcon(hInstance, AppName));
{ -- make sure that no other programs cover the screen -- }
p.x := 0 ; p.y := 0;
TmpWin := WindowFromPoint(P);
GetWindowText(TmpWin, st, 80);
While (TmpWin <> 0) and (StrComp(st, '') <> 0 ) do begin
if MessageBox(HWindow,CoverMsg,ErrorMsg,mb_retrycancel+mb_iconstop)=
IDCANCEL then halt(1);
TmpWin := WindowFromPoint(P);
GetWindowText(TmpWin, st, 80);
end;
MsWin := 0;
END;
FUNCTION TCheat.GetClassName;
BEGIN
GetClassName := AppName;
END;
{--------------------------------------------------}
{ TMyApplication's method implementations: }
{--------------------------------------------------}
PROCEDURE TMyApplication.InitMainWindow;
BEGIN
MainWindow := New(PCheat, Init(NIL, AppName));
END;
{--------------------------------------------------}
{ Main program: }
{--------------------------------------------------}
VAR MyApp: TMyApplication;
BEGIN
MyApp.Init(AppName);
MyApp.Run;
MyApp.Done;
END.