这个很强大，支持一下。
这个太强大了，赞一个
这个真不错，以前有想过，CDMA授时时钟，但无才不知如何下手，如果能把屏弄得大些就好了，最好是彩屏
挺好的东西！是否可以做成产品
这个很强大，支持一下
厉害，见高手了
以前我就有这想法没法实现，楼主做的作品和我的设想一致，你这有两个方向发展：一，不安UIM卡能实现接打电话，那这时钟的手机号码是多少？别人怎么往这上边打？要是能行的通的话，你可以做个免费手机能省不少话费。二，你可以用这个板子接个大点的LED显示屏，最好做成万年历会很实用，能直观的显示当地的天气温度风力等信息，对于农村来说很实用。电源直接插家用220V电通过适配器转换实现，不用考虑功耗问题。（仅供参考）
天空之城 发表于 2014-3-30 22:45 static/image/common/back.gif
以前我就有这想法没法实现，楼主做的作品和我的设想一致，你这有两个方向发展：一，不安UIM卡能实现接打电话 ...
没说不装UIM能打收费电话，而是能读取时间，一般手机无网状态下不能，呵呵
没有注册身份即处于漫游状态，只能拨打免费服务台如119
关于您的想法很好，以后回去完善。
l5213j 发表于 2014-3-22 05:27 static/image/common/back.gif
这个真不错，以前有想过，CDMA授时时钟，但无才不知如何下手，如果能把屏弄得大些就好了，最好是彩屏
以后会慢慢完善:handshake
放出时钟最后修订的代码，以后将不会更新了，过几年估计有时间翻译为C语言。
本次修订相比1楼的程序主要解决了显示方面的bug.
从日志看出这个项目开发时间跨度比较长，因为个人比较忙，而且很多东西的调试需要长期观察……
'===================================================================================
'
'
' Version;1.0.0
'
' by gaochongjun1
' http://www.crystalradio.cn/
'
' This is a source of free items.
'===================================================================================
' _______________________________________________________________
' PIN FUNCTION MODE TO FROM
' ---------------------------------------------------------------
' PD.0 RXD INPUT / MC8331
' PD.1 TXD OUTPUT MC8331 /
' PD.2 Infra-red INPUT / Receiver
' PD.6 1-wirte I/O DS18B20 /
' PD.7 ON/OFF OUTPUT MC8331 /
' PC.0 LED control OUTPUT LED+ /
' PC.1 RI INPUT / MC8331
' PA.0 LCD DATA4 OUTPUT 1602 /
' PA.1 LCD DATA5 OUTPUT 1602 /
' PA.2 LCD DATA6 OUTPUT 1602 /
' PA.3 LCD DATA7 OUTPUT 1602 /
' PA.4 LCD E OUTPUT 1602 /
' PA.5 LCD RS OUTPUT 1602 /
' _______________________________________________________________
'Warning:1\必需在VCC与GND间并至少470uF的滤波电容
' 2\DS18B20传感器数据线需接4.7K的上拉电阻
'===================================================================================
' EEPROM data view:
' ____________________________________________________________
' Address FUNCTION Default Value Hex
' ------------------------------------------------------------
' 00000000 Display mode "T"/"F"/"A" 54/46/41
' ____________________________________________________________
$eeprom : Data "T" : $data
'===================================================================================
'**Build long:
'2013/5/20 06:30 启动项目
'2013/6/01 20:01 完成硬件组装
'2013/6/01 21:14 完成串口部分调试
'2013/6/01 21:23 各项功能解调基本正常
'2013/6/01 22:33 完成软件部分调试
'2013/6/02 10:00 暂停软件开发，对外观进行改进
'2013/7/18 00:57 完成构建思路
'2013/7/21 21:48 组装完成，进入测试阶段
'2013/12/21 00:38 增加DS18B20温度计
'2013/12/22 15:30 增加红外遥控
'2013/12/22 15:37 增加遥控关机功能
'2013/12/22 20:13 增加CSQ信号强度界面
'2013/12/27 21:58 增加Zeller算法计算星期
'2013/12/27 22:05 增加精简/完整界面切换功能
'2013/12/28 23:30 PCB板全部更换
'2013/12/28 16:00 加入UIM卡识别
'2013/12/29 17:00 去掉MCU座使硬件更稳定
'2014/01/01 00:20 增加打电话功能
'2014/01/10 18:40 采用UART异步读取模块返回值保证事件的完整性
'2014/01/11 15:55 组装完毕，工程初步封顶，进入第二测试阶段
'2014/01/23 00:00 增加大字体显示模式
'2014/01/23 16:18 增加整点报时功能
'==================================================================================
'**Debug long:
'2013/6/01 21:13 解决串口丢包卡死程序的问题
'2013/6/01 22:29 修正某些时间ATE0指令失败的问题
'2013/6/01 00:01 修改了界面布局
'2013/6/01 00:59 增加了自动背光控制（见306行）
'2013/7/22 19:55 修正背光夜晚闪烁严重的bug
'2013/12/22 15:35 修正因红外干扰，触发中断导致错过模块启动消息的bug
'2013/12/22 15:40 修正开机时DS18B20因转换时间不足显示85摄氏度的bug
'2013/12/22 20:18 修正模块搜索网络时信号强度显示异常
'2013/12/22 22:22 修正LCD偶然乱码的问题
'2013/12/24 12:27 修正信号有效值显示错误
'2014/01/01 00:35 修正Zeller算法代码的bug
'2014/01/11 15:00 修正时钟模式下自动应答的问题
'2014/01/16 23:00 修正错误显示和意外死机的问题
'2014/05/27 15:27 修正经过长期发现积累的bug杂项
'==================================================================================
$regfile = "m16def.dat"
$swstack = 16
$framesize = 40
'/* Defining Methods */
Declare Sub Setupmodule()
Declare Sub Gettemperature()
Declare Sub Getline(s As String)
Declare Sub Getweek(iyear As Integer , Imonth As Integer , Iday As Integer)
Declare Sub Shownumber(byval Istart As Integer , Byval Inum As Integer )
Declare Sub Clarline(byval Istart As Integer )
'/* LCM symbol */
Deflcdchar 1 , 7 , 5 , 7 , 32 , 32 , 32 , 32 , 32 ' °symbol
Deflcdchar 2 , 21 , 10 , 21 , 10 , 21 , 10 , 21 , 10 ' Shadow
Deflcdchar 3 , 31 , 31 , 32 , 31 , 31 , 32 , 31 , 31 ' replace ? with number (0-7)
Deflcdchar 4 , 31 , 31 , 32 , 32 , 32 , 32 , 32 , 32 ' replace ? with number (0-7)
Deflcdchar 5 , 31 , 31 , 32 , 32 , 32 , 32 , 31 , 31 ' replace ? with number (0-7)
Deflcdchar 6 , 32 , 32 , 32 , 32 , 32 , 32 , 31 , 31 ' replace ? with number (0-7)
Deflcdchar 0 , 32 , 32 , 32 , 31 , 31 , 32 , 32 , 32 ' replace ? with number (0-7)
'/* system hardware setup */
$crystal = 8000000
$hwstack = 40
Config Portd.7 = Output , Pinc.1 = Input , Portc.0 = Output
Config Lcdpin = Pin , Db4 = Porta.0 , Db5 = Porta.1 , Db6 = Porta.2 , Db7 = Porta.3 , E = Porta.4 , Rs = Porta.5 : Config Lcd = 16 * 2
Config 1wire = Portd.6
Config Serialin = Buffered , Size = 30
_monoff Alias Portd.7
_ri Alias Pinc.1
_lamp Alias Portc.0
'/* USART */
Dim Str_uart As String * 32
Dim Uart_byte As Byte
' MC8331: AT+IPR=19200 <cr><lf>
$baud = 19200
'/* temp vars */
Dim Intlen As Integer
Dim Intlen0 As Integer
'/* system state vars */
Dim Installed_uim As Bit
Dim Old_state As Integer
Dim Module_state As Integer
' _____________________________________________________________
' Value Mode Content
' -------------------------------------------------------------
' -2 Closed Closed
' -1 Closing Close clock
' 0 Init RESET Module
' 1 Module is ready Initialization completed
' 2 Clock Get CCLK
' 3 CSQ Get CSQ value
' 4 Keyboard Enter the telephone number
' 5 Calling Call out
' 6 Calling Incoming
' _____________________________________________________________
Dim Draw_state As Integer
' _____________________________________________________________
' Value Mode Content
' -------------------------------------------------------------
' 0 Null null
' 1 calling draw "connecting"
' _____________________________________________________________
Dim Setting_show_temp As Byte
'/* system interrupt */
Config Int0 = Falling 'Infra-red input
On Int0 Int_0
Enable Interrupts
' -------------- Setup --------------
Const Autolamp = 0 '.(0/1)automatic controlling lamp
' -----------------------------------
'(
Function : Initialise Module And Program
Date : 2013 / 6 / 01
')
_init:
_lamp = 1
_ri = 1
Cls : Lcd "Initialise.."
Gosub _resetmodule
Cursor Off Noblink
Installed_uim = 0
Module_state = 0
（字数超长，下接）
'(
Function : Main Function
Date : 2013 / 6 / 01
Rev.31
')
_main:
'/* date time vars */
Dim Strdate As String * 10
Dim Strtime As String * 8
Dim Strmin As String * 2
Dim Strhour As String * 2
Dim Intyear As Integer
Dim Intmonth As Integer
Dim Intday As Integer
'/* temp vars */
Dim Oldhour As String * 2
Dim Strtemp As String * 2
Dim Intfix As Integer
'/* system state vars */
Dim Intcsq As Integer
Dim Bitri As Bit 'ring symbol
Dim Strtelephonenumber As String * 16 , Strinnumber As String * 16 , Strkeynumber As String * 16
Do
'/* Get data from module */
Getline Str_uart
'/////////////////////////////////////////////////////////////
'State Machine
'
'+STATE Module
'/////////////////////////////////////////////////////////////
If Str_uart = "+ZIND:8" Then
_lamp = 0
Cls : Locate 2 , 1 : Lcd "Module is full."
Call Setupmodule
Module_state = 1
End If
If Str_uart = "+ZIND:0" Or Str_uart = "+ZIND:1" Then
Call Setupmodule
If Str_uart = "+ZIND:1" Then Installed_uim = 1 : Waitms 1000
Cls : Locate 1 , 1 : Lcd "Load data..."
If Installed_uim = 1 Then
Locate 2 , 13 : Lcd "UIM"
End If
Module_state = 2 : Old_state = 2
_lamp = 1
Readeeprom Setting_show_temp , 0
If Setting_show_temp <> "T" And Setting_show_temp <> "F" And Setting_show_temp <> "A" Then Setting_show_temp = "T"
Enable Int0 'Infra-red input
End If
If Left(str_uart , 8) = "+ZCCNT:0" Then
Locate 2 , 1 : Lcd "### "
End If
If Left(str_uart , 6) = "+ZCEND" Then
Cls : Locate 1 , 1 : Lcd "# Disconnected #" : Waitms 1000
Strinnumber = ""
Module_state = Old_state
End If
If _ri = 0 And Module_state <> 0 And Module_state <> 1 Then
Bitri = 1
Else
Bitri = 0
End If
If Left(str_uart , 5) = "RING:" Then
Intlen = Len(str_uart) - 5
Strinnumber = Right(str_uart , Intlen)
Bitri = 1
End If
If Bitri = 1 Then
Locate 1 , 1 : Lcd "### RING : "
Locate 2 , 1 : Lcd Strinnumber ; " "
Module_state = 6
End If
If Left(str_uart , 10) = "NO CARRIER" Then
Cls : Locate 1 , 1 : Lcd "NO CARRIER" : Waitms 1000
End If
If Left(str_uart , 9) = "NO ANSWER" Then
Cls : Locate 1 , 1 : Lcd "NO ANSWER" : Waitms 1000
End If
'///////////////////////////////////////////////////////////////
'State Machine
'
'+STATE Clock
'///////////////////////////////////////////////////////////////
If Module_state = -1 Then Goto _closemodule
'/* Draw Callin number */
If Module_state = 5 Then
Locate 1 , 1 : Lcd Strkeynumber ; " "
Locate 2 , 5 : Lcd Strtelephonenumber
End If
'/* Draw Dial */
If Module_state = 4 Then
Locate 1 , 1 : Lcd "Key number: "
Locate 2 , 1 : Lcd Strtelephonenumber ; " "
End If
'/* Draw Mark */
Select Case Draw_state
Case 1
Locate 2 , 1 : Lcd ">>> "
Draw_state = 0
End Select
If Module_state = 5 Or Module_state = 6 Then Goto Exit0
If Module_state = 2 Then Print "AT+CCLK?"
If Module_state = 3 Then Print "AT+CSQ?"
If Left(str_uart , 5) = "+CCLK" Then
'/* cut string */
Intlen = Len(str_uart) - 8 : Str_uart = Right(str_uart , Intlen)
Intlen = Intlen - 5 : Str_uart = Left(str_uart , Intlen )
'/* get date time */
Strdate = "20" + Left(str_uart , 8)
Strtime = Right(str_uart , 8)
Strhour = Left(strtime , 2)
Strmin = Mid(strtime , 4 , 2)
'/* check data */
If Mid(strdate , 5 , 1) <> "/" Then Goto Exit0
If Mid(strdate , 8 , 1) <> "/" Then Goto Exit0
If Mid(strtime , 3 , 1) <> ":" Then Goto Exit0
If Mid(strtime , 6 , 1) <> ":" Then Goto Exit0
'/* the whole point timekeeping */
If Oldhour <> Strhour Then Print "AT+ZDTMF=1," ; Chr(34) ; "*" ; Chr(34) ; ",4,5" : Oldhour = Strhour 'Beep
Select Case Setting_show_temp
'/* full mode */
Case "T"
Strtemp = Mid(strdate , 3 , 2) : Intyear = Val(strtemp)
Strtemp = Mid(strdate , 6 , 2) : Intmonth = Val(strtemp)
Strtemp = Mid(strdate , 9 , 2) : Intday = Val(strtemp)
Locate 1 , 1 : Lcd Strdate ; " "
Locate 2 , 1 : Lcd Strtime ; " "
Call Getweek(intyear , Intmonth , Intday)
Call Gettemperature()
'/* simple mode */
Case "F"
Locate 1 , 1 : Lcd Strdate ; " "
Locate 2 , 9 : Lcd Strtime ; " "
Locate 2 , 1 : Lcd " "
'/* large print mode */
Case "A"
Intfix = Val(strhour)
If Intfix > 12 Then
Intfix = Intfix - 12
Strhour = Str(intfix)
End If
If Len(strhour) = 1 Then Strhour = "0" + Strhour
Call Clarline(2)
'/* Draw hour number */
If Strhour <> "11" Then
Strtemp = Mid(strhour , 1 , 1) : Intlen = Val(strtemp)
If Intlen = 0 Then
Call Clarline(1) : Call Clarline(2)
Else
Call Shownumber(1 , Intlen)
End If
Strtemp = Mid(strhour , 2 , 1) : Intlen = Val(strtemp) : Call Shownumber(3 , Intlen)
If Intlen = 1 Then Call Clarline(5)
Else
Strtemp = Mid(strhour , 1 , 1) : Intlen = Val(strtemp) : Call Shownumber(3 , Intlen)
Strtemp = Mid(strhour , 2 , 1) : Intlen = Val(strtemp) : Call Shownumber(5 , Intlen)
Call Clarline(1)
Call Clarline(2)
If Strhour = "11" Then Call Clarline(12)
End If
Call Clarline(6)
Call Clarline(8)
Call Clarline(16)
'/* Draw point */
Locate 1 , 7 : Lcd Chr(0)
Locate 2 , 7 : Lcd Chr(0)
'/* Draw Min number */
Strtemp = Mid(strmin , 1 , 1) : Intlen0 = Val(strtemp) : Call Shownumber(9 , Intlen0)
Strtemp = Mid(strmin , 2 , 1) : Intlen = Val(strtemp)
If Intlen0 = 1 Then
Call Shownumber(11 , Intlen)
If Intlen = 1 Then
Call Clarline(12)
Call Clarline(13)
End If
Call Clarline(14)
Call Clarline(15)
Else
Call Shownumber(13 , Intlen)
Call Clarline(12)
End If
If Intlen = 1 Then Call Clarline(15) : Call Clarline(16)
End Select
'/* auto backlight */
#if Autolamp = 1
Intlen = Val(strhour)
If Intlen > 18 Or Intlen < 8 Then 'Evening
_lamp = 1
Else 'Morning/afternoon
_lamp = 0
End If
#endif
End If
If Left(str_uart , 4) = "+CSQ" Then
Intlen = Len(str_uart) - 5
Str_uart = Right(str_uart , Intlen)
Intcsq = Val(str_uart)
If Intcsq < 32 Then
'/* normal */
Locate 2 , 1 : Lcd "CSQ: " + Str(intcsq) ; " "
Intcsq = Intcsq / 2
For Intlen = 0 To Intcsq
Locate 1 , Intlen : Lcd Chr(255)
Next Intlen
Intcsq = Intcsq + 1
For Intlen = Intcsq To 16
Locate 1 , Intlen : Lcd Chr(2)
Next Intlen
Else
'/* searching network */
For Intlen = 0 To 4
Locate 1 , Intlen : Lcd Chr(255)
Next Intlen
For Intlen = 5 To 16
Locate 1 , Intlen : Lcd Chr(2)
Next Intlen
Locate 2 , 1 : Lcd "Search network.."
End If
End If
Exit0:
Loop
End
'(
Function : Close Module And Power Off
Date : 2013 / 6 / 01
Rev.3
')
_closemodule:
Cls : Locate 1 , 1 : Lcd "Reset module..."
Print "ATH" : Waitms 100
Print "AT+ZPWROFF"
Waitms 1000
Cls : Locate 1 , 1 : Lcd "Module is full."
Waitms 2000
Cls : Locate 1 , 1 : Lcd "Close the clock!"
_lamp = 0
Module_state = -2
Powerdown
_resetmodule:
Waitms 30
_monoff = 0
Waitms 2000
_monoff = 1
Waitms 100 '200ms impulse
_monoff = 0
_monoff = 1
Waitms 100
_monoff = 0
_monoff = 1
Return
（字数超长，下接）
'(
Function : Receive Infra -red Code
Date : 2013 / 12 / 2
Rev.11
')
Int_0:
Dim A As Byte , B As Word , C As Word , Aa As Byte , Bb As Byte
Dim D As Byte , A1(3) As Byte , Cc As Byte , Dd As Byte
A = 0
Do
Waitus 800
If Portd.2 = 1 Then Goto Exit1
Incr A
Loop Until A = 10
Bitwait Pind.2 , Set
Waitms 5
A = 0
Do
Bitwait Pind.2 , Set : Waitms 1 : B.0 = Pind.2
If B.0 = 0 Then
Rotate B , Right , 1
Else
Waitms 1 : Rotate B , Right , 1
End If
Incr A
Loop Until A = 16
A = 0
Do
Bitwait Pind.2 , Set : Waitms 1 : C.0 = Pind.2
If C.0 = 0 Then
Rotate C , Right , 1
Else
Waitms 1 : Rotate C , Right , 1
End If
Incr A
Loop Until A = 16
Aa = High(b) : Bb = Low(b) : Cc = High(c) : Dd = Low(c)'Address=BB，Not Data=DD，Data=CC
Aa = Not Aa : Cc = Not Cc
If Aa = Bb Then A1(2) = Aa Else Goto Exit1
If Cc = Dd Then A1(3) = Cc Else Goto Exit1
'Read Infra-red code
' Address code :128 (PWM)
' __________________________________________________________________
' Control code Title Function
' ------------------------------------------------------------------
' 18 Power Close the Clock/Disconnect
' 26 Mode Show CSQ Interface
' 1 Play/Pause Set display mode mode
' 4 EQ Clear number
' 2 forwad Backspace
' 8 RPT Connect/Disconnect
' __________________________________________________________________
If Bb <> 128 Then Goto Exit1
If Cc = 5 Or Cc = 6 Or Cc = 7 Or Cc = 10 Or Cc = 27 Or Cc = 31 Or Cc = 12 Or Cc = 13 Or Cc = 14 Or Cc = 0 Or Cc = 15 Or Cc = 25 Then
If Module_state <> 4 And Module_state <> 5 And Module_state <> 6 Then
Strinnumber = ""
Strtelephonenumber = ""
Module_state = 4
End If
End If
Select Case Cc
Case 18 'POWER OFF
If Module_state = 5 Or Module_state = 6 Or Module_state = 4 Then
Print "ATH" 'disconnect
Strinnumber = ""
Strtelephonenumber = ""
Module_state = Old_state
Else
Module_state = -1 'close
End If
Case 1 'display mode mode
If Module_state = 2 Then
If Setting_show_temp = "F" Then
Setting_show_temp = "T"
Goto Exit2
Elseif Setting_show_temp = "T" Then
Setting_show_temp = "A"
Goto Exit2
Elseif Setting_show_temp = "A" Then
Setting_show_temp = "F"
Goto Exit2
End If
Exit2:
Writeeeprom Setting_show_temp , 0
End If
Case 26 'CSQ
If Module_state = 5 Or Module_state = 6 Then Goto Exit1
If Module_state = 2 Then
Module_state = 3
Else
Module_state = 2
End If
Old_state = Module_state
Case 4 'clear number
If Module_state = 5 Or Module_state = 6 Then Goto Exit1
If Module_state <> 4 Then Module_state = 4
Strtelephonenumber = ""
Case 2 'backspace
If Module_state = 5 Or Module_state = 6 Then Goto Exit1
Intlen = Len(strtelephonenumber) - 1
Strtelephonenumber = Left(strtelephonenumber , Intlen)
If Intlen = 0 Then Strtelephonenumber = ""
Case 8
If Module_state = 2 Or Module_state = 3 Or Module_state = 6 Then
Print "ATA" 'Connect(in)
Strkeynumber = ""
Module_state = 6
End If
If Module_state = 5 Or Module_state = 6 Then 'Disconnect
Print "ATH"
Strinnumber = ""
Module_state = Old_state
End If
If Module_state = 4 Then 'Connect(out)
Print "ATD" ; Strtelephonenumber ; ";"
Strkeynumber = ""
Draw_state = 1
Module_state = 5
End If
Case 7 'num keys
Strtelephonenumber = Strtelephonenumber + "0"
Strkeynumber = Strkeynumber + "0"
Print "AT+ZDTMF=1," ; Chr(34) ; "0" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "0"
Case 10
Strtelephonenumber = Strtelephonenumber + "1"
Strkeynumber = Strkeynumber + "1"
Print "AT+ZDTMF=1," ; Chr(34) ; "1" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "1"
Case 27
Strtelephonenumber = Strtelephonenumber + "2"
Strkeynumber = Strkeynumber + "2"
Print "AT+ZDTMF=1," ; Chr(34) ; "2" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "2"
Case 31
Strtelephonenumber = Strtelephonenumber + "3"
Strkeynumber = Strkeynumber + "3"
Print "AT+ZDTMF=1," ; Chr(34) ; "3" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "3"
Case 12
Strtelephonenumber = Strtelephonenumber + "4"
Strkeynumber = Strkeynumber + "4"
Print "AT+ZDTMF=1," ; Chr(34) ; "4" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "4"
Case 13
Strtelephonenumber = Strtelephonenumber + "5"
Strkeynumber = Strkeynumber + "5"
Print "AT+ZDTMF=1," ; Chr(34) ; "5" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "5"
Case 14
Strtelephonenumber = Strtelephonenumber + "6"
Strkeynumber = Strkeynumber + "6"
Print "AT+ZDTMF=1," ; Chr(34) ; "6" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "6"
Case 0
Strtelephonenumber = Strtelephonenumber + "7"
Strkeynumber = Strkeynumber + "7"
Print "AT+ZDTMF=1," ; Chr(34) ; "7" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "7"
Case 15
Strtelephonenumber = Strtelephonenumber + "8"
Strkeynumber = Strkeynumber + "8"
Print "AT+ZDTMF=1," ; Chr(34) ; "8" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "8"
Case 25
Strtelephonenumber = Strtelephonenumber + "9"
Strkeynumber = Strkeynumber + "9"
Print "AT+ZDTMF=1," ; Chr(34) ; "9" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "9"
Case 5 '*
Strtelephonenumber = Strtelephonenumber + "*"
Strkeynumber = Strkeynumber + "*"
Print "AT+ZDTMF=1," ; Chr(34) ; "*" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "*"
Case 6 '#
Strtelephonenumber = Strtelephonenumber + "#"
Strkeynumber = Strkeynumber + "#"
Print "AT+ZDTMF=1," ; Chr(34) ; "#" ; Chr(34) ; ",4,1" : Waitms 50
Print "AT+VTS=" ; "#"
End Select
Exit1:
Return
'(
Function : Get Line Of Data From Buffer
Date : 2013 / 6 / 01
Rev.4
')
Sub Getline(s As String)
Dim Inttime As Long 'timeout
S = ""
Do
Inttime = Inttime + 1
If Inttime > 3072 Then 'watch dog
Inttime = 0
Exit Do
End If
Uart_byte = Inkey()
Select Case Uart_byte
Case 0
Case 10
Case 13
If S <> "" Then
Clear Serialin
Exit Do
End If
Case Else
S = S + Chr(uart_byte)
Inttime = 0
End Select
Loop
End Sub
'(
Function : Setup Module
Date : 2014 / 1 / 24
')
Sub Setupmodule
Print "ATE0" : Waitms 100
Print "AT+ZRIM=0" : Waitms 100
Print "AT+VGT=3" : Waitms 100
Print "AT+VGR=7"
Return
End Sub
'(
Function : Get Temperature
Date : 2013 / 12 / 21
Rev.4
')
Sub Gettemperature()
Dim Ct(2) As Byte
Dim T As Word
'/* temp vars */
Dim Temp As Single
Dim Inttemp As Integer
1wreset
1wwrite &HCC
1wwrite &H44
'Waitus 500
1wreset
1wwrite &HCC .
1wwrite &HBE
'Get Data
For Intlen = 1 To 2
Ct(intlen) = 1wread()
Next
'Read Data
T = Ct(2) * 256
T = T + Ct(1)
Locate 2 , 12
If Ct(2) > 15 Then
T = Not T
T = T + 1
Temp = T * 0.0625
Inttemp = Int(temp)
Lcd "-" ; Inttemp ; Chr(1) ; "C"
Else
Temp = T * 0.0625
Inttemp = Int(temp)
If Inttemp <> 85 Then
Lcd Inttemp ; Chr(1) ; "C "
Else
Lcd "--" ; Chr(1) ; "C "
End If
End If
End Sub
'(
Function : Get Week
Date : 2013 / 12 / 27
Rev.4
')
Sub Getweek(iyear As Integer , Imonth As Integer , Iday As Integer)
'/* temp vars */
Dim Intweek As Integer
Dim Inttemp0 As Integer
Dim Inttemp1 As Integer
Dim Inttemp2 As Integer
Dim Inttemp3 As Integer
'Zeller : w=(y++-2c++d-1)%7
If Imonth = 1 Or Imonth = 2 Then
Iyear = Iyear - 1
Imonth = Imonth + 12
End If
Inttemp0 = Intyear / 4
Inttemp1 = Intmonth + 1
Inttemp1 = Inttemp1 * 26
Inttemp1 = Inttemp1 / 10
Intweek = Intyear + Inttemp0
Intweek = Intweek - 35
Intweek = Intweek + Inttemp1
Intweek = Intweek + Intday
Intweek = Intweek - 1
While Intweek <= 7
Intweek = Intweek + 7
Wend
Intweek = Intweek Mod 7
Intweek = Intweek + 7
Intweek = Intweek Mod 7
Select Case Intweek
Case 1
Locate 1 , 12 : Lcd "MON. "
Case 2
Locate 1 , 12 : Lcd "TUES."
Case 3
Locate 1 , 12 : Lcd "WEB. "
Case 4
Locate 1 , 12 : Lcd "THUR."
Case 5
Locate 1 , 12 : Lcd "FRI. "
Case 6
Locate 1 , 12 : Lcd "SAT. "
Case 0
Locate 1 , 12 : Lcd "SUN. "
End Select
End Sub
（字数超长，下接）
'(
Function : Show Number
Date : 2014 / 1 / 23
Rev.5
')
Sub Shownumber(byval Istart As Integer , Byval Inum As Integer )
Dim Chr1 As Integer , Chr2 As Integer , Chr3 As Integer , Chr4 As Integer , Chr5 As Integer , Chr6 As Integer
Select Case Inum
Case 1
Chr1 = 3 ' =
Chr2 = 3 ' =
Chr3 = 32 ' =
Chr4 = 32 ' =
Chr5 = -1 ' =
Chr6 = -1 ' =
Case 2
Chr1 = 4 ' = = =
Chr2 = 3 ' =
Chr3 = 4 ' =
Chr4 = 5 ' = = =
Chr5 = 3 ' =
Chr6 = 5 ' = = =
Case 3
Chr1 = 4 ' = = =
Chr2 = 5 ' =
Chr3 = 4 ' =
Chr4 = 5 ' = = =
Chr5 = 3 ' =
Chr6 = 3 ' = = =
Case 4
Chr1 = 3 ' = =
Chr2 = 4 ' = =
Chr3 = 6 ' = = =
Chr4 = 4 ' = = =
Chr5 = 3 ' =
Chr6 = 3 ' =
Case 5
Chr1 = 3 ' = = =
Chr2 = 5 ' =
Chr3 = 4 ' =
Chr4 = 5 ' = = =
Chr5 = 4 ' =
Chr6 = 3 ' = = =
Case 6
Chr1 = 3 ' = = =
Chr2 = 3 ' =
Chr3 = 4 ' =
Chr4 = 5 ' = = =
Chr5 = 4 ' = =
Chr6 = 3 ' = = =
Case 7
Chr1 = 4 ' = = =
Chr2 = 32 ' =
Chr3 = 4 ' =
Chr4 = 32 ' =
Chr5 = 3 ' =
Chr6 = 3 ' =
Case 8
Chr1 = 3 ' = = =
Chr2 = 3 ' = =
Chr3 = 5 ' = = =
Chr4 = 5 ' = = =
Chr5 = 3 ' = =
Chr6 = 3 ' = = =
Case 9
Chr1 = 3 ' = = =
Chr2 = 5 ' = =
Chr3 = 5 ' = = =
Chr4 = 5 ' = = =
Chr5 = 3 ' =
Chr6 = 3 ' = = =
Case 0
Chr1 = 3 ' = = =
Chr2 = 3 ' = =
Chr3 = 4 ' = =
Chr4 = 6 ' = =
Chr5 = 3 ' = =
Chr6 = 3 ' = = =
End Select
Locate 1 , Istart : Lcd Chr(chr1)
Locate 2 , Istart : Lcd Chr(chr2)
Incr Istart : Locate 1 , Istart : Lcd Chr(chr3)
Locate 2 , Istart : Lcd Chr(chr4)
If Chr5 <> -1 Then
Incr Istart : Locate 1 , Istart : Lcd Chr(chr5)
Locate 2 , Istart : Lcd Chr(chr6)
End If
End Sub
Sub Clarline(byval Istart As Integer )
Locate 1 , Istart : Lcd " "
Locate 2 , Istart : Lcd " "
End Sub
（终）
ps:字数限制只好分开发了，没时间打包上传，只好发代码。
东西很好，手里有一块移动的基板。看到那么多语言头大啊
真心羡慕你们 我都不懂这些玩意