Mega Code Archive
Rubberbandingone
<![CDATA[
RUBBER-BANDING CODE
Richard Ebbs
Jan 2000
Rubber-banding is the geek-name for drawing a line from
a start point and then holding the (usually left-) mouse
down while a temporary line follows the cursor around
from the start point to the dragged cursor until the
(usually left-) mouse is released whereupon a permanent
line is drawn from the start point to the 'mouse up'
position.
RELEVANT TYPE DECLARATIONS
TDrawingMode = (dmSelect, dmLineDrawing, dmDragDrop);
TLineRecord = record
startPt: TPoint;
endPt: TPoint;
end;
RELEVANT OBJECT METHODS
type
TMainForm = class(TForm)
procedure DrawAreaMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DrawAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure DrawAreaMouseUp(Sender: TObject; Button: TMouseButton;
RELEVANT OBJECT PRIVATE DECLARATIONS
private
{private declarations}
Origin: TPoint;
tempLine: TLineRecord;
MovePt: TPoint;
drawMode: TDrawingMode;
end;
procedure TMainForm.DrawAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
{use this or similar if you want to snap to a particular
point, otherwise just use the MouseDown X and Y coords
for the start point of your rubber-banding line...}
nearestGridVertex: TPoint;
begin
if (drawMode = dmLineDrawing) then
begin
nearestGridVertex := GetNearestGridVertex(X, Y);
Origin.x := nearestGridVertex.x;
Origin.y := nearestGridVertex.y;
MovePt := Origin;
DrawArea.Canvas.MoveTo(Origin.X, Origin.Y);
tempLine.startPt.X := Origin.X;
tempLine.startPt.Y := Origin.Y;
end;
end;
procedure TMainForm.DrawAreaMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if (drawMode = dmLineDrawing) then
begin
{check that the left mouse button is being held down...}
if (ssLeft in Shift) then
begin
//this use of 'MovePt' and Origin is a standard way of rubber-banding
//lines -there are better ways but this is fairly easy to understand...
with DrawArea.Canvas do
begin
//pen.Style:= psSolid;
Pen.Color := clBlack;
Pen.Width := scrPrefs.lineThickness;
//next line avoids an unsightly effect whereby
//a line might appear too wide while being drawn
Pen.Mode := pmNotXor;
MoveTo(Origin.X, Origin.Y);
LineTo(MovePt.X, MovePt.Y);
MoveTo(Origin.X, Origin.Y);
LineTo(X,Y);
end;
MovePt:= Point(X,Y);
DrawArea.Canvas.Pen.Mode := pmBlack;
end;
end;
end;
procedure TMainForm.DrawAreaMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
nearestGridVertex: TPoint;
begin
if (drawMode = dmLineDrawing) then
begin
{use this or similar if you want to snap to a particular
point, otherwise just use the MouseDown X and Y coords
for the end point of your rubber-banding line...}
nearestGridVertex := GetNearestGridVertex(X, Y);
DrawArea.Canvas.MoveTo(Origin.X, Origin.Y);
DrawArea.Canvas.LineTo(nearestGridVertex.x, nearestGridVertex.y);
tempLine.endPt.x := nearestGridVertex.x;
tempLine.endPt.y := nearestGridVertex.y;
{reinitialise the global templine variable used to track
line coordinates between procedures as they 'happen'...}
tempLine.startPt.x := 0;
tempLine.startPt.y := 0;
tempLine.endPt.x := 0;
tempLine.endPt.y := 0;
Inc(ptIndex);
end;
ReDrawAll(DrawArea.Canvas, DrawArea.Width, DrawArea.Height);
end;
]]>