DeleteDC DeleteObject 出错为什么？VB，API高手请进

Question

'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 = 1Const LOGPIXELSY = 90
Const COLOR_WINDOW = 5
Const Message = "Hello !"Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End TypePrivate Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) 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) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) 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) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Dim mDC As Long, mBitmap As Long
Private Sub Form_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim mRGN As Long, Cnt As Long, mBrush As Long, R As RECT
    'Create a device context, compatible with the screen
    mDC = CreateCompatibleDC(GetDC(0))
    'Create a bitmap, compatible with the screen
    mBitmap = CreateCompatibleBitmap(GetDC(0), Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
    'Select the bitmap nito the device context
    SelectObject mDC, mBitmap
    'Set the bitmap's backmode to transparent
    SetBkMode mDC, TRANSPARENT
    'Set the rectangles' values
    SetRect R, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY
    'Fill the rect with the default window-color
    FillRect mDC, R, GetSysColorBrush(COLOR_WINDOW)    For Cnt = 0 To 350 Step 30
        'Select the new font into the form's device context and delete the old font
        DeleteObject SelectObject(mDC, CreateMyFont(24, Cnt))
        'Print some text
        TextOut mDC, (Me.Width / Screen.TwipsPerPixelX) / 2, (Me.Height / Screen.TwipsPerPixelY) / 2, Message, Len(Message)
    Next Cnt    'Create an elliptical region
    mRGN = CreateEllipticRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
    'Set the window region
    SetWindowRgn Me.hWnd, mRGN, True    'delete our elliptical region
    DeleteObject mRGN
End Sub
Function CreateMyFont(nSize As Integer, nDegrees As Long) As Long
    'Create a specified font
    CreateMyFont = CreateFont(-MulDiv(nSize, GetDeviceCaps(GetDC(0), LOGPIXELSY), 72), 0, nDegrees * 10, 0, FW_NORMAL, False, False, False, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH, "Times New Roman")
End Function
Private Sub Form_Paint()
    'Copy the picture to the form
    BitBlt Me.hdc, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, mDC, 0, 0, vbSrcCopy
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'clean up
    DeleteDC mDC
    DeleteObject mBitmap
End Sub

Answer 1

【VB声明】
  Private Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Long) As Long【说明】
  删除专用设备场景或信息场景，释放所有相关窗口资源。不要将它用于GetDC函数取回的设备场景 【返回值】
  Long，执行成功则为非零，失败则为零 【备注】
  若有对象被选入设备场景，则在调用本函数前应将它们选出。为此，可将初始对象回选入DC，也可用SaveDC， RestoreDC函数对回复DC为其创建时的状态
  在vb里使用
  不要将它用于由vb hdc属性获取的设备场景句柄【参数表】
  hdc ------------  Long，将要删除的设备场景
【VB声明】
  Private Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long【说明】
  用这个函数删除GDI对象，比如画笔、刷子、字体、位图、区域以及调色板等等。对象使用的所有系统资源都会被释放 【返回值】
  Long，非零表示成功，零表示失败 【备注】
  不要删除一个已选入设备场景的画笔、刷子或位图。如删除以位图为基础的阴影（图案）刷子，位图不会由这个函数删除——只有刷子被删掉【参数表】
  hObject --------  Long，一个GDI对象的句柄

Answer 2

Const NEWFRAME = 1
Private Declare Function Escape Lib "gdi32" (ByVal hdc As Long, ByVal nEscape As Long, ByVal nCount As Long, ByVal lpInData As String, lpOutData As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim hMemoryDC As Long
Private Sub Command1_Click()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    'API uses pixels
    Picture1.ScaleMode = vbPixels
    Printer.ScaleMode = vbPixels
    'Take paper
    Printer.Print ""    'Create a compatible device context
    hMemoryDC = CreateCompatibleDC(Picture1.hdc)
    'Select Picture1's picture into our new device context
    hOldBitMap = SelectObject(hMemoryDC, Picture1.Picture)    'Stretch our picture to the height and width of the paper
    StretchBlt Printer.hdc, 0, 0, Printer.ScaleWidth, Printer.ScaleHeight, hMemoryDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy    'Select the original bitmap into our DC
    hOldBitMap = SelectObject(hMemoryDC, hOldBitMap)
    'Delete our memorydc
    DeleteDC hMemoryDC    'Access our printer device
    Escape Printer.hdc, NEWFRAME, 0, 0&, 0&    'End of document
    Printer.EndDoc
End Sub

Answer 3

先将位图选出
再DeleteDC、DeleteObject

Answer 4

将位图选出，如何选出呢？
为什么在win98中会经常出错selectobject 或 CreateCompatibleDC
出错呢？？
有没有什么解的方法！！！！

Answer 5

特别是在98下CreateCompatibeleDC会出错，在2000下就不会了。为什么呢

Answer 6

hDC = CreateCompatibleDC(0)
hMap = CreateCompatibleBitmap(hDC, 16, 16)If hDC<>0 and hMap<>0 then
    hOldMap=SelectObject(hDC, hMap) '选入
    
    ……
    
    Call SelectObject(hDC, hOldMap) '选出
End IfIf hMap then DeleteObject(hMap)
If hDC then DeleteDC(hDC)