模仿QQ宠物(nopet v1.0源代码) VB版

    QQ宠物是以flash作为素材的,在其QQPet目录下面的Common目录里即是QQ宠物展示的各种表情和动作.我们要实现的就是在桌面的一个窗体显示flash文件,并根据不同的窗体状态和其他消息响应来显示相应的flash文件.
    1.透明窗体.建立一个工程,新建一个无标题栏的窗体.在窗体上添加一个flash控件.因为宠物运行时是以桌面为背景,所以我们需要将flash控件的WMode设为透明,并将窗体设置为透明的.
    源码为:
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal
hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As
Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const COLDNEY_COLOR = &H999999
Private Sub frmSetTransparence(frm As Form)
    Dim WindowExs As Long, Color As Long
    WindowExs = GetWindowLong(frm.hwnd, GWL_EXSTYLE)
    WindowExs = WindowExs or WS_EX_LAYERED
    SetWindowLong frm.hwnd, GWL_EXSTYLE, WindowExs
    SetLayeredWindowAttributes frm.hwnd, COLDNEY_COLOR, 0, LWA_COLORKEY
End Sub
     2.装载宠物flash素材.首先要取得flash模型所在的路径,然后存储在一个文件列表框里(当然也可以放在其它地方).通过读取列表框里的文件就以动态显示flash文件.

     源码(简单循环播放)为:
Dim PlayFileNum As Integer
Dim TotalFile As Integer
Dim FilePath As String
FilePath = File1.Path
If Right(FilePath, 1) <> "\" Then
     FilePath = FilePath & "\"
End If
TotalFile = File1.ListCount
File1.ListIndex = 0  'int(rnd()*(file1.listcount-1))
PlayFileNum = File1.ListIndex
Private Sub NextFlashFilePlay()
    PlayFileNum = PlayFileNum + 1
    Form1.Flash1.Movie = ""
    Form1.Flash1.Movie = FilePath + File1.List(PlayFileNum)
    Form1.Flash1.Play
    Flash1.Loop = False
End Sub
Private Sub Timer_Timer()
If (PlayFileNum = TotalFile - 1) Then PlayFileNum = 0
    If Form1.Flash1.CurrentFrame >= Form1.Flash1.TotalFrames - 4 Then
    Call NextFilePlay
End If
End Sub
      3.窗体的拖动及移动.因为flash控件没有鼠标事件支持,最简单的方法可以采用在flash控件上放一个透明的Lable,当然你也可以用子类化处理和局部hook右键.窗体自移动可以添加在鼠标事件中.拖动窗体采用计算鼠标移动量来移动窗体位置可以防止虚线框.

源码为:
Dim MoveScreen As Boolean
Dim MousX As Integer
Dim MousY As Integer
Dim CurrX As Integer
Dim CurrY As Integer
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As
Single, Y As Single)
If Button = 1 Then
    MoveScreen = True
    MousX = x
    MousY = Y
ElseIf Button = 2 Then
    'other event
End If
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As
Single, Y As Single)
If MoveScreen Then
    CurrX = Form1.Left - MousX + x
    CurrY = Form1.Top - MousY + Y
    Form1.Move CurrX, CurrY
End If
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, x As
Single, Y As Single)
    MoveScreen = False
End Sub
  4.到此,你就可以看到一个最简单的宠物模型.其它功能比如,变大小可以改变窗体大小,然后让控件跟着自适应就可以了.也可以在窗体的移动状态下显示不同的flash文件.也可以用timer控制显示flash文件.完整源代码稍后提供(没空间).

号外:nopet v2.0 demo版(没服务器)即将(何年何月)发布,呵呵,不再模仿QQ,基于C/S模
式.
                                          NOP-STUDIO
                                          2007.01.29