⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 直线长度计算.frm

📁 Visual Basic课程举例1 有很好的例题
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "直线长度计算"
   ClientHeight    =   4560
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7605
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   304
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   507
   StartUpPosition =   3  '窗口缺省
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H0080C0FF&
      Caption         =   "按下鼠标左键可以拖动线的一端,放开后显示线的长度"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   7215
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000000FF&
      BorderWidth     =   10
      X1              =   72
      X2              =   408
      Y1              =   192
      Y2              =   128
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' VB过程示例
' 编制:曹新国, 2006年3月28日
' 本程序演示了鼠标事件的用法和自定义函数的使用。
' 程序使用方法:按下鼠标左键可以拖动线的一端,放开后显示线的长度
'
' 同学们可以自行修改,增加更多的功能
' 例如:拖动线的中间部分可以在窗口中移动线段。
' 也可以考虑实现多个线段的拖动和拉伸功能。

Dim e1 As Boolean  ' 说明点中的是线的哪一端,第1端为TRUE
Dim msD As Boolean ' 鼠标键按下的状态,按下时为TRUE

' 给出两个点,计算两点间距离的函数
Function distance(x1, y1, x2, y2) As Double
    distance = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
End Function

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = distance(X, Y, Line1.x1, Line1.y1)
b = distance(X, Y, Line1.x2, Line1.y2)
If a < b Then
    Line1.x1 = X
    Line1.y1 = Y
    e1 = True
Else
    Line1.x2 = X
    Line1.y2 = Y
    e1 = False
End If

msD = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Not msD Then Exit Sub

If e1 Then
    Line1.x1 = X
    Line1.y1 = Y
Else
    Line1.x2 = X
    Line1.y2 = Y
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label1.Caption = Format(distance(Line1.x1, Line1.y1, Line1.x2, Line1.y2))
    msD = False
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -