SHARE
TWEET

Gio Pet

a guest Jan 26th, 2010 76 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2. PROCEDURE Paste_Reassign;
  3.  
  4.  
  5.  
  6. VAR
  7.        
  8.         ClassNames              :DYNARRAY[] of STRING;
  9.         NewClassNames   :DYNARRAY[] of STRING;
  10.         ExtraClassNames :DYNARRAY[] of STRING;
  11.        
  12.         countClasses, NewcountClasses   :INTEGER;
  13.         diff, StartClass,w,y,x                  :INTEGER;
  14.         index                                                   :INTEGER;
  15.        
  16.         DidCancel       :BOOLEAN;
  17.         StringMatch  :BOOLEAN;
  18.        
  19.         OldClass                        :STRING;
  20.         NewClass                        :STRING;
  21.         VerifyValuesAFTER               :STRING;
  22.         VerifyValuesBEFORE              :STRING;
  23.        
  24.         PROCEDURE Populate_Array1;
  25.         VAR
  26.                 x       :INTEGER;
  27.                 y       :INTEGER;
  28.                 w       :INTEGER;
  29.                
  30.                 BEGIN
  31.                 countClasses:=CLASSNUM;
  32.                 ALLOCATE ClassNames [1..countClasses];
  33.  
  34.                         FOR x:= 1 TO countClasses DO BEGIN
  35.                                 y:=x;
  36.                                 CLassnames[y] := ClassList(x);                  
  37.                         END;
  38.         END;
  39.        
  40.         PROCEDURE Populate_Array2;     
  41.     VAR
  42.                                 x       :INTEGER;
  43.                                 y       :INTEGER;
  44.                                 w       :INTEGER;
  45.         BEGIN
  46.                                
  47.                                 ALLOCATE NewClassNames [1..NewcountClasses];
  48.                                
  49.                                         FOR x:= 1 TO NewcountClasses DO BEGIN
  50.                                                 y:=x;
  51.                                                 NewClassNames[y] := ClassList(x);  
  52.                                         END;           
  53.         END;
  54.        
  55.        
  56.         PROCEDURE Populate_Array_Extra;
  57.         VAR
  58.                 x       :INTEGER;
  59.                 y       :INTEGER;
  60.                 w       :INTEGER;
  61.                
  62.                 BEGIN
  63.                        
  64.                         diff:=(NewcountClasses - countClasses);
  65.                         StartClass:=(NewcountClasses - diff)+1;
  66.                        
  67.                         ALLOCATE ExtraClassNames [1..diff];    
  68.                                                
  69.                                        
  70.                         y:=1;                  
  71.                                 FOR x:=(StartClass) TO (NewcountClasses) DO BEGIN
  72.                                         IF  y<=diff THEN BEGIN
  73.                                         ExtraClassNames[y] := NewClassNames[x];                                
  74.                         y:=y+1;
  75.                 END;
  76.                 END;
  77.                        
  78.                 VerifyValuesBEFORE := 'Macintosh HD:VerifyValuesBEFORE.txt';
  79.                 Append(VerifyValuesBEFORE);
  80.                 WRITE(diff);  
  81.                         WRITELN(' New classes are being copied');
  82.                         WRITE('The Index of the first new class is: ');
  83.                         WRITELN(StartClass);
  84.                         WRITE('The Index of the last class is: ');
  85.                         WRITELN(Newcountclasses);
  86.                                 FOR w:=1 TO NewcountClasses DO BEGIN
  87.                                         WRITE('The Class Name of index: ');
  88.                                         WRITE(w);
  89.                                         WRITE(' is: ');
  90.                                         WRITELN(NewClassNames[w]);
  91.                                 END;
  92.                         close (VerifyValuesBEFORE);
  93.         END;
  94.  
  95.  
  96.        
  97.  
  98.  
  99.  
  100.         PROCEDURE AutomaticDlog;
  101.                
  102.         CONST
  103.        
  104.                 kDlgID=1;
  105.                 kItem1bName='Ok';
  106.                 kItem2bName='Cancel';
  107.                 kItem3fName='Assign this Class:';
  108.                 kItem5fName='To this:';
  109.                 kItem4cName='OldClassPop';
  110.                 kItem6cName='NewClassPop';
  111.        
  112.                 Procedure SetupDialog;
  113.                 Var
  114.                         i:INTEGER;
  115.                         major, minor, maint, platform:INTEGER;
  116.                 Begin
  117.                         GetVersion(major, minor, maint, platform);
  118.                         BeginDialog(kDlgID, 1, 0, 0,300,320);
  119.                                 if (platform = 1) then
  120.                                 begin { macintosh }
  121.                                         AddButton(kItem1bName,1,1,200,280,285,320);
  122.                                         AddButton(kItem2bName,2,1,105,280,185,320);
  123.                                 end
  124.                                 else { windows }
  125.                                 begin
  126.                                         AddButton(kItem1bName,1,1,200,280,285,320);
  127.                                         AddButton(kItem2bName,2,1,105,280,185,320);
  128.                                 end;
  129.                                 AddField(kItem3fName,3,1,12,12,188,28);
  130.                                 AddField(kItem5fName,5,1,12,67,188,83);
  131.                                 AddChoiceItem(kItem4cName,4,1,12,37,283,57);
  132.                                 AddChoiceItem(kItem6cName,6,1,12,92,283,112);
  133.                EndDialog;
  134.                 End; {of SetupDialog}
  135.        
  136.         Procedure HandleDialog;
  137.                 Var
  138.                         item, Count             :INTEGER;
  139.                         done, canceled  :BOOLEAN;
  140.                         error                   :BOOLEAN;
  141.                 Begin
  142.                         GetDialog(kDlgID);
  143.                        
  144.                         FOR Count := 1 TO diff
  145.                         DO BEGIN
  146.                                 InsertChoice(4,Count, ExtraClassNames[Count]);
  147.                         END;
  148.  
  149.                         FOR Count := 1 TO countClasses
  150.                         DO BEGIN
  151.                                 InsertChoice(6,Count, ClassNames[Count]);
  152.                         END;
  153.                        
  154.                         SetTitle('Class Reassign-Delete');
  155.                         error := false;
  156.                         canceled := false;
  157.                         done := false;
  158.                         while (not canceled) and (not done) do
  159.                         begin
  160.                                 DialogEvent(item);
  161.                                 Case item OF
  162.                                         1: if (not error) then
  163.                                                         done:= true
  164.                                            else Sysbeep;
  165.                                         2: canceled:= true;
  166.                                 end; {of case}
  167.  
  168.                         end;
  169.                         if (done) then
  170.                         begin
  171.                         { this would be a good place to retrieve the data     }
  172.                         DidCancel := canceled;
  173.                                 GetSelChoice(4, 0, NewcountClasses, NewClass);
  174.                         GetSelChoice(6, 0, countClasses, OldClass);
  175.                         end;
  176.                         ClrDialog;
  177.                        
  178.                         if (canceled) Then
  179.                         Begin
  180.                                 DidCancel := canceled;
  181.                                 DoMenuTextByName('Undo',0);
  182.                         End;
  183.                
  184.                 End; {of HandleDialog}
  185.         BEGIN    {of AutomaticDlog}
  186.                 SetupDialog;
  187.                 HandleDialog;
  188.         END;
  189.  
  190.  
  191.     PROCEDURE reassignclass(h:handle);
  192.         BEGIN
  193.         IF GetClass(h) = Newclass THEN SetClass(h, Oldclass);
  194.     END;  
  195.  
  196.         PROCEDURE ReAllocate_Array;
  197.                 BEGIN
  198.                         diff:=diff-1;
  199.                         StartClass:=3;
  200.                         NewcountClasses:=CLASSNUM;
  201.                        
  202.                                
  203.                         ALLOCATE ExtraClassNames [1..diff];    
  204.                                        
  205.                         y:=1;                  
  206.                                 FOR x:=(StartClass) TO (NewcountClasses) DO BEGIN
  207.                                         IF  y<=diff THEN BEGIN
  208.                                         ExtraClassNames[y] := NewClassNames[x];                                
  209.                         y:=y+1;
  210.                         END;
  211.                 END;
  212.          END;          
  213.        
  214.        
  215. BEGIN  {of Paste_Reassign}
  216.                
  217.                 Populate_Array1;
  218.                 DoMenuTextByName('Paste',0);
  219.                 NewcountClasses:=CLASSNUM;
  220.                 IF (NewcountClasses=countClasses) THEN BEGIN
  221.                
  222.                         Message('No New Classes Pasted');
  223.                         END ELSE BEGIN
  224.                        
  225.                         Populate_Array2;
  226.                         Populate_Array_Extra;
  227.                            
  228.                         WHILE NewcountClasses<>countClasses DO BEGIN                { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }  
  229.                                 AutomaticDlog;
  230.                                                
  231.                                 IF NOT DidCancel
  232.                                         THEN BEGIN
  233.                                         foreachobject(reassignclass,InSymbol);
  234.                                         DelClass(NewClass);
  235.                                         index:=1;                                 { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }    
  236.                                         StringMatch:=False;                       { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }                  
  237.                                                 While (index<=NewcountClasses) AND NOT StringMatch Do BEGIN   { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }  
  238.                                                         IF ExtraClassNames[index]=NewClass THEN BEGIN          { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }  
  239.                                                         StringMatch:=True;                                   { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }  
  240.                                                         ExtraClassNames[index]:=nil;                         { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }  
  241.                                                         END ELSE index:=index+1;                             { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }            
  242.                                                         END;
  243.                
  244.                                         ReAllocate_Array;                 { note: this can be deleted to test the script withtout LOOPING THE DIALOG   }  
  245.                                        
  246.                                 END;
  247.  
  248.             END;
  249.                 END;
  250. END;                           
  251. RUN(Paste_Reassign);
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top