[Resolvido] array

[xanburzum 169]

Uma classe que executa um array direcional de 2 dimensões

 

Uso:

 

SortArray(aArray,OrderBy,Dir). aArray = array OrderBy = column ordinal Dir = direction ("ASC"/"DEC")

 

<%

' classe que realiza 
' Um direcional em uma array de dimensão 2 

Class ArrayCls

	Public function SortArray(aArray,OrderBy,Dir)
		'matriz aArray - 2 dimensional 
                'Orderby - Ordinal de coluna para classificar por 
		'Dir - Direção para classificar em (ASC/DESC)
		'Se o tipo de direção é omitido ou não ASC ou DESC,é definida asc
		dir = lcase (dir)
		if dir = "" or (dir<>"asc" and dir<>"desc") then dir = "asc"
		if len(orderby) = 0 then orderby = 0

		san = 0
		do 
			changed = false

			for row = 0 to ubound(aArray,1)-1
				'response.write " AlphaCompare("& aArray(row,OrderBy)&","& aArray(row+1,OrderBy)&")=" & AlphaCompare(aArray(row,OrderBy),aArray(row+1,OrderBy)) & "<br>"
				select case AlphaCompare(aArray(row,OrderBy),aArray(row+1,OrderBy))
					case 0
				
					case 1
						'row row is alpha< than row row+1
						IF dir = "desc" then
							aArray = SwapRows(aArray,row,row+1)
							changed = true
						end if
					case 2
						'row row+1 is alpha< than row n
						if dir = "asc" then
							aArray = SwapRows(aArray,row,row+1)
							changed = true
						end if
				end select
			next
			san = san + 1

		loop until changed = false or san = ubound(aArray,1)

		IF san => (ubound(aArray,1)*ubound(aArray,1)) THEN response.write "Falha de verificação snaity!<br>"

		SortArray = aArray

	end function

'**************
'**Private functions

	private function SwapRows(aArray,row1,row2)

		temp = array

		Copie aArray em uma variável temp 
		redim temp(ubound(aArray,1),ubound(aArray,2))
		for y = 0 to ubound(aArray,1)
			for x = 0 to ubound(aArray,2)
				temp(y,x) = aArray(y,x)
			next
		next
		for n = 0 to ubound(aArray,2)
			'Troque a linha de valores
			temp(row1,n) = aArray(row2,n)
			temp(row2,n) = aArray(row1,n)
		next

		'Retorna nova matriz
		SwapRows = temp

	end function

	private function AlphaCompare(val1,val2)

		'Compare val1 e Val1
		' - retorna 0 para o mesmo
		'	1 if val1 is top
		'	2 if val2 is top

		val1 = lcase(trim(val1))
		val2 = lcase(trim(val2))

		if val1 = val2 then 
			AlphaCompare = 0
			exit function
		end if

		len1 = len(val1)
		len2 = len(val2)

		if len1 < len2 then
			checkchars  = len1
			'len1 é mais curto para o padrão é 1
			AlphaCompare = 1
		else
			checkchars  = len2
			'len1 é mais curto para o padrão
			AlphaCompare = 2
		end if

		FOR n = 1 to checkchars
			checkchar1 = asc(mid(val1,n,1))
			checkchar2 = asc(mid(val2,n,1))
			
			if checkchar1 < checkchar2 then
				AlphaCompare = 1
				exit function
			end if
			
			if checkchar2 < checkchar1 then
				AlphaCompare = 2
				exit function
			end if
			
		next

	end function

End Class
%>