您所在位置：主题：[原创]时钟(万年历的应用)源代码
QB71
[专家分：1300] 发布于 2005-10-30 14:50:00
飞鸟12 和 Moz 都说得好!!!!
近来QB区真是太冷清了!!!!
如果你想修改时间和日期,可以在windows中修改时间和日期
如果你想能够在程序中修改,那么你可以用TIME$和DATE$函数
对时间和日期进行修改.
一点说明:对于万年历的数据,是可以压缩到一年只有4个字节的,
这点留给有兴趣的朋友去做,下面是万年历数据格式
的说明:
一年是16个字节
每四个字节是一个Integer整数,假设是A,B,C,D
A/256 :一年农历有几个月
A mod 256 :农历闰年闰第几个月 0为没闰
B/256 :农历正月初一的国历的月
B mod 256 :农历正月初一的国历的日
C/256 :农历正月初一的天干
C mod 256 :农历正月初一的地支
D :农历月的大小(位为1=30天,0=29天)
以下是源代码:
DECLARE SUB ClockPic (Flag%)
DECLARE SUB digMax (x%, y%, st$, size%)
DECLARE SUB ListMonth (Flag%)
DECLARE SUB ListTime (Flag%)
DECLARE SUB PalInit ()
DECLARE SUB SetPal (N%, R%, G%, B%)
DECLARE FUNCTION week% (y%, M%, d%)
DECLARE FUNCTION wnl$ (y%, M%, d%)
DECLARE SUB MyPrn (x%, y%, st$, bfclr%, bkclr%, over%)
DEFINT A-Z
'==============================================
' 取y/m/d(年/月/日)的农历(天干/地支)
' 秋风2005年10月22日
' 函数返回:wnl$(24字节)
' byte=农历年 8 byte
' 农历月 4 byte
' 农历日 4 byte
' 日天干 4 byte
' 日地支 4 byte
'==============================================
'****************************************************************************
CONST MyClr = 15
SCREEN 12
'****************************************************************************
ON TIMER(1) GOSUB ListClock
TIMER ON
'****************************************************************************
DEF SEG = 65
WHILE INKEY$ = ""
IF ChangeColor% = 1 AND shift% > ct% + 1 THEN
ct% = shift%
clr% = clr% + 1
SetPal MyClr, clr%, clr%, clr%
IF clr% >= 63 THEN ChangeColor% = 0
END IF
IF ChangeColor% = 2 AND shift% > ct% + 1 THEN
ct% = shift%
clr% = clr% - 1
SetPal MyClr, clr%, clr%, clr%
IF clr% <= 0 THEN ChangeColor% = 0
END IF
shift% = PEEK(92)
IF ct% > shift% THEN ct% = 0
WEND
END
'****************************************************************************
ListClock:
SELECT CASE count%
CASE 0
CLS : clr% = 0
SetPal MyClr, 0, 0, 0
CALL ClockPic(1)
ChangeColor% = 1
CASE 12
ChangeColor% = 2
clr% = 63
CASE 20
CLS : clr% = 0
SetPal MyClr, 0, 0, 0
CALL ListMonth(1)
ChangeColor% = 1
CASE 32
ChangeColor% = 2
clr% = 63
CASE 40
CLS : clr% = 0
SetPal MyClr, 0, 0, 0
CALL ListTime(1)
ChangeColor% = 1
CASE 52
ChangeColor% = 2
clr% = 63
END SELECT
IF count% < 20 THEN
CALL ClockPic(0)
END IF
IF count% >= 40 AND count% < 60 THEN
CALL ListTime(0)
END IF
count% = count% + 1
IF count% >= 60 THEN count% = 0
RETURN
近来QB区真是太冷清了!!!!
如果你想修改时间和日期,可以在windows中修改时间和日期
如果你想能够在程序中修改,那么你可以用TIME$和DATE$函数
对时间和日期进行修改.
一点说明:对于万年历的数据,是可以压缩到一年只有4个字节的,
这点留给有兴趣的朋友去做,下面是万年历数据格式
的说明:
一年是16个字节
每四个字节是一个Integer整数,假设是A,B,C,D
A/256 :一年农历有几个月
A mod 256 :农历闰年闰第几个月 0为没闰
B/256 :农历正月初一的国历的月
B mod 256 :农历正月初一的国历的日
C/256 :农历正月初一的天干
C mod 256 :农历正月初一的地支
D :农历月的大小(位为1=30天,0=29天)
以下是源代码:
DECLARE SUB ClockPic (Flag%)
DECLARE SUB digMax (x%, y%, st$, size%)
DECLARE SUB ListMonth (Flag%)
DECLARE SUB ListTime (Flag%)
DECLARE SUB PalInit ()
DECLARE SUB SetPal (N%, R%, G%, B%)
DECLARE FUNCTION week% (y%, M%, d%)
DECLARE FUNCTION wnl$ (y%, M%, d%)
DECLARE SUB MyPrn (x%, y%, st$, bfclr%, bkclr%, over%)
DEFINT A-Z
'==============================================
' 取y/m/d(年/月/日)的农历(天干/地支)
' 秋风2005年10月22日
' 函数返回:wnl$(24字节)
' byte=农历年 8 byte
' 农历月 4 byte
' 农历日 4 byte
' 日天干 4 byte
' 日地支 4 byte
'==============================================
'****************************************************************************
CONST MyClr = 15
SCREEN 12
'****************************************************************************
ON TIMER(1) GOSUB ListClock
TIMER ON
'****************************************************************************
DEF SEG = 65
WHILE INKEY$ = ""
IF ChangeColor% = 1 AND shift% > ct% + 1 THEN
ct% = shift%
clr% = clr% + 1
SetPal MyClr, clr%, clr%, clr%
IF clr% >= 63 THEN ChangeColor% = 0
END IF
IF ChangeColor% = 2 AND shift% > ct% + 1 THEN
ct% = shift%
clr% = clr% - 1
SetPal MyClr, clr%, clr%, clr%
IF clr% <= 0 THEN ChangeColor% = 0
END IF
shift% = PEEK(92)
IF ct% > shift% THEN ct% = 0
WEND
END
'****************************************************************************
ListClock:
SELECT CASE count%
CASE 0
CLS : clr% = 0
SetPal MyClr, 0, 0, 0
CALL ClockPic(1)
ChangeColor% = 1
CASE 12
ChangeColor% = 2
clr% = 63
CASE 20
CLS : clr% = 0
SetPal MyClr, 0, 0, 0
CALL ListMonth(1)
ChangeColor% = 1
CASE 32
ChangeColor% = 2
clr% = 63
CASE 40
CLS : clr% = 0
SetPal MyClr, 0, 0, 0
CALL ListTime(1)
ChangeColor% = 1
CASE 52
ChangeColor% = 2
clr% = 63
END SELECT
IF count% < 20 THEN
CALL ClockPic(0)
END IF
IF count% >= 40 AND count% < 60 THEN
CALL ListTime(0)
END IF
count% = count% + 1
IF count% >= 60 THEN count% = 0
RETURN
