www.pudn.com > DataCollectionSystem.rar > frmStudy.frm, change:2003-07-10,size:16604b


VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx" 
Begin VB.Form frmStudy  
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "学习功能" 
   ClientHeight    =   4935 
   ClientLeft      =   1065 
   ClientTop       =   1470 
   ClientWidth     =   8805 
   BeginProperty Font  
      Name            =   "宋体" 
      Size            =   9 
      Charset         =   0 
      Weight          =   400 
      Underline       =   0   'False 
      Italic          =   0   'False 
      Strikethrough   =   0   'False 
   EndProperty 
   Icon            =   "frmStudy.frx":0000 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   PaletteMode     =   1  'UseZOrder 
   Picture         =   "frmStudy.frx":030A 
   ScaleHeight     =   4935 
   ScaleWidth      =   8805 
   StartUpPosition =   1  'CenterOwner 
   Begin VB.TextBox txtHZAngle  
      Alignment       =   2  'Center 
      Appearance      =   0  'Flat 
      BackColor       =   &H00E0E0E0& 
      ForeColor       =   &H00FF0000& 
      Height          =   375 
      Left            =   120 
      Locked          =   -1  'True 
      TabIndex        =   15 
      Top             =   1320 
      Width           =   1815 
   End 
   Begin VB.TextBox txtVAngle  
      Alignment       =   2  'Center 
      Appearance      =   0  'Flat 
      BackColor       =   &H00E0E0E0& 
      ForeColor       =   &H00FF0000& 
      Height          =   375 
      Left            =   120 
      Locked          =   -1  'True 
      TabIndex        =   14 
      Top             =   2040 
      Width           =   1815 
   End 
   Begin MSComctlLib.ListView resultList  
      Height          =   3495 
      Left            =   2640 
      TabIndex        =   13 
      Top             =   120 
      Width           =   6015 
      _ExtentX        =   10610 
      _ExtentY        =   6165 
      View            =   3 
      Arrange         =   1 
      LabelEdit       =   1 
      LabelWrap       =   -1  'True 
      HideSelection   =   -1  'True 
      FullRowSelect   =   -1  'True 
      GridLines       =   -1  'True 
      HoverSelection  =   -1  'True 
      _Version        =   393217 
      ForeColor       =   -2147483640 
      BackColor       =   -2147483643 
      Appearance      =   1 
      NumItems        =   0 
   End 
   Begin PrjMain.xpcmdbutton cmdEdit  
      Height          =   495 
      Left            =   7440 
      TabIndex        =   12 
      Top             =   4320 
      Width           =   1215 
      _extentx        =   2143 
      _extenty        =   873 
      enabled         =   0   'False 
      caption         =   "修改" 
      font            =   "frmStudy.frx":5849 
   End 
   Begin PrjMain.xpcmdbutton cmdAdd  
      Height          =   495 
      Left            =   7440 
      TabIndex        =   11 
      Top             =   3720 
      Width           =   1215 
      _extentx        =   2143 
      _extenty        =   873 
      caption         =   "添加" 
      font            =   "frmStudy.frx":586D 
   End 
   Begin PrjMain.xpcmdbutton cmdWriteToFile  
      Height          =   495 
      Left            =   1320 
      TabIndex        =   10 
      Top             =   4200 
      Width           =   1095 
      _extentx        =   1931 
      _extenty        =   873 
      caption         =   "写入文件" 
      font            =   "frmStudy.frx":5891 
   End 
   Begin PrjMain.xpcmdbutton cmdQuit  
      Height          =   495 
      Left            =   120 
      TabIndex        =   9 
      Top             =   4200 
      Width           =   1095 
      _extentx        =   1931 
      _extenty        =   873 
      caption         =   "关闭退出" 
      font            =   "frmStudy.frx":58B5 
   End 
   Begin PrjMain.xpcmdbutton cmdGetData  
      Height          =   495 
      Left            =   1320 
      TabIndex        =   8 
      Top             =   3600 
      Width           =   1095 
      _extentx        =   1931 
      _extenty        =   873 
      caption         =   "获取数据" 
      font            =   "frmStudy.frx":58D9 
   End 
   Begin PrjMain.xpcmdbutton cmdOpenConnection  
      Height          =   495 
      Left            =   120 
      TabIndex        =   7 
      Top             =   3600 
      Width           =   1095 
      _extentx        =   1931 
      _extenty        =   873 
      caption         =   "打开端口" 
      font            =   "frmStudy.frx":58FD 
   End 
   Begin VB.TextBox txtType  
      Appearance      =   0  'Flat 
      BeginProperty DataFormat  
         Type            =   1 
         Format          =   "0" 
         HaveTrueFalseNull=   0 
         FirstDayOfWeek  =   0 
         FirstWeekOfYear =   0 
         LCID            =   2052 
         SubFormatType   =   1 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   375 
      Left            =   5520 
      TabIndex        =   6 
      Top             =   4080 
      Width           =   1215 
   End 
   Begin VB.TextBox txtName  
      Appearance      =   0  'Flat 
      ForeColor       =   &H00FF0000& 
      Height          =   375 
      Left            =   4080 
      TabIndex        =   5 
      Top             =   4080 
      Width           =   1215 
   End 
   Begin VB.TextBox txtNumber  
      Appearance      =   0  'Flat 
      BeginProperty DataFormat  
         Type            =   1 
         Format          =   "0" 
         HaveTrueFalseNull=   0 
         FirstDayOfWeek  =   0 
         FirstWeekOfYear =   0 
         LCID            =   2052 
         SubFormatType   =   1 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   375 
      Left            =   2640 
      TabIndex        =   4 
      Top             =   4080 
      Width           =   1215 
   End 
   Begin VB.Label Label5  
      AutoSize        =   -1  'True 
      BackStyle       =   0  'Transparent 
      Caption         =   "水平角:" 
      Height          =   180 
      Left            =   120 
      TabIndex        =   17 
      Top             =   1080 
      Width           =   630 
   End 
   Begin VB.Label Label6  
      AutoSize        =   -1  'True 
      BackStyle       =   0  'Transparent 
      Caption         =   "垂直角:" 
      Height          =   180 
      Left            =   120 
      TabIndex        =   16 
      Top             =   1800 
      Width           =   630 
   End 
   Begin VB.Label Label4  
      BackStyle       =   0  'Transparent 
      Caption         =   "类别:" 
      Height          =   255 
      Left            =   5520 
      TabIndex        =   3 
      Top             =   3840 
      Width           =   495 
   End 
   Begin VB.Label Label3  
      BackStyle       =   0  'Transparent 
      Caption         =   "点名:" 
      Height          =   255 
      Left            =   4080 
      TabIndex        =   2 
      Top             =   3840 
      Width           =   495 
   End 
   Begin VB.Label Label2  
      AutoSize        =   -1  'True 
      BackStyle       =   0  'Transparent 
      Caption         =   "点号:" 
      Height          =   180 
      Left            =   2640 
      TabIndex        =   1 
      Top             =   3840 
      Width           =   450 
   End 
   Begin VB.Label Label1  
      AutoSize        =   -1  'True 
      BackStyle       =   0  'Transparent 
      Caption         =   "学习功能" 
      BeginProperty Font  
         Name            =   "楷体_GB2312" 
         Size            =   18 
         Charset         =   134 
         Weight          =   700 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   360 
      Left            =   120 
      TabIndex        =   0 
      Top             =   240 
      Width           =   1500 
   End 
End 
Attribute VB_Name = "frmStudy" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
'control variablen 
Dim bApplRunning As Boolean       ' state is application running or not 
 
Dim Result As Long    ' function result 
 
'measurement variablen 
Dim OnlyAngle As TMC_HZ_V_ANG ' angle data 
Dim dSlopeDistance As Double  ' slope distance data 
Dim EdmMeasPrgm As Long       ' used EDM mesurement program 
Dim numeric As Integer 
 
 
' Function close the application, this function 
' will be called if you pressed the QUIT button 
Private Sub cmdQuit_Click() 
' Only if application is running 
If bApplRunning = True Then 
   bApplRunning = False 
   'stop running measurements and clear distance data 
   Call VB_TMC_DoMeasure(TMC_CLEAR, TMC_AUTO_INC) 
   
   'terminate comunication with instr 
   Result = VB_COM_CloseConnection() 
   If Result <> RC_OK Then 
      'Display error message 
      Call VB_COM_End 
      ViewError Result 
   End If 
   'reinitialize comunication package 
   Call VB_COM_End 
End If 
 
' Unloading form resp. control and Terminate execution 
Unload Me 
 
End Sub 
 
 
Private Sub cmdAdd_Click() 
If txtNumber.Text <> "" And txtName.Text <> "" And txtType.Text <> "" And txtHZAngle.Text <> "" And txtVAngle.Text <> "" Then 
    numeric = numeric + 1 
    resultList.ListItems.Add numeric, , numeric 
    resultList.ListItems(numeric).ListSubItems.Add 1, , txtNumber.Text 
    resultList.ListItems(numeric).ListSubItems.Add 2, , txtName.Text 
    resultList.ListItems(numeric).ListSubItems.Add 3, , txtType.Text 
    resultList.ListItems(numeric).ListSubItems.Add 4, , txtHZAngle.Text 
    resultList.ListItems(numeric).ListSubItems.Add 5, , txtVAngle.Text 
    txtNumber.Text = "" 
    txtName.Text = "" 
    txtType.Text = "" 
    txtHZAngle.Text = "" 
    txtVAngle.Text = "" 
Else 
    If txtHZAngle.Text = "" Or txtVAngle.Text = "" Then 
        MsgBox "还没有获取坐标?", vbOKOnly + 16, "警告" 
    End If 
End If 
End Sub 
 
Private Sub cmdEdit_Click() 
    cmdEdit.Enabled = False 
    resultList.SelectedItem.ListSubItems(1).Text = txtNumber.Text 
    resultList.SelectedItem.ListSubItems(2).Text = txtName.Text 
    resultList.SelectedItem.ListSubItems(3).Text = txtType.Text 
    resultList.SelectedItem.ListSubItems(4).Text = txtHZAngle.Text 
    resultList.SelectedItem.ListSubItems(5).Text = txtVAngle.Text 
    txtNumber.Text = "" 
    txtName.Text = "" 
    txtType.Text = "" 
    txtHZAngle.Text = "" 
    txtVAngle.Text = "" 
End Sub 
 
Private Sub cmdGetData_Click() 
' Function starts the application, it initialize 
' GeoCom and starts the simple main measure task 
If bApplRunning = True Then 
Result = VB_TMC_SetEdmMode(EdmMeasPrgm) 
Result = VB_TMC_DoMeasure(TMC_DEF_DIST, TMC_AUTO_INC) 
If Result <> RC_OK Then 
    Result = VB_TMC_DoMeasure(TMC_CLEAR, TMC_AUTO_INC) 
    ' Display error message 
    Result = VB_COM_ViewError(Result, "测量出错") 
Else 
    Call main_measure_loop 
End If 
End If 
     
End Sub 
 
Private Sub cmdOpenConnection_Click() 
If Not bApplRunning Then 
   
  Result = VB_COM_Init() 
  If Result = RC_OK Then 
    'open com port 2 
    Result = VB_COM_OpenConnection(ComPort, Baudrate, RETRIES_1) 
    If Result = RC_OK Then 
        bApplRunning = True 
        cmdOpenConnection.Enabled = False 
    Else 
      'could not open port 2 
      '->check com param on instr side 
      ViewError Result ' Display error message 
      Call VB_COM_End 'reinitialize comunication package 
    End If 
  Else 
    'could not initialize comunication package 
    '->on this time should not happen (it's only for future use) 
    ViewError Result ' Display error message 
  End If 
End If 
End Sub 
 
Private Sub cmdWriteToFile_Click() 
    Dim i As Integer, j As Integer 
    Dim mPoint As Integer, nPoint As Integer 
    Dim PtType(300) As Integer, PtSequence(300) As Integer 
    j = 0 
    mPoint = 0 
    nPoint = 0 
    Open App.Path & "\DataFiles\oridata.txt" For Output As #10 
    For i = 1 To numeric 
        Write #10, Val(resultList.ListItems(i).ListSubItems(1).Text), resultList.ListItems(i).ListSubItems(2).Text, Val(resultList.ListItems(i).ListSubItems(3).Text), Val(resultList.ListItems(i).ListSubItems(4).Text), Val(resultList.ListItems(i).ListSubItems(5).Text) 
        PtType(i) = Val(resultList.ListItems(i).ListSubItems(3).Text) 
    Next i 
    Close #10 
     
    For i = 1 To numeric 
        If (PtType(i) = 2) Or (PtType(i) = 0) Then 
            j = j + 1 
            mPoint = mPoint + 1 
            PtSequence(j) = i 
        End If 
    Next i 
    For i = 1 To numeric 
        If (PtType(i) = 3) Then 
            j = j + 1 
            nPoint = nPoint + 1 
            PtSequence(j) = i 
        End If 
    Next i 
     
    SetIniN "初始设置", "基准点数目", mPoint 
    SetIniN "初始设置", "变形点数目", nPoint 
    frmMain.txtJZ.Text = mPoint 
    frmMain.txtBX.Text = nPoint 
     
    Open App.Path & "\DataFiles\oridata.txt" For Append As #10 
    For i = 1 To numeric 
    If i < numeric Then 
        Write #10, PtSequence(i), 
    Else 
        Write #10, PtSequence(i) 
    End If 
    Next i 
    Close #10 
 
    MsgBox "写入文件成功!", vbOKOnly + 64, "提示" 
End Sub 
 
' Function initialize the used global variablen 
Private Sub Form_Initialize() 
    'initialize global variable 
    bApplRunning = False        ' running flag 
    bApplAborted = False        ' abbort flag 
    bDistButtonPressed = False  ' distance button flag 
    bTrkActiv = False           ' tracking measurement activ or not 
    EdmMeasPrgm = 0             ' default dist measurement program 
    ComPort = COM_1             ' default port 1 
    numeric = 0 
End Sub 
 
Private Sub Form_Load() 
resultList.View = lvwReport 
resultList.FullRowSelect = True 
resultList.GridLines = True 
resultList.ColumnHeaders.Clear 
resultList.ListItems.Clear 
resultList.LabelEdit = lvwAutomatic 
resultList.HideSelection = True 
resultList.SortKey = 0 
With resultList.ColumnHeaders 
    .Add , , "编号", 600 
    .Add , , "点号", 1000 
    .Add , , "点名", 1000 
    .Add , , "类别", 1000 
    .Add , , "水平角", 1000 
    .Add , , "垂直角", 1000 
End With 
    resultList.PictureAlignment = lvwTile 
    resultList.Picture = LoadResPicture(101, vbResBitmap) 
    Call setFlatHeader(resultList, frmStudy) 
End Sub 
 
' Function reinitialize GeoCom, so you can use 
' again GeoCom 
Private Sub Form_Unload(Cancel As Integer) 
If bApplRunning Then 
    ' stop running measurements and clear distance data 
    Call VB_TMC_DoMeasure(TMC_CLEAR, TMC_AUTO_INC) 
     
    'terminate comunication with instr 
    Result = VB_COM_CloseConnection() 
    If Result <> RC_OK Then 
       'reinitialize comunication package 
        Call VB_COM_End 
       ' Display error message 
       ViewError Result 
    End If 
    'reinitialize comunication package 
    Call VB_COM_End 
End If 
End Sub 
 
' Function displayed the various error messages 
Public Sub ViewError(ByVal Result As Integer) 
    ' display error message 
    Call VB_COM_ViewError(Result, "Error") 
End Sub 
 
' Function represent a simple measure task, 
' he gets and displayed the HZ/V angles and 
' (if measured) the distance 
Public Sub main_measure_loop() 
  Result = VB_TMC_GetAngle5(OnlyAngle, TMC_AUTO_INC) 
  If Result = RC_OK Or Result = TMC_NO_FULL_CORRECTION Or Result = TMC_ACCURACY_GUARANTEE Then 
     
    ' convert HZ angle rad to gon 
    OnlyAngle.dV = RadToDfm(OnlyAngle.dV) 
     
    ' generate output string 
    frmStudy.txtVAngle.Text = Format(Round(OnlyAngle.dV, 5)) 
    frmStudy.txtVAngle.Refresh 
     
    ' convert HZ angle rad to gon 
    OnlyAngle.dHz = RadToDfm(OnlyAngle.dHz) 
    ' generate output string 
    frmStudy.txtHZAngle.Text = Format(Round(OnlyAngle.dHz, 5)) 
    frmStudy.txtHZAngle.Refresh 
  Else 
    ' display error message 
    ViewError Result 
  End If 
End Sub 
 
Private Sub resultList_ItemClick(ByVal Item As MSComctlLib.ListItem) 
If resultList.SelectedItem.Text <> "" Then 
    cmdEdit.Enabled = True 
    txtNumber.Text = Item.ListSubItems(1).Text 
    txtName.Text = Item.ListSubItems(2).Text 
    txtType.Text = Item.ListSubItems(3).Text 
    txtHZAngle.Text = Item.ListSubItems(4).Text 
    txtVAngle.Text = Item.ListSubItems(5).Text 
End If 
End Sub 
 
Private Sub txtType_Change() 
'If txtType.Text <> 0 Or txtType.Text <> 2 Or txtType.Text <> 3 Then 
'   MsgBox "类型输入不正确", vbOKOnly + 16, "警告" 
'   txtType.Text = "" 
''   txtType.SetFocus 
'End If 
End Sub