| Вопрос: Прозрачный цвет | Добавлено: 28.12.06 14:45 |
Автор вопроса:  Tur | ICQ: 201446364 |
| Помню где то видел объект полу-прозрачный, т.е. он имел явный определенный цвет и в то же время при его движении объекты под ним были видимы. Что это за объект? Label? Picture? Form? И как это сделать? |
| Ответы | Всего ответов: 16 |
|
Номер ответа: 1 Автор ответа:  Djon Вопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #1 | Добавлено: 28.12.06 18:19 |
|
Можно сделать форму прозрачной или полупрозрачной.
Может быть ты это видел. |
||
|
Номер ответа: 2 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #2 | Добавлено: 28.12.06 18:27 |
|
Что бы форма была прозрачной
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2 Const GWL_EXSTYLE = (-20) Const WS_EX_LAYERED = &H80000 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Sub Command1_Click() Dim Ret As Long Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret SetLayeredWindowAttributes Me.hWnd, 0, 125, LWA_ALPHA 'параметр 125 обозначает степьнь прозрачности (от 0 до 255) End Sub |
||
|
Номер ответа: 3 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #3 | Добавлено: 28.12.06 18:29 |
|
А можно что бы определённый цвет на форме был прозрачный.
Dim Ret As Long
Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret SetLayeredWindowAttributes Me.hWnd, цвет, 0, LWA_COLORKEY |
||
|
Номер ответа: 4 Автор ответа: Tur ICQ: 201446364 Вопросов: 22 Ответов: 72 |
Профиль | | #4 | Добавлено: 28.12.06 18:31 |
| Скорей всего это, но не помню как это сделать. Мне надо чтобы нарисованные на пикче линии были видны сквозь нежный туман, подкрашивающий но не скрывающий район. | ||
|
Номер ответа: 5 Автор ответа: Sacred PhoenixICQ: 304238252 Вопросов: 52 Ответов: 927 |
Профиль | | #5 | Добавлено: 28.12.06 20:12 |
|
Мне надо чтобы нарисованные на пикче линии были видны сквозь нежный туман, подкрашивающий но не скрывающий район. романтично :D
|
||
|
Номер ответа: 6 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #6 | Добавлено: 28.12.06 20:23 |
| А может быть можно просто сделать цвет линий немного светлей, по моему получится "туман". | ||
|
Номер ответа: 7 Автор ответа: TurICQ: 201446364 Вопросов: 22 Ответов: 72 |
Профиль | | #7 | Добавлено: 28.12.06 20:59 |
| Все это работает хорошо. Djon спасибо! Только вот странно, что этот код почему то не сработал у меня для Picture.hWnd или для Label, которую сразу можно посадить на пикче. А теперь придется решать еще одну проблемку: совместить прозрачный форм с пикчей на др форме и сделать его всегда поверх этого форма, что я совершенно забыл. | ||
|
Номер ответа: 8 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #8 | Добавлено: 28.12.06 21:08 |
| Форму по верх всех окон это можно сделать, а вот чтобы именно поверх определённой формы, это нужно подумать. А на счёт совмещения прозрачной формы и формы с пикчебокс, это не трудно, только нужно учесть то что форму с пикчебоксом могут перетащить. | ||
|
Номер ответа: 9 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #9 | Добавлено: 28.12.06 21:44 |
|
Вот, держи всё получилось, переделал примерчик один.
Это в модуль Option Explicit
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal lngHandle As Long, ByVal lngMsg As Long, ByVal lngFirstParam As Long, ByVal lngLastParam As Long) As Long Private Declare Function SetWindowLongA Lib "user32" (ByVal lngHandle As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private lngOldProc As Long Public Sub SetProc(ByVal lngHandle As Long) lngOldProc = SetWindowLongA(lngHandle, -4, AddressOf WinProc) End Sub Private Function WinProc(ByVal lngHandle As Long, ByVal lngMsg As Long, ByVal lngFirstParam As Long, ByVal lngLastParam As Long) As Long If lngMsg = &H3 Then frmMain.picShadow.Move frmMain.Left + (Screen.TwipsPerPixelX), frmMain.Top + (Screen.TwipsPerPixelY), frmMain.Width, frmMain.Height End If WinProc = CallWindowProcA(lngOldProc, lngHandle, lngMsg, lngFirstParam, lngLastParam) End Function А это на форму Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Const LWA_COLORKEY = &H1 Const LWA_ALPHA = &H2 Const GWL_EXSTYLE = (-20) Const WS_EX_LAYERED = &H80000 Private Sub Form_Load() Dim Ret As Long SetParent picShadow.hWnd, GetDesktopWindow SetProc hWnd Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret SetLayeredWindowAttributes Me.hWnd, 0, 125, LWA_ALPHA End Sub |
||
|
Номер ответа: 10 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #10 | Добавлено: 28.12.06 21:46 |
| Получилось даже легче, чем думалось, обошолся одной формой. Переделал пример http://www.vbnet.ru/faq/showtopic.asp?id=401 | ||
|
Номер ответа: 11 Автор ответа: СерёгаICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | | #11 | Добавлено: 28.12.06 21:59 |
|
Форму по верх всех окон это можно сделать, а вот чтобы именно поверх определённой формы, это нужно подумать.
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub Form_Initialize() ret = SetParent(Form2.hWnd, Me.hWnd) Form2.WindowState = 2 Form2.Show End Sub Private Sub Form_Unload(Cancel As Integer) Unload Form2 End End Sub |
||
|
Номер ответа: 12 Автор ответа: СерёгаICQ: 262809473 Вопросов: 17 Ответов: 561 |
Web-сайт: Профиль | | #12 | Добавлено: 28.12.06 22:04 |
- Кажется я немного опоздал 
|
||
|
Номер ответа: 13 Автор ответа: TurICQ: 201446364 Вопросов: 22 Ответов: 72 |
Профиль | | #13 | Добавлено: 28.12.06 23:23 |
|
Djon, последний твой пример тяжеловат, пока не знаю как его примастить. Мне нужно вроде бы другое: чтобы маленькая пролу-прозрачная лайбел или на худой конец форма двигалась по майн форме (и с этой майн формой в том числе конечно)
Серёга, привет. Вот играюсь с твоим примером. Странные вещи всплывают, не получается установить позицию дочернего форма ' Form1 Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long Private Sub Form_Initialize() Dim ret Form1.Show Form2.Show Form2.Left = 0 Form2.Top = 0 ret = SetParent(Form2.hWnd, Me.hWnd) Form2.Top = 0 ' что тут происходит?? Form2.Left = 0 Form2.Top = 0 Form2.Left = 0 End Sub Private Sub Form_Unload(Cancel As Integer) Unload Form2 End End Sub ' Form2 а это не работает, зараза! Dim X1 As Single, Y1 As Single Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) X1 = X: Y1 = Y End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Form2.Left = Form2.Left + X - X1 Form2.Top = Form2.Top + Y - Y1 End If End Sub |
||
|
Номер ответа: 14 Автор ответа: DjonВопросов: 61 Ответов: 471 |
Web-сайт: Профиль | | #14 | Добавлено: 30.12.06 16:02 |
|
А чем тебе мой пример не нравится?
Там же пикчебокс с картинкой,а с верху как ты и хотел полупрозрачная форма... |
||
|
Номер ответа: 15 Автор ответа: StarsВопросов: 41 Ответов: 239 |
Профиль | | #15 | Добавлено: 12.01.07 12:12 |
| Полезные примеры!!! | ||