Public Function CreateTransparentBackGround( _
 ByVal hwndRebar As Long) As IPictureDisp
  Dim rc As RECT
  Dim tPt As POINTAPI
  Dim hdcRef As Long
  Dim hdcDst As Long
  Dim hbmDst As Long
  Dim hbmOld As Long

  'Dim the_hdc As Long
  Dim hbmDstOld As Long
  Dim RebarHeight As Long
  Dim RebarWidth As Long
  
  Dim hbmpBack_temp As Long
  Dim hbshBack_temp As Long
  
  
  hbmpBack_temp = FormMain.PictureDigits.Picture.Handle
  If hbmpBack_temp <> 0 Then
    hbshBack_temp = CreatePatternBrush(hbmpBack_temp)
  Else
    'затычка на случай отсутствия фоновой картинки
    Dim the_ColorRef As Long
    OleTranslateColor FormMain.PictureDigits.BackColor, 0, the_ColorRef
    hbshBack_temp = CreateSolidBrush(the_ColorRef)
  End If
  
  GetWindowRect hwndRebar, rc
  If ThemesEnabled(hwndRebar) Then
    rc.Left = rc.Left + 2
  End If
  RebarWidth = rc.Right - rc.Left
  RebarHeight = rc.Bottom - rc.Top
  
  hdcRef = GetDC(hwndRebar)
  hdcDst = CreateCompatibleDC(hdcRef)
  hbmDst = CreateCompatibleBitmap(hdcRef, RebarWidth, RebarHeight)
  ReleaseDC hwndRebar, hdcRef
  hbmOld = SelectObject(hdcDst, hbmDst)

  hbmDstOld = SelectObject(hdcDst, hbshBack_temp)
  SetBkMode hdcDst, TRANSPARENT
  tPt.x = rc.Left
  tPt.y = rc.Top
  MapWindowPoints 0, FormMain.PictureDigits.hwnd, tPt, 2
  rc.Left = tPt.x
  rc.Top = tPt.y
  SetBrushOrgEx hdcDst, -rc.Left, -rc.Top, tPt
  PatBlt hdcDst, 0, 0, RebarWidth, RebarHeight, PATCOPY
  SelectObject hdcDst, hbmDstOld
  
  SelectObject hdcDst, hbmOld: hbmOld = 0
  DeleteDC hdcDst: hdcDst = 0
  
  DeleteObject hbshBack_temp
 
  Set CreateTransparentBackGround = CreateIPictureDispFromHBITMAP(hbmDst)
End Function

  DeleteObject SelectObject(hdcDst, hbmDstOld)