ПОЛУПРОЗРАЧНЫЕ окна на vb

[MMX//ALEX]

Как создать полупрозрачное окно?
Очень просто.

Вот это в модуль:

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, _
ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Sub SetTransparent(hWnd As Long, Layered As Byte)
Dim Ret As Long
Ret = GetWindowLong(hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes hWnd, 0, Layered, LWA_ALPHA
End Sub

А вот это на форму:

SetTransparent Me.hWnd, 100
где 100 - прозрачность(0-255)

Ну вот и все.

[MMX//ALEX]

Кому чего надо. Просите. У меня много чего найдется...

[Amed]

Ты это не видел?

[seelts]

Я бы оценил ваши труды, но

Can't find DLL entry point SetLayeredWindowAttributes in user32

чё делать?

[Amed]

2seels: какая стоит система, есть ли Service Packs?

На всех компьютерах, где я пробовал, работало

P.S. если система НЕ winXP, то ничего ПРОСТО не работает/не происходит...

[MEMBER]

Ишшо одна ветка с кодом, который никто не просил.
Было уже.

[seelts]

2seels: P.S. если система НЕ winXP, то ничего ПРОСТО не работает/не происходит...

ну вобщем да... не ХР -> Win98SE (не люб мне ХР)
и ч ничего нельзя поделать??? переход на ХР не предлагать...

[GSerg]

Предлагаю переход на 2k

[seelts]

Предлагаю переход на 2k

оригинально конечно... но можно ли сделать на Вин98?

[GSerg]

Нэт...

[alibek]

В принципе можно, но через ... не скажу, через что
Берешь картинку с Desktop, берешь картинку со своей формы, делаешь блендинг и результат делаешь фоном. И так рекурсией для всех контролов на твоей форме. И рефрешить при движении формы, изменении размеров, при движении других форм и просто так время от времени

[Amed]

Гхм... Сособ действительно через ...
Но по-иному действительно не получится Win'98 и иже с ними не поддерживают windows transparency (то бишь прозрачность окон)...

Кстати, будт ли заметные лаггггггггиииииии?
Самому, извиняюсь, написать нет времени (я на 1 курсе МГТУ ) Может, кто-нибудь напишет и проверит всё на своём skin'е?

[Aleksej]

Для Win98:

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

Public Sub RebuildWindowRgn(FormName As Form)

Dim FullRgn As Long
Dim Rgn As Long
Dim CaptionHeight As Integer
Dim Control As Control

CaptionHeight = 22

FormName.ScaleMode = 3

FullRgn = CreateRectRgn(0, 0, FormName.Width, FormName.Height)

Rgn = CreateRectRgn(0, CaptionHeight, FormName.Width, _
                    FormName.Height)

CombineRgn FullRgn, FullRgn, Rgn, RGN_DIFF

For Each Control In FormName.Controls
If Control <> True Then
Rgn = CreateRectRgn(Control.Left + 2, (Control.Top + _
                    CaptionHeight), (Control.Left + _
                    Control.Width + 2), (Control.Top + _
                    Control.Height + CaptionHeight))
End If
CombineRgn FullRgn, FullRgn, Rgn, RGN_OR

Next Control

SetWindowRgn FormName.hWnd, FullRgn, True
End Sub

[GSerg]

Ещё один изврат:

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

Option Explicit

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Sub Command1_Click()
  SetWindowLong Me.hwnd, -20&, &H20&
End Sub