如何让图片控件中的图片文字动起来？

Question

在VB中如何让图片控件中的图片文字动起来？如象PPT中的打字效果，逐行显示，从中间往外辐射，旋转显示出来等？

Answer 1

'These are the delarations to Draw text to a form
'or picture box
Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal Height As Long, ByVal Width As Long, ByVal Escapement As Long, ByVal Orientation As Long, ByVal Weight As Long, ByVal Italic As Long, ByVal Underline As Long, ByVal StrikeOut As Long, ByVal CharSet As Long, ByVal OutputPrecision As Long, ByVal ClipPrecision As Long, ByVal Quality As Long, ByVal PitchAndFamily As Long, ByVal FontFace As String) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'used with fnWeight
Const FW_DONTCARE = 0
Const FW_THIN = 100
Const FW_EXTRALIGHT = 200
Const FW_LIGHT = 300
Const FW_NORMAL = 400
Const FW_MEDIUM = 500
Const FW_SEMIBOLD = 600
Const FW_BOLD = 700
Const FW_EXTRABOLD = 800
Const FW_HEAVY = 900
Const FW_BLACK = FW_HEAVY
Const FW_DEMIBOLD = FW_SEMIBOLD
Const FW_REGULAR = FW_NORMAL
Const FW_ULTRABOLD = FW_EXTRABOLD
Const FW_ULTRALIGHT = FW_EXTRALIGHT
'used with fdwCharSet
Const ANSI_CHARSET = 0
Const DEFAULT_CHARSET = 1
Const SYMBOL_CHARSET = 2
Const SHIFTJIS_CHARSET = 128
Const HANGEUL_CHARSET = 129
Const CHINESEBIG5_CHARSET = 136
Const OEM_CHARSET = 255
'used with fdwOutputPrecision
Const OUT_CHARACTER_PRECIS = 2
Const OUT_DEFAULT_PRECIS = 0
Const OUT_DEVICE_PRECIS = 5
'used with fdwClipPrecision
Const CLIP_DEFAULT_PRECIS = 0
Const CLIP_CHARACTER_PRECIS = 1
Const CLIP_STROKE_PRECIS = 2
'used with fdwQuality
Const DEFAULT_QUALITY = 0
Const DRAFT_QUALITY = 1
Const PROOF_QUALITY = 2
'used with fdwPitchAndFamily
Const DEFAULT_PITCH = 0
Const FIXED_PITCH = 1
Const VARIABLE_PITCH = 2
'used with SetBkMode
Const OPAQUE = 2
Const TRANSPARENT = 1
Public Type Font_Style
Bold As Long
Italic As Boolean
Underline As Boolean
StrikeThough As Boolean
Name As String
Size As Long
End Type
Public Function DrawText(FontStyle As Font_Style, strText As String, Angle As Integer, PicDrawInto As PictureBox, X1 As Long, Y1 As Long) As Long
Dim OldFont As Long
Dim FontWeight As Long
'If FontStyle.Bold Then
'    FontWeight = FW_BOLD
'Else
'    FontWeight = FW_NORMAL
'End If
NewFont = CreateFont(FontStyle.Size, 0, Angle * 10, 0, FontStyle.Bold, FontStyle.Italic, FontStyle.Underline, FontStyle.StrikeThough, ANSI_CHARSET Or DEFAULT_CHARSET Or SYMBOL_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, FontStyle.Name)
OldFont = SelectObject(PicDrawInto.hdc, NewFont)
PicDrawInto.CurrentX = X1
PicDrawInto.CurrentY = Y1
PicDrawInto.Print strText
NewFont = SelectObject(PicDrawInto.hdc, OldFont)
'DeleteObject OldFont
DeleteObject NewFont
End Function
Public Function DrawOptionBox(PicDest As PictureBox, X As Long, Y As Long)
'Draw n (FFFFFF) l (000000) m (C0C0C0) j (808080) k (FFFFFF)
Dim MyFont As Font_Style
With MyFont
.Bold = False
.Italic = False
.Size = 12
.StrikeThough = False
.Underline = False
.Name = "Marlett"
End With
PicDest.ForeColor = &HFFFFFF
Call DrawText(MyFont, "n", 0, PicDest, X, Y)
PicDest.ForeColor = &H0
Call DrawText(MyFont, "l", 0, PicDest, X, Y)
PicDest.ForeColor = &HC0C0C0
Call DrawText(MyFont, "m", 0, PicDest, X, Y)
PicDest.ForeColor = &H808080
Call DrawText(MyFont, "j", 0, PicDest, X, Y)
PicDest.ForeColor = &HFFFFFF
Call DrawText(MyFont, "k", 0, PicDest, X, Y)
End Function
Public Function DrawOptionBoxDot(PicDest As PictureBox, X As Long, Y As Long, Optional iOption As Byte)
'Draw n (FFFFFF) l (000000) m (C0C0C0) j (808080) k (FFFFFF)
Dim MyFont As Font_Style
With MyFont
.Bold = False
.Italic = False
.Size = 12
.StrikeThough = False
.Underline = False
.Name = "Marlett"
End With
PicDest.ForeColor = &H0
Call DrawText(MyFont, Chr(Asc("i") - iOption), 0, PicDest, X, Y)
End Function

Answer 2

俺有一个字幕控件啊！！！！
卖了很久了！！！！
555555555555555555555555帖子都沉到海底了！！！！！5555555555555555555
都申请破产保护了！！！5555555555555555http://expert.csdn.net/Expert/topic/2416/2416623.xml?temp=.6731989