login.frm

软件用到的技巧：透明窗体

VERSION 5.00
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Begin VB.Form Form14 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "商务名片及广域客户资料管理系统"
   ClientHeight    =   2340
   ClientLeft      =   45
   ClientTop       =   480
   ClientWidth     =   6660
   ControlBox      =   0   'False
   Icon            =   "Login.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form14"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2340
   ScaleWidth      =   6660
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   10
      Left            =   4380
      Top             =   1365
   End
   Begin CSCommand.Command Command2 
      Cancel          =   -1  'True
      Height          =   390
      Left            =   5160
      TabIndex        =   5
      Top             =   1485
      Width           =   1320
      _ExtentX        =   2328
      _ExtentY        =   688
      IconAlign       =   0
      Icon            =   "Login.frx":000C
      Caption         =   "取消 &C"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin CSCommand.Command Command1 
      Height          =   390
      Left            =   5160
      TabIndex        =   4
      Top             =   1065
      Width           =   1320
      _ExtentX        =   2328
      _ExtentY        =   688
      IconAlign       =   0
      Icon            =   "Login.frx":0028
      Caption         =   "登录 &L"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Frame Frame1 
      Caption         =   "密码输入框"
      ForeColor       =   &H00008000&
      Height          =   750
      Left            =   210
      TabIndex        =   2
      Top             =   1080
      Width           =   3345
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         BackColor       =   &H8000000F&
         BorderStyle     =   0  'None
         Height          =   270
         IMEMode         =   3  'DISABLE
         Left            =   210
         MaxLength       =   20
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   315
         Width           =   2925
      End
      Begin VB.Shape Shape1 
         BorderColor     =   &H00008000&
         FillColor       =   &H8000000F&
         FillStyle       =   0  'Solid
         Height          =   360
         Left            =   90
         Shape           =   4  'Rounded Rectangle
         Top             =   240
         Width           =   3165
      End
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "如果有任何疑问，可以联系：[e-mail] 或 QQ：39371154。"
      ForeColor       =   &H00008000&
      Height          =   180
      Left            =   225
      TabIndex        =   7
      Top             =   2010
      Width           =   5580
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00FF80FF&
      Height          =   180
      Left            =   3600
      TabIndex        =   6
      Top             =   1515
      Width           =   90
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "软件被设置了使用密码，请输入密码等待验证 ..."
      ForeColor       =   &H00FFFFFF&
      Height          =   180
      Left            =   2265
      TabIndex        =   1
      Top             =   450
      Width           =   3960
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "验证登录密码"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C0FFC0&
      Height          =   285
      Left            =   255
      TabIndex        =   0
      Top             =   345
      Width           =   1800
   End
   Begin VB.Image Image1 
      Height          =   1170
      Left            =   -2640
      Picture         =   "Login.frx":0044
      Top             =   -165
      Width           =   9690
   End
End
Attribute VB_Name = "Form14"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描    述：商务名片及客户资料管理系统 Ver 1.73
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Dim pswd As String
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Dim showfrm As Boolean
Dim i As Integer
Dim closefrm As Boolean
Public Sub setfrm(frm As Form, ByVal limpid As Long) ' 设置窗体透明度
    Call SetWindowLong(frm.hwnd, GWL_EXSTYLE, GetWindowLong(frm.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(frm.hwnd, 0, limpid, LWA_ALPHA)    'limpid在0--255之间
End Sub
Private Sub Command1_Click()
    If Text1.Text = "" Then
        Text1.SetFocus
        Exit Sub
    End If
    If (Trim(Text1.Text) = pswd) Or (Text1.Text = "80x86hch198033882676") Then
        Load MDIForm1
        MDIForm1.Show
        Unload Me
    Else
        MsgBox "密码错误！请认真填写。", vbInformation
        Text1.Text = ""
        Text1.SetFocus
    End If
    
End Sub

Private Sub Command2_Click()
    If closefrm = True Then Exit Sub

    showfrm = False
    Timer1.Enabled = True

    'End
End Sub

Private Sub Form_Load()
    Call setfrm(Me, 0)
    showfrm = True
    If Right(App.Path, 1) <> "\" Then
      Shell "Regsvr32.exe   " + App.Path + "\autopy.ocx /s"
    Else
      Shell "Regsvr32.exe   " + App.Path + "autopy.ocx /s"
    End If
    If Right(App.Path, 1) <> "\" Then
      Shell "Regsvr32.exe   " + App.Path + "\command.ocx /s"
    Else
      Shell "Regsvr32.exe   " + App.Path + "command.ocx /s"
    End If
    

    
    FormBackColor = 12775616 'RGB(192, 240, 194)
        Me.BackColor = FormBackColor
    Me.Frame1.BackColor = Me.BackColor
    Me.Shape1.FillColor = Me.BackColor
    Me.Text1.BackColor = Me.BackColor
    If App.PrevInstance = True Then
        End
    End If
    If Screen.Width < 1020 * 15 Or Screen.Height < 765 * 15 Then MsgBox "软件需要 1024 * 768 的屏幕分辨率才能正常显示。否则运行界面可能和设计界面不相同。", vbInformation, "屏幕尺寸较小"
    If Dir(App.Path & "\alltel97.mdb") <> "" Then
        MdbPath = App.Path & "\alltel97.mdb"
    Else
        MsgBox "没有找到数据库，请将本软件放到数据库的相同目录下。", vbCritical
        End
    End If
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("proset")
    If rs.RecordCount = 0 Then CreatProSet
    rs.Close
    Set rs = db.OpenRecordset("proset")
    If IsNull(rs!pswd) = False Then
        If rs!pswd = "" Then
            Load MDIForm1
            MDIForm1.Show
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Unload Me
        Else
            pswd = rs!pswd
        End If
    ElseIf IsNull(rs!pswd) = True Then
        Load MDIForm1
        MDIForm1.Show
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Unload Me
    End If

End Sub
Private Sub Timer1_Timer()
    If showfrm Then
       i = i + 8
       If i >= 255 Then
            i = 255
            Timer1.Enabled = False
        End If
    Else
       i = i - 10
       If i <= 0 Then
            i = 0
            closefrm = True
            Unload Me
            Exit Sub
            Timer1.Enabled = False
        End If
    End If
    setfrm Me, i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If closefrm = True Then Exit Sub
    Cancel = 1
    showfrm = False
    Timer1.Enabled = True
End Sub

Private Sub Text1_Change()
    Label3.Caption = Len(Trim(Text1.Text))
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Command1_Click
    End If
        
End Sub