''''建一个Form1,然后添加一个CommandButton,贴上以下代码做测试。 Option Explicit Private Sub Command1_Click() Dim t As clsDate Dim y As Long Dim m As Long Dim d As Long Dim st As Single Dim et As Single Dim da As Date Dim j As Long Dim ret As Long Set t = New clsDate t.sInitDate 2004, 5, 18 ''''t.lInitDate 2047, 5, 12, False Debug.Print t.lYear If t.IsLeap = False Then Debug.Print t.lMonth Else Debug.Print " 闰 " & t.lMonth End If Debug.Print t.CDayStr(t.lDay) Debug.Print t.GanZhi(t.lYear) Debug.Print t.YearAttribute(t.lYear) Debug.Print t.sYear Debug.Print t.sMonth Debug.Print t.sDay Debug.Print t.sWeekDay Debug.Print t.Era(t.sYear) Debug.Print t.Constellation(t.sMonth, t.sDay) Debug.Print "Week:" & t.wHoliday Debug.Print "Solar" & t.sHoliday Debug.Print "Lunar" & t.lHoliday Debug.Print t.lSolarTerm Set t = Nothing End Sub
''''******************************************************************************************** ''''建一个类,类名为clsDate Option Explicit '''' 作 者 的 话 '''' '''' clsDate本来是我在写一个软件的时候,因为需要,而且自已也想实作一个公农历的模块,因此就 '''' 写了它。2003年我将它发表在CSDN上,开始没有什么人注意,但是后来发现很多人写信给我说很不错, '''' 我终于了解到了它的意义。所以也就打算一直把它维护下去。 '''' '''' 因为我也是看到一个JSP的开源代码,我才了解它的原理,因此我也把这个小东东的源码公开了, '''' 希望大家能够喜欢它。在这个类里有两个比较重要的问题需要解决,当你理解了它们,你就理解这个类 '''' 1、如何在VB中初使化数组数据 '''' 我采用的方式是 mydata =Array( , , , , ) '''' 或许你有更好的方法,虽然我也曾经想到用资源的方案,但是我觉得用户需要将资源导来导去,在 '''' 使用中会很不方便。 '''' 2、VB中的位操作是如何的 '''' 在1.0版中,也就是我发表在CSDN上的版本,其中需要一个Bit4VB.DLL的动态库,我是用C写的, '''' 因为大家说VB是不能做位操作的,呵呵,我也没有去考虑那么多,就写了一个动态库。结果很多网友来信 '''' 有很大一半是要这个DLL的。 '''' 当我阅读Hardcore VB时,我才发现原来VB也是可以进行位操作的。如果计算到动态库的载入和接口处 '''' 理的花费的话,其实VB来写一个位操作的函数并不比用C来写慢多少。因此我实作出mvarBitTest32这个函数 '''' 在1.02中你再也不需要任何的DLL来支持这个类了。 '''' '''' '''' '''' 最后我希望你能抽一点点时间给我写一封信,让我知道你在用它。让我有信心继续维护它。 '''' '''' E-mail: liuxiaoshi@xtcz.net zhenghesoft@hotmail.com '''' ''''
'''' 版本预告: '''' 下次我将推出 VB.net 和VB 6.0两个平台的版本。 '''' 将实现 1900-2100年的公农历转换 '''' 将一些方法和属性重新更名,但原有的接口将继续保持。 '''' '''' 版本历史: '''' 更新版本请注意CSDN上的更新 '''' '''' '''' 版本1.02 2004-4-15 '''' 考虑到用动态DLL的方案并不能真正提高位操作的速度, '''' 而且受到Hardcore VB 作者的启示,已实作出速度很快的VB位操作模块,因此不再使用Bit4VB.DLL '''' 在这个版本中只需要一个clsDate便真正可以完成公农历的转换,不需要其它任何的模块 '''' '''' 版本 1.01 2004-2-10 '''' 增加了可以返回星期几字样的函数,sWeekDayStr '''' 原来的sWeekDay 仍继续使用,以保证其它用户 '''' '''' '''' '''' '''' 注 意 事 项 '''' '''' /////////////////////////////////////////////////////////////////////////////// '''' // // '''' // // '''' // 说明:本模块仅能用于1900.1.31日起至 2049.12.31日止的数据转换,否则会出错。 // '''' // 或者农历1900.1.1日起至2049.12.7日止 // '''' // // '''' /////////////////////////////////////////////////////////////////////////////// ''''
Private Type SolarHolidayStruct Month As Long Day As Long Recess As Long HolidayName As String End Type
Private Type LunarHolidayStruct Month As Long Day As Long Recess As Long HolidayName As String End Type
Private Type WeekHolidayStruct Month As Long WeekAtMonth As Long WeekDay As Long HolidayName As String End Type
''''保持属性值的局部变量 Private mvarsYear As Long ''''局部复制 Private mvarsMonth As Long ''''局部复制 Private mvarsDay As Long ''''局部复制 Private mvarlYear As Long ''''局部复制 Private mvarlMonth As Long ''''局部复制 Private mvarlDay As Long ''''局部复制 Private mvarIsLeap As Boolean ''''局部复制
''''Private Declare Function BitRight32 Lib "Bit4VB.DLL" (ByVal x As Long, ByVal num As Long) As Long ''''此定义已不使用 ''''定义类内部用公用变量
Private SolarMonth As Variant Private Gan As Variant Private Zhi As Variant Private Animals As Variant Private SolarTerm As Variant Private sTermInfo As Variant Private nStr1 As Variant Private nStr2 As Variant Private MonthName As Variant Private LunarInfo(150) As Long Private LunarYearDays(150) As Long Private sHolidayInfo() As SolarHolidayStruct Private lHolidayInfo() As LunarHolidayStruct Private wHolidayInfo() As WeekHolidayStruct
Private mvarDate As Date ''''内部使用标准的日期变量
Private BitPower(31) As Long ''''0-31
''''位测试 ,测试位为1 返回真 Private Function mvarBitTest32(Number As Long, Bit As Long) As Boolean If Bit < 0 Or Bit > 31 Then ''''不是整数位 mvarBitTest32 = False Else If Number And BitPower(Bit) Then mvarBitTest32 = True Else mvarBitTest32 = False End If End If End Function
Private Sub Class_Initialize() Dim tempArray As Variant Dim i As Long Dim b As Long Dim sFtv As Variant Dim lFtv As Variant Dim wFtv As Variant ''''根据VB的位计算特点,故扩充原有的数据位,将其变成32位 tempArray = Array( _ &H104BD8, &H104AE0, &H10A570, &H1054D5, &H10D260, &H10D950, &H116554, &H1056A0, &H109AD0, &H1055D2, _ &H104AE0, &H10A5B6, &H10A4D0, &H10D250, &H11D255, &H10B540, &H10D6A0, &H10ADA2, &H1095B0, &H114977, _ &H104970, &H10A4B0, &H10B4B5, &H106A50, &H106D40, &H11AB54, &H102B60, &H109570, &H1052F2, &H104970, _ &H106566, &H10D4A0, &H10EA50, &H106E95, &H105AD0, &H102B60, &H1186E3, &H1092E0, &H11C8D7, &H10C950, _ &H10D4A0, &H11D8A6, &H10B550, &H1056A0, &H11A5B4, &H1025D0, &H1092D0, &H10D2B2, &H10A950, &H10B557, _ &H106CA0, &H10B550, &H115355, &H104DA0, &H10A5D0, &H114573, &H1052D0, &H10A9A8, &H10E950, &H106AA0, _ &H10AEA6, &H10AB50, &H104B60, &H10AAE4, &H10A570, &H105260, &H10F263, &H10D950, &H105B57, &H1056A0, _ &H109 [1] [2] [3] [4] [5] [6] 下一页 [系统软件]用RegDllView揪出所有已注册的dll/ocx [系统软件]Windows系统的活动大陆基石 细看DLL文件 [系统软件]Windows的活动大陆:细看DLL文件 [常用软件]利用msdvm.dll实现微软虚拟桌面 [VB.NET程序]使用VB6.0设计ActiveX DLL事件 [VB.NET程序]Crystal Report(水晶报表)的报表封装成VB的DLL [VB.NET程序]用diskid.dll和disk32.dll获得硬盘序列号 [Delphi程序]输出SHELL32.DLL的图标 [Delphi程序]把图标存储在SHELL32.DLL [Delphi程序]DLL 應用 - 設計可抽換的模組
|