home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch16 / mdipntb.bas < prev    next >
Encoding:
BASIC Source File  |  1996-12-19  |  4.3 KB  |  97 lines
  1. Attribute VB_Name = "MDIPaintMod"
  2. Option Explicit
  3.  
  4. Public OldWindowProc As Long  ' Original window proc
  5.  
  6. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  7. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  8.  
  9. Public Const GW_CHILD = 5
  10. Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  11. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  12. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  13. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
  14. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  15. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  16. 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
  17. Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  18. Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  19. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  20. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  21. Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
  22. Private Declare Function ExcludeClipRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  23. Private Declare Function ValidateRectBynum Lib "user32" Alias "ValidateRect" (ByVal hWnd As Long, ByVal lpRect As Long) As Long
  24. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  25.  
  26. Const COLOR_BACKGROUND = 1
  27. Public Const WM_ERASEBKGND = &H14
  28.  
  29. Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  30.  
  31. Private Type RECT
  32.         Left As Long
  33.         Top As Long
  34.         Right As Long
  35.         Bottom As Long
  36. End Type
  37.  
  38. ' Bitmap Header Definition
  39. Private Type BITMAP
  40.         bmType As Long
  41.         bmWidth As Long
  42.         bmHeight As Long
  43.         bmWidthBytes As Long
  44.         bmPlanes As Integer
  45.         bmBitsPixel As Integer
  46.         bmBits As Long
  47. End Type
  48.  
  49. Public Function SubClass1_WndMessage(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long
  50.     Dim tdc&
  51.     Dim usedc&
  52.     Dim oldbm&
  53.     Dim bm As BITMAP
  54.     Dim rc As RECT
  55.     Dim offsx&, offsy&
  56.     
  57.     If Msg <> WM_ERASEBKGND Then
  58.        ' Call the default window procedure
  59.        SubClass1_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
  60.        Exit Function
  61.     End If
  62.     
  63.     ' Get a DC to draw into
  64.     usedc = GetDC(hWnd)
  65.     ' Create a compatible DC to use
  66.     tdc = CreateCompatibleDC(usedc)
  67.     
  68.     ' Gets the bitmap handle of the background bitmap
  69.     oldbm = SelectObject(tdc, MDIForm1.Picture1.Picture)
  70.     Call GetObjectAPI(MDIForm1.Picture1.Picture, Len(bm), bm)
  71.     Call GetClientRect(hWnd, rc)
  72.     ' Decide where to place the MDI client logo
  73.     offsx = 20
  74.     offsy = 20
  75.     
  76.     ' Set the clipping region to the entire window -
  77.     ' necessary because the hDC provided has a clipping
  78.     ' region set.
  79.     Call SelectClipRgn(usedc, 0)
  80.     
  81.     ' We exclude the bitmap area - this reduces flicker (try removing it)
  82.     Call ExcludeClipRect(usedc, offsx, offsy, offsx + bm.bmWidth, offsy + bm.bmHeight)
  83.     Call FillRect(usedc, rc, COLOR_BACKGROUND)
  84.     
  85.     ' And restore the clip region before painting the bitmap
  86.     Call SelectClipRgn(usedc, 0)
  87.     
  88.     Call BitBlt(usedc, offsx, offsy, bm.bmWidth, bm.bmHeight, tdc, 0, 0, SRCCOPY)
  89.     Call ReleaseDC(hWnd, usedc)
  90.     Call SelectObject(tdc, oldbm)
  91.     Call DeleteDC(tdc)
  92.     ' This was added for VB5
  93.     Call ValidateRectBynum(hWnd, 0)
  94.     SubClass1_WndMessage = True
  95. End Function
  96.  
  97.