frmlogin.frm

AO二次开次,运行Startup启动ArcMap程序

VERSION 5.00
Begin VB.Form frmLogin 
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   BorderStyle     =   0  'None
   Caption         =   "登录"
   ClientHeight    =   4515
   ClientLeft      =   3735
   ClientTop       =   3510
   ClientWidth     =   6720
   DrawStyle       =   5  'Transparent
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2667.61
   ScaleMode       =   0  'User
   ScaleWidth      =   6309.712
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCancel 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "取消"
      Height          =   375
      Left            =   5520
      MaskColor       =   &H00FFC0C0&
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   3840
      Width           =   855
   End
   Begin VB.CommandButton cmdOK 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      Caption         =   "登录"
      Height          =   375
      Left            =   4080
      MaskColor       =   &H00C0C0FF&
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   3840
      Width           =   855
   End
   Begin VB.TextBox txtUserName 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   360
      Left            =   4560
      TabIndex        =   0
      Top             =   2640
      Width           =   1815
   End
   Begin VB.TextBox txtPassword 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   4560
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   3240
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "密  码："
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Index           =   1
      Left            =   3600
      TabIndex        =   3
      Top             =   3360
      Width           =   975
   End
   Begin VB.Label lblLabels 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      ForeColor       =   &H0000FFFF&
      Height          =   375
      Index           =   0
      Left            =   3600
      TabIndex        =   2
      Top             =   2760
      Width           =   975
   End
   Begin VB.Image Image1 
      Height          =   4455
      Left            =   0
      Top             =   0
      Width           =   6735
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_pDoc As IDocument
Private m_pApp As IApplication
Private m_pWindowPosition As IWindowPosition
Private WithEvents m_pAppRot As AppROT
Attribute m_pAppRot.VB_VarHelpID = -1
Private Sub cmdCancel_Click()
    '设置全局变量为 False
    '不提示失败的登录
    Me.Hide
    End
End Sub

Sub StartArcMap()
    Me.MousePointer = vbHourglass
    ' Start ArcMap
    Set m_pDoc = New MxDocument
    ' Get a reference to the application
    Set m_pApp = m_pDoc.Parent
    '显示窗体标题：地理信息系统
        m_pApp.Caption = "U2 BT - ArcMap - ArcInfo"
    ' Show ArcMap
    m_pApp.Visible = True
    
    Set m_pWindowPosition = m_pApp
        m_pWindowPosition.State = esriWSMaximize
    '打开一个.mxd文件(地图文档.mxd)
'    m_pApp.OpenDocument App.Path & "\Source\地图文档.mxd"
End Sub


Private Sub cmdOK_Click()
Call Login
End Sub

Private Sub m_pAppRot_AppRemoved(ByVal pApp As esriFramework.IApplication)
  ' Release m_pDoc and m_pApp if you manually exit ArcMap
  If TypeOf pApp Is IMxApplication Then
    If pApp.Document Is m_pDoc Then
      Set m_pDoc = Nothing
      Set m_pApp = Nothing
    End If
  End If
End Sub
Private Sub Form_Load()
    Image1.Picture = LoadPicture(App.Path & "\Source\loginpicture.jpg")
    Set m_pAppRot = New AppROT
'    Init
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set m_pAppRot = Nothing
End Sub

Private Sub Login()
   '检查正确的密码
  On Error GoTo errhandle
If txtUserName = "gis" And txtPassword = "gis" Then
    Me.Hide
    StartArcMap
    Unload Me
Else
   MsgBox "你输入的用户名或密码错误，请重新输入。"
   Exit Sub
End If
errhandle:
  End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Call Login
Else
Exit Sub
End If
End Sub


Private Sub txtSysID_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Call Login
End If
End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Call Login
End If
End Sub