Здесь вы сможете оценить код, написанного мною "Плавающего инженерного калькулятора", который кстати можно скачать здесь.
Калькулятор написан на 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
|