Mega Code Archive
Rubberbandingtwo
<![CDATA[
'FLOOR PLAN' CODE FORRUBBER-BANDING...
as you can see, you need three (or two, if you
rewrite this code to be more elegant) variables
that are global to the form/image component
where the rubber-banding is going on, and then
all rubber-banding ops happen in MouseDown(),
MouseMove(), and MouseUp().
Richard E
[type]
TLineRecord = record
startPt: TPoint;
endPt: TPoint;
end;
[global main form vars]
origin: TPoint;
movePt: TPoint;
tempLine: TLineRecord;
procedure TMainForm.DrawAreaMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
nearestGridVertex: TPoint;
begin
DrawArea.Canvas.Pen.Width := scrPrefs.lineThickness;
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;
procedure TMainForm.DrawAreaMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
DrawArea.Canvas.Pen.Width := scrPrefs.lineThickness;
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.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
DrawArea.Canvas.Pen.Width := scrPrefs.lineThickness;
if (drawMode = dmLineDrawing) then
begin
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;
if ((tempLine.startPt.x = 0) and (tempLine.startPt.y = 0) and
(tempLine.endPt.x = 0) and (tempLine.endPt.y = 0)) then
begin
//do nothing
end
else AddLineToObjectList(tempLine);
{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;
]]>