frmgradcredits.frm

一个ERP系统可以用来学习之用

VERSION 5.00
Begin VB.Form frmGradCredits 
   Caption         =   "特别说明："
   ClientHeight    =   5790
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6765
   LinkTopic       =   "Form1"
   ScaleHeight     =   5790
   ScaleWidth      =   6765
   Begin VB.Timer Redrawtimer 
      Interval        =   1
      Left            =   360
      Top             =   5280
   End
   Begin VB.PictureBox Picbackbuffer 
      AutoRedraw      =   -1  'True
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5175
      Left            =   120
      ScaleHeight     =   5115
      ScaleWidth      =   6435
      TabIndex        =   3
      Top             =   120
      Visible         =   0   'False
      Width           =   6495
   End
   Begin VB.PictureBox Picbuffer 
      AutoRedraw      =   -1  'True
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5175
      Left            =   120
      ScaleHeight     =   5115
      ScaleWidth      =   6435
      TabIndex        =   2
      Top             =   120
      Visible         =   0   'False
      Width           =   6495
   End
   Begin VB.PictureBox picOut 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000007&
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5175
      Left            =   120
      ScaleHeight     =   5115
      ScaleWidth      =   6435
      TabIndex        =   1
      Top             =   120
      Width           =   6495
   End
   Begin VB.CommandButton cmdoK 
      Caption         =   "退出"
      Height          =   375
      Left            =   2880
      TabIndex        =   0
      Top             =   5400
      Width           =   1095
   End
End
Attribute VB_Name = "frmGradCredits"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const srccopy = &HCC0020
Dim filename As String
Dim ipicheight As Integer
Dim ipicwidth As Integer
Dim Tempstring(1 To 1000) As Variant
Dim lyoffset As Integer
Dim icolorCur As Single
Dim icolorstep As Single
Dim numlines As Integer
Dim lx As Long
Dim ly As Long
Dim strRead As String
Private Sub cmdOK_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    frmGradCredits.BackColor = RGB(77, 116, 244)
    frmGradCredits.Left = (Screen.Width - frmGradCredits.Width) / 2
    frmGradCredits.Top = (Screen.Height - frmGradCredits.Height) / 2 + 300
    Dim iline As Integer
    
    numlines = 1
    frmGradCredits.ScaleMode = vbPixels
    Picbuffer.ScaleMode = vbPixels
    Picbuffer.ForeColor = vbWhite
    Picbuffer.BackColor = vbBlack
    Picbuffer.AutoRedraw = True
    Picbuffer.Visible = False
    
    filename = App.Path & "\" & "credit.txt"
    
    Open filename For Input As #1
        Do Until EOF(1)
            Line Input #1, Tempstring(numlines)
            numlines = numlines + 1
        Loop
            Close #1
     numlines = numlines - 1
     lx = Picbuffer.ScaleLeft
     ly = Picbuffer.ScaleHeight
     
     GradiantBackground Picbackbuffer
     
     Redrawtimer.Interval = 20
     Redrawtimer.Enabled = True
     
End Sub

Private Function GradiantBackground(picbox As PictureBox)
    ipicwidth = picbox.ScaleWidth
    ipicheight = picbox.ScaleHeight
    
    icolorCur = 255
    icolorstep = 5 * (0 - 255) / ipicheight
    
    For lyoffset = 0 To ipicheight Step 5
        picbox.Line (-1, lyoffset - 1)-(ipicwidth, lyoffset + 5), RGB(0, 0, icolorCur), BF
        
        icolorCur = icolorCur + icolorstep
        
     Next lyoffset
     
End Function

Private Sub RedrawTimer_Timer()
Dim l As Long
Dim j As Long

On Error Resume Next
        
    l = BitBlt(Picbuffer.hDC, 0, Picbuffer.ScaleTop, Picbuffer.ScaleWidth, Picbuffer.ScaleHeight, Picbackbuffer.hDC, 0, 0, srccopy)

    For j = 1 To numlines Step 1
      
        Picbuffer.CurrentY = ly + (j * Picbuffer.FontSize + (6 * j))
      
        Picbuffer.CurrentX = (Picbuffer.ScaleWidth / 2) - (Picbuffer.TextWidth(Tempstring(j)) / 2)
   
        
        Picbuffer.ForeColor = vbWhite
  
        If Picbuffer.CurrentY < 245 Then
            
            If Picbuffer.CurrentY > 15 Then
                Picbuffer.ForeColor = RGB((((255 / 235) * Picbuffer.CurrentY)), (((255 / 235) * Picbuffer.CurrentY)), (((255 / 25) * Picbuffer.CurrentY)))
    
            Else
                Picbuffer.ForeColor = vbBlack
   
                If j = numlines And Picbuffer.CurrentY < -25 Then
                    Redrawtimer.Enabled = False
                    
                    Unload Me
                
                End If
            
            End If
        
        End If
        
        Picbuffer.Print Tempstring(j)
    Next j
    
    l = BitBlt(picOut.hDC, 0, picOut.ScaleTop, picOut.ScaleWidth, picOut.ScaleHeight, Picbuffer.hDC, 0, 0, srccopy)
    picOut.Refresh
    
  
    ly = ly - 1

End Sub