! 發展單位：風禹科技驗證有限公司
! 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水博肄，微軟最有價值專家
! Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
! --------------------------------------------------------------------------------------

Module modStrTools
	Use kernel32
	
	Integer, Private, Parameter :: StrTools_ChangeType = 32

Contains
   ! 字串轉實數陣列
   Integer Function SplitToReal(arrReal, strSource, strDivision, bContinue)
		Character*(*) :: strSource, strDivision
		Integer :: i, nCount, nLen, nScan, nLoc
		Logical :: bContinue, pContinue
		Real, Allocatable :: arrReal(:)
      Optional :: strDivision, bContinue
		Character, Pointer :: pDivision
		Character*1 :: strComma
		Target :: strDivision, strComma
		
		strComma = ','		
      If (Present(strDivision)) Then
			pDivision => strDivision
		Else
			pDivision => strComma
		End If
		
      If (Present(bContinue)) Then
			pContinue = bContinue
		Else
			pContinue = .False.
		End If
		
		nLen = Len(pDivision)
		nCount = 0
      nLoc = 1
		Do 
		   nScan = Scan(strSource(nLoc:), pDivision)
			If (nScan > 0) Then
			   nLoc = nLoc + nScan + nLen - 1
			   If (pContinue .And. (nScan == 1)) Then
			   Else
				   nCount = nCount + 1
				End If
			Else
			   nCount = nCount + 1
			   Exit
			End If
		End Do		

		If (Allocated(arrReal)) Then
			Deallocate(arrReal)
		End If

		Allocate(arrReal(nCount))

		Read(strSource, *) (arrReal(i), i = 1, nCount)

		SplitToReal = nCount

   End Function

   ! 字串轉實數
   Real Function StringToReal(sValue)
      Character*(*) :: sValue
      Character*(StrTools_ChangeType) :: strValue
      Integer :: iLoc

      strValue = sValue
		iLoc = Scan(strValue,'.')
		If (iLoc == 0) Then
		   strValue = Trim(strValue) // '.'
		End If

		Read(strValue,*) StringToReal
      
   End Function

   ! 實數轉字串
   Character*(StrTools_ChangeType) Function RealToString(vReal, bNoZero)
      Real :: vReal
		Logical :: bNoZero, pNoZero
      Optional :: bNoZero
      Integer :: iNoZero

      If (Present(bNoZero)) Then
			pNoZero = bNoZero
		Else
			pNoZero = .False.
		End If
		RealToString = Repeat(' ', StrTools_ChangeType)
      
      Write(RealToString, *) vReal
      RealToString = RealToString(ContinueLoc(RealToString, ' ')+1:)
      
      If (pNoZero) Then
			iNoZero = ContinueLoc(RealToString, '0', 0, .True.)
			If (iNoZero > 0) Then
				RealToString = RealToString(1:iNoZero - 1)
			End If
      End If
   End Function

   ! 整數轉字串
   Character*(StrTools_ChangeType) Function IntToString(int)
      Integer :: int
      Write(IntToString, '(I32)') int
      IntToString = IntToString(ContinueLoc(IntToString, ' ')+1:)      
   End Function
   
   ! 連續符號最後位置
   Integer Function ContinueLoc(sSource, sFind, pStart, pBackSearch)
      Character*(*) :: sSource, sFind
      Integer :: nStart, i, nLen, pStart
      Optional :: pStart, pBackSearch
      Logical :: pBackSearch, bBackSearch
      
      nLen = Len(sFind)
      
		If (Present(pBackSearch)) Then
		   bBackSearch = pBackSearch
		Else
			bBackSearch = .False.
		End If

		If (Present(pStart)) Then
		   nStart = pStart
		Else
			nStart = 0
		End If

		If (nStart <= 0) Then
			If (bBackSearch) Then
				nStart = Len(Trim(sSource))
			Else
				nStart = 1
			End If
		End If
		
		ContinueLoc = -1
		If (bBackSearch) Then
			Do i = nStart, 1, -nLen
				If (sSource(i-nLen+1:i) /= sFind) Then
					ContinueLoc = i + nLen
					Exit				
				End If
			End Do
		Else
			Do i = nStart, Len(sSource), nLen
				If (sSource(i:i+nLen-1) /= sFind) Then
					ContinueLoc = i - nLen
					Exit
				End If
			End Do
		End If
      
      If (ContinueLoc < 0) Then
         ContinueLoc = 0
      End If
      
   End Function

End Module