ab.com コミュニティ

コード: 全て選択

Sub kuikkusooto(buffer As BytePtr,size As DWord)
	Dim pipotto As Byte
	Dim i As Long
	Dim j As Long
	Dim temp As Byte
	Dim bunkatu As DWordPtr
	Dim bunkatukazu As Long
	Dim bunkatusaidai As Long
	If size>=2 Then
		bunkatukazu=1
		bunkatu=calloc(2*Len(bunkatukazu))
		bunkatusaidai=1
		bunkatu[0]=0
		bunkatu[1]=size-1
		While bunkatukazu>=1
			If bunkatu[bunkatukazu*2-1]-bunkatu[bunkatukazu*2-2]>1 Then
				pipotto=buffer[bunkatu[bunkatukazu*2-1]]
				i=bunkatu[bunkatukazu*2-2]
				j=bunkatu[bunkatukazu*2-1]-1
				bunkatukazu--
				Do
					While buffer<pipotto and i<size
						i++
					Wend
					While buffer[j]>pipotto and j>=0
						j--
					Wend
					If j<=i Then
						temp=buffer
						buffer=buffer[bunkatu[bunkatukazu*2+1]]
						buffer[bunkatu[bunkatukazu*2+1]]=temp'ピポットと交換
						Exit Do
					End If
					temp=buffer
					buffer=buffer[j]
					buffer[j]=temp'交換
					i++
					j--
				Loop
				If i<size-1 Then
					If bunkatukazu>=bunkatusaidai Then
						bunkatu=realloc(bunkatu,(bunkatusaidai+1)*2*Len(bunkatukazu))
						bunkatusaidai++
					End If
					buffer[bunkatukazu*2]=i+1
					bunkatu[bunkatukazu*2+1]=bunkatu[bunkatukazu*2-1]'分割された後ろのところ
					bunkatukazu++
				End If
				If i>0 Then
					If bunkatukazu>=bunkatusaidai Then
						bunkatu=realloc(bunkatu,(bunkatusaidai+1)*2*Len(bunkatukazu))
						bunkatusaidai++
					End If
					bunkatu[bunkatukazu*2]=bunkatu[bunkatukazu*2-2]
					bunkatu[bunkatukazu*2+1]=i-1'分割された前のところ
					bunkatukazu++
				End If
			Else
				bunkatukazu--
			End If
		Wend
		free(bunkatu)
	End If
End Sub