维克苗综合站

图片上移动文字

‘************************************************************
‘*程序编号∶030
‘*功    能∶本程序演示了如何在图片上移动文字
‘*日    期∶4/19/1999
‘************************************************************
Option Explicit

Private Const SRCCOPY& = &HCC0020
Private Const SRCAND& = &H8800C6

Private Declare Sub Sleep Lib ”kernel32″ (ByVal dwMilliseconds As Long)
Private Declare Function TextOut& Lib ”gdi32″ Alias ”TextOutA” (ByVal hDC As Long, ByVal X As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long)
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)

Private isBack As Boolean
Private Sub BackText()
    Picture1.FontName = ”宋体”
    Picture1.FontBold = True
    Picture1.FontSize = 25
    Picture1.Cls
    PrintText ”感谢您的支持”
    PrintText ”vbbattlefront”
    PrintText ”永远记着您”
End Sub

Private Sub PrintText(StrText As String)

    Static X          As Long
    Static y          As Long
    Dim dl            As Long
    X = (Picture1.Width - Picture1.TextWidth(StrText)) \ 2
    y = y + Picture1.TextHeight(StrText) + 5
    dl& = TextOut(Picture1.hDC, X, y, StrText, LenB(StrConv(StrText, vbFromUnicode)))
        
End Sub
Private Sub BackPic()
    Dim dl        As Long
    Dim y         As Long
    
    y = (PicOut.Height - Picture1.Height) \ 2
    dl& = BitBlt(PicBack.hDC, 0, 0, PicBack.Width, PicBack.Height, PicOut.hDC, 0, y, SRCCOPY)
End Sub
Private Sub PlayOutText()
    Dim dY As Long
    Dim dl As Long
    Dim y As Long
    
    dY = (PicOut.Height - Picture1.Height) \ 2
    For y = -Picture2.Height To Picture2.Height
        Picture2.Cls
        dl& = BitBlt(Picture2.hDC, 0, 0, Picture2.Width, Picture2.Height, Picture1.hDC, 0, y, SRCCOPY)
        dl& = BitBlt(Picture2.hDC, 0, 0, PicBack.Width, PicBack.Height, PicBack.hDC, 0, 0, vbSrcAnd)
      
        Sleep 20
        DoEvents
        dl& = BitBlt(PicOut.hDC, 0, dY, Picture2.Width, Picture2.Height, Picture2.hDC, 0, 0, SRCCOPY)
    Next
End Sub

Private Sub Command1_Click()
   Command1.Enabled = False
   If Not isBack Then
        BackPic
        BackText
        isBack = True
   End If
   PlayOutText
   Command1.Enabled = True
End Sub

Private Sub Form_Load()
    Form1.ScaleMode = vbPixels
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
    PicBack.ScaleMode = vbPixels
    PicOut.ScaleMode = vbPixels
    
    Picture2.Width = Picture1.Width
    Picture2.Height = Picture1.Height
    PicBack.Width = Picture1.Width
    PicBack.Height = Picture1.Height
    
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = True
    PicBack.AutoRedraw = True
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Random Posts

• WordPress的收费CMS模板下载
• SQL语句性能调整原则
• 新式疗法
• 求职面试易被忽略的12种高级错误
• mysql,access,sql 随机读取N条记录的写法
• 网站赚钱应如何选择网站联盟?
• 关于修改SQL SERVER排序规则
• 是什么使你想到
• 致富新招
• 如何在Windows 2003中配置 NAT 服务器