Attribute VB_Name = "公用函數(shù)"
Public MyPath As String
Public MName As String
Public MyStr As String
Public 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
Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Long) As Integer
Const ERROR_SUCCESS = &H0
Const COPY_PUT = &HCC0020
'------------------------------------------------------------------
Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Any) As Long
Global Const HELP_QUIT = 2
Global Const HELP_INDEX = 3
Global Const HELP_HELPONHELP = 4
Global Const HELP_PARTIALKEY = &H105
'-------------------------------
'使窗體始終保持在最前面
Public Declare Function SetWindowPos Lib "user32" _
         (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
          ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Public Function PutWindowOnTop(pFrm As Form)
  Dim lngWindowPosition As Long
  lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Function
' WindowOnTop.bas
'-----------------
'
' Use the following code in the form_load event of the form you
' want put onto of all the other forms on the screen.
'
'    Call PutWindowOnTop ( Me )
'
Function TeShuFont(FormName, WenBen As String, XiaoGuo As String, x, y, FontColor As Integer)
'程序說明:
'FormName 為窗體名稱
'WenBen 為所要顯示的文字
'XiaoGuo 為效果標志
'當XiaoGuo 為D、F、Y時對應(yīng)為雕刻、浮雕及陰影效果
'x , y為文字顯示的位置
'函數(shù)調(diào)用示例:
'在窗口Me中200,390處顯示具有雕刻效果的文字“北京勘測設(shè)計研究院".
'Private Sub Form_Load()
'    Me.Show
'    Me.BackColor = QBColor(6)
'    Me.FontName = "隸書"
'    Me.FontSize = 20
'    TeShuFont Me, "北京勘測設(shè)計研究院", "F", 200, 390，5
'End Sub
    FormName.CurrentX = x
    FormName.CurrentY = y
    If Left(XiaoGuo, 1) = "d" Or Left(XiaoGuo, 1) = "D" Then
      X1 = -18: Y1 = -20
     ElseIf Left(XiaoGuo, 1) = "f" Or Left(XiaoGuo, 1) = "F" Then
      X1 = 10: Y1 = 20
     ElseIf Left(XiaoGuo, 1) = "y" Or Left(XiaoGuo, 1) = "Y" Then
      X1 = 50: Y1 = -20
    End If
    FormName.ForeColor = QBColor(15)
    FormName.Print WenBen
    FormName.CurrentX = x + X1
    FormName.CurrentY = y + Y1
    FormName.ForeColor = QBColor(FontColor)
    FormName.Print WenBen
End Function
Sub HelpFunction(lhWnd As Long, HelpCmd As Integer, HelpKey As String)
 Dim lRtn As Long 'declare the needed variables
 If HelpCmd = HELP_PARTIALKEY Then
   lRtn = WinHelp(lhWnd, App.Path + "\help.hlp", HelpCmd, HelpKey)
  Else
   lRtn = WinHelp(lhWnd, App.Path + "\help.hlp", HelpCmd, 0&)
 End If
End Sub

Function FileExist(FileName As String) As Boolean
'判斷文件是否存在的函數(shù)
  FileExist = IIf(Dir(FileName) <> "", True, False)
End Function
Public Function SetFormPic(Tform As Object, TPic As Object) As Variant
'用時在Private Sub Form_Paint()下寫入“SetFormPic Me, Picture2”，即將Picture2充滿窗體
Dim II, JJ As Integer
For II = 0 To Tform.ScaleWidth \ TPic.Width
 For JJ = 0 To Tform.ScaleHeight \ TPic.Height
  Tform.PaintPicture TPic, i * TPic.Width, j * TPic.Height
 Next JJ
Next II
End Function

Sub delay(ByVal n As Single)
    Dim tm1 As Single, tm2 As Single
    tm1 = Timer
    Do
        tm2 = Timer
        If tm2 < tm1 Then tm2 = tm2 + 86400
        If tm2 - tm1 > n Then Exit Do
        DoEvents
    Loop
End Sub
Sub Main()

    ' 顯示"標志"，并且等待 2 秒
   ' Form3.Show
   ' delay 2
   ' MDIFrmMain.Show
    ' 顯示"登錄"窗體，采取強制響應(yīng)方式
    ' delay 2
    ' Unload Form3
'******************************原來的
    ' 顯示"標志"，并且等待 2 秒
  Form3.Show
    delay 1
    FrmHY.Show
    ' 顯示"登錄"窗體，采取強制響應(yīng)方式
     delay 2
     Unload Form3
    frmLogin.Show vbModal
 ' If Not frmLogin.cmdOK Then
 '       MsgBox "未完成用戶名稱和密碼輸入", vbCritical
 '       End
 '  End If
   Unload frmLogin
  Unload FrmHY
    
    ' 顯示"主"窗體
End Sub