کد:
$regfile = "m323def.dat"
$crystal = 16000000
$lib "glcdKS108.lib"
Config Graphlcd = 128 * 64sed , Dataport = Porta , Controlport = Portc , Ce = 0 , Ce2 = 1 , Cd = 4 , Rd = 3 , Reset = 2 , Enable = 5
$include "font8x8.font"
Setfont Font8x8
Config Keyboard = Pind.2 , Data = Pind.4 , Keydata = Keydata
Dim Key As Byte , A As Byte , B As Byte , S As Bit , N As Bit
Dim Op As String * 5 , Op2 As String * 1
Dim K As Byte , Ans As Single , F1 As Single , F2 As Single , F3 As Single
Dim In1(8) As Byte , I1 As Byte
Dim In2(8) As Byte , I2 As Byte , Stn(9) As Long
Stn(1) = 1 : Stn(2) = 10 : Stn(3) = 100 : Stn(4) = 1000 : Stn(5) = 10000
Stn(6) = 100000 : Stn(7) = 1000000 : Stn(8) = 10000000
'+++++++++++++++++++++++ mani program ++++++++++++++++++++++++++++++++++++++++++
Start_new:
I1 = 0 : I2 = 0 : S = 0 : N = 0
Cls : Lcdat 1 , 1 , "0"
Do
Op = ""
Gosub Set_number1
If S = 1 Then Goto Start_new 'check for reset
Cls
Gosub Set_number2
If S = 1 Then Goto Start_new 'check for reset
Gosub Functions
Lcdat 2 , 1 , "ANS=" ; Ans
Do
K = Getatkbd()
Loop Until K <> 0
Goto Start_new
Loop
End 'end program
'+++++++++++++++++++++++ 4 Function ++++++++++++++++++++++++++++++++++++++++++++
Functions:
If Op2 = "+" Then Ans = F1 + F2
If Op2 = "-" Then Ans = F1 - F2
If Op2 = "*" Then Ans = F1 * F2
If Op2 = "/" Then Ans = F1 / F2
If Op2 = "Sin" Then Ans = Sin(f1)
If Op2 = "Cos" Then Ans = Cos(f1)
If Op2 = "Tan" Then Ans = Tan(f1)
If Op2 = "Asin" Then Ans = Asin(f1)
Return
'+++++++++++++++++++++++ Functions +++++++++++++++++++++++++++++++++++++++++++++
Keycod:
Do
K = Getatkbd()
Select Case K
Case 48 : Key = 0
Case 49 : Key = 1
Case 50 : Key = 2
Case 51 : Key = 3
Case 52 : Key = 4
Case 53 : Key = 5
Case 54 : Key = 6
Case 55 : Key = 7
Case 56 : Key = 8
Case 57 : Key = 9
Case 27 : Op = "c"
Case 13 : Op = "="
Case 47 : Op = "/"
Case 42 : Op = "*"
Case 45 : Op = "-"
Case 43 : Op = "+"
Case 83 : Op = "Sin"
Case 67 : Op = "Cos"
Case 84 : Op = "Tan"
End Select
Loop Until K <> 0
Do
K = Getatkbd()
Loop Until K = 0
K = 0
Return
'##############################################################################
Set_number1:
I1 = 0 : F3 = 0 : F1 = 0
Do
Gosub Keycod
If Ans = 0 And Op = "-" And N = 0 Then 'check for input negative namber
N = 1 : Op = ""
Lcd "-"
Goto End_action
End If
If I1 = 0 Then
'================================= 'check for functions and old ans EXP: ans+2=
If Op = "+" Or Op = "-" Or Op = "/" Or Op = "*" Then
F1 = Ans
Goto No_c
End If
End If
If Op = "c" Then
S = 1 'set s for check status
Cls
Goto No_c 'clear and goto start
End If
If Op = "+" Or Op = "-" Or Op = "/" Or Op = "*" Or Op = "=" Then Goto Lable1 'jump if not key
If I1 < 8 Then
Incr I1
In1(i1) = Key 'copy key to array
Lcd In1(i1) 'display key
End If
End_action:
Loop
Lable1:
B = I1
For A = 1 To B Step 1 'change numbers to long nubmer
F3 = In1(a) * Stn(i1)
F1 = F1 + F3
Decr I1
Next
If N = 1 Then F1 = F1 * -1 'negative number
N = 0
No_c:
Op2 = Op
If Op = "=" Then Op2 = ""
Return
'##############################################################################
Set_number2:
I2 = 0 : F3 = 0 : F2 = 0 : Op = ""
Lcd F1 ; Op2
Do
Gosub Keycod
If Op = "c" Then
S = 1 'set s for check status
Cls
Goto No_c2 'clear and goto start
End If
If Op = "+" Or Op = "-" Or Op = "/" Or Op = "*" Or Op = "=" Then Goto Lable2 'jump if not key
If I2 < 8 Then
Incr I2
In2(i2) = Key 'copy key to array
Lcd In2(i2) 'display key
End If
Loop
Lable2:
B = I2
For A = 1 To B Step 1
F3 = In2(a) * Stn(i2)
F2 = F2 + F3
Decr I2
Next
No_c2:
Return
Keydata:
'normal keys lower case
Data 0 , 0 , 0 , 0 , 0 , 130 , 0 , 129 , 0 , 0 , 0 , 0 , 0 , 9 , 0 , 0
Data 0 , 0 , 0 , 0 , 128 , 81 , 49 , 0 , 0 , 0 , 90 , 83 , 65 , 87 , 50 , 0
Data 0 , 67 , 88 , 68 , 69 , 52 , 51 , 0 , 0 , 32 , 86 , 70 , 84 , 82 , 53 , 0
Data 0 , 78 , 66 , 72 , 71 , 89 , 54 , 0 , 0 , 76 , 77 , 74 , 85 , 55 , 56 , 0
Data 0 , 44 , 75 , 73 , 79 , 48 , 57 , 0 , 0 , 46 , 47 , 76 , 59 , 80 , 45 , 0
Data 0 , 0 , 39 , 0 , 91 , 61 , 57 , 0 , 0 , 0 , 13 , 93 , 0 , 92 , 0 , 0
Data 0 , 62 , 0 , 0 , 0 , 8 , 223 , 0 , 49 , 49 , 52 , 52 , 55 , 0 , 0 , 0
Data 48 , 46 , 50 , 53 , 54 , 56 , 27 , 0 , 0 , 43 , 51 , 45 , 42 , 57 , 0 , 0
'shifted keys UPPER case
Data 0 , 0 , 0 , 0 , 0 , 130 , 0 , 129 , 0 , 0 , 0 , 0 , 0 , 9 , 0 , 0
Data 0 , 0 , 0 , 0 , 128 , 81 , 33 , 0 , 0 , 0 , 90 , 83 , 65 , 87 , 64 , 0
Data 0 , 67 , 88 , 68 , 69 , 36 , 35 , 0 , 0 , 0 , 86 , 70 , 84 , 82 , 37 , 0
Data 0 , 78 , 66 , 72 , 71 , 89 , 94 , 0 , 0 , 0 , 77 , 74 , 85 , 38 , 42 , 0
Data 0 , 60 , 75 , 73 , 79 , 41 , 40 , 0 , 0 , 62 , 63 , 76 , 58 , 80 , 95 , 0
Data 0 , 0 , 34 , 0 , 123 , 43 , 0 , 0 , 0 , 0 , 0 , 125 , 0 , 124 , 0 , 0
Data 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
Data 0 , 46 , 0 , 0 , 0 , 0 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
صفحه اصلی
انجمن
جستجو
فهرست اعضا
افزونه های فایرفاکس
» 
تشکر شده توسط :
