注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

沉默蜂B4A安卓编程

国内资料最全的B4A资料库

 
 
 

日志

 
 

[原创]相册例程(二)  

2014-05-01 22:59:14|  分类: 图形图像 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

[原创]相册例程(二) - 沉默蜂QQ793136625 - Basic4android安卓编程

 

 

 

 

──────────────  下面是类模块SlidingPanels代码  ──────────────

#Region 代码说明


'注解:沉默蜂(QQ793136625)
'博客:http://silentbees.blog.163.com

'这是一个水平滚动面板的类
'来源 [Class] Multi Type SlidingPanels
'http://www.basic4ppc.com/android/forum/threads/class-multi-Type-SlidingPanels.23303/

#End Region

 

 

#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

  评论这张
 
阅读(477)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017