Копирование изображения

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
lister
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 389
Зарегистрирован: 15.01.2005 (Сб) 7:34
Откуда: Страна оления

Копирование изображения

Сообщение lister » 26.09.2006 (Вт) 11:46

Есть задача скопировать кусок родительского окна (изображение со всеми контролами) на дочернее окно.

Родительское окно - форма Form1, дочернее - UserControl1

Копируется изображение формы, находящеестя под UserControl1

Неделю туплю... вместо нужного изображения формы получается "дыра" :shock:

Что не так?

Код: Выделить всё
Option Explicit
'
'
'
'
Implements ISubclass
'
'
'
'
Private Const WM_ERASEBKGND As Long = &H14
Private Const WM_PAINT As Long = &HF&
'
'
'
'
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Type SIZE
  cx As Long
  cy As Long
End Type

Private Type PAINTSTRUCT
  hDC As Long
  fErase As Long
  rcPaint As RECT
  fRestore As Long
  fIncUpdate As Long
  rgbReserved As Byte
End Type
'
'
'
'
Private Declare Function BitBlt Lib "gdi32.dll" ( _
   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 GetUpdateRect Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpRect As RECT, _
   ByVal bErase As Long) As Long
   
Private Declare Function ValidateRect Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpRect As RECT) As Long
   
Private Declare Function BeginPaint Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpPaint As PAINTSTRUCT) As Long
   
Private Declare Function EndPaint Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpPaint As PAINTSTRUCT) As Long

Private Declare Function GetParent Lib "user32.dll" ( _
   ByVal hWnd As Long) As Long

Private Declare Function GetWindowRect Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpRect As RECT) As Long

Private Declare Function GetClientRect Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpRect As RECT) As Long

Private Declare Function GetWindowExtEx Lib "gdi32.dll" ( _
   ByVal hDC As Long, _
   ByRef lpSize As SIZE) As Long
   
Private Declare Function GetWindowOrgEx Lib "gdi32.dll" ( _
   ByVal hDC As Long, _
   ByRef lpPoint As POINTAPI) As Long

Private Declare Function CopyRect Lib "user32.dll" ( _
   ByRef lpDestRect As RECT, _
   ByRef lpSourceRect As RECT) As Long

Private Declare Function GetWindowDC Lib "user32.dll" ( _
   ByVal hWnd As Long) As Long

Private Declare Function GetDC Lib "user32.dll" ( _
   ByVal hWnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByVal hDC As Long) As Long
   
Private Declare Function GetDCOrgEx Lib "gdi32.dll" ( _
   ByVal hDC As Long, _
   ByRef lpPoint As POINTAPI) As Long

Private Declare Function ClientToScreen Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpPoint As POINTAPI) As Long
   
Private Declare Function ScreenToClient Lib "user32.dll" ( _
   ByVal hWnd As Long, _
   ByRef lpPoint As POINTAPI) As Long
'
'
'
'
Private Function ISubclass_Callback(ByVal hWnd As Long, wMsg As Long, wParam As Long, lParam As Long, ByVal PrevProc As Long) As Long
  Dim typPS As PAINTSTRUCT
  Dim typPT As POINTAPI
  Dim typParentPT As POINTAPI
  Dim typRC As RECT
  Dim typParentRC As RECT
  Dim hWndParent As Long
  Dim hDC As Long
  Dim hDCParent As Long
  Dim lngX As Long
  Dim lngY As Long

  Select Case wMsg
    Case WM_PAINT
      If (hWnd) Then
        GetClientRect hWnd, typRC

        hDC = GetDC(hWnd)

        If (hDC) Then
          hWndParent = GetParent(hWnd)

          If (hWndParent) Then
            GetWindowRect hWndParent, typParentRC

            hDCParent = GetWindowDC(hWndParent)

            If (hDCParent) Then
              GetDCOrgEx hDC, typPT

              GetDCOrgEx hDCParent, typParentPT

              lngX = typPT.x - typParentPT.x
              lngY = typPT.y - typParentPT.y

              With typRC
                BitBlt hDC, .Left, .Top, .Right, .Bottom, hDCParent, lngX, lngY, vbSrcCopy

              End With

              ReleaseDC hWnd, hDCParent

            End If

          End If

          ReleaseDC hWnd, hDC

        End If

      End If

      ISubclass_Callback = 0
     
     
    Case Else
      ISubclass_Callback = SubClasser.CallWindowProc(PrevProc, hWnd, wMsg, wParam, lParam)


  End Select

End Function
'
'
'
'
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  If (Ambient.UserMode) Then SubClasser.AddSubclassHook hWnd, Me, DoNotTransfer
 
End Sub

Private Sub UserControl_Terminate()
  SubClasser.RemoveSubclassHook hWnd
 
End Sub


Также прикрепил весь проект...
Вложения
BitBlt.zip
(4.88 Кб) Скачиваний: 42

keks-n
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2509
Зарегистрирован: 19.09.2005 (Пн) 17:17
Откуда: г. Москва

Сообщение keks-n » 26.09.2006 (Вт) 13:00

Всё правильно. Дыра и должна быть :lol: Дело в том, что тот кусок формы перекрыт твоим контролом. Попробуй сначала сделать его невидимым, затем скопировать нужный кусок на DC в памяти, затем снова видимым и из DC в памяти на него.
Изображение


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: Mail.ru [бот], Yandex-бот и гости: 140

    TopList