Chip 1998 March/Chip_1998-03_cd.bin/tema/MINICAD/MC7DEMO/MINICAD.1/SPRINGS.MPC

Text File | 1997-04-30 | 53KB | 2,635 lines

Procedure Springs;
{
(c)1997, Diehl Graphsoft, Inc.
Developed by Tom Urie

This procedure draws every spring known to man (almost).
}
LABEL 99;

VAR
    Type : INTEGER;
    Abort : BOOLEAN;


Procedure CompressionSprings;
{
(c)1997, Diehl Graphsoft, Inc.
Developed by Tom Urie

This procedure draws a compression spring.
}

LABEL 10,20,30,99;

CONST
    Fillpat1=1;
    Fillpat2=27;

VAR
    D,P,wd,FL,OD,SH,WL : REAL;
    x0,y0,R_MW,R_SS : REAL;

    NCoils,NCoilsB,NCoilsF,TNCoils : INTEGER;
    Type,Method : INTEGER;

    Abort,Inch,Section : BOOLEAN;

    sf,UPI : REAL;
    Fmt : INTEGER;
    UM,UM2 : STRING;
    UName,DA : LONGINT;

Procedure SpringDialog;
{
This procedure defines the dialog box.
}
VAR
    Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;

Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
VAR
    scrx1,scry1,scrx2,scry2:INTEGER;
BEGIN
    GetScreen(scrx1,scry1,scrx2,scry2);
    x1:=((scrx1+scrx2) div 2)-(Width div 2);
    x2:=x1+Width;
END;

Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
{
This procedure locates the 'OK' and 'Cancel' buttons.
}
VAR
    v1,v2,v3,v4 : INTEGER;
    Mac : BOOLEAN;

Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
VAR
    Temp : INTEGER;
BEGIN
    Temp:=m1;
    m1:=m3;
    m3:=Temp;
    Temp:=m2;
    m2:=m4;
    m4:=Temp;
END;        {of Swap}

BEGIN
    Mac:=FALSE;
    GetVersion(v1,v2,v3,v4);
    IF v4 = 1 THEN Mac:=TRUE;

    IF DialogType = 1 THEN
    BEGIN
        px1:=(scnw DIV 2) - 80;
        px2:=(scnw DIV 2) - 10;
        px3:=(scnw DIV 2) + 10;
        px4:=(scnw DIV 2) + 80;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE IF DialogType = 2 THEN
    BEGIN
        px1:=scnw - 180;
        px2:=scnw - 110;
        px3:=scnw - 90;
        px4:=scnw - 20;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE
    BEGIN
        px1:=scnw - 90;
        px2:=scnw - 20;
        px3:=px1;
        px4:=px2;

        py1:=scnh -70;
        py2:=scnh - 50;
        py3:=scnh - 40;
        py4:=scnh - 20;
        IF Mac THEN SWAP(py1,py2,py3,py4);
    END;
END;        {of Locate Buttons}

Procedure MakeDialog1;
CONST
    y1=100;
    scnw = 420;
    scnh = 230;
    DialogType = 2;

VAR
    h : INTEGER;

BEGIN
    AlignScr(scnw,x1,x2);
    y2:=y1+scnh;
    LocateButtons(DialogType,scnh,scnw);

    BeginDialog(1,1,x1,y1,x2,y2);
        AddButton('OK',1,1,px1,py1,px2,py2);
        AddButton('Cancel',2,1,px3,py3,px4,py4);

        h:=0;
        AddField('Method:',19,1,20,9+h,75,25+h);
        AddButton('1',20,3,80,10+h,110,25+h);
        AddButton('2',21,3,120,10+h,155,25+h);

        AddField('Units:',22,1,220,9+h,260,25+h);
        AddButton('Inch',23,3,265,10+h,315,25+h);
        AddButton('mm',24,3,320,10+h,365,25+h);

        AddField('',4,1,20,44+h,130,60+h);
        AddField('',5,2,145,45+h,210,60+h);
        AddField('',6,1,20,69+h,130,85+h);
        AddField('',7,2,145,70+h,210,85+h);
        AddField('',8,1,20,94+h,130,110+h);
        AddField('',9,2,145,95+h,210,110+h);
        AddField('',10,1,20,119+h,130,135+h);
        AddField('',11,2,145,120+h,210,135+h);
        AddField('',12,1,20,144+h,130,160+h);
        AddField('',13,2,145,145+h,210,160+h);

        AddField('',30,1,220,44+h,255,60+h);
        AddField('',31,1,220,69+h,255,85+h);
        AddField('',32,1,220,94+h,255,110+h);
        AddField('',33,1,220,119+h,255,135+h);
        AddField('',34,1,220,144+h,255,160+h);

        AddField('Type of Ends:',3,1,265,39+h,375,55+h);
        AddButton('Open',14,3,265,125+h,315,140+h);
        AddButton('Closed',15,3,265,105+h,405,120+h);
        AddButton('Open and Ground',16,3,265,85+h,405,100+h);
        AddButton('Closed and Ground',17,3,265,65+h,410,80+h);

        AddButton('Section View',18,2,20,185+h,120,200+h);

    EndDialog;
END;

BEGIN
    MakeDialog1;
END;

Procedure GetInfo;
{
This procedure displays the dialog box and retrieves the information.
}
LABEL 5,10,20,99;
VAR
    Value : REAL;
    Item,Field,k,NTimes,NPlaces : INTEGER;
    RFlag : ARRAY[1..3] OF INTEGER;
    Done : BOOLEAN;

Procedure SetRButton(i,Item : INTEGER);
BEGIN
    IF RFlag[i] <> Item THEN BEGIN
        SetItem(RFlag[i],FALSE);
        SetItem(Item,TRUE);
        RFlag[i]:=Item;
    END;
END;

PROCEDURE SetTextFields(Method:INTEGER);
CONST
    SLength=25;
    STitle='                         ';
VAR
    Field,k : INTEGER;
    Description : ARRAY[1..2,1..5] OF STRING;
BEGIN
    Description[1,1]:='Outside Diameter:';
    Description[1,2]:='Wire Diameter:';
    Description[1,3]:='Free Length:';
    Description[1,4]:='Solid Height:';
    Description[1,5]:='Working Length:';
    Description[2,1]:='Mean Diameter:';
    Description[2,2]:='Wire Diameter:';
    Description[2,3]:='Pitch:';
    Description[2,4]:='No. of Active Coils:';
    Description[2,5]:='(Not Used)';
    Field:=2;
    FOR k:=1 TO 5 DO BEGIN;
        Field:=Field+2;
        SetField(Field,Description[Method,k]);
    END;
END;

PROCEDURE SetUnitsField(Inch:BOOLEAN);
VAR
    Field,k : INTEGER;
    UnitsM1,UnitsM2 : STRING;
BEGIN
    Field:=29;
    IF Inch THEN
        UnitsM1:='in'
    ELSE
        UnitsM1:='mm';
    FOR k:=1 TO 5 DO
    BEGIN;
        Field:=Field+1;
        SetField(Field,UnitsM1);
    END;
END;

BEGIN
    NTimes:=NTimes+1;
    IF NTimes > 1 THEN GOTO 5;

    OD:=0.975;
    wd:=0.125;
    D:=OD-wd;
    FL:=2.0;
    SH:=1.117;
    WL:=1.75;
    TNCoils:=SH/wd;
    P:=(FL-2*wd)/TNCoils;
    NCoils:=TNCoils-2;
    Method:=1;
    Type:=4;
    Inch:=TRUE;
    Section:=FALSE;

    5:Done:=FALSE;
    Abort:=FALSE;
    RFlag[1]:=Type+13;
    RFlag[2]:=Method+19;
    IF Inch Then RFlag[3]:=23
    ELSE RFlag[3]:=24;
    GetDialog(1);
    SetTitle('Compression Springs');
    SetTextFields(Method);
    SetUnitsField(Inch);
    SetItem(RFlag[1],TRUE);
    SetItem(RFlag[2],TRUE);
    SetItem(RFlag[3],TRUE);
    SetItem(18,Section);
    IF Method = 1 THEN BEGIN
        SetField(5,Num2StrF(OD));
        SetField(7,Num2StrF(wd));
        SetField(9,Num2StrF(FL));
        SetField(11,Num2StrF(SH));
        SetField(13,Num2StrF(WL));
    END
    ELSE BEGIN
        SetField(5,Num2StrF(D));
        SetField(7,Num2StrF(wd));
        SetField(9,Num2StrF(P));
        SetField(11,Num2Str(0,NCoils));
        SetField(13,'n/a');
    END;
    SelField(5);
    10:REPEAT
        DialogEvent(Item);
        IF Item=1 then
            Done:=True;
        IF Item=2 then BEGIN
            Done:=TRUE;
            Abort:=TRUE;
        END;
        IF (ITEM=13) AND (Method=2) THEN
        BEGIN
            SysBeep;
            SelField(5);
        END;
        IF (Item>13) AND (Item<18) THEN
        BEGIN
            SetRButton(1,Item);
            Type:=Item-13;
        END;
        IF Item=18 THEN
        BEGIN
            SetItem(Item,NOT Section);
            Section:=NOT Section;
        END;
        IF (Item=20) AND (Method=2) THEN
        BEGIN
            SetRButton(2,Item);
            Method:=1;
            SetTextFields(Method);
            SetField(5,Num2StrF(OD));
            SetField(7,Num2StrF(wd));
            SetField(9,Num2StrF(FL));
            SetField(11,Num2StrF(SH));
            SetField(13,Num2StrF(WL));
        END;
        IF (Item=21) AND (Method=1) THEN
        BEGIN
            SetRButton(2,Item);
            Method:=2;
            SetTextFields(Method);
            SetField(5,Num2StrF(D));
            SetField(7,Num2StrF(wd));
            SetField(9,Num2StrF(P));
            SetField(11,Num2Str(0,NCoils));
            SetField(13,'<n/a>');
        END;
        IF (Item=23) AND (NOT Inch) THEN
        BEGIN
            SetRButton(3,Item);
            Inch:=TRUE;
            SetUnitsField(Inch);
        END;
        IF (Item=24) AND (Inch) THEN
        BEGIN
            SetRButton(3,Item);
            Inch:=FALSE;
            SetUnitsField(Inch);
        END;
    UNTIL Done;
    IF Abort THEN GOTO 99;
    Field:=3;
    FOR k:=1 TO 5 DO
    BEGIN
        Field:=Field+2;
        IF (Field=13) AND (Method=2) THEN GOTO 20;
        IF Str2Num(GetField(Field))>0 THEN GOTO 20;
        SysBeep;
        SelField(Field);
        Done:=False;
        GOTO 10;
    20:END;
    IF Method = 1 THEN BEGIN
        OD:=Str2Num(GetField(5));
        wd:=Str2Num(GetField(7));
        FL:=Str2Num(GetField(9));
        SH:=Str2Num(GetField(11));
        WL:=Str2Num(GetField(13));
    END
    ELSE BEGIN
        D:=Str2Num(GetField(5));
        wd:=Str2Num(GetField(7));
        P:=Str2Num(GetField(9));
        NCoils:=Str2Num(GetField(11));
    END;
    99:ClrDialog;
END;

PROCEDURE DrawCoil(x,y,D,P,wd:REAL; Direction:INTEGER);
VAR
    r,L,Theta,x0,y0 : REAL;
BEGIN
    r:=wd/2;
    Theta:=Direction*ArcTan(P/(2*D));
    L:=Sqrt(D^2 + (P/2)^2);
    x0:=x-r*(Sin(Theta)+Cos(Theta));
    y0:=y+r*(Cos(Theta)-Sin(Theta));
    Theta:=Rad2Deg(Theta);
    Absolute;
    MoveTo(x0,y0);
    Relative;
    AngleVar;
    ClosePoly;
    BeginPoly;
        ArcTo((L+2*r),#Theta,r);
        ArcTo(2*r,#(Theta-90),r);
        ArcTo(-(L+2*r),#Theta,r);
        ArcTo(2*r,#(Theta+90),r);
    EndPoly;
    NoAngleVar;
    IF Section THEN BEGIN
        Absolute;
        MoveTo(x,y);
        Relative;
        FillPat(FillPat2);
        Arc(-r,r,r,-r,0,360);
        MoveTo(D,-P/2);
        Arc(-r,r,r,-r,0,360);
        FillPat(FillPat1);
    END;
END;

PROCEDURE DrawCoil1(x,y,D,P,wd:REAL; Direction:INTEGER);
VAR
    i,r,L,Theta,x0,y0 : REAL;
BEGIN
    r:=wd/2;
    i:=Direction;
    Theta:=-ArcTan(P/(2*D));
    L:=Sqrt(D^2 + (P/2)^2);
    x0:=x-r*(Sin(Theta)+i*Cos(Theta));
    y0:=y+r*(Cos(Theta)-i*Sin(Theta));
    Theta:=Rad2Deg(Theta);
    Absolute;
    MoveTo(x0,y0);
    Relative;
    AngleVar;
    ClosePoly;
    BeginPoly;
        LineTo(i*(L/2+r),#Theta);
        LineTo(2*r,#(Theta-90));
        ArcTo(-i*(L/2+r),#Theta,r);
        ArcTo(2*r,#(Theta+90),r);
    EndPoly;
    NoAngleVar;
    IF Section THEN BEGIN
        Absolute;
        MoveTo(x,y);
        Relative;
        FillPat(FillPat2);
        Arc(-r,r,r,-r,0,360);
        FillPat(FillPat1);
    END;
END;

PROCEDURE DrawCoil3a(x,y,MD,P,wd:REAL;Direction:INTEGER);
VAR
    x0,y0,Alpha,Beta,Theta,Phi : REAL;
    c,r,x1,y1,x2,y2,x3,y3,y4,dx,dy : REAL;
    i : INTEGER;
BEGIN
    r:=wd/2;
    i:=Direction;
    Theta:=ArcTan(P/(2*MD));
    y1:=wd/4;
    x1:=Sqrt(r^2 - y1^2);
    Beta:=(PI/6 + Theta/2);
    Alpha:=(PI/3 - Theta)/2;
    c:=wd/(2*Sin(Alpha));
    x2:=c*Cos(Beta);
    y2:=c*Sin(Beta);
    x3:=wd*Sin(Theta)/2;
    y3:=wd*Cos(Theta)/2;
    y4:=y1+y3-(MD/2-x3)*Tan(Theta);
    x0:=x + i*x1;
    y0:=y + i*y1;
    Absolute;
    MoveTo(x0,y0);
    Relative;
    ClosePoly;
    BeginPoly;
        LineTo(0,0);
        LineTo(-i*(MD/2 + x1),0);
        LineTo(-0,-i*y4);
        ArcTo(i*(MD/2 + x2),i*(y4-y1-y2),wd/2);
    EndPoly;
    IF Section THEN BEGIN
        Phi:=Rad2Deg(ArcTan(x1/y1));
        IF Phi < 0 THEN Phi:=-1*Phi;
        Absolute;
        MoveTo(x,y);
        Relative;
        FillPat(FillPat2);
        Arc(-r,r,r,-r,i*90+Phi,360-2*Phi);
        FillPat(FillPat1);
    END;
END;

PROCEDURE DrawCoil3b(x,y,D,P,wd:REAL; Direction:INTEGER);
VAR
    i,r,x0,y0,a,a1,b,c,e : REAL;
    Alpha,Beta,Theta : REAL;
BEGIN
    r:=wd/2;
    i:=Direction;
    Theta:=ArcTan(P/(2*D));
    Alpha:=(PI/3 + Theta)/2;
    b:=wd/(2*Tan(Alpha));
    a:=wd/(2*Tan(Theta)) - wd/(4*Sin(Theta));
    Beta:=ArcTan(2*a/wd);
    c:=wd*Tan(Beta+Theta)/4;
    e:=c + wd*Sin(PI/3)/2;
    x0:=x+i*(r*(Sin(Theta)-Cos(Theta)));
    y0:=y-i*(r*(Cos(Theta)+Sin(Theta)));
    Absolute;
    MoveTo(x0,y0);
    Relative;
    AngleVar;
    BeginPoly;
        ArcTo(0,#0,r);
        ArcTo(i*(wd/2 + D/Cos(Theta) + b), #Rad2Deg(Theta),r);
        LineTo(i*b,#120);
        LineTo(i*e,#180);
        ArcTo(i*(D/Cos(Theta) + wd/2 - a),#(180+Rad2Deg(Theta)),r);
    EndPoly;
    NoAngleVar;
END;

PROCEDURE DrawCoil4a(x,y,D,P,wd:REAL; Direction:INTEGER);
VAR
    a,b,c,e,Beta,Beta2,dx3,dy3,dx4 : REAL;
    i,r,x0,y0,y1,dy1,dy2,Theta2 : REAL;
BEGIN
    r:=wd/2;
    i:=Direction;
    dy1:=(wd-P/2)/2;
    IF dy1 < 0 THEN dy1:=0;
    dy2:=wd/2 - dy1;
    a:=D^2 + dy1^2;
    b:=-2*r*D;
    c:=r^2 - dy1^2;
    e:=(-b-Sqrt(b^2 - 4*a*c))/(2*a);
    Theta2:=ArcSin(e);
    Beta:=(PI/2+Theta2)/2;
    y1:=r*Tan(Beta);
    x0:=x{+i*D}-i*r;
    y0:=y-i*(P/2 + dy1 + r);
    Absolute;
    MoveTo(x0,y0);
    Relative;
    ClosePoly;
    BeginPoly;
        LineTo(0,0);
        {LineTo(-i*(D+r),0);
        ArcTo(0,i*y1,r);
        LineTo(i*(D+r),-i*(y1-dy1));}
        ArcTo(0,i*y1,r);
        IF dy1 <> 0 THEN BEGIN
            Beta2:=ArcCos(Cos(Theta2)-dy1/r) - Theta2;
            dx3:=r*Tan(Beta2/2)*Cos(Theta2);
            dy3:=r*Tan(Beta2/2)*Sin(Theta2);
            dy1:=dy1-dy3;
            dx4:=r*Tan(Beta2/2)*Sin(Beta2+Theta2);
            ArcTo(i*(D+r*(1+Sin(Theta2))+dx3),-i*(y1-dy1),r);
            LineTo(i*dx4,-i*dy1);
        END
        ELSE
            LineTo(i*(D+r),-i*y1);
    EndPoly;
    IF Section THEN BEGIN
        Absolute;
        MoveTo(x,y0);
        Relative;
        FillPat(FillPat2);
        Arc(-r,r,r,-r,180,-i*180);
        FillPat(FillPat1);
    END;
END;

PROCEDURE DrawCoil4b(x,y,D,P,wd:REAL; Direction:INTEGER);
VAR
    i,r,x0,y0,y1,dy1,y2,dy2,y3,y4 : REAL;
    a,b,c,Alpha,SinAlpha,Beta,Theta2 : REAL;
BEGIN
    r:=wd/2;
    i:=Direction;
    dy1:=(wd-P/2)/2;
    IF dy1 < 0 THEN dy1:=0;
    dy2:=wd/2 - dy1;
    y1:=P/2 + dy1 + r;
    Theta2:=ArcTan((dy1+r)/D);
    Beta:=(PI/2-Theta2)/2;
    y2:=r*Tan(Beta);
    y3:=r/Tan(Beta);
    y4:=y1-P/2+y3-y2;
    a:=(D+r)^2 + (dy1+r)^2;
    b:=2*(D+r)*r;
    c:=r^2 - (dy1+r)^2;
    SinAlpha:=(-b + Sqrt(b^2 - 4*a*c))/(2*a);
    Alpha:=ArcSin(SinAlpha);
    x0:=x-i*r;
    y0:=y-i*y1;
    Absolute;
    MoveTo(x0,y0);
    Relative;
    ClosePoly;
    AngleVar;
    BeginPoly;
        LineTo(0,0);
        ArcTo(i*y2,#90,r);
        ArcTo(-i*(r + D/Cos(Theta2) + r*Tan(Beta)),#(Rad2Deg(Theta2))-180,r);
    LineTo(-i*r*(1+tan((Theta2-Alpha)/2)),#(90+Rad2Deg(Theta2)));
    ArcTo(-i*r*(1+tan((Theta2-Alpha)/2)),#(90+Rad2Deg(Alpha)),r);
    EndPoly;
END;

PROCEDURE DrawActiveCoils(x0,y0,D,P,wd:REAL; NCoilsF,NCoilsB:INTEGER);
VAR
    x,y : REAL;
    j : INTEGER;
BEGIN
    Absolute;
    x:=x0;
    y:=y0-(NCoilsF-1)*P;
    MoveTo(x,y);
    Relative;
    FOR j:=1 TO NCoilsB DO BEGIN
        IF NOT SECTION THEN
            DrawCoil(x,y,D,P,wd,1);
        y:=y+P;
    END;
    FOR j:=1 TO NCoilsF DO BEGIN
        DrawCoil(x,y,D,P,wd,-1);
        y:=y-P;
    END;
END;

PROCEDURE DrawEnds(x0,y0,D,P,wd:REAL; NCoils,TNCoils,Type:INTEGER);
VAR
    x,y,AlphaR,AlphaL,Beta,Theta,P1,P2 : REAL;
    cR,cL,x1,y1,x2R,y2R,x2L,y2L : REAL;
    i,j,n : INTEGER;
BEGIN
    IF Type=1 THEN BEGIN
        x:=x0;
        y:=y0-(NCoils-1)*P;
        IF NOT Section THEN
            DrawCoil(x,y,D,P,wd,1);
        DrawCoil1(x,y,D,P,wd,1);
        x:=x0;
        y:=y0;
        IF NOT Section THEN
            DrawCoil(x,y,D,P,wd,1);
        x:=x0+D;
        y:=y0+P/2;
        DrawCoil1(x,y,D,P,wd,-1);
    END
    ELSE IF Type=2 THEN BEGIN
        Theta:=ArcTan(P/(2*D));
        P1:=P/4 + wd/(2*Cos(Theta)) + wd/2;
        P2:=2*(P1-P/2);
        x:=x0;
        y:=y0 - (NCoils*P + P1);
        IF NOT Section THEN
            DrawCoil(x,y,D,P2,wd,1);
        DrawCoil1(x,y,D,0,wd,1);
        x:=x0;
        y:=y0;
        IF NOT Section THEN
            DrawCoil(x,y,D,P2,wd,1);
        x:=x0+D;
        y:=y0 - P/2 + P1;
        DrawCoil1(x,y,D,0,wd,-1);
    END
    ELSE IF Type=3 THEN BEGIN
        x:=x0;
        y:=y0;
        IF NOT Section THEN
            DrawCoil3b(x,y,D,P,wd,1);
        x:=x0+D;
        y:=y0+P/2;
        DrawCoil3a(x,y,D,P,wd,1);
        y:=y0-(NCoils-1/2)*P;
        IF NOT Section THEN
            DrawCoil3b(x,y,D,P,wd,-1);
        x:=x0;
        y:=y0-NCoils*P;
        DrawCoil3a(x,y,D,P,wd,-1);
    END
    ELSE BEGIN
        x:=x0;
        y:=y0-NCoils*P;
        IF NOT Section THEN
            DrawCoil4b(x,y,D,P,wd,1);
        DrawCoil4a(x,y,D,P,wd,1);
        x:=x0+D;
        y:=y0-P/2;
        IF NOT Section THEN
            DrawCoil4b(x,y,D,P,wd,-1);
        DrawCoil4a(x,y,D,P,wd,-1);
    END;
END;

{
Main Program.
}
BEGIN
    DSelectAll;

{
Display the dialog box and get the information.
}
    SpringDialog;
    SetCursor(ArrowC);
    GetInfo;
    IF Abort THEN GOTO 99;

{
Get drawing units and adjust parameters.
}
    GetUnits(UName,DA,Fmt,UPI,UM,UM2);
    IF Inch THEN
        sf:=UPI
    ELSE
        sf:=UPI/25.4;
    OD:=OD*sf;
    wd:=wd*sf;
    FL:=FL*sf;
    SH:=SH*sf;
    WL:=WL*sf;
    D:=D*sf;
    P:=P*sf;
    PushAttrs;
    FillPat(1);
{
Get the location of the spring.
}
    GetPt(x0,y0);
{
Calculate spring parameters.
}
    IF Method = 1 THEN BEGIN
        D:=OD-wd;
        IF Type = 1 THEN BEGIN
            TNCoils:=(SH-wd)/wd;
            NCoils:=TNCoils;
            P:=(WL-wd)/TNCoils;
            NCoilsF:=NCoils-1;
            NCoilsB:=NCoils-2;
            x0:=x0-D/2;
            y0:=y0+(NCoils-3/2)*P/2;
        END
        ELSE IF Type = 2 THEN BEGIN
            TNCoils:=(SH-3*wd)/wd + 2;
            NCoils:=TNCoils - 2;
            P:=(WL-3*wd)/(TNCoils-2);
            NCoilsF:=NCoils+1;
            NCoilsB:=NCoils;
            x0:=x0-D/2;
            y0:=y0+(NCoils+1/2)*P/2;
        END
        ELSE IF Type = 3 THEN BEGIN
            TNCoils:=SH/wd;
            NCoils:=TNCoils - 1;
            P:=(WL-wd/2)/(NCoils+1/2);
            NCoilsF:=NCoils;
            NCoilsB:=NCoils-1;
            x0:=x0-D/2;
            y0:=y0+(NCoils-1/2)*P/2;
        END
        ELSE BEGIN
            TNCoils:=(SH-2*wd)/wd + 2;
            NCoils:=TNCoils - 2;
            P:=(WL-2*wd)/(TNCoils-2);
            NCoilsF:=NCoils+1;
            NCoilsB:=NCoils;
            x0:=x0-D/2;
            y0:=y0+(NCoils+1/2)*P/2;
        END;
    END
    ELSE BEGIN
        IF Type = 1 THEN BEGIN
            TNCoils:=NCoils;
            WL:=TNCoils*P+wd;
            NCoilsF:=NCoils-1;
            NCoilsB:=NCoils-2;
            x0:=x0-D/2;
            y0:=y0+(NCoils-3/2)*P/2;
        END
        ELSE IF Type=2 THEN BEGIN
            TNCoils:=NCoils + 2;
            NCoilsF:=NCoils+1;
            NCoilsB:=NCoils;
            WL:=NCoils*P+3*wd;
            x0:=x0-D/2;
            y0:=y0+(NCoils+1/2)*P/2;
        END
        ELSE IF Type = 3 THEN BEGIN
            TNCoils:=NCoils + 1;
            NCoilsF:=NCoils;
            NCoilsB:=NCoils-1;
            WL:=TNCoils*P;
            x0:=x0-D/2;
            y0:=y0+(NCoils-1/2)*P/2;
        END
        ELSE BEGIN
            TNCoils:=NCoils + 2;
            NCoilsF:=NCoils+1;
            NCoilsB:=NCoils;
            WL:=NCoils*P+2*wd;
            x0:=x0-D/2;
            y0:=y0+(NCoils+1/2)*P/2;
        END;
    END;

{
Draw spring.
}

    DrawEnds(x0,y0+WL/2,D,P,wd,NCoils,TNCoils,Type);
    DrawActiveCoils(x0,y0+WL/2,D,P,wd,NCoilsF,NCoilsB);
    Group;
    PopAttrs;
99:END;    {of CompressionSprings}

Procedure ConicalCompSprings;
{
(c)1997, Diehl Graphsoft, Inc.
Developed by Tom Urie

This procedure draws a conical compression spring.
}
LABEL 10,90,99;

CONST
    Fillpat1=1;
    Fillpat2=24;
    MaxCoils=25;
    MaxCoils2=50;

VAR
    DS,DL,L,ODL,ODS,P,wd : REAL;
    x0,y0,x,y,dy,F,p1,p2,q1,q2,q3,q4 : REAL;
    a,b,c,s1,s2,s3,s4 : REAL;
    Theta1,Theta2,Theta3,Theta4 : REAL;
    x1,x2,y1,y2 : ARRAY[1..MaxCoils] OF REAL;
    k,m,n,NCoils : Integer;

    Abort,Inch,Section : BOOLEAN;

    sf,UPI : REAL;
    Fmt : INTEGER;
    UM,UM2 : STRING;
    UName,DA : LONGINT;

Procedure SpringDialog;
{
This procedure defines the dialog box.
}
VAR
    Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;

Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
VAR
    scrx1,scry1,scrx2,scry2:INTEGER;
BEGIN
    GetScreen(scrx1,scry1,scrx2,scry2);
    x1:=((scrx1+scrx2) div 2)-(Width div 2);
    x2:=x1+Width;
END;

Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
{
This procedure locates the 'OK' and 'Cancel' buttons.
}
VAR
    v1,v2,v3,v4 : INTEGER;
    Mac : BOOLEAN;

Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
VAR
    Temp : INTEGER;
BEGIN
    Temp:=m1;
    m1:=m3;
    m3:=Temp;
    Temp:=m2;
    m2:=m4;
    m4:=Temp;
END;        {of Swap}

BEGIN
    Mac:=FALSE;
    GetVersion(v1,v2,v3,v4);
    IF v4 = 1 THEN Mac:=TRUE;

    IF DialogType = 1 THEN
    BEGIN
        px1:=(scnw DIV 2) - 80;
        px2:=(scnw DIV 2) - 10;
        px3:=(scnw DIV 2) + 10;
        px4:=(scnw DIV 2) + 80;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE IF DialogType = 2 THEN
    BEGIN
        px1:=scnw - 180;
        px2:=scnw - 110;
        px3:=scnw - 90;
        px4:=scnw - 20;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE
    BEGIN
        px1:=scnw - 90;
        px2:=scnw - 20;
        px3:=px1;
        px4:=px2;

        py1:=scnh -70;
        py2:=scnh - 50;
        py3:=scnh - 40;
        py4:=scnh - 20;
        IF Mac THEN SWAP(py1,py2,py3,py4);
    END;
END;        {of Locate Buttons}

Procedure MakeDialog2;
CONST
    y1=100;
    scnw = 280;
    scnh = 250;
    DialogType = 2;

VAR
        h : INTEGER;

BEGIN
    AlignScr(scnw,x1,x2);
    y2:=y1+scnh;
    LocateButtons(DialogType,scnh,scnw);

    BeginDialog(2,1,x1,y1,x2,y2);
        AddButton('OK',1,1,px1,py1,px2,py2);
        AddButton('Cancel',2,1,px3,py3,px4,py4);

        h:=0;
        AddField('Units:',22,1,20,9+h,60,25+h);
        AddButton('Inch',23,3,65,10+h,115,25+h);
        AddButton('mm',24,3,120,10+h,165,25+h);

        h:=-10;
        AddField('OD - Large End:',4,1,20,44+h,130,60+h);
        AddField('',5,2,155,45+h,230,60+h);
        AddField('OD - Small End:',6,1,20,69+h,130,85+h);
        AddField('',7,2,155,70+h,230,85+h);
        AddField('Wire Diameter:',8,1,20,94+h,130,110+h);
        AddField('',9,2,155,95+h,230,110+h);
        AddField('Length:',10,1,20,119+h,130,135+h);
        AddField('',11,2,155,120+h,230,135+h);
        AddField('No. of Active Coils:',12,1,20,144+h,150,160+h);
        AddField('',13,2,155,145+h,230,160+h);

        AddField('',30,1,240,44+h,275,60+h);
        AddField('',31,1,240,69+h,275,85+h);
        AddField('',32,1,240,94+h,275,110+h);
        AddField('',33,1,240,119+h,275,135+h);

        h:=-20;
        AddButton('Section View',18,2,20,185+h,500,200+h);
    EndDialog;
END;

BEGIN
    MakeDialog2;
END;

Procedure GetInfo;
{
This procedure displays the dialog box and retrieves the information.
}
LABEL 5,10,20,99;
VAR
    Value : REAL;
    Item,Field,k,NTimes,NPlaces : INTEGER;
    RFlag : ARRAY[1..20] OF INTEGER;
    Done : BOOLEAN;

Procedure SetRButton(i,Item : INTEGER);
BEGIN
    IF RFlag[i] <> Item THEN BEGIN
        SetItem(RFlag[i],FALSE);
        SetItem(Item,TRUE);
        RFlag[i]:=Item;
    END;
END;

PROCEDURE SetUnitsField(Inch:BOOLEAN);
VAR
    Field,k : INTEGER;
    UnitsM : STRING;
BEGIN
    IF Inch THEN UnitsM:='in'
    ELSE UnitsM:='mm';
    Field:=29;
    FOR k:=1 TO 4 DO
    BEGIN;
        Field:=Field+1;
        SetField(Field,UnitsM);
    END;
END;

BEGIN
    Inch:=TRUE;
    Section:=FALSE;

    ODL:=2.000;
    ODS:=0.750;
    wd:=0.125;
    L:=1.8125;
    NCoils:=6;

    5:Done:=FALSE;
    Abort:=FALSE;
    IF Inch Then RFlag[1]:=23
    ELSE RFlag[1]:=24;
    GetDialog(2);
    SetTitle('Conical Compression Springs');
    SetUnitsField(Inch);
    SetItem(RFlag[1],TRUE);
    SetItem(18,Section);
    SetField(5,Num2StrF(ODL));
    SetField(7,Num2StrF(ODS));
    SetField(9,Num2StrF(wd));
    SetField(11,Num2StrF(L));
    SetField(13,Num2Str(0,NCoils));
    SelField(5);
    10:REPEAT
        DialogEvent(Item);
        IF Item=1 then
            Done:=True;
        IF Item=2 then BEGIN
            Done:=TRUE;
            Abort:=TRUE;
        END;
        IF Item=18 THEN
        BEGIN
            SetItem(Item,NOT Section);
            Section:=NOT Section;
        END;
        IF (Item=23) AND (NOT Inch) THEN
        BEGIN
            SetRButton(1,Item);
            Inch:=TRUE;
            SetUnitsField(Inch);
        END;
        IF (Item=24) AND (Inch) THEN
        BEGIN
            SetRButton(1,Item);
            Inch:=FALSE;
            SetUnitsField(Inch);
        END;
    UNTIL Done;
    IF Abort THEN GOTO 99;
    Field:=3;
    FOR k:=1 TO 5 DO
    BEGIN
        Field:=Field+2;
        IF Str2Num(GetField(Field))>0 THEN GOTO 20;
        SysBeep;
        SelField(Field);
        Done:=False;
        GOTO 10;
    20:END;
        ODL:=Str2Num(GetField(5));
        ODS:=Str2Num(GetField(7));
        wd:=Str2Num(GetField(9));
        L:=Str2Num(GetField(11));
        NCoils:=Str2Num(GetField(13));
    99:ClrDialog;
END;

Procedure DrawCoil(x1,y1,x2,y2,wd : REAL);
VAR
    r,L,Theta,x0,y0 : REAL;
BEGIN
    r:=wd/2;
    L:=Distance(x1,y1,x2,y2);
    Theta:=ArcCos((x2-x1)/L);
    IF y2 < y1 THEN
    Theta:=2*PI-Theta;
    x0:=x1-r*Cos(Theta)-r*Sin(Theta);
    y0:=y1-r*Sin(Theta)+r*Cos(Theta);
    Theta:=Rad2Deg(Theta);
    Absolute;
    MoveTo(x0,y0);
    Relative;
    AngleVar;
    ClosePoly;
    BeginPoly;
        ArcTo((L+2*r),#Theta,r);
        ArcTo((2*r),#(Theta-90),r);
        ArcTo(-(L+2*r),#Theta,r);
        ArcTo(-(2*r),#(Theta-90),r);
    EndPoly;
    NoAngleVar;
    IF Section THEN BEGIN
        Absolute;
        MoveTo(x1,y1);
        Relative;
        FillPat(FillPat2);
        Arc(-r,r,r,-r,0,360);
        Absolute;
        MoveTo(x2,y2);
        Relative;
        Arc(-r,r,r,-r,0,360);
        FillPat(FillPat1);
    END;
END;

{
Main Program.
}
BEGIN
    DSelectAll;

{
Display the dialog box and get the information.
}
    SpringDialog;
    SetCursor(ArrowC);
    GetInfo;
    IF Abort THEN GOTO 99;
{
Get drawing units and adjust parameters.
}
    GetUnits(UName,DA,Fmt,UPI,UM,UM2);
    IF Inch THEN
        sf:=UPI
    ELSE
        sf:=UPI/25.4;
    ODL:=ODL*sf;
    ODS:=ODS*sf;
    wd:=wd*sf;
    L:=L*sf;
    PushAttrs;
    FillPat(1);
{
Get the location of the spring.
}
    GetPt(x0,y0);
{
Calculate spring parameters.
}
    n:=NCoils;
    DS:=ODS-wd;
    DL:=ODL-wd;
    Theta1:=ArcSin(wd/DS);
    s1:=DS*Cos(Theta1)+wd;
    p1:=s1*Sin(Theta1);
    q1:=s1*Cos(Theta1);

    a:=1+(wd/DL)^2;
    b:=2*(wd/DL)^2;
    c:=(wd/DL)^2 - 1;
    Theta2:=ArcCos((-b+Sqrt(b^2-4*a*c))/(2*a));
    s2:=DL*Cos(Theta2) - wd/2;
    p2:=s2*Sin(Theta2);
    q2:=s2*Cos(Theta2);

    s3:=L-wd-p1;
    q3:=DL/2-q1+DS/2;
    Theta3:=ArcTan(q3/s3);

    s4:=L-wd-p2;
    q4:=q2-DL/2-DS/2;
    Theta4:=ArcTan(q4/s4);

    m:=n-1;
    F:=m*(m+1)/2;

    y1[1]:=0;                x1[1]:=DS/2;
    y1[2]:=p1;                x1[2]:=q1-DS/2;
    FOR k:=3 TO n DO
    BEGIN
        dy:=(k-2)*s3/F;
        IF dy<wd THEN dy:=wd;
        y1[k]:=y1[k-1]+dy;
        x1[k]:=x1[k-1]+dy*Tan(Theta3);
    END;
    y1[n+1]:=L-wd;        x1[n+1]:=DL/2;

    y2[1]:=0;            x2[1]:=DS/2;
    dy:=p1 + (y1[3]-y1[2])/2;
    y2[2]:=dy;            x2[2]:=DS/2+dy*Tan(Theta4);
    FOR k:=3 TO n-1 DO
    BEGIN
        dy:=(y1[k+1]-y1[k-1])/2;
        y2[k]:=y2[k-1]+dy;
        x2[k]:=x2[k-1]+dy*Tan(Theta4);
    END;
    y2[n]:=s4;                x2[n]:=q2-DL/2;
    y2[n+1]:=L-wd;        x2[n+1]:=DL/2;

{
Draw spring.
}
    x:=x0;            y:=y0+L-wd/2;
    FOR k:=1 TO n+1 DO
    BEGIN
        DrawCoil(x-x1[k],y-y1[k],x+x2[k],y-y2[k],wd);
    END;
    IF Section THEN GOTO 90;
        FOR k:=1 TO n DO
    BEGIN
        DrawCoil(x-x1[k+1],y-y1[k+1],x+x2[k],y-y2[k],wd);
    END;
    Absolute;
    MoveTo(x-x1[1], y);
    Relative;
    Arc(-wd/2,wd/2,wd/2,-wd/2,0,360);
    Absolute;
    MoveTo(x, y-L+wd/2);
    Relative;
    BeginPoly;
        LineTo(0,0);
        ArcTo(ODL/2,0,wd/2);
        ArcTo(0,wd,wd/2);
        LineTo(-ODL/2,0);
        LineTo(0,-wd);
    EndPoly;
    90:Group;
    PopAttrs;
99:END;    {of ConicalCompSprings}


Procedure DieSprings;
{
(c)1997, Diehl Graphsoft, Inc.
Developed by Tom Urie

This procedure draws a heavy duty rectangular wire die spring.
}
LABEL 5,10,90,99;

CONST
    Fillpat1=1;
    Fillpat2=24;

VAR
    A,D,FL,ID,SD,OD,HD,P,wh,ww,SH,WL : REAL;
    x0,y0,q1,q2,q3,q4,Theta1,Theta2 : REAL;
    Clearance : REAL;

    k,nCoils : INTEGER;

    Abort,Inch,Section : BOOLEAN;

    sf,UPI : REAL;
    Fmt : INTEGER;
    UM,UM2 : STRING;
    UName,DA : LONGINT;

Procedure SpringDialog;
{
This procedure defines the dialog box.
}
VAR
    Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;

Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
VAR
    scrx1,scry1,scrx2,scry2:INTEGER;
BEGIN
    GetScreen(scrx1,scry1,scrx2,scry2);
    x1:=((scrx1+scrx2) div 2)-(Width div 2);
    x2:=x1+Width;
END;

Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
{
This procedure locates the 'OK' and 'Cancel' buttons.
}
VAR
    v1,v2,v3,v4 : INTEGER;
    Mac : BOOLEAN;

Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
VAR
    Temp : INTEGER;
BEGIN
    Temp:=m1;
    m1:=m3;
    m3:=Temp;
    Temp:=m2;
    m2:=m4;
    m4:=Temp;
END;        {of Swap}

BEGIN
    Mac:=FALSE;
    GetVersion(v1,v2,v3,v4);
    IF v4 = 1 THEN Mac:=TRUE;

    IF DialogType = 1 THEN
    BEGIN
        px1:=(scnw DIV 2) - 80;
        px2:=(scnw DIV 2) - 10;
        px3:=(scnw DIV 2) + 10;
        px4:=(scnw DIV 2) + 80;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE IF DialogType = 2 THEN
    BEGIN
        px1:=scnw - 180;
        px2:=scnw - 110;
        px3:=scnw - 90;
        px4:=scnw - 20;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE
    BEGIN
        px1:=scnw - 90;
        px2:=scnw - 20;
        px3:=px1;
        px4:=px2;

        py1:=scnh -70;
        py2:=scnh - 50;
        py3:=scnh - 40;
        py4:=scnh - 20;
        IF Mac THEN SWAP(py1,py2,py3,py4);
    END;
END;        {of Locate Buttons}

Procedure MakeDialog3;
CONST
    y1=100;
    scnw = 320;
    scnh = 270;
    DialogType = 2;

VAR
    h : INTEGER;

BEGIN
    AlignScr(scnw,x1,x2);
    y2:=y1+scnh;
    LocateButtons(DialogType,scnh,scnw);

    BeginDialog(3,1,x1,y1,x2,y2);
        AddButton('OK',1,1,px1,py1,px2,py2);
        AddButton('Cancel',2,1,px3,py3,px4,py4);

        h:=0;
        AddField('Units:',22,1,20,9+h,60,25+h);
        AddButton('Inch',23,3,65,10+h,115,25+h);
        AddButton('mm',24,3,120,10+h,165,25+h);

        h:=-5;
        AddField('Fits in Hole Size:',4,1,20,44+h,130,60+h);
        AddField('',5,2,145,45+h,260,60+h);

        AddField('Fits Over Shaft:',6,1,20,69+h,130,85+h);
        AddField('',7,2,145,70+h,260,85+h);

        AddField('Wire Size (t x w):',8,1,20,94+h,140,110+h);
        AddField('',9,2,145,95+h,190,110+h);
        AddField('x',10,1,199,92+h,207,107+h);
        AddField('',11,2,215,95+h,260,110+h);

        AddField('Free Length:',12,1,20,119+h,130,135+h);
        AddField('',13,2,145,120+h,260,135+h);

        AddField('Solid Height:',14,1,20,144+h,130,160+h);
        AddField('',15,2,145,145+h,260,160+h);

        AddField('Working Length:',16,1,20,169+h,130,185+h);
        AddField('',17,2,145,170+h,260,185+h);

        AddField('',30,1,270,44+h,305,60+h);
        AddField('',31,1,270,69+h,305,85+h);
        AddField('',32,1,270,94+h,305,110+h);
        AddField('',33,1,270,119+h,305,135+h);
        AddField('',34,1,270,144+h,305,160+h);
        AddField('',35,1,270,169+h,305,185+h);

        h:=10;
AddButton('Section View',18,2,20,185+h,500,200+h);

    EndDialog;
END;

BEGIN
    MakeDialog3;
END;

Procedure GetInfo;
{
This procedure displays the dialog box and retrieves the information.
}
LABEL 5,10,20,99;
CONST
    NumParams=7;
VAR
    Value : REAL;
    Param : ARRAY[1..NumParams] OF REAL;
    Item,Field,j,k,NTimes,NPlaces : INTEGER;
    RFlag : ARRAY[1..20] OF INTEGER;
    Done,OK : BOOLEAN;

Procedure SetRButton(i,Item : INTEGER);
BEGIN
    IF RFlag[i] <> Item THEN BEGIN
        SetItem(RFlag[i],FALSE);
        SetItem(Item,TRUE);
        RFlag[i]:=Item;
    END;
END;

PROCEDURE SetUnitsField(Inch:BOOLEAN);
VAR
    Field,k : INTEGER;
    UnitsM1,UnitsM2 : STRING;
BEGIN
    IF Inch THEN
        UnitsM1:='in'
    ELSE
        UnitsM1:='mm';
    Field:=29;
    FOR k:=1 TO 6 DO
    BEGIN;
        Field:=Field+1;
        SetField(Field,UnitsM1);
    END;
END;

BEGIN
    NTimes:=NTimes+1;
    IF NTimes > 1 THEN GOTO 5;

    Inch:=TRUE;
    Section:=FALSE;

    Param[1]:=1.500;
    Param[2]:=0.750;
    Param[3]:=0.135;
    Param[4]:=0.345;
    Param[5]:=3.000;
    Param[6]:=1.150;
    Param[7]:=2.000;

    5:Done:=FALSE;
    Abort:=FALSE;
    IF Inch Then RFlag[1]:=23
    ELSE RFlag[1]:=24;
    GetDialog(3);
    SetTitle('Heavy Duty Rect. Wire Die Springs');
    SetUnitsField(Inch);
    SetItem(RFlag[1],TRUE);
    SetItem(18,Section);

    j:=3;
    FOR k:=1 TO NumParams DO
    BEGIN
        j:=j+2;
        SetField(j,Num2Str(3,Param[k]));
    END;
    SelField(5);

    10:REPEAT
        DialogEvent(Item);
        IF Item=1 then
            Done:=True;

        IF Item=2 then BEGIN
            Done:=TRUE;
            Abort:=TRUE;
        END;

        IF Item=18 THEN
        BEGIN
            SetItem(Item,NOT Section);
            Section:=NOT Section;
        END;

        IF (Item=23) AND (NOT Inch) THEN
        BEGIN
            SetRButton(1,Item);
            Inch:=TRUE;
            SetUnitsField(Inch);
        END;

        IF (Item=24) AND (Inch) THEN
        BEGIN
            SetRButton(1,Item);
            Inch:=FALSE;
            SetUnitsField(Inch);
        END;

    UNTIL Done;
    IF Abort THEN GOTO 99;
    Field:=3;
    FOR k:=1 TO 6 DO
    BEGIN
        Field:=Field+2;
        IF Str2Num(GetField(Field))>0 THEN GOTO 20;
        SysBeep;
        SelField(Field);
        Done:=False;
        GOTO 10;
    20:END;
    j:=3;
    FOR k:=1 TO NumParams DO
    BEGIN
        j:=j+2;
        OK:=ValidNumStr(GetField(j),Param[k]);
        IF (NOT OK) OR (Param[k]<=0) THEN
        BEGIN
            SysBeep;
            SelField(j);
            Done:=FALSE;
            GOTO 10;
        END;
    END;

    HD:=Param[1];
    SD:=Param[2];
    wh:=Param[3];
    ww:=Param[4];
    FL:=Param[5];
    SH:=Param[6];
    WL:=Param[7];

    IF WL >= SH THEN GOTO 99;
    SysBeep;
    SelField(17);
    Done:=FALSE;
    GOTO 10;
    99:ClrDialog;
END;

{
Main Program.
}
BEGIN
    DSelectAll;

{
Display the dialog box and get the information.
}
    SpringDialog;
    SetCursor(ArrowC);
    GetInfo;
    IF Abort THEN GOTO 99;
{
Get drawing units and adjust parameters.
}
    GetUnits(UName,DA,Fmt,UPI,UM,UM2);
    IF Inch THEN
        sf:=UPI
    ELSE
        sf:=UPI/25.4;
    Clearance:=(HD-SD-2*ww)/4;
    OD:=(HD-2*Clearance)*sf;
    ID:=(OD-2*ww)*sf;
    wh:=wh*sf;
    ww:=ww*sf;
    FL:=FL*sf;
    SH:=SH*sf;
    WL:=WL*sf;
    PushAttrs;
    FillPat(1);
{
Get the location of the spring.
}
    GetPt(x0,y0);
{
Calculate spring parameters.
}
    NCoils:=SH/wh - 0.5;
    P:=(WL-wh)/(NCoils - 1/2);
    Theta1:=ArcTan(P/(2*OD));
    q1:=ww*Tan(Theta1);
    IF P/2 < wh THEN
        Theta2:=ArcTan((wh-P/2)/OD)
    ELSE Theta2:=0;
    q2:=ww*Tan(Theta2);
    q3:=(ww+ID)*Tan(Theta2);
    q4:=OD*Tan(Theta2);

{
Draw spring.

{
Draw rear active coils.
}
    IF (SH=WL) AND (NOT Section) THEN GOTO 5;
    Absolute;
    MoveTo(x0+OD/2,y0-P/2);
    Relative;
    FOR k:=1 TO NCoils-1 DO
    BEGIN
        Move(0,P);
        Poly(0,0, -OD,P/2, 0,wh, OD,-P/2, 0,-wh);
    END;

{
Draw front active coils (normal view);
}
    5:IF Section THEN GOTO 10;
    Absolute;
    MoveTo(x0-OD/2,y0-P);
    Relative;
    FOR k:=1 TO NCoils DO
    BEGIN
        Move(0,P);
        Poly(0,0, OD,P/2, 0,wh, -OD,-P/2, 0,-wh);
    END;

{
Draw end coils - normal view.
}
    Absolute;
    MoveTo(x0-OD/2,y0);
    Relative;
    Poly(0,0, OD,0, 0,P/2, -OD,-P/2);
    Absolute;
    MoveTo(x0+OD/2,y0+WL);
    Relative;
    Poly(0,0, -OD,0, 0,-P/2, OD,P/2);
    GOTO 90;

{
Draw end coils - section view.
}
    10:Absolute;
    MoveTo(x0-OD/2,y0);
    Relative;
    FillPat(1);
    Poly(0,0, 0,wh, OD,-q4, 0,-P/2, -OD,0);
    FillPat(FillPat2);
    Poly(0,0, 0,wh, ww,0, 0,-wh, -ww,0);
    Move(OD,0);
    Poly(0,0, 0,(wh-q4), -ww,0, 0,-(wh-q4), ww,0);

    Absolute;
    MoveTo(x0+OD/2,y0+WL);
    Relative;
    FillPat(1);
    Poly(0,0, 0,-wh, -OD,q4, 0,P/2, OD,0);
    FillPat(FillPat2);
    Poly(0,0, 0,-wh, -ww,0, 0,wh, ww,0);
    Move(-OD,0);
    Poly(0,0, 0,-(wh-q4), ww,0, 0,(wh-q4), -ww,0);

{
Draw sections - active coils.
}
    Absolute;
    MoveTo(x0-OD/2,y0);
    Relative;
    FillPat(FillPat2);
    FOR k:=1 TO NCoils-1 DO
    BEGIN
        Move(OD,P/2);
        Rect(0,0,-ww,wh);
        Move(-OD,P/2);
        Rect(0,0,ww,wh);
    END;

    90:Group;
    PopAttrs;
99:END;    {of DieSprings}

Procedure ExtensionSprings;
{
(c)1997, Diehl Graphsoft, Inc.
Developed by Tom Urie

This procedure draws an extension spring.
}

LABEL 5,10,20,30,99;

CONST
    Hf2=1.00;
    G_MW = 12.0e6;
    G_SS = 10.0e6;
    LBperSqIn2NperSqMM = 6.8947e-3;
    ShowCoils = 3;
    PP1 = -10;

VAR
    D,HL,ID,LCF,LCW,FL,OD,P,WL,wd : REAL;
    x0,y0,x1,y1,x2,y2,R_MW,R_SS : REAL;

    k,n,NCoils,s,Type,View : Integer;

    Abort,Inch,ShowAllCoils : BOOLEAN;

    sf,UPI : REAL;
    Fmt : INTEGER;
    UM,UM2 : STRING;
    UName,DA : LONGINT;

Procedure SpringDialog;
{
This procedure defines the dialog box.
}
VAR
    Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;

Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
VAR
    scrx1,scry1,scrx2,scry2:INTEGER;

BEGIN
    GetScreen(scrx1,scry1,scrx2,scry2);
    x1:=((scrx1+scrx2) div 2)-(Width div 2);
    x2:=x1+Width;
END;

Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
{
This procedure locates the 'OK' and 'Cancel' buttons.
}
VAR
    v1,v2,v3,v4 : INTEGER;
    Mac : BOOLEAN;

Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
VAR
    Temp : INTEGER;
BEGIN
    Temp:=m1;
    m1:=m3;
    m3:=Temp;
    Temp:=m2;
    m2:=m4;
    m4:=Temp;
END;        {of Swap}

BEGIN
    Mac:=FALSE;
    GetVersion(v1,v2,v3,v4);
    IF v4 = 1 THEN Mac:=TRUE;

    IF DialogType = 1 THEN
    BEGIN
        px1:=(scnw DIV 2) - 80;
        px2:=(scnw DIV 2) - 10;
        px3:=(scnw DIV 2) + 10;
        px4:=(scnw DIV 2) + 80;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE IF DialogType = 2 THEN
    BEGIN
        px1:=scnw - 180;
        px2:=scnw - 110;
        px3:=scnw - 90;
        px4:=scnw - 20;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE
    BEGIN
        px1:=scnw - 90;
        px2:=scnw - 20;
        px3:=px1;
        px4:=px2;

        py1:=scnh -70;
        py2:=scnh - 50;
        py3:=scnh - 40;
        py4:=scnh - 20;
        IF Mac THEN SWAP(py1,py2,py3,py4);
    END;
END;        {of Locate Buttons}

Procedure MakeDialog4;
CONST
    y1=100;
    scnw = 420;
    scnh = 270;
    DialogType = 2;

VAR
    h : INTEGER;

BEGIN
    AlignScr(scnw,x1,x2);
    y2:=y1+scnh;
    LocateButtons(DialogType,scnh,scnw);

    BeginDialog(4,1,x1,y1,x2,y2);
        AddButton('OK',1,1,px1,py1,px2,py2);
        AddButton('Cancel',2,1,px3,py3,px4,py4);

        h:=0;
        AddField('Units:',22,1,20,9+h,60,25+h);
        AddButton('Inch',23,3,65,10+h,115,25+h);
        AddButton('mm',24,3,120,10+h,170,25+h);

        h:=-10;
        AddField('Outside Diameter:
',4,1,20,44+h,140,60+h);
        AddField('',5,2,145,45+h,210,60+h);
        AddField('Wire Diameter:
',6,1,20,69+h,130,85+h);
        AddField('',7,2,145,70+h,210,85+h);
        AddField('Free Length:
',8,1,20,94+h,130,110+h);
        AddField('',9,2,145,95+h,210,110+h);
        AddField('Working Length:',10,1,20,119+h,130,135+h);
        AddField('',11,2,145,120+h,210,135+h);
        AddField('Hook Length:',12,1,20,144+h,130,160+h);
        AddField('',13,2,145,145+h,210,160+h);

        AddField('',30,1,220,44+h,245,60+h);
        AddField('',31,1,220,69+h,245,85+h);
        AddField('',32,1,220,94+h,245,110+h);
        AddField('',33,1,220,119+h,245,135+h);
        AddField('',34,1,220,144+h,245,160+h);

        h:=-30;
        AddField('Type of Ends:',3,1,265,39+h,385,55+h);
        AddButton('Full Loop',14,3,265,65+h,345,80+h);
        AddButton('Full Round Hook',15,3,265,85+h,385,100+h);
        AddButton('Machine Loop',16,3,265,105+h,375,120+h);
        AddButton('Machine Hook',17,3,265,125+h,375,140+h);
        AddButton('Raised Hook',18,3,265,145+h,365,160+h);
        AddButton('Rectangular Hook',19,3,265,165+h,400,180+h);
        AddButton('V Hook',20,3,265,185+h,335,200+h);

        h:=10;
        AddField('View:',40,1,20,155+h,70,170+h);
        AddButton('Normal',41,3,20,175+h,90,190+h);
        AddButton('End View',42,3,100,175+h,190,190+h);
        AddButton('Edge View of Hooks',43,3,20,195+h,170,210+h);
        AddButton('Hooks at Right Angles',44,3,20,215+h,180,230+h);

        AddButton('Show All Coils',29,2,235,175+h,345,190+h);

    EndDialog;
END;

BEGIN
    MakeDialog4;
END;

Procedure GetInfo;
{
This procedure displays the dialog box and retrieves the information.
}
LABEL 5,10,20,99;
VAR
    Value : REAL;
    Item,Field,k,NTimes,NPlaces : INTEGER;
    RFlag : ARRAY[1..3] OF INTEGER;
    Done : BOOLEAN;

Procedure SetRButton(i,Item : INTEGER);
BEGIN
    IF RFlag[i] <> Item THEN BEGIN
        SetItem(RFlag[i],FALSE);
        SetItem(Item,TRUE);
        RFlag[i]:=Item;
    END;
END;

PROCEDURE SetUnitsField(Inch:BOOLEAN);
VAR
    Field,k : INTEGER;
    UnitsM1,UnitsM2 : STRING;
BEGIN
    Field:=29;
    IF Inch THEN
        UnitsM1:='in'
    ELSE
        UnitsM1:='mm';
    FOR k:=1 TO 5 DO
    BEGIN;
        Field:=Field+1;
        SetField(Field,UnitsM1);
    END;
END;

BEGIN
    NTimes:=NTimes+1;
    IF NTimes > 1 THEN GOTO 5;
    Type:=1;
    View:=1;
    Inch:=TRUE;
    ShowAllCoils:=FALSE;

    OD:=0.750;
    wd:=0.125;
    FL:=4.000;
    WL:=5.500;
    HL:=1.3125;

    5:Done:=FALSE;
    Abort:=FALSE;
    RFlag[1]:=Type+13;
    IF Inch Then RFlag[2]:=23
    ELSE RFlag[2]:=24;
    RFlag[3]:=View+40;
    GetDialog(4);
    SetTitle('Extension Springs');
    SetUnitsField(Inch);
    SetItem(RFlag[1],TRUE);
    SetItem(RFlag[2],TRUE);
    SetItem(RFlag[3],TRUE);
    SetItem(29,ShowAllCoils);
    SetField(5,Num2StrF(OD));
    SetField(7,Num2StrF(wd));
    SetField(9,Num2StrF(FL));
    SetField(11,Num2StrF(WL));
    IF Type>4 THEN SetField(13,Num2StrF(HL))
    ELSE SetField(13,'<n/a>');
    SelField(5);
    10:REPEAT
        DialogEvent(Item);
        IF Item=1 then
            Done:=True;
        IF Item=2 then BEGIN
            Done:=TRUE;
            Abort:=TRUE;
        END;
        IF (Item=13) AND (Type<5) THEN
        BEGIN
            Sysbeep;
            SelField(5);
        END;
        IF (Item>13) AND (Item<21) THEN
        BEGIN
            SetRButton(1,Item);
            Type:=Item-13;
            IF Type>4 THEN
                SetField(13,Num2StrF(HL))
            ELSE SetField(13,'<n/a>');
        END;
        IF Item=29 THEN
        BEGIN
            SetItem(Item,NOT ShowAllCoils);
            ShowAllCoils:=NOT ShowAllCoils;
        END;
        IF (Item=23) AND (NOT Inch) THEN
        BEGIN
            SetRButton(2,Item);
            Inch:=TRUE;
            SetUnitsField(Inch);
        END;
        IF (Item=24) AND (Inch) THEN
        BEGIN
            SetRButton(2,Item);
            Inch:=FALSE;
            SetUnitsField(Inch);
        END;
        IF (Item>40) AND (Item<45) THEN
        BEGIN
            SetRButton(3,Item);
            View:=Item-40;
        END;
    UNTIL Done;
    IF Abort THEN GOTO 99;
    Field:=3;
    FOR k:=1 TO 5 DO
    BEGIN
        Field:=Field+2;
        IF (Field=13) AND (Type<5) THEN GOTO 20;
        IF Str2Num(GetField(Field))>0 THEN GOTO 20;
        SysBeep;
        SelField(Field);
        Done:=False;
        GOTO 10;
    20:END;
    OD:=Str2Num(GetField(5));
    wd:=Str2Num(GetField(7));
    FL:=Str2Num(GetField(9));
    WL:=Str2Num(GetField(11));
    IF Type>4 THEN HL:=Str2Num(GetField(13));
    99:ClrDialog;
END;

Procedure DrawCoil(x1,y1,x2,y2,wd:REAL);
VAR
    r,L,Theta,x0,y0 : REAL;
BEGIN
    r:=wd/2;
    L:=Distance(x1,y1,x2,y2);
    Theta:=ArcCos((x2-x1)/L);
    IF y2 < y1 THEN
    Theta:=2*PI-Theta;
    x0:=x1-r*Cos(Theta)-r*Sin(Theta);
    y0:=y1-r*Sin(Theta)+r*Cos(Theta);
    Theta:=Rad2Deg(Theta);
    Absolute;
    MoveTo(x0,y0);
    Relative;
    AngleVar;
    ClosePoly;
    BeginPoly;
        ArcTo((L+2*r),#Theta,r);
        ArcTo((2*r),#(Theta-90),r);
        ArcTo(-(L+2*r),#Theta,r);
        ArcTo(-(2*r),#(Theta-90),r);
    EndPoly;
    NoAngleVar;
END;

Procedure DrawEndView;
LABEL 99;
CONST
    MaxPoints=12;
VAR
    p1,p2,p3,p4,p5,p6,p7,r1,r2,r3,r4,r5 : REAL;
    q1,q2,Theta1 : REAL;
    x,y,R : ARRAY[1..MaxPoints] OF REAL;
BEGIN
    r1:=ID/2;
    r2:=OD/2;
    r3:=wd/2;
    r4:=r3+wd;
    r5:=wd/2;
    p1:=Sqrt((r1-r3)^2 - (r3+r5)^2);
    Theta1:=ArcCos((r3+r5)/(r1-r3));
    p2:=r3/(Tan(Theta1/2));
    p3:=(r3 + 2*r5)/(Tan(Theta1/2));
    p4:=r1*(Tan(Theta1/2));
    p5:=r2*(Tan(Theta1/2));
    p6:=r1*Sin(Theta1);
    p7:=r2*Sin(Theta1);
    q1:=r1*Cos(Theta1);
    q2:=r2*Cos(Theta1);

    x[1]:=0;                y[1]:=r2;            R[1]:=0;
    x[2]:=-r2;            y[2]:=r2;            R[2]:=r2;
    x[3]:=-r2;            y[3]:=-r2;            R[3]:=r2;
    x[4]:=r2;            y[4]:=-r2;            R[4]:=r2;
    x[5]:=r2;            y[5]:=r2;            R[5]:=r2;
    x[6]:=0;                y[6]:=r2;            R[6]:=0;
    x[7]:=0;                y[7]:=r1;            R[7]:=0;
    x[8]:=r1;            y[8]:=r1;            R[8]:=r1;
    x[9]:=r1;            y[9]:=-r1;            R[9]:=r1;
    x[10]:=-r1;        y[10]:=-r1;        R[10]:=r1;
    x[11]:=-r1;        y[11]:=r1;            R[11]:=r1;
    x[12]:=0;            y[12]:=r1;            R[12]:=0;

    Absolute;
    ClosePoly;
    BeginPoly;
        LineTo(x0+x[1], y0+y[1]);
        FOR k:=2 TO 5 DO
            ArcTo(x0+x[k], y0+y[k], R[k]);
        LineTo(x0+x[6], y0+y[6]);
        MoveTo(x0+x[7], y0+y[7]);
        FOR k:=8 TO 11 DO
            ArcTo(x0+x[k], y0+y[k], R[k]);
        LineTo(x0+x[12], y0+y[12]);
        MoveTo(x0+x[1], y0+y[1]);
    EndPoly;

    x[1]:=0;                y[1]:=r2;            R[1]:=0;
    x[2]:=-p5;            y[2]:=r2;            R[2]:=r2;
    x[3]:=-p7;            y[3]:=q2;            R[3]:=0;
    x[4]:=-(p1+p3);y[4]:=-r5;            R[4]:=r4;
    x[5]:=-p1;            y[5]:=-r5;            R[5]:=0;
    x[6]:=r2;            y[6]:=-r5;            R[6]:=r5;
    x[7]:=r2;            y[7]:=r5;            R[7]:=r5;
    x[8]:=-p1;            y[8]:=r5;            R[8]:=0;
    x[9]:=-(p1+p2);y[9]:=r5;            R[9]:=r3;
    x[10]:=-p6;        y[10]:=q1;            R[10]:=0;
    x[11]:=-p4;        y[11]:=r1;            R[11]:=r1;
    x[12]:=0;            y[12]:=r1;            R[12]:=0;

    BeginPoly;
        FOR k:=1 TO 11 DO
        BEGIN
            IF R[k]=0 THEN
                LineTo(x0+x[k], y0+y[k])
            ELSE
                ArcTo(x0+x[k], y0+y[k], R[k]);
        END;
        LineTo(x0+x[12], y0+y[12]);
        MoveTo(x0+x[1], y0+y[1]);
    EndPoly;
    Group;
END;

Procedure DrawEnds(Type:INTEGER);
LABEL 10,20,30,99;
CONST
    MaxPoints=16;
VAR
    p1,p2,p3,p4,p5,p6,p7,s1,s2 : REAL;
    q1,q2,q3,q4,q5,r1,r2,r3,x1,y1 : REAL;
    Theta1,Theta2,Theta3,Theta4,Theta5 : REAL;
    x,y,R : ARRAY[1..MaxPoints] OF REAL;
    i,NPoints : INTEGER;

BEGIN
    IF Type = 1 THEN
        BEGIN
        NPoints:=16;
        r1:=ID/2;
        r2:=OD/2;
        r3:=wd/2;
        Theta1:=ArcTan((r1+r3)/(r2+r3));
        Theta2:=Pi/2 - 2*Theta1;
        p1:=(r1+r2+r3)*Tan(Theta2) - r3/Cos(Theta2);
        p2:=(2*r1+r3)*Tan(Theta2) + r3/Cos(Theta2);
        p3:=r3*(Cos(Theta2)+Sin(Theta2));
        q1:=r3*(Cos(Theta2)-Sin(Theta2));
        Theta3:=Pi/6;
        Theta4:=(Pi/2-Theta3)/2;
        p4:=r1*Tan(Theta4);
        p5:=r2*Tan(Theta4);
        p6:=r1*Cos(Theta3);
        p7:=r2*Cos(Theta3);
        q3:=r1*Sin(Theta3);
        q4:=r2*Sin(Theta3);

    x[1]:=-(r2-p7);    y[1]:=q4;            R[1]:=0;
    x[2]:=-(r2-p5);    y[2]:=r2;            R[2]:=r2;
    x[3]:=-r2;                y[3]:=r2;            R[3]:=0;
    x[4]:=-2*r2;            y[4]:=r2;            R[4]:=r2;
    x[5]:=-2*r2;            y[5]:=-r2;            R[5]:=r2;
    x[6]:=-r2;                y[6]:=-r2;            R[6]:=0;
    x[7]:=-(p1-P/2);    y[7]:=-r2;            R[7]:=r2;
    x[8]:=P/2+p3;        y[8]:=r1+r3+q1;R[8]:=r3;
    x[9]:=P/2-q1;        y[9]:=r1+r3+p3;R[9]:=r3;
    x[10]:=-(p2-P/2);y[10]:=-r1;        R[10]:=r1;
    x[11]:=-r2;            y[11]:=-r1;        R[11]:=0;
    x[12]:=-(r1+r2);    y[12]:=-r1;        R[12]:=r1;
    x[13]:=-(r1+r2);    y[13]:=r1;            R[13]:=r1;
    x[14]:=-r2;            y[14]:=r1;            R[14]:=0;
    x[15]:=-(r2-p4);    y[15]:=r1;            R[15]:=r1;
    x[16]:=-(r2-p6);    y[16]:=q3;            R[16]:=0;

    END ELSE IF Type = 2 THEN
        BEGIN
        NPoints:=12;
        r1:=ID/2;
        r2:=OD/2;
        r3:=wd/2;
        Theta1:=ArcTan((r1+r3)/(r2+r3));
        Theta2:=Pi/2 - 2*Theta1;
        p1:=(r1+r2+r3)*Tan(Theta2) - r3/Cos(Theta2);
        p2:=(2*r1+r3)*Tan(Theta2) + r3/Cos(Theta2);
        p3:=r3*(Cos(Theta2)+Sin(Theta2));
        q1:=r3*(Cos(Theta2)-Sin(Theta2));

    x[1]:=-r2;                y[1]:=r2;            R[1]:=0;
    x[2]:=-2*r2;            y[2]:=r2;            R[2]:=r2;
    x[3]:=-2*r2;            y[3]:=-r2;            R[3]:=r2;
    x[4]:=-r2;                y[4]:=-r2;            R[4]:=0;
    x[5]:=-(p1-P/2);    y[5]:=-r2;            R[5]:=r2;
    x[6]:=P/2+p3;            y[6]:=r1+r3+q1;R[6]:=r3;
    x[7]:=P/2-q1;            y[7]:=r1+r3+p3;R[7]:=r3;
    x[8]:=-(p2-P/2);    y[8]:=-r1;            R[8]:=r1;
    x[9]:=-r2;                y[9]:=-r1;            R[9]:=0;
    x[10]:=-(r1+r2);    y[10]:=-r1;        R[10]:=r1;
    x[11]:=-(r1+r2);    y[11]:=r1;            R[11]:=r1;
    x[12]:=-r2;            y[12]:=r1;            R[12]:=0;

    END ELSE IF Type = 3 THEN
    BEGIN
        NPoints:=10;
        p1:=Hf2*wd;
        p2:=ID/2+p1;
        p3:=p2+wd;
        p4:=wd/2;
        r1:=ID/2;
        r2:=OD/2;
        r3:=wd/2;

        x[1]:=wd/2;        y[1]:=-r2;        R[1]:=r3;
        x[2]:=-p1;            y[2]:=-r2;        R[2]:=0;
        x[3]:=-p3;            y[3]:=-r2;        R[3]:=r2;
        x[4]:=-p3;            y[4]:=r2;        R[4]:=r2;
        x[5]:=-p4;            y[5]:=r2;        R[5]:=0;
        x[6]:=-p4;            y[6]:=r1;        R[6]:=0;
        x[7]:=-p2;            y[7]:=r1;        R[7]:=r1;
        x[8]:=-p2;            y[8]:=-r1;        R[8]:=r1;
        x[9]:=-p1;            y[9]:=-r1;        R[9]:=0;
        x[10]:=wd/2;        y[10]:=-r1;    R[10]:=r3;

    END ELSE IF Type = 4 THEN
    BEGIN
        NPoints:=12;
        Theta1:=Pi/6;
        p1:=Hf2*wd;
        p2:=ID/2+p1;
        p3:=OD/2+wd;
        p4:=p1+ID*Sin(Theta1)/2;
        p5:=p1+OD*Sin(Theta1)/2;
        q1:=ID*Tan(Theta1)/2;
        q2:=OD*Tan(Theta1)/2;
        q3:=ID*Cos(Theta1)/2;
        q4:=OD*Cos(Theta1)/2;
        r1:=ID/2;
        r2:=OD/2;
        r3:=wd/2;

        x[1]:=r3;            y[1]:=-r2;        R[1]:=r3;
        x[2]:=-p1;            y[2]:=-r2;        R[2]:=0;
        x[3]:=-p3;            y[3]:=-r2;        R[3]:=r2;
        x[4]:=-p3;            y[4]:=0;            R[4]:=0;
        x[5]:=-p3;            y[5]:=q2;        R[5]:=r2;
        x[6]:=-p5;            y[6]:=q4;        R[6]:=0;
        x[7]:=-p4;            y[7]:=q3;        R[7]:=0;
        x[8]:=-p2;            y[8]:=q1;        R[8]:=r1;
        x[9]:=-p2;            y[9]:=0;            R[9]:=0;
        x[10]:=-p2;        y[10]:=-r1;    R[10]:=r1;
        x[11]:=-p1;        y[11]:=-r1;    R[11]:=0;
        x[12]:=r3;            y[12]:=-r1;    R[12]:=r3;


    END ELSE IF (Type = 5) OR (Type = 6) THEN
    BEGIN
        NPoints:=8;
        p1:=HL+wd;
        IF Type=5 THEN
        BEGIN
            p2:=ID/2;
            r1:=ID/2;
            r2:=OD/2;
        END ELSE
        BEGIN
            p2:=wd;
            r1:=wd;
            r2:=2*wd;
        END;
        x[1]:=wd/2;        y[1]:=-OD/2;        R[1]:=wd/2;
        x[2]:=-p1;            y[2]:=-OD/2;        R[2]:=r2;
        x[3]:=x[2];        y[3]:=OD/2;        R[3]:=r2;
        x[4]:=-p2;            y[4]:=OD/2;        R[4]:=0;
        x[5]:=x[4];        y[5]:=ID/2;        R[5]:=0;
        x[6]:=x[3]+wd;    y[6]:=ID/2;        R[6]:=r1;
        x[7]:=x[6];        y[7]:=-ID/2;        R[7]:=r1;
        x[8]:=x[1];        y[8]:=-ID/2;        R[8]:=wd/2;
    END

    ELSE IF Type = 7 THEN
    BEGIN
        NPoints:=8;
        r1:=wd;
        r2:=wd/2;
        r3:=3*wd/2;
        p1:=D/2;
        q1:=HL-r1;
        s1:=Sqrt(p1^2 + q1^2);
        s2:=r1*s1/(r1+r2);
        Theta1:=ArcTan(q1/p1);
        Theta2:=ArcSin(r1/s2);
        Theta3:=Pi/2-Theta1-Theta2;
        p2:=r2*Tan((Pi/2 - Theta3)/2);
        q2:=HL;
        p3:=r3*Tan((Pi/2 - Theta3)/2);
        q3:=HL+wd;
        q4:=r2*(Cos(Theta3)-Sin(Theta3));
        p4:=r2*(Cos(Theta3)+Sin(Theta3));
        p5:=q1*Tan(Theta3)/2;

        x[1]:=q4;        y[1]:=-(D/2+p4);        R[1]:=r2;
        x[2]:=-q3;        y[2]:=-p3;        R[2]:=r3;
        x[3]:=-q3;        y[3]:=p3;        R[3]:=r3;
        x[4]:=q4-q1/2;        y[4]:=(D/2+p4)-p5;    R[4]:=0;
        x[5]:=p4-q1/2;        y[5]:=(D/2-q4)-p5;    R[5]:=0;
        x[6]:=-q2;        y[6]:=p2;        R[6]:=r1;
        x[7]:=-q2;        y[7]:=-p2;        R[7]:=r1;
        x[8]:=p4;        y[8]:=-(D/2-q4);        R[8]:=r2;
    END;

    IF (View = 3) THEN GOTO 20;
    x1:=x0;        y1:=y0;
    i:=1;
    Absolute;
    ClosePoly;
    10:BeginPoly;
        FOR k:=1 TO NPoints DO
        BEGIN
            IF R[k]=0 THEN
                LineTo(x1+i*x[k],y1+i*y[k])
            ELSE
                ArcTo(x1+i*x[k],y1+i*y[k],R[k]);
        END;
    EndPoly;
    IF i=-1 THEN GOTO 99;
    IF View = 4 THEN GOTO 20;
    i:=-1;
    x1:=x0+LCW;        y1:=y0;
    GOTO 10;

    20:NPoints:=6;
    i:=1;
    x1:=x0+LCW;        y1:=y0;
    30:r1:=wd;
    r2:=2*wd;
    r3:=wd/2;
    Theta1:=ArcTan(P/(2*D));
    p1:=r3*(Cos(Theta1)+Sin(Theta1));
    q1:=r3*(Cos(Theta1)-Sin(Theta1));
    p2:=(D-wd)*Sin(Theta1)/2 + r3/Cos(Theta1);
    p3:=HL+wd;
    p4:=(D+wd)*Sin(Theta1)/2 - r3/Cos(Theta1);

    x[1]:=-p1;        y[1]:=D/2+q1;            R[1]:=r3;
    x[2]:=q1;        y[2]:=D/2+p1;            R[2]:=r3;
    x[3]:=p2;        y[3]:=wd/2;                R[3]:=r1;
    x[4]:=p3;        y[4]:=wd/2;                R[4]:=r3;
    x[5]:=p3;        y[5]:=-wd/2;            R[5]:=r3;
    x[6]:=p4;        y[6]:=-wd/2;            R[6]:=r2;

    Absolute;
    BeginPoly;
        FOR k:=1 TO NPoints DO
        BEGIN
            IF R[k]=0 THEN
                LineTo(x1+i*x[k], y1+i*y[k])
            ELSE
                ArcTo(x1+i*x[k], y1+i*y[k], R[k]);
        END;
    EndPoly;
    IF (View = 4) OR (i=-1) THEN GOTO 99;
    i:=-1;
    x1:=x0;  y1:=y0;
    GOTO 30;
99:END;

{
Main Program.
}
BEGIN
    DSelectAll;
{
Display the dialog box and get the information.
}
    SpringDialog;
    SetCursor(ArrowC);
    GetInfo;
    IF Abort THEN GOTO 99;

{
Get drawing units and adjust parameters.
}
    GetUnits(UName,DA,Fmt,UPI,UM,UM2);
    IF Inch THEN
        sf:=UPI
    ELSE
        sf:=UPI/25.4;
    OD:=OD*sf;
    wd:=wd*sf;
    FL:=FL*sf;
    WL:=WL*sf;
    HL:=HL*sf;
    PushAttrs;
{
Get the location of the spring.
}
    GetPt(x0,y0);
{
Calculate spring parameters.
}
    D:=OD-wd;
    ID:=OD-2*wd;
    IF (Type=1) OR (Type=2) THEN
    BEGIN
        HL:=ID+wd;
    END ELSE IF (Type=3) OR (Type=4) THEN
    BEGIN
        HL:=(Hf2*wd+ID/2);
    END ELSE
    BEGIN
        LCF:=FL-2*HL;
        LCW:=WL-2*HL;
    END;
    LCF:=FL-2*HL;
    LCW:=WL-2*HL;
    NCoils:=LCF/wd - 1/2;
    P:=LCW/(NCoils + 1/2);
    IF (ShowAllCoils) OR ((NCoils - 1) <= 2*ShowCoils) THEN
    BEGIN
        s:=NCoils;
        ShowAllCoils:=TRUE;
    END ELSE
        s:=ShowCoils;
    n:=NCoils  - s + 1;
{
Draw spring.
}
    IF View=2 THEN
    BEGIN
        DrawEndView;
        GOTO 99;
    END;

    IF (Type>2)OR(View>3) THEN
    BEGIN
        IF (Type>2) OR ((Type<3)AND(View=3)) THEN
        BEGIN
            x1:=x0+P/2;
            y1:=y0+D/2;
            x2:=x0;
            y2:=y0-D/2;
            DrawCoil(x1,y1,x2,y2,wd);
        END;
        5:x1:=x0+LCW;
        y1:=y0+D/2;
        x2:=x1-P/2;
        y2:=y0-D/2;
        DrawCoil(x1,y1,x2,y2,wd);
    END;
    IF Type < 3 THEN DrawEnds(Type);

    FOR k:=1 TO NCoils DO
    BEGIN
        IF (k>s) AND (k<n) THEN GOTO 20;
        IF ((k=s)OR(k=NCoils)) OR (WL=FL) THEN GOTO 10;
        x1:=x0+k*P;
        y1:=y0-D/2;
        x2:=x0+(k+1/2)*P;
        y2:=y0+D/2;
        DrawCoil(x1,y1,x2,y2,wd);
        10:x1:=x0+(k-1/2)*P;
        y1:=y0+D/2;
        x2:=x0+k*P;
        y2:=y0-D/2;
        DrawCoil(x1,y1,x2,y2,wd);
    20:END;

    IF ShowAllCoils THEN GOTO 30;
    Absolute;
    MoveTo((x0+(s-1/2)*P), y0+OD/2);
    PenPat(PP1);
    Relative;
    LineTo((NCoils-2*s+1)*P, 0);
    Move(wd/2,-OD);
    LineTo(-(NCoils-2*s+1)*P, 0);

    30:PopAttrs;
    IF Type > 2 THEN DrawEnds(Type);
    Group;
99:END;    {of ExtensionSprings}


Procedure MainDialog;
{
This procedure defines the main dialog box.
}
VAR
    Width,x1,y1,x2,y2,px1,px2,px3,px4,py1,py2,py3,py4 : INTEGER;

Procedure AlignScr(Width:INTEGER; VAR x1,x2:INTEGER);
VAR
    scrx1,scry1,scrx2,scry2:INTEGER;

BEGIN
    GetScreen(scrx1,scry1,scrx2,scry2);
    x1:=((scrx1+scrx2) div 2)-(Width div 2);
    x2:=x1+Width;
END;

Procedure LocateButtons(DialogType,scnh,scnw : INTEGER);
{
This procedure locates the 'OK' and 'Cancel' buttons.
}
VAR
    v1,v2,v3,v4 : INTEGER;
    Mac : BOOLEAN;

Procedure Swap(VAR  m1,m2,m3,m4 : INTEGER);
VAR
    Temp : INTEGER;
BEGIN
    Temp:=m1;
    m1:=m3;
    m3:=Temp;
    Temp:=m2;
    m2:=m4;
    m4:=Temp;
END;        {of Swap}

BEGIN
    Mac:=FALSE;
    GetVersion(v1,v2,v3,v4);
    IF v4 = 1 THEN Mac:=TRUE;

    IF DialogType = 1 THEN
    BEGIN
        px1:=(scnw DIV 2) - 80;
        px2:=(scnw DIV 2) - 10;
        px3:=(scnw DIV 2) + 10;
        px4:=(scnw DIV 2) + 80;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE IF DialogType = 2 THEN
    BEGIN
        px1:=scnw - 180;
        px2:=scnw - 110;
        px3:=scnw - 90;
        px4:=scnw - 20;
        IF Mac THEN SWAP(px1,px2,px3,px4);

        py1:=scnh-40;
        py2:=scnh-20;
        py3:=py1;
        py4:=py2;
    END ELSE
    BEGIN
        px1:=scnw - 90;
        px2:=scnw - 20;
        px3:=px1;
        px4:=px2;

        py1:=scnh -70;
        py2:=scnh - 50;
        py3:=scnh - 40;
        py4:=scnh - 20;
        IF Mac THEN SWAP(py1,py2,py3,py4);
    END;
END;        {of Locate Buttons}

Procedure MakeDialog6;

CONST
    y1=100;
    scnw = 250;
    scnh = 200;
    DialogType = 1;

VAR
    h : INTEGER;

BEGIN
    AlignScr(scnw,x1,x2);
    y2:=y1+scnh;
    LocateButtons(DialogType,scnh,scnw);

    BeginDialog(6,1,x1,y1,x2,y2);
        AddButton('OK',1,1,px1,py1,px2,py2);
        AddButton('Cancel',2,1,px3,py3,px4,py4);

        h:=-30;
        AddField('Type of Spring:',4,1,20,39+h,195,55+h);
        AddButton('Compression Spring',5,3,20,65+h,220,80+h);
        AddButton('Extension Spring',6,3,20,85+h,220,100+h);
        AddButton('Conical Compression spring',7,3,20,105+h,220,120+h);
        AddButton('Heavy Duty Die Spring',8,3,20,125+h,220,140+h);
        {AddButton('Torsion Spring',9,3,20,145+h,220,160+h);}
    EndDialog;
END;

BEGIN
    MakeDialog6;
END;

Procedure GetInfo1;
{
This procedure displays the main dialog box and retrieves the information.
}
VAR
    Item:INTEGER;
    RFlag : ARRAY[1..2] OF INTEGER;
    Done:BOOLEAN;

Procedure SetRButton(i,Item : INTEGER);
BEGIN
    IF RFlag[i] <> Item THEN BEGIN
        SetItem(RFlag[i],FALSE);
        SetItem(Item,TRUE);
        RFlag[i]:=Item;
    END;
END;

BEGIN
    Done:=FALSE;
    Abort:=FALSE;
    Type:=1;
    RFlag[1]:=5;
    GetDialog(6);
    SetTitle('Springs');
    SetItem(RFlag[1],TRUE);
    REPEAT
        DialogEvent(Item);
        IF Item=1 THEN
            Done:=TRUE;
        IF Item=2 THEN
        BEGIN
            Done:=TRUE;
            Abort:=TRUE;
        END;
        IF Item>4 THEN BEGIN
            SetRButton(1,Item);
            Type:=Item-4;
        END;
    UNTIL DONE;
    ClrDialog;
END;

{
Main Program.
}
BEGIN
    MainDialog;
    SetCursor(ArrowC);
    GetInfo1;
    IF Abort THEN GOTO 99;
    If Type=1 THEN CompressionSprings
    ELSE If Type=2 THEN ExtensionSprings
    ELSE If Type=3 THEN ConicalCompSprings
    ELSE If Type=4 THEN DieSprings;
99:END;

RUN(Springs);