Как создать прозрачное окно?

[z3f]

Собственно subj...
то есть нужно чтобы при запуске видны были только label и все ...
настрока прозрачности окна в дальнейшем не понадобится...

[GSerg]

http://bbs.vbstreets.ru/viewtopic.php?t=14983

[A.A.Z.]

2 GSerg: челу нужно окно, в котором видны только Label'ы

[Jenizix]

Эх... сколько раз уж обсуждалось...
Я далаю так: Рисую картинку где: белый цвет - то что должно быть прозрачным, а например черный, где будут находиться контролы, затем вырезаю белый цвет, и все...

[Jenizix]

Создаем новый проект, выставляем у формы св-во BorderStyle=0

Расставляем контролы на форме как вам нужно, я для примера расставлю так:



Далее мы запускаем программу ( F5 ) и делаем скриншот нашего окна ( ALT+PrintScreen ), открываем MS Paint, нажимаем CTRL+V, появиться изображение нашей формы, затем на этом рисунке заливаем черным цветом все контролы, а саму форму заливаем розовым, после того как все сделали сохраняем рисунок, у меня получилось вот так :



Теперь нам нужно установить этот рисунок фоном формы, нажимаем на кнопочку в св-ве формы Picture, и выбираем там рисунок который мы сохранили. На этом подготовка графики завершена... переходим непосредственно к коду.

Добавляем к проекту модуль, в нем пишем:

Код: Выделить всё

Option Explicit

Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Const RGN_OR = 2

Private Type BITMAPINFOHEADER
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type

Public Function lGetRegion(ByVal lBackColor As Long, ByVal Picture As StdPicture, ByVal Frm As Form) As Long
   Dim lRgn As Long
   Dim lSkinRgn As Long
   Dim lStart As Long
   Dim lX As Long
   Dim lY As Long
   Dim ms As Long

   Dim bi As BITMAPINFOHEADER, bits() As Long, hdc As Long
   With bi
      .biSize = LenB(bi)
      .biWidth = Frm.ScaleX(Picture.Width, vbHimetric, vbPixels)
      .biHeight = Frm.ScaleY(Picture.Height, vbHimetric, vbPixels)
      .biPlanes = 1
      .biBitCount = 32
      .biCompression = 0
      ReDim bits(0 To .biWidth - 1, 0 To .biHeight - 1)
      hdc = CreateCompatibleDC(0)
      GetDIBits hdc, Picture, 0, bi.biHeight, bits(0, 0), bi, 0
      DeleteDC (hdc)
   
      lSkinRgn = CreateRectRgn(0, 0, 0, 0)
   
      For lX = 0 To .biHeight - 1
         lY = 0
         Do While lY < .biWidth
            Do While lY < .biWidth
               If bits(lY, lX) <> lBackColor Then Exit Do
               lY = lY + 1
            Loop
       
            If lY < .biWidth Then
               lStart = lY
               Do While lY < .biWidth
                  If bits(lY, lX) = lBackColor Then Exit Do
                  lY = lY + 1
               Loop
                     
               If lY > .biWidth Then lY = .biWidth
           
               lRgn = CreateRectRgn(lStart, .biHeight - lX - 1, lY, .biHeight - lX)
               CombineRgn lSkinRgn, lSkinRgn, lRgn, RGN_OR
               DeleteObject lRgn
            End If
         Loop
       Next
   End With
   lGetRegion = lSkinRgn
End Function

Теперь в процедуре Form_Load нашей формы пишем:

Код: Выделить всё

lRgn = lGetRegion(RGB(255, 0, 255), Picture, Me) ' Где RGB(255, 0, 255) - цвет кторый должен быть прозрачным
SetWindowRgn hWnd, lRgn, True

Все! Нажимаем на F5 и радуемся результату!!!

P.S. Я точно не помню кто написал ф-ию lGetRegion .. но вроде кто-то с VBStreets... или нет... на Sources.ru она тоже есть...

[tyomitch]

P.S. Я точно не помню кто написал ф-ию lGetRegion .. но вроде кто-то с VBStreets... или нет... на Sources.ru она тоже есть...

Позволю предположить, что я: http://bbs.vbstreets.ru/viewtopic.php?p=71370#71370

[Jenizix]

Вот более приличный код:

Код: Выделить всё

Option Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const RGN_OR = 2

Private Sub Form_Load()
    Dim WindowRgn As Long ' тут будет храниться регион, по которому в последствии будет вырезано окно
    Dim ctrlRgn As Long ' тут будет храниться регион текущео конрола
    Dim ctrl As Control ' текущий контрол
   
    WindowRgn = CreateRectRgn(0, 0, 0, 0) ' создаем пустой регион
   
    On Error Resume Next
    For Each ctrl In Controls ' перебираем все контролы на форме
        ctrlRgn = CreateRectRgn(ctrl.Left / Screen.TwipsPerPixelX, ctrl.Top / Screen.TwipsPerPixelY, (ctrl.Left + ctrl.Width) / Screen.TwipsPerPixelX, (ctrl.Top + ctrl.Height) / Screen.TwipsPerPixelY) ' создаем регион текущего контрола
        CombineRgn WindowRgn, WindowRgn, ctrlRgn, RGN_OR ' комбинируем его с регионом WindowRgn
    Next
   
    SetWindowRgn hWnd, WindowRgn, True ' вырезаем окно по региону WindowRgn
   
    DeleteObject WindowRgn
    DeleteObject ctrlRgn
End Sub


Делает видимыми только контролы.