-
تعداد ارسال ها
969 -
تاریخ عضویت
-
آخرین بازدید
-
روز های برد
138
نوع محتوا
نمایه ها
فروشگاه
تالارهای گفتگو
بخش دریافت
تمامی مطالب نوشته شده توسط MR.B4A
-
کنترل هوشمند کلیکها در اندروید؛ بدون لمس حتی یک بار!
MR.B4A پاسخی ارسال کرد برای یک موضوع در ســـورس کـــدهـا
آیا میخواهید برنامهتان بتواند بهصورت خودکار و دقیق، روی هر بخش دلخواه کلیک کند؟ 🤖 با مینی سورس کلیک خودکار برای Basic4Android، قابلیت اجرای کلیکهای خودکار را به پروژههای خود اضافه کنید؛ فقط کافی است ویوی موردنظر و زمان اجرا را مشخص کنید تا برنامه، عملیات کلیک را بهصورت کاملاً خودکار انجام دهد. ✨ ویژگیها: ✅ کلیک خودکار روی ویوی دلخواه ✅ تعیین زمان اجرای کلیک ✅ ساده، سبک و قابل استفاده در پروژههای مختلف ✅ مناسب برای توسعهدهندگان Basic4Android 🚀 یک ابزار کوچک اما کاربردی برای ساخت اپلیکیشنهای حرفهایتر! سورس Sub Class_Globals Private Root As B4XView Private xui As XUI Private AutoClickEnabled As Boolean End Sub Public Sub Initialize ' B4XPages.GetManager.LogEvents = True End Sub 'This event will be called once, before the page becomes visible. Private Sub B4XPage_Created (Root1 As B4XView) Root = Root1 Root.LoadLayout("MainPage") AutoClickEnabled = True StartAutoClick End Sub 'You can see the list of page related events in the B4XPagesManager object. The event name is B4XPage. Private Sub Button1_Click ToastMessageShow("دکمه کلیک شد!", False) End Sub Sub StartAutoClick Do While AutoClickEnabled Button1_Click Sleep(3000) ' هر ۱ ثانیه یک بار Loop End Sub این کدها را فقط در پروژتان اضافه کنید. تهیه و تنظیم مرتضی صباغی MR.B4A کانال ایتا https://eitaa.com/basic4androidlan گانال تلگرام https://t.me/programmingwithb4a-
- 1
-
-
دیگه وقتشه نمودارهای حرفهای رو به اپلیکیشنهات اضافه کنی!
MR.B4A پاسخی ارسال کرد برای یک موضوع در ســـورس کـــدهـا
اگر با Basic4Android (B4A) برنامهنویسی میکنی، این سورس دقیقاً همون چیزیه که دنبالش بودی! 🔥 سورس طراحی نمودار با مقداردهی کامل که بهت امکان میده تنها با چند خط کد، نمودارهای جذاب و حرفهای بسازی. ✅ نمودار خطی (Line Chart) ✅ نمودار ستونی یا میلهای (Bar Chart) ✅ نمودار دایرهای (Pie Chart) 💡 مناسب برای: ✔️ نمایش آمار و گزارش ✔️ داشبوردهای مدیریتی ✔️ اپلیکیشنهای فروشگاهی، مالی، آموزشی و هر پروژهای که نیاز به نمایش دادهها داره. ✨ کدنویسی تمیز، قابل شخصیسازی و آماده استفاده در پروژههای واقعی. 🎯 اگر میخوای ظاهر اپلیکیشنهات حرفهایتر بشه و دادهها رو به زیباترین شکل نمایش بدی، این سورس رو از دست نده. سورس: Sub Globals Private Panel1 As Panel Private Panel2 As Panel Private Panel3 As Panel End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") Dim Data() As Int = Array As Int(12,25,18,40,35,55,48,60) Dim Data2() As Int = Array As Int(12,25,18,40,35,55,48,60) Dim Data3() As Int = Array As Int(12,25,18,40,35,55,48,60) DrawChartline(Data,Colors.Yellow,Colors.Black) DrawBarChart(Data2,Colors.Red,Colors.Black,Colors.Blue,Colors.Cyan,Colors.DarkGray,Colors.Magenta) DrawPieChart(Data3) End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub 'نمودار دخطی Sub DrawChartline(Values() As Int, pointcolor As Int, linecolor As Int) If Values.Length < 2 Then Return Dim cvs As Canvas cvs.Initialize(Panel1) cvs.DrawColor(Colors.White) Dim Margin As Float = 30dip Dim MaxValue As Int = 0 'بزرگترین مقدار For Each n As Int In Values If n > MaxValue Then MaxValue = n Next If MaxValue = 0 Then Return Dim StepX As Float = (Panel1.Width - (2 * Margin)) / (Values.Length - 1) Dim i As Int For i = 0 To Values.Length - 2 Dim x1 As Float = Margin + (i * StepX) Dim x2 As Float = Margin + ((i + 1) * StepX) Dim Ratio1 As Float = Values(i) / MaxValue Dim Ratio2 As Float = Values(i + 1) / MaxValue Dim y1 As Float = Panel1.Height - Margin - (Ratio1 * (Panel1.Height - (2 * Margin))) Dim y2 As Float = Panel1.Height - Margin - (Ratio2 * (Panel1.Height - (2 * Margin))) cvs.DrawLine(x1, y1, x2, y2, linecolor, 3dip) cvs.DrawCircle(x1, y1, 5dip, pointcolor, True, 1dip) Next 'رسم آخرین نقطه Dim LastX As Float = Margin + ((Values.Length - 1) * StepX) Dim LastY As Float = Panel1.Height - Margin - ((Values(Values.Length - 1) / MaxValue) * _ (Panel1.Height - (2 * Margin))) cvs.DrawCircle(LastX, LastY, 5dip, pointcolor, True, 1dip) Panel1.Invalidate End Sub 'نمودار خطی 'نمودار ستونی Sub DrawBarChart(Values() As Int,color1 As Int, color2 As Int, color3 As Int, color4 As Int,color5 As Int, _ color6 As Int) Dim cvs As Canvas cvs.Initialize(Panel2) cvs.DrawColor(Colors.White) Dim Margin As Float = 30dip Dim MaxValue As Int = 0 'پیدا کردن بیشترین مقدار For Each n As Int In Values If n > MaxValue Then MaxValue = n Next If MaxValue = 0 Then Return Dim BarCount As Int = Values.Length Dim BarWidth As Float = (Panel2.Width - (2 * Margin)) / BarCount 'آرایه رنگها Dim ColorsArray() As Int = Array As Int( _ color1, _ color2, _ color3, _ color4, _ color5, _ color6 _ ) Dim i As Int For i = 0 To BarCount - 1 Dim BarHeight As Float = (Values(i) / MaxValue) * (Panel2.Height - (2 * Margin)) Dim Left As Float = Margin + (i * BarWidth) Dim Top As Float = Panel2.Height - Margin - BarHeight Dim Right As Float = Left + BarWidth * 0.7 Dim Bottom As Float = Panel2.Height - Margin Dim Rect1 As Rect Rect1.Initialize(Left, Top, Right, Bottom) 'انتخاب رنگ متفاوت برای هر ستون Dim c As Int c = ColorsArray(i Mod ColorsArray.Length) cvs.DrawRect(Rect1, c, True, 0) Next Panel2.Invalidate End Sub 'نمودار ستونی 'نمودار دایره ای Sub DrawPieChart(Values() As Int) Dim cvs As Canvas cvs.Initialize(Panel3) cvs.DrawColor(Colors.White) 'محاسبه مجموع Dim Total As Int = 0 For Each n As Int In Values Total = Total + n Next If Total = 0 Then Return 'رنگ بخش ها Dim ColorsArray() As Int = Array As Int( _ Colors.Red, _ Colors.Blue, _ Colors.Green, _ Colors.Yellow, _ Colors.Magenta, _ Colors.Cyan _ ) Dim Radius As Float = Min(Panel3.Width, Panel3.Height) / 3 Dim CenterX As Float = Panel3.Width / 2 Dim CenterY As Float = Panel3.Height / 2 Dim StartAngle As Float = -90 Dim i As Int For i = 0 To Values.Length - 1 Dim SweepAngle As Float = (Values(i) / Total) * 360 'ساخت یک تکه از دایره Dim Path1 As Path Dim StartX As Float = CenterX + CosD(StartAngle) * Radius Dim StartY As Float = CenterY + SinD(StartAngle) * Radius Path1.Initialize(CenterX, CenterY) Path1.LineTo(StartX, StartY) Dim a As Float For a = StartAngle To StartAngle + SweepAngle Step 5 Dim x As Float = CenterX + CosD(a) * Radius Dim y As Float = CenterY + SinD(a) * Radius Path1.LineTo(x, y) Next Path1.LineTo(CenterX, CenterY) cvs.DrawPath(Path1, ColorsArray(i Mod ColorsArray.Length), True, 0) StartAngle = StartAngle + SweepAngle Next Panel3.Invalidate End Sub 'نمودار دایره ای فقط کافیه این کدهارو داخل برنامت کپی کنی. تهیه و تنظیم مرتضی صباغی MR.B4A کانال ایتا https://eitaa.com/basic4androidlan کانال تلگرام https://t.me/programmingwithb4a-
- 1
-
-
سلام. کارش چیه؟
-
اپلیکیشن بورس بان
MR.B4A پاسخی برای MR.B4A ارسال کرد در موضوع : برنامــه هـای سـاختـه شـده توسـط شمــا
سلام استاد خیلی ممنون که درمورد اپم نظر دادید.واقعا باعث افتخاره منه که شما درمورد برنامم نظر بدید. چشم حتما درمورد اون چه که گفتید تحقیق میکنم و استفاده میکنم خیلی ممنونم- 2 پاسخ
-
- 1
-
-
اگر به دنبال یک ابزار کامل برای بررسی صندوقهای سرمایهگذاری و وضعیت بازار بورس هستید، این برنامه انتخابی مناسب برای شماست. دانلود از کافه بازار: https://cafebazaar.ir/app/mr.b4a.bors محاسبه سود سهام بهصورت سریع و دقیق معرفی صندوقهای پربازده و برتر بازار پیشنهاد صندوقهای مناسب بر اساس عملکرد و بازدهی مشاهده بازدهی صندوقهای درآمد ثابت در هفته گذشته بررسی وضعیت نمادها معرفی عرضههای اولیه امکانات ویژه برنامه: نمایش دارایی هر سهم و صندوق بررسی بازدهی هفتگی صندوقها شناسایی صندوقهای دارای روند صعودی رابط کاربری ساده و سریع بهروزرسانی هفتگی اطلاعات و دادههای بازار با استفاده از این برنامه میتوانید اطلاعات مهم بازار سرمایه را در یک محیط ساده و کاربردی مشاهده کرده و تصمیمهای آگاهانهتری برای سرمایهگذاری بگیرید. اطلاعات بهروز و دسترسی آسان به مهمترین دادههای بورس و صندوقهای سرمایهگذاری در یک اپلیکیشن
- 2 پاسخ
-
- 1
-
-
یک لیست ویوی بسیار زیبا و مدرن با قابلیت کلیک سورس: ⭕ صفحه اول Sub Process_Globals Dim Bitmap As Bitmap End Sub Sub Globals Private xui As XUI Private ImageView1 As B4XView Private T As Label Private Button1 As Button Private Label1 As Label Private Button1 As Button Private CLV As CustomListView Private Panel1 As Panel Private Button2 As Button Dim Counter As Int End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") End Sub Private Sub activity_PermissionResult (Permission As String, Result As Boolean) End Sub Private Sub CreateItem(Width As Int, Title As String, Image As B4XBitmap,Date As String) As Panel Dim p As B4XView = xui.CreatePanel("") Dim height As Int = 120dip Dim Obj1 As Reflector p.SetLayoutAnimated(0, 0, 0, Width, height) p.LoadLayout("card") T.Text = Title Dim ripple As RippleView ripple.Initialize(Panel1, Colors.Blue, 300, True) Label1.TextColor = 0xFF4A0091 Label1.Text = " Tel : @SkillPersian"&CRLF&Date ImageView1.SetBitmap(CreateRoundBitmap(Image, ImageView1.Width)) Obj1.Target = T Obj1.RunMethod3("setLineSpacing", 1, "java.lang.float", 1.2, "java.lang.float") Return p End Sub Sub CreateRoundBitmap (Input As B4XBitmap, Size As Int) As B4XBitmap If Input.Width <> Input.Height Then 'if the image is not square then we crop it to be a square. Dim l As Int = Min(Input.Width, Input.Height) Input = Input.Crop(Input.Width / 2 - l / 2, Input.Height / 2 - l / 2, l, l) End If Dim c As B4XCanvas Dim xview As B4XView = xui.CreatePanel("") xview.SetLayoutAnimated(0, 0, 0, Size, Size) c.Initialize(xview) Dim path As B4XPath path.InitializeOval(c.TargetRect) c.ClipPath(path) c.DrawBitmap(Input.Resize(Size, Size, False), c.TargetRect) c.RemoveClip c.DrawCircle(c.TargetRect.CenterX, c.TargetRect.CenterY, c.TargetRect.Width / 2 - 2dip, xui.Color_White, False, 5dip) 'comment this line to remove the border c.Invalidate Dim res As B4XBitmap = c.CreateBitmap c.Release Return res End Sub 'درصورت فعال بودن Ripple View 'کلیک آیتم از کار می افته بنابرین باید 'seneder 'برای دسترسی به کلیک آیتم ها استفاده کنید Sub CLV_ItemClick (Index As Int, Value As Object) ToastMessageShow(Value,False) End Sub Private Sub Panel1_Click Dim index As Int = CLV.GetItemFromView(Sender) ToastMessageShow("آیتم شماره "&CLV.GetValue(index)&" کلیک شد. ",False) End Sub Private Sub Button1_Click Dim index As Int = CLV.GetItemFromView(Sender) ToastMessageShow("مشاهده آیتم "&CLV.GetValue(index),False) End Sub Private Sub Button2_Click For i= 0 To 10 Bitmap= LoadBitmap(File.DirAssets,i&".jpg") Counter = Counter +1 CLV.Add(CreateItem(CLV.AsView.Width,"Mohammad Reza Pirzadeh"&CRLF&"Skillpersian",Bitmap,""),Counter) Next End Sub Private Sub btn_next_Click Activity.Finish StartActivity("page2") End Sub ✅ صفحه دوم Sub Process_Globals Dim Bitmap As Bitmap End Sub Sub Globals Private xui As XUI Private ImageView1 As B4XView Private T As Label Private Button1 As Button Private Label1 As Label Private Button1 As Button Private CLV As CustomListView Private Panel1 As Panel Dim Counter As Int Private i As Int End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("page2") End Sub Private Sub CreateItem(Width As Int, Title As String, Image As B4XBitmap,Date As String) As Panel Dim p As B4XView = xui.CreatePanel("") Dim height As Int = 120dip Dim Obj1 As Reflector p.SetLayoutAnimated(0, 0, 0, Width, height) p.LoadLayout("card") T.Text = Title Dim ripple As RippleView ripple.Initialize(Panel1, Colors.Blue, 300, True) Label1.TextColor = 0xFF4A0091 Label1.Text = " Tel : @SkillPersian"&CRLF&Date ImageView1.SetBitmap(CreateRoundBitmap(Image, ImageView1.Width)) Obj1.Target = T Obj1.RunMethod3("setLineSpacing", 1, "java.lang.float", 1.2, "java.lang.float") Return p End Sub Sub CreateRoundBitmap (Input As B4XBitmap, Size As Int) As B4XBitmap If Input.Width <> Input.Height Then 'if the image is not square then we crop it to be a square. Dim l As Int = Min(Input.Width, Input.Height) Input = Input.Crop(Input.Width / 2 - l / 2, Input.Height / 2 - l / 2, l, l) End If Dim c As B4XCanvas Dim xview As B4XView = xui.CreatePanel("") xview.SetLayoutAnimated(0, 0, 0, Size, Size) c.Initialize(xview) Dim path As B4XPath path.InitializeOval(c.TargetRect) c.ClipPath(path) c.DrawBitmap(Input.Resize(Size, Size, False), c.TargetRect) c.RemoveClip c.DrawCircle(c.TargetRect.CenterX, c.TargetRect.CenterY, c.TargetRect.Width / 2 - 2dip, xui.Color_White, False, 5dip) 'comment this line to remove the border c.Invalidate Dim res As B4XBitmap = c.CreateBitmap c.Release Return res End Sub 'درصورت فعال بودن Ripple View 'کلیک آیتم از کار می افته بنابرین باید 'seneder 'برای دسترسی به کلیک آیتم ها استفاده کنید Sub CLV_ItemClick (Index As Int, Value As Object) ToastMessageShow(Value,False) End Sub Private Sub Panel1_Click Dim index As Int = CLV.GetItemFromView(Sender) ToastMessageShow("آیتم شماره "&CLV.GetValue(index)&" کلیک شد. ",False) End Sub Private Sub Button1_Click Dim index As Int = CLV.GetItemFromView(Sender) ToastMessageShow("مشاهده آیتم "&CLV.GetValue(index),False) End Sub Private Sub Button2_Click If i=11 Then ToastMessageShow("همه آیتم ها ساخته شدند",False) Return End If Bitmap= LoadBitmap(File.DirAssets,i&".jpg") i=i+1 Counter = Counter +1 CLV.Add(CreateItem(CLV.AsView.Width,"Mohammad Reza Pirzadeh"&CRLF&"Skillpersian",Bitmap,""),Counter) End Sub Private Sub activity_KeyPress (KeyCode As Int) As Boolean 'Return True to consume the event Activity.Finish StartActivity("main") Return True End Sub تهیه و تنظیم مرتضی صباغی MR.B4A https://eitaa.com/basic4androidlan https://t.me/programmingwithb4a
-
- 1
-
-
با استفاده از این سورس یک WobbleMenu برای پروزه تان بسازید یک منوی بسیار زیبا و کاربردی سورس: Sub Globals Private WobbleMenu1 As WobbleMenu End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout1") WobbleMenu1.SetTabTextIcon(1,"Menu 1",Chr(0xF009),Typeface.FONTAWESOME) WobbleMenu1.SetTabTextIcon(2,"Menu 2",Chr(0xF0CA),Typeface.FONTAWESOME) WobbleMenu1.SetTabTextIcon(3,"Menu 3",Chr(0xF0EC),Typeface.FONTAWESOME) WobbleMenu1.SetTabTextIcon(4,"Menu 4",Chr(0xF24D),Typeface.FONTAWESOME) WobbleMenu1.SetTabTextIcon(5,"Menu 5",Chr(0xF2C0),Typeface.FONTAWESOME) WobbleMenu1.SetBadge(4,5,Colors.White,Colors.Blue) End Sub Sub WobbleMenu1_Tab1Click WobbleMenu1.RemoveBadge(4) ToastMessageShow("تب اول",False) End Sub Private Sub WobbleMenu1_Tab2Click ToastMessageShow("تب دوم",False) End Sub Private Sub WobbleMenu1_Tab3Click ToastMessageShow("تب سوم",False) End Sub Private Sub WobbleMenu1_Tab4Click ToastMessageShow("تب چهارم",False) End Sub Private Sub WobbleMenu1_Tab5Click ToastMessageShow("تب پنجم",False) End Sub طراح و تهیه کننده: مرتضی صباغی MR.B4A https://t.me/programmingwithb4a
-
- 1
-
-
این عملکرد را چگونه بسازیم؟ https://www.aparat.com/v/hbvp3f3 به وسیله این مینی سورس میتوانید کاراکترهای داخل جعبه متن رو تک تک حذف کنید. دقیقا مثل دکمه بک کیبرد. سورس: Private Sub btn_delete_Click If txt_char.Text.Length > 0 Then txt_char.Text = txt_char.Text.SubString2(0, txt_char.Text.Length - 1) txt_char.SelectionStart = txt_char.Text.Length Else ToastMessageShow("جعبه متن خالی است!",False) End If End Sub تهیه و تنظیم مرتضی صباغی MR.B4A https://t.me/programmingwithb4a https://eitaa.com/basic4androidlan
-
- 1
-
-
این سورس را میخواهیم بسازیم: https://aparat.com/v/osgpkrg با استفاده از این سورس میتوانید یک افکت انیمیشنی بسیار زیبا به برنامه خود دهید. سورس #Region Project Attributes #ApplicationLabel: Animation Wave #VersionCode: 1 #VersionName: 1.00 'SupportedOrientations possible values: unspecified, landscape or portrait. #SupportedOrientations: unspecified #CanInstallToExternalStorage: False #End Region #Region Activity Attributes #FullScreen: true #IncludeTitle: false #Extends : androidx.appcompat.app.AppCompatActivity #End Region #MultiDex:true Sub Process_Globals End Sub Sub Globals Dim WaveView As AXWaveView Dim LineWaveView As AXLineWaveView Dim chk,chk2 As CheckBox Private Panel1 As Panel End Sub Sub Activity_Create(FirstTime As Boolean) Activity.Color = 0xFF1C2229 If File.Exists(File.DirInternal,"db.db")=False Then File.Copy(File.DirAssets,"db.db",File.DirInternal,"db.db") End If Dim Seekbar As ACSeekBar Seekbar.Initialize("Seekbar") Activity.AddView(Seekbar,16dip,16dip,100%x-32dip,32dip) WaveView.Initialize Dim Size As Int = 250dip Activity.AddView(WaveView,50%x - (Size/2), 50%y - (Size/2) , Size, Size) InitWaveView Dim MicImage As ImageView MicImage.Initialize("") Size = 64dip Activity.AddView(MicImage,50%x - (Size/2), 50%y - (Size/2) , Size, Size) Dim BD As BitmapDrawable BD.Initialize(LoadBitmap(File.DirAssets,"mic.png")) Dim AC As AppCompat AC.SetDrawableTint(BD,Colors.White) MicImage.Background = BD LineWaveView.Initialize Activity.AddView(LineWaveView,0,100%y-36dip,100%x,36dip) InitLineWaveView chk.Initialize("RedState") chk.TextColor = Colors.White chk.Checked = False Activity.AddView(chk , 16dip , Seekbar.Top + Seekbar.Height + 20dip , 140dip , 40dip) chk.Text = "Red State" chk2.Initialize("WaveEnabled") chk2.TextColor = Colors.White chk2.Checked = True Activity.AddView(chk2 , 16dip , chk.Top + chk.Height + 20dip , 140dip , 40dip) chk2.Text = "WaveEnabled" Panel1.Initialize("") Activity.AddView(Panel1,0,0,100%x,100%y) Panel1.Visible=False End Sub Private Sub activity_KeyPress (KeyCode As Int) As Boolean 'Return True to consume the event If KeyCode=KeyCodes.KEYCODE_BACK Then If Panel1.Visible=True Then Panel1.Visible=False End If Return True End If End Sub Private Sub RedState_CheckedChange(Checked As Boolean) If chk2.Checked = False Then chk2.Checked = True WaveView.PrepareToRemove(Checked) End Sub Private Sub WaveEnabled_CheckedChange(Checked As Boolean) WaveView.PrepareToRemoveWaveEnabled = Not(Checked) Dim st As AXWeavingState = WaveView.CurrentState st.SupportWaves = Checked WaveView.Invalidate End Sub Private Sub InitWaveView Dim State1 As AXWeavingState State1.Initialize3(1,WaveView.CreateRadialShader(200,0xff2BCEFF,0xff0976E3)) State1.Width = WaveView.Width + 20dip State1.Height = State1.Width WaveView.AddState(1,State1) Dim State2 As AXWeavingState State2.Initialize(2,WaveView.CreateRadialShader(200,0xff12B522,0xff00D6C1),"WaveState2") State2.Width = WaveView.Width + 20dip State2.Height = State2.Width WaveView.AddState(2,State2) WaveView.SetState(1) WaveView.CircleEnabled = True WaveView.Amplitude = -1 Dim Reflection As Reflector Reflection.Target = WaveView Reflection.SetOnClickListener("Wave_Click") WaveView.PrepareToRemoveColor = Colors.Red WaveView.PrepareToRemoveSize = 250dip WaveView.PrepareToRemoveAngle = 45.0f WaveView.PrepareToRemoveShader = WaveView.CreateLinearShader(350dip,0xFFD54141, 0xFFF76E7E,Colors.Transparent) WaveView.PrepareToRemoveWaveEnabled = False End Sub Private Sub WaveState2_UpdateTargets (State As AXWeavingState) State.TargetX = 0.2f + 0.1f * Rnd(1,100) / 100 State.TargetY = 0.7f + 0.1f * Rnd(1,100) / 100 End Sub Private Sub Wave_Click (Tag As Object) Dim State As AXWeavingState = WaveView.CurrentState If State.State = 1 Then WaveView.SetState(2) LineWaveView.SetState(2) SetNavigationBarColor(0xff00D6C1) Else WaveView.SetState(1) LineWaveView.SetState(1) SetNavigationBarColor(0xff0976E3) End If End Sub Private Sub Seekbar_ValueChanged (Value As Int, UserChanged As Boolean) WaveView.Amplitude = Value * WaveView.MAX_AMPLITUDE / 100 LineWaveView.Amplitude = Value * LineWaveView.MAX_AMPLITUDE / 100 End Sub Private Sub InitLineWaveView Dim State1 As AXLineWeavingState State1.Initialize3(1,WaveView.CreateRadialShader(200,0xff0976E3,0xff0976E3)) LineWaveView.AddState(1,State1) Dim State2 As AXLineWeavingState State2.Initialize3(2,WaveView.CreateRadialShader(200,0xff00D6C1,0xff00D6C1)) LineWaveView.AddState(2,State2) LineWaveView.SetState(1) SetNavigationBarColor(0xff0976E3) LineWaveView.MaxAlpha = 120 LineWaveView.MainWaveEnabled = False End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Public Sub SetNavigationBarColor (NewColor As Int) Dim sdk As Phone If sdk.SdkVersion >= 21 Then Dim j1 As JavaObject j1.InitializeContext j1.RunMethodJO("getWindow",Null) _ .RunMethod("setNavigationBarColor",Array (NewColor)) End If End Sub تهیه و تنظیم مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال تلگرام: https://t.me/programmingwithb4a
-
- 1
-
-
مینی سورس عمودی کردن ویوها در بیسیک فور اندروید
MR.B4A پاسخی ارسال کرد برای یک موضوع در آموزش های متنی
بااستفاده از این سورس، ویوهای برنامه تان را با استفاده از کدنویسی، عمودی کنید. بیشتر گاربر بصری دارد. سورس Sub Process_Globals Private t1, t2, t3, t4, t5, t6 As Timer End Sub Sub Globals Private SeekBar1 As SeekBar Private SeekBar2 As SeekBar Private SeekBar3 As SeekBar Private SeekBar4 As SeekBar Private SeekBar5 As SeekBar Private SeekBar6 As SeekBar Private Label1 As Label Private btn_source As Button End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") t1.Initialize("t1",1000) t2.Initialize("t2",2000) t3.Initialize("t3",3000) t4.Initialize("t4",4000) t5.Initialize("t5",5000) t6.Initialize("t6",6000) 'تایمرها مقداردهی شدند تا به ترتیب حالتشان تغییر کند Dim jo As JavaObject jo.InitializeContext jo.RunMethod("ChangeColor",Array As Object(SeekBar1,Colors.RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))) jo.RunMethod("ChangeColor",Array As Object(SeekBar2,Colors.RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))) jo.RunMethod("ChangeColor",Array As Object(SeekBar3,Colors.RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))) jo.RunMethod("ChangeColor",Array As Object(SeekBar4,Colors.RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))) jo.RunMethod("ChangeColor",Array As Object(SeekBar5,Colors.RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))) jo.RunMethod("ChangeColor",Array As Object(SeekBar6,Colors.RGB(Rnd(0,255),Rnd(0,255),Rnd(0,255)))) 'رنگ های سیک بار با استفاده از این کدها تغییر میکند End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Private Sub t1_Tick Private x As B4XView = SeekBar1 x.Rotation=90 t1.Enabled=False End Sub Private Sub t2_Tick Private x1 As B4XView = SeekBar2 x1.Rotation=90 t2.Enabled=False End Sub Private Sub t3_Tick Private x2 As B4XView = SeekBar3 x2.Rotation=90 t3.Enabled=False End Sub Private Sub t4_Tick Private x3 As B4XView = SeekBar4 x3.Rotation=90 t4.Enabled=False End Sub Private Sub t5_Tick Private x4 As B4XView = SeekBar5 x4.Rotation=90 t5.Enabled=False End Sub Private Sub t6_Tick Private x5 As B4XView = SeekBar6 x5.Rotation=90 t6.Enabled=False End Sub 'رویدادی که تایمرها، دستورات مربوط به تغییر حالت سیک بارها را اجرا میکنند Private Sub Button1_Click t1.Enabled=True t2.Enabled=True t3.Enabled=True t4.Enabled=True t5.Enabled=True t6.Enabled=True End Sub 'روشن کردن همه تایمرها #if java import android.graphics.PorterDuff; import android.widget.SeekBar; public void ChangeColor(SeekBar seekbar,int Color) { seekbar.getProgressDrawable().setColorFilter(Color, PorterDuff.Mode.SRC_IN); seekbar.getThumb().setColorFilter(Color, PorterDuff.Mode.SRC_IN); } #End If 'دستورات جاوا برای تغییر رنگ سیک بار Private Sub Button2_Click Private x As B4XView = SeekBar1 x.Rotation=0 Private x1 As B4XView = SeekBar2 x1.Rotation=0 Private x2 As B4XView = SeekBar3 x2.Rotation=0 Private x3 As B4XView = SeekBar4 x3.Rotation=0 Private x4 As B4XView = SeekBar5 x4.Rotation=0 Private x5 As B4XView = SeekBar6 x5.Rotation=0 End Sub 'برگت به حالت افقی سیک بارها Private Sub SeekBar1_ValueChanged (Value As Int, UserChanged As Boolean) Label1.Text=Value End Sub Private Sub SeekBar2_ValueChanged (Value As Int, UserChanged As Boolean) Label1.Text=Value End Sub Private Sub SeekBar3_ValueChanged (Value As Int, UserChanged As Boolean) Label1.Text=Value End Sub Private Sub SeekBar4_ValueChanged (Value As Int, UserChanged As Boolean) Label1.Text=Value End Sub Private Sub SeekBar5_ValueChanged (Value As Int, UserChanged As Boolean) Label1.Text=Value End Sub Private Sub SeekBar6_ValueChanged (Value As Int, UserChanged As Boolean) Label1.Text=Value End Sub 'مقداردهی لیبل عدد Private Sub Button3_Click Activity.Finish StartActivity("page2") End Sub کانال ایتا:https://eitaa.com/basic4androidlan کانال بله: https://web.bale.ai/chat?uid=5896703188 تهیه و تنظیم مرتضی صباغی MR.B4A-
- 2
-
-
سورس پخش ویدئو به صورت آفلاین و آنلاین در بیسیک فور اندروید
MR.B4A پاسخی ارسال کرد برای یک موضوع در آموزش های متنی
بااستفاده از این سورس، میتوانید به راحتی یک ویدئو را با استفاده از لینک، به صورت آنلاین پخش کنید. همچنین میتوانید با انتخاب ویدئو از حافظه گوشی، آن را به صورت آفلاین در برنامه پخش کنید. سورس: Sub Process_Globals Private cc As ContentChooser End Sub Sub Globals Private videov As VideoView Private ptn_play_pause As Button End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") If cc.IsInitialized=False Then cc.Initialize("cc") End If If videov.IsInitialized=False Then videov.Initialize("v") End If Activity.AddView(videov,0,0,100%x,100%y) videov.MediaControllerEnabled=True If File.Exists(File.DirInternal,"1.mp4")=False Then File.Copy(File.DirAssets,"1.mp4",File.DirInternal,"1.mp4") End If videov.LoadVideo(File.DirInternal,"1.mp4") End Sub Sub cc_Result (Success As Boolean, Dir As String, FileName As String) If Success=True Then videov.LoadVideo(Dir,FileName) videov.Play Else Msgbox("اجرای ویدئو با مشکل مواجه شده است","") End If End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Private Sub ptn_play_pause_Click If videov.IsPlaying=False Then videov.Play ptn_play_pause.Typeface=Typeface.MATERIALICONS ptn_play_pause.Text=Chr(0xE034) Else videov.Pause ptn_play_pause.Typeface=Typeface.MATERIALICONS ptn_play_pause.Text=Chr(0xE037) End If End Sub Private Sub v_Complete Msgbox("پخش ویدئو تمام شد","") videov.Play End Sub Private Sub btn_select_vid_Click cc.Show("video/*","ویدئوی مورد نظر را انتخاب کنید") End Sub Private Sub btn_play_web_Click videov.LoadVideo("http://media.newspring.cc/video/2013/","021013_DontWasteYourLife_01_iPod.mp4") videov.Play End Sub تهیه و تنظیم مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال بله: https://web.bale.ai/chat?uid=5896703188 ویرایش شده1۱۱:۴۲ بعدازظهر-
- 2
-
-
میخوام یه اپ بنویسم که به درگاه بانکی ( ترجیحا با api ) وصل شه. حالا میخوام اول یه تستی برم ببینم چه طوری کسی از دوستان سایتی ترفندی راهی میشناسه که بشه درگاه بانکی رو تست کرد؟
-
سورس تنظیم کردن متن از هر دوطرف در بیسیک فور اندروید
MR.B4A پاسخی ارسال کرد برای یک موضوع در آموزش های متنی
بااستفاده از این سورس به راحتی میتوانید متون رو از هر دو طرف جاستیفای کنید تا از خط بیرون نزند و مرتب باشد. سورس در ادامه... Sub Globals Private Label1 As Label End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") Dim PersianText As String = Label1.Text Label1.Text = PersianText Dim jo As JavaObject = Label1 jo.RunMethod("setJustificationMode", Array(1)) Label1.Gravity = Bit.Or(Gravity.LEFT, Gravity.RIGHT) End Sub لینک کانال ایتا: https://eitaa.com/basic4androidlan ینک کانال بله: https://web.bale.ai/chat?uid=5896703188 طراح و تهیه کننده: مرتضی صباغی MR.B4A-
- 2
-
-
-
با استفاده از کدهای پست بعدی یک کورنومتر بسیار زیبا برای پروژه خود بسازید سورس فقط کافیه این دستورات رو در برنامه خود کپی کنید: Sub Process_Globals Dim t As Timer End Sub Sub Globals Dim MiliS = 0 ,Secound = 0, Minute=0 As Int Private Label2 As Label End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("MainLayout") t.Initialize("T",10) End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Sub Btn2_Click End Sub Sub T_Tick If MiliS = 100 Then Secound = Secound + 1 MiliS = 0 If Secound = 60 Then Minute = Minute + 1 Secound = 0 If Minute = 60 Then Minute = 0 Secound = 0 MiliS = 0 End If End If Else MiliS = MiliS + 1 End If Label2.Text=Minute&":"&Secound&":"&MiliS End Sub Private Sub Button1_Click t.Enabled = True End Sub Private Sub Button2_Click t.Enabled = False End Sub Private Sub Button3_Click Label2.Text=0 Label2.Text="" Minute=0 Secound=0 MiliS=0 End Sub لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال بله: https://web.bale.ai/chat?uid=5896703188 طراح و تهیه کننده: مرتضی صباغی MR.B4A
-
حل مشکل سپر امنیتی گوگل Blocked By Play Protect
MR.B4A پاسخی برای Mr Mansour ارسال کرد در سوال : پرسش و پاسخ B4A
سلام مگه از چه کتابخونه هایی استفاده میکنید؟ -
با استفاده از این مینی سورس کد، میتوانید با زدن یک دکمه، تم برنامه تان را تغییر دهید. در این سورس چندتا تم آوردم که با کدنویسی میتوانید آن ها را تغییر دهید. سورس: این سورس ها را در برنامه تان کپی کنید: Sub Process_Globals Private Theme_Value As Int End Sub Sub Globals Private res As XmlLayoutBuilder Private run As RuntimePermissions Private ProgressBar1 As ProgressBar Private Spinner1 As Spinner End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("1") ProgressBar1.Progress = 50 Spinner1.AddAll(Array("Item 1", "Item 2", "Item 3")) run.CheckAndRequest(run.PERMISSION_WRITE_EXTERNAL_STORAGE) End Sub Private Sub activity_PermissionResult (Permission As String, Result As Boolean) End Sub Sub btnHolo_Click SetTheme(res.GetResourceId("style", "android:style/Theme.Holo")) End Sub Sub btnHoloLight_Click SetTheme(res.GetResourceId("style", "android:style/Theme.Holo.Light")) End Sub Sub btnHoloLightDark_Click SetTheme(res.GetResourceId("style", "android:style/Theme.Holo.Light.DarkActionBar")) End Sub Sub btnOld_Click SetTheme(16973829) End Sub Sub btnMaterialLightDark_Click SetTheme(res.GetResourceId("style", "android:style/Theme.Material.Light.DarkActionBar")) End Sub Sub btnMaterialLight_Click SetTheme(res.GetResourceId("style", "android:style/Theme.Material.Light")) End Sub Sub btnMaterial_Click SetTheme(res.GetResourceId("style", "android:style/Theme.Material")) End Sub Private Sub SetTheme (Theme As Int) If Theme = 0 Then ToastMessageShow("Theme not available.", False) Return End If If Theme = Theme_Value Then Return File.WriteString(File.DirInternal, "theme.txt", Theme) Theme_Value = Theme Activity.Finish StartActivity(Me) End Sub #if java import anywheresoftware.b4a.objects.streams.*; public void _onCreate() { try { if (File.Exists(getFilesDir().toString(), "theme.txt")) _theme_value = Integer.parseInt(File.ReadString(getFilesDir().toString(), "theme.txt")); } catch (Exception e) { throw new RuntimeException(e); } if (_theme_value != 0) setTheme(_theme_value); } #end if تمام طراح و تهیه کننده: مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال روبیکا: https://web.rubika.ir/#c=c0DYTXf0c992f816317cf4280db0333a
-
من که به واسطه این پست میخواستم یاد بگیرم ولی چشم، روش کار میکنم اگر میخواید در جریانش هم بهتر قرار بگیرید، پیشنهاد میکنم توی کانال ایتام عضو بشید: https://eitaa.com/basic4androidlan
-
* اگر دنبال یه راه ساده و سریع برای ساخت اپ اندروید هستی، B4A یکی از بهترین گزینههاست! * این محیط توسعه با زبان Basic کار میکنه، ولی قدرتش چیزی کمتر از Java و Kotlin نداره. * ساده و قابل فهم * کدهاش مثل زبان محاورهای نوشته میشن، حتی کسایی که تازه وارد دنیای برنامهنویسی شدن به راحتی میتونن اپ بسازن. * بدون نیاز به Android Studio یا Gradle * فقط با نصب B4A کارتو شروع کن! محیطش سبکتره، اجرا سریعتره، و دردسر تنظیمات نداره. * دسترسی کامل به امکانات اندروید از دوربین و شبکه گرفته تا دیتابیس و اینتنتها — همهچیز مثل پروژههای حرفهای ممکنه. * حتی میتونی از کتابخانههای Java استفاده کنی! * فروم رسمی B4A پر از مثال، آموزش، و آدمهای باتجربهست که هر سوالی رو جواب میدن * اپهایی که با B4A ساخته میشن بهینه هستن، مصرف رم و CPU پایین دارن و خیلی روان اجرا میشن. در یک جمله: B4A یعنی قدرت برنامهنویسی حرفهای در قالبی ساده و لذتبخش. طراح و تهیه کننده: مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال روبیکا: https://web.rubika.ir/#c=c0DYTXf0c992f816317cf4280db0333a
-
- 1
-
-
مینی سورس توابع ریاضی به زبان بیسیک فور اندروید
MR.B4A پاسخی ارسال کرد برای یک موضوع در آموزش های متنی
بااستفاده از این سورس، یک برنامه ای بسازید که توابع ریاضی را حل کند توابعی مثل قدرمطلق مقدار سقفی کوسینوس برمبنای درجه مقدار کف عدد و... سورس: Sub Globals Private i As Double Private EditText1 As EditText End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Private Sub btn_tan_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(TanD(i),"تانژانت") End Sub Private Sub btn_jazr_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Sqrt(i),"جذر مربعی") End Sub Private Sub btn_sin_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(SinD(i),"سینوس") End Sub Private Sub btn_round_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Round(i),"گردکردن") End Sub Private Sub btn_tavan_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Power(2,i),"مقدار2 به توان "&i) End Sub Private Sub btn_log_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Logarithm(i,100),"لگاریتم عدد100 برمبنای"&i) End Sub Private Sub btn_kaf_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Floor(i),"مقدار کف") End Sub Private Sub btn_cos_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(CosD(i),"کسینوس") End Sub Private Sub btn_saghfi_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Ceil(i),"مقدار سقفی") End Sub Private Sub btn_motlagh_Click If EditText1.Text="" Then ToastMessageShow("لطفا عددی وارد کنید",False) Return End If i=EditText1.Text Msgbox(Abs(i),"مقدار مطلق") End Sub طراح و تهیه کننده: مرتضی صباغی MR.B4A -
با استفاده از این سورس کابردی میتوانید یک جدول بسیار کاربردی برای برنامه تان بسازید سورس: ابتدا کی کلاس تعریف کرده و کدهای زیر را در آن کپی میکنید: Sub Class_Globals Private StringUtils1 As StringUtils Private SV As ScrollView Private Header As Panel Private Callback As Object Private Event As String Private SelectedRow As Int Private Data As List Private LabelsCache As List Private minVisibleRow, maxVisibleRow As Int Private visible As Boolean Private visibleRows As Map Private NumberOfColumns, ColumnWidth As Int Public RowHeight, HeaderColor, TableColor, FontColor, HeaderFontColor As Int Public FontSize As Float Type RowCol (Row As Int, Col As Int) Public Alignment As Int Public SelectedDrawable(), Drawable1(), Drawable2() As Object 'Table settings HeaderColor = Colors.Gray RowHeight = 30dip TableColor = Colors.LightGray FontColor = Colors.Black HeaderFontColor = Colors.White FontSize = 14 Alignment = Gravity.CENTER 'change to Gravity.LEFT or Gravity.RIGHT for other alignments. End Sub Public Sub Initialize (CallbackModule As Object, EventName As String, vNumberOfColumns As Int) SV.Initialize2(0, "SV") SV.Panel.Color = TableColor Callback = CallbackModule Event = EventName innerClearAll(vNumberOfColumns) End Sub 'Clears the table Public Sub ClearAll innerClearAll(NumberOfColumns) End Sub 'Sets the columns widths. 'Example: <code>Table1.SetColumnsWidths(Array As Int(100dip, 30dip, 30dip, 100%x - 160dip))</code> Public Sub SetColumnsWidths(Widths() As Int) Dim v As View For i = 0 To Widths.Length - 1 v = Header.GetView(i) v.Width = Widths(i) - 1dip If i > 0 Then v.Left = Header.GetView(i-1).Left + Widths(i-1) + 1dip End If Next Dim lbls() As Label For i = 0 To visibleRows.Size - 1 lbls = visibleRows.GetValueAt(i) For lbl = 0 To lbls.Length - 1 lbls(lbl).SetLayout(Header.GetView(lbl).Left, lbls(lbl).Top, _ Header.GetView(lbl).Width, RowHeight) Next Next End Sub Private Sub innerClearAll(vNumberOfColumns As Int) For i = SV.Panel.NumberOfViews -1 To 0 Step -1 SV.Panel.RemoveViewAt(i) Next NumberOfColumns = vNumberOfColumns Dim Drawable1(NumberOfColumns) As Object Dim Drawable2(NumberOfColumns) As Object Dim SelectedDrawable(NumberOfColumns) As Object For i = 0 To NumberOfColumns - 1 Dim cd1, cd2, cd3 As ColorDrawable cd1.Initialize(Colors.White, 0) cd2.Initialize(0xFF98F5FF, 0) cd3.Initialize(0xFF007FFF, 0) Drawable1(i) = cd1 Drawable2(i) = cd2 SelectedDrawable(i) = cd3 Next SV.Panel.Height = 0 SelectedRow = -1 minVisibleRow = -1 maxVisibleRow = 0 Data.Initialize LabelsCache.Initialize visibleRows.Initialize SV.ScrollPosition = 0 DoEvents SV.ScrollPosition = 0 For i = 1 To 80 'fill the cache to avoid delay on the first touch LabelsCache.Add(CreateNewLabels) Next If visible Then SV_ScrollChanged(0) End If End Sub Private Sub SV_ScrollChanged(Position As Int) Dim currentMin, currentMax As Int currentMin = Max(0, Position / RowHeight - 30) currentMax = Min(Data.Size - 1, (Position + SV.Height) / RowHeight + 30) If minVisibleRow > -1 Then If minVisibleRow < currentMin Then 'need to hide the upper rows For I = minVisibleRow To Min(currentMin - 1, maxVisibleRow) HideRow(I) Next Else If minVisibleRow > currentMin Then 'need to show the upper rows For I = currentMin To Min(minVisibleRow - 1, currentMax) ShowRow(I) Next End If If maxVisibleRow > currentMax Then 'need to hide the lower rows For I = maxVisibleRow To Max(currentMax + 1, minVisibleRow) Step -1 HideRow(I) Next Else If maxVisibleRow < currentMax Then 'need to show the lower rows For I = currentMax To Max(maxVisibleRow + 1, currentMin) Step -1 ShowRow(I) Next End If End If minVisibleRow = currentMin maxVisibleRow = currentMax End Sub 'Adds the tablet to the activity. Public Sub AddToActivity(Act As Activity, Left As Int, Top As Int, Width As Int, Height As Int) visible = True Header.Initialize("") Header.Color = TableColor Act.AddView(Header, Left, Top , Width, RowHeight) Act.AddView(SV, Left, Top + RowHeight, Width, Height - RowHeight) ColumnWidth = SV.Width / NumberOfColumns SV_ScrollChanged(0) End Sub 'Adds a row to the table 'Example:<code>Table1.AddRow(Array As String("aaa", "ccc", "ddd", "eee"))</code> Public Sub AddRow(Values() As String) If Values.Length <> NumberOfColumns Then Log("Wrong number of values.") Return End If Data.Add(Values) Dim lastRow As Int lastRow = Data.Size - 1 If lastRow < (SV.ScrollPosition + SV.Height) / RowHeight + 1 Then ShowRow(lastRow) End If SV.Panel.Height = Data.Size * RowHeight End Sub Private Sub ShowRow(row As Int) If visibleRows.ContainsKey(row) Then Return 'Log("ShowRow: " & row) Dim lbls() As Label Dim values() As String lbls = GetLabels(row) values = Data.Get(row) visibleRows.Put(row, lbls) Dim rowColor() As Object If row = SelectedRow Then rowColor = SelectedDrawable Else If row Mod 2 = 0 Then rowColor = Drawable1 Else rowColor = Drawable2 End If For I = 0 To lbls.Length - 1 SV.Panel.AddView(lbls(I), Header.GetView(I).Left, row * RowHeight, Header.GetView(I).Width, _ RowHeight - 1dip) lbls(I).Text = values(I) lbls(I).Background = rowColor(I) Next End Sub Private Sub IsRowVisible(Row As Int) As Boolean Return Row < (SV.ScrollPosition + SV.Height) / (RowHeight + 1) And _ Row > SV.ScrollPosition / RowHeight End Sub Private Sub HideRow (Row As Int) 'Log("HideRow: " & row) Dim lbls() As Label lbls = visibleRows.Get(Row) If lbls = Null Then Log("HideRow: (null) " & Row) Return End If For I = 0 To lbls.Length - 1 lbls(I).RemoveView Next visibleRows.Remove(Row) LabelsCache.Add(lbls) End Sub Private Sub GetLabels(Row As Int) As Label() Dim lbls() As Label If LabelsCache.Size > 0 Then 'Log("from cache") lbls = LabelsCache.Get(LabelsCache.Size - 1) LabelsCache.RemoveAt(LabelsCache.Size - 1) Else lbls = CreateNewLabels End If For I = 0 To lbls.Length - 1 Dim rc As RowCol rc = lbls(I).Tag rc.Row = Row Next Return lbls End Sub Private Sub CreateNewLabels As Label() Dim lbls(NumberOfColumns) As Label For I = 0 To NumberOfColumns - 1 Dim rc As RowCol rc.Col = I Dim l As Label l.Initialize("cell") l.Gravity = Alignment l.TextSize = FontSize l.TextColor = FontColor l.Tag = rc lbls(I) = l Next Return lbls End Sub 'Set the headers values 'Example:<code>Table1.SetHeader(Array As String("Col1", "Col2", "Col3"))</code> Public Sub SetHeader(Values() As String) For I = Header.NumberOfViews - 1 To 0 Step -1 Header.RemoveViewAt(I) Next For I = 0 To NumberOfColumns - 1 Dim l As Label l.Initialize("header") l.Gravity = Gravity.CENTER l.TextSize = FontSize l.Color = HeaderColor l.TextColor = HeaderFontColor l.Text = Values(I) l.Tag = I Header.AddView(l, ColumnWidth * I, 0, ColumnWidth - 1dip, RowHeight) Next End Sub Private Sub Cell_Click Dim rc As RowCol Dim l As Label l = Sender rc = l.Tag SelectRow(rc.Row) If SubExists(Callback, Event & "_CellClick") Then CallSub3(Callback, Event & "_CellClick", rc.Col, rc.Row) End If End Sub Private Sub Header_Click Dim l As Label Dim col As Int l = Sender col = l.Tag If SubExists(Callback, Event & "_HeaderClick") Then CallSub2(Callback, Event & "_HeaderClick", col) End If End Sub 'Gets the value of the given cell. Public Sub GetValue(Col As Int, Row As Int) Dim values() As String values = Data.Get(Row) Return values(Col) End Sub 'Sets the value of the given cell. Public Sub SetValue(Col As Int, Row As Int, Value As String) Dim values() As String values = Data.Get(Row) values(Col) = Value If visibleRows.ContainsKey(Row) Then Dim lbls() As Label lbls = visibleRows.Get(Row) lbls(Col).Text = Value End If End Sub Private Sub SelectRow(Row As Int) Dim prev As Int prev = SelectedRow SelectedRow = Row 'remove the color of previously selected row If prev > -1 Then If visibleRows.ContainsKey(prev) Then HideRow(prev) ShowRow(prev) End If End If SelectedRow = Row For col = 0 To NumberOfColumns - 1 If visibleRows.ContainsKey(SelectedRow) Then HideRow(SelectedRow) ShowRow(SelectedRow) End If Next End Sub 'Makes the given row visible. Public Sub JumpToRow(Row As Int) SV.ScrollPosition = Row * RowHeight End Sub 'Clears the previous table and loads the CSV file to the table. 'You should first add the Table to the activity before calling this method. Public Sub LoadTableFromCSV(Dir As String, Filename As String, HeadersExist As Boolean) Dim List1 As List Dim h() As String If HeadersExist Then Dim headers As List List1 = StringUtils1.LoadCSV2(Dir, Filename, ",", headers) Dim h(headers.Size) As String For i = 0 To headers.Size - 1 h(i) = headers.Get(i) Next Else List1 = StringUtils1.LoadCSV(Dir, Filename, ",") Dim firstRow() As String firstRow = List1.Get(0) Dim h(firstRow.Length) For i = 0 To firstRow.Length - 1 h(i) = "Col" & (i + 1) Next End If innerClearAll(h.Length) ColumnWidth = SV.Width / NumberOfColumns SetHeader(h) For i = 0 To List1.Size - 1 Dim row() As String row = List1.Get(i) AddRow(row) Next End Sub 'Saves the table to a CSV file. Public Sub SaveTableToCSV(Dir As String, Filename As String) Dim headers(NumberOfColumns) As String For i = 0 To headers.Length - 1 Dim l As Label l = Header.GetView(i) headers(i) = l.Text Next StringUtils1.SaveCSV2(Dir, Filename, ",", Data, headers) سپس این کدها را در اکتیویتی که میخواهید جدول را در آن پیاده کنید، بنویسید: Sub Globals Dim Table1, Table2 As Table End Sub Sub Activity_Create(FirstTime As Boolean) Table1.Initialize(Me, "Table1", 4)' فراخوانی جدول Table1.AddToActivity(Activity, 0, 0dip, 100%x, 50%y) ' مقدار دهی به اندازه برنامه در اکتیویتی Table1.SetHeader(Array As String("سربرگ", "سربرگ 2", "سربرگ 3", "سربرگ 4"))'تنظیم سربرگ ها به هر اندازه که دوست دارید با آرایه میتونید For i=0 To 20 Table1.AddRow(Array As String("زیر مجموعه: " & i, "MR.", "B4A", "basic4android"))' و زیر مجموعه سر برگ ها همان ROW به اندازه هدر ها Next Table1.SetColumnsWidths(Array As Int(100dip, 30dip, 130dip, 100%x - 260dip))'اندازه هر بخش به اندازه هدر ها Activity.AddMenuItem("پریدن به 5", "Jump1")' منو برای پرش به قسمت از جدول Activity.AddMenuItem("پریدن به 0", "Jump2")' منو برای پرش به قسمت از جدول Table2.Initialize(Me, "Table2", 0)' Table2.AddToActivity(Activity, 0, 50%y, 100%x, 40%y)'مقدار دهی به اندازه برنامه در اکتیویتی Table2.LoadTableFromCSV(File.DirAssets, "citylist.csv", True)' فایل اکسل End Sub Private Sub t_Tick OpenLink("") End Sub Sub OpenLink(url As String) Dim i As Intent i.Initialize(i.ACTION_VIEW, url) StartActivity(i) End Sub 'لینک دانلود در این بخش توسط مرورگر باز میشود Sub Jump1_Click Table1.JumpToRow(5)' End Sub Sub Jump2_Click Table1.JumpToRow(0)' End Sub Sub Activity_Resume End Sub Sub Activity_Pause (UserClosed As Boolean) End Sub Sub Table2_CellClick (Col As Int, Row As Int) Log("(Table2) CellClick: " & Col & " , " & Row) Activity.Title = Table2.GetValue(Col, Row) End Sub Sub Table1_CellClick (Col As Int, Row As Int) Log("CellClick: " & Col & " , " & Row) Activity.Title = Table1.GetValue(Col, Row) End Sub Sub Table1_HeaderClick (Col As Int) Log("HeaderClick: " & Col) End Sub طراح و تهیه کننده: مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال روبیکا: https://web.rubika.ir/#c=c0DYTXf0c992f816317cf4280db0333a لینک کانال تلگرام: https://t.me/programmingwithb4a
-
سورس تب هاست با قابلیت اسکرول و سوآیپ در بیسیک فور اندروید
MR.B4A پاسخی ارسال کرد برای یک موضوع در آموزش های متنی
اگر پروژه تان دارای صفحات مختلفی است که تمایل ندارید کاربر از این اکتیویتی به آن اکتیویتی برود، میتوانید از این سورس استفاه کنید. با استفاده از سورس زیر میتوانید یک تب هاست بسیار کاربردی برای پروژه خود پیاده سازی کنید. ویژگی ها سوآیپ کردن اسکرول کردن قابلیت اضافه کردن تب های متعدد کدها: Sub Process_Globals Private t_char As Timer End Sub Sub Globals Private TabStrip1 As TabStrip Private B4XPageIndicator1 As B4XPageIndicator Private x_char,y_char As Int Private ScrollView1 As ScrollView Private Button2 As Button Private ListView1 As ListView Private img_run As ImageView End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("page1_main") t_char.Initialize("t_char",500) TabStrip1.LoadLayout("Page1", "pictures") TabStrip1.LoadLayout("Page2", "scrolling") TabStrip1.LoadLayout("Page3", "AND PAGE 3") Activity.AddMenuItem("Jump to page 1", "mnu1") Activity.AddMenuItem("Jump to page 2", "mnu2") Activity.AddMenuItem("Jump to page 3", "mnu3") ScrollView1.Panel.LoadLayout("scrolling_page") ScrollView1.Panel.Height = Button2.Top + Button2.Height + 15dip ListView1.Color=Colors.RGB(123, 31, 162) ListView1.SingleLineLayout.Label.TextColor=Colors.Black ListView1.SingleLineLayout.Label.TextSize=20 ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") ListView1.AddSingleLine("BASIC4ANDROID") End Sub Private Sub t_char_Tick x_char=Rnd(0,75%x) y_char=Rnd(3%y,65%y) img_run.Left=x_char img_run.Top=y_char End Sub Sub mnu1_Click TabStrip1.ScrollTo(0, True) End Sub Sub mnu2_Click TabStrip1.ScrollTo(1, True) End Sub Sub mnu3_Click TabStrip1.ScrollTo(20, True) End Sub Sub TabStrip1_PageSelected (Position As Int) B4XPageIndicator1.CurrentPage = Position If Position=2 Then t_char.Enabled=True Else t_char.Enabled=False End If End Sub یادتان باشد که لایوت های موردنظرتون رو حتما بسازید و به تب اد کنید. تهیه و تنظیم مرتضی صباغی MR.B4A -
سلام به همه میخوام پرداخت درون برنامه ای بسازم و نمیخوام از زرین پال استفاده کنم کسی هست که تجربه استفاده از api برای پرداخت بانکی رو داشته باشه و بتونه راهنمایی کنه؟
-
بیسیک فور اندروید (B4A) چیست و چرا برای برنامهنویسان جذاب است؟
MR.B4A پاسخی ارسال کرد برای یک موضوع در آموزش های متنی
بیسیک فور اندروید یک محیط توسعه ساده اما قدرتمند برای ساخت اپلیکیشنهای اندرویدی است که زمان برنامهنویسی را به شکل چشمگیری کاهش میدهد. در B4A نیازی به درگیری با پیچیدگیهای زبانهایی مثل جاوا و کاتلین نیست؛ همین سادگی باعث میشود افراد تازهکار بتوانند سریع شروع کنند و برنامهنویسان حرفهای هم با سرعت بیشتری پروژههای خود را تحویل دهند. این پلتفرم با داشتن کتابخانههای آماده، ابزارهای کاربردی، جامعه کاربری فعال و امکان تبدیل ایده به محصول در کمترین زمان، به یکی از محبوبترین گزینهها برای توسعه سریع اپلیکیشن تبدیل شده است. اگر به دنبال ساخت اپ با کمترین دردسر، بیشترین سرعت و درعینحال انعطافپذیری بالا هستید، B4A میتواند انتخابی هوشمندانه برای شما باشد. مقایسه B4A و Java در برنامهنویسی اندروید ۱) سادگی یادگیری B4A: سینتکس ساده و شبیه BASIC؛ برای شروع فوقالعاده سریع. Java: ساختار پیچیدهتر و نیازمند درک عمیقتری از مفاهیم شیءگرایی. ۲) سرعت توسعه B4A: به لطف کتابخانههای آماده و ابزارهای اتوماتیک، ساخت اپ در کمترین زمان ممکن انجام میشود. Java: حرفهای و قدرتمند، اما فرایند توسعه زمانبرتر است. ۳) دسترسی به قابلیتهای اندروید B4A: بیشتر قابلیتها را پوشش میدهد؛ اما برای امکانات بسیار پیشرفته ممکن است محدودیتهایی وجود داشته باشد. Java: دسترسی کامل و مستقیم به تمامی APIهای اندروید. ۴) جامعه کاربری و منابع آموزشی B4A: جامعه کوچکتر اما بسیار فعال و صمیمی. Java: یکی از بزرگترین جوامع برنامهنویسی در دنیا. ۵) مناسب برای چه کسانی؟ B4A: بهترین انتخاب برای کسانی که میخواهند سریع اپ بسازند و زمان یادگیری کوتاه باشد. Java: مناسب حرفهایها و کسانی که قصد دارند به توسعه پیشرفته اندروید یا کار روی پروژههای بزرگ وارد شوند. مقایسه B4A و Kotlin در برنامهنویسی اندروید ۱) سطح دشواری یادگیری B4A: بسیار ساده و قابل فهم، مناسب شروع سریع حتی بدون تجربه قبلی. Kotlin: مدرن، قدرتمند و شیءگرا، اما برای مبتدیها نسبتاً پیچیدهتر از B4A. ۲) سرعت توسعه B4A: بهلطف ابزارها و کتابخانههای آماده، ساخت اپها خیلی سریعتر انجام میشود. Kotlin: نسبت به Java سریعتر و تمیزتر، اما همچنان نیازمند ساختاردهی و کدنویسی بیشتر نسبت به B4A. ۳) امکانات و انعطافپذیری B4A: مناسب اپلیکیشنها و پروژههای عمومی؛ اما در ویژگیهای خیلی تخصصی اندروید ممکن است محدودیت داشته باشد. Kotlin: دسترسی کامل به همهی APIهای اندروید، مناسب پروژههای پیشرفته و حرفهای. ۴) آینده و پشتیبانی B4A: جامعه فعال و ابزار قابل اعتماد؛ بیشتر مناسب توسعه سریع. Kotlin: زبان رسمی اندروید، پشتیبانی مستقیم گوگل و آینده بسیار روشن. ۵) مناسب برای چه کسانی؟ B4A: افرادی که میخواهند با کمترین پیچیدگی و بیشترین سرعت اپ بسازند. Kotlin: برنامهنویسانی که قصد توسعه بلندمدت، حرفهای و سطح بالا برای اندروید دارند. در B4A میتوانی به دو شکل از Java استفاده کنی: الف) کتابخانههای آمادهٔ جاوا هر کتابخانهای که برای اندروید نوشته شده باشد (jar یا aar) معمولاً قابل استفاده در B4A است. ب) نوشتن کد جاوا داخل پروژه (Java Inline Code) B4A این قابلیت را دارد که داخل کد B4A، تکهکدهای جاوا اضافه کنی و مستقیماً از آن استفاده کنی. این یعنی: متد بسازی کلاس تعریف کنی از APIهای پیشرفته اندروید استفاده کنی بدون نیاز به نوشتن کل برنامه با جاوا. پشتیبانی از جاوا در B4A کاملاً کامل و یک قابلیت رسمی است. کاتلین بهصورت مستقیم داخل B4A قابل نوشتن نیست، اما: میتوانی کتابخانهای که با Kotlin نوشته شده را (AAR/JAR) وارد B4A کنی به شرطی که: کلاسها به Java قابل استفاده باشند (که معمولاً هستند) از coroutines یا ویژگیهای خاصی که نیاز به ساختار Kotlin runtime خاص دارند، درست پشتیبانی شود در این حالت، کاتلین برای B4A مثل یک کتابخانهٔ خارجی رفتار میکند. پس: استفاده از Kotlin ممکن است، اما نه به سادگی جاوا. طراح و تهیه کننده: مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال روبیکا: https://web.rubika.ir/#c=c0DYTXf0c992f816317cf4280db0333a -
با استفاده از این سورس، متن حرکتی زیبا برای برنامه تان بسازید. سورس: این دستورات را در اکتیویتی مورد نظرتان کپی کنید: Sub Process_Globals Private t As Timer End Sub Sub Globals Dim lbl As Label Dim lbl2 As Label Private a,b,c,d,e,f As Int Private pnl_adv As Panel End Sub Sub Activity_Create(FirstTime As Boolean) Activity.LoadLayout("Layout") t.Initialize("t",500) t.Enabled=True lbl.Initialize("lbl") lbl.Text="برنامهنویسی اندروید یکی از محبوبترین مهارتها در حوزه فناوری است."& _ "این مهارت به توسعهدهندگان امکان میدهد تا اپلیکیشنهای متنوعی برای گوشیهای هوشمند طراحی کنند."& _ "با استفاده از زبانهایی مانند Java و Kotlin، برنامهنویسان قادر به ایجاد برنامههای قدرتمند و کاربردی هستند."& _ "اندروید بهعنوان یک سیستمعامل متنباز، امکانات زیادی برای سفارشیسازی در اختیار قرار میدهد."& _ "در نهایت، یادگیری برنامهنویسی اندروید فرصتی عالی برای ورود به بازار کار فناوری است." lbl.Typeface=Typeface.DEFAULT_BOLD lbl.TextSize=18 lbl.Gravity=Gravity.CENTER_VERTICAL Activity.AddView(lbl,0%x,10%y,100%x,15%y) Marquee(lbl) lbl2.Initialize("lbl2") lbl2.Text="Android programming is one of the most popular skills in the tech industry."& _ "This skill allows developers To design a variety of applications For smartphones."& _ "Using languages like Java And Kotlin, programmers can create powerful And functional apps."& _ "As an open-source operating system, Android offers extensive customization capabilities."& _ "In the End, learning Android programming Is a great opportunity To enter the tech job market." lbl2.Typeface=Typeface.DEFAULT_BOLD lbl2.TextSize=18 lbl2.Gravity=Gravity.CENTER_VERTICAL Activity.AddView(lbl2,0%x,20%y,100%x,15%y) Marquee2(lbl2) End Sub Sub Marquee(lbl_t As Label) lbl_t.SingleLine = True lbl_t.Ellipsize = "MARQUEE" Sleep(10) Dim jo As JavaObject = lbl_t jo.RunMethod("setSelected", Array(True)) End Sub Sub Marquee2(lbl_t2 As Label) lbl_t2.SingleLine = True lbl_t2.Ellipsize = "MARQUEE" Sleep(10) Dim jo As JavaObject = lbl_t2 jo.RunMethod("setSelected", Array(True)) End Sub Private Sub t_Tick a=Rnd(0,255) b=Rnd(0,255) c=Rnd(0,255) lbl.TextColor=Colors.RGB(a,b,c) d=Rnd(0,255) e=Rnd(0,255) f=Rnd(0,255) lbl2.TextColor=Colors.RGB(d,e,f) End Sub سورس قابلیت خوان متن از دیتابیس آنلاین و آفلاین را دارد. طراح و تهیه کننده: مرتضی صباغی MR.B4A لینک کانال ایتا: https://eitaa.com/basic4androidlan لینک کانال روبیکا: https://web.rubika.ir/#c=c0DYTXf0c992f816317cf4280db0333a
-
- 1
-
-
بااستفاده از این سورس، یک اسلاید منوی بسیار زیبا با قابلیت کلیک آیتم برای پروژه تان بسازید سورس: ابتدا توی اکتیویتی که میخواهید منو را پیاده سازی کنید، این کدها را بنویسید: Sub Process_Globals End Sub Sub Globals #region appBar Dim lblMenu,lblTitle As Label Dim pnl_header As Panel Private img As ImageView #end region #region SlideMenu Dim PnlMenu,PnlBackMenu As Panel Private Scroll_SlideMenu As ScrollView Private img_menu As ImageView #end region End Sub Sub Activity_Create(FirstTime As Boolean) If File.Exists(File.DirInternal,"db.db")=False Then File.Copy(File.DirAssets,"db.db",File.DirInternal,"db.db") End If InitAppBar Initialize_SlideMenu End Sub Sub InitAppBar img.Initialize("") Activity.AddView(img,10%x,20%y,80%x,50%y) img.SetBackgroundImage(LoadBitmap(File.DirAssets,"pic1.png")) img.Gravity=Gravity.FILL pnl_header.Initialize("") pnl_header.Color = Colors.RGB(85,186,209) ' pnl_header.Elevation=6dip Activity.AddView(pnl_header,0,0,Activity.Width,56dip) lblMenu.Initialize("lblMenu") lblMenu.TextColor = Colors.White lblMenu.Gravity = Bit.Or(Gravity.CENTER_HORIZONTAL,Gravity.CENTER_VERTICAL) lblMenu.Typeface = Typeface.MATERIALICONS lblMenu.Text = Chr(0xE5D2) lblMenu.TextSize = 27 pnl_header.AddView(lblMenu,pnl_header.Width -50dip,3dip,50dip,50dip) lblTitle.Initialize("lblTitle") lblTitle.TextColor = Colors.White lblTitle.Gravity = Bit.Or(Gravity.CENTER_HORIZONTAL,Gravity.CENTER_VERTICAL) lblTitle.Text = "MR.B4A" lblTitle.TextSize = 18 pnl_header.AddView(lblTitle,0dip,3dip,pnl_header.Width,50dip) End Sub Sub Initialize_SlideMenu PnlBackMenu.Initialize("PnlBackMenu") PnlBackMenu.Color = Colors.ARGB(150,106,106,106) PnlBackMenu.Visible = False PnlBackMenu.BringToFront Activity.AddView(PnlBackMenu,0,0,Activity.Width,Activity.Height) PnlMenu.Initialize("PnlMenu") PnlMenu.Visible = False PnlMenu.Color = Colors.White PnlBackMenu.AddView(PnlMenu,28%x,0,PnlBackMenu.Width - 28%x,PnlBackMenu.Height) img_menu.Initialize("") img_menu.SetBackgroundImage(LoadBitmap(File.DirAssets,"pic1.png")) img_menu.Gravity=Gravity.FILL img_menu.Visible=False PnlMenu.AddView(img_menu,10%x,30%y,50%x,25%y) Scroll_SlideMenu.Initialize(2000) PnlMenu.AddView(Scroll_SlideMenu,0,0,PnlMenu.Width,PnlMenu.Height) 'برای حذف میله اسکرول ویو.نیاز به کتابخونه 'Reflection ' Dim r As Reflector ' r.Target = Scroll_SlideMenu ' r.RunMethod2("setVerticalScrollBarEnabled", False, "java.lang.boolean") ExtentionCode.SlideMenu(Scroll_SlideMenu) End Sub Sub LblItem_Click Dim lbl As Label lbl = Sender Dim tag As Int = lbl.Tag Select tag Case 0 Activity.Finish StartActivity("about") Case 1 img_menu.SetVisibleAnimated(1000,True) Case 2 Msgbox("MR.B4A","") End Select ' PnlBackMenu_Click End Sub Sub LblMenu_Click If PnlBackMenu.Visible = False Then Dim anim As AnimationPlus PnlBackMenu.SetVisibleAnimated(1000,True) anim.InitializeTranslate("anim1" ,PnlMenu.Width-10dip,0,0,0) PnlMenu.Top = 0dip PnlMenu.Height = PnlBackMenu.Height anim.Duration=200 anim.Start(PnlMenu) ' PnlMenu.SetVisibleAnimated(1,True) PnlMenu.Visible = True ' PnlBackMenu.BringToFront Else Dim anim As AnimationPlus anim.InitializeTranslate("anim1" ,0,0,PnlMenu.Width-10dip,0) PnlMenu.Top = 0dip PnlMenu.Height = PnlBackMenu.Height anim.Duration=200 anim.Start(PnlMenu) PnlMenu.SetVisibleAnimated(200,False) Sleep(200) PnlBackMenu.SetVisibleAnimated(1,False) End If End Sub Sub PnlBackMenu_Click Dim anim As AnimationPlus anim.InitializeTranslate("anim1" ,0,0,PnlMenu.Width-10dip,0) PnlMenu.Top = 0dip PnlMenu.Height = PnlBackMenu.Height anim.Duration = 200 anim.Start(PnlMenu) PnlMenu.Visible = False Sleep(80) PnlBackMenu.SetVisibleAnimated(1,False) End Sub Sub PnlMenu_Click Log("") End Sub Sub Activity_KeyPress (KeyCode As Int) As Boolean If KeyCode = KeyCodes.KEYCODE_BACK And PnlBackMenu.Visible = True Then Dim anim As AnimationPlus anim.InitializeTranslate("anim1",0,0,PnlMenu.Width-10dip,0) PnlMenu.Top = 0dip PnlMenu.Height = PnlBackMenu.Height anim.Duration = 200 anim.Start(PnlMenu) PnlMenu.Visible = False PnlBackMenu.SetVisibleAnimated(50,False) Return True Else if KeyCode = KeyCodes.KEYCODE_BACK Then ExitApplication Return True Else Return False End If End Sub Sub PnlMenu_Touch (Action As Int, X As Float, Y As Float) Dim Start_TouchX As Int Select Action Case Activity.ACTION_DOWN Start_TouchX = X Case Activity.ACTION_UP If Abs(X-Start_TouchX) > 50dip Then If X > Start_TouchX Then ' swipe right Log("right") Dim anim As AnimationPlus anim.InitializeTranslate("anim1" ,0,0,PnlMenu.Width-10dip,0) PnlMenu.Top = 0dip PnlMenu.Height = PnlBackMenu.Height anim.Duration = 200 anim.Start(PnlMenu) PnlMenu.SetVisibleAnimated(200,False) Sleep(80) PnlBackMenu.SetVisibleAnimated(1,False) End If If X < Start_TouchX Then ' swipe left Log("left") End If End If End Select End Sub یک ماژول بسازید و این کدها را داخلش کپی کنید: Sub Process_Globals ' Dim FontIransanse As Typeface = Typeface.LoadFromAssets("iransans.ttf") Dim ListItem As List = Array As String("درباره ما","MR.B4A","برنامه نویسی اندروید با...") Dim ListIcon As List = Array As String(Chr(0xE853),Chr(0xE859),Chr(0xE22B),Chr(0xE8E8)) Dim top As Int End Sub Sub SlideMenu(sc As ScrollView) top = 0 For i = 0 To ListItem.Size - 1 Dim PnlItem As Panel PnlItem.Initialize("PnlItem") Dim cd As ColorDrawable cd.Initialize(Colors.Transparent,5dip) PnlItem.Background = cd sc.Panel.AddView(PnlItem,5dip,top,sc.Width-10dip,40dip) Dim LblIconConst As Label LblIconConst.Initialize("") LblIconConst.TextColor = 0xFF3E3E3E LblIconConst.Gravity = Bit.Or(Gravity.CENTER_HORIZONTAL,Gravity.CENTER_VERTICAL) LblIconConst.Typeface = Typeface.MATERIALICONS LblIconConst.Text = Chr(0xE5CB) LblIconConst.TextSize = 25 PnlItem.AddView(LblIconConst,2dip,2dip,38dip,PnlItem.Height - 4dip) Dim LblItem As Label LblItem.Initialize("LblItem") LblItem.TextColor = 0xFF3E3E3E LblItem.Gravity = Bit.Or(Gravity.CENTER_VERTICAL,Gravity.RIGHT) ' LblItem.Typeface = FontIransanse LblItem.Text = ListItem.Get(i) LblItem.TextSize = 14 LblItem.Tag = i PnlItem.AddView(LblItem,40dip,2dip,PnlItem.Width - 80dip,PnlItem.Height - 4dip) Dim LblIconVar As Label LblIconVar.Initialize("") LblIconVar.TextColor = 0xFF3E3E3E LblIconVar.Gravity = Bit.Or(Gravity.CENTER_HORIZONTAL,Gravity.CENTER_VERTICAL) LblIconVar.Typeface = Typeface.MATERIALICONS LblIconVar.Text = ListIcon.Get(i) LblIconVar.TextSize = 25 PnlItem.AddView(LblIconVar,PnlItem.Width - 38dip,2dip,38dip,PnlItem.Height - 4dip) If i=1 Then LblItem.TextColor=0xFF3EA3B5 LblIconVar.TextColor=0xFF3EA3B5 LblItem.TextSize=16 Else If i=3 Then LblItem.TextColor=0xFF00CAFF LblItem.TextSize=20 Else If i=0 Then LblItem.TextColor= 0xFFC13B63 LblItem.Typeface=Typeface.DEFAULT_BOLD LblItem.TextSize=22 End If top = top + 45dip Next sc.Panel.Height = top End Sub حالا شما این منوی زیبا را دارید: https://aparat.com/v/hbz60ez طراح و تهیه کننده: مرتضی صباغی MR.B4A
-
- 1
-