Results 1 to 14 of 14

Thread: DebugATPABounds Quickfix

  1. #1
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default DebugATPABounds Quickfix

    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
    SCAR Code:
    {*******************************************************************************
    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;
    Last edited by Wanted; 03-21-2010 at 07:46 PM. Reason: All your base are belong to us.

  2. #2
    Join Date
    Dec 2006
    Location
    Houston, TX USA
    Posts
    4,791
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    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) ?

  3. #3
    Join Date
    Jan 2007
    Posts
    8,876
    Mentioned
    123 Post(s)
    Quoted
    327 Post(s)

    Default

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

  4. #4
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

    Quote Originally Posted by IceFire908 View Post
    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) ?
    :].. 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

  5. #5
    Join Date
    Mar 2007
    Posts
    4,810
    Mentioned
    3 Post(s)
    Quoted
    3 Post(s)

    Default

    Quote Originally Posted by caused View Post
    :].. 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

  6. #6
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

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

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



    SCAR Code:
    {*******************************************************************************
    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;
    Last edited by caused; 03-12-2010 at 03:13 AM.

  7. #7
    Join Date
    Dec 2006
    Location
    Houston, TX USA
    Posts
    4,791
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

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

    Hopefully it will find its way into OpenDev soon.

    Good work.

  8. #8
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

    Quote Originally Posted by IceFire908 View Post
    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

  9. #9
    Join Date
    Dec 2006
    Location
    Houston, TX USA
    Posts
    4,791
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    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.

    SCAR Code:
    {*******************************************************************************
    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.

  10. #10
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

    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

  11. #11
    Join Date
    Dec 2006
    Location
    Houston, TX USA
    Posts
    4,791
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Quote Originally Posted by caused View Post
    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.

  12. #12
    Join Date
    Mar 2009
    Location
    Ireland
    Posts
    111
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    Code:
    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

  13. #13
    Join Date
    Dec 2006
    Location
    Houston, TX USA
    Posts
    4,791
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

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

  14. #14
    Join Date
    Mar 2009
    Location
    Ireland
    Posts
    111
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default

    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

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •