ИСХОДНИК КАЛЬКУЛЯТОРА

      Здесь вы сможете оценить код, написанного мною "Плавающего инженерного калькулятора", который кстати можно скачать здесь.
      Калькулятор написан на Visual Basic 6.0 с использованием встраиваемого VBScript, который и производит калькуляцию вводимой строки. Исходник и форму смотрим ниже:

      ФОРМА




      ИСХОДНИК

      Private Const HWND_TOPMOST = -1
      Private Const HWND_TOPMOST1 = 1
      Private Const SWP_NOSIZE = &H1
      Private Const SWP_NOMOVE = &H2
      Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
      Public pic As Long
      Public hx As Long
      Public hy As Long
      Public wx As Long
      Public wy As Long
      Public mx As Long
      Public my As Long
      Public sx As Long
      Public sy As Long
      Public a As Double
      Public colpix As Double

      Public Napr As String

      Dim SC As New ScriptControl
      Public G As Long

      Private Sub Check2_Click()
      If Check2.Value = 1 Then
      Call SetWindowPos(Main.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Call SetWindowPos(Autor.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Else
      Call SetWindowPos(Main.hwnd, HWND_TOPMOST1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Call SetWindowPos(Autor.hwnd, HWND_TOPMOST1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      End If

      If Check2.Value = 1 Then
      Check2.Caption = "Ниже всех окон"
      Check2.ToolTipText = "Отожмите кнопку для вывода окна калькулятора ниже всех окон"
      Else
      Check2.Caption = "Поверх всех окон"
      Check2.ToolTipText = "Нажмите на кнопку для вывода окна калькулятора поверх всех окон"
      End If
      End Sub

      Private Sub Command1_Click()
      txtIn.Text = txtIn.Text & "8"
      End Sub

      Private Sub Command10_Click()
      txtIn.Text = txtIn.Text & "."
      End Sub

      Private Sub Command11_Click()
      SC.Reset
      'clear settings

      SC.AddObject "Main", Me, True
      'adding main form object to the SC control

      s = "Private Sub Script()" & vbCrLf
      s = s & "Main.txtOut=cstr(" & Me.txtIn & ")" & vbCrLf
      s = s & "End Sub"
      'here is a code, generated by the Calc Pro program

      On Error GoTo er
      SC.AddCode s
      SC.ExecuteStatement "Script"
      'executing generated code

      Exit Sub
      'if code contains some invalid instructions
      er: MsgBox "Вы ввели неверные инструкции. Пожалуйста, сформулируйте запрос по-другому.", vbCritical, "Error"
      End Sub

      Private Sub Command12_Click()
      txtIn.Text = txtIn.Text & "-"
      End Sub

      Private Sub Command13_Click()
      txtIn.Text = txtIn.Text & "7"
      End Sub

      Private Sub Command14_Click()
      txtIn.Text = txtIn.Text & "4"
      End Sub

      Private Sub Command15_Click()
      txtIn.Text = txtIn.Text & "1"
      End Sub

      Private Sub Command16_Click()
      txtIn.Text = txtIn.Text & "0"
      End Sub

      Private Sub Command17_Click()
      txtIn.Text = txtIn.Text & "("
      End Sub

      Private Sub Command18_Click()
      txtIn.Text = txtIn.Text & "^"
      End Sub

      Private Sub Command19_Click()
      txtIn.Text = txtIn.Text & "ABS("
      End Sub

      Private Sub Command2_Click()
      txtIn.Text = txtIn.Text & "9"
      End Sub

      Private Sub Command20_Click()
      txtIn.Text = txtIn.Text & "CINT("
      End Sub

      Private Sub Command21_Click()
      txtIn.Text = txtIn.Text & "COS("
      End Sub

      Private Sub Command22_Click()
      txtIn.Text = txtIn.Text & "SIN("
      End Sub

      Private Sub Command23_Click()
      txtIn.Text = txtIn.Text & "TAN("
      End Sub

      Private Sub Command24_Click()
      txtIn.Text = txtIn.Text & "ATN("
      End Sub

      Private Sub Command25_Click()
      txtIn.Text = txtIn.Text & ")"
      End Sub

      Private Sub Command26_Click()
      txtIn.Text = txtIn.Text & "Exp("
      End Sub

      Private Sub Command27_Click()
      txtIn.Text = txtIn.Text & "SGN("
      End Sub

      Private Sub Command28_Click()
      txtIn.Text = txtIn.Text & "LOG("
      End Sub

      Private Sub Command29_Click()
      txtIn.Text = ""
      txtOut.Text = ""
      End Sub

      Private Sub Command3_Click()
      txtIn.Text = txtIn.Text & "/"
      End Sub

      Private Sub Command30_Click()
      txtIn.Text = txtIn.Text & "SQR("
      End Sub

      Private Sub Command31_Click()
      txtIn.Text = txtIn.Text & "INT("
      End Sub

      Private Sub Command32_Click()
      txtIn.Text = txtIn.Text & "RND"
      End Sub

      Private Sub Command33_Click()

      If Len(txtIn.Text) > 0 Then
      txtIn.Text = Left$(txtIn.Text, Len(txtIn.Text) - 1)
      End If

      End Sub

      Private Sub Command34_Click()
      If Command34.Caption = "Показать клавиатуру" Then
      Main.Height = 3300
      Command34.Caption = "Скрыть клавиатуру"
      Else
      Main.Height = 1400
      Command34.Caption = "Показать клавиатуру"
      End If
      End Sub

      Private Sub Command35_Click()
      On Error Resume Next
      mx = Screen.Width - Main.Width
      my = Screen.Height / 2 - Main.Height / 2 - 17 * 25.4
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command35.Caption 'Вправо
      End Sub

      Private Sub Command36_Click()
      On Error Resume Next
      mx = Screen.Width / 2 - Main.Width / 2
      my = Screen.Height / 2 - Main.Height / 2 - 17 * 25.4
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command36.Caption 'В центр
      End Sub

      Private Sub Command37_Click()
      On Error Resume Next
      mx = 0
      my = Screen.Height / 2 - Main.Height / 2 - 17 * 25.4
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command37.Caption 'Влево
      End Sub

      Private Sub Command38_Click()
      On Error Resume Next
      mx = 0
      my = 0
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command38.Caption 'Вверх влево
      End Sub

      Private Sub Command39_Click()
      On Error Resume Next
      mx = Screen.Width / 2 - Main.Width / 2
      my = 0
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command39.Caption 'Вниз вправо
      End Sub

      Private Sub Command4_Click()
      txtIn.Text = txtIn.Text & "5"
      End Sub

      Private Sub Command40_Click()
      On Error Resume Next
      mx = Screen.Width - Main.Width
      my = 0
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command40.Caption 'Вниз вправо
      End Sub

      Private Sub Command41_Click()
      On Error Resume Next
      mx = 0
      my = Screen.Height - Main.Height - 17 * 25.4
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command41.Caption 'Вниз влево
      End Sub

      Private Sub Command42_Click()
      On Error Resume Next
      mx = Screen.Width / 2 - Main.Width / 2
      my = Screen.Height - Main.Height - 17 * 25.4
      wx = Main.Left
      wy = Main.Top
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command42.Caption 'Вниз
      End Sub

      Private Sub Command43_Click()
      On Error Resume Next
      mx = Screen.Width - Main.Width 'Разность между шириной экрана и шириной формы
      my = Screen.Height - Main.Height - 17 * 25.4 'Разность между высотой экрана и высотой формы
      wx = Main.Left 'Горизонтальная координата левого верхнего угла формы
      wy = Main.Top 'Вертикальная координата левого верхнего угла формы
      hx = wx - mx
      hy = wy - my
      a = Atn(hy / hx)
      Timer1.Enabled = True
      Napr = Command43.Caption 'Вниз вправо
      End Sub

      Private Sub Command44_Click()
      Autor.Show vbModal
      If Check2.Value = 1 Then
      Call SetWindowPos(Main.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Call SetWindowPos(Autor.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Else
      Call SetWindowPos(Main.hwnd, HWND_TOPMOST1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Call SetWindowPos(Autor.hwnd, HWND_TOPMOST1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      End If
      End Sub

      Private Sub Command5_Click()
      txtIn.Text = txtIn.Text & "6"
      End Sub

      Private Sub Command6_Click()
      txtIn.Text = txtIn.Text & "*"
      End Sub

      Private Sub Command7_Click()
      txtIn.Text = txtIn.Text & "2"
      End Sub

      Private Sub Command8_Click()
      txtIn.Text = txtIn.Text & "3"
      End Sub

      Private Sub Command9_Click()
      txtIn.Text = txtIn.Text & "+"
      End Sub

      Private Sub Form_Load()
      SC.Language = "VBScript"

      If Check2.Value = 1 Then
      Call SetWindowPos(Main.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Call SetWindowPos(Autor.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Else
      Call SetWindowPos(Main.hwnd, HWND_TOPMOST1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      Call SetWindowPos(Autor.hwnd, HWND_TOPMOST1, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
      End If

      If Check2.Value = 1 Then
      Check2.Caption = "Ниже всех окон"
      Check2.ToolTipText = "Отожмите кнопку для вывода окна калькулятора ниже всех окон"
      Else
      Check2.Caption = "Поверх всех окон"
      Check2.ToolTipText = "Нажмите на кнопку для вывода окна калькулятора поверх всех окон"
      End If

      Main.Height = 1400
      'initialising SC control
      End Sub

      Private Sub Form_Unload(Cancel As Integer)
      End
      End Sub

      Private Sub Timer1_Timer()
      'Select Case Napr

      'Case "Вниз вправо"
      colpix = 7
      sx = 25.4 * Cos(a) * colpix
      sy = 25.4 * Sin(a) * colpix
      Main.Left = Main.Left + sx
      Main.Top = Main.Top + sy
      'Main.Refresh
      If Main.Left >= mx Or Main.Top >= my Then
      Main.Left = mx
      Main.Top = my
      Timer1.Enabled = False
      End If
      End Sub

      Private Sub txtIn_Change()
      a = txtIn.SelStart
      txtIn = UCase(txtIn)
      txtIn.SelStart = a

      If Check1.Value = 1 Then
      SC.Reset
      SC.AddObject "Main", Me, True
      s = "Private Sub Script()" & vbCrLf
      s = s & "Main.txtOut=cstr(" & Me.txtIn & ")" & vbCrLf
      s = s & "End Sub"
      On Error GoTo er
      SC.AddCode s
      SC.ExecuteStatement "Script"
      Exit Sub
      er: txtOut = "ОШИБКА ВВОДА"
      End If

      If Len(txtIn.Text) = 0 Then txtOut = ""

      End Sub

      Private Sub txtIn_DblClick()
      SC.Reset
      'clear settings

      SC.AddObject "Main", Me, True
      'adding main form object to the SC control

      s = "Private Sub Script()" & vbCrLf
      s = s & "Main.txtOut=cstr(" & Me.txtIn & ")" & vbCrLf
      s = s & "End Sub"
      'here is a code, generated by the Calc Pro program

      On Error GoTo er
      SC.AddCode s
      SC.ExecuteStatement "Script"
      'executing generated code

      Exit Sub
      'if code contains some invalid instructions
      er: MsgBox "Вы ввели неверные инструкции. Пожалуйста, сформулируйте запрос по-другому.", vbCritical, "Error"
      End Sub

      Private Sub txtOut_Change()
      txtOut = UCase(txtOut)
      End Sub



  ГЛАВНАЯ
  СКАЧАТЬ КАЛЬКУЛЯТОРЫ
  ИСТОРИЯ КАЛЬКУЛЯТОРОВ
  СТАТЬИ
  ИСХОДНИК КАЛЬКУЛЯТОРА
  ССЫЛКИ НА САЙТЫ СОФТА

  КАРТА САЙТА

ЩЕЛКНИТЕ ЗДЕСЬ, чтобы узнать, как получить 21 999 посетителей на Ваш сайт.Бесплатно!

Копирайт (c) 2009. Создано pdi13soft. Все права защищены.

Хостинг от uCoz