اساتید من این کد دارم میخوام متن داخل lblbody اسکرول بشه از صبح تا حالا گیرشم لطف میکنید اگه راهنماییم کنید
#Region Activity Attributes #FullScreen: False
#IncludeTitle: False
#End Region
Sub Process_Globals
Dim sGroupName As String
Dim listSearch As List
End Sub
Sub Globals
Dim s1 As myDB
Dim l1 As List
Dim c1 As CustomListView
Private pnlparent As Panel
Private lblbody As Label
Private lbltitle As Label
Private imgbookmark As ImageView
Private imgshare As ImageView
Private imgsms As ImageView
Private imgemail As ImageView
Dim pre As AHPreferenceManager
Private lbltitle1 As Label
Dim sFontsize,sFontColor,sFontFamily As String
End Sub
Sub Activity_Create(FirstTime As Boolean)
Activity.LoadLayout("frmsubgroup")
sFontsize = pre.GetString("fontsize")
If sFontsize.Length = 0 Then
sFontsize = 19
End If
sFontColor = pre.GetString("fontcolor")
If sFontColor.Length = 0 Then
sFontColor = myLibrary.getColor("Black")
Else
sFontColor = myLibrary.getColor(sFontColor)
End If
sFontFamily = pre.GetString("fontfamily")
If sFontFamily.Length = 0 Then
sFontFamily = "byekan.ttf"
End If
s1.Initialize
l1.Initialize
c1.Initialize(Me,"scroll")
lbltitle1.Typeface = Typeface.LoadFromAssets("byekan.ttf")
pnlparent.AddView(c1.AsView,0,53dip,100%x,100%y)
c1.bet = 30dip
If listSearch.IsInitialized = False OR sGroupName <> "" Then
l1 = s1.listsubGroup(sGroupName)
lbltitle1.Text = sGroupName
Else
l1 = listSearch
lbltitle1.Text = "نتیجه جستجوی"
End If
Log(l1.Size)
Dim sms1 As sSMS
sms1.Initialize
Try
sms1 = l1.Get(0)
Catch
Return
End Try
addItem(sms1)
End Sub
Sub addItem(sms1 As sSMS)
Dim p1 As Panel
p1.Initialize("")
If sms1.sBody.Length > 200 Then
c1.Add(p1,360dip,"")
p1.LoadLayout("frmtemplatesms")
Else
c1.Add(p1,240dip,"")
p1.LoadLayout("frmtemplatesms1")
End If
lblbody.Text = sms1.sBody
lblbody.Typeface = Typeface.LoadFromAssets(sFontFamily)
lblbody.TextSize = sFontsize
lblbody.TextColor = sFontColor
Try
lblbody.TextSize = sFontsize
Catch
End Try
If sFontColor = "Red" Then
lblbody.TextColor = Colors.Red
Else If sFontColor = "Green" Then
lblbody.TextColor = Colors.Green
Else If sFontColor = "Blue" Then
lblbody.TextColor = Colors.Blue
Else If sFontColor = "Black" Then
lblbody.TextColor = Colors.Black
Else If sFontColor = "Yellow" Then
lblbody.TextColor = Colors.Yellow
End If
imgbookmark.Tag = sms1.sID
imgemail.Tag = sms1.sBody
imgshare.Tag = sms1.sBody
imgsms.Tag = sms1.sBody
If myLibrary.checkBookmark(sms1.sID) = True Then
imgbookmark.SetBackgroundImage(LoadBitmap(File.DirAssets,"bookmark_ok.png"))
End If
End Sub
Sub Activity_Resume
End Sub
Sub Activity_Pause (UserClosed As Boolean)
End Sub
Sub imgbookmark_Click
Dim v1 As View
v1 = Sender
If myLibrary.bookmark(v1.Tag) = True Then
v1.SetBackgroundImage(LoadBitmap(File.DirAssets,"bookmark_ok.png"))
ToastMessageShow("گزینه مورد نظر نشان شد",False)
Else
v1.SetBackgroundImage(LoadBitmap(File.DirAssets,"bookmark.png"))
ToastMessageShow("گزینه مورد نظر حذف شد",False)
End If
End Sub
Sub imgshare_Click
Dim v1 As View
v1 = Sender
myLibrary.ShareContent(v1.Tag,"اشتراک گذاری")
End Sub
Sub imgsms_Click
Dim v1 As View
v1 = Sender
Dim a1 As InputDialog
a1.InputType = a1.INPUT_TYPE_PHONE
If a1.Show("شماره پیامک را وارد کنید","اشتراک","بفرست","انصراف","",Null) = DialogResponse.POSITIVE Then
If a1.Input.Length = 11 Then
myLibrary.SendSms(a1.Input,v1.Tag)
End If
End If
End Sub
Sub imgemail_Click
Dim v1 As View
v1 = Sender
Dim a1 As InputDialog
a1.InputType = a1.INPUT_TYPE_TEXT
If a1.Show("ادرس الکترونیکی را وارد کنید","اشتراک","بفرست","انصراف","",Null) = DialogResponse.POSITIVE Then
If a1.Input.Length > 7 Then
myLibrary.SendMail(a1.Input,v1.Tag,"موضوع جدید")
End If
End If
End Sub
Sub btnback_Click
Activity.Finish
StartActivity(actGroup)
myLibrary.SetAnimation("file3","file4")
End Sub
سوال
mashgholom 34
سلام دوستای گلم همگی خسته نباشید
اساتید من این کد دارم میخوام متن داخل lblbody اسکرول بشه از صبح تا حالا گیرشم لطف میکنید اگه راهنماییم کنید
#Region Activity Attributes #FullScreen: False #IncludeTitle: False #End Region Sub Process_Globals Dim sGroupName As String Dim listSearch As List End Sub Sub Globals Dim s1 As myDB Dim l1 As List Dim c1 As CustomListView Private pnlparent As Panel Private lblbody As Label Private lbltitle As Label Private imgbookmark As ImageView Private imgshare As ImageView Private imgsms As ImageView Private imgemail As ImageView Dim pre As AHPreferenceManager Private lbltitle1 As Label Dim sFontsize,sFontColor,sFontFamily As String End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("frmsubgroup") sFontsize = pre.GetString("fontsize") If sFontsize.Length = 0 Then sFontsize = 19 End If sFontColor = pre.GetString("fontcolor") If sFontColor.Length = 0 Then sFontColor = myLibrary.getColor("Black") Else sFontColor = myLibrary.getColor(sFontColor) End If sFontFamily = pre.GetString("fontfamily") If sFontFamily.Length = 0 Then sFontFamily = "byekan.ttf" End If s1.Initialize l1.Initialize c1.Initialize(Me,"scroll") lbltitle1.Typeface = Typeface.LoadFromAssets("byekan.ttf") pnlparent.AddView(c1.AsView,0,53dip,100%x,100%y) c1.bet = 30dip If listSearch.IsInitialized = False OR sGroupName <> "" Then l1 = s1.listsubGroup(sGroupName) lbltitle1.Text = sGroupName Else l1 = listSearch lbltitle1.Text = "نتیجه جستجوی" End If Log(l1.Size) Dim sms1 As sSMS sms1.Initialize Try sms1 = l1.Get(0) Catch Return End Try addItem(sms1) End Sub Sub addItem(sms1 As sSMS) Dim p1 As Panel p1.Initialize("") If sms1.sBody.Length > 200 Then c1.Add(p1,360dip,"") p1.LoadLayout("frmtemplatesms") Else c1.Add(p1,240dip,"") p1.LoadLayout("frmtemplatesms1") End If lblbody.Text = sms1.sBody lblbody.Typeface = Typeface.LoadFromAssets(sFontFamily) lblbody.TextSize = sFontsize lblbody.TextColor = sFontColor Try lblbody.TextSize = sFontsize Catch End Try If sFontColor = "Red" Then lblbody.TextColor = Colors.Red Else If sFontColor = "Green" Then lblbody.TextColor = Colors.Green Else If sFontColor = "Blue" Then lblbody.TextColor = Colors.Blue Else If sFontColor = "Black" Then lblbody.TextColor = Colors.Black Else If sFontColor = "Yellow" Then lblbody.TextColor = Colors.Yellow End If imgbookmark.Tag = sms1.sID imgemail.Tag = sms1.sBody imgshare.Tag = sms1.sBody imgsms.Tag = sms1.sBody If myLibrary.checkBookmark(sms1.sID) = True Then imgbookmark.SetBackgroundImage(LoadBitmap(File.DirAssets,"bookmark_ok.png")) End If End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Sub imgbookmark_Click Dim v1 As View v1 = Sender If myLibrary.bookmark(v1.Tag) = True Then v1.SetBackgroundImage(LoadBitmap(File.DirAssets,"bookmark_ok.png")) ToastMessageShow("گزینه مورد نظر نشان شد",False) Else v1.SetBackgroundImage(LoadBitmap(File.DirAssets,"bookmark.png")) ToastMessageShow("گزینه مورد نظر حذف شد",False) End If End Sub Sub imgshare_Click Dim v1 As View v1 = Sender myLibrary.ShareContent(v1.Tag,"اشتراک گذاری") End Sub Sub imgsms_Click Dim v1 As View v1 = Sender Dim a1 As InputDialog a1.InputType = a1.INPUT_TYPE_PHONE If a1.Show("شماره پیامک را وارد کنید","اشتراک","بفرست","انصراف","",Null) = DialogResponse.POSITIVE Then If a1.Input.Length = 11 Then myLibrary.SendSms(a1.Input,v1.Tag) End If End If End Sub Sub imgemail_Click Dim v1 As View v1 = Sender Dim a1 As InputDialog a1.InputType = a1.INPUT_TYPE_TEXT If a1.Show("ادرس الکترونیکی را وارد کنید","اشتراک","بفرست","انصراف","",Null) = DialogResponse.POSITIVE Then If a1.Input.Length > 7 Then myLibrary.SendMail(a1.Input,v1.Tag,"موضوع جدید") End If End If End Sub Sub btnback_Click Activity.Finish StartActivity(actGroup) myLibrary.SetAnimation("file3","file4") End Subلینک ارسال
به اشتراک گذاری در سایت های دیگر
3 پاسخ به این سوال تاکنون داده شده است
ارسالهای توصیه شده
بایگانی شده
این موضوع بایگانی و قفل شده و دیگر امکان ارسال پاسخ نیست.