SRL Archive - SRL Archives

I've always had troubles with the SRL DebugATPABounds function. Now looking at it, I think that this function is somewhat outdated ;)…

Feel free to use this one, if you're having trouble with the usual DebugATPABounds function( Blank debug canvas ).

It also works without SRL.

Example Output:

E: Committed

{*******************************************************************************
procedure DebugATPABounds(aPoints: Array Of TPointArray);
By: Wizzup?, lordsaturn, & caused
Description: Shows an image of the client, plotting each TPA's bounds as a box
             of different colour per TPA. If a name is specified, an image
             will be saved.
*******************************************************************************}

procedure DebugATPABounds(aPoints: Array Of TPointArray);
var
   Width, Height, ClientBMP, I,x2, y2, h : Integer;
   B: TBox;
   BoxColors : Array Of Integer;
   SelColor: Integer;
begin
  {$IFDEF SIMBA}
  WriteLn('Ok who''s the lucky guy who wants to make this Simba compatiable? =P - IceFire908 was here xD');
  {$ELSE}
  GetClientDimensions(x2,y2);
  width := x2;
  height := y2;

  ClientBMP := BitmapFromString(Width, Height, '');
  CopyClientToBitmap(ClientBMP, 0, 0, width, height);

  DisplayDebugImgWindow(Width, Height);

  SafeDrawBitmap(ClientBmp, GetDebugCanvas, 0, 0);

  GetDebugCanvas.Font.Style := [fsBold];
  GetDebugCanvas.Brush.Style := bsClear;

  BoxColors := [clRed, clBlue, clBlack, clGreen, clYellow];
  for i:= 0 to high(aPoints) do
  begin
    SelColor := BoxColors[Random(length(Boxcolors))];

    GetDebugCanvas.Pen.Color := SelColor;
    GetDebugCanvas.Font.Color := SelColor;

    B := GetTPABounds(aPoints[i]);
    GetDebugCanvas.Rectangle(B.x1,B.y1,B.x2,B.y2);
    GetDebugCanvas.TextOut(B.x1,B.y1,inttostr(i));
  end;
 FreeBitmap(ClientBmp);
 {$ENDIF}
end;

Hey cool, a nice sweet simple solution, it might get a little hard to read if all the boxes are red in the same general area though. For epicness could you make it different color boxes (match the number color w/ the box) :D?

Dude! Do you play ROSE? :O
What server? evoRose? rRose? iRose? TitanRose? :P

From: IceFire908
Hey cool, a nice sweet simple solution, it might get a little hard to read if all the boxes are red in the same general area though. For epicness could you make it different color boxes (match the number color w/ the box) :D?

:].. Right. Why not making it epic ;D… I'll upload the epic version later(or tommorow). Thanks.

Dude! Do you play ROSE? :O
What server? evoRose? rRose? iRose? TitanRose? :P

Yeah, I love it, It's soo cute @___@… Not sure about the server, I just downloaded the official client and logged on.

~caused

From: caused
:].. Right. Why not making it epic ;D… I'll upload the epic version later(or tommorow). Thanks.
~caused

Please do, DebugATPABounds is probably the best debugging method there is. It always seems to give a black screen for some reason though, apparently it was canvas error, but who knows. I guess I'll check if it works in SIMBA :)

Sorry for the late update. Here's the new colorful version ;].

I was suprised to see my bank booth finder still going that strong.

{*******************************************************************************
procedure DebugATPABounds(aPoints: Array Of TPointArray);
By: caused
Description: Debugs boxes(ATPA's) in fancy colors!
*******************************************************************************}
procedure DebugATPABounds(aPoints: Array Of TPointArray);
var
   Width, Height, ClientBMP, I,x2, y2, h : Integer;
   B: TBox;
   BoxColors : Array Of Integer;
   SelColor: Integer;
begin
  GetClientDimensions(x2,y2);
  width := x2;
  height := y2;

  ClientBMP := BitmapFromString(Width, Height, '');
  CopyClientToBitmap(ClientBMP, 0, 0, width, height);

  DisplayDebugImgWindow(Width, Height);

  SafeDrawBitmap(ClientBmp, GetDebugCanvas, 0, 0);

  GetDebugCanvas.Font.Style := [fsBold];
  GetDebugCanvas.Brush.Style := bsClear;

  BoxColors := [clRed, clBlue, clBlack, clGreen, clYellow];
  for i:= 0 to high(aPoints) do
  begin
    SelColor := BoxColors[Random(length(Boxcolors))];

    GetDebugCanvas.Pen.Color := SelColor;
    GetDebugCanvas.Font.Color := SelColor;

    B := GetTPABounds(aPoints[i]);
    GetDebugCanvas.Rectangle(B.x1,B.y1,B.x2,B.y2);
    GetDebugCanvas.TextOut(B.x1,B.y1,inttostr(i));
  end;
 FreeBitmap(ClientBmp);
end;

This is uber cool, really glad to see this working again :)

Hopefully it will find its way into OpenDev soon.

Good work.

From: IceFire908
This is uber cool, really glad to see this working again :)

Hopefully it will find its way into OpenDev soon.

Good work.

Yeh, it's really frustrating to not be able to debug your functions.
Feel free to add it right away ;].

~caused

Ok I committed the 2nd version. Good work, thanks for this much needed fix. :)

Unfortunately it was not simba compatible, and I did not have time to make it compatible. So I put in this.

{*******************************************************************************
procedure DebugATPABounds(aPoints: Array Of TPointArray);
By: Wizzup?, lordsaturn, & caused
Description: Debugs boxes(ATPA's) in fancy colors!
*******************************************************************************}
procedure DebugATPABounds(aPoints: Array Of TPointArray);
var
   Width, Height, ClientBMP, I,x2, y2, h : Integer;
   B: TBox;
   BoxColors : Array Of Integer;
   SelColor: Integer;
begin
  {$IFDEF SIMBA}
  WriteLn('Ok who''s the lucky guy who wants to make this Simba compatiable? =P - IceFire908 was here xD');
  {$ELSE}
  GetClientDimensions(x2,y2);
  width := x2;
  height := y2;

  ClientBMP := BitmapFromString(Width, Height, '');
  CopyClientToBitmap(ClientBMP, 0, 0, width, height);

  DisplayDebugImgWindow(Width, Height);

  SafeDrawBitmap(ClientBmp, GetDebugCanvas, 0, 0);

  GetDebugCanvas.Font.Style := [fsBold];
  GetDebugCanvas.Brush.Style := bsClear;

  BoxColors := [clRed, clBlue, clBlack, clGreen, clYellow];
  for i:= 0 to high(aPoints) do
  begin
    SelColor := BoxColors[Random(length(Boxcolors))];

    GetDebugCanvas.Pen.Color := SelColor;
    GetDebugCanvas.Font.Color := SelColor;

    B := GetTPABounds(aPoints[i]);
    GetDebugCanvas.Rectangle(B.x1,B.y1,B.x2,B.y2);
    GetDebugCanvas.TextOut(B.x1,B.y1,inttostr(i));
  end;
 FreeBitmap(ClientBmp);
 {$ENDIF}
end;

Anyone feel free to post a simba fix.

I'm actually not sure if Wizzup? or LordSaturn did anything for this function xDD.. Even though I based it on their function - I totally rewrote it (Some var names may be the same) ;].

Ok I committed the 2nd version. Good work, thanks for this much needed fix.

Welcome : D

Unfortunately it was not simba compatible, and I did not have time to make it compatible. So I put in this.

Hah, I think It would be just a simple change in the debug Canvas that Simba uses :].

~caused

From: caused
I'm actually not sure if Wizzup? or LordSaturn did anything for this function xDD.. Even though I based it on their function - I totally rewrote it (Some var names may be the same) ;].


Welcome : D


Hah, I think It would be just a simple change in the debug Canvas that Simba uses :].

~caused

:-P That's credible for something is it not? ;)

Yea, I'm not good with Canvases though ha. If someone posts I'll fix.

procedure DebugATPABounds(aPoints: Array Of TPointArray);
var
   Width, Height, ClientBMP, I, x2, y2, h : Integer;
   B: TBox;
   BoxColors : Array Of Integer;
   SelColor: Integer;

begin
  GetClientDimensions(x2,y2);
  width := x2;
  height := y2;

  ClientBMP := BitmapFromString(Width, Height, '');
  CopyClientToBitmap(ClientBMP, 0, 0, width, height);

  DisplayDebugImgWindow(Width, Height);

  {$IFDEF SIMBA}

  DrawBitmapDebugImg(ClientBmp);

  BoxColors := [clRed, clBlue, clBlack, clGreen, clYellow];
  DrawATPABitmapEx(ClientBMP, aPoints, BoxColors);

  DrawBitmapDebugImg(ClientBMP);

  FreeBitmap(ClientBMP);

  {$ELSE}

  SafeDrawBitmap(ClientBmp, GetDebugCanvas, 0, 0);

  GetDebugCanvas.Font.Style := [fsBold];
  GetDebugCanvas.Brush.Style := bsClear;

  BoxColors := [clRed, clBlue, clBlack, clGreen, clYellow];
  for i:= 0 to high(aPoints) do
  begin
    SelColor := BoxColors[Random(length(Boxcolors))];

    GetDebugCanvas.Pen.Color := SelColor;
    GetDebugCanvas.Font.Color := SelColor;

    B := GetTPABounds(aPoints[i]);
    GetDebugCanvas.Rectangle(B.x1,B.y1,B.x2,B.y2);
    GetDebugCanvas.TextOut(B.x1,B.y1,inttostr(i));
  end;
 FreeBitmap(ClientBmp);
 {$ENDIF}
end;                         

Could you try this? I've never used ATPAs do I don't know how to try them out, but from reading through the source, this should work.


I could tweak it to draw on Smart's Debug Canvas either.

~mc_teo

^This is fixed quite well in latest versions. Have you tried it recently from the SRL repo?

No I haven't because I've never used ATPAs and have no intention of starting in the foreseeable future. and I didnt check the latest ones, I just saw the request when I was waiting for someone to post on my other thread