mc_teo
2010-06-29 19:21:11
I made these functions procedures for debugging Reflection scripts, but I think they would be useful in general in SRL
Any feedback/comments welcome
{*******************************************************************************
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