scrollingsplashscreen.frm

社区医疗管理系统 用vb开发的简单社区卫生组织用的管理系统

VERSION 5.00
Begin VB.Form frmScrollingSplashScreen 
   AutoRedraw      =   -1  'True
   BackColor       =   &H0000FF00&
   BorderStyle     =   0  'None
   Caption         =   "About Your Program...."
   ClientHeight    =   4230
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6255
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   15
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4230
   ScaleWidth      =   6255
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer timScrollText 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   1320
      Top             =   3480
   End
   Begin VB.Frame fraPictureBoxes 
      BackColor       =   &H0000FF00&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4155
      Left            =   60
      TabIndex        =   0
      Top             =   -20
      Width           =   6100
      Begin VB.PictureBox picBackgroundBuffer 
         AutoRedraw      =   -1  'True
         BackColor       =   &H0000FF00&
         BorderStyle     =   0  'None
         FillColor       =   &H00404040&
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   14.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   3945
         Left            =   60
         Picture         =   "ScrollingSplashScreen.frx":0000
         ScaleHeight     =   197.25
         ScaleMode       =   2  'Point
         ScaleWidth      =   300.75
         TabIndex        =   1
         Top             =   150
         Visible         =   0   'False
         Width           =   6020
      End
      Begin VB.PictureBox picTempBuffer 
         BackColor       =   &H0000FF00&
         BorderStyle     =   0  'None
         FillColor       =   &H00404040&
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   9
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   3945
         Left            =   60
         ScaleHeight     =   3945
         ScaleWidth      =   6015
         TabIndex        =   3
         Top             =   150
         Visible         =   0   'False
         Width           =   6010
      End
      Begin VB.PictureBox picDestinationBuffer 
         AutoRedraw      =   -1  'True
         BackColor       =   &H00000000&
         BorderStyle     =   0  'None
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   11.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   3945
         Left            =   90
         ScaleHeight     =   3945
         ScaleWidth      =   6000
         TabIndex        =   2
         Top             =   150
         Width           =   6000
      End
   End
End
Attribute VB_Name = "frmScrollingSplashScreen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/18
'描    述：社区医疗点数据管理系统 Ver 1.0
'网    站：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 m_strTextArray() As String
Dim m_lngCurrentY    As Long





Private Sub Form_Load()
       
   Call m_subLoadTextArrayFromFile(App.Path & "\ScrollingSplashScreen.txt", m_strTextArray)
      
   Call m_subInitializePictureBoxes
    
   Call m_subInitializeTimer(15)
   
End Sub





Private Sub Form_Unload(Cancel As Integer)

   Unload Me
   Set frmScrollingSplashScreen = Nothing
   
End Sub

Private Sub timScrollText_Timer()
   
   Dim l_blnContinueToScrollText As Boolean
   
   
   l_blnContinueToScrollText = g_funScrollText(m_strTextArray, _
                                               picBackgroundBuffer, _
                                               picTempBuffer, _
                                               picDestinationBuffer, _
                                               &HC0FFFF, _
                                               &H80FF&, _
                                               m_lngCurrentY, _
                                               100, _
                                               vbCenter)
                        
   m_lngCurrentY = m_lngCurrentY - 1
   
   If Not (l_blnContinueToScrollText) Then
      Unload Me
   End If
   
End Sub



Private Sub m_subInitializePictureBoxes()
    
   picBackgroundBuffer.ScaleMode = vbPixels
   picBackgroundBuffer.AutoRedraw = True
   picBackgroundBuffer.Visible = False
    
   picTempBuffer.ScaleMode = vbPixels
   picTempBuffer.AutoRedraw = True
   picTempBuffer.Visible = False
    
   picDestinationBuffer.ScaleMode = vbPixels
   picDestinationBuffer.AutoRedraw = True
   picDestinationBuffer.Visible = True
    
   m_lngCurrentY = picDestinationBuffer.ScaleHeight
    
End Sub

Private Sub m_subInitializeTimer(ByVal v_intInterval As Integer)

   timScrollText.Interval = v_intInterval
   timScrollText.Enabled = True

End Sub

Private Sub m_subLoadTextArrayFromFile(ByVal v_strFile As String, _
                                       ByRef v_strTextArray() As String)

   On Error GoTo ERROR_HANDLER
   
   Dim l_lngIndex As Long
   
   
   Open (v_strFile) For Input Access Read Shared As #1
    
   Do Until EOF(1)
      ReDim Preserve v_strTextArray(l_lngIndex)
      
      Line Input #1, v_strTextArray(l_lngIndex)
      
      l_lngIndex = l_lngIndex + 1
   Loop
   
   Close #1

EXIT_HANLDER:
   Exit Sub
   
ERROR_HANDLER:
   ReDim Preserve v_strTextArray(3)
   
   v_strTextArray(0) = "Error, Unable To Load File"
   v_strTextArray(1) = ""
   v_strTextArray(2) = "Contact You Supervisor"
   v_strTextArray(3) = "For Assistance"
   
End Sub