V-Форум / Corel VBA / Тема: Сортировка элементов массива
Сортировка элементов массива
22/10/2008 16:04:44 #Link
есть код:
Set gb = ActivePage.FindShapes(, cdrTextShape)
For Each s In gb
's.PositionX
s.Text.Replace KW, FormatNumber(n, 0, vbTrue, vbFalse, vbFalse), False, ReplaceAll:=True
n = n + 1
Next s
Как отсортировать масив gb по значению элемента s.PositionX от большего к меньшему?
Set gb = ActivePage.FindShapes(, cdrTextShape)
For Each s In gb
's.PositionX
s.Text.Replace KW, FormatNumber(n, 0, vbTrue, vbFalse, vbFalse), False, ReplaceAll:=True
n = n + 1
Next s
Как отсортировать масив gb по значению элемента s.PositionX от большего к меньшему?
Re: Сортировка элементов массива
22/10/2008 16:23:41 #Link
не проверял, но взят работающий кусок и адаптирован:
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
Re: Сортировка элементов массива
22/10/2008 23:57:22 #LinkwOxxOm
Спасибо за ответ,
пока не пробовал.
Как только время найду применю ...
И напишу ощущения
Спасибо за ответ,
пока не пробовал.Как только время найду применю ...
И напишу ощущения
Источник: https://powerclip.ru/modules/newbb/viewtopic.php?topic_id=8154&start=0
