'''''''''''''''''''''''''''''''''
'Delete pages with given numbers'
'''''''''''''''''''''''''''''''''
Function Main As String

Dim Form, Page As Object
Dim Text, UserText, UserMess, TempMess As String
Dim Res, npages, i, Elem, NumEl, MaxNum, CorI, Res1 As Integer
Dim Mass(100) As Integer
Const Title = "Delete pages"

  Main = "Failed or nothing to Do."
  Page = ActiveDocument.ActivePage
  For i = 1 to 20
    Mass(i) = 0
  Next i
 
 ' Default pages numbers defining
  npages=ActiveDocument.Count
  Form=ReadForm("Delpage.frm")
  Do
     'Display form
     If Form.ExecForm Then
       Text=Form.GetStrValue("RangeBox")
     Else
       Main="Cancelled"
       Exit Function
     End If

     'Check entered text
     Res = CheckText(Text, Mass)
     UserText = Left(Text, Len(Text)-1)
     If Res = 0 Then
       MessageBox("Enter correct sequence of positive numbers (e.g. 1,4-6,3)", Title, MBB_OK or MBI_EXCLAMATION)
     Else
       MaxNum = MaxElement(Mass, Res)
       If MaxNum > ActiveDocument.Count Then
         MessageBox("Some of your entered pages are out of range.", Title, MBB_OK or MBI_EXCLAMATION)
         Res = 0
       end If
     end If
  loop While (Res = 0)
  Res = Res-1
  TempMess = "Running ChemBasic program disables Undo option." +Chr(13)+Chr(13)+"Do you want to delete entered pages anyway?"
  If MessageBox(TempMess,TITLE, MBB_OKCANCEL+MBI_EXCLAMATION) = MBR_CANCEL Then Exit Function
  DeletePages(Mass, Res)
  Main = "Completed"

end Function


sub DeletePages(ByRef Mass() As Integer, MassSize As Integer)
Dim j, i, j1, j2, m, n As Integer
Dim CurDoc As Object
Dim TempMass(100) As Integer
	CurDoc = ActiveDocument
	
	For i = 1 to MassSize
		TempMass(i) = 1	
	Next i
	For i = 1 to MassSize
		j = Mass(i)
		If TempMass(i) = 1 Then
			Kill(CurDoc.Item(j))
			For m = 1 to MassSize
				If Mass(m) = j and TempMass(m) = 1 Then TempMass(m) = 0
				If Mass(m) > j Then Mass(m) = Mass(m) - 1	
			Next m
		end If		
	Next i		
end sub



Function MaxElement (ByRef Mass() As Integer, MassSize As Integer) As Integer
Dim EL, i As Integer
	El = 1

	For i = 1 to MassSize-1
		
		If El <= Mass(i) Then El = Mass(i)  
	Next i
	MaxElement = El
end Function

Function CheckText(Text As String, ByRef Mass() As Integer) As Integer
Dim i, j, n, StartNum, EndNum, pos, Num As Integer
Dim TempStr, TempStr1, SLet, TrueSymbols As String
Dim Num1, s  As Integer
	Checktext = 0
	RemoveSpaces(Text)
	TrueSymbols = "0123456789,-"
	If Len(Text) = 0 Then exit Function
	For i = 1 to Len(Text)
		SLet = Mid(Text, i, 1)
		If InStr(1, TrueSymbols, SLet) = 0 Then
			Text = Text + ","
			exit Function
		end If
	Next i
	n = 1
	Num1 = 0
	TempStr = ""
	Text = Text+ ","
	For i = 1 to Len(Text)
		SLet = Mid(Text, i, 1)
		If SLet = "," Then
			
			Num = Int(Val(TempStr))
			If Num > 0 and Num <= 100 Then
				If Num1 <> 0 Then
					s = 1
					If Num1 > Num Then s = -1
					j = Num1
					While j <> Num + s
						Mass(n) = j
						n = n+1
						j = j + s
						If n > 100 Then exit Do
					end While 
					Num1 = 0
					TempStr = ""
				Else 
					Mass(n) = Num
					n = n+1
					Num = 0
					TempStr = ""
				end If
			Else
				exit Function
			end If
		Else
			If SLet = "-" Then
				If Num1 <> 0 Then exit Function
				Num1 = Int(Val(TempStr))
				If Num1 < 1  or Num1 > 100 Then exit Function
				TempStr = ""
			Else
				TempStr = TempStr + SLet
			end If
		end If

		If n > 100 Then exit For
	Next i
	CheckText = n
end Function

sub RemoveSpaces(Text As String)
Dim i, TextLen As Integer
Dim SLet, TempStr As String
	TextLen = Len(Text)
	TempStr = ""
	For i = 1 to TextLen
		SLet = Mid(Text, i, 1)
		If SLet <> " " Then TempStr = TempStr + SLet
	Next i
	Text = TempStr
end sub
