This procedure extends or trims lines to form sharp corners.
Developed by Tom Urie.
}
LABEL 10,15,80,99;
VAR
b1,b2,m1,m2 : REAL;
xt,yt,CursorX,CursorY,px,py : REAL;
x1,x2,y1,y2,xp,yp,x1n,x2n,y1n,y2n : ARRAY[1..2] OF REAL;
j,k,ObjType,KeyCode : INTEGER;
Case : ARRAY[1..2] OF INTEGER;
R,G,B : LONGINT;
ObjectH,nObjectH : ARRAY[1..3] OF HANDLE;
FirstLine,FirstTime : BOOLEAN;
Procedure Swap(VAR x1,x2,y1,y2 : REAL);
{
This procedure swaps the values of x1 and x2, and y1 and y2.
}
VAR
Temp : REAL;
BEGIN
Temp:=x1;
x1:=x2;
x2:=Temp;
Temp:=y1;
y1:=y2;
y2:=Temp;
END;
BEGIN
{
Main program.
}
{
Select the lines.
}
FirstTime:=TRUE;
10:Message('Select the first line. Click anywhere to end.');
FirstLine:=FALSE;
DSelectAll;
FOR k:=1 TO 2 DO
BEGIN
SetCursor(ArrowC);
REPEAT
{
Perform the next two routines if the Esc key is pressed.
}
IF KeyDown(KeyCode) THEN
BEGIN
IF KeyCode = 27 THEN
BEGIN
IF FirstLine THEN
{
(1) If only the first line has been selected, de-select it.
}
DSelectAll
ELSE IF NOT FirstTime THEN
BEGIN
{
(2) If the new lines have been drawn, restore old lines.
}
Absolute;
DSelectAll;
FOR j:=1 TO 2 DO
BEGIN
MoveTo(x1[j],y1[j]);
LineTo(x2[j],y2[j]);
ObjectH[j]:=LSActLayer;
SetLW(ObjectH[j],GetLW(nObjectH[j]));
SetLS(ObjectH[j],GetLS(nObjectH[j]));
SetClass(ObjectH[j],GetClass(nObjectH[j]));
GetPenFore((nObjectH[j]),R,G,B);
SetPenFore((ObjectH[j]),R,G,B);
GetPenBack((nObjectH[j]),R,G,B);
SetPenBack((ObjectH[j]),R,G,B);
GetFillFore((nObjectH[j]),R,G,B);
SetFillFore((ObjectH[j]),R,G,B);
GetFillBack((nObjectH[j]),R,G,B);
SetFillBack((ObjectH[j]),R,G,B);
DelObject(nObjectH[j]);
END;
RedrawAll;
DSelectAll;
FirstTime:=TRUE;
END; {of NOT FirstTime routine}
GOTO 10;
END; {of KeyCode 27 routine}
END; {of KeyDown routine}
{
Change the cursor to a cross when the mouse is in the vicinity of a line.
}
GetMouse(CursorX,CursorY);
ObjectH[3]:=PickObject(CursorX,CursorY);
IF ObjectH[3] <> NIL THEN
BEGIN
ObjType:=GetType(ObjectH[3]);
IF ObjType = 2 THEN
SetCursor(LgCrossC);
END ELSE
SetCursor(ArrowC);
UNTIL MouseDown(xp[k],yp[k]);
{
Select the object the mouse was on when the mouse was clicked and determine if it was a line.
}
ObjectH[k]:=PickObject(xp[k],yp[k]);
IF ObjectH[k] = NIL THEN
BEGIN
ClrMessage;
GOTO 99;
END ELSE
{
If the object selected was not a line, end program.
}
BEGIN
ObjType:=GetType(ObjectH[k]);
IF ObjType <> 2 THEN BEGIN
ClrMessage;
Sysbeep;
AlrtDialog('The object selected is not a line!');
GOTO 99;
END ELSE
{
If the object is a line, get coordinates of end points. Set the leftmost end to x1 and y1, or if the line is vertical, set the lowest end to x1 and y1.
}
BEGIN
SetSelect(ObjectH[k]);
GetSegPt1(ObjectH[k],x1[k],y1[k]);
GetSegPt2(ObjectH[k],x2[k],y2[k]);
IF (x2[k] < x1[k]) OR ((x2[k] = x1[k]) AND (y2[k] < y1[k])) THEN
Swap(x1[k],x2[k],y1[k],y2[k]);
END;
END;
RedrawAll;
Message('Select the second line. Click anywhere to end.');
FirstLine:=TRUE;
END; {of Select Lines}
ClrMessage;
{
Determine the equations of the lines and find the coordinates of the intersection point.
}
IF x2[1] <> x1[1] THEN
BEGIN
Case[1]:=1;
m1:=(y2[1] - y1[1])/(x2[1] - x1[1]);
b1:=y1[1] - m1*x1[1];
END ELSE
BEGIN
Case[1]:=2;
xt:=x1[1];
IF x2[2] <> x1[2] THEN
BEGIN
Case[2]:=1;
m2:=(y2[2] - y1[2])/(x2[2] - x1[2]);
b2:=y1[2] - m2*x1[2];
yt:=m2*xt+b2;
GOTO 80;
END ELSE
{
If both lines are vertical give warning.
}
BEGIN
Sysbeep;
AlrtDialog('Those lines do not intersect!');
GOTO 10;
END;
END;
IF x2[2] <> x1[2] THEN
BEGIN
Case[2]:=1;
m2:=(y2[2] - y1[2])/(x2[2] - x1[2]);
b2:=y1[2] - m2*x1[2];
END ELSE
BEGIN
Case[2]:=2;
xt:=x2[2];
yt:=m1*xt+b1;
GOTO 80;
END;
IF m1 <> m2 THEN
BEGIN
xt:=(b2-b1)/(m1-m2);
yt:=(m1*b2-m2*b1)/(m1-m2);
GOTO 80;
END ELSE
{
IF the lines are parallel give warning.
}
BEGIN
Sysbeep;
AlrtDialog('Those lines do not intersect!');
GOTO 10;
END;
{
Determine the new end points of the lines. The portion of the line that remains is determined by the location of the mouse when the line was selected.
}
80:FOR k:=1 TO 2 DO
BEGIN
IF Case[k] = 1 THEN
BEGIN
IF xp[k] < xt THEN
BEGIN
x1n[k]:=x1[k]; y1n[k]:=y1[k];
x2n[k]:=xt; y2n[k]:=yt;
END ELSE
BEGIN
x1n[k]:=xt; y1n[k]:=yt;
x2n[k]:=x2[k]; y2n[k]:=y2[k];
END;
END
ELSE BEGIN
IF yp[k] < yt THEN
BEGIN
x1n[k]:=x1[k]; y1n[k]:=y1[k];
x2n[k]:=x2[k]; y2n[k]:=yt;
END ELSE
BEGIN
x1n[k]:=x1[k]; y1n[k]:=yt;
x2n[k]:=x2[k]; y2n[k]:=y2[k];
END;
END;
END;
{
Delete the old lines and draw the trimmed lines in their place.
