运行截图
本例程演示了滑动面板的使用和图片如何缩放到一个区域里显示
Main窗体代码如下
#Region Project Attributes
#ApplicationLabel:相册
#VersionCode: 1
#VersionName:
'SupportedOrientations(支持的方向) 值可以是： unspecified(未指定), landscape(纵向)或portrait(横向)。
#SupportedOrientations: unspecified
#CanInstallToExternalStorage: False
#End Region
#Region Activity Attributes
#FullScreen: true
#IncludeTitle: false
#End Region
Sub Process_Globals
End Sub
Sub Globals
Dim SD As SlidingPanels
'主界面会显示N只宠物狗
Dim NuDoc =5 As Int
'来源 《触碰图片控件TouchImageView》
'http://www.basic4ppc.com/android/forum/threads/TouchImageView.15616/#content
Dim gTouchImageView(NuDoc) As TouchImageView
Dim gImageView(NuDoc) As ImageView
'库 Core > 类 Rect 方法:2 属性:6 常量:0 事件:0
'矩形，拥有四个坐标
Dim gSourceImageRect, gTouchImageViewRect As Rect
End Sub
Sub Activity_Create(FirstTime As Boolean)
Activity.Color=Colors.White
IniActivity
End Sub
Sub Activity_Resume
End Sub
Sub Activity_Pause (UserClosed As Boolean)
End Sub
'初始化Activity
Sub IniActivity
'获取指定目录下，指定字符串开头的文件名称
Dim vDocPics() = GetFileName(File.DirAssets,"doc_") As String
' cLog("vDocPics数组元素数量有" & vDocPics.Length)
#Region 加载图片
'SlidingPanels初始化。
'EventName - 单击或改变控件时的事件名称
'Speed - 滑动速度,以毫秒为单位。
'水平--如果确实意味着水平滚动,垂直。
'Horizontal - if it is True means horizontal scrolling, vertical otherwise.
'Parent - 在哪里活动创建SlidingPanels。
'Module - 必须是Me
'Module - must be "Me"
SD.Initialize( "SD",350,Activity,Me,True) 'Initialize the Class.
' SD.ModeLittlePanelsZoom(NuDoc,50%x,70%x,70%y,30%x,True,200,Activity.Width*0.9) 'Creates the mode of SlidingPanels.
' SD.ModeFullScreen(NuDoc,False)
'创建SlidingPanels面板全屏，可以用SD.panels.Length获取子面板数量
'测试中发现参数SlidingInLoop 填写True会出错，只能填写Flase
'这是一个由沉默蜂改进的增强版本
'创建SlidingPanels面板全屏，使用前必须先初始化的类。
'NumberOfPanels - 要创建面板的数量。
'TopSpace - 子面板离屏幕顶部的距离 (沉默蜂增加的参数)
'numDistance - 各子面板之间的距离 (沉默蜂增加的参数)
'SlidingInLoop - 子面板是否采用循环切换方式显示(True = 不断循环)。
'为了照顾模拟标题栏而特地改动全屏模式
SD.ModeFullScreen2(NuDoc, 0.8, 5%x, False)
'---Add elements to Panels---
' Dim c As Int
Dim vBitmap As Bitmap
Dim vBitmapDrawable As BitmapDrawable
Dim vWidth , vHeight ,vLeft,vTop As Float
For c = 0 To SD.panels.Length-1
'初始化触碰图片控件
gTouchImageView(c).Initialize("gTouchImageView")
gTouchImageView(c).Tag=c
'往屏幕增加这个控件，若不加下面这句代码，控件将无法显示
SD.panels(c).AddView(gTouchImageView(c), 0, 0, SD.panels(c).Width, SD.panels(c).Height)
SD.panels(c).Visible=False
gTouchImageView(c).Visible=False
#Region 通过TouchImageView对象获取自适应指定矩形区域里的图片尺寸
'库 TouchImageView > 类 TouchImageView > 属性 MaxScale As Float
'获取或设置的最大尺度的图像可以放大(放大). 默认MaxScale是1.5.
'库 TouchImageView > 类 TouchImageView > 属性 MinScale As Float
'获取或设置图像的最小规模可以减少(放大).默认MinScale是0.5.
'库 TouchImageView > 类 TouchImageView > 属性 TranslatePadding As Int
'获取或设置图像的最小数量的像素在TouchImageView总是显示.
'默认TranslatePadding 64像素.
'图像不能拖的可见性,至少64像素的宽度和高度总是可见的.
' gTouchImageView(c).MinScale=0.25
' gTouchImageView(c).MaxScale=2
' gTouchImageView(c).TranslatePadding=SD.panels(c).Width
' gTouchImageView(c).Gravity=Gravity.FILL
'设置控件的背景图片，调用的目录资料里的图片b4a_logo.png
' gTouchImageView(c).SetBackgroundImage(LoadBitmap(File.DirAssets, "b4a_logo.png"))
'定义一个位置对象
Dim Bitmap1 As Bitmap
'用目录资源里的一张图片来初始化这个位置对象
Bitmap1.Initialize(File.DirAssets,vDocPics(c))
'载入这个位置对象
gTouchImageView(c).SetBitmap(Bitmap1)
' If FirstTime Then
'初始化矩形对象，定位它的左边、顶边、右边、底边等4个值
'库 Core > 类 Rect > 方法 Initialize ( Left As int, Top As int, Right As int, Bottom As int )
'Source数据来源
gSourceImageRect.Initialize(0, 0, Bitmap1.Width, Bitmap1.Height)
gTouchImageViewRect.Initialize(0, 0, gTouchImageView(c).Width, gTouchImageView(c).Height)
' End If
'库 TouchImageView > 类 TouchImageView > 方法 ScaleSrcRectToDestRect
'ScaleSrcRectToDestRect ( SrcRect As Rect, DestRect As Rect, ScaleToFit As String )
'Scale AND position the area of the (foreground) image defined by SrcRect To the area of the TouchImageView defined by DestRect.
'ScaleToFit controls how the image should be aligned In the DestRect:
'CENTER - Center AND maximise the image To fit the DestRect maintaining the aspect ratio.
'End - Maximise the image To fit the DestRect maintaining the aspect ratio, align the image with the bottom AND right edges of the DestRect.
'FILL - Maximise the image To completely fill the DestRect, the aspect ratio may Not be maintained.
'START - Maximise the image To fit the DestRect maintaining the aspect ratio, align the image with the top AND left edges of the DestRect.
'
'SrcRect 和 DestRect 设置图片的大小和位置
'ScaleToFit = 控制DestRect应该如何对齐图像:
'CENTER = 中心和最大化图像以适应DestRect保持长宽比.
'--图像以适应DestRect最大化保持长宽比,使图像与底部和右DestRect的边缘.
'FILL = 图像完全填补DestRect最大化,长宽比不得予以保留.
' 'START= 最大化图像以适应DestRect保持长宽比,使图像与DestRect的顶部和左边缘.
'
'
' '如果扩展过程尺度图像小于当前MinScale或超过当前MaxScale然后MinScale MaxScale将调整
' ' if the scaling process scales the image to less than the current MinScale or more than the current MaxScale then MinScale or MaxScale will be adjusted
gTouchImageView(c).ScaleSrcRectToDestRect( gSourceImageRect, gTouchImageViewRect, "CENTER")
'返回当前触碰控件中图片的尺寸大小和位置
gTouchImageViewRect=gTouchImageView(c).GetDestRect
#End Region 获取自适应指定矩形区域里的图片尺寸
' cLog( "c = " &c)
SD.panels(c).Color=Colors.White
' SD.panels(c).Background =Methods.CtrDrawableRounded(Colors.White)
vBitmap.Initialize(File.DirAssets,vDocPics(c))
'把缩放后的图片尺寸提取出来
vWidth=gTouchImageViewRect.Right
vHeight=gTouchImageViewRect.Bottom
vLeft=(SD.panels(c).Width-vWidth)/2
vTop=( SD.panels(c).Height -vHeight )/2
SD.panels(c).RemoveAllViews
gImageView(c).Initialize("")
SD.panels(c).AddView(gImageView(c),vLeft,vTop,SD.panels(c).Width,vHeight)
gImageView(c).Gravity=Gravity.FILL
gImageView(c).Bitmap=vBitmap
'
Next
#Region 显示指定图片
' lblDemo = False
'库 Core > 类 Common > 方法 RndSeed
'RndSeed ( Seed As Long )
'设定随机种子值，若不设置随机数种子值，可能出来的随机数每次会相同
'下面代码为沉默蜂所加
RndSeed (DateTime.Now)
SD.Start( Rnd(0,SD.panels.Length )) 'Start the SlidingPanels.
' SD.Start(0)
'如果这个触碰控件不隐藏的话，一次载入大量图片，会让有看得眼花
'全部显示后再显示图片
For i=0 To gTouchImageView.Length-1
SD.panels(i).Visible=True
gTouchImageView(i).Visible=True
Next
#End Region 显示指定图片
#End Region 加载图片
End Sub
'获取指定目录下，指定字符串开头的文件名称
Sub GetFileName (vDir As String ,vStatrFileName As String) As String()
'这个方法就做两个事
'listMenuName保存菜单名称
'listFileName保存文件名
Dim FileList As List
Dim FileName As String
Dim LongFileName = "" As String
Dim sfString As StringFunctions
'获取根目录的所有文件(含文件夹)到列表
FileList=File.ListFiles (vDir)
If FileList .Size >0 Then
'枚举列表
For i=0 To FileList.Size-1
FileName=FileList.Get ( i)
'判断是文件夹还是文件
If (File.IsDirectory(File.DirAssets,FileName)) Then
'目录
'Log("文件夹 = " &FileName)
Else
'文件
'Log("文件名 = " &FileName)
'判断是否为指定字符串开头的文件名
If Left(FileName,vStatrFileName.Length)=vStatrFileName Then
'保存文件名
If LongFileName ="" Then
LongFileName = FileName
cLog("图片文件 "& vDir &"/"&FileName)
Else
LongFileName = LongFileName & CRLF & FileName
cLog("图片文件 "& vDir &"/"&FileName)
End If
End If
End If
Next
End If
' Dim ANS() As String
'
' ANS = sfString.Split2(LongFileName, CRLF)
Return sfString.Split2(LongFileName, CRLF)
End Sub
'自定义LOG命令
Sub cLog(message As String)
Log(DateTime.Time(DateTime.now) & " "&message)
End Sub
'处理回退键事件
Sub Activity_KeyPress (KeyCode As Int) As Boolean
If (KeyCode = KeyCodes.KEYCODE_BACK) Then
If (Msgbox2("是否要退出程序?", "", "确定", "取消", "", Null) = DialogResponse.POSITIVE) Then
'DialogResponse是一个预定义的对象,其中包含了可能的返回值
'DialogResponse.Positive = -1 '点击确认按钮
'DialogResponse.CANCEL= -3 '点击取消按钮
ExitApplication '退出应用
'Return False 表示按键信息交给系统处理
'这个处理由两个步骤组成：
'1、在系统执行默认的退出键事件之前，先执行我写的代码
'2、执行系统默认的退出键事件
Return False'返回False则表示按键信息交给系统处理
' Activity.Finish'关闭这个活动
Else
'Return True 将告诉系统，当前的退出键已经处理好了
'Return True 只执行我写的代码，不再去执行系统默认的退出键事件
Return True'返回True则表示按键已经处理
End If
End If
End Sub
'取字符串左边指定字数的内容
Public Sub Left(Str As String,Lens As Int)As String
Return (Str.SubString2(0,Lens))
End Sub
Sub Activity_Touch (Action As Int, X As Float, Y As Float)
'This line should be added if you use the option ActivityTouch.
SD.Panels_Touch(Action,X,Y)
End Sub
标准类SlidingPanels代码如下
#Region Library Attributes
#Event: Click
#Event: LongClick
#Event: Change
#End Region
'Class Name: SlidingPanels
'Author: Dominex
'Version: 1.20
'B4A Version Used: 2.50
'Last Modified: 10/02/2013
'-------------------------
'Class module
Private Sub Class_Globals
Private UseFriction,FRICTION_DEC = 0.96,FRICTION_INC = 1.02,FRICTION_ACCELERATE = 1.5 As Float
Private ACTION_DOWN = 0,ACTION_UP = 1,ACTION_MOVE = 2 As Int
Private DisXtest = 160*Density/5,VelTest = 200 As Int
Private MargineTouch As Int = 10dip
'-------------------------------------------------
Private Timer1,TimerLC As Timer
Private Display As Panel
Private X0,X1,CurrentPanel,Velocity,vDistance,Touched As Int
Private vWidth,vYpos,vZoom,vZoomArea,OrigH,OrigW As Int
Private NoLoop,FirstTime,vFriction,SlidingInProgress,vActivityTouch,LongClick As Boolean
Private RapidSliding As Long
Private vEventName,EventTouch As String
Type JumpData (Panel As Int,Delay As Int,Speed As Int)
Private Jump As JumpData
Type MovesPanel (PanelNumber As Int,Start As Float,Destination As Int,Increase As Float)
Private Move As MovesPanel
Private vModule As Object
Type TouchData (X As Int,Y As Int,Tag As Object)
Private vTouchData As TouchData
'-------------------------------------------------
Public Panels() As Panel
End Sub
Private Sub Timer_Tick
If Not(SlidingInProgress) Then
Timer1.Enabled = False
Return
End If
Dim c = Move.PanelNumber,GCP = GetCenterPosition(c) As Int
If Abs(GCP-Move.Destination) < Abs(Move.Increase) Or GCP = Move.Destination Then
SetLeftPosition(c,Move.Destination)
CurrentPanel = Move.PanelNumber
SlidingInProgress = False
Else If Abs(Move.Increase) < 0.5 Then
SlidingInProgress = False
Else
If UseFriction = FRICTION_DEC Then
Move.Increase = Move.Increase*FRICTION_DEC
Else If UseFriction = FRICTION_INC Then
Move.Increase = Min(Move.Increase*FRICTION_INC,20)
End If
Move.Start = Move.Start + Move.Increase
SetLeftPosition(c,Move.Start)
End If
Concatenates(c)
If SlidingInProgress = False Then
If UseFriction = FRICTION_INC Then
UseFriction = 0
If SubExists(vModule,vEventName&"_Change") Then CallSub2(vModule,vEventName&"_Change",CurrentPanel)
Else If UseFriction = FRICTION_DEC Then
FrictionPanelBack
Else If Jump.Panel = -1 And FirstTime = False Then
If SubExists(vModule,vEventName&"_Change") Then CallSub2(vModule,vEventName&"_Change",CurrentPanel)
Else
FirstTime = False
End If
If Jump.Panel > -1 Then JumpToPanel(Jump.Panel,Jump.Speed,Jump.Delay)
End If
End Sub
Private Sub FrictionPanelBack
UseFriction = FRICTION_INC
PanelToCentre(CalcCurrentPanel,Velocity*5) '*10)
End Sub
Private Sub CalcCurrentPanel As Int
Dim c,Tmp,TmpDisX,TmpPanel As Int
TmpDisX = Abs(vWidth/2-GetCenterPosition(0))
If Panels.Length > 1 Then
For c = 1 To Panels.Length-1
Tmp = Abs(vWidth/2-GetCenterPosition(c))
If Tmp < TmpDisX Then
TmpDisX = Tmp
TmpPanel = c
End If
Next
End If
CurrentPanel = TmpPanel
Return CurrentPanel
End Sub
Private Sub Concatenates (PanelNumber As Int)
Dim c,dist As Int
For c = 0 To Panels.Length-1
If c <> PanelNumber Then
dist = CalcCenterPosition(c,PanelNumber)
If dist-Panels(c).Width/2 < Display.Width Or dist+Panels(c).Width/2 > 0 Then
SetLeftPosition(c,dist)
End If
End If
Next
If vZoom > 0 Then CalculatesZoom
If NoLoop Then
If CalcCenterPosition(0,PanelNumber) > Display.Width+vWidth Or _
CalcCenterPosition(Panels.Length-1,PanelNumber) < -vWidth Then FrictionPanelBack
Else If FirstTime = False Then
If PanelNumber = 0 And Panels(PanelNumber).Left > 0 Then
Panels(Panels.Length-1).Left = Panels(PanelNumber).Left-Panels(PanelNumber).Width
Else If PanelNumber = Panels.Length-1 And Panels(PanelNumber).Left < 0 Then
Panels(0).Left = Panels(PanelNumber).Left+Panels(PanelNumber).Width
End If
End If
Display.Invalidate
End Sub
Private Sub CalculatesZoom
Dim c,tmpZoom,topZoom,DisP As Int
For c = 0 To Panels.Length-1
DisP = Min(Abs(Panels(c).Left+Panels(c).Width/2-Display.Width/2),vZoomArea/2)
DisP = (vZoom-100)/(vZoomArea/2)*DisP
tmpZoom = vZoom-DisP
If tmpZoom > topZoom Then
topZoom = tmpZoom
Panels(c).BringToFront
End If
ZoomPanel(Panels(c),tmpZoom)
Next
End Sub
Private Sub PanelToCentre (PanelNumber As Int,Speed As Int)
Move.PanelNumber = PanelNumber
Move.Start = CalcCenterPosition(PanelNumber,CurrentPanel)
Move.Destination = Display.Width/2
Speed = Speed/Display.Width*Abs(Move.Destination-Move.Start)
If UseFriction = FRICTION_DEC Then
Move.Increase = 1
Else
Move.Increase = (Move.Destination-Move.Start)/(Speed/Timer1.Interval)
End If
SlidingInProgress = True
Timer1.Enabled = True
End Sub
Private Sub CalcCenterPosition (PanelNumber As Int,Reference As Int) As Int
Return (PanelNumber-Reference)*(vWidth+vDistance)+Panels(Reference).left+Panels(Reference).Width/2
End Sub
Private Sub GetCenterPosition (PanelNumber As Int) As Int
PanelNumber = Min(Max(0,PanelNumber),Panels.Length-1)
Return Panels(PanelNumber).Width/2+Panels(PanelNumber).Left
End Sub
Private Sub SetLeftPosition (PanelNumber As Int,CenterPosition As Int)
Panels(PanelNumber).Left = CenterPosition-(Panels(PanelNumber).Width/2)
End Sub
Private Sub ClickedPanel (X As Int,Y As Int) As Int
Dim c,dimension,idx = -1 As Int
For c = 0 To Panels.Length-1
If X >= Panels(c).Left AND Y >= Panels(c).Top AND X <= Panels(c).Left+Panels(c).Width AND _
Y <= Panels(c).Top+Panels(c).Height Then
If Panels(c).Width > dimension Then
dimension = Panels(c).Width
idx = c
End If
End If
Next
Return idx
End Sub
Private Sub TimerLC_Tick
Dim margine = 5dip As Int
TimerLC.Enabled = False
If SubExists(vModule,vEventName&"_LongClick") Then
vTouchData.Tag = Panels(Touched).Tag
CallSub2(vModule,vEventName&"_LongClick",vTouchData)
LongClick = True
End If
End Sub
Public Sub Panels_Touch (Action As Int,X As Float,Y As Float)
If SlidingInProgress Then
SlidingInProgress = False
Timer1.Enabled = False
Jump.Panel = -1
End If
Select Action
Case ACTION_DOWN
If vActivityTouch Then
Touched = ClickedPanel(X,Y)
If Touched = -1 Then
Return
End If
X = X - Panels(Touched).Left
Else
Dim Send = Sender As Panel
Touched = Send.Tag
End If
RapidSliding = DateTime.Now
X0 = X
X1 = GetCenterPosition(Touched)
'---Stores the position for LongClick---
vTouchData.X = X
vTouchData.Y = Y
LongClick = False
TimerLC.Enabled = True
Case ACTION_MOVE
If Touched = -1 Then Return
If vActivityTouch Then X = X - Panels(Touched).Left
If Abs(vTouchData.X-X) > MargineTouch OR Abs(vTouchData.Y-Y) > MargineTouch Then TimerLC.Enabled = False
SetLeftPosition(Touched,X-X0+GetCenterPosition(Touched))
Concatenates(Touched)
If DateTime.Now-RapidSliding > 1000 Then
RapidSliding = DateTime.Now
End If
Case ACTION_UP
TimerLC.Enabled = False
If Touched = -1 Then Touched = CurrentPanel
Dim DisX = GetCenterPosition(Touched)-X1 As Int
'---Click Event---
If Abs(DisX) < MargineTouch Then
If SubExists(vModule,vEventName&"_Click") AND LongClick = False Then
Dim lista As List
If vActivityTouch Then
X = X - Panels(Touched).Left
Y = Y - Panels(Touched).Top
End If
vTouchData.X = X
vTouchData.Y = Y
vTouchData.Tag = Panels(Touched).Tag
FrictionPanelBack
CallSub2(vModule,vEventName&"_Click",vTouchData)
End If
Return
End If
'---SlidingPanels with Friction---
Dim Vel = DateTime.Now-RapidSliding As Long
If vFriction Then
Move.PanelNumber = Touched
Move.Start = CalcCenterPosition(Touched,CurrentPanel)
If DisX > 0 Then '---------Right direction
Move.Destination = Touched*(vWidth+vDistance)+Display.Width+vWidth
Else If DisX < 0 Then '-----Left direction
Move.Destination = (Panels.Length-1-Touched)*(vWidth+vDistance)-vWidth
End If
Move.Increase = DisX/(Vel/Timer1.Interval)*FRICTION_ACCELERATE
UseFriction = FRICTION_DEC
SlidingInProgress = True
Timer1.Enabled = True
Return
End If
'---SlidingPanels without Friction---
Dim NextPanel,ReturnBack As Int
If DisX > 0 Then '---------Right direction
NextPanel = CurrentPanel - 1
ReturnBack = 0
Else If DisX < 0 Then '-----Left direction
NextPanel = CurrentPanel + 1
ReturnBack = Panels.Length-1
End If
If NoLoop AND Touched = ReturnBack Then
PanelToCentre(Touched,Velocity)
Return
Else
Dim TestVelocity As Boolean
DisX = Abs(DisX)
If DisX > DisXtest AND Vel < VelTest Then TestVelocity = True Else TestVelocity = False
If Max(GetCenterPosition(Touched),X1)-Min(GetCenterPosition(Touched),X1) > vWidth/2 Or TestVelocity Then
If NextPanel < 0 Then
NextPanel = Panels.Length-1
CurrentPanel = NextPanel
Else If NextPanel > Panels.Length-1 Then
NextPanel = 0
CurrentPanel = NextPanel
End If
If TestVelocity Then
Vel = Max(Vel/DisX*Abs(Display.Width/2-Abs(GetCenterPosition(Touched))),Velocity)
PanelToCentre(NextPanel,Vel)
Else
PanelToCentre(NextPanel,Velocity) '---Forward
End If
Else
PanelToCentre(Touched,Velocity) '----------Back
End If
End If
End Select
End Sub
'Start the SlidingPanels showing Panels indicated.
'The Class must first be initialized, and choosing a mode of SlidingPanels.
'PanelNumber - number of panels to start.
Public Sub Start (PanelNumber As Int)
If FirstTime = False Then Return
PanelNumber = Max(Min(PanelNumber,Panels.Length-1),0)
Wait(200)
PanelToCentre(PanelNumber,Velocity)
JumpToPanel(PanelNumber,Velocity,0)
End Sub
'Runs the SlidingPanels up to a specific Panel.
'Return False if it is already in the Panel indicated.
'PanelNumber - number of panels to jump to.
'Speed - is the sliding speed in milliseconds.
'Delay - delay before the next jump.
Public Sub JumpToPanel (PanelNumber As Int,Speed As Int,Delay As Int) As Boolean
PanelNumber = Max(Min(PanelNumber,Panels.Length-1),0)
Jump.Panel = PanelNumber
If PanelNumber = CurrentPanel Then
Jump.Panel = -1
Return False
End If
If SlidingInProgress Then SlidingInProgress = False
Jump.Delay = Delay
Jump.Speed = Speed
Wait(Delay)
Dim NextPanel As Int
If PanelNumber < CurrentPanel Then '---Right direction
NextPanel = CurrentPanel - 1
Else '----------------------------------Left direction
NextPanel = CurrentPanel + 1
End If
PanelToCentre(NextPanel,Jump.Speed)
Return True
End Sub
'Returns the number of the current Panel.
Public Sub GetCurrentPanel
Return CurrentPanel
End Sub
'Return if the SlidingPaneles is in progress.
Public Sub GetSlidingInProgress
Return SlidingInProgress
End Sub
'Sets the speed of sliding.
'Speed - speed in milliseconds.
Public Sub SetSpeedScroll (Speed As Int)
Velocity = Speed
End Sub
Private Sub ZoomPanel (obj As Panel,NewZoom As Int)
Dim sWidth,sHeight As Int
sWidth = OrigW/100*NewZoom
sHeight = OrigH/OrigW*sWidth
Dim Left,Top As Int
Left = obj.Left+obj.Width/2-sWidth/2
Top = vYpos-sHeight/2
obj.SetLayout(Left,Top,sWidth,sHeight)
End Sub
Private Sub Wait(Milliseconds As Int)
Dim Time As Long
Time = DateTime.Now + (Milliseconds)
Do While DateTime.Now < Time
DoEvents
Loop
End Sub
'SlidingPanels初始化
'如果想使用SlidingPanels来显示想要显示的面板，首先这个类库必须初始化，
'然后选择一种SlidingPanels的模式
'
'此方法各参数如下
'EventName - 单击或改变控件时的事件名称
'Speed - 滑动速度,以毫秒为单位。
'Parent - 在哪里活动创建SlidingPanels。
'Module - 必须是Me
'
'ActivityTouch -
'如果ActivityTouch 属性为True，当触摸屏幕时触发Activity的触摸事件，而不是单独的某个子面板
'这时应该在ActivityTouch事件中调用某个子面板的触摸方法，例如SD.Panels_Touch(Action,X,Y)
'举例如下<code>
'Sub Activity_Touch (Action As Int, X As Float, Y As Float)
' SD.Panels_Touch(Action,X,Y)
'End Sub</code>
Public Sub Initialize (EventName As String,Speed As Int,Parent As Panel,Module As Object,ActivityTouch As Boolean)
vEventName = EventName
Velocity = Speed
Display = Parent
vModule = Module
FirstTime = True
NoLoop = True
vActivityTouch = ActivityTouch
If vActivityTouch = False Then EventTouch = "Panels"
Jump.Panel = -1
Timer1.Initialize("Timer",15)
TimerLC.Initialize("TimerLC",500)
End Sub
'Creates the SlidingPanels with Panels full screen.
'The Class must first be initialized.
'NumberOfPanels - is the number of panels to be created, Min 2.
'SlidingInLoop - indicates whether the SlidingPanels is in Loop (True = Loop).
Public Sub ModeFullScreen (NumberOfPanels As Int,SlidingInLoop As Boolean)
Dim c As Int
Dim Panels(Max(NumberOfPanels,2)) As Panel
vYpos = Display.Height/2
vWidth = Display.Width
For c = 0 To Panels.Length-1
Panels(c).Initialize(EventTouch)
Panels(c).Tag = c
Display.AddView(Panels(c),vWidth,0,vWidth,Display.Height * 80%y)
' Display.AddView(Panels(c),vWidth,0,vWidth,Display.Height)
Next
NoLoop = Not(SlidingInLoop)
vDistance = 0
vFriction = False
End Sub
'Creates the SlidingPanels with smaller panels of the screen.
'The Class must first be initialized.
'NumberOfPanels - is the number of panels to be created, Min 2.
'Width - width of the panels.
'Height - height of the panels.
'Ypost - vertical central position of the panels.
'Distance - is the distance separating the panels.
'Friction - enable/disable the friction.
Public Sub ModeLittlePanels (NumberOfPanels As Int,Width As Int,Height As Int,Ypos As Int,Distance As Int,Friction As Boolean)
Dim c As Int
Dim Panels(Max(NumberOfPanels,2)) As Panel
vWidth = Min(Width,Display.Width)
vYpos = Ypos
Height = Min(Height,Display.Height)
For c = 0 To Panels.Length-1
Panels(c).Initialize(EventTouch)
Panels(c).Tag = c
Display.AddView(Panels(c),Display.Width,vYpos-(Height/2),vWidth,Height)
Next
vDistance = Distance
vFriction = Friction
End Sub
'创建SlidingPanels与放大屏幕的小板，使用之前SlidingPanels对象必须先初始化
'NumberOfPanels——要创建面板的数量。
'Width——宽度。
'Height - 高度。
'Ypost——垂直面板的中心位置，也就是子面板底部的垂直位置。
'Distance——各子面板之间的间距。
'摩擦--启用/禁用。
'放大——设置缩放比(150 = 150%)，即当前居中显示的那个较大的子面板是没放大子面板的多少比例。
'ZoomArea——面积计算放大(沉默蜂注:这个参数是起什么作用，我一直搞不懂)。
'
'Creates the SlidingPanels with smaller panels of the screen with zoom.
'The Class must first be initialized.
'NumberOfPanels - is the number of panels to be created, Min 2.
'Width - width of the panels.
'Height - height of the panels.
'Ypost - vertical central position of the panels.
'Distance - is the distance separating the panels.
'Friction - enable/disable the friction.
'Zoom - set the zoom (150 = 150%).
'ZoomArea - area in which it calculates the zoom.
Public Sub ModeLittlePanelsZoom (NumberOfPanels As Int,Width As Int,Height As Int,Ypos As Int,Distance As Int,Friction As Boolean,Zoom As Int,ZoomArea As Int)
ModeLittlePanels(NumberOfPanels,Width,Height,Ypos,Distance,Friction)
OrigW = vWidth
OrigH = Height
vZoom = Zoom
vZoomArea = ZoomArea
End Sub
'这是一个由沉默蜂改进的增强版本
'创建SlidingPanels面板全屏，使用前必须先初始化的类。
'NumberOfPanels - 要创建面板的数量。
'TopSpace - 子面板离屏幕顶部的距离 (沉默蜂增加的参数)
'numDistance - 各子面板之间的距离 (沉默蜂增加的参数)
'SlidingInLoop - 子面板是否采用循环切换方式显示(True = 不断循环)。
'
'为了照顾模拟标题栏而特地改动全屏模式
Public Sub ModeFullScreen2 (NumberOfPanels As Int,vH As Float, numDistance As Int, SlidingInLoop As Boolean)
Dim c As Int
Dim Panels(NumberOfPanels) As Panel
'Display是一个panel面板
vYpos = Display.Height/2
vWidth = Display.Width
For c = 0 To Panels.Length-1
Panels(c).Initialize(EventTouch)
Panels(c).Tag = c
'改动代码如下
Display.AddView( Panels(c),vWidth*0.05, Display.Height * 0.05 , vWidth*0.9, Display.Height*vH )
'原始代码如下
'AddView ( View As View, Left As int, Top As int, Width As int, Height As int )
Next
NoLoop = Not(SlidingInLoop)
'各子面板之间的间距
vDistance =numDistance
' vDistance = 0
'启动摩擦后，会造成有时看不到子面板
vFriction = False
'当各子面板之间的间距很小时，不启动摩擦效果
If vDistance = 0 Then
vFriction = False
Else
vFriction = True
End If
End Sub
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
