اساتید من این کد دارم میخوام متن داخل 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 اسکرول بشه از صبح تا حالا گیرشم لطف میکنید اگه راهنماییم کنید
لینک ارسال
به اشتراک گذاری در سایت های دیگر
3 پاسخ به این سوال تاکنون داده شده است
ارسالهای توصیه شده
بایگانی شده
این موضوع بایگانی و قفل شده و دیگر امکان ارسال پاسخ نیست.