lol minesweeper

Since SRL is busy being fixed for the new RS (I'm not good enough to fix it myself) I made a cool little script. This script will play the Windows XP minesweeper really fast. Don't move the mouse while its running. You will have to stop the script if it gets a new best time. It's not very smart so expert is hard for it.

Code:

program New;

const
col1=16711680;
col2=32768;
col3=255;
col4=8388608;
col5=128;
col6=8421376;
col7=0;
col8=8421504;

var
x,y,i,w,h,dud,count:integer;
board: array of array of integer;

procedure init;
begin
  getclientdimensions(x,y);
  w:=(x-27)/16;
  h:=(y-116)/16;
  setlength(board,w);
  for i:=0 to w-1 do
  begin
    setlength(board[i],h);
  end;
end;

function idsquare(xx,yy:integer):integer;
begin
  Result:=0;
  if getcolor(xx,yy)=16777215 then
  begin
    Result:=9;
    exit;
  end;
  if findcolor(dud,dud,col1,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=1;
    exit;
  end;
  if findcolor(dud,dud,col2,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=2;
    exit;
  end;
  if findcolor(dud,dud,col3,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=3;
    exit;
  end;
  if findcolor(dud,dud,col4,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=4;
    exit;
  end;
  if findcolor(dud,dud,col5,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=5;
    exit;
  end;
  if findcolor(dud,dud,col6,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=6;
    exit;
  end;
  if findcolor(dud,dud,col7,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=7;
    exit;
  end;
  if findcolor(dud,dud,col8,xx+1,yy+1,xx+15,yy+15) then
  begin
    Result:=8;
    exit;
  end;
end;

procedure fill;
begin
  for x:=0 to w-1 do
  begin
    for y:=0 to h-1 do
    begin
      if board[x][y]=9 then
      begin
        board[x][y]:=idsquare(15+16*x,104+16*y);
      end;
    end;
  end;
end;

function click():boolean;
var
k,a,b,q:integer;
begin
  Result:=false;
  fill;
  for x:=0 to w-1 do
  begin
    for y:=0 to h-1 do
    begin
      k:=board[x][y];
      q:=0;
      if (k<>0) and (k<>9001) and (k<>9) then
      begin
        for a:=-1 to 1 do
        begin
          for b:=-1 to 1 do
          begin
            if (x+a>=0) and (x+a<w) and (y+b>=0) and (y+b<h) then
            begin
              if board[x+a][y+b]=9 then
              begin
                q:=q+1;
              end;
              if board[x+a][y+b]=9001 then
              begin
                k:=k-1;
              end;
            end;
          end;
        end;
        if q=0 then
        begin
          board[x][y]:=0;
        end;
        if k=0 then
        begin
          for a:=-1 to 1 do
          begin
            for b:=-1 to 1 do
            begin
              if (x+a>=0) and (x+a<w) and (y+b>=0) and (y+b<h) then
              begin
                if board[x+a][y+b]=9 then
                begin
                  clickmouse(23+16*(x+a),112+16*(y+b),true);
                  Result:=true;
                end;
              end;
            end;
          end;
        end;
        if k=q then
        begin
          for a:=-1 to 1 do
          begin
            for b:=-1 to 1 do
            begin
              if (x+a>=0) and (x+a<w) and (y+b>=0) and (y+b<h) then
              begin
                if board[x+a][y+b]=9 then
                begin
                  board[x+a][y+b]:=9001;
                end
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

begin
  cleardebug;
  activateclient;
  init
  repeat
  for x:=0 to w-1 do
  begin
    for y:=0 to h-1 do
    begin
      board[x][y]:=9;
    end;
  end;
  clickmouse(20+16*random(w),110+16*random(h),true);
  count:=0;
  while true do
  begin
    if click=false then
    begin
      count:=count+1;
    end;
    if count>10 then
    begin
      break;
    end;
  end;
  findcolor(x,y,65535,0,0,27+16*w,116+16*h)
  clickmouse(x,y,true);
  wait(100);
  until(false)
end.

 

A good waste of time there, eh?

 

wrong section

 

its scar script

 

Not bad. Actually made a minesweeper "solver" myself a while ago. I'll post it when I can be assed to dig it up if I'll remember

Anyhow, good job.

 

Very nice work

 

rofl it actualy works

 

Gj mate.

~Uber