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.