frmabout.frm

1:首先要导入hotel数据

VERSION 5.00
Begin VB.Form frmAbout 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Hotel manage system"
   ClientHeight    =   3645
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5955
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3645
   ScaleWidth      =   5955
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Const DT_BOTTOM As Long = &H8
Const DT_CALCRECT As Long = &H400
Const DT_CENTER As Long = &H1
Const DT_EXPANDTABS As Long = &H40
Const DT_EXTERNALLEADING As Long = &H200
Const DT_LEFT As Long = &H0
Const DT_NOCLIP As Long = &H100
Const DT_NOPREFIX As Long = &H800
Const DT_RIGHT As Long = &H2
Const DT_SINGLELINE As Long = &H20
Const DT_TABSTOP As Long = &H80
Const DT_TOP As Long = &H0
Const DT_VCENTER As Long = &H4
Const DT_WORDBREAK As Long = &H10

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

'the actual text to scroll. This could also be loaded in from a text file
Const ScrollText As String = "Hotel manage system" & vbCrLf & _
                             vbCrLf & vbCrLf & _
                             "CopyRight(C)2005 for Visionking Studio" & vbCrLf & _
                             "Visionking retained the copyright of this software." & _
                             vbCrLf & _
                             vbCrLf & "Studio member：" & _
                             vbCrLf & _
                             vbCrLf & "VisionKing   Mars   Mr.JinHongYu" & _
                             vbCrLf & "Mr.MaNan   Mr.LuoPeng   Mr.LiuLiXin"
                             
Dim EndingFlag As Boolean

Private Sub Form_Activate()
    RunMain
End Sub

Private Sub RunMain()
Dim LastFrameTime As Long
Const IntervalTime As Long = 40
Dim rt As Long
Dim DrawingRect As RECT
Dim UpperX As Long, UpperY As Long 'Upper left point of drawing rect
Dim RectHeight As Long

frmAbout.Refresh

rt = DrawText(picScroll.hdc, ScrollText, -1, DrawingRect, DT_CALCRECT)
    DrawingRect.Top = picScroll.ScaleHeight
    DrawingRect.Left = 0
    DrawingRect.Right = picScroll.ScaleWidth
    RectHeight = DrawingRect.Bottom
    DrawingRect.Bottom = DrawingRect.Bottom + picScroll.ScaleHeight


Do While Not EndingFlag
    If GetTickCount() - LastFrameTime > IntervalTime Then
        picScroll.Cls
        DrawText picScroll.hdc, ScrollText, -1, DrawingRect, DT_CENTER Or DT_WORDBREAK
        DrawingRect.Top = DrawingRect.Top - 1
        DrawingRect.Bottom = DrawingRect.Bottom - 1
        If DrawingRect.Top < -(RectHeight) Then 'time to reset
            DrawingRect.Top = picScroll.ScaleHeight
            DrawingRect.Bottom = RectHeight + picScroll.ScaleHeight
        End If
        picScroll.Refresh
        LastFrameTime = GetTickCount()
    End If
    DoEvents
Loop

Unload Me
Set frmAbout = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
    EndingFlag = True
End Sub
Private Sub lblBack_Click()
    Unload Me
End Sub