VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 4529|回复: 2

[原创] [发布源码] 无控件计算器,可运行在 Ubuntu-Wine

[复制链接]
 楼主| 发表于 2012-6-14 16:50:23 | 显示全部楼层 |阅读模式
本帖最后由 Igawk 于 2012-6-15 00:27 编辑

无控件计算器,可运行在 Ubuntu-Wine。
精雕细琢,可以拉伸,欢迎测试。

4353233j.jpg

346342.gif

calc.zip (11.89 KB, 下载次数: 772)

点评

EXE 已更新!  发表于 2012-6-15 00:24
就不用花那个力气搞科学版啦,也没人会真用它  发表于 2012-6-14 21:02
你们编的计算器都不是科学版的啊……  发表于 2012-6-14 17:15
发表于 2012-6-14 20:37:08 | 显示全部楼层
左上角的图标,VB写的么,怎么才能在ubuntu上面跑?

点评

Windows vb编译的。  发表于 2012-6-14 21:06
先装一个 Wine  发表于 2012-6-14 21:03
回复 支持 反对

使用道具 举报

 楼主| 发表于 2012-6-14 22:25:25 | 显示全部楼层
源码:

  1. '不用除Form外任何控件的计算器
  2. '
  3. 'Igawk, 2012年6月
  4. '
  5. Option Explicit

  6. Private Type tButton
  7.     x1 As Integer
  8.     y1 As Integer
  9.     xw As Integer
  10.     yw As Integer
  11.     fs As Single
  12.     co As Long
  13.     ch2 As String * 1
  14.     ch As String
  15. End Type

  16. Const Pi As Double = 3.14159265358979
  17. Const sOper = "+-*/"

  18. Dim mWide As Long, mHeight As Long, ifac As Long
  19. Dim Buttons(30) As tButton, Nbuttons As Long, CurrButt&, Bstate&
  20. Public Disp As String


  21. '过程和函数
  22. Private Sub RegistButton(x1&, y1&, x2&, y2&, icol&, fs&, c2$, cap$)
  23.     Nbuttons = Nbuttons + 1
  24.     With Buttons(Nbuttons)
  25.         .ch = cap: .fs = fs: .ch2 = c2: .co = icol
  26.         .x1 = x1: .y1 = y1: .xw = x2: .yw = y2
  27.     End With
  28. End Sub

  29. Private Sub locate(x%, y%)
  30.     CurrentX = x
  31.     CurrentY = y
  32. End Sub

  33. Private Sub PaintButton(iButt&, Optional ByVal State As Integer = 0)
  34.     '绘制按钮
  35.     Dim y&, x1&, x2&, y1&, y2&, ico&, cap$, fs&
  36.     With Buttons(iButt)
  37.         cap = .ch: fs = .fs: ico = .co
  38.         x1 = .x1: y1 = .y1: x2 = .xw + x1: y2 = .yw + y1
  39.     End With
  40.     ' Button#0, 显示X
  41.     If iButt = 0 Then
  42.         ForeColor = ico
  43.         Font.Bold = True
  44.         With Buttons(0)
  45.             Line (x1, y1)-(x2, y2), &HFFE8C0, BF
  46.             Line (x1, y1)-(x2, y1), &H808080
  47.             Line -(x2, y2), &H808080
  48.             Line -(x1, y2), &HFFFFFF
  49.             Line -(x1, y1), &HFFFFFF
  50.             Font.Size = fs
  51.             Font.Name = "宋体"
  52.             locate x2 - TextWidth(Disp) - 4, (y1 + y2) / 2 - TextHeight(Disp) / 2
  53.             Print Disp;
  54.             If KMem Then
  55.                 Font.Bold = False: Font.Name = "Courier New"
  56.                 ForeColor = &H408040
  57.                 locate x1 + 3, y1 + 2
  58.                 Font.Size = IIf(.yw / 3 < 8, 8, .yw / 3)
  59.                 Print "M";
  60.             End If
  61.         End With
  62.         Exit Sub
  63.     End If
  64.     ' 按钮重绘
  65.     '
  66.     Font.Name = "Courier New"
  67.     Font.Bold = True
  68.     DrawWidth = 1
  69.     For y = y1 + 1 To y2 - 1
  70.         If State = 0 Then
  71.             Line (x1 + 1, y)-(x2 - 1, y), Int((100 + 155 * (y2 - y) / (y2 - y1))) * &H10101, B
  72.         ElseIf State = 1 Then
  73.             Line (x1 + 1, y)-(x2 - 1, y), Int((25 + 38 * (y2 - y) / (y2 - y1))) * &H30404, B
  74.         Else
  75.             Line (x1 + 1, y)-(x2 - 1, y), Int((63 - 38 * (y2 - y) / (y2 - y1))) * &H30404, B
  76.         End If
  77.     Next
  78.     '
  79.     ForeColor = &H804040
  80.     Line (x1 + 3, y1)-(x2 - 3, y1): Line -(x2, y1 + 3)
  81.     Line -(x2, y2 - 3): Line -(x2 - 3, y2): Line -(x1 + 3, y2)
  82.     Line -(x1, y2 - 3): Line -(x1, y1 + 3): Line -(x1 + 3, y1)
  83.     '
  84.     Font.Size = fs
  85.     ForeColor = IIf(State = 0, ico, IIf(State = 1, &H80F0C0, &H40D0FF))
  86.     locate (x2 - x1 - TextWidth(cap)) / 2 + x1, (y2 - y1 - TextHeight(cap)) / 2 + y1
  87.     Print cap;

  88.     Bstate = State
  89. End Sub

  90. Private Sub RePaint()
  91.     '屏幕重绘
  92.     Dim iX As Integer, iY As Integer, i&
  93.     Cls
  94.     '
  95.     For i = 1 To Nbuttons
  96.         PaintButton i, 0
  97.     Next i
  98.     '
  99.     Font.Bold = False
  100.     Font.Name = "隶书"
  101.     Font.Size = Buttons(1).fs * 1.5
  102.     i = (mWide - TextWidth("计 算 器")) / 2
  103.     ForeColor = &H3080B0: locate i + 0, 20: Print "计 算 器";
  104.     locate mWide - 90, mHeight - 12
  105.     Font.Size = 9: Font.Bold = False
  106.     ForeColor = &HC0
  107.     Print "Igawk 2012.6"
  108.     '
  109.     PaintButton 0, 0
  110. End Sub

  111. '操作响应
  112. Private Sub bKeys(ByVal iAsc As Integer)
  113.     Dim ch As String
  114.     '计算分支
  115.     If iAsc = 8 Or iAsc = 27 Then ch = "c" Else ch = Chr(iAsc)
  116.     Select Case ch
  117.     Case "c": OpCancel                      '[AC]
  118.     Case "0" To "9": OpNumbers iAsc - 48    '数字
  119.     Case ".": OpDecimal                     '点[.]
  120.     Case "_": OpNeg                         ' 负数
  121.     Case "+", "-", "*", "/"                 '+-*/
  122.         OpOperators InStr(sOper, ch) - 1
  123.     Case "x": OpFunction 3                  '倒数
  124.     Case "q": OpFunction 0                  '开根号
  125.     Case "=", Chr(13): OpEqual              '等号
  126.     Case "m": OpMc                          'MC
  127.     Case "r": OpMr                          'MR
  128.     Case "p": OpMp                          'MP
  129.     Case "s": OpMs                          'MS
  130.     Case Else
  131.     End Select
  132.     PaintButton 0, 0
  133. End Sub

  134. '事件
  135. Private Sub Form_KeyPress(KeyAscii As Integer)
  136.     bKeys KeyAscii
  137. End Sub

  138. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  139.     If CurrButt = 0 Then Exit Sub
  140.     If Button = 1 Then PaintButton CurrButt, 2
  141. End Sub

  142. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  143.     '计算鼠标位置和按键关系
  144.     Dim i&, A&
  145.     '
  146.     For i = 1 To Nbuttons
  147.         With Buttons(i)
  148.             If x > .x1 + 1 And x < .x1 + .xw - 1 And y > .y1 + 1 And y < .y1 + .yw - 1 Then Exit For
  149.         End With
  150.     Next i
  151.     If i > Nbuttons Then i = 0
  152.     '
  153.     If i <> CurrButt Then
  154.         PaintButton CurrButt, 0
  155.         PaintButton i, 1
  156.         CurrButt = i
  157.     ElseIf i > 0 Then
  158.         A = IIf(Button = 1, 2, 1)
  159.         If Bstate <> A Then PaintButton i, A
  160.     End If
  161. End Sub

  162. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  163.     ' 触发鼠标点击事件
  164.     If Button = 1 And CurrButt > 0 Then
  165.         PaintButton CurrButt, 1
  166.         bKeys Asc(Buttons(CurrButt).ch2)
  167.     End If
  168. End Sub

  169. Private Sub Form_Load()
  170.     Dim iX As Integer, iY As Integer, n As Integer
  171.     ifac = Screen.TwipsPerPixelX
  172.     Width = 5400
  173.     Height = 5400
  174.     ScaleMode = vbPixels
  175.     AutoRedraw = True
  176.     KeyPreview = True
  177.     BackColor = &HC8D0C0
  178.     Font.Bold = True
  179.     Caption = "计算器"
  180.     '
  181.     CurrButt = 0
  182.     Calc_Init
  183. End Sub

  184. Private Sub Form_Resize()
  185.     Dim gw&, gh&, bW&, bH&, fs&
  186.     ' 检查屏幕是否太小
  187.     mWide = ScaleWidth
  188.     mHeight = ScaleHeight
  189.     ' 屏幕太小。递归处理
  190.     If mWide < 240 Then Width = (240 - mWide) * ifac + Width: Exit Sub
  191.     If mHeight < 170 Then Height = (170 - mHeight) * ifac + Height: Exit Sub
  192.     ' 栅格间距,按钮尺寸
  193.     gw = (mWide - 30) / 6
  194.     gh = (mHeight - 24) / 6
  195.     bW = gw - 10
  196.     bH = gh - 6
  197.     If bH > bW Then bH = bW
  198.     ' 重新定义新按钮
  199.     Nbuttons = 0
  200.     Font.Size = bH * 0.5
  201.     While TextWidth("器") * 7 > mWide
  202.         Font.Size = Font.Size - 1
  203.     Wend
  204.     fs = Font.Size
  205.     RegistButton gw * 0 + 20, gh * 2 + 16, bW, bH, &HA04040, fs, "7", "7"
  206.     RegistButton gw * 1 + 20, gh * 2 + 16, bW, bH, &HA04040, fs, "8", "8"
  207.     RegistButton gw * 2 + 20, gh * 2 + 16, bW, bH, &HA04040, fs, "9", "9"
  208.     RegistButton gw * 0 + 20, gh * 3 + 16, bW, bH, &HA04040, fs, "4", "4"
  209.     RegistButton gw * 1 + 20, gh * 3 + 16, bW, bH, &HA04040, fs, "5", "5"
  210.     RegistButton gw * 2 + 20, gh * 3 + 16, bW, bH, &HA04040, fs, "6", "6"
  211.     RegistButton gw * 0 + 20, gh * 4 + 16, bW, bH, &HA04040, fs, "1", "1"
  212.     RegistButton gw * 1 + 20, gh * 4 + 16, bW, bH, &HA04040, fs, "2", "2"
  213.     RegistButton gw * 2 + 20, gh * 4 + 16, bW, bH, &HA04040, fs, "3", "3"
  214.     RegistButton gw * 0 + 20, gh * 5 + 16, bW, bH, &HA04040, fs, "0", "0"
  215.     RegistButton gw * 1 + 20, gh * 5 + 16, bW, bH, &HA04040, fs, "_", "±"
  216.     RegistButton gw * 2 + 20, gh * 5 + 16, bW, bH, &HA04040, fs, ".", "."
  217.     RegistButton gw * 3 + 20, gh * 2 + 16, bW, bH, &H408040, fs, "r", "mr"
  218.     RegistButton gw * 3 + 20, gh * 3 + 16, bW, bH, &H408040, fs, "p", "mp"
  219.     RegistButton gw * 3 + 20, gh * 4 + 16, bW, bH, &H408040, fs, "s", "ms"
  220.     RegistButton gw * 3 + 20, gh * 5 + 16, bW, bH, &HE040D0, fs, "=", "="
  221.     RegistButton gw * 4 + 20, gh * 2 + 16, bW, bH, &HE040D0, fs, "/", "÷"
  222.     RegistButton gw * 4 + 20, gh * 3 + 16, bW, bH, &HE040D0, fs, "*", "×"
  223.     RegistButton gw * 4 + 20, gh * 4 + 16, bW, bH, &HE040D0, fs, "-", "-"
  224.     RegistButton gw * 5 + 20, gh * 2 + 16, bW, bH, &H4040F0, fs, "c", "C"
  225.     RegistButton gw * 5 + 20, gh * 3 + 16, bW, bH, &HA0A040, fs * 0.6, "x", "1/x"
  226.     RegistButton gw * 5 + 20, gh * 4 + 16, bW, bH, &HA0A040, fs * 0.9, "q", "√x"
  227.     RegistButton gw * 4 + 20, gh * 5 + 16, bW * 2 + 10, bH, &HE040D0, fs, "+", "+"
  228.     '
  229.     '定义显示区
  230.     With Buttons(0)
  231.         .ch = "0": .ch2 = "": .co = &HC04040
  232.         .x1 = 20: .y1 = gh + 18
  233.         .xw = gw * 5 + bW: .yw = bH - 4
  234.     End With
  235.     ' 改变显示区字体大小
  236.     Font.Size = fs
  237.     Font.Bold = True
  238.     While TextWidth("E") * 22 > Buttons(0).xw
  239.         Font.Size = Font.Size - 1
  240.     Wend
  241.     Buttons(0).fs = Font.Size
  242.     '
  243.     RePaint
  244. End Sub
复制代码
计算器模块:

  1. Option Explicit
  2. '===============================================
  3. ' (c)版权所有,禁止转载
  4. ' 仿 Window 计算器程序模块
  5. ' VBGood论坛专用版 (WWW.VbGood.Com)
  6. ' 作者:Igawk, 2011.11
  7. '
  8. '===============================================

  9. Dim Op1#, Op2#      ' 预先输入操作数。
  10. Dim DecFlag%        ' 小数点存在吗?
  11. Dim Klast           ' 指示上一次按键事件的类型。
  12. Dim OpFlag          ' 指示未完成的操作。
  13. Dim Kedt%           ' 指示键入状态, 0-未操作,1-算过,2-改过
  14. Dim MemNum#         ' 存储器
  15. Public KMem         ' 存储器有内容
  16. Dim Temp2#

  17. ' 窗体的初始化过程
  18. ' 设置所有变量为其初始值。
  19. Sub Calc_Init()
  20.     OpCancel
  21.     MemNum = 0
  22.     KMem = False
  23. End Sub

  24. ' 取回显示参数
  25. Sub GetOp1()
  26.     Op1 = Val(Form1.Disp)
  27. End Sub

  28. Sub Display(A#)
  29.     Dim s As String
  30.     s = CStr(A)
  31.     If InStr(s, ".") = 0 Then s = s + "."
  32.     If Left(s, 1) = "." Then s = "0" + s
  33.     If Left(s, 2) = "-." Then s = "-0" + Mid(s, 2)
  34.     Form1.Disp = s
  35. End Sub

  36. ' 运算符 (+, -, x, /,^,Inv ^)
  37. ' 如果有一个操作数,则设置 Op1。
  38. ' 如果有两个操作数,则将 Op1 设置为 Op1 与当前输入字符串的运算结果,并显示结果。
  39. Sub OpOperators(Index As Integer)
  40.     '
  41.     If Klast = "OPS" And Kedt > 0 Then
  42.         If Kedt = 2 Then GetOp1
  43.         DoOperation
  44.     Else
  45.         If Kedt = 2 Then GetOp1
  46.         Display Op1
  47.         Op2 = Op1
  48.     End If
  49.     Klast = "OPS"
  50.     Kedt = 0
  51.     OpFlag = Mid("+-X/^&", Index + 1, 1)
  52. End Sub

  53. ' C (取消)
  54. ' 重新设置显示并初始化变量。
  55. Sub OpCancel()
  56.     Op1 = 0
  57.     Op2 = 0
  58.     Display Op1
  59.     DecFlag = False
  60.     Klast = "NUL"
  61.     Temp2 = 0
  62.     OpFlag = ""
  63.     Kedt = 0
  64. End Sub

  65. ' CE (取消输入) 。
  66. Sub OpZero()
  67.     Op1 = 0
  68.     Display Op1
  69.     DecFlag = False
  70.     Kedt = 0
  71. End Sub

  72. ' 小数点 (.)
  73. ' 如果上一次按键为运算符,初始化 Form1.Disp为 "0.";
  74. ' 否则显示时追加一个小数点。
  75. Sub OpDecimal()
  76.     If Klast = "EQU" Then OpCancel
  77.     If Kedt < 2 Then
  78.         Display 0
  79.         Kedt = 2
  80.     End If
  81.     DecFlag = True
  82. End Sub

  83. ' 数字键 (0-9)
  84. ' 向显示中的数追加新数。
  85. Sub OpNumbers(Index As Integer)
  86.     If Klast = "EQU" Then OpCancel
  87.     If Kedt < 2 Then
  88.         Form1.Disp = "."
  89.         DecFlag = False
  90.     End If
  91.     If DecFlag Then
  92.         If Len(Form1.Disp) < 21 Then Form1.Disp = Form1.Disp & Index
  93.     Else
  94.         Form1.Disp = Left(Form1.Disp, InStr(Form1.Disp, ".") - 1) & Index & "."
  95.     End If
  96.     Kedt = 2
  97. End Sub
  98. ' 执行二元运算(+,-,*,/,^,Inv ^)
  99. Sub DoOperation()
  100.     On Error GoTo ErrH
  101.     '
  102.     Temp2 = Op1
  103.     Select Case OpFlag
  104.     Case "+": Op1 = Op2 + Op1
  105.     Case "-": Op1 = Op2 - Op1
  106.     Case "X": Op1 = Op2 * Op1
  107.     Case "/": Op1 = Op2 / Op1
  108.     Case "^": Op1 = Op2 ^ Op1
  109.     Case "&": Op1 = Op2 ^ (1 / Op1)
  110.     End Select
  111.     '
  112.     Display Op1
  113.     Op2 = Op1
  114.     Exit Sub
  115. ErrH:
  116.     OpCancel
  117.     Form1.Disp = "ERROR!"
  118. End Sub

  119. ' 运算符 (=)
  120. ' 如果重复按“=”,则重复最后的运算。
  121. Sub OpEqual()
  122.     Select Case Klast
  123.     Case "NUL"
  124.         If Kedt = 2 Then GetOp1
  125.         Display Op1
  126.         Op2 = Op1
  127.     Case "EQU"
  128.         If OpFlag <> "" Then
  129.             Op2 = Op1
  130.             Op1 = Temp2
  131.             DoOperation
  132.         End If
  133.     Case "OPS"
  134.         If Kedt = 2 Then GetOp1
  135.         DoOperation
  136.     End Select
  137.     Klast = "EQU"
  138.     Kedt = 1
  139. End Sub

  140. '===============================================
  141. ' (c)版权所有,禁止转载, 作者:Igawk, 2011.11
  142. '===============================================
  143. ' 存入存储器
  144. Sub OpMs()
  145.     If Kedt = 2 Then GetOp1
  146.     MemNum = Op1
  147.     Kedt = 1
  148.     KMem = True
  149.     If MemNum = 0 Then OpMc
  150. End Sub

  151. Sub OpMp()
  152.     If Kedt = 2 Then GetOp1
  153.     MemNum = MemNum + Op1
  154.     Kedt = 1
  155.     KMem = True
  156.     If MemNum = 0 Then OpMc
  157. End Sub

  158. ' 取出存储器数据
  159. Sub OpMr()
  160.     If Not KMem Then Exit Sub
  161.     OpZero
  162.     Op1 = MemNum
  163.     Display Op1
  164.     Kedt = 1
  165. End Sub
  166. ' 清除存储器
  167. Sub OpMc()
  168.     MemNum = 0
  169.     KMem = False
  170. End Sub

  171. '===============================================
  172. ' (c)版权所有,禁止转载, 作者:Igawk, 2011.11
  173. '===============================================
  174.    
  175. '改变数字的正负号
  176. Sub OpNeg()
  177.     If Left(Form1.Disp, 1) <> "-" Then
  178.         Form1.Disp = "-" + Form1.Disp
  179.     Else
  180.         Form1.Disp = Right(Form1.Disp, Len(Form1.Disp) - 1)
  181.     End If
  182.     GetOp1
  183. End Sub

  184. ' 函数计算
  185. Sub OpFunction(Index As Integer)
  186.     On Error GoTo ErrH
  187.     '
  188.     If Kedt = 2 Then GetOp1
  189.     Select Case Index
  190.     Case 0: ' 开根号计算
  191.         Op1 = Sqr(Op1)
  192.     Case 1: ' 平方计算
  193.         Op1 = Op1 * Op1
  194.     Case 2: ' 取整计算
  195.         Op1 = Int(Op1)
  196.     Case 3: ' 倒数计算
  197.         Op1 = 1 / Op1
  198.     Case 4: '百分比键
  199.         Op1 = Op1 / 100
  200.     End Select
  201.     Display Op1
  202.     Kedt = 1
  203.     Exit Sub
  204. ErrH:
  205.     OpCancel
  206.     Form1.Disp = "ERROR!"
  207. End Sub

复制代码
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2020-6-5 21:35

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表