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

Text File | 1997-04-30 | 5KB | 292 lines

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

This procedure creates a Datum Feature Symbol.
}

LABEL 10,20,25,90,95,99;

CONST
{The following constants determine the size of the datum feature symbol and text location for text size of 10 pt.}
    BoxWdthC = 0.25;
    BoxHgtC = 0.25;

{The following constant determines the height of of the datum feature marker for text size of 10 pt.}
    htC=0.125;

VAR
    a,b,h,ht,r1,Theta,x0,y0,x1,y1,x2,y2,xt : REAL;
    BoxWdth,BoxHgt,LScale : REAL;
    xb1,xb2,yb1,yb2 : REAL;

    TxtSize : INTEGER;
    cR,cG,cB : LONGINT;
    DatumRef : STRING;
    Abort,Leader : BOOLEAN;
    LayerH,TextH,GroupH : HANDLE;

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

Procedure DatumDialog;
{
This procedure creates 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 LocateButtons2(scnh,scnw : INTEGER);
{
This procedure locates the 'OK' and 'Cancel' buttons at the lower left hand corner of the dialog box.
}
VAR
    v1,v2,v3,v4 : INTEGER;

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
    px1:=scnw - 180;
    px2:=scnw - 110;
    px3:=scnw - 90;
    px4:=scnw - 20;

    py1:=scnh-40;
    py2:=scnh-20;
    py3:=py1;
    py4:=py2;

    GetVersion(v1,v2,v3,v4);
    IF v4 = 1 THEN Swap(px1,px2,px3,px4);

END;        {of Locate Buttons1}

Procedure MakeDialog;
CONST
    y1=100;
    scnh=125;
    scnw=300;

VAR
    h : INTEGER;

BEGIN
    AlignScr(scnw,x1,x2);
    y2:=y1+scnh;
    LocateButtons2(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:=30;
        AddField('Datum ID Letter:',5,1,20,44-h,140,60-h);
        AddField('',6,2,145,45-h,205,60-h);

        AddButton('Draw leader line',7,2,20,75-h,170,90-h);
    EndDialog;
END;

BEGIN
    MakeDialog;
END;

Procedure GetInfo;
{
This procedure displays the dialog box and retrieves the information.
}
VAR
    Done:Boolean;
    Item:Integer;

BEGIN
    Done:=FALSE;
    Abort:=FALSE;
    Leader:=TRUE;
    GetDialog(1);
    SetTitle('Datum Feature Symbol');
    SelField(6);
    SetItem(7, Leader);
    REPEAT
        DialogEvent(Item);
        IF Item=1 THEN
            Done:=TRUE;

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

        IF Item = 7 THEN
        BEGIN
            Leader:=NOT Leader;
            SetItem(7, Leader);
        END;
    UNTIL Done;
    DatumRef:=GetField(6);
    ClrDialog;
END;

Function GetActTextSize : INTEGER;
{
This function returns the active  text size.
}
VAR
    a : INTEGER;
    TextH : HANDLE;

BEGIN
    DSelectAll;
    TextOrigin(0,0);
    BeginText;
        ' '
    EndText;
    TextH:=FSActLayer;
    GetActTextSize:=GetSize(TextH);
    DelObject(TextH);
END;

{
Main program.
}
BEGIN
    DSelectAll;
    TextSpace(2);
    TextJust(2);

{
Display the dialog box and get the information.
}

    DatumDialog;
    SetCursor(ArrowC);
    10:GetInfo;
    IF Abort THEN GOTO 99;

{
Get text size.
}

    TxtSize:=GetActTextSize;

{
Get layer scale and units per inch.
}

    LayerH:=ActLayer;
    LScale:=GetLScale(LayerH);
    GetUnits(UName,DA,Fmt,UPI,UM,UM2);

{
Adjust the constants for layer scale, units per inch, and text size.
}

    h:=TxtSize/10;
    LScale:=h*LScale;
    BoxWdth:=BoxWdthC*UPI*LScale;
    BoxHgt:=BoxHgtC*UPI*LScale;
    ht:=htC*UPI*LScale;

{
Determine location of text.
}

    Absolute;
    DSelectAll;
    xt:=BoxWdth/2;

{
Get symbol location.
}

    GetPt(x0,y0);

{
Draw symbol and enter text.
}

    FillPat(1);
    Absolute;
    MoveTo(x0-BoxWdth/2,y0+BoxHgt/2);
    Relative;
    Rect(0,0,BoxWdth,-BoxHgt);

    FillPat(0);
    IF DatumRef = '' THEN GOTO 25;
    Absolute;
    TextOrigin(x0,y0);
    BeginText;
        DatumRef
    EndText;
    TextH:=LSActLayer;
    GetBBox(TextH,xb1,yb1,xb2,yb2);
    HMove(TextH,0,(yb1-yb2)/2);

    25:Group;
    GroupH:=LSactLayer;
    IF NOT Leader THEN GOTO 95;

    ReDraw;
    DSelectAll;
    Absolute;
    MoveTo(x0,y0);
    GetPtL(x0,y0,x1,y1);
    LineTo(x1,y1);
    DoMenuText('Send to Back');
    Redraw;

    GetPtL(x1,y1,x2,y2);
    IF (x1 = x2) AND (y1 = y2) THEN GOTO 20;
    LineTo(x2,y2);
    x0:=x1; y0:=y1;
    x1:=x2; y1:=y2;

    20:r1:=Distance(x0,y0,x1,y1);
    Theta:=Rad2Deg(ArcCos((x1-x0)/r1));
    IF y1 < y0 THEN
        Theta:=360 - Theta;
    a:=ht/Cos(Pi/6);
    b:=2*ht*Tan(Pi/6);
    MoveTo(x1,y1);
    Relative;
    AngleVar;
    Move(-b/2,#(Theta-90));
    ClosePoly;
    FillPat(2);
    FPenFore(cR,cG,cB);
    FillFore(cR,cG,cB);
    BeginPoly;
        LineTo(0,0);
        LineTo(b,#(Theta-90));
        LineTo(-a,#(Theta-30));
    EndPoly;
    SetSelect(GroupH);
    90:Group;
    95:PopAttrs;
99:END;

RUN(DatumFeature);