form1.frm

来自「主要靠调用API函数实现图片框的透明从而实现动画,」· FRM 代码 · 共 69 行

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GdiTransparentBlt Lib "gdi32" (ByVal hdc1 As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal W1 As Long, ByVal H1 As Long, ByVal Hdc2 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal W2 As Long, ByVal H2 As Long, ByVal Color As Long) As Long
Private WithEvents Timer1 As Timer
Attribute Timer1.VB_VarHelpID = -1
Private WithEvents Picture1 As PictureBox
Attribute Picture1.VB_VarHelpID = -1
Dim picname$, picno%, appdisk$, W&, H&, transcolor$, x1%, y1%
Dim N%, L%, C$, ud As Boolean
Const Captions As String = "老姜头 的动画"
Private Sub Form_Load()
   appdisk = Trim(App.Path)
   If Right(appdisk, 1) <> "\" Then appdisk = appdisk & "\"
   With Me
      .AutoRedraw = True
      If Dir(appdisk & "bchscale.jpg") <> "" Then .Picture = LoadPicture(appdisk & "bchscale.jpg")
      .Width = 7000
      .Height = 5160
      .Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
      .ScaleMode = 3
   End With
   Set Picture1 = Controls.Add("vb.picturebox", "Picture1")
   With Picture1
      .Visible = True
      .AutoSize = True
      .AutoRedraw = True
      .BorderStyle = 0
      .Move Screen.Width
      If Dir(appdisk & "girls.gif") <> "" Then .Picture = LoadPicture(appdisk & "girls.gif")
   End With
   picno = 1
   W = Picture1.Width: H = Picture1.Height \ 6
   Set Timer1 = Controls.Add("vb.timer", "Timer1")
   Timer1.Interval = 100
   transcolor = RGB(99, 0, 255)
   x1 = 58: y1 = 33
End Sub
Private Sub Timer1_Timer()
   Me.Cls
   GdiTransparentBlt Me.hDC, x1, y1, W, H, Picture1.hDC, 0, 120 * (picno - 1), W, H, transcolor
   'GdiTransparentBlt Me.hDC, x1, y1, W / 2, H / 2, Picture1.hDC, 0, 120 * (picno - 1), W, H, transcolor '缩小一半
   picno = IIf(picno >= 6, 1, picno + 1)
   y1 = IIf(ud, y1 + 2, y1 - 2)
   ud = IIf(y1 >= 66 Or y1 <= 0, Not ud, ud)
   '*********** 滚动标题栏
   L = Int(Me.Width / 110)
   C = String(L, " ") & Captions & String(L, " ")
   N = N + 1
   If N > Len(C) - L Then N = 1
   Me.Caption = Mid(C, N, L)
End Sub