مشکل لودینگ برای رفتن به صفحه جدید سایت در بیسیک

[taha1371 84]

سلام من این کد زدم برای که وقتی روی باتون کلیک مردم بره صفحه جدیدی لود کنه بعد داخل اکتیویتی خلافی بیار اما مشکل چیه این که  پیام لودینگ میاد اما تقربیا 10 ثانیه قبل از این که بره داخل صفحه جدید میره و باعث میشه که کاربر فکر کنه برنامه از کار افتاده باید چکار کنم که لودین تا اخر بمونه

Sub WebView1_PageFinished(URL As String)
	If sum=1 Then
	If WebView1.Url="http://estelam.rahvar120.ir/index.jsp?siteid=1&fkeyid=&siteid=1&pageid=2542" Then
			WebViewExtras1.executeJavascript(WebView1,"B4A.CallSub('Process_HTML', true, document.documentElement.outerHTML)")

	End If
	End If
	If sum=0 Then

	WebViewExtras1.executeJavascript(WebView1,"B4A.CallSub('Process_HTML', true, document.documentElement.outerHTML)")
	pn.Exequte(WebView1,"get","document.getElementById('capimg')")
	End If
	ProgressDialogHide	

End Sub																						

Sub process_HTML(HTML As String)
	HTML=HTML.Replace("""","'")

If sum=0 Then
	Dim cap As String
	cap = HTML.SubString(HTML.IndexOf("captcha.jpg?rand=")+1)
	cap = "http://estelam.rahvar120.ir/includes/c"&cap.SubString2(0,cap.IndexOf("'")-0)

	End If
If sum =1 Then

		cunt=Regex.Split("odd footable-visible footable-first-column",HTML)


		
		Dim pattern As String
		
		pattern = "(>.*<)"
		Dim Matcher1 As Matcher
		Matcher1 = Regex.Matcher(pattern, HTML)
		Do While Matcher1.Find
			
			list1.Add(Matcher1.Match)
			Log(Matcher1.Match)
		Loop
		
		StartActivity(khalafi)
		Activity.Finish
		
End If
End Sub
Sub getlist (matn As String)
	Msgbox(matn,"متن")
End Sub
Sub get(img As Object)
	th.Initialise("")
	th.RunOnGuiThread("setbitmap",Array As Object(img))
End Sub
Sub setbitmap(bitmap As Object)
	ImageView1.Bitmap=bitmap
	sum=1
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub

Sub Button1_Click
	WebViewExtras1.executeJavascript(WebView1,"document.getElementById('btn').click();")
	ProgressDialogShow2("loading",False)
End Sub