[资料]6 位半电压源 Voltgen V1.0 源程序

lilith · 发表于 2015-6-23 18:47:13

本帖最后由 lilith 于 2015-7-15 11:16 编辑

该电压源历经 V0.1 原理验证手工版、V0.3 原理验证工厂 PCB，如今是 V1.0 长期可行性验证 PCB，因为还是一个出于验证的 PCB 和电路，因此程序编写也侧重于测试功能是否能实现，一些细致的调整还没有进行，因此有调整时噪声过大的一些问题还待修正。

由于一次发帖文字有限，源程序分为多个模块张贴。

源程序下载

标准版：

t1_12864.zip (23.49 KB, 下载次数: 561)

廉价版：

vg_costdown_t1.zip (7.39 KB, 下载次数: 217)

包含文件（LCD/OLED 驱动和软字体），如需编译程序，应将其放在主程序目录下的 /inc 子目录中

inc.zip (12.68 KB, 下载次数: 224)

+++++++++++++

廉价版 V1.0b202，修正了个别情况下因为硬件偏差值导致的 COM chk 和 DAC 1st chk 不过：

vg_costdown_V202_12864.zip (17.2 KB, 下载次数: 137)

+++++++++++++

廉价版 V1.0b200，包含自检代码

vg_costdown_t1_V200.zip (7.31 KB, 下载次数: 136)

自检代码的 inc

inc_withselftest.zip (13.71 KB, 下载次数: 123)

编译后固件

vg_costdown_t1v200_12864.zip (16.87 KB, 下载次数: 124)

上位机：

Voltgen.zip (16.48 KB, 下载次数: 153)

lilith · 发表于 2015-6-23 18:48:39

本帖最后由 lilith 于 2015-6-23 19:09 编辑

一、标准版（t1_12864.bas）

第一节

预定义和声明
'///////////////////////////////////////////////////////////////////////////////////////////////////
      'Voltage Generator
      'By Lilith Washu
'///////////////////////////////////////////////////////////////////////////////////////////////////
$Device= m32 ' 使用的单片机名称
$Stack = 32
$Clock = 11.0592    ' 使用的单片机主频
$ShiftIn Data = PORTB.4, Clock = PORTB.3, Msb ' 读取 ADC 的方法，注意为了速度这里用了编译器内置的软 SPI 而非我后面编写的软 SPI
'$ShiftOut Data = PORTB.1, Clock = PORTB.2, Msb
$Baud = 19200,n,8,1 '声明串口的波特率和其它信息
$1Wire = PORTD.6 '声明一个编译器内置的软 1W 总线
$LeadChar="0", Format(2,6) '格式化字符串
'************** Config the IO **************
' the Display Screen IO Connect
$Def IO_SCR_RST = PORTC.7
$Def IO_SCR_CSA = PORTC.6
$Def IO_SCR_CSB = PORTC.5
$Def IO_SCR_DoI = PORTC.4
$Def IO_SCR_RoW = PORTC.3
$Def IO_SCR_STB = PORTC.2
$Def IO_SCR_DAT = PORTA
' the Analog Board IO Connect
$Def IO_REG_STB = PORTB.0
$Def IO_REG_DAT = PORTB.1
$Def IO_REG_CLK = PORTB.2
$Def IO_ADC_CLK = PORTB.3
$Def IO_ADC_DAT = PINB.4
$Def IO_KEY_STB = PORTB.5
$Def IO_KEY_DAT = PINB.6
$Def IO_KEY_CLK = PORTB.7
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Constant
'///////////////////////////////////////////////////////////////////////////////////////////////////
Const fMasterReference = 7.038941E+00'7.043855e+00  'LM399 Voltage Value
Const fDACReference = 5.000000E+00 'DAC Voltage Reference Value
Const fDACenter = 2.500000E+00 'Slave DAC Default Output Voltage Value
Const fDACGain = 2.500000E+06 'DAC Output buff Gain
Const fMResistance = 2.49E+02 'DAC Voltgae Compound Resistance, the Master
Const fSResistance = 1E+06    'DAC Voltgae Compound Resistance, the Slave
'Const Cubic = -3.566e-01
Const Quadratic = -3.2425e+00 'No-line Error Adjuest Quadratic Coefficient 二次项系数
Const Linear = 4.262e+01    'No-line Error Adjuest Linear Coefficient  一次项系数
Const Constant =  -5.8295e+01 'No-line Error Adjuest Offset Coefficient  常数
Const fDacal = 1.006520e+00'1.0080731e+00    'DAC Fullscale Error Adjuest Vale
Const Synthesis = &b00000001 ' Analog Switch = Synthesis Voltage Output  | DG412 Pin
Const Reference = &b00000010    ' Analog Switch = Internal Reference(LM399)  | DG412 Pin
Const ExternaIN = &b00000100 ' Analog Switch = Externa Voltage Input | DG412 Pin
Const GndOffset = &b00001000 ' Analog Switch = Auto Zero    | DG412 Pin
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' String Variables
'///////////////////////////////////////////////////////////////////////////////////////////////////
Dim Ft1 As Flash Byte ' 软字体码表
Dim Ft2 As Flash Byte ' 软字体码表
Dim Charat As String *33' 要显示的字符缓冲区
Dim tTxt As String *15
Dim tm As String *7
Dim tCmd As String *4
Dim iCursors(8) As Byte
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Gen Variables
'///////////////////////////////////////////////////////////////////////////////////////////////////
Dim i As Byte
Dim bUartset As Byte
Dim bUartlk As Byte
Dim bAdjuest As Byte
Dim bDigitaLoop As Byte
Dim bRun As Byte
Dim bTrigcompleted As Byte
Dim bRefsource As Byte
Dim iErrlimit As Byte
Dim bSregister As Byte
Dim iSmlen As Byte
Dim iSmsetp As Byte
Dim iBusystp As Byte
Dim iTrd As Byte
Dim iDraw As Word
Dim CurrentChannel As Byte
Dim bNextchannel As Byte
Dim itm As Byte
Dim iDa As Byte
Dim iDb As Byte
Dim iDc As Byte
Dim iDd As Byte
Dim iTa As Byte
Dim iTb As Byte
Dim iTc As Byte
Dim iTd As Byte
Dim bADCResult(3) As Byte
Dim bREGa(64) As Byte '移动窗平均用变量数组
Dim bREGb(64) As Byte
Dim bREGc(64) As Byte
Dim bREGd(64) As Byte
Dim dTempdatum(1) As Byte
Dim dTempresult As Word
Dim iError As Integer
Dim wError As Word
Dim IsTempresultSense As Byte
Dim iErrcode As Byte
Dim iKeypress As Byte
Dim iKeycode As Word
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Float Variables
'///////////////////////////////////////////////////////////////////////////////////////////////////
Dim fTrn As Float
Dim fOut As Float
Dim fGndOffset As Float
Dim fReference As Float
Dim fSynthesis As Float
Dim fCalsacles As Float
Dim fCalfSynth As Float
Dim fSetting As Float
Dim fVoltage As Float
Dim fError As Float
Dim fVset As Float
Dim fVtrn As Float
Dim fTemperature As Float
Dim Vseth As Word
Dim Vsetl As Word
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Screen Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
Declare Function WriteKS(Code As Byte, Channel As Byte) As Byte ' 向显示屏写数据的函数
Declare Function SetKS(Code As Byte, Channel As Byte) As Byte ' 向显示屏写指令的函数
Declare Function InitKS() As Byte          ' 初始化显示屏
Declare Function ResetKS() As Byte          ' 显示屏上电函数，可用硬件电路代替
Declare Function ClsKS(GRAM As Byte) As Byte       ' 清屏函数
Declare Function DrawPix(x As Byte, y As Byte) As Byte    ' 在显示屏上画一个点
Declare Function DrawPage(x As Byte, Page As Byte, Code As Byte) As Byte ' 在显示屏上画一个页
Declare Function DrawChr(x As Byte, Page As Byte) As Byte    ' 显示一行标准 ASCII 字符
Declare Function DrawChrLarge(x As Byte, Page As Byte) As Byte    ' 显示一行标准 ASCII 字符
Declare Function DrawCursors(x As Byte, Page As Byte, Length As Byte) As Byte
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' IO Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
Declare Function WriteSReg(bDat As Byte) As Byte '写入抹泥板控制用串行寄存器
Declare Function WriteSBUS(bDat As Byte) As Byte
Declare Function WriteDAC(bmDath As Byte, bmDatL As Byte, bsDath As Byte, bsDatL As Byte) As Byte '写入 DAC
Declare Function SetChannel(Channel As Byte) As Byte '设置模拟开关
Declare Function ReadADC() As Byte '读取 ADC 的软代码，代码已经编写好，但这个例程为了速度没有使用，直接使用了编译器提供的
Declare Function ReadKEY() As Byte '读取键盘的软 SPI 代码
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Mathematical Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
Declare Function SetVoltage(fVoltage As Float) As Byte '设置输出电压，将浮点数转换为二进制代码
Declare Function Getinlerr(fVoltage As Float) As Float '二次三项式非线性拟合
Declare Function ReadADConvert(NextChannel As Byte) As Long
Declare Function FixADCResult() As Byte
Declare Function WriteResultREG(bSetp As Byte, bArea As Byte) As Byte
Declare Function MoveResultREG(bSetp As Byte, bArea As Byte) As Byte '对 ADC 结果进行移动窗平滑
Declare Function ReadADCResult(bChannel As Byte) As Float
Declare Sub StatusDisplay()
Declare Function UpdateTempresultInfo() As Byte
Declare Sub Trigcompleted()
Declare Function ADCheck(bNextChannel As Byte) As Integer
Declare Function Selftest() As Byte
Declare Function Debug(iTestcode As Byte) As Byte
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' UART Interrupt
'///////////////////////////////////////////////////////////////////////////////////////////////////
Declare Interrupt Urxc()
Declare Interrupt Int0()
'************** Enable the Keyboard **************
'Int0 Rising 'Falling '
Enable Interrupts
'Enable Int0
'************** Enable the Keyboard **************
'Enable Interrupts
Enable Urxc
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Config the MCU IO Register
'///////////////////////////////////////////////////////////////////////////////////////////////////
DDRA = &b11111111  'Display Screen Data Bus
   'Parallel 8bit Data bus
DDRC = &b11111111  'Display Screen Control Bus
   'PC0: (Saved)
   'PC1: (Saved)
   'PC2: Screen Strobe
   'PC3: Screen Write or Read
   'PC4: Screen Data or Instructions
   'PC5: Screen Area Enable LO Bit
   'PC6: Screen Area Enable HI Bit
   'PC7: Screen Reset
DDRB = &b10101111  'Analog Board Connect
   'REG STB <--- PB0
   'REG DAT <--- PB1
   'REG CLK <--- PB2
   'ADC CLK <--- PB3
   'ADC DAT ---> PB4
   'KEY STB <--- PB5
   'KEY DAT ---> PB6
   'KEY CLK <--- PB7
DDRD = &b11111011  'INT, UART and PWM Control
   'PD0: UART RX
   'PD1: UART TX
   'PD2: INT0 TRIG(Key)
   'PD3: INT1 TRIG(Saved)
   'PD4: PWM OC1B(Saved)
   'PD5: PWM OC1A(Saved)
   'PD6: 1Wire BUS(DS18b20)
   'PD7: PWM OC2(Saved)
PORTA = &b00000000    '初始化端口
PORTB = &b01000000
PORTC = &b00000000
PORTD = &b00000000

lilith · 发表于 2015-6-23 18:49:57

第二节初始化

'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Program Initialization
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Analog Board Initialization, Open all Analog Switch
bSregister = &b00000000
WriteSReg(bSregister)
' DAC Initialization to 0V Output
SetVoltage(0)
InitKS() ' 初始化显示屏
ClsKS(0) ' 清屏
' LCD Test and Init Display Charat
Charat = "Voltage Generator" : DrawChrLarge(6,1)
Charat = "Version 1.0" : DrawChr(32,3)
Charat = "Build 173" : DrawChr(44,4)
Charat = "By Lilith Washu" : DrawChr(38,6)
Wait 2    'Wait the LM399 Initialization
ClsKS(0)
Charat = "Initialization" : DrawChr(1,0)
'Initialization Var?
Charat = "Initialization    OK" : DrawChr(1,0)
iKeypress = 0
iKeycode = 0
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' EEPROM Initialization
'///////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Self Test
'///////////////////////////////////////////////////////////////////////////////////////////////////
iErrcode = Selftest()
If iErrcode > 1 Then
Charat = "Failed" : DrawChr(91,1)
Charat = "Code:" : DrawChr(1,7)
Format(3,0) : Charat = Str(iErrcode) : DrawChr(31,7)
'SetChannel(Synthesis)
Wait 5
ADCheck(Synthesis)
Debug(iErrcode)
Else
'ADCheck(Synthesis)
'Debug(iErrcode)
Charat = "OK" : DrawChr(115,1)
End If

'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Self Test End
'///////////////////////////////////////////////////////////////////////////////////////////////////

Wait 1 'Wait the LM399 Warmed
ClsKS(0)
' Screen Fixed Display Initialization
Charat = "SET:"
DrawChrLarge(1,0)
Charat = "REB:"
DrawChrLarge(1,2)
Charat = "VDC"
DrawChrLarge(105,0)
DrawChrLarge(105,2)
' Right Sataus Lable Display
'Charat = "MH:"
'DrawChr(156,0)
'Charat = "ML:"
'DrawChr(156,1)
'Charat = "SH:"
'DrawChr(156,2)
'Charat = "SL:"
'DrawChr(156,3)
'Charat = "WAT:" : DrawChr(156,4)
'Charat = "ADJ:"
'DrawChr(156,5)
'Botton Sataus Label Display
Charat = "IGNO" : DrawChr(9,4)
Charat = "EXEC" : DrawChr(9,5)
'Charat = "TemP" : DrawChr(12,6)
'Charat = "Filt" : DrawChr(96,6)
Charat = "ErroR" : DrawChr(52,6)
Charat = "RuN" : DrawChr(100,5)
Charat = "StP" : DrawChr(100,4)
' Cursors Draw
'MemLoad(VarPtr(iCursors), &b00001000, &b00011100, &b00111110, &b01111111) : DrawCursors(1, 4, 4) ' Display a "<" Cursors
'MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 4, 4) ' Display a ">" Cursors
'MemLoad(VarPtr(iCursors), &b00000100, &b00000110, &b00000111, &b00000110, &b00000100) : DrawCursors(1, 4, 5)  ' Display a "^" Cursors
If IsTempresultSense = 1 Then
MemLoad(VarPtr(iCursors), &b00000110, &b00001001, &b00001001, &b000000110) : DrawCursors(31, 7, 4) ' Display a  Degree Cursors
Charat = "C" : DrawChr(37,7)
UpdateTempresultInfo()
End If
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Program Initialization End
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Start the Temperature Sense(DS18b20) Convert
'1Wreset
'1Wwrite &hcc; &h44
'///////////////////////////////////////////////////////////////////////////////////////////////////
      ' Running  Register Initialization
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Init the DAC Output Default
fSetting = 10000000
fVoltage = fSetting
' Program Reset Point:
stt:
fVoltage = fVoltage / fDacal
SetVoltage(fVoltage)
' All Setting Register Value Initialization to Default
fReference = 0
fSynthesis = 0
fCalsacles = fMasterReference
iSmlen = 16 ' the Sommth Length, 1 Trig Cycle(Adjuest Cycle) = 3 x Sommth Length
bDigitaLoop = 1 ' Digital Loop = Close Loop(0=Open Loop)
itm = 0
iSmsetp = 0 ' Current Program Running Setp
bRun = 1 ' Flag the Program Run or Setp, 1 = Run
bRefsource = 0 ' Flag the Reference Source, 0 = INT, 1 = EXT
bNextchannel = 0  ' Flag the Analog Switch Channel
bAdjuest = 0 ' Flag is/isnot Adjuest Output Voltage
bUartlk = 1 ' Flag the UART Port Talk,bit 8 = All Talk; bit 1 = talk when Trigcompleted.
bUartset = 2
' Display and Update the Output Voltage Setting Value
Format(2,0)
Charat = Str(iSmlen) : DrawChr(104,7)
'Charat = Str(iSmlen * 3 + 1) : DrawChr(179,7)
Charat = "pt"  :  DrawChr(116,7)
Charat = "/" :  DrawChr(98,7)
Format(2,6)
fTrn = fSetting / 1000000
Charat = Str(fTrn)
DrawChrLarge(28,0)

北极风 · 发表于 2015-6-23 18:50:10

本帖最后由北极风于 2015-6-24 08:11 编辑

谢谢提供源程序下载

lilith · 发表于 2015-6-23 18:50:35

第三节主程序

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      'Program Main Loop
'///////////////////////////////////////////////////////////////////////////////////////////////////
Do
If bRun = 0 Then
  Charat = " ---------" : DrawChrLarge(28,2)
  MemLoad(VarPtr(iCursors), &h00, &h00, &h00, &h00) : DrawCursors(122, 5, 4)
  MemLoad(VarPtr(iCursors), &h08, &h1C, &h3E, &h7F) : DrawCursors(122, 4, 4)
  iSmsetp = 0
  WaitMs 100
  GoTo Runout
Else
  MemLoad(VarPtr(iCursors), &h00, &h00, &h00, &h00) : DrawCursors(122, 4, 4)
  MemLoad(VarPtr(iCursors), &h08, &h1C, &h3E, &h7F) : DrawCursors(122, 5, 4)
End If

bNextchannel = bNextchannel + 1
If bNextchannel > 3 Then bNextchannel = 1
iBusystp = 0
Do
  iBusystp = iBusystp + 1
  WaitMs 1
Loop While IO_ADC_DAT = 1
Select Case bNextChannel
Case 1 : CurrentChannel = SetChannel(Reference)
Case 2 : CurrentChannel = SetChannel(GndOffset)
Case 3 : CurrentChannel = SetChannel(Synthesis)
End Select

'Charat = Hex(iBusystp) : DrawChr(64,4)
bADCResult(3) = ShiftIn
bADCResult(2) = ShiftIn
bADCResult(1) = ShiftIn
bADCResult(0) = ShiftIn
FixADCResult()

For i = 1 To iSmlen
  MoveResultREG(i, bNextchannel)
Next i
WriteResultREG(iSmlen, bNextchannel)

iSmsetp = iSmsetp + 1
Format(2,0)
Charat = Str(iSmsetp/3)
DrawChr(86,7)

fSynthesis = ReadADCResult(1) 'syn
fReference = ReadADCResult(2) 'ref
fGndOffset = ReadADCResult(3) 'gnd

fCalfSynth = (fSynthesis - fGndOffset) / ((fReference - fGndOffset) / fCalsacles)
fCalfSynth = fCalfSynth + Getinlerr(fCalfSynth)/ 1000000

fTrn = Getinlerr(fCalfSynth)
Format(4, 1) : Charat = Str(fTrn) : DrawChr(48, 4)

fError = fSetting - fCalfSynth * 1000000
iError = fError
wError = iError * iError

Format(2,6)
Charat = Str(fCalfSynth)
DrawChrLarge(28,2)

Format(4,0)
Charat = "    " : DrawChr(52,7)
Charat = Str(iError) : DrawChr(52,7)
'Charat = Str(wError) : DrawChr(1,5)

iErrlimit = 0
If wError > 99 Then iErrlimit = 1
bAdjuest = bDigitaLoop And iErrlimit

'Format(2,0)
'Charat = Str(bAdjuest) : DrawChr(180,5)

If iSmsetp = iSmlen * 3 + 1 Then
  iSmsetp = 0
  Trigcompleted()
End If

Runout:
If bUartset = 1 Then
  bUartset = 0
  iSmsetp = 0
  fVoltage = fSetting
  fVoltage = fVoltage / fDacal
  SetVoltage(fVoltage)
  fTrn = fSetting / 1000000
  Format(2,6)
  Charat = Str(fTrn)
  DrawChrLarge(28,0)
End If

If bUartset = 2 Then
  bUartset = 0
  StatusDisplay()
End If

If iKeypress = 1 Then
  iKeypress = 0
  WaitMs 1
  iKeycode = ReadKey() + ReadKey() * 256
End If
'Charat = Hex(iKeycode) : DrawChr(1,6)
Loop
End

lilith · 发表于 2015-6-23 18:51:38

第四节对结果进行计算的函数

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      'Operation Sub and Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
Sub StatusDisplay()
If bDigitaLoop = 1 Then
MemLoad(VarPtr(iCursors), &h00, &h00, &h00, &h00) : DrawCursors(1, 4, 4)
MemLoad(VarPtr(iCursors), &h7F, &h3E, &h1C, &h08) : DrawCursors(1, 5, 4)
Else
MemLoad(VarPtr(iCursors), &h00, &h00, &h00, &h00) : DrawCursors(1, 5, 4)
MemLoad(VarPtr(iCursors), &h7F, &h3E, &h1C, &h08) : DrawCursors(1, 4, 4)
End If
End Sub
Function UpdateTempresultInfo() As Byte
1Wreset
1Wwrite &hcc; &hbe
1Wread dTempdatum ,2
1Wreset
1Wwrite &hcc; &h44
dTempresult = dTempdatum(0)
fTemperature = dTempresult
fTemperature = fTemperature / 16
Format(2,1) : Charat = Str(fTemperature) : DrawChr(1,7)
End Function
Sub Trigcompleted()
If bAdjuest = 1 Then
  fVoltage = fVoltage + fError
  SetVoltage(fVoltage)
End If
If IsTempresultSense = 1 Then UpdateTempresultInfo()
If bUartlk = 1 Then
  Format(5,2)
  Print fError; fTemperature
End If
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Return the 24bit Result from 32bit Data
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function FixADCResult() As Byte
iDa = bADCResult(3)
iDb = bADCResult(2)
iDc = bADCResult(1)
iDd = bADCResult(0)
' Casting out the lower 4bit Data and Return the low 8bit Result
iDd = iDd And &b11110000
iDd = Swap(iDd)
iTrd = iDc And &b00001111
iTrd = Swap(iTrd)
iTd = iDd + iTrd
' Move and Return the middle 8 bit Result
iTrd = iDc And &b11110000
iTc = Swap(iTrd)
iTrd = iDb And &b00001111
iTrd = Swap(iTrd)
iTc = iTrd + iTc
' Move and Return the hihg 8 bit Result
iTrd = iDb And &b11110000
iTb = Swap(iTrd)
iTrd = iDa And &b00001111
iTrd = Swap(iTrd)
iTb = iTrd + iTb
' Return the Overload and Sign Bit
iTrd = iDa And &b00110000
iTa = Swap(iTrd)
' Copy Result to Public Array
bADCResult(3) = iTa
bADCResult(2) = iTb
bADCResult(1) = iTc
bADCResult(0) = iTd
Return 0
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Write a ADC Result to FIFO Movewindow Array
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function WriteResultREG(bSetp As Byte, bArea As Byte) As Byte
iTrd = (bArea - 1) * iSmlen + bSetp
bREGa(iTrd) = bADCResult(3)
bREGb(iTrd) = bADCResult(2)
bREGc(iTrd) = bADCResult(1)
bREGd(iTrd) = bADCResult(0)
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Move the FIFO Array
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function MoveResultREG(bSetp As Byte, bArea As Byte) As Byte
iTrd = (bArea - 1) * iSmlen + bSetp
bREGa(iTrd) = bREGa(iTrd + 1)
bREGb(iTrd) = bREGb(iTrd + 1)
bREGc(iTrd) = bREGc(iTrd + 1)
bREGd(iTrd) = bREGd(iTrd + 1)
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Return a Float Format Smohth ADC Result
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function ReadADCResult(bChannel As Byte) As Float
fTrn = 0
fOut = 0
For i = 1 To iSmlen
iTrd = (bChannel - 1) * iSmlen + i
iTa = bREGa(iTrd)
iTb = bREGb(iTrd)
iTc = bREGc(iTrd)
iTd = bREGd(iTrd)
fTrn = 5 * 2.5 * (16777216 * iTa + 65536 * iTb + 256 * iTc + iTd - 33554432) / 16777216
fOut = fOut + fTrn
Next i
fOut = fOut / iSmlen
Return fOut
End Function

Function DrawCursors(x As Byte, Page As Byte, Length As Byte) As Byte
For i = 0 To Length - 1
DrawPage(x + i, Page, iCursors(i))
Next i
End Function

Function ADCheck(bNextChannel As Byte) As Integer
Local iChkresutl As Integer
Local iChk1 As Byte
Local iChk2 As Byte
Local iChk3 As Byte
Local iChk4 As Byte
Do
Loop While IO_ADC_DAT = 1
SetChannel(bNextChannel) : WaitMs 10
iChk4 = ShiftIn : iChk3 = ShiftIn : iChk2 = ShiftIn : iChk1 = ShiftIn
bADCResult(3) = iChk4 : bADCResult(2) = iChk3 : bADCResult(1) = iChk2 : bADCResult(0) = iChk1
iChkresutl = iChk4 * 4
iChkresutl = iChkresutl * 256 + iChk3 * 4 - 32768
Return iChkresutl / 4
End Function

lilith · 发表于 2015-6-23 18:53:49

第五节硬件 IO

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      'Shiftreg IO
'///////////////////////////////////////////////////////////////////////////////////////////////////

'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Wrtie the Analog board Control Shift-Register
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function WriteSReg(bDat As Byte) As Byte
Local i As Byte
Local bWritedat As Byte
Local bWritebit As Byte
bWritedat = bDat
IO_REG_DAT = 0
IO_REG_CLK = 0
IO_REG_STB = 0
WaitUs 1
For i = 1 To 8
bWritebit = bWritedat And &b10000000
If bWritebit = 128 Then
   IO_REG_DAT = 1
Else
   IO_REG_DAT = 0
End If
WaitUs 1
IO_REG_CLK = 1 : WaitUs 1 : IO_REG_CLK = 0
bWritedat = Shift(Left, 1, bWritedat)
Next i
WaitUs 1
IO_REG_STB = 1 : WaitMs 1 : IO_REG_STB = 0
IO_REG_DAT = 0
IO_REG_CLK = 0
Return 0
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Setting the Analog Switch(ADC Input Channel)
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function SetChannel(Channel As Byte) As Byte
Local Channelset As Byte
Channelset = bSregister And &b11110000
WriteSReg(Channelset)  ' Open all Analog Switch when Close Next Switch
WaitMs 10
bSregister = Channelset + Channel
WriteSReg(bSregister)
Return bSregister
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Wrtie the DAC Shift-Register
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function WriteSBUS(bDat As Byte) As Byte
Local i As Byte
Local bWritedat As Byte
Local bWritebit As Byte
bWritedat = bDat
IO_REG_DAT = 0
IO_REG_CLK = 0
WaitUs 1
For i = 1 To 8
bWritebit = bWritedat And &b10000000
If bWritebit = 128 Then
   IO_REG_DAT = 1
Else
   IO_REG_DAT = 0
End If
WaitUs 1
IO_REG_CLK = 1 : WaitUs 1 : IO_REG_CLK = 0
bWritedat = Shift(Left, 1, bWritedat)
Next i
WaitUs 1
IO_REG_DAT = 0
IO_REG_CLK = 0
Return 0
End Function
Function WriteDAC(bmDath As Byte, bmDatL As Byte, bsDath As Byte, bsDatL As Byte) As Byte
' Setp 1:
bSregister = bSregister And &b00001111    'Hold the Analog Switch Status and Setting the DAC to Write Mode
WriteSBUS(bmDath) : WriteSBUS(bmDatL) : WriteSBUS(bsDath) : WriteSBUS(bsDatL) : WriteSBUS(bSregister)
IO_REG_STB = 1 : WaitUs 10 : IO_REG_STB = 0    'Update the Control Shift-Register, DAC tobe Write
' Setp 2:
bSregister = bSregister + &b10000000    'Hold the Analog Switch Status and Setting the DAC to Update
WriteSBUS(bmDath) : WriteSBUS(bmDatL) : WriteSBUS(bsDath) : WriteSBUS(bsDatL) : WriteSBUS(bSregister)
IO_REG_STB = 1 : WaitUs 10 : IO_REG_STB = 0    'Update the Control Shift-Register, DAC tobe Update
Return 0
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Read Analog Board ADC Result Shift-Register
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function ReadADC() As Byte
Local myByte As Byte
Local i As Byte
myByte = 0
' Read 8bit = 1 Byte Result form ADC Shift-Out Register(2Wire Serial Bus ADC)
For i = 0 To 7
IO_ADC_CLK = 1
Rotate(Left,1,myByte)
myByte = myByte + IO_ADC_DAT
WaitUs 1
IO_ADC_CLK = 0
WaitUs 1
Next i
' Return 1 Byte Result to Function
Return myByte
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Read MCU Block Keyboard Status Shift-Register
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function ReadKey() As Byte
Local myByte As Byte
Local i As Byte
myByte = 0
' Read 8bit = 1 Byte Result form Keyboard Shift-Out Register(74HC165)
For i = 0 To 7
Rotate(Left,1,myByte)
myByte = myByte + IO_KEY_DAT
IO_KEY_CLK = 1
WaitUs 1
IO_KEY_CLK = 0
WaitUs 1
Next i
' Return 1 Byte Result to Function
myByte = Not myByte
Return myByte
End Function

lilith · 发表于 2015-6-23 18:54:55

第六节对电压、非线性进行计算的函数

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      'Mathematical Function
'///////////////////////////////////////////////////////////////////////////////////////////////////

'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' Setting the Analogboard DAC Output Voltage
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function SetVoltage(fVoltage As Float) As Byte
Local Vsetm As Word  ' The Master DAC Setting Return
Local Vsets As Word  ' The Slave  DAC Setting Return
Local mbMSB As Byte
Local mbLSB As Byte
Local sbMSB As Byte
Local sbLSB As Byte
' the VOut = Gain * (Vmaster * Rs + Vslave * Rm) / (Rm+Rs), Fullscale of the Vm = 5V and Vs = -5V, Gain = 2.5
fVtrn = fVoltage
fVtrn = fVtrn / fDACGain
fVset = fVtrn
'Get the MasteDAC Voltage Setting Value, Vm=[Vo*(Rm+Rs)+2.5*Rm]/Rs , at Default, the Slave DAC Output = -2.5V
fVtrn = (fVtrn * (fMResistance + fSResistance) + fDACenter * fMResistance) / fSResistance
fVtrn = fVtrn * 65535 / fDACReference    'The Master DAC(MAX541) is 16bit DAC, Fullscale = 2^16 = 65536
Vsetm = fVtrn
mbMSB = Msb(Vsetm)          'Split the Setting Word to two Byte, Get the MSB Byte
mbLSB = Vsetm - mbMSB * 256       'Split the Setting Word to two Byte, Get the LSB Byte
' Get the SlaveDAC Voltage Setting Value,Vs=[Vo*(Rm+Rs)-Vm*Rs]/Rm
fVtrn = Vsetm * fDACReference / 65535
fVtrn = 0 - ((fVset * (fMResistance + fSResistance) - fVtrn * fSResistance) / fMResistance)
fVtrn = fVtrn * 4096 / fDACReference    'The Slave DAC(MAX515) is 12bit DAC, Fullscale = 2^12 = 4096
Vsets = fVtrn
sbMSB = Msb(Vsets)          'Split the Setting Word to two Byte, Get the MSB Byte
sbLSB = Vsets - sbMSB * 256       'Split the Setting Word to two Byte, Get the LSB Byte
WriteDAC(mbMSB, mbLSB, sbMSB, sbLSB)
' Write the Setting to DAC
'Setp 1:
'bSregister = bSregister And &b00001111    'Hold the Analog Switch Status and Setting the DAC to Write Mode
'ShiftOut mbMSB;mbLSB;sbMSB;sbLSB;bSregister    'Write to Serial Bus
'WriteDAC(mbMSB) : WriteDAC(mbLSB) : WriteDAC(sbMSB) : WriteDAC(sbLSB) : WriteDAC(bSregister)
'IO_REG_STB = 1 : WaitUs 10 : IO_REG_STB = 0    'Update the Control Shift-Register, DAC tobe Write
'Setp 2:
'bSregister = bSregister + &b10000000    'Hold the Analog Switch Status and Setting the DAC to Update
'ShiftOut mbMSB;mbLSB;sbMSB;sbLSB;bSregister
'WriteDAC(mbMSB) : WriteDAC(mbLSB) : WriteDAC(sbMSB) : WriteDAC(sbLSB) : WriteDAC(bSregister)
'IO_REG_STB = 1 : WaitUs 10 : IO_REG_STB = 0    'Update the Control Shift-Register, DAC tobe Update
Return 0
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////
   ' ADC No-line Error Adjuest
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function Getinlerr(fVoltage As Float) As Float
fVtrn = fVoltage
fVset = fVtrn * fVtrn * Quadratic + fVtrn * Linear + Constant
'fVset = fVtrn * fVtrn * fVtrn * Cubic + fVtrn * fVtrn * Quadratic + fVtrn * Linear + Constant
Return fVset
End Function

lilith · 发表于 2015-6-23 18:55:43

第七节自检和侦错代码

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      'Self Test Code
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function Selftest() As Byte
Local iTestcode As Byte
iTestcode = 0
Charat = "Self Test......" : DrawChr(1,1)
Format(5,0)
' Check the Tempresult Sense(DS18b20)
IsTempresultSense = 1Wreset
If Not(IsTempresultSense) Then
Charat = ">TepSense not install" : DrawChr(1,2)
IsTempresultSense = 0
Else
Charat = ">TemperatureSense Chk" : DrawChr(1,2)
1Wwrite &hcc; &h44
WaitMs 500
1Wreset
1Wwrite &hcc; &hbe
1Wread dTempdatum ,2
1Wreset
1Wwrite &hcc; &h44
dTempresult = dTempdatum(0)
'Charat = Str(dTempresult) : DrawChr(156,2)
If dTempresult = 0 Then
  Charat = ">TemperatureSense Err" : DrawChr(1,2)
  IsTempresultSense = 0
  iTestcode = iTestcode Or &b00000001
Else
  Charat = ">Temperature Sense OK" : DrawChr(1,2)
  IsTempresultSense = 1
End If
End If
' Check the ADC(LTC2400)
'Charat = ">ADC Checked..." : DrawChr(1,3)
If IO_ADC_DAT = 1 Then
Charat = ">ADC Detect...Failed" : DrawChr(1,3)
iTestcode = iTestcode Or &b00000010
Else
SetChannel(GndOffset)
bADCResult(3) = ShiftIn : bADCResult(2) = ShiftIn : bADCResult(1) = ShiftIn : bADCResult(0) = ShiftIn
iBusystp = 0
For i = 1 To 200
  iBusystp = iBusystp + 1
  If IO_ADC_DAT = 0 Then Exit For
  WaitMs 1
Next i
If iBusystp < 155 Or iBusystp > 166 Then
  Charat = ">ADC ChK Failed" : DrawChr(1,3)
  Charat = Str(iBusystp) : DrawChr(94,3)
  iTestcode = iTestcode Or &b00000100
Else
  Charat = ">ADC Checked...Passed" : DrawChr(1,3)
  iError = ADCheck(Reference)       'Result = GND Offset < +10~-10 >
  If iError <> 0 Then
If iError > -10 And iError < 10 Then
Charat = ">COM Checked...Passed" : DrawChr(1,4)
Else
Charat = ">COM ChK Failed " : DrawChr(1,4)
Charat = Str(iError) : DrawChr(94,4)
iTestcode = iTestcode Or &b00001000
End If
  Else
Charat = ">COM Checked...Passed" : DrawChr(1,4)
  End If
  'Check the Reference
  Charat = ">Reference Chk:" : DrawChr(1,5)
  SetVoltage(0) : WaitMs 10
  iError = ADCheck(Synthesis)       'Result = Reference, Next is Synthesis Out Voltage <6500*1.024~7500*1.024 / 6655~7680>
  wError = iError * 25 / 8
  If wError > 6800 And wError < 7475 Then
Charat = ">REF Checked...Passed" : DrawChr(1,5)
  Else
Charat = Str(wError) : DrawChr(94,5)
iTestcode = iTestcode Or &b00010000
  End If
  'Check the DAC Offset
  Charat = ">DAC Check 1st." : DrawChr(1,6)
  WaitMs 200          'Wait the ADC to Converting...
  SetVoltage(12000000) : WaitMs 10    'Set Next Check Item = DAC Fullscale Out
  iError = ADCheck(Synthesis)       'Result = Synthesis Out Voltage(Set=0V) <+~-1>
  If iError <> 0 Then
If iError > -10 And iError < 10 Then
Charat = ">DAC Check 1st Passed" : DrawChr(1,6)
Else
Charat = Str(iError) : DrawChr(94,6)
iTestcode = iTestcode Or &b00100000
End If
  Else
Charat = ">DAC Check 1st Passed" : DrawChr(1,6)
  End If
  'Check the DAC Full Scale
  Charat = "2nd" : DrawChr(67,7)
  WaitMs 200
  'SetVoltage(0)
  iError = ADCheck(Synthesis)       'Result = Synthesis Out Voltage(Set=12V) <12282 +/- 10word, 12270~12295>
  wError = (iError / 2) * 25 / 4
  If wError > 12000 And wError < 12575 Then
Charat = "Passed" : DrawChr(91,7)
  Else
Charat = Str(wError) : DrawChr(94,7)
iTestcode = iTestcode Or &b01000000
  End If
End If
End If
Return iTestcode
End Function
Function Debug(iTestcode As Byte) As Byte
Format(5,0)
ClsKS(0)
Charat = "Debug Code    Result" : DrawChr(1,0)
Charat = " >REG 0x00" : DrawChr(1,1)
Charat = " >REG 0xFF" : DrawChr(1,2)
Charat = " >DAC 0000" : DrawChr(1,3)
Charat = " >DAC 8000" : DrawChr(1,4)
Charat = " >DAC FF00" : DrawChr(1,5)
Charat = " >DAC 0080" : DrawChr(1,6)
Charat = " >DAC 00FF" : DrawChr(1,7)
Do
  WriteSReg(0)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 1, 4)
  Wait 5
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 1, 4)

  WriteSReg(255)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 2, 4)
  Wait 5
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 2, 4)

  WriteDAC(&h00, &h00, &h00, &h00)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 3, 4)
  Wait 5
  iError = ADCheck(Synthesis)
  Charat = Str(iError) : DrawChr(94,3)
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 3, 4)

  WriteDAC(&h80, &h00, &h00, &h00)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 4, 4)
  Wait 5
  iError = ADCheck(Synthesis)
  Charat = Str(iError) : DrawChr(94,4)
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 4, 4)

  WriteDAC(&hFF, &hFF, &h00, &h00)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 5, 4)
  Wait 5
  iError = ADCheck(Synthesis)
  Charat = Str(iError) : DrawChr(94,5)
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 5, 4)

  WriteDAC(&h00, &h00, &h80, &h00)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 6, 4)
  Wait 5
  iError = ADCheck(Synthesis)
  Charat = Str(iError) : DrawChr(94,6)
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 6, 4)

  WriteDAC(&h00, &h00, &hFF, &hFF)
  MemLoad(VarPtr(iCursors), &b01111111, &b00111110, &b00011100, &b00001000) : DrawCursors(1, 7, 4)
  Wait 5
  iError = ADCheck(Synthesis)
  Charat = Str(iError) : DrawChr(94,7)
  MemLoad(VarPtr(iCursors), 0, 0, 0, 0) : DrawCursors(1, 7, 4)
Loop
End Function

lilith · 发表于 2015-6-23 18:56:28

第八节串口通讯（和程序结束）

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
      'INT Process
'///////////////////////////////////////////////////////////////////////////////////////////////////
Interrupt Urxc(),Save All
Local uVseth As Word
Local uVsetl As Word
'Local uMSBh As Byte
'Local uLSBh As Byte
'Local uMSBl As Byte
'Local uLSBl As Byte
Local bMSB As Byte
Local bLSB As Byte
Local bRebtype As Byte
Local bSett As Byte
InputBin tTxt
tCmd = Mid(tTxt, 1, 3)
If tCmd = "STV" Then
tm = Mid(tTxt,4,4)
uVseth = Val(tm)
tm = Mid(tTxt,8,4)
uVsetl = Val(tm)
fVtrn = uVseth
fVtrn = fVtrn * 10000
fVtrn = fVtrn + uVsetl
tm = Mid(tTxt,12,1)
bSett = Val(tm)
If bSett = 0 Then
   fSetting = fVtrn
   bUartset = 1
End If
If bSett = 1 Then
   fCalsacles = fVtrn
   bUartset = 1
End If
End If
If tCmd = "STS" Then
tm = Mid(tTxt,4,1)
If tm <> "x" Then bDigitaLoop = Val(tm)
tm = Mid(tTxt,12,1)
If tm <> "x" Then bRun = Val(tm)
tm = Mid(tTxt,11,1)
If tm <> "x" Then bRefsource = Val(tm)
bUartset = 2
End If
If tCmd = "REB" Then
tm = Mid(tTxt,4,1)
bRebtype = Val(tm)
Select Case bRebtype
      Case 0 ' Readback Measure Value(0-?)
      Case 8 ' Readback Cal
      Case 9 ' Readback Setting Status
End Select
End If

Enable Interrupts
End Interrupt
Interrupt Int0(), Save 0
iKeypress = 1
Enable Interrupts
End Interrupt
$Include "inc\k12864drv.bas"
$Include "inc\font1.bas"
$Include "inc\font2.bas"

lilith · 发表于 2015-6-23 18:57:09

第九节液晶屏驱动

'///////////////////////////////////////////////////////////////////////////////////////////////////
      'Screen Drive
'///////////////////////////////////////////////////////////////////////////////////////////////////
Function SetKS(Code As Byte, Channel As Byte) As Byte ' 写指令函数
IO_SCR_DAT = Code
Select Case Channel       ' PA3 和 PA4 组合决定使用屏的区域，19264 有三个 64x64 区域
   Case 1 : IO_SCR_CSB = 0 : IO_SCR_CSA = 1
   Case 2 : IO_SCR_CSB = 1 : IO_SCR_CSA = 0
   'Case 3 : IO_SCR_CSB = 0 : IO_SCR_CSA = 1
End Select
IO_SCR_RoW = 0          ' 设置为写状态 (0=Write，1=Read)
IO_SCR_DoI = 0          ' 设置为指令状态 (0=指令，1=数据)
IO_SCR_STB = 1 : WaitUs 1 : IO_SCR_STB = 0 : WaitUs 1 ' 在 En 的上升沿，指令或数据进入屏幕
Return 0
End Function
Function WriteKS(Code As Byte, Channel As Byte) As Byte ' 写指令函数
IO_SCR_DAT = Code
Select Case Channel       ' PA3 和 PA4 组合决定使用屏的区域，19264 有三个 64x64 区域
   Case 1 : IO_SCR_CSB = 0 : IO_SCR_CSA = 1
   Case 2 : IO_SCR_CSB = 1 : IO_SCR_CSA = 0
   'Case 3 : IO_SCR_CSB = 0 : IO_SCR_CSA = 1
End Select
IO_SCR_RoW = 0
IO_SCR_DoI = 1          ' 设置为数据状态 (0=指令，1=数据)
IO_SCR_STB = 1 : WaitUs 1 : IO_SCR_STB = 0 : WaitUs 1
Return 0
End Function
Function InitKS() As Byte
Local iC As Byte
ResetKS()
For iC = 1 To 3
SetKS(&hc0, iC)       ' 向屏幕的三个控制 IC 写入初始化和开显示的指令
SetKS(&h3f, iC)
Next iC
Return 0
End Function
Function ResetKS() As Byte       ' 给屏幕完成上电脉冲，可用一个硬件电路来完成
IO_SCR_RST = 0
WaitMs 200
IO_SCR_RST = 1
End Function
Function ClsKS(GRAM As Byte) As Byte    ' 清屏函数，给整个屏幕清除显示
Local iP As Byte
Local iQ As Byte
Local iC As Byte
For iC = 1 To 3
For iP = 0 To 7
      For iQ = 0 To 63
         SetKS(&hB8 + iP, iC)    ' 设置显存开始写数据的页地址
         SetKS(&h40 + iQ, iC)    ' 设置显存开始写数据的行地址
         WriteKS(GRAM, iC)    ' 写入一个 8bit 的显存数据
      Next iQ
Next iP
Next iC
Return 0
End Function
Function DrawPix(x As Byte, y As Byte) As Byte ' 在屏幕上绘制一个点
Local xAdd As Byte
Local xChip As Byte
Local yAdd As Byte
Local yCode As Byte
Local yPage As Byte
Local iStep As Byte
yCode = 1
xChip = ((x-1)/64)+1       ' 因为屏幕是3个 64pix 区域，所以需要根据横坐标决定实际上位于哪个控制 IC 的显存的行地址
xAdd = x mod 64
If xAdd = 0 Then
xAdd = 63
Else
xAdd = xAdd - 1
End If
yPage = (y-1)/8          ' KS0108 的纵坐标是 8 页每页 8 个点，据此找到页地址
yAdd = y mod 8
If yAdd = 0 Then yAdd = 8
For iStep = 1 To yAdd - 1
yCode = yCode * 2
Next iStep
If yAdd = 1 Then yCode = 1
SetKS(&hB8 + yPage, xChip)       ' 设置显存开始写数据的页地址
SetKS(&h40 + xAdd, xChip)       ' 设置显存开始写数据的行地址
WriteKS(yCode, xChip)
Return 0
End Function
Function DrawPage(x As Byte, Page As Byte, Code As Byte) As Byte
Local xAdd As Byte       ' 显存一次写入整页的函数
Local xChip As Byte
xChip = ((x-1)/64)+1
xAdd = x mod 64
If xAdd = 0 Then
xAdd = 63
Else
xAdd = xAdd - 1
End If
SetKS(&hB8 + Page, xChip)
SetKS(&h40 + xAdd, xChip)
WriteKS(Code, xChip)
Return 0
End Function
Function DrawChr(x As Byte, Page As Byte) As Byte  ' 显示一行字符，必须是码表中存在的标准 ASCII 字符
Local is As Byte
Local iLs As Byte
Local iFn As Byte
Local iChn As Byte
Local bChr As Byte
Local xAdd As Byte
xAdd = 0
iLs = Len(Charat)
For is = 1 To iLs
bChr = Asc(Mid(Charat,is,1)) - 32    ' 根据每一个字符的 ASCII 马，在码表数组中找到对应的数据，一个字符是 5x8 点的 5 个 Byte 数据
For iFn = 0 To 4
      iChn = Ft1(bChr * 5 + iFn)
      DrawPage(x+xAdd,Page,iChn)    ' 将每一个字符对应的这 5 个 Byte 写到显存
      xAdd = xAdd + 1
Next iFn
xAdd = xAdd + 1
Next is
Return 0
End Function
Function DrawChrLarge(x As Byte, Page As Byte) As Byte  ' 显示一行字符，必须是码表中存在的标准 ASCII 字符
Local is As Byte
Local iLs As Byte
Local iFn As Byte
Local iChn As Byte
Local bChr As Byte
Local xAdd As Byte
xAdd = 0
iLs = Len(Charat)
For is = 1 To iLs
bChr = Asc(Mid(Charat,is,1)) - 32    ' 根据每一个字符的 ASCII 马，在码表数组中找到对应的数据，一个字符是 6x16 点的 ? 个 Byte 数据
For iFn = 0 To 11
      iChn = Ft2(bChr * 12 + iFn)
      If iFn < 6 Then
         DrawPage(x+xAdd,Page,iChn)    ' 将每一个字符对应的这 5 个 Byte 写到显存
      Else
         DrawPage(x+xAdd-6,Page + 1,iChn)
      End If
      xAdd = xAdd + 1
Next iFn
xAdd = xAdd - 6
xAdd = xAdd + 1
Next is
Return 0
End Function

lbk32 · 发表于 2015-6-23 20:29:55

本帖最后由 lbk32 于 2015-6-23 20:31 编辑

顶楼主，楼主牛叉啊！basic语言，MGD！

{:142_381:}{:142_381:}！要是换成keil C可能不错哦，建议哦。

i6950 · 发表于 2015-6-23 21:11:14

顶LZ，感谢分享！

mapleft · 发表于 2015-6-23 21:23:09

我的妈呀，用BASIC 写的

zhikai_wu · 发表于 2015-6-23 21:45:55

太好的，顶一下

marshallemon · 发表于 2015-6-23 21:47:34

没有工程管理感觉有些痛苦，这么多模块全部放在同一个bas文件中？

lilith · 发表于 2015-6-23 22:06:34

marshallemon 发表于 2015-6-23 21:47
没有工程管理感觉有些痛苦，这么多模块全部放在同一个bas文件中？

是啊，这个编译器很弱的，不像 Visual Studio 那样可以方便分成多个模块一起编译

虽然有 include，但 inc 进去的文件在 IDE 中修改后如果不保存为文件，编译主程序的时候是不会编译进去的，所以只有相对固定的自检、侦错、屏幕驱动和软字体我 inc 了，其它可能经常修改的代码就通通扔到主程序中，经常上下翻找某条语句翻得头大如斗

zhikai_wu · 发表于 2015-6-23 22:25:09

能讲解一下“第六节对电压、非线性进行计算的函数”，因为代码实在看不懂

songjiao · 发表于 2015-6-23 22:39:42

lilith 发表于 2015-6-23 22:06
是啊，这个编译器很弱的，不像 Visual Studio 那样可以方便分成多个模块一起编译虽然有 i ...

我拍了套件，向MCU中烧录程序需要专门的硬件工具吗？如果需要，那就请你代我烧录好吗？

zw1235 · 发表于 2015-6-23 23:08:14

真正开源代码，向楼主致敬！

lilith · 发表于 2015-6-24 00:50:45

songjiao 发表于 2015-6-23 22:39
我拍了套件，向MCU中烧录程序需要专门的硬件工具吗？如果需要，那就请你代我烧录好吗？

是的，我用的是 ATMEL（爱特梅尔）的 Mega 系列 AVR 单片机（ATMega32），因此需要 AVR 单片机的烧写工具，一些廉价的工具也可以使用，但建议使用 STK500 兼容的山寨烧录器（原版很贵没有必要，山寨的 50 软妹左右），这种烧录器一般不容易因为误操作烧死芯片，比较安全。

建议自备烧录工具，因为此硬件的固件会有诸多更新，我当然可以代为烧录*，但考虑到新固件带来的性能提升，还是建议自备烧录器。

*我没有 QPF44 插座，所以如需代烧录固件，单片机和烧录端口（以及调试供电待用的 1Wbus 端口）必须预先焊接，我的焊接水平...

38hot_321 · 发表于 2015-6-24 08:41:44

lilith 发表于 2015-6-24 00:50
是的，我用的是 ATMEL（爱特梅尔）的 Mega 系列 AVR 单片机（ATMega32），因此需要 AVR 单片机的烧写 ...

有源程序可以各种折腾了。有时间我这个菜鸟看能不能转成C的。

topv · 发表于 2015-6-24 13:43:11

支持楼主了，辛苦！

keywod · 发表于 2015-6-24 14:33:41

调整需要键盘吧？用记事本打开程序也有按键定义。请问编译器能用别的替代么？

jdgtx · 发表于 2015-6-24 16:55:31

看来一下，源程序都已经编译好了，直接下载就行了，感谢lilith大神！上位机程序什么时间放出？另外不知能否放一份能够供打印的原理图，比如PDF格式什么的，这样调试时方便些。

lilith · 发表于 2015-6-25 14:55:31

keywod 发表于 2015-6-24 14:33
调整需要键盘吧？用记事本打开程序也有按键定义。请问编译器能用别的替代么？

除非你改写成其它语言，否则只能用 FastAVR

FastAVR.part1.rar (1 MB, 下载次数: 131)

FastAVR.part2.rar (1 MB, 下载次数: 116)

FastAVR.part3.rar (935.15 KB, 下载次数: 132)

lilith · 发表于 2015-6-25 14:56:56

jdgtx 发表于 2015-6-24 16:55
看来一下，源程序都已经编译好了，直接下载就行了，感谢lilith大神！上位机程序什么时间放出？另外不知能否 ...

上位机程序

Voltgen.zip (16.48 KB, 下载次数: 109)

源代码

Imports System.IO
Public Class Voltagegen
Dim eEvent As String
Dim tMessage As String
Dim PortState As Boolean
Dim lVoltageSettingValue As Long
Dim tVoltgteSettingValue As String
Shared fLog As IO.StreamWriter
Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
      SerialPort1.Close()
      fLog.Flush()
      fLog.Close()
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      lVoltageSettingValue = 9900000
      For Each sp As String In My.Computer.Ports.SerialPortNames
         ComboBox1.Items.Add(sp)
      Next
      PortState = False
      ComboBox1.SelectedIndex = 0
      'SerialPort1.Open()
      'SerialPort1.DtrEnable = False
      SmLength.Items.Add("4 点平滑滤波")
      SmLength.Items.Add("8 点平滑滤波")
      SmLength.Items.Add("16 点平滑滤波")
      SmLength.Items.Add("32 点平滑滤波")
      SmLength.Items.Add("64 点平滑滤波")
      SmLength.SelectedIndex = 2
      fLog = IO.File.AppendText(Application.StartupPath & "\Record.txt")
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
      If PortState = False Then
         SerialPort1.PortName = ComboBox1.SelectedItem
         Label1.Text = "当前连接端口：" & ComboBox1.SelectedItem
         SerialPort1.Open()
         Button1.Text = "断开(&D)"
         PortState = True
         CommRTSLab.Text = SerialPort1.RtsEnable
         CommDTRLab.Text = SerialPort1.DtrEnable
      Else
         SerialPort1.Close()
         Button1.Text = "连接(&C)"
         PortState = False
         Label1.Text = "尚未连接"
      End If
End Sub
Private Sub ButtSed_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtSed.Click
      SerialPort1.WriteLine(Ctrlcmd.Text & vbCrLf)
End Sub
Private Sub ReceiveUart(ByVal sender As System.Object, ByVal e As System.EventArgs)
      Dim dReback As Double = 0, dTemperature As Double = 0, dError As Double = 0
      ' MsgBox(Mid(tMessage, InStr(tMessage, "#CSYN=$") + 8, 13))
      'dReback = CDbl(Mid(tMessage, InStr(tMessage, "#CSYN=$") + 8, 13))
      'dError = CDbl(Mid(tMessage, InStr(tMessage, "#CERR=$") + 8, 13))
      'dTemperature = CDbl(Mid(tMessage, InStr(tMessage, "#TEMP=$") + 8, 13))
      'RebackLab.Text = "回读值：" & FormatNumber(dReback, 6) & " VDC；设置误差：" & FormatNumber(dError, 1) & " uV；当前温度：" & FormatNumber(dTemperature, 1) & " 摄氏度。"
      Rxinfo.AppendText(tMessage & vbCrLf)
      Rxinfo.ScrollToCaret()
      fLog.WriteLine(Now & " " & tMessage)
      fLog.Flush()
End Sub
Private Sub SerialPort1_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived
      'Dim tRC() As String, dResult As Double
      tMessage = Trim(SerialPort1.ReadLine())
      Me.Invoke(New EventHandler(AddressOf ReceiveUart))
End Sub
Private Sub CommDTR_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CommDTR.Click
      SerialPort1.DtrEnable = Not SerialPort1.DtrEnable
      CommDTRLab.Text = SerialPort1.DtrEnable
End Sub
Private Sub CommRTS_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CommRTS.Click
      SerialPort1.RtsEnable = Not SerialPort1.RtsEnable
      CommRTSLab.Text = SerialPort1.RtsEnable
End Sub
Private Sub nStvSlah_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nStvSlah.ValueChanged
      If nStvMaster.Value = 10 Then nStvSlah.Maximum = 10 Else nStvSlah.Maximum = 999
      lVoltageSettingValue = CLng(nStvMaster.Value) * 1000000 + CLng(nStvSlah.Value) * 1000 + CLng(nStvSlal.Value)
      tVoltgteSettingValue = Replace(Format(lVoltageSettingValue, "00,000,000"), ",", ".", 1, 1)
      lbVoltSetting.Text = "设置值：" & tVoltgteSettingValue
End Sub
Private Sub nStvMaster_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nStvMaster.ValueChanged
      If nStvMaster.Value = 10 Then nStvSlah.Maximum = 10 Else nStvSlah.Maximum = 999
      lVoltageSettingValue = CLng(nStvMaster.Value) * 1000000 + CLng(nStvSlah.Value) * 1000 + CLng(nStvSlal.Value)
      tVoltgteSettingValue = Replace(Format(lVoltageSettingValue, "00,000,000"), ",", ".", 1, 1)
      lbVoltSetting.Text = "设置值：" & tVoltgteSettingValue
End Sub
Private Sub nStvSlal_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles nStvSlal.ValueChanged
      lVoltageSettingValue = CLng(nStvMaster.Value) * 1000000 + CLng(nStvSlah.Value) * 1000 + CLng(nStvSlal.Value)
      tVoltgteSettingValue = Replace(Format(lVoltageSettingValue, "00,000,000"), ",", ".", 1, 1)
      lbVoltSetting.Text = "设置值：" & tVoltgteSettingValue
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
      lVoltageSettingValue = CLng(nStvMaster.Value) * 1000000 + CLng(nStvSlah.Value) * 1000 + CLng(nStvSlal.Value)
      tVoltgteSettingValue = Format(lVoltageSettingValue, "00000000")
      tVoltgteSettingValue = "STV" & tVoltgteSettingValue & "0"
      'MsgBox(tVoltgteSettingValue)
      SerialPort1.WriteLine(tVoltgteSettingValue & vbCrLf)
      lbVoltSettbef.Text = lbVoltSetting.Text
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
      Dim tSettcmd As String = "STSabb00dd0x"
      Dim ttHreshold As String = ""
      If Loopclose.Checked Then
         tSettcmd = Replace(tSettcmd, "a", "1")
      Else
         tSettcmd = Replace(tSettcmd, "a", "0")
      End If
      Select Case SmLength.SelectedIndex
         Case 0 : tSettcmd = Replace(tSettcmd, "bb", "04")
         Case 1 : tSettcmd = Replace(tSettcmd, "bb", "08")
         Case 2 : tSettcmd = Replace(tSettcmd, "bb", "16")
         Case 3 : tSettcmd = Replace(tSettcmd, "bb", "32")
         Case 4 : tSettcmd = Replace(tSettcmd, "bb", "64")
      End Select
      ttHreshold = tHreshold.Text
      If Math.Abs(CInt(ttHreshold)) < 10 Then ttHreshold = "0" & Trim(CStr(Math.Abs(CInt(ttHreshold)))) Else ttHreshold = Trim(CStr(Math.Abs(CInt(ttHreshold))))
      tSettcmd = Replace(tSettcmd, "dd", ttHreshold)
      'MsgBox(tSettcmd)
      SerialPort1.WriteLine(tSettcmd & vbCrLf)
      'If Loopclose.Checked Then
      'SerialPort1.WriteLine("STS10000000x" & vbCrLf)
      'Else
      'SerialPort1.WriteLine("STS00000000x" & vbCrLf)
      'End If
End Sub
Private Sub Buttrun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttrun.Click
      If Buttrun.Text = "Stop" Then
         SerialPort1.WriteLine("STSx00000000" & vbCrLf)
         Buttrun.Text = "Run"
      Else
         SerialPort1.WriteLine("STSx00000001" & vbCrLf)
         Buttrun.Text = "Stop"
      End If
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
      SerialPort1.WriteLine("STSx0000000x" & vbCrLf)
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
      SerialPort1.WriteLine("STSx0000001x" & vbCrLf)
End Sub
Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
      SerialPort1.WriteLine("STSx0000002x" & vbCrLf)
End Sub
Private Sub bt_SetPwm_Click(sender As Object, e As EventArgs) Handles bt_SetPwm.Click
      Dim tChannel As String = "0"
      If rb_Pwmaster.Checked = True Then
         lVoltageSettingValue = CLng(nb_PAMSB.Value) * 10000 + CLng(nb_PALSB.Value)
         tChannel = "1"
      Else
         lVoltageSettingValue = CLng(nb_PBMSB.Value) * 10000 + CLng(nb_PBLSB.Value)
         tChannel = "2"
      End If
      tVoltgteSettingValue = Format(lVoltageSettingValue, "00000000")
      tVoltgteSettingValue = "PWM" & tVoltgteSettingValue & tChannel
      'MsgBox(tVoltgteSettingValue)
      SerialPort1.WriteLine(tVoltgteSettingValue & vbCrLf)
End Sub
Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
      SerialPort1.WriteLine("abc" & vbCrLf & Chr(0))
End Sub
End Class

lilith · 发表于 2015-6-25 15:01:36

jdgtx 发表于 2015-6-24 16:55
看来一下，源程序都已经编译好了，直接下载就行了，感谢lilith大神！上位机程序什么时间放出？另外不知能否 ...

电路图是用 bSCH 绘制的，我不知道怎么转 PDF，建议直接用 bSCH 打开，方便放大观察，如果用 Win8 平板还可以在工作台上随时对着呢

Voltgen.rar (253.8 KB, 下载次数: 120)

bSCH：
http://www.suigyodo.com/online/schsoft.htm

jdgtx · 发表于 2015-6-25 15:52:18

lilith 发表于 2015-6-25 15:01
电路图是用 bSCH 绘制的，我不知道怎么转 PDF，建议直接用 bSCH 打开，方便放大观察，如果用 Win8 平板 ...

lilith，鬼文看不懂哦，试着下了两文件，但是不能运行。能传给我一份吗？或者告我下载哪个文件也可。多谢！

38hot_321 · 发表于 2015-6-25 16:01:33

lilith 发表于 2015-6-25 15:01
电路图是用 bSCH 绘制的，我不知道怎么转 PDF，建议直接用 bSCH 打开，方便放大观察，如果用 Win8 平板 ...

有PDF打印机的话，可以直接打印成PDF

账号		自动登录	找回密码
密码			立即注册

[资料]6 位半电压源 Voltgen V1.0 源程序

相关帖子