Results 1 to 5 of 5

Thread: Two Useful Procedures

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

    Default Two Useful Procedures

    I made these functions procedures for debugging Reflection scripts, but I think they would be useful in general in SRL

    Code:
    {*******************************************************************************
    procedure PointToPoint(var bmp: Integer; start, finish: TPoint; colour: TColor);
    Bresenham's Line Algorithm (implemented in PS by mc_teo)
    Description: Draws a line on given Bmp, from TPoint Start to TPoint Finish.
    *******************************************************************************}
    procedure PointToPoint(var bmp: Integer; start, finish: TPoint; colour: TColor);
    var
      steep: boolean;
      deltax, deltay, error, ystep: integer;
    begin
      steep := (iAbs(finish.Y - start.Y) > iAbs(finish.X - start.X));
        if steep then
          begin
            swap(start.X, start.Y);
            swap(finish.X, finish.Y);
          end;
        if start.X > finish.X then
          begin
            swap(start.X, finish.X);
            swap(start.Y, finish.Y);
          end;
        deltax := (finish.X - start.X);
        deltay := iAbs(finish.Y - start.Y);
        error := (deltax / 2);
        y := start.Y
        if (start.Y < finish.Y) then
          ystep := 1
        else
          ystep := -1;
        for x := start.X to finish.X do
          begin
            if steep then
              FastSetPixel(bmp, y, x, colour)
            else
              FastSetPixel(bmp, x, y, colour);
            error := error - deltay;
            if error < 0 then
              begin
                y := y + ystep;
                error := error + deltax;
              end;
          end;
    end;
    
    {*******************************************************************************
    function DebugRectangle(x1, y1, x2, y2: TPoint; colour: TColor): Boolean;
    By: caused (adapted for Simba and SMART by mc_teo)
    Description: Draws a rectancle on SMART's Debug Canvas, in Colour.
    *******************************************************************************}
    function DebugRectangle(x1, y1, x2, y2: TPoint; Colour: TColor): Boolean;
    var
      Bmp: integer;
      P: TPoint;
      Canvas: TCanvas;
    begin
      GetClientDimensions(P.x, P.y);
      Bmp := BitmapFromString(P.x, P.y,'');
    
      PointToPoint(Bmp, x1, x2, Colour);
      PointToPoint(Bmp, x1, y1, Colour);
      PointToPoint(Bmp, x2, y2, Colour);
      PointToPoint(Bmp, y1, y2, Colour);
    
      Canvas := TCANVAS.Create;
      Canvas.Handle := SmartGetDebugDC;
    
      DrawBitmap(Bmp, Canvas, 0, 0);
      FreeBitmap(Bmp);
      Result := True;
    end;
    Any feedback/comments welcome
    Last edited by mc_teo; 06-29-2010 at 11:25 PM.

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

    Default

    Moved to reflection section.

  3. #3
    Join Date
    Jan 2008
    Location
    Ontario, Canada
    Posts
    7,805
    Mentioned
    5 Post(s)
    Quoted
    3 Post(s)

    Default

    Moved back to Public SRL...
    Writing an SRL Member Application | [Updated] Pascal Scripting Statements
    My GitHub

    Progress Report:
    13:46 <@BenLand100> <SourceCode> @BenLand100: what you have just said shows you 
                        have serious physchological problems
    13:46 <@BenLand100> HE GETS IT!
    13:46 <@BenLand100> HE FINALLY GETS IT!!!!1

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

    Default

    Quote Originally Posted by Nava2 View Post
    Moved back to Public SRL...
    Thanks. I wanted these two procedures to be in the Public SRL section because they have uses beyond that of Reflection.

    As far as I know there is no procedure in SRL for joining two TPoints, and this one was easy to implement in PS.

    The second procedure is for drawing a four point polygon on Smart's Debug Canvas, but could be easily altered to include any number of points.

  5. #5
    Join Date
    Apr 2008
    Location
    Marquette, MI
    Posts
    15,252
    Mentioned
    138 Post(s)
    Quoted
    680 Post(s)

    Default

    Neat, could you perhaps give some examples of usage and maybe some screenshots?

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
  •