frmsplash.frm

金算盘软件代码

VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Begin VB.Form frmSplash 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   4236
   ClientLeft      =   252
   ClientTop       =   1416
   ClientWidth     =   5688
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   DrawStyle       =   5  'Transparent
   Icon            =   "frmSplash.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4236
   ScaleWidth      =   5688
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox picAvi 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   4368
      Left            =   -36
      ScaleHeight     =   4344
      ScaleWidth      =   5712
      TabIndex        =   0
      Top             =   -72
      Width           =   5736
      Begin MCI.MMControl MMControl1 
         Height          =   624
         Left            =   972
         TabIndex        =   1
         Top             =   1332
         Visible         =   0   'False
         Width           =   3180
         _ExtentX        =   5609
         _ExtentY        =   1101
         _Version        =   393216
         UpdateInterval  =   100
         DeviceType      =   ""
         FileName        =   ""
      End
   End
End
Attribute VB_Name = "frmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private lngResoureID As Long            '资源ID


Private Sub Form_Load()
Dim strFileAVI As String, strFileBMP As String, strPath As String
    On Error GoTo ErrHandle
    lngResoureID = 0
    Me.Height = 360 * Screen.TwipsPerPixelY
    Me.width = 480 * Screen.TwipsPerPixelX
    strPath = App.Path
    If Right(strPath, 1) = "\" Then
        strFileAVI = strPath & "GaSoft.AVI"
    Else
        strFileAVI = strPath & "\GaSoft.AVI"
    End If
    If Dir(strFileAVI) = "" Then GoTo ErrHandle '未找到动画文件，则加载一般图片
    picAvi.Height = Me.Height + 100
    picAvi.width = Me.width + 150
    MMControl1.hWndDisplay = picAvi.hwnd
'    MMControl1.Notify = False
'    MMControl1.Wait = True
    MMControl1.Silent = False
'    MMControl1.UpdateInterval = 1000
'    MMControl1.Shareable = False
    MMControl1.DeviceType = "AVIVideo"
    MMControl1.FileName = strFileAVI
    MMControl1.Command = "Open"
    MMControl1.Command = "Play"
    Exit Sub
ErrHandle:
    On Error Resume Next
    If Right(strPath, 1) = "\" Then
        strFileBMP = strPath & "GaSoft.BMP"
    Else
        strFileBMP = strPath & "\GaSoft.BMP"
    End If
    If Dir(strFileBMP) = "" Then
        #If conVersionType = 1 Then
           Set picAvi.Picture = Utility.GetFormResPicture(11390, vbResBitmap)
           lngResoureID = 11390
        #Else
           #If conVersionType = 16 Then
               If InStr(1, App.title, "医疗") <> 0 Then
                  Set picAvi.Picture = Utility.GetFormResPicture(11529, vbResBitmap)
                  lngResoureID = 11529
               Else
                  If InStr(1, App.title, "行政事业") <> 0 Then
                     Set picAvi.Picture = Utility.GetFormResPicture(11528, vbResBitmap)
                     lngResoureID = 11528
                  Else
                     Set picAvi.Picture = Utility.GetFormResPicture(138, vbResBitmap)
                     lngResoureID = 138
                  End If
               End If
           #End If
        #End If
    Else
        Set picAvi.Picture = LoadPicture(strFileBMP)
        lngResoureID = -1
    End If
    Me.Height = picAvi.Height
    Me.width = picAvi.width
    Me.ScaleHeight = picAvi.Height
    Me.ScaleWidth = picAvi.width
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    MMControl1.Command = "Close"
    Set picAvi.Picture = Nothing
    If lngResoureID > 0 Then
        Utility.RemoveFormResPicture lngResoureID
    End If
End Sub
'查询动画运行状态
Public Function HaveComplete() As Boolean
    Debug.Print MMControl1.Mode
    HaveComplete = IIf(lngResoureID <> 0, True, IIf(MMControl1.Mode <> 567, True, False)) 'blnHaveComplete
End Function
'是否刷新
Public Function ActiveRefresh() As Boolean
    ActiveRefresh = IIf(lngResoureID = 0, False, True)
End Function