sysanimate32.cls

VB6.0编写的医院影像系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SysAnimate32"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const ANIMATE_CLASS = "SysAnimate32" & vbNullChar
Private Const WM_USER = &H400&
Private Const ACS_CENTER = &H1&
Private Const ACS_TRANSPARENT = &H2&
Private Const ACS_AUTOPLAY = &H4&
Private Const ACM_OPEN = WM_USER + 100
Private Const ACM_PLAY = WM_USER + 101
Private Const ACM_STOP = WM_USER + 102
Private Const WS_EX_TRANSPARENT = &H20&
Private Const WS_CHILD = &H40000000
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Private StaticHwnd As Long
Private AnimateHwnd As Long


Public Sub Create(ByVal hwnd As Long, ByVal Id As Variant, ByVal Left As Long, ByVal Top As Long, ByVal width As Long, ByVal height As Long)
    StaticHwnd = CreateWindowEx(WS_EX_TRANSPARENT, "Static", vbNullString, &H50000003, Left, Top, width, height, hwnd, 0&, App.hInstance, ByVal 0&)
    AnimateHwnd = CreateWindowEx(WS_EX_TRANSPARENT, ANIMATE_CLASS, vbNullString, &H50000003, 0, 0, width, height, StaticHwnd, 0&, App.hInstance, ByVal 0&)
    If IsNumeric(Id) Then
        SendMessage AnimateHwnd, ACM_OPEN, 0&, ByVal CLng(Id)
    Else
        SendMessage AnimateHwnd, ACM_OPEN, 0&, ByVal CStr(Id) & vbNullChar
    End If

End Sub

Public Sub pPlay()
    SendMessage AnimateHwnd, ACM_PLAY, -1&, ByVal &HFFFF0000
End Sub

Public Sub pStop()
    SendMessage AnimateHwnd, ACM_STOP, 0&, ByVal 0&
End Sub

Public Sub Destroy()
    Me.pStop
    DestroyWindow AnimateHwnd
    DestroyWindow StaticHwnd
End Sub