All pastes #450326 Raw Edit

Someone

public text v1 · immutable
·published 2007-04-20 19:31 UTC
rendered paste body
program New;
{.include SRL/SRL.scar}

function InIntArray(TheInt:integer;TheArray:array of integer):boolean;
var i:integer;
begin
  repeat
    if TheArray[i]=TheInt then
      result:=true;
    i:=i+1;
  until ((i=getarraylength(TheArray)) or (result));
end;
procedure RemoveFromTPA(Index:integer; var TPA:array of tpoint);
var swapTP:tpoint;
AL:integer;
begin
  AL:=getarraylength(TPA);
  swapTP:=TPA[AL-1];
  TPA[AL-1]:=TPA[Index];
  TPA[Index]:=swapTP;
  setarraylength(TPA,AL-1);
end;




type ColorTPA = record
color:integer;
tpa: array of tpoint;
end;
var
PlayerDotCTPA:array of ColorTPA;
parray,parray2,tx,ty,tmpcolor,mmbmp,dropdot,AL:integer;
ColorArray: array of integer;


procedure updatebitmap(sx,sy,color:integer);
begin
  FastSetPixel(mmbmp,sx-mmx1,sy-mmy1,color);
CopyCanvas(getbitmapcanvas(mmbmp),getdebugcanvas,0,0,mmx2-mmx1,mmy2-mmy1,0,0,mmx2-mmx1,mmy2-mmy1);
 DisplayDebugImgWindow(mmx2-mmx1,mmy2-mmy1)


end;
begin
  setupsrl;
   DisplayDebugImgWindow(mmx2-mmx1,mmy2-mmy1)//displays debug image
MMbmp:=BitmapFromString(mmx2-mmx1,mmy2-mmy1,'');
CopyClientToBitmap(MMbmp,mmx1,mmy1,mmx2,mmy2);
CopyCanvas(getbitmapcanvas(mmbmp),getdebugcanvas,0,0,mmx2-mmx1,mmy2-mmy1,0,0,mmx2-mmx1,mmy2-mmy1);
 DisplayDebugImgWindow(mmx2-mmx1,mmy2-mmy1)

   dropdot:= DTMFromString('78DA6354666060606340012FA134238C56021' +
       '2ECA86A3EA2AB5104121CA86A6EA2AB51C634E71C921A66200600' +
       '386A0432');
   setarraylength(colorarray,6);
    ColorArray[0]:=16711422;
  ColorArray[1]:=15527148;
  ColorArray[2]:=13816530;
  ColorArray[3]:=14869218;
  ColorArray[4]:=12961221;
  ColorArray[5]:=65536;
  if FindDTM(dropdot,tx,ty,mmx1,mmy1,mmx2,mmy2)then
  begin
    setarraylength(colorarray,18);
    ColorArray[6]:=getcolor(tx,ty);
    ColorArray[7]:=getcolor(tx,ty+1);
    ColorArray[8]:=getcolor(tx-1,ty-1);
    ColorArray[9]:=getcolor(tx-1,ty);
    ColorArray[10]:=getcolor(tx-1,ty+1);
    ColorArray[11]:=getcolor(tx-1,ty+2);
    ColorArray[12]:=getcolor(tx-2,ty-1);
    ColorArray[13]:=getcolor(tx-2,ty);
    ColorArray[14]:=getcolor(tx-2,ty+1);
    ColorArray[15]:=getcolor(tx-2,ty+2);
    ColorArray[16]:=getcolor(tx-3,ty);
    ColorArray[17]:=getcolor(tx-3,ty+1);
  end;
  freedtm(dropdot);
  AL:=getarraylength(colorarray);
  setarraylength(PlayerDotCTPA,AL);
  for parray:=0 to AL-1 do
  begin
    PlayerDotCTPA[parray].color:=colorarray[parray];
   // writeln(inttostr(PlayerDotCTPA[parray].color));
  end;
  AL:=getarraylength(colorarray);
  for parray:=0 to AL-1 do
  begin
    FindColorsSpiralTolerance(tx,ty,PlayerDotCTPA[parray].tpa,
       PlayerDotCTPA[parray].color,mmx1,mmy1,mmx2,mmy2,0);
  end;
  repeat
  for parray:=0 to AL-1 do
  begin
    for parray2:=0 to getarraylength(PlayerDotCTPA[parray].tpa)-1 do
    begin
      tmpcolor:=getcolor(PlayerDotCTPA[parray].tpa[parray2].x,PlayerDotCTPA[parray].tpa[parray2].y);
      if not(InIntArray(tmpcolor,ColorArray)) then
    // if not(tmpcolor=PlayerDotCTPA[parray].color) then
      begin
        UpdateBitmap(PlayerDotCTPA[parray].tpa[parray2].x,PlayerDotCTPA[parray].tpa[parray2].y,tmpcolor);
        RemoveFromTPA(parray2,PlayerDotCTPA[parray].tpa);
      end;
    end;
  end;
    wait(500);
  //  CopyCanvas(getbitmapcanvas(mmbmp),getdebugcanvas,0,05,mmx2-mmx1,mmy2-mmy1,0,0,748-541,175);
  //DisplayDebugImgWindow(748-541,175)
    //writeln('new bmp');
  //repeat
   // wait(30);
  //until isfkeydown(12);

  //repeat
  //  wait(30);
  //until isfkeydown(11);
  until isfkeydown(10);
  FreeBitmap(mmbmp);

end.