Честа стандартна процедура при създаване на етикети е удвояване на обекти. Това удвояване може да става във всяка една посока - наляво, надясно, нагоре, надолу. Освен това може да се зададе и брой на удвояванията. Ако ли пък не се зададе посока, а само брой на удвояванията, то удвояваните обекти се натрупват един върху друг. Всичко това е организирано в една потребителска форма с един бутон DUPLICATE, един текст бокс, където се въвежда броят и четири чек бокса, разположени около текст бокса - UP, DOWN, LEFT, RIGHT. Чек боксовете указват посоката на удвояването.
В лявата част на формата има син бутон DUPLICATE. В ляво от него има TextBox Distance - Там се записва на какво разстояние трябва да е удвоеният обект от оригинала. В дясно от DUPLICATE има TextBox, където се записва броят на копията. Около текст бокса с броя на копията има check boxes - UO, DOWN, LEFT, RIGHT. Те показват посоката на удвояване. Ако не се избере нито една посока, то копията се наслагват върху оригинала.
Код на DUPLICATE
Private Sub CommandButton6_Click()Dim S1 As Shape, s2 As Shape'DUPLICATE RIGHTIf Me.cbDuplicateRight Then 'Set s1 = ActiveLayer.CreateEllipse(2, 7, 4, 5)'Set s1 = ActiveShapeSet S1 = ActiveSelection 'Set s2 = s1.Duplicate(3, -5) 'Set s2 = s1.Duplicate(0, 0)'DUPLICATE OVERFor X = 1 To Me.tbDuplicate.Value 'Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, 0) Set s2 = S1.Duplicate(ActiveSelection.SizeWidth + tbDistance.Value / 25.4, 0)' Set s2 = s1.Duplicate(ActiveSelection.SizeWidth + tbDistance.Value / 25, 0)NextEnd If
'DUPLICATE LEFTIf Me.cbDuplicateLeft Then 'Set s1 = ActiveLayer.CreateEllipse(2, 7, 4, 5)'Set s1 = ActiveShapeSet S1 = ActiveSelection
'Set s2 = s1.Duplicate(3, -5) 'Set s2 = s1.Duplicate(0, 0)'DUPLICATE OVERFor X = 1 To Me.tbDuplicate.Value 'Set s2 = s1.Duplicate(-ActiveShape.SizeWidth * x, 0) 'on same x coord Set s2 = S1.Duplicate(-ActiveSelection.SizeWidth - tbDistance.Value / 25.4, 0) 'on same x coord' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, 1)' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, -1)NextEnd If
'DUPLICATE TOPIf Me.cbDuplicateTop Then 'Set s1 = ActiveLayer.CreateEllipse(2, 7, 4, 5)'Set s1 = ActiveShapeSet S1 = ActiveSelection 'Set s2 = s1.Duplicate(3, -5) 'Set s2 = s1.Duplicate(0, 0)'DUPLICATE OVERFor X = 1 To Me.tbDuplicate.Value Set s2 = S1.Duplicate(0, ActiveSelection.SizeHeight + tbDistance.Value / 25.4) 'on same Y coord' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, 1)' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, -1)NextEnd If
'DUPLICATE BOTTOMIf Me.cbDuplicateBottom Then 'Set s1 = ActiveLayer.CreateEllipse(2, 7, 4, 5)'Set s1 = ActiveShapeSet S1 = ActiveSelection 'Set s2 = s1.Duplicate(3, -5) 'Set s2 = s1.Duplicate(0, 0)'DUPLICATE OVERFor X = 1 To Me.tbDuplicate.Value ''''' Set s2 = s1.Duplicate(0, -ActiveShape.SizeHeight * x) 'on same Y coordSet s2 = S1.Duplicate(0, -ActiveSelection.SizeHeight - tbDistance.Value / 25.4) 'on same Y coord' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, 1)' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, -1)NextEnd If
If Me.cbDuplicateRight = False And Me.cbDuplicateLeft = False And Me.cbDuplicateTop = False And Me.cbDuplicateBottom = False Then 'Set s1 = ActiveLayer.CreateEllipse(2, 7, 4, 5)'Set s1 = ActiveShapeSet S1 = ActiveSelection 'Set s2 = s1.Duplicate(3, -5) 'Set s2 = s1.Duplicate(0, 0)'DUPLICATE OVERFor X = 1 To Me.tbDuplicate.Value ''''' Set s2 = s1.Duplicate(0, -ActiveShape.SizeHeight * x) 'on same Y coordSet s2 = S1.Duplicate(0, 0) 'on same place' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, 1)' Set s2 = s1.Duplicate(ActiveShape.SizeWidth * x, -1)NextEnd IfEnd Sub
Код на DUPLICATE UPPrivate Sub cbDuplicateTop_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)cbDuplicateBottom = FalsecbDuplicateRight = FalsecbDuplicateLeft = False'cbDuplicateTop = TrueEnd Sub