رفتن به مطلب
  • 0

اسکرول کردن متن(متفاوت)


mashgholom

سوال

سلام دوستای گلم همگی خسته نباشید

اساتید من این کد دارم میخوام متن داخل 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 پاسخ به این سوال تاکنون داده شده است

ارسال‌های توصیه شده

بایگانی شده

این موضوع بایگانی و قفل شده و دیگر امکان ارسال پاسخ نیست.

  • کاربران آنلاین در این صفحه   0 کاربر

    • هیچ کاربر عضوی،در حال مشاهده این صفحه نیست.
×
×
  • اضافه کردن...