Gio Pet

PROCEDURE Paste_Reassign;



VAR

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

    countClasses, NewcountClasses   :INTEGER;
    diff, StartClass,w,y,x          :INTEGER;
    index                           :INTEGER;

    DidCancel   :BOOLEAN;
    StringMatch  :BOOLEAN;

    OldClass            :STRING;
    NewClass            :STRING;
    VerifyValuesAFTER       :STRING;
    VerifyValuesBEFORE      :STRING;

    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

            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;

            VerifyValuesBEFORE := 'Macintosh HD:VerifyValuesBEFORE.txt';
            Append(VerifyValuesBEFORE);
            WRITE(diff);
            WRITELN(' New classes are being copied');
            WRITE('The Index of the first new class is: ');
            WRITELN(StartClass);
            WRITE('The Index of the last class is: ');
            WRITELN(Newcountclasses);
                FOR w:=1 TO NewcountClasses DO BEGIN
                        WRITE('The Class Name of index: ');
                        WRITE(w);
                        WRITE(' is: ');
                        WRITELN(NewClassNames[w]);
                END;
            close (VerifyValuesBEFORE);
    END;






    PROCEDURE AutomaticDlog;

    CONST

        kDlgID=1;
        kItem1bName='Ok';
        kItem2bName='Cancel';
        kItem3fName='Assign this Class:';
        kItem5fName='To this:';
        kItem4cName='OldClassPop';
        kItem6cName='NewClassPop';

        Procedure SetupDialog;
        Var
            i:INTEGER;
            major, minor, maint, platform:INTEGER;
        Begin
            GetVersion(major, minor, maint, platform);
            BeginDialog(kDlgID, 1, 0, 0,300,320);
                if (platform = 1) then
                begin { macintosh }
                    AddButton(kItem1bName,1,1,200,280,285,320);
                    AddButton(kItem2bName,2,1,105,280,185,320);
                end
                else { windows }
                begin
                    AddButton(kItem1bName,1,1,200,280,285,320);
                    AddButton(kItem2bName,2,1,105,280,185,320);
                end;
                AddField(kItem3fName,3,1,12,12,188,28);
                AddField(kItem5fName,5,1,12,67,188,83);
                AddChoiceItem(kItem4cName,4,1,12,37,283,57);
                AddChoiceItem(kItem6cName,6,1,12,92,283,112);
           EndDialog;
        End; {of SetupDialog}

    Procedure HandleDialog;
        Var
            item, Count     :INTEGER;
            done, canceled  :BOOLEAN;
            error           :BOOLEAN;
        Begin
            GetDialog(kDlgID);

            FOR Count := 1 TO diff
            DO BEGIN
                InsertChoice(4,Count, ExtraClassNames[Count]);
            END;

            FOR Count := 1 TO countClasses
            DO BEGIN
                InsertChoice(6,Count, ClassNames[Count]);
            END;

            SetTitle('Class Reassign-Delete');
            error := false;
            canceled := false;
            done := false;
            while (not canceled) and (not done) do
            begin
                DialogEvent(item);
                Case item OF
                    1: if (not error) then
                            done:= true
                       else Sysbeep;
                    2: canceled:= true;
                end; {of case}

            end;
            if (done) then
            begin
                { this would be a good place to retrieve the data     }
                DidCancel := canceled;
                GetSelChoice(4, 0, NewcountClasses, NewClass);
                GetSelChoice(6, 0, countClasses, OldClass);
            end;
            ClrDialog;

            if (canceled) Then
            Begin
                DidCancel := canceled;
                DoMenuTextByName('Undo',0);
            End;

        End; {of HandleDialog}
    BEGIN    {of AutomaticDlog}
        SetupDialog;
        HandleDialog;
    END;


    PROCEDURE reassignclass(h:handle);
        BEGIN
        IF GetClass(h) = Newclass THEN SetClass(h, Oldclass);
    END;

    PROCEDURE ReAllocate_Array;
        BEGIN
            diff:=diff-1;
            StartClass:=3;
            NewcountClasses:=CLASSNUM;


            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;


BEGIN  {of Paste_Reassign}

        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;

            WHILE NewcountClasses<>countClasses DO BEGIN                { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                AutomaticDlog;

                IF NOT DidCancel
                    THEN BEGIN
                    foreachobject(reassignclass,InSymbol);
                    DelClass(NewClass);
                    index:=1;                         { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                    StringMatch:=False;                   { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                        While (index<=NewcountClasses) AND NOT StringMatch Do BEGIN   { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                            IF ExtraClassNames[index]=NewClass THEN BEGIN          { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                            StringMatch:=True;                                   { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                            ExtraClassNames[index]:=nil;                         { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                            END ELSE index:=index+1;                             { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }
                            END;

                    ReAllocate_Array;             { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }

                END;

            END;
        END;
END;
RUN(Paste_Reassign);