Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {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;
- GLO_ClassArray :ARRAY [1..200] of STRING;
- GLO_Ex_Class :ARRAY [1..200] of STRING;
- to_be_assigned :String;
- assign_to : String;
- countClasses, NewcountClasses :INTEGER;
- diff, StartClass :INTEGER;
- index :INTEGER;
- Didcancel :BOOLEAN;
- canceled :BOOLEAN;
- StringMatch :BOOLEAN;
- OldClass :STRING;
- NewClass :STRING;
- VerifyValuesAFTER :STRING;
- VerifyValuesBEFORE :STRING;
- AlertMessage :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
- 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;
- 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 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;
- xmlID :LONGINT;
- cnt :INTEGER;
- int :INTEGER;
- boo :BOOLEAN;
- Select_more :BOOLEAN;
- Select_one :BOOLEAN;
- str :STRING;
- ndx :INTEGER;
- numOfClass :INTEGER;
- classname :INTEGER;
- {$Include _DialogBuilderUtilities.px}
- 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;
- { ***************************************************************** }
- PROCEDURE Assign_Button;
- Var
- Selection : Boolean;
- Assign : Boolean;
- Remove : Boolean;
- Sel_ndx : Integer;
- Sel_cls : Integer;
- x : Integer;
- temp_ndx1 :Integer;
- temp_ndx2 :Integer;
- temp_cls1 :string;
- temp_cls2 :string;
- atChoice :INTEGER;
- list_name :STRING;
- list_image :Integer;
- list_number :INTEGER;
- h : handle;
- LOC_ClassArray :DYNARRAY[] of STRING;
- LOC_ClassIndex :DYNARRAY[] of INTEGER;
- 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
- 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
- Remove:=DeleteLBItem(dialog1, kNEWclsnm, LOC_ClassIndex[x]);
- foreachobject(ReassignClass,InSymbol);
- DelClass(LOC_ClassArray[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 : Boolean;
- Assign : BOOLEAN;
- Remove : Boolean;
- Paste_in : Integer;
- Sel_ndx : Integer;
- Sel_cls : Integer;
- x : Integer;
- temp_ndx1 :Integer;
- temp_ndx2 :Integer;
- temp_cls1 :string;
- temp_cls2 :string;
- atChoice :INTEGER;
- list_name :STRING;
- list_image :Integer;
- list_number :INTEGER;
- h : handle;
- LOC_ClassArray :DYNARRAY[] of STRING;
- LOC_ClassIndex :DYNARRAY[] of INTEGER;
- { ReassignClass ------------------------------------------ }
- PROCEDURE ReassignClass( h : HANDLE );
- BEGIN
- IF GetClass( h ) = LOC_ClassArray[x] THEN SetClass(h, assign_to);
- END;
- { ------------------------------------------ }
- 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]);
- Paste_in:=InsertLBItem(dialog1, kEXclsnm, LOC_ClassIndex[x],LOC_ClassArray[x]);
- End;
- End;
- END ELSE BEGIN
- AlrtDialog('SELECT ONE OF THE EXISTING CLASSES');
- End;
- End;
- { ***************************************************************** }
- { ***************************************************************** }
- PROCEDURE dialog1_Handler(VAR item :LONGINT; data :LONGINT);
- Var
- ColNum,TempI,I : Integer;
- SheetTypeIcon : Integer;
- BSB : Boolean;
- BSS : String;
- Selection : Boolean;
- LayerHand : Handle;
- LayerName,SelectedIconString : String;
- SheetIconNumber,SelectedIconNumber : Integer;
- Click : Integer;
- Sel_cls : 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;
- kCancel:
- BEGIN
- canceled:=TRUE;
- Didcancel:=canceled;
- END;
- kUndo_Btn:
- BEGIN
- END;
- kPaste_Btn:
- BEGIN
- Add_Button;
- END;
- kAssign:
- BEGIN
- Assign_Button;
- END;
- kOK:
- BEGIN
- {DELETE...}
- UpdateVSOsInDrawing(dialog1, 'All Control Types');
- {...DELETE}
- 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
- 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;
- { ***************************************************************** }
- 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;
- index := 1;
- AlertMessage:= (' NEW INCOMING Classes need to be Reassigned to the Existing Classes');
- 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/>.}
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement