home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / message / subcls / mdipaint.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-31  |  3.3 KB  |  89 lines
  1. Option Explicit
  2.  
  3. ' Standard rectangle structure
  4. Type RECT
  5.    left As Integer
  6.    top As Integer
  7.    right As Integer
  8.    bottom As Integer
  9. End Type
  10.  
  11. ' Win16 API calls
  12. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  13. Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
  14. Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
  15. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  16. Declare Function CreateCompatibleDC Lib "GDI" (ByVal hDC As Integer) As Integer
  17. Declare Function CreateCompatibleBitmap Lib "GDI" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
  18. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  19. Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
  20. Declare Function GetSysColor Lib "User" (ByVal nIndex As Integer) As Long
  21. Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
  22. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  23. Declare Function CreateSolidBrush Lib "GDI" (ByVal crColor As Long) As Integer
  24. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
  25. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  26.  
  27.  
  28. ' BitBlt RasterOp constant
  29. Global Const SRCCOPY = &HCC0020
  30.  
  31. ' GetWindow constant to retrieve first child
  32. Global Const GW_CHILD = 5
  33.  
  34. ' System color constant for MDI background fill
  35. Global Const COLOR_APPWORKSPACE = 12
  36.  
  37. Sub mdiBitBltCentered (Src As PictureBox, Dest As MDIForm, FillColor As Long)
  38.    Dim nRet As Integer
  39.    Dim dDC As Integer, dWnd As Integer, cDC As Integer
  40.    Dim sR As RECT, dR As RECT
  41.    Dim hBmp As Integer, oldBmp As Integer
  42.    Dim hBrush As Integer
  43.    Dim dX As Integer, dY As Integer
  44.    '
  45.    ' Get DC to client space
  46.    '
  47.    dWnd = GetWindow(Dest.hWnd, GW_CHILD)
  48.    dDC = GetDC(dWnd)
  49.    '
  50.    ' Get source and destination rectangles
  51.    '
  52.    Call GetClientRect(Src.hWnd, sR)
  53.    Call GetClientRect(dWnd, dR)
  54.    '
  55.    ' Create a memory bitmap to build image in
  56.    '
  57.    cDC = CreateCompatibleDC(dDC)
  58.    hBmp = CreateCompatibleBitmap(dDC, dR.right, dR.bottom)
  59.    oldBmp = SelectObject(cDC, hBmp)
  60.    '
  61.    ' Create new brush and paint background
  62.    '
  63.    hBrush = CreateSolidBrush(FillColor)
  64.    nRet = FillRect(cDC, dR, hBrush)
  65.    '
  66.    ' Calc upper-left position parameters to place image
  67.    '
  68.    dX = (dR.right - sR.right) \ 2
  69.    If dR.bottom > sR.bottom Then
  70.       dY = (dR.bottom - sR.bottom) \ 3
  71.    Else
  72.       dY = (dR.bottom - sR.bottom) \ 2
  73.    End If
  74.    '
  75.    ' BitBlt first to memory DC, then from memory to screen
  76.    '
  77.    nRet = BitBlt(cDC, dX, dY, sR.right, sR.bottom, Src.hDC, 0, 0, SRCCOPY)
  78.    nRet = BitBlt(dDC, 0, 0, dR.right, dR.bottom, cDC, 0, 0, SRCCOPY)
  79.    '
  80.    ' and clean up
  81.    '
  82.    nRet = DeleteObject(hBrush)
  83.    nRet = SelectObject(cDC, oldBmp)
  84.    nRet = DeleteObject(hBmp)
  85.    nRet = DeleteDC(cDC)
  86.    nRet = ReleaseDC(dWnd, dDC)
  87. End Sub
  88.  
  89.