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

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

Procedure DivideLine;
{
⌐1996, Diehl Graphsoft, Inc.
Developed by Tom Urie

This procedure divides a line into a given number of equal segments and/or places loci at the division points.
}

LABEL 10,99;

VAR
    x,y,x0,y0,x1,y1,x2,y2,dx,dy:REAL;
    i,nSegs,TVal,Type:INTEGER;
    ObjectH:HANDLE;
    Abort,Loci,Segments,Erase : BOOLEAN;

Procedure Dialog;
{
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 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 MakeDialog;
{
This procedure defines the dialog box.
}

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

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:=-30;
        AddField('Options -',5,1,20,40+h,185,55+h);
        AddButton('Place loci',6,2,20,60+h,160,75+h);
        AddButton('Break line into segments',7,2,20,80+h,205,95+h);
        AddButton('Leave original line intact',8,2,20,100+h,205,115+h);

        AddField('Number of segments:',9,1,20,140+h,165,155+h);
        AddField('2',10,2,170,140+h,210,155+h);

    EndDialog;
END;

BEGIN
    MakeDialog;
END;

Procedure GetInfo;
{
This procedure displays the dialog box and retrieves the information.
}
VAR
    Item : INTEGER;
    Done : BOOLEAN;
BEGIN
    Done:=FALSE;
    Abort:=FALSE;
    Loci:=TRUE;
    Segments:=TRUE;
    Erase:=FALSE;
    GetDialog(1);
    SetTitle('Divide Line');
    SetItem(6,Loci);
    SetItem(7,Segments);
    SetItem(8,NOT Erase);
    SelField(10);
    REPEAT
        DialogEvent(Item);
        IF Item=1 THEN
            Done:=TRUE;
        IF Item=2 THEN
        BEGIN
            Done:=TRUE;
            Abort:=TRUE;
        END;

        IF Item = 6 THEN
        BEGIN
            Loci:=NOT Loci;
            SetItem(Item,Loci);
            IF (NOT Loci) AND (NOT Segments) AND (Erase) THEN
            BEGIN
                SetItem(8,TRUE);
                Erase:=False;
            END;
        END;

        IF Item = 7 THEN
        BEGIN
            Segments:=NOT Segments;
            SetItem(Item,Segments);
            IF (NOT Segments) AND (NOT Loci) THEN
            BEGIN
                SetItem(8,TRUE);
                Erase:=False;
            END;
        END;

        IF Item = 8 THEN
        BEGIN
            Erase:=NOT Erase;
            SetItem(Item,NOT Erase);
            IF (Erase) AND (NOT Loci) THEN
            BEGIN
                SetItem(7,TRUE);
                Segments:=TRUE;
            END;
        END;

    UNTIL Done;
    NSegs:=Str2Num(GetField(10));
    ClrDialog;
END;

{
Main Program.
}
BEGIN
{
Check to see if a line is selected
}
    ObjectH:=FSActLayer;
    IF ObjectH = NIL THEN
    BEGIN
        Sysbeep;
        AlrtDialog('You must select the line first!');
        GOTO 99;
    END;
    TVal:=GetType(ObjectH);
    IF TVal <> 2 THEN
    BEGIN
        Sysbeep;
        AlrtDialog('The object selected is not a line!');
        GOTO 99;
    END;
{
Display the dialog box
}
    Dialog;
    SetCursor(ArrowC);
{
Get the information from the dialog box.
}
    GetInfo;
    IF Abort THEN GOTO 99;
{
Get the end points of the line and determint the length of the segments.
}
    GetSegPt1(ObjectH, x1,y1);
    GetSegPt2(ObjectH, x2,y2);
    dx:=(x1-x2)/nSegs;
    dy:=(y1-y2)/nSegs;
{
Delete the original line.
}
    IF Erase THEN
        DelObject(ObjectH);
    x:=x1;
    y:=y1;
    Absolute;
    MoveTo(x,y);
    FOR i:=1 to nSegs-1 DO
    BEGIN
        x:=x1-i*dx;
        y:=y1-i*dy;
{
Draw the new line segments.
}
        IF Segments THEN
            LineTo(x,y);
{
Place loci.
}
        IF Loci THEN
            Locus(x,y);
    END;
{
Draw the last line segment.
}
    IF Segments THEN
    BEGIN
        x:=x1-i*dx;
        y:=y1-i*dy;
        LineTo(x,y);
    END;
99:END;

RUN(DivideLine);