SRL Archive - The Bashing Club / BBQ Pit

What is the best Function/Procedure you ever made?
Well if you have one then post it!

*You may post more than one.*


Here is mine:

function SquareRootSymbol(Num: integer) : string;
var
  Temp, ModCheck : integer;
  Stop : boolean;

begin
  Inc(Temp);
  repeat
    if((Temp * Temp) = Num)then Result := IntToStr(Temp);
    if((Temp * Temp) < Num)then Inc(Temp);
    if((Temp * Temp) > Num)then Stop := True;
  until(Result = IntToStr(Temp)) or (Stop = True);
  if(Stop = True)then
   begin
    ModCheck := Num;
    repeat
     Dec(ModCheck);
     Temp := ModCheck * ModCheck;
     if(Num - ((Num div Temp) * Temp) = 0)then Break;
    until(ModCheck = Num);
   end;
  if(ModCheck = Num) and (Stop = True)then
   begin
    Result := '0';
    writeln('Can''t compute, in other words, WONT WORK');
    writeln('Sqrt(' + IntToStr(ModCheck) + ')');
   end;
  if(Stop) and (ModCheck <> Num)then
   begin
    Temp := Num div (ModCheck * ModCheck);
    writeln('Square Root = ' +IntToStr(ModCheck) + ' Sqrt(' + IntToStr(Temp) + ')');
    Result := IntToStr(ModCheck) + ' Sqrt( ' + IntToStr(Temp) + ' )';
   end;
  if not(Stop)then
    writeln('Square Root = ' + Result);
end;

function FightNPCFindMob(Color:TintegerArray; tol: integer;Uptext:TStringArray): integer;

var
  x,y,fcolx,fcoly,ftd:integer;
  bebs:integer;
  npccolortpa,npccolortpa2:Tpointarray;
  
begin
  if (not (LoggedIn)) or (FindDead) or (InFight) then Exit;
  for ftd:=0 to high(color) do
  begin
    x:=MSCX;
    y:=MSCY;
    if FindObjTPA(x, y, color[ftd], tol, -1, 15, 15, 25,Uptext)and
    not(FindColor(fcolx, fcoly, 65280, x - 20, y, x + 20, y + 80)) then
    begin
      Mouse(x,y,2,2,true);
      flag;
      wait(500 + random(200));
      if infight then
      begin
        Result:=1;
        Wait(1000+random(500));
        Exit;
      end;
    end;
  end;
  begin
    FindColorsSpiralTolerance(MMCX, MMCY,npccolorTPA, 195836, MMX1, MMY1, MMX2, MMY2,3);
    npccolortpa2:=ReArrangeandShortenArray(npccolorTPA,2);
    for bebs:=0 to high(npccolorTPA2) do
    begin
      if not(FindColorTolerance(x, y, 16711422, npccolorTPA2[bebs].x - 2, npccolorTPA2[bebs].y - 2, npccolorTPA2[bebs].x + 2,npccolorTPA2[bebs].y + 2, 5)) then
      begin
        Mouse(npccolorTPA2[bebs].x,npccolortpa2[bebs].y,3,3,true);
        Result:=2;
        FFlag(3);
        exit;
      end;
    end;
  end;
  begin
    Findcolorspie(npccolorTPA, 195836, 3, 0, 360, 0, 60, MMX1, MMY1, MMX2, MMY2, MMCX, MMCY);
    npccolortpa2:=ReArrangeandShortenArray(npccolorTPA,2);
    if (npccolorTPA[0].x <> 0 )then
    begin
      try
        for bebs:=random(2) to high(npccolorTPA2) do
        begin
          Mouse(npccolorTPA2[bebs].x,npccolortpa2[bebs].y,3,3,true);
          Result:=3;
          FFlag(3+random(2));
          Exit;
        end;
      except
        Writeln('Wow, we must be lost or something, there are less than 1 npc dots on the minimap!');
        result:=5;
        exit;
      finally
      end;
    end else
    result:=4;
  end;
end;

Tries fighting a NPC, if it does not find the NPC, tries to find a yellow dot on the minimap without a white dot next to it. If does not find a single NPC dot, it will just click the first npc dot.

Procedure ProgressReport;
Var
  I: Integer;
Begin
  Writeln('<------------------------------------------------------------------->');
  Writeln('                   JuKKa Edgeville Fisher & Banker');
  Writeln('<------------------------------------------------------------------->');
  Writeln('  Worked ' + TimeRunning);
  Writeln('  Fished ' + IntToStr( Fished )+' Fishes');
  Writeln('    Trouts ' + IntToStr( Trout )+'');
  Writeln('    Salmons ' + IntTostr( Salmon )+'');
  Writeln('  Gained ' + IntToStr( Gained )+' Exp.');
  Writeln('  Banked ' + IntToStr( Banks )+' Loads');
  Writeln('<------------------------------------------------------------------->');
  Writeln(' # - Status - Fished - Trouts - Salmons - Gained - Banked - Location');
  For I:= 0 To HowManyPlayers-1 Do
    Writeln(' ' + Padr(IntToStr(I), Length(' - S'))
                + Padr(BoolToStr(Players[I].Active), Length(' - Fished'))
                + Padr(IntToStr(Players[I].Integers[0]), Length(' - Trouts'))
                + Padr(IntToStr(Players[I].Integers[1]), Length('- Salmons'))
                + Padr(IntToStr(Players[I].Integers[2]), Length('  - Gained'))
                + Padr(IntToStr(Players[I].Integers[3]), Length(' - Banked'))
                + Padr(IntToStr(Players[i].Banked), Length(' Location'))
                + Padr(Players[I].Loc, Length('')));

  Writeln('<------------------------------------------------------------------->');
  SRLRandomsReport;
End;

function TehOwnageFunction: Boolean;
var
  i, u: Integer;
begin
  u := -1;
  for i := 0 to 5468947 do
    Writeln('Hello World!');
  Writeln('Boo!');
  Result := i > u;
end;

hmmm


very hard question.. I don't know…
Here's one im pretty proud of…

function Leo_AnalyzeCoffin(var CoffinName: string; ClientHDC: HDC): Boolean; stdcall;
var
  BMP: TBitmap;
  x, y, nic, i, dist: Integer;
  sRGB, bRGB, Hue, st: Extended;
  Line: PRGB32Array;


label Lab1;

function RGBMin: Integer;
begin
  Result := Min(Min(Line[x].r, Line[x].g), Line[x].b);
end;

function RGBMax: Integer;
begin
  Result := Max(Max(Line[x].r, Line[x].g), Line[x].b);
end;

procedure Maskit;
begin
   sRGB := RGBMin / 255;
    bRGB := RGBMax / 255;
    Hue := 0.0;
    if (not(sRGB = bRGB)) then
    begin
       if (Line[x].r = bRGB) then
       Hue := (Line[x].g - Line[x].b) / (bRGB - sRGB)
     else if (Line[x].g = bRGB) then
       Hue := 2.0 + (Line[x].b - Line[x].r) / (bRGB - sRGB)
     else Hue := 4.0 + (Line[x].r - Line[x].g) / (bRGB - sRGB);
          Hue := Hue / 6.0;
        if (Hue < 0.0) then Hue := Hue + 1;
     end;
    if (Hue < 13.0) then
        c[x][y] := 0
    else
        c[x][y] := clwhite;
end;

begin
  Result := False;
  CoffinName := 'error';
  w := 240; h := 237;
  Bmp := TBitmap.Create;
  Bmp.Width := w;
  Bmp.Height:= h;
  Bmp.PixelFormat := pf32bit;
   for nic := 1 to 9 do
     Item[nic].Parm := 0;
  SetLength(c, w + 1, h + 1);
  SetLength(b, w + 1, h + 1);
  bitsize := 7;
  st := now;

 repeat
    BitBlt(Bmp.Canvas.Handle, 0, 0, w, h, ClientHDC, 145, 50, SRCCOPY);

 {    Filter Pixels (Get Mask)      }
 Area := 0;
  for y := 0 to h-1 do
  begin
    Line := bmp.ScanLine[y];
   for x := 0 to w-1 do
   begin
     c[x][y] := RGB(Line[x].r, Line[x].g, Line[x].b);
     b[x][y] := false;
     Maskit;
   end;
 end;

 SolveParamerter;
  for y := 0 to h do
  for x := 0 to w do
   Bmp.Canvas.Pixels[x, y] := c[x][y];
   Bmp.Canvas.Brush.Color := 10;
   Bmp.Canvas.FloodFill(2, 2, 0, fsSurface);
   Bmp.Canvas.FloodFill(w - 2, h - 2, 0, fsSurface);
 for y := 0 to h do
  for x := 0 to w do
   c[x][y] := bmp.Canvas.Pixels[x, y];

 for nic := 1 to 9 do
   if (Data[nic].Parm > Item[nic].Parm) then
   begin
     Item[nic] := Data[nic];
     Item[nic].Holes := 0;

          // Corners
      for y := Item[nic].y1 to Item[nic].y2 do
       for x := Item[nic].x1 to Item[nic].x2 do
        if (c[x][y] = clblue) then
        begin
        for i := 0 to 7 do
        if (X + ax[i] > 0) and (X + ax[i] < w) and
           (Y + ay[i] > 0) and (Y + ay[i] < h) then
             if (c[x + ax[i]][y + ay[i]] = 10) then
             begin
                 c[x][y] := $CCFF;
                 break;
             end;
       end;
      Item[nic].MinDist := 500;
      fillcolor := clpurple;
      bgcolor := 0;
       for y := Item[nic].y1 to Item[nic].y2 do
        for x := Item[nic].x1 to Item[nic].x2 do
        begin
         if (c[x][y] = 0) then
         begin
           Area := 0;
           FFillBg(x, y);
           if (Area > 5) then inc(Item[nic].Holes);
         end;
         if (c[x][y] = $CCFF) then
         begin
            Dist := round(Sqrt(Sqr(1.0 * (x - Item[nic].mx)) + Sqr(1.0 * (y - Item[nic].my))));
            if (Item[nic].MinDist > Dist) then Item[nic].MinDist := Dist;
         end;
     end;
   end;
 Sleep(150 + random(50));
until (((Now - st) * 86400000) > 10000);

  CoffinName := CoffinAnswer;

Lab1:

 bmp.free;
end;

Autocolor.scar?? :)