VB开发安卓程序_例程10自定义日历类_vb 安卓开发-优快云博客

本文链接：https://blog.youkuaiyun.com/u010643864/article/details/138023799

运行截图

Main窗体代码如下：



#Region Module Attributes
	#FullScreen: False
	#IncludeTitle: True
	#ApplicationLabel: Custom Calendar Exemple
	#VersionCode: 1
	#VersionName: 
	#SupportedOrientations: unspecified
	#CanInstallToExternalStorage: False
#End Region

'Activity module
Sub Process_Globals
	
	
	'AHLocale对象提供了许多信息设备场所设置像货币符号等。
	
	'AHLocale library 类来源于	
'	https://www.b4x.com/android/forum/threads/ahlocale-library.7561/


	
End Sub

Sub Globals
	Dim CsCal As CustomCalendar

End Sub

Sub Activity_Create(FirstTime As Boolean)

	
	CsCal.Initialize(Me,"CsCal",100%x,100%y,DateTime.Now,1949,2100)
	Activity.AddView(CsCal.AsView,0,0,100%x,100%y)	
	
	CsCal.ShowCalendar(True)	
End Sub

Sub CsCal_ItemLongClick(dt As Long)	
	
	CsCal.ShowCalendar(False)

	Dim aa,dd,mm As Int
	aa=DateTime.GetYear(dt)
	dd=DateTime.GetDayOfMonth(dt)
	mm=DateTime.GetMonth(dt)
	
	Msgbox( CsCal.NmFullMonth(mm-1) &"  "&dd& "  " & aa," Date Selected")
    CsCal.ShowCalendar(True)	
	
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub

新建一个标准类CustomCalendar

'CustomCal3

'Class module
Sub Class_Globals
	
	Dim Local As AHLocale

	'lblDays 日历单元格，共6行，7列
	Private lblDays(42) As Label
	
	'btTitre 定义一栏用来显示周一周二等文字的标题栏
	Private btTitre(8) As Button   
	
	'lbtitle 用于显示标题
	Private lbtitle As Label  
	
	
	' lbToday 按钮一点可跳到今天
	Private lbToday As Label
	
	
	' lbCopy 按钮用来把当前指向的日期复制到剪切板
	Private lbCopy As Label
	
	
	
	'btNextMonth 下一月按钮
	Private btNextMonth As Label 
	
	'btPrevMonth 上一月按钮
	Private btPrevMonth As Label
	
	'spLabel 显示年份区域
	Private spLabel As Label 
	
	'SpYearsChoice 年份选择列表
	Private SpYearsChoice As Spinner
	
	'面板 pnl 是这个日历控件最底层的那个区域
	'面板 pnlbackGround 被放置在 面板 pnl  上，是日历控件显示的最核心区域
	Private pnl,pnlbackGround As Panel 
	
	'日历控件事件名称
	Private EventName As String
	
	'当前的日历控件将在哪个窗体中显示
	Private CallBack As Object	
	
	'Local.WeekDays 返回字符串的数组,其中包含的缩写名称的日子。
	Public NmFullday(7) As String 
	
	'Local.ShortMonths 返回字符串的数组包含几个月的缩写名称。
	Public NmMonth(12) As String 
	
	Public NmFullMonth(12) As String 
	
	Private CalDay, CalMonth, CalYear As Int
	Private RelativTextSize As Int
	
	
	
	'开始：日历控件颜色相关属性的默认值设定 -----------------------------------------
	
	'ColTable 为日历控件格了的边框线颜色
	Private ColTable As Int : ColTable = Colors.ARGB(200,182,189,209 )
	
	'ColInactive 日历表格中需要隐藏的日期文字颜色
	'inactive adj. 不活跃的；不活动的
	'active	  adj. 积极的；活跃的；主动的；
	Private ColInactive As Int : ColInactive = Colors.White
	
	'ColFunction 当前选中的日期格子的颜色
	Private ColFunction As Int : ColFunction = Colors.RGB(222,233,175)
	'Private ColFunction As Int : ColFunction = Colors.RGB(236,233,216)
		
	'ColActive  每个日历格子的背景色
	Private ColActive As Int : ColActive = Colors.White
	
	'ColBackGround 为整个日历控件最底层的背景色
	Private ColBackGround As Int : ColBackGround = Colors.White

	'结束：日历控件颜色相关属性的默认值设定 -----------------------------------------

	
	'SD	年份最早可以查哪一年 (沉默蜂加上去的功能)
	'ED	年份最晚可以查哪一年 (沉默蜂加上去的功能)	
	'日历控件查询的年份段由Initialize方法的两个参数决定，具体参考 Initialize
	Private SD, ED As Int 
	
	Private SomeTime As Long
	
End Sub


Public Sub Initialize(vCallback As Object, vEventName As String, Ww,Hh As Int, vBeginDate As Long,vSD,vED As Int)'初始化日历控件
	'初始化日历控件对象，如果需要,您可以添加这个方法的参数。

	Local.Initialize()

	'Local.WeekDays 返回字符串的数组,其中包含的缩写名称的日子。
	NmFullday = Local.WeekDays    ' Array As String("Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi")
	
	
	'Local.ShortMonths 返回字符串的数组包含几个月的缩写名称。
	NmMonth = Local.ShortMonths    'Array As String("jan","fev","mar","avr","mai","jun","jul","aug","sep","oct","nov","dec")
	
	
	NmFullMonth = Local.Months 'Array As String("janver","février","mars","avril","mai","juin","juillet","août","septembre","octobre","novembre","décembre")
	







	'开始：参数介绍 -----------------------------------------------------------------
	
	'参数 vCallback 用于设定当前这个日历控件将在哪个窗体中显示
	'参数 vEventName 用于定义日历事件名称
	'参数 Ww,Hh 用于定义日历控件的宽度和高度
	'参数 vBeginDate 用来指定日历控件将显示哪个时间
	'参数 vSD	年份最早可以查哪一年 (沉默蜂加上去的功能)
	'参数 vED	年份最晚可以查哪一年 (沉默蜂加上去的功能)
	
	'结束：参数介绍 -----------------------------------------------------------------
	
	
	CallBack = vCallback
	
	
	EventName = vEventName
	
	
	'面板 pnl 是这个日历控件最底层的那个区域
	pnl.Initialize("pnl")	'初始化面板控件
	pnl.Color=ColBackGround '定义背景色
	
	
	Dim mx,my,tx,ty As Int
	Dim i,j,z As Int		
	
	'relatively 相对的
	'定义文字尺寸
	RelativTextSize = 17 
	
	
	'开始：日历单元格宽高值计算 -----------------------------------------------------
	
	'日历控件其实就是一个表格控件的变体类型
	
	'计算每个单元的宽度
	'mx中的x可以理解成水平的意思
	mx=(Ww/7)'-8 
	
	'计算每个单元的高度
	'my中的y可以理解成垂直的意思
	my=(Hh/9)'-10
	
	
	If my>mx Then 
		'如果高度值比宽度值大，在这里将强制将 高度值 = 宽度值
		my=mx
	End If
	
	If ((my*10)+10dip)>Hh Then
		my=((Hh-10dip)/10)
	End If
	
	tx=(Ww-((mx*7)+8dip)) / 2
	ty=(Hh-((my*10)+8dip)) / 2
	
	'结束：日历单元格宽高值计算 -----------------------------------------------------
	
	
	
	
	'开始：日历控件区域设置 ---------------------------------------------------------
	
	pnlbackGround.Initialize("")
	
	'ColTable 为日历控件格了的边框线颜色
	pnlbackGround.Color=ColTable
	
	'pnlbackGround 这个面板控件将被加载到 pnl 面板中 
	pnl.addview(pnlbackGround,tx,ty,(mx*7)+8dip, (my*10)+5dip)
	
	'隐藏这个面板控件
	pnl.Visible=False
	
	'结束：日历控件区域设置 ---------------------------------------------------------
	
	
	
	
	
	'开始：日历控件标题栏 -----------------------------------------------------------
	
	'用于显示标题的标签控件初始化
	lbtitle.Initialize("")
	
	pnlbackGround.addView(lbtitle,1dip,0dip,pnlbackGround.Width-2dip, my-5dip)
	'pnlbackGround.addView(lbtitle,1dip,1dip,pnlbackGround.Width-2dip, my-6dip)
	
	'标题文本的水平和垂直方向的对方方式定义
'	lbtitle.Gravity=Bit.OR(Gravity.LEFT, Gravity.CENTER_VERTICAL)	
	lbtitle.Gravity=Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)	
	
	'文字字体
	lbtitle.Typeface=Typeface.DEFAULT_BOLD	
	
	'背景色
	lbtitle.Color=Colors.ARGB(255,0,0,0) + ColBackGround
	
	'当前日历上指定时间显示栏的文字颜色
	lbtitle.TextColor=Colors.Red
		
	'结束：日历控件标题栏 -----------------------------------------------------------
	
	
		
	'开始：绘制星期标题栏 -----------------------------------------------------------
	
	'btTitre 定义一栏用来显示周一周二等等文字的标题栏
	
	For i=0 To 6 'Days name buttons
		'Titre n. [分化] 滴定度；最小滴定量

		btTitre(i).Initialize ("")
		btTitre(i).Color=ColInactive
'		btTitre(i).TextSize =60dip
		btTitre(i).Typeface = Typeface.DEFAULT_BOLD
		pnlbackGround.AddView(btTitre(i),  (i*mx)+((i+1)*1dip), (2*my)+1dip, mx, my)
		'pnlbackGround.AddView(btTitre(i),  (i*mx)+((i+1)*1dip), (2*my)+1dip, mx+2dip, my)
		
	Next
	
	'结束：绘制星期标题栏 -----------------------------------------------------------
	
	
	
	'开始：绘制日历单元格 -----------------------------------------------------------
	'下面是按一行单元格绘制完再绘制下一行，如此反复绘制
	For j=0 To 5 'Days buttons	
	
		For i=0 To 6	
		
			z = (j*7)+i
			lblDays(z).Initialize("BtJour")	
			lblDays(z).tag = 0	
			lblDays(z).Gravity = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)
			'lblDays(z).Gravity = Bit.OR(Gravity.Top, Gravity.CENTER_HORIZONTAL)
			pnlbackGround.AddView(lblDays(z), (i*mx)+((i+1)*1dip), ((j+2)*(my+1dip))+my,  mx,  my) 
			
 		Next
		
	Next
	
	'结束：绘制日历单元格 -----------------------------------------------------------
	
	
	'开始：增加今天和复制按钮 -------------------------------------------------------
		
		' lbToday 按钮一点可跳到今天
		lbToday.Initialize ("lbToday")
		lbToday.Color =   ColFunction
		lbToday.TextColor=Colors.Black
		lbToday.TextSize=(RelativTextSize*0.8) 
		lbToday.Gravity = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)
		
		lbToday.Text ="今 天"
		
		pnlbackGround.addview(lbToday, lblDays(0).Left, lblDays(41).Top+lblDays(41).Height+1dip, pnlbackGround.Width/2-1dip, my-2dip)
'		pnlbackGround.addview(lbToday, lblDays(0).Left, lblDays(41).Top+lblDays(41).Height+2dip, pnlbackGround.Width/2-1dip, my)
		
		
		 'lbCopy 按钮用来把当前指向的日期复制到剪切板
		 lbCopy.Initialize ("lbCopy")
		 lbCopy.Color =   ColFunction
		 lbCopy.TextColor=Colors.Black
		 lbCopy.TextSize=(RelativTextSize*0.8) 
		 lbCopy.Gravity = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)
		 
		 lbCopy.Text="复 制"
		 
		 pnlbackGround.addview( lbCopy, lbToday.Left+lbToday.Width+1dip, lbToday.Top ,lbToday.Width, my-2dip)
	
	'	 	pnl.addview(pnlbackGround,tx,ty,(mx*7)+8dip, (my*9)+5dip)
		 
	 '结束：增加今天和复制按钮 -------------------------------------------------------
	
	

	
	#Region 年月日按钮的初始化
	
	'开始：上一月按钮 ---------------------------------------------------------------
	
	btPrevMonth.Initialize("btPrevMonth")
	btPrevMonth.Color=ColFunction	
	btPrevMonth.Typeface=Typeface.DEFAULT_BOLD
	btPrevMonth.TextColor = Colors.Black
	btPrevMonth.Gravity = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)
	
	pnlbackGround.AddView(btPrevMonth,btTitre(0).Left,my-4dip,(mx*1.5),my+4dip)
	
	'结束：上一月按钮 ---------------------------------------------------------------
	
	
	'开始：下一月按钮 ---------------------------------------------------------------
	btNextMonth.Initialize("btNextMonth")
	btNextMonth.Color= ColFunction
	btNextMonth.TextColor = Colors.Black
	btNextMonth.Gravity = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)
	btNextMonth.Typeface=Typeface.DEFAULT_BOLD
	
	pnlbackGround.AddView(btNextMonth,(mx*5.5)+7dip,my-4dip,(mx*1.5),my+4dip)
	
	'结束：下一月按钮 ---------------------------------------------------------------
	
	
	'开始：年份选择列表框 -----------------------------------------------------------
	
	SpYearsChoice.Initialize("SpYearsChoice")
	SpYearsChoice.Color=ColFunction
	pnlbackGround.AddView(SpYearsChoice,btPrevMonth.Width+2dip, my-4dip, (mx*4)+4dip,my+4dip)
    SpYearsChoice.Visible = False
	
	'结束：年份选择列表框 -----------------------------------------------------------
		
		
		
	'开始：显示年份区域 -------------------------------------------------------------
	
	'********** Hide the spinner (visible = false) and setup the label to do the work **************	
	
	spLabel.Initialize("SpLabel") ' SpLabel click event actually calls the spinner event - see next sub below  
	spLabel.Color=ColFunction
	
	spLabel.TextColor = Colors.Black
	pnlbackGround.AddView(spLabel,btPrevMonth.Width+2dip, my-4dip, (mx*4)+4dip,my+4dip)
	
	' ********** Label takes the same space as spinner ******************
	
	'结束：显示年份区域 -------------------------------------------------------------
	
	
	
	'开始：绘制日期 -----------------------------------------------------------------
	
	For i=0 To 6	
		'Public Sub Nmday(n As Int) As String
		'Replace ( Target As String, Replacement As String ) As String 
		'由于这个日历控件会显示星期一这种格式，会造成断行，于是需要进行改动
		btTitre(i).Text=Nmday(i).Replace("星期","")
'		btTitre(i).Text=Nmday(i)
	Next
	
	'结束：绘制日期 -----------------------------------------------------------------
	
	
	'开始：填充年份列表 -------------------------------------------------------------
	'年选择列表中填充数据
	
	SD = vSD
	ED = vED
	
	For i = SD To ED 'years in Spinner
		SpYearsChoice.add(i)		
	Next
	
	'结束：填充年份列表 -------------------------------------------------------------
	
	#End Region
	
		

	 
	
	
	
	
	'Private Sub PrintDate(dts As Long)
	'日历控件显示指定日期
	'参数 vBeginDate 用来指定日历控件将显示哪个时间
	PrintDate(vBeginDate)	
	
End Sub


Private Sub lbToday_Click '点击今天按钮
	PrintDate(DateTime.Now)
End Sub

Private Sub lbCopy_Click'点击复制按钮

End Sub



' **** Label click calls spinner click - Thanks to Erel the genius
Private Sub SpLabel_click

	Dim r As Reflector
	r.Target = SpYearsChoice
	r.RunMethod("performClick")

End Sub




Public Sub ShowCalendar(b As Boolean)
	pnl.Visible=b	
End Sub

Public Sub Nmday(n As Int) As String
	Dim S As String
	S=NmFullday(n+1)
	Return S.SubString2(0,3)
End Sub



Private Sub PrintDate(dts As Long)'日历控件显示指定日期

	Dim nbj,nday As Int
	Dim mn1,mn2 As Int
	Dim cdd, cmm, caa As Int
	
'	Log(DateTime.Now)
	
	
	'DateTime .GetDayOfMonth ( Ticks As Long ) As Int 
	'GetDayOfMonth 返回一个月中的一天, 值在 1~31 之间
	
	'DateTime.Now 获取当前时间
	'DateTime .GetDayOfMonth 获取当前是几号
	cdd=DateTime .GetDayOfMonth(DateTime.Now)
	
	'DateTime.GetMonth 获得月份
	cmm=DateTime.GetMonth(DateTime.Now)
	
	'DateTime.GetYear 获取当前是哪一年
	caa=DateTime.GetYear(DateTime.Now)
	
	
	CalDay   = DateTime.GetDayOfMonth(dts)	
	CalYear  = DateTime.GetYear(dts)	
	CalMonth = DateTime.GetMonth(dts)
	
	'年份选择列表的文字大小
	SpYearsChoice.TextSize=(RelativTextSize*0.87) '14
	
	'指定年份选择列表当前选中项
	SpYearsChoice.SelectedIndex=(CalYear-SD)	




	'开始：年份显示区域初始化 ------------------------------------------------

	'Here we set the Label To Spinner's selected value
	'在这里我们设置标签微调控制项的选择值
	'spLabel 显示年份区域
	spLabel.TextSize=(RelativTextSize*0.87) '14 文字大小
	spLabel.Gravity = Bit.Or(Gravity.CENTER_VERTICAL, Gravity.CENTER_HORIZONTAL)'对齐
	spLabel.Typeface = Typeface.DEFAULT_BOLD 
	
	spLabel.Text    = SpYearsChoice.SelectedItem & " 年 " & CalMonth & " 月" 
	
	'结束：年份显示区域初始化 ------------------------------------------------
	
	
	'lbtitle 用于显示标题
	lbtitle.TextSize=RelativTextSize
		
	lbtitle.Text="公历："& CalYear & " 年 " & CalMonth  & " 月 " & CalDay & " 日"
	
	
	'btTitre 定义一栏用来显示周一周二等文字的标题栏
	For mn1=0 To 6
		btTitre(mn1).TextSize=(RelativTextSize*0.8) '12		
	Next
	
	'btPrevMonth 上一月按钮	
	mn1=CalMonth-1 'prev month
	If mn1<1 Then mn1=12
	btPrevMonth.TextSize=(RelativTextSize*0.87) '14
	
	btPrevMonth.Text= "<"
'	btPrevMonth.Text=NmMonth(mn1-1)
	
	
	'btNextMonth 下一月按钮
	mn2=CalMonth+1 'next month
	If mn2>12 Then mn2=1
	btNextMonth.TextSize=(RelativTextSize*0.87) '14
	
	btNextMonth.Text= ">"
'	btNextMonth.Text=NmMonth(mn2-1)
	
	'Public Sub LengthMonth(An,Mois As Int) As Int '计算指定月份共有多少天
	nbj= LengthMonth(CalYear,CalMonth)
	

	#Region B4A 中如今指定一个具体时间
	
	'库 Core > 类 DateTime提供了两种风格的方法用于编程员指定一个具体的时间
	'DateTime.DateParse 用于指定一个包括年月日的时间
	'DateTime.DateTimeParse  用于指定一个包括年月日时分种的时间
	'下面将对这两个方法进行讲解
	'
	'───────────────────────────────────
	'
	'Dim SomeTime As Long 
	'SomeTime = DateTime.DateParse("02/23/2007")
	'
	'───────────────────────────────────
	'
	''指定的时间为1999-03-26 01:24:16
	'Dim DateString = "1999-03-26 01:24:16"AsString
	'
	'Dim DateTimeTicks AsLong
	'Dim Date_Time() AsString
	''根据空格，把这个具体时间分成两部分，并存放到下个数组中
	'Date_Time = Regex.Split("", DateString)
	'
	'DateTime.DateFormat = "yyyy-MM-dd"
	'DateTime.TimeFormat = "HH:mm:ss"
	''通过DateTime.DateTimeParse 把指定的具体日期（包括年月日时分种）给时间变量DateTimeTicks
	'DateTimeTicks = DateTime.DateTimeParse(Date_Time(0), Date_Time(1))
	'
	'───────────────────────────────────	
	
	#End Region
	
		'some 大约的意思；SomeTime 意思为大概时间
	
	SomeTime = DateTime.DateParse(CalMonth & "/01/" & CalYear)
	
	
	
	'DateTime.GetDayOfWeek 用于获取当前是星期几
	nday = (DateTime.GetDayOfWeek(SomeTime)-1)
	
	Dim i,nb As Int
	nb=nday
	
	If nb=0 Then nb=7 'decal next line dim 1
	
	
	
	'开始：初始化日历表格中的42个方格 -----------------------------------------------
	
	''lblDays 显示日期的表格共有42格
	For i=0 To 41 
		lblDays(i).TextColor=Colors.Black
		lblDays(i).Color=ColActive
		lblDays(i).Typeface=Typeface.DEFAULT
		lblDays(i).Text=""	
		lblDays(i).Tag=0
		lblDays(i).TextSize = (RelativTextSize*0.87)
	Next	
	
	'结束：初始化日历表格中的42个方格 -----------------------------------------------
	
	
	'开始：打印日期号 ---------------------------------------------------------------
	
	#Region 打印当前月的日期
	
	Dim z As Int	
	
	For i=(nb) To (nb-1+nbj)
	
		z = i-nb+1
		lblDays(i).Typeface=Typeface.DEFAULT_BOLD
		
		
		Log("lblDays(i).Text =	" & z)
		
		lblDays(i).Text=z	
		
		lblDays(i).Tag=z
		
		'SetdayColor(cmm,caa,cdd,z,i)
		
		If (cmm=CalMonth) And (caa=CalYear) Then
		
		
			If (z=CalDay) Then
			'If (z=cdd) Then '这一句代码是错误的
			
			
				'如果当时号码是指定日期的就修改它的背景色
			
				''ColFunction 当前选中的日期格子的颜色
				lblDays(i).Color=ColFunction
				
			End If
			
		End If
		
		
		If z =CalDay  Then
		
			lblDays(i).Color=ColFunction
			
		End If
		
	Next
	
	#End Region
	

	
	#Region 日历表格中打印上一个月日期

	Log(CRLF&CRLF)
	Log("打印上一个月日期")
	
	Dim m2,m3 As Int
	
	m2=LengthMonth(CalYear,mn1)
	m3=m2-(nb-1)
	For i=0 To (nb-1) 'Prev month
		lblDays(i).TextColor=ColInactive		
		
		Log("lblDays(i).Text = " & (m3+i)	 )
		
		lblDays(i).Text=m3+i	
		lblDays(i).Tag=100+m3+i	
	Next
	
	#End Region
	
	
	
	#Region 日历表格中打印下一个月日期
	
	Log(CRLF&CRLF)
	Log("打印下一个月日期")	
	
	For i=(nb+nbj) To 41 'Next month
		lblDays(i).TextColor=ColInactive
		
		Log("lblDays(i).Text = " & (i-(nb+nbj)+1 ))
		
		lblDays(i).Text=i-(nb+nbj)+1
		lblDays(i).Tag=200+(i-(nb+nbj)+1)
	Next
	
	#End Region
	
	'结束：打印日期号 ---------------------------------------------------------------
	
	
End Sub




Public Sub LengthMonth(An,Mois As Int) As Int '计算指定月份共有多少天
	Dim i As Int
	
	If Mois=1 Then
		i=31
	Else If Mois=2 Then
		If (An Mod 4)=0 Then
			i=29
		Else
			i=28
		End If
	Else If Mois=3 Then
		i=31
	Else If Mois=4 Then
		i=30
	Else If Mois=5 Then
		i=31
	Else If Mois=6 Then
		i=30
	Else If Mois=7 Then
		i=31
	Else If Mois=8 Then
		i=31
	Else If Mois=9 Then
		i=30
	Else If Mois=10 Then
		i=31
	Else If Mois=11 Then
		i=30
	Else If Mois=12 Then
		i=31
	End If
	
	Return i
End Sub

Public Sub AsView As View
Return pnl
End Sub

Private Sub btPrevMonth_Click '点击上一个月按钮

	Dim mm,aa As Int
	
	mm=CalMonth-1
	aa=CalYear
	If mm<1 Then 
		mm=12
		aa=aa-1
	End If
	
	CalMonth = mm
	CalYear  = aa
	SomeTime = DateTime.DateParse(mm & "/01/" & aa)
	
	PrintDate(SomeTime)
	
End Sub

Private Sub SpYearsChoice_ItemClick (Position As Int, Value As Object)
	CalYear=Position+SD
	SomeTime = DateTime.DateParse(CalMonth & "/" & CalDay & "/" & CalYear)
	PrintDate(SomeTime)
End Sub

Public Sub SetTextSize(value As Int)
	RelativTextSize = value
	PrintDate(DateTime.DateParse(CalMonth & "/" & CalDay & "/" & CalYear))
End Sub

Public Sub SetBackGroundColor(vColor As Int)
	ColBackGround = vColor
	pnl.Color=vColor
End Sub

Public Sub SetTableColor(vColor As Int)
	ColTable = vColor
	pnlbackGround.Color=vColor
End Sub

Public Sub SetActiveButtonColor(vColor As Int) '设置42个日历单元格的背景色
	Dim i As Int
	ColActive = vColor
	For i=0 To 41 
		lblDays(i).Color = vColor		
	Next		
End Sub

Public Sub SetFunctionButtonColor(vColor As Int)'设置当前选中的日期格子的背景色
	ColFunction=vColor
	btNextMonth.Color = vColor
	btPrevMonth.Color = vColor
	SpYearsChoice.Color = vColor
End Sub

Public Sub SetInactiveButtonColor(vColor As Int)	'设置周一周二等星期栏的背景色
	Dim i As Int	
	ColInactive = vColor
	For i=0 To 6
		btTitre(i).Color = vColor	
	Next	
End Sub

Private Sub btNextMonth_Click '点击下一个月按钮
	Dim mm,aa As Int
	
	mm=CalMonth+1
	aa=CalYear
	If mm>12 Then 
		mm=1
		aa=aa+1
	End If
	CalMonth = mm
	CalYear  = aa
	SomeTime = DateTime.DateParse(mm & "/01/" & aa)
	PrintDate(SomeTime)
End Sub


Private Sub DayPress As Boolean '按下日期单元格

	Dim v As Label 'Button
	Dim mm,aa,dd As Int
	
	v = Sender
	dd=v.tag
	
	aa=CalYear
	mm=CalMonth
	
	If (dd>100) And (dd<200) Then 'prev month
	   Return False
	Else If (dd>200) Then 'next month
	   Return False
	End If
	
	SomeTime = DateTime.DateParse(mm & "/" & dd & "/" & aa)
	
	'lbtitle 用于显示标题
	lbtitle.Text="公历："& aa & " 年 " & (CalMonth)  & " 月 " & dd & " 日"
	
	
	'开始：改变当前日历背景色显示，突出当前选中的日期 -------------------------------
	
	For i=0 To 41 
		lblDays(i).Color=ColActive
	Next	

	v.Color=ColFunction
	
	'结束：改变当前日历背景色显示，突出当前选中的日期 -------------------------------
	
	
'    lbtitle.Text=NmFullMonth(CalMonth-1)  & "  " & dd& "  " & aa	
    Return True

End Sub


Private Sub BtJour_Click '日历单元格单击

	If SubExists(CallBack, EventName & "_ItemLongClick") Then
	
		Log("日历单元格单击")
       DayPress	
	   
	End If
	
End Sub

'Private Sub BtJour_Down '日历单元格按下
'
'	If SubExists(CallBack, EventName & "_ItemLongClick") Then
'       DayPress	
'	End If
'	
'End Sub

Private Sub BtJour_LongClick '长按单元格
'	Dim SomeTime As Long
'
'	'SubExists ( Object As Object, Sub As String ) As Boolean 
'	'SubExists 判断子过程存在,测试对象是否包含指定方法. 
'	'如果对象没有初始化或没有实例化的用户累则返回 False.
'	
'	If SubExists(CallBack, EventName & "_ItemLongClick") Then
'	
'       If DayPress Then
'	   	 ' CallSub2 ( Component As Object, Sub As String, Argument As Object ) As Object 
'		 '调用子过程2 ,和 CallSub 相似.用单个参数调用子过程.
'	      CallSub2(  CallBack, EventName & "_ItemLongClick",SomeTime)	
'	   End If
'	   
'	End If
	
End Sub