frmpmt.frm

vb编写的测量用坐标转换程序

VERSION 5.00
Object = "{C7B002C1-3288-46D5-AB8D-7B38F51D7F76}#1.0#0"; "FlexCell.ocx"
Begin VB.Form frmPmt 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "转换参数计算"
   ClientHeight    =   7305
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   10425
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7305
   ScaleWidth      =   10425
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame framPmt 
      Height          =   7150
      Left            =   120
      TabIndex        =   0
      Top             =   50
      Width           =   10215
      Begin VB.CommandButton cmdBack 
         Caption         =   "返 回"
         Height          =   495
         Left            =   9000
         TabIndex        =   12
         Top             =   1320
         Width           =   975
      End
      Begin VB.CommandButton cmdCal 
         Caption         =   "解 算"
         Height          =   495
         Left            =   9000
         TabIndex        =   11
         Top             =   480
         Width           =   975
      End
      Begin VB.TextBox txtD1 
         Height          =   270
         Left            =   5160
         TabIndex        =   5
         Top             =   795
         Width           =   3495
      End
      Begin VB.TextBox txtK1 
         Height          =   270
         Left            =   5160
         TabIndex        =   4
         Top             =   315
         Width           =   3495
      End
      Begin VB.TextBox txtQ1 
         Height          =   270
         Left            =   600
         TabIndex        =   3
         Top             =   795
         Width           =   3615
      End
      Begin VB.TextBox txtP1 
         Height          =   270
         Left            =   600
         TabIndex        =   2
         Top             =   315
         Width           =   3615
      End
      Begin FlexCell.Grid Grid1 
         Height          =   5745
         Left            =   360
         TabIndex        =   1
         Top             =   1200
         Width           =   8415
         _ExtentX        =   14843
         _ExtentY        =   10134
         BackColorBkg    =   -2147483637
         Cols            =   5
         ExtendLastCol   =   -1  'True
         Rows            =   30
      End
      Begin VB.Label Label2 
         Caption         =   "注意：                      数据从第一行开始填起"
         Height          =   975
         Left            =   9000
         TabIndex        =   10
         Top             =   5880
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "P:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   9
         Top             =   323
         Width           =   255
      End
      Begin VB.Label Label1 
         Caption         =   "Q:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   5
         Left            =   240
         TabIndex        =   8
         Top             =   803
         Width           =   255
      End
      Begin VB.Label Label1 
         Caption         =   "K:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   6
         Left            =   4800
         TabIndex        =   7
         Top             =   330
         Width           =   255
      End
      Begin VB.Label Label1 
         Caption         =   "角度:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Index           =   7
         Left            =   4440
         TabIndex        =   6
         Top             =   810
         Width           =   615
      End
   End
End
Attribute VB_Name = "frmPmt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdBack_Click()
    Unload Me
End Sub

Private Sub cmdCal_Click()
    Dim i, j, h, counter As Integer
    Dim s1, s2, s3, s4 As Double
    Dim aver1, aver2, aver3, aver4 As Double
    Dim as1, as2, as3, as4, as5, as6 As Double
    Dim p, q, k, degree As Double
    Dim m, n, l As Double
    Dim x1() As Double
    Dim x2() As Double
    Dim y1() As Double
    Dim y2() As Double
    
    '计算总数
    For i = 1 To 20
       If Grid1.Cell(i, 1).Text = "" Then Exit For
    Next i
    counter = i - 1
    
    If counter <= 1 Then
      MsgBox (" 点数太少，怎么算？")
      Exit Sub
    End If
    
    '单项求和
    For j = 1 To counter
       s1 = s1 + CDbl(Grid1.Cell(j, 1).Text)
       s2 = s2 + CDbl(Grid1.Cell(j, 2).Text)
       s3 = s3 + CDbl(Grid1.Cell(j, 3).Text)
       s4 = s4 + CDbl(Grid1.Cell(j, 4).Text)
    Next j
    
    '求平均
    aver1 = s1 / counter
    aver2 = s2 / counter
    aver3 = s3 / counter
    aver4 = s4 / counter
    
    ReDim x1(counter) As Double
    ReDim x2(counter) As Double
    ReDim y1(counter) As Double
    ReDim y2(counter) As Double
    h = 0
    
    '计算差值及总和
    For h = 0 To counter - 1
   
        x1(h) = CDbl(Grid1.Cell(h + 1, 1).Text) - aver1
        y1(h) = CDbl(Grid1.Cell(h + 1, 2).Text) - aver2
        x2(h) = CDbl(Grid1.Cell(h + 1, 3).Text) - aver3
        y2(h) = CDbl(Grid1.Cell(h + 1, 4).Text) - aver4
        as1 = as1 + y2(h) * x1(h)
        as2 = as2 + x2(h) * y1(h)
        as3 = as3 + x2(h) * x1(h)
        as4 = as4 + y2(h) * y1(h)
        as5 = as5 + x1(h) * x1(h)
        as6 = as6 + y1(h) * y1(h)
    Next h
 
    '计算参数
    m = as1 - as2
    n = as3 + as4
    l = as5 + as6

    degree = Atn(m / n)
    k = Sqr(m ^ 2 + n ^ 2) / (as5 + as6)
    p = s3 / counter - k * Cos(degree) * s1 / counter + k * Sin(degree) * s2 / counter
    q = s4 / counter - k * Cos(degree) * s2 / counter - k * Sin(degree) * s1 / counter

    '显示数据
    txtP1.Text = p
    txtQ1.Text = q
    txtK1.Text = k
    txtD1.Text = degree
    frmConvert.txtP.Text = p
    frmConvert.txtQ.Text = q
    frmConvert.txtK.Text = k
    frmConvert.txtD.Text = degree
End Sub

Private Sub Form_Load()
    Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^"
    With Grid1
          .OpenFile (App.Path & "\pmt.cel")
    End With
    
End Sub