这代码是用在Active Dll里面,因为用的窗体供别的程序调用会提示不能显示非模态的错误,所以想自已制作一个窗口.
窗口创建完成后我就用GDI画个背景和一些字上去,调试的时候销毁窗口连VB6也一起关了,搞了两天还找不到原因,只知道窗口关闭后,释放GDI+对象,虽然返回值=0,但是对象还在,不知道为什么
我把不停的画字的那倒计时子程序删了以后,销毁窗口就正常了.没分了,请好心的大神帮忙解答下

Public Sub 创建窗口()
    Dim wMsg As Msg
    Dim ResData() As Byte, Stream As Object
    If Img Then GdipDisposeImage Img
    ResData = LoadResData(102, "CUSTOM")
    CreateStreamOnHGlobal ResData(0), False, Stream
    GdipLoadImageFromStream Stream, Img
    Set Stream = Nothing
    GdipGetImageHeight Img, PngHeight
    GdipGetImageWidth Img, PngWidth
    ghWith = (Screen.Width / Screen.TwipsPerPixelX) - PngWidth - 1
    gHeight = (Screen.Height / Screen.TwipsPerPixelY) - GetTaskbarHeight - PngHeight
    DeskWin = FindWindowEx(0&, 0&, "Progman", vbNullString)
    DeskWin = FindWindowEx(DeskWin, 0&, "SHELLDLL_DefView", vbNullString)
    DeskWin = FindWindowEx(DeskWin, 0&, "SysListView32", vbNullString)
    If RegisterWindowClass = False Then
        gHwnd = FindWindow(gClassName, gAppName)
        If gHwnd > 0 Then
            MoveWindow gHwnd, ghWith, gHeight, PngWidth, PngHeight, False
            Delay 100
            Call 画图
            Do While 倒计时() = False
                Delay 100
            Loop
        End If
    Else
        If CreateWindows Then
            Call 画图
            Do While GetMessage(wMsg, 0&, 0&, 0&)
                Delay 0
                Call TranslateMessage(wMsg)
                Call DispatchMessage(wMsg)
                If 倒计时() Then
                    Exit Do
                End If
            Loop
        End If
    End If
    Debug.Print UnregisterClass(gClassName$, 0&)
    释放内存
    If IsIDE() = False Then DestroyWindow gHwnd&
End Sub

'注册窗口类
Public Function RegisterWindowClass() As Boolean
    Dim wc As WNDCLASS
    nowTime = Now
    
    With wc
        .style = CS_HREDRAW Or CS_VREDRAW
        .lpfnwndproc = GetAddress(AddressOf WndProc)
        .hInstance = GetModuleHandle(vbNullString)
        .hIcon = LoadIconByNum(0&, IDI_APPLICATION)
        .hCursor = LoadCursorByNum(0&, IDC_ARROW)
        .hbrBackground = COLOR_WINDOW
        .lpszClassName = gClassName$
        .lpszMenuName = vbNullString
        .cbClsextra = 0&
        .cbWndExtra2 = 0&
    End With
    RegisterWindowClass = RegisterClass(wc) <> 0
End Function


'创建窗体以及子类化操作

Public Function CreateWindows() As Boolean                                      'WS_EX_TOOLWINDOW WS_DLGFRAME WS_POPUP Or WS_VISIBLE
    gHwnd& = CreateWindowEx(WS_EX_TOOLWINDOW, gClassName$, gAppName$, _
    WS_OVERLAPPEDWINDOW, ghWith, gHeight, PngWidth, PngHeight, DeskWin, 0&, GetModuleHandle(vbNullString), ByVal 0&)
    ' gHwnd = CreateWindowEx(&H10&, gClassName$, gAppName$, &HCF0000, ghWith, gHeight, PngWidth, PngHeight, 0&, 0&, GetModuleHandle(vbNullString), ByVal 0&)
    
    Call ShowWindowAsync(gHwnd&, SW_SHOWNORMAL)
    SetWindowPos gHwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    Call UpdateWindow(gHwnd)
    CreateWindows = (gHwnd& <> 0)
End Function


Private Sub 释放内存()
    
    With blendFunc32bpp
        .AlphaFormat = AC_SRC_ALPHA
        .BlendFlags = 0
        .BlendOp = AC_SRC_OVER
        .SourceConstantAlpha = 0
    End With
    UpdateLayeredWindow gHwnd, hdc, ByVal 0&, WinSize, mDC, SrcPoint, 0, blendFunc32bpp, ULW_ALPHA
    If m_Pen Then Call GdipDeletePen(m_Pen)
    If m_Brush Then Call GdipDeleteBrush(m_Brush)
    If FontFam Then Call GdipDeleteFontFamily(FontFam)
    If CurFont Then Call GdipDeleteFont(CurFont)
    If StrFormat Then Call GdipDeleteFont(StrFormat)
    If Img Then Call GdipDisposeImage(Img)
    If Graphics Then Call GdipDeleteGraphics(Graphics)
    
    Call SelectObject(mDC, OldBitmap)
    Call DeleteObject(MainBitmap)
    Call DeleteObject(OldBitmap)
    Call DeleteDC(mDC)
    Call ReleaseDC(gHwnd, hdc)
    
End Sub
'窗体的消息处理函数，该函数在窗体注册时指定的

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Select Case uMsg&
    Case WM_PRINT
        
    Case WM_CREATE
        
    Case WM_DESTROY
        Call PostQuitMessage(0&)
    Case WM_QUIT
        
    Case WM_CLOSE
        DestroyWindow gHwnd&
    Case WM_LBUTTONUP, WM_RBUTTONUP
        DestroyWindow gHwnd&
    End Select
    WndProc = DefWindowProc(hWnd&, uMsg&, wParam&, lParam&)
End Function

Public Function GetAddress(ByVal lngAddr As Long) As Long
    GetAddress = lngAddr&
End Function
Private Function 倒计时() As Boolean
    倒计时 = False
    If IsDate(nowTime) Then
        t = DateDiff("s", Now, DateAdd("s", 3, nowTime))
        days = Int(t / 86400)
        t = t Mod 86400
        hours = Int(t / 3600)
        t = t Mod 3600
        Minutes = Int(t / 60)
        t = t Mod 60
        If t >= 0 Then
            DrawGdiPlusString "本窗口将在：" & Right$("0" & CStr(t), 2) + "秒后关闭"
            Call PostMessage(gHwnd&, WM_LBUTTONDOWN, 0, ByVal MAKELPARAM(10, 10))
        Else
            Call PostMessage(gHwnd&, WM_LBUTTONUP, 0, ByVal MAKELPARAM(10, 10))
            倒计时 = True
        End If
    End If
End Function

Private Sub 画图()
    Dim CurWinLong As Long
    Dim TempBI As BITMAPINFO
    With TempBI.bmiHeader
        .biSize = Len(TempBI.bmiHeader)
        .biBitCount = 32
        .biHeight = PngHeight
        .biWidth = PngWidth
        .biPlanes = 1
        .biSizeImage = .biWidth * .biHeight * (.biBitCount / 8)
    End With
    hdc = GetDC(gHwnd)
    mDC = CreateCompatibleDC(hdc)
    MainBitmap = CreateDIBSection(mDC, TempBI, DIB_RGB_COLORS, ByVal 0, 0, 0)
    OldBitmap = SelectObject(mDC, MainBitmap)
    GdipCreateFromHDC mDC, Graphics
    If Graphics = 0 Then 释放内存: Exit Sub
    CurWinLong = GetWindowLong(gHwnd, GWL_EXSTYLE)
    SetWindowLong gHwnd, GWL_EXSTYLE, CurWinLong Or WS_EX_LAYERED
    SrcPoint.x = 0
    SrcPoint.y = 0
    WinSize.cx = PngWidth
    WinSize.cy = PngHeight
    
    GdipCreatePen1 MakeARGB(vbBlack, 170), 2, UnitPixel, m_Pen
    GdipCreateSolidFill MakeARGB(vbCyan, 120), m_Brush
    
    GdipCreateFontFamilyFromName "微软雅黑", 0, FontFam
    GdipCreateFont FontFam, 20, FontStyleBold, UnitPoint, CurFont
    GdipCreateStringFormat 0, 0, StrFormat
    GdipSetStringFormatAlign StrFormat, StringAlignmentNear
    
    GdipDrawImageRect Graphics, Img, 0, 0, PngWidth, PngHeight
    
    With blendFunc32bpp
        .AlphaFormat = AC_SRC_ALPHA
        .BlendFlags = 0
        .BlendOp = AC_SRC_OVER
        .SourceConstantAlpha = 255
    End With
    UpdateLayeredWindow gHwnd, hdc, ByVal 0&, WinSize, mDC, SrcPoint, 0, blendFunc32bpp, ULW_ALPHA 'Or ULW_OPAQUE
    DrawGdiPlusString "本窗口将在：15秒后关闭"
    nowTime = Now
    ' ReleaseDC gHwnd, hdc
    Debug.Print m_Pen, m_Brush, FontFam, CurFont, hdc, mDC
    
End Sub

Private Sub DrawGdiString()
    With rcLayout
        .Top = 2
        .Left = 5
        .Width = PngWidth
        .Height = PngHeight / 5
    End With
    Call GdipAddPathString(Path, "信息提示窗口 BY QQ:82850696", -1, FontFam, 1, 15, rcLayout, StrFormat)
End Sub

Private Sub DrawGdiString2()
    With rcLayout
        .Top = 50
        .Left = 5
        .Width = PngWidth
        .Height = PngHeight - 50
    End With
    Call GdipAddPathString(Path, 局_文本, -1, FontFam, 1, 15, rcLayout, StrFormat)
End Sub
Private Sub DrawGdiString3()
    '    GdipCreatePen1 MakeARGB(vbMagenta, 170), 2, UnitPixel, m_Pen
    '    GdipCreateSolidFill MakeARGB(vbGreen, 100), m_Brush
    With rcLayout
        .Top = 220
        .Left = 330
        .Width = PngWidth
        .Height = PngHeight / 5
    End With
    Call GdipAddPathString(Path, "阿牛工作室 出品", -1, FontFam, 1, 20, rcLayout, StrFormat)
End Sub
Private Sub DrawGdiPlusString(ByVal DrawStr As String)
    On Error Resume Next
    GdipCreatePath FillModeWinding, Path
    GdipGraphicsClear Graphics, &H0
    GdipDrawImageRect Graphics, Img, 0, 0, PngWidth, PngHeight
    GdipSetTextRenderingHint Graphics, TextRenderingHintClearTypeGridFit        '6.绘制图形
    
    Call DrawGdiString
    Call DrawGdiString2
    Call DrawGdiString3
    With rcLayout
        .Width = PngWidth
        .Height = PngHeight / 5
        .Left = 5
        .Top = 220
    End With
    Call GdipAddPathString(Path, DrawStr, -1, FontFam, 1, 16, rcLayout, StrFormat)
    GdipSetSmoothingMode Graphics, SmoothingModeAntiAlias
    GdipDrawPath Graphics, m_Pen, Path
    GdipFillPath Graphics, m_Brush, Path
    GdipDeletePath Path
    UpdateLayeredWindow gHwnd, hdc, ByVal 0&, WinSize, mDC, SrcPoint, 0, blendFunc32bpp, ULW_ALPHA
    DoEvents
End Sub

Private Function ColorARGB(ByVal alpha As Byte, ByVal red As Byte, ByVal green As Byte, ByVal blue As Byte) As Long
    Dim bytestruct As COLORBYTES
    Dim Result As COLORLONG
    
    With bytestruct
        .AlphaByte = alpha
        .RedByte = red
        .GreenByte = green
        .BlueByte = blue
    End With
    LSet Result = bytestruct
    ColorARGB = Result.longval
End Function

Private Function MakeARGB(ByVal lColor As Long, Optional ByVal alpha As Byte = 255) As Long
    Dim rgbq As RGBQUAD
    CopyMemory rgbq, lColor, 4
    MakeARGB = ColorARGB(alpha, rgbq.rgbBlue, rgbq.rgbGreen, rgbq.rgbRed)
End Function