Gio Pet

{SMART PASTE_Command to control the automatic creation of new classes when Copy/Pasting across Drawings.
Copyright (C) 2010  Giovanni Petrolito}


PROCEDURE Smart_Paste;


VAR
        ClassNames                      :DYNARRAY[] of STRING;
        NewClassNames                   :DYNARRAY[] of STRING;
        ExtraClassNames                 :DYNARRAY[] of STRING;


        countClasses, NewcountClasses   :INTEGER;
        diff, StartClass                :INTEGER;
        index                           :INTEGER;
        clicks                          :INTEGER;
        ClassOptions                    :INTEGER;

        Didcancel    :BOOLEAN;
        canceled     :BOOLEAN;


        OldClass                        :STRING;
        NewClass                        :STRING;
        to_be_assigned                  :STRING;
        assign_to                       :STRING;



{ ***************************************************************************************************************** }
                { BEGINNING OF SUB-PROCEDURES }
{ ***************************************************************************************************************** }



        PROCEDURE Populate_Array1;

        VAR
                x       :INTEGER;
                y       :INTEGER;
                w       :INTEGER;


                BEGIN
                countClasses:=CLASSNUM;
                ALLOCATE ClassNames [1..countClasses];

                        FOR x:= 1 TO countClasses DO BEGIN
                                y:=x;
                                CLassnames[y] := ClassList(x);
                        END;
        END;

{ ***************************************************************************************************************** }

        PROCEDURE Populate_Array2;

        VAR
                x       :INTEGER;
                y       :INTEGER;
                w       :INTEGER;

        BEGIN
                ALLOCATE NewClassNames [1..NewcountClasses];

                FOR x:= 1 TO NewcountClasses DO BEGIN

                        y:=x;
                        NewClassNames[y] := ClassList(x);
                        END;
        END;

{ ***************************************************************************************************************** }

        PROCEDURE Populate_Array_Extra;

        VAR
                x       :INTEGER;
                y       :INTEGER;
                w       :INTEGER;


                BEGIN
                        canceled:=False;
                        diff:=(NewcountClasses - countClasses);
                        StartClass:=(NewcountClasses - diff)+1;
                        ALLOCATE ExtraClassNames [1..diff];
                        y:=1;

                        FOR x:=(StartClass) TO (NewcountClasses) DO BEGIN
                            IF  y<=diff THEN BEGIN
                                ExtraClassNames[y] := NewClassNames[x];
                                y:=y+1;
                            END;
                        END;
                END;

{ ***************************************************************** }


        PROCEDURE dialog1_Main;

        CONST
            kStartStringAt = 3000;
            kOK           = 1;
            kCancel       = 2;
            kUndo_Btn     = 4;
            kPaste_Btn    = 5;
            kAssign       = 6;
            kGroupBox7    = 7;
            kGroupBox14   = 14;
            kGroupBox15   = 15;
            kGroupBox25   = 25;
            kGroupBox26   = 26;
            kNEWclsnm     = 40;
            kEXclsnm      = 41;
            kStaticText63 = 63;
            kStaticText64 = 64;

            kRight        = 1;
            kBottom       = 2;
            kLeft         = 3;
            kResize       = 0;
            kShift        = 1;

            kTextOnly     = 0;
            kIconOnly     = 1;
            kTextIcon     = 3;
            kStatic       = 1;
            kRadio        = 2;
            kMulti        = 3;
            kCol0         = 0;
            kCol1         = 1;
            kRow1         = 1;
        VAR
            dialog1             :INTEGER;
            kImageCheckNEW      :INTEGER;
            kImageBlankNEW      :INTEGER;
            kImageSheetNEW      :INTEGER;
            kImageViewNEW       :INTEGER;

            kImageCheckEX       :INTEGER;
            kImageBlankEX       :INTEGER;
            kImageSheetEX       :INTEGER;
            kImageViewEX        :INTEGER;

            cnt                 :INTEGER;
            int                 :INTEGER;
            ndx                 :INTEGER;

            numOfClass          :INTEGER;
            classname           :INTEGER;

            xmlID               :LONGINT;

            boo                 :BOOLEAN;
            Select_more         :BOOLEAN;
            Select_one          :BOOLEAN;
            str                 :STRING;

            {$Include _DialogBuilderUtilities.txt}



            FUNCTION GetPlugInString(ndx :INTEGER) :STRING;
                BEGIN
                CASE ndx OF
                    {Static Text}
                    3001: GetPlugInString := 'OK';
                    3002: GetPlugInString := 'Cancel';
                    3003: GetPlugInString := 'Smart Paste';
                    3004: GetPlugInString := 'Undo';
                    3005: GetPlugInString := 'Add';
                    3006: GetPlugInString := 'Assign';
                    3007: GetPlugInString := 'Controls';
                    3014: GetPlugInString := 'Untitled';
                    3015: GetPlugInString := 'Untitled';
                    3025: GetPlugInString := '';
                    3026: GetPlugInString := '';
                    3063: GetPlugInString := 'New Incoming Classes:';
                    3064: GetPlugInString := 'Existing Classes:';

                    {Help Text}
                    4001: GetPlugInString := 'Accepts dialog data.';
                    4002: GetPlugInString := 'Cancels operation without changes.';
                    4004: GetPlugInString := 'A push button control.';
                    4005: GetPlugInString := 'A push button control.';
                    4006: GetPlugInString := 'A push button control.';
                    4007: GetPlugInString := '';
                    4014: GetPlugInString := '';
                    4015: GetPlugInString := '';
                    4025: GetPlugInString := 'A group box control.';
                    4026: GetPlugInString := 'A group box control.';
                    4040: GetPlugInString := 'A list box control.';
                    4041: GetPlugInString := 'A list box control.';
                    4063: GetPlugInString := 'Static text control.';
                    4064: GetPlugInString := 'Static text control.';
                END;
            END;

{ ***************************************************************************************************************** }

            FUNCTION GetStr(ndx :INTEGER) :STRING;
                BEGIN
                    GetStr := GetPlugInString(ndx + kStartStringAt);
                END;

{ ***************************************************************************************************************** }

            PROCEDURE dialog1_Setup;
                BEGIN
                    dialog1 := CreateResizableLayout(GetStr( 3), TRUE, GetStr(kOK), GetStr(kCancel), FALSE, TRUE);
                    CreatePushButton          (dialog1, kUndo_Btn,      GetStr(kUndo_Btn));
                    CreatePushButton          (dialog1, kPaste_Btn,     GetStr(kPaste_Btn));
                    CreatePushButton          (dialog1, kAssign,        GetStr(kAssign));
                    CreateGroupBox            (dialog1, kGroupBox7,     GetStr(kGroupBox7), TRUE);
                    CreateGroupBox            (dialog1, kGroupBox14,    GetStr(kGroupBox14), FALSE);
                    CreateGroupBox            (dialog1, kGroupBox15,    GetStr(kGroupBox15), FALSE);
                    CreateGroupBox            (dialog1, kGroupBox25,    GetStr(kGroupBox25), TRUE);
                    CreateGroupBox            (dialog1, kGroupBox26,    GetStr(kGroupBox26), TRUE);
                    CreateLB                  (dialog1, kNEWclsnm,      32, 10);
                    CreateLB                  (dialog1, kEXclsnm,       32, 10);
                    CreateStaticText          (dialog1, kStaticText63,  GetStr(kStaticText63), -1);
                    CreateStaticText          (dialog1, kStaticText64,  GetStr(kStaticText64), -1);
                    SetFirstLayoutItem(dialog1, kGroupBox15);
                    SetFirstGroupItem (dialog1, kGroupBox15,    kGroupBox26);
                    SetFirstGroupItem (dialog1, kGroupBox26,    kStaticText63);
                    SetBelowItem      (dialog1, kStaticText63,  kNEWclsnm,      0, 0);
                    SetRightItem      (dialog1, kGroupBox26,    kGroupBox7,     0, 0);

                    SetFirstGroupItem (dialog1, kGroupBox7,     kAssign);
                    SetBelowItem (dialog1, kGroupBox7,     kPaste_Btn, 3.25, -40 );
                    SetRightItem (dialog1,kPaste_Btn,     kUndo_Btn, -11.47, 10 );

                    SetRightItem      (dialog1, kGroupBox7,     kGroupBox14,    0, 0);
                    SetFirstGroupItem (dialog1, kGroupBox14,    kGroupBox25);
                    SetFirstGroupItem (dialog1, kGroupBox25,    kStaticText64);
                    SetBelowItem      (dialog1, kStaticText64,  kEXclsnm,       0, 0);


                    AlignItemEdge(dialog1, kNEWclsnm,      kLeft,    2, kResize);
                    AlignItemEdge(dialog1, kEXclsnm,       kRight,   2, kResize);

                    SetEdgeBinding        (dialog1, kUndo_Btn,      FALSE, FALSE, FALSE, FALSE);
                    SetEdgeBinding        (dialog1, kPaste_Btn,     FALSE, FALSE, FALSE, FALSE);
                    SetEdgeBinding        (dialog1, kAssign,        FALSE, FALSE, FALSE, FALSE);
                    SetEdgeBinding        (dialog1, kGroupBox14,    TRUE, TRUE, TRUE, TRUE);
                    SetEdgeBinding        (dialog1, kGroupBox15,    TRUE, TRUE, TRUE, TRUE);
                    SetEdgeBinding        (dialog1, kGroupBox25,    TRUE, TRUE, TRUE, TRUE);
                    SetEdgeBinding        (dialog1, kGroupBox26,    TRUE, TRUE, TRUE, TRUE);
                    SetEdgeBinding        (dialog1, kNEWclsnm,      TRUE, TRUE, TRUE, TRUE);
                    SetEdgeBinding        (dialog1, kEXclsnm,       TRUE, TRUE, TRUE, TRUE);
                    SetEdgeBinding        (dialog1, kStaticText63,  FALSE, FALSE, TRUE, FALSE);
                    SetEdgeBinding        (dialog1, kStaticText64,  FALSE, FALSE, TRUE, FALSE);
                    SetProportionalBinding(dialog1, kNEWclsnm,      FALSE, FALSE, FALSE, FALSE);
                    SetProportionalBinding(dialog1, kEXclsnm,       FALSE, FALSE, FALSE, FALSE);

                    FOR cnt := 1 TO 15 DO SetHelpString(cnt, GetStr(cnt + 1000));
                END;

            { ***************************************************************** }
                        { PROCEDURES TO DEFINE BUTTONS BEHAVIOUR }
            { ***************************************************************** }

            PROCEDURE Assign_Button;

            Var
                    Selection, Remove, Assign   :Boolean;

            Sel_ndx, Sel_cls            :Integer;

            temp_ndx1, temp_ndx2        :Integer;
            temp_cls1, temp_cls2        :string;
            list_name                   :STRING;
            list_image                  :Integer;
            list_number                 :INTEGER;

            LOC_ClassArray              :DYNARRAY[] of STRING;
            LOC_ClassIndex              :DYNARRAY[] of INTEGER;

            atChoice    :Integer;
            h           :handle;
            x           :Integer;



            Procedure AssignThem(h :HANDLE);
                begin
                    if GetClass(h) = LOC_ClassArray[x]  then SetClass(h, assign_to);
                end;


                BEGIN
                    IF GetNumSelectedLBItems(dialog1, kEXclsnm)<>0 THEN BEGIN

                        list_number := GetNumLBItems(dialog1, kEXclsnm);

                        For atChoice:=0 to list_number Do Begin
                            Selection := IsLBItemSelected(dialog1, kEXclsnm, atChoice);

                            If  Selection=True Then Begin
                                Assign := GetLBItemInfo(dialog1, kEXclsnm, atChoice, kCol0, assign_to, list_image);
                                x:=1;
                            End;

                        End;

                    IF GetNumLBItems(dialog1, kNEWclsnm)<>0 THEN BEGIN

                        list_number := GetNumLBItems(dialog1, kNEWclsnm);
                        Sel_cls := GetNumSelectedLBItems(dialog1, kNEWclsnm);

                        if  Sel_cls=0 Then BEGIN
                            AlrtDialog('No classes Selected');
                        End;

                        if  Sel_cls>0 Then BEGIN
                            clicks := clicks+1;

                            ALLOCATE LOC_ClassArray[1..Sel_cls];
                            ALLOCATE LOC_ClassIndex[1..Sel_cls];
                            Sel_ndx:=1;

                            For atChoice:=0 to list_number Do Begin
                                Selection := IsLBItemSelected(dialog1, kNEWclsnm, atChoice);

                                If  Selection=True Then Begin
                                    Assign := GetLBItemInfo(dialog1, kNEWclsnm, atChoice, kCol0, to_be_assigned, list_image);

                                    LOC_ClassArray[Sel_ndx] := to_be_assigned;
                                    LOC_ClassIndex[Sel_ndx] := atChoice;

                                    Sel_ndx:=Sel_ndx+1;
                                End;

                            End;

                            Sel_ndx:=(Sel_cls);


                            {Sort the Array in Descending order to allow DeleteLBItem work in a Loop }

                            For x:=1 to Sel_cls do BEGIN

                                if x<Sel_ndx Then Begin


                                    temp_ndx1 := LOC_ClassIndex[Sel_ndx];
                                    temp_cls1 := LOC_ClassArray[Sel_ndx];

                                    temp_ndx2 := LOC_ClassIndex[x];
                                    temp_cls2 := LOC_ClassArray[x];

                                    LOC_ClassIndex[x] := temp_ndx1;
                                    LOC_ClassArray[x] := temp_cls1;

                                    LOC_ClassIndex[Sel_ndx] := temp_ndx2;
                                    LOC_ClassArray[Sel_ndx] := temp_cls2;
                                End;
                                Sel_ndx:=(Sel_ndx-1);
                            End;


                            AlrtDialog(Concat('Selected Existing Class:  ', assign_to));

                            For x:=1 to Sel_cls Do BEGIN
                                ForEachObject(AssignThem, SEL);
                                DelClass(LOC_ClassArray[x]);
                                Remove:=DeleteLBItem(dialog1, kNEWclsnm, LOC_ClassIndex[x]);
                            End;
                        End;

                    END ELSE BEGIN
                        AlrtDialog('No more classes need to be reassigned');
                    End;

                END ELSE BEGIN
                    AlrtDialog('SELECT ONE OF THE EXISTING CLASSES');
                End;
            End;

{ ***************************************************************************************************************** }
            Procedure   Add_Button;
            Var
                Selection, Remove, Assign   :Boolean;
                Add                         :Integer;

                Sel_ndx, Sel_cls            :Integer;

                temp_ndx1, temp_ndx2        :Integer;
                temp_cls1, temp_cls2        :string;
                list_name                   :STRING;
                list_image                  :Integer;
                list_number                 :INTEGER;

                LOC_ClassArray              :DYNARRAY[] of STRING;
                LOC_ClassIndex              :DYNARRAY[] of INTEGER;

                atChoice    :Integer;
                h           :handle;
                x           :Integer;


            BEGIN

                IF GetNumLBItems(dialog1, kNEWclsnm)<>0 THEN BEGIN
                    list_number := GetNumLBItems(dialog1, kNEWclsnm);

                    Sel_cls := GetNumSelectedLBItems(dialog1, kNEWclsnm);

                        if  Sel_cls=0 Then BEGIN
                            AlrtDialog('No classes Selected');
                        End;

                    if  Sel_cls>0 Then BEGIN

                        ALLOCATE LOC_ClassArray[1..Sel_cls];
                        ALLOCATE LOC_ClassIndex[1..Sel_cls];

                        Sel_ndx:=1;
                        For atChoice:=0 to list_number Do Begin
                            Selection := IsLBItemSelected(dialog1, kNEWclsnm, atChoice);

                            If  Selection=True Then Begin
                                Assign := GetLBItemInfo(dialog1, kNEWclsnm, atChoice, kCol0, to_be_assigned, list_image);

                                LOC_ClassArray[Sel_ndx] := to_be_assigned;
                                LOC_ClassIndex[Sel_ndx] := atChoice;

                                Sel_ndx:=Sel_ndx+1;
                            End;

                        End;

                        Sel_ndx:=(Sel_cls);

                        {Sort the Array in Descending order to allow DeleteLBItem work in a Loop }

                        For x:=1 to Sel_cls do BEGIN

                            if x<Sel_ndx Then Begin

                                temp_ndx1 := LOC_ClassIndex[Sel_ndx];
                                temp_cls1 := LOC_ClassArray[Sel_ndx];

                                temp_ndx2 := LOC_ClassIndex[x];
                                temp_cls2 := LOC_ClassArray[x];

                                LOC_ClassIndex[x] := temp_ndx1;
                                LOC_ClassArray[x] := temp_cls1;

                                LOC_ClassIndex[Sel_ndx] := temp_ndx2;
                                LOC_ClassArray[Sel_ndx] := temp_cls2;
                            End;
                            Sel_ndx:=(Sel_ndx-1);

                        End;

                        For x:=1 to Sel_cls Do Begin
                            AlrtDialog(Concat(LOC_ClassArray[x],' will be added to the Drawing'));
                            Remove:=DeleteLBItem(dialog1, kNEWclsnm, LOC_ClassIndex[x]);
                            Add:=InsertLBItem(dialog1, kEXclsnm, LOC_ClassIndex[x],LOC_ClassArray[x]);
                        End;
                    End;

                    END ELSE BEGIN
                        IF GetNumLBItems(dialog1, kNEWclsnm)=0 THEN BEGIN
                            AlrtDialog('No more classes can be added');
                            END ELSE BEGIN
                                AlrtDialog('SELECT ONE OF THE EXISTING CLASSES');
                        End;
                    END;

            END;


{ **************************************************************************************************************** }
        Procedure Undo_Button;
        VAR
            x :INTEGER;
            Refresh :Boolean;

        BEGIN

            For x:=1 to Clicks do begin
                DoMenuTextByName('Undo',0);
                Refresh:=RefreshLB(dialog1,kNEWclsnm);
            End;
        END;

        { ***************************************************************** }
                        { END DEFINITION OF BUTTONS BEHAVIOUR }
        { ***************************************************************** }

        PROCEDURE dialog1_Handler(VAR item :LONGINT; data :LONGINT);

        Var
            ColNum,TempI,I : Integer;
            SheetTypeIcon : Integer;
            BSB : Boolean;
            BSS : String;
            Selection : Boolean;

            LayerName,SelectedIconString : String;
            SheetIconNumber,SelectedIconNumber : Integer;


            atChoice    :Integer;
            list_number :Integer;

            list_image  :Integer;
            Assign      :Boolean;
            x,y         :integer;


        BEGIN
            CASE item OF
                SetupDialogC:
                    BEGIN

                        {Load images into kNEWclsnm.}

                        kImageCheckNEW := AddLBImage(dialog1, kNEWclsnm, 1, 11022);
                        kImageBlankNEW := AddLBImage(dialog1, kNEWclsnm, 1, 11023);
                        kImageSheetNEW := AddLBImage(dialog1, kNEWclsnm, 1, 11024);
                        kImageViewNEW := AddLBImage(dialog1, kNEWclsnm, 1, 11025);


                        {Define kNEWclsnm column 0.}
                        cnt := InsertLBColumn        (dialog1, kNEWclsnm, kCol0, 'Class Name', 180);
                        boo := SetLBControlType      (dialog1, kNEWclsnm, kCol0, kStatic);
                        boo := SetLBItemDisplayType  (dialog1, kNEWclsnm, kCol0, kTextOnly);



                        {Initialize the rows to be used in kNEWclsnm.}
                        FOR cnt := 1 TO diff DO BEGIN
                            int := InsertLBItem(dialog1, kNEWclsnm, cnt, ExtraClassNames[cnt]);
                        END;

                        {Insert the data into the columns and assign them to the rows.}
                        LB_SetCell(dialog1, kNEWclsnm, kCol0, kRow1, 'ClassList('')');

                        EnableLBColumnLines(dialog1, kNEWclsnm, TRUE);



                        {Load images into kEXclsnm.}
                        kImageCheckEX := AddLBImage(dialog1, kEXclsnm, 1, 11022);
                        kImageBlankEX := AddLBImage(dialog1, kEXclsnm, 1, 11023);
                        kImageSheetEX := AddLBImage(dialog1, kEXclsnm, 1, 11024);
                        kImageViewEX := AddLBImage(dialog1, kEXclsnm, 1, 11025);


                        {Define kEXclsnm column 0.}
                        cnt := InsertLBColumn        (dialog1, kEXclsnm, kCol0, 'Class Name', 180);
                        boo := SetLBControlType      (dialog1, kEXclsnm, kCol0, kStatic);
                        boo := SetLBItemDisplayType  (dialog1, kEXclsnm, kCol0, kTextOnly);


                        {Initialize the rows to be used in kEXclsnm.}
                        FOR cnt := 1 TO countClasses DO BEGIN
                            int := InsertLBItem(dialog1, kEXclsnm, cnt, CLassnames[cnt]);
                        END;

                        {Insert the data into the columns and assign them to the rows.}
                        LB_SetCell(dialog1, kEXclsnm, kCol0, kRow1, 'ClassList('')');

                        EnableLBColumnLines(dialog1, kEXclsnm, TRUE);

                    END;

                { ***************************************************************** }
                            { CALL PROCEDURES OF BUTTONS BEHAVIOUR}
                { ***************************************************************** }
                kCancel:
                    BEGIN
                        canceled:=TRUE;
                        Didcancel:=canceled;
                    END;

                kUndo_Btn:
                    BEGIN
                        Undo_Button;
                    END;

                kPaste_Btn:
                        BEGIN
                            Add_Button;
                        END;

                kAssign:
                        BEGIN
                            Assign_Button;
                        END;

                kOK:
                    BEGIN



                    END;

                kNEWclsnm:
                    BEGIN
                    {Insert the data into the columns and assign them to the rows.}

                        For cnt:= 1 to numOfClass do

                        LB_SetCell(dialog1, kNEWclsnm, 0, cnt, ClassList(cnt));


                        EnableLBColumnLines(dialog1, kNEWclsnm, TRUE);
                        Select_more:=EnableLBSingleLineSelection(dialog1, kNEWclsnm,FALSE);
                    END;

                kEXclsnm:
                    BEGIN
                    {Insert the data into the columns and assign them to the rows.}

                        For cnt:= 1 to numOfClass do

                        LB_SetCell(dialog1, kEXclsnm, 0, cnt, ClassList(cnt));


                        EnableLBColumnLines(dialog1, kEXclsnm, TRUE);
                        Select_one:=EnableLBSingleLineSelection(dialog1, kEXclsnm,TRUE);
                    END;
            END;


        END;

    BEGIN   {of dialog1_Main}

        kImageCheckNEW  := 0;
        kImageBlankNEW  := 0;
        kImageSheetNEW  := 0;
        kImageViewNEW   := 0;

        kImageCheckEX := 0;
        kImageBlankEX := 0;
        kImageSheetEX := 0;
        kImageViewEX  := 0;


        IF ResourceIsOK THEN dialog1_Setup;
        IF RunLayoutDialog(dialog1, dialog1_Handler) = 1 then BEGIN

        END;
    END;

{ **************************************************************************************************************** }
                                { END OF ALL SUB-PROCEDURES }
{ **************************************************************************************************************** }

BEGIN  {of Smart_Paste}


    Populate_Array1;
    DoMenuTextByName('Paste',0);

    NewcountClasses:=CLASSNUM;

    IF (NewcountClasses=countClasses) THEN BEGIN
        Message('No New Classes Pasted');

    END ELSE BEGIN

        Populate_Array2;

        Populate_Array_Extra;

        index := 1;
        clicks := 0;
        dialog1_Main;
        IF Didcancel THEN BEGIN
            DoMenuTextByName('Undo',0);
        END;
    END;

END;

{ ***************************************************************************************************************** }

RUN(Smart_Paste);



{This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.}