main.bas

来自「大量优秀的vb编程」· BAS 代码 · 共 84 行

Attribute VB_Name = "basMain"
'      PURPOSE: To provide the primary module for the application.
'        NOTES: None.
' DEPENDENCIES: "frmSplash"
'   REFERENCES: None.
'    PLATFORMS: VB6.
'      AUTHORS: T.Cummins (TCC) 12/09/2000.
'---------------------------------------------------------------------------------------------------------------------

Option Explicit

'Application info for display in the Splash and About forms.
Public Const pcstrAppPlatform As String = "Win 95/98/NT4"

'API declaration used to ensure Splash screen stays on top.
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_HWNDPARENT = (-8)

Sub Main()
    
  '    PURPOSE: To execute code on start-up of the application.
  '      NOTES: None.
  '  ARGUMENTS: None.
  '    RETURNS: None.
  '    AUTHORS: T.Cummins (TCC) - 12/09/2000.
  '---------------------------------------------------------------------------------------------------------------------
  
  On Error GoTo HandleErrors
      
  frmSplash.Platform = pcstrAppPlatform
  frmSplash.Show
  
  
  'Ensure the Splash form is refreshed prior to displaying the Main form.
  DoEvents
                
  '---------------------------------------------------------------------------------------------------------------------

  'Perform other start up tasks here...
      
  'For demo purposes we add a delay to simulate a typical applications initialisation.
  DemoDelay
  
  '---------------------------------------------------------------------------------------------------------------------
  
  frmMain.Show
  
  DoEvents
      
  Unload frmSplash

ExitHandleErrors:
  
  Exit Sub
  
HandleErrors:

  MsgBox Err.Description & " (" & Err.Number & ")", vbCritical, App.Title & " Error"
  Resume ExitHandleErrors

End Sub

Public Sub DemoDelay()

  '    PURPOSE: To provide a delay in program execution (4 seconds) to simulate a typical applications
  '             initialisation (eg. connecting to a database)...
  '
  '      NOTES: THIS SUB-ROUTINE IS NOT REQUIRED IN A PRODUCTION APPLICATION.
  '
  '  ARGUMENTS: None.
  '    RETURNS: None.
  '    AUTHORS: T.Cummins (TCC) - 12/09/2000.
  '---------------------------------------------------------------------------------------------------------------------
  
  On Error Resume Next
      
  Dim sngStartTime As Single
  sngStartTime = Timer
  Do Until (Timer - sngStartTime) > 4
      DoEvents
  Loop

End Sub