Re: Сортировка элементов массива
Написал wOxxOm в 22/10/2008 16:23:41
не проверял, но взят работающий кусок и адаптирован:
Set gb = ActivePage.FindShapes(, cdrTextShape)
'в объявлении New использовать не надо, ибо будет тормозить
dim coll as Collection: set coll=new Collection
for each s in gb
collStuffSorted coll, s, -1
next
' теперь массив сортирован
dim obj as object ' на всякий случай если не пройдет перебор через 's'
for each obj in coll
set s=obj
'а дальше работать с 's' как с обычным объектом Shape
.............
.............
next
Function collStuffSorted&(coll As Collection, sh as shape, ByVal Direction&)
Dim a&, b&, C&, rel&
a = 1: b = coll.Count: C = 0: rel = 0
dim key0 as double: key0 = sh.PositionX
Do While b - a >= 0
C = (a + b) \ 2: rel = (key0 - coll(C).PositionX) * Direction
Select Case rel
Case is < 0: If C = a Then Exit Do Else b = C
Case 0: Exit Do
Case is > 0: If b = a Then Exit Do Else If a = C Then a = b Else a = C
End Select
Loop
If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add s, , C Else coll.Add s, , , C
End Function
Set gb = ActivePage.FindShapes(, cdrTextShape)
'в объявлении New использовать не надо, ибо будет тормозить
dim coll as Collection: set coll=new Collection
for each s in gb
collStuffSorted coll, s, -1
next
' теперь массив сортирован
dim obj as object ' на всякий случай если не пройдет перебор через 's'
for each obj in coll
set s=obj
'а дальше работать с 's' как с обычным объектом Shape
.............
.............
next
Function collStuffSorted&(coll As Collection, sh as shape, ByVal Direction&)
Dim a&, b&, C&, rel&
a = 1: b = coll.Count: C = 0: rel = 0
dim key0 as double: key0 = sh.PositionX
Do While b - a >= 0
C = (a + b) \ 2: rel = (key0 - coll(C).PositionX) * Direction
Select Case rel
Case is < 0: If C = a Then Exit Do Else b = C
Case 0: Exit Do
Case is > 0: If b = a Then Exit Do Else If a = C Then a = b Else a = C
End Select
Loop
If C = 0 Then coll.Add sh Else If rel = -1 Then coll.Add s, , C Else coll.Add s, , , C
End Function
Источник: https://powerclip.ru/modules/newbb/viewtopic.php?post_id=91538
