Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: AnimateWindow, итить его... Добавлено: 11.05.07 18:19  

Автор вопроса:  someone | Web-сайт: 123
Заметили, что этот самый AnimateWindow хреново работает?
Форма ЧЁРНАЯ при этом, хоть на 98, хоть на XP <_<
Не подскажете, как сделать плавное появление и исчезание окна без ентого самого AnimateWindow?

Ответить

  Ответы Всего ответов: 4  

Номер ответа: 1
Автор ответа:
 Боцман



ICQ: 295725312 

Вопросов: 53
Ответов: 830
 Web-сайт: Rus-Skipper.narod.ru
 Профиль | | #1
Добавлено: 11.05.07 19:52
Плавное исчезновение, так что ли?
Кинь на форму таймер и кнопку, далее код.
Option Explicit
Dim wrem As Long

Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
wrem = 250
Timer1.Interval = 50
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Call alpha(Me.hwnd, wrem)
wrem = wrem - 10
If wrem = 30 Then
Timer1.Enabled = False
Unload Me
End If
End Sub

а это в модуле.
Option Explicit
'&#238;&#225;&#250;&#255;&#226;&#235;&#255;&#229;&#236; API &#244;&#243;&#237;&#234;&#246;&#232;&#232; &#232; &#234;&#238;&#237;&#241;&#242;&#224;&#237;&#242;&#251;
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 Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
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 Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000
Sub alpha(Hwnds As Long, vals As Long) '&#241;&#238;&#231;&#228;&#224;&#237;&#232;&#229; &#239;&#240;&#238;&#231;&#240;&#224;&#247;&#237;&#238;&#241;&#242;&#232; &#243; &#244;&#238;&#240;&#236;&#251; (&#238;&#239;&#232;&#241;&#224;&#242;&#229;&#235;&#252; &#238;&#234;&#237;&#224;, &#241;&#242;&#229;&#239;&#229;&#237;&#252; &#239;&#240;&#238;&#231;&#240;&#224;&#247;&#237;&#238;&#241;&#242;&#232; 0 - 255)
If vals < 254 Then '&#229;&#241;&#235;&#232; &#231;&#237;&#224;&#247;&#229;&#237;&#232;&#229; vals &#236;&#229;&#237;&#252;&#248;&#229; 254, &#242;&#238;
Dim lStyle As Long '&#238;&#225;&#250;&#255;&#226;&#235;&#255;&#229;&#236; &#247;&#232;&#241;&#235;&#238;&#226;&#243;&#254; &#239;&#229;&#240;&#229;&#236;&#229;&#237;&#237;&#243;&#254;
lStyle = GetWindowLong(Hwnds, GWL_EXSTYLE) '&#243;&#231;&#237;&#224;&#229;&#236; &#224;&#242;&#242;&#240;&#232;&#225;&#243;&#242;&#251; &#238;&#234;&#237;&#224;
lStyle = lStyle Or WS_EX_LAYERED
SetWindowLong Hwnds, GWL_EXSTYLE, lStyle '&#243;&#241;&#242;&#224;&#237;&#224;&#226;&#235;&#232;&#226;&#224;&#229;&#236; &#224;&#242;&#242;&#240;&#232;&#225;&#243;&#242;&#251; &#238;&#234;&#237;&#224;
SetLayeredWindowAttributes Hwnds, 0, vals, LWA_ALPHA '&#243;&#241;&#242;&#224;&#237;&#224;&#226;&#235;&#232;&#226;&#224;&#229;&#236; &#239;&#240;&#238;&#231;&#240;&#224;&#247;&#237;&#238;&#241;&#242;&#252;
Else '&#226; &#235;&#254;&#225;&#238;&#236; &#228;&#240;&#243;&#227;&#238;&#236; &#241;&#235;&#243;&#247;&#224;&#229;
SetWindowLong Hwnds, GWL_EXSTYLE, 0 '&#243;&#241;&#242;&#224;&#237;&#224;&#226;&#235;&#232;&#226;&#224;&#229;&#236; &#238;&#225;&#251;&#247;&#237;&#251;&#229; &#224;&#242;&#242;&#240;&#232;&#225;&#243;&#242;&#251; &#238;&#234;&#237;&#224;
End If '&#231;&#224;&#234;&#240;&#251;&#226;&#224;&#229;&#236; &#243;&#241;&#235;&#238;&#226;&#232;&#229;
End Sub

извени коментарии искажены, да они и не нужны.

Ответить

Номер ответа: 2
Автор ответа:
 EUGY



Вопросов: 0
Ответов: 454
 Профиль | | #2 Добавлено: 11.05.07 21:36
для AnimateWindow нужен обработчик WM_PRINTCLIENT.
Cабклассировать окно и в оконной процедуре использовать следущее:

Public Function win_proc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim rct As RECT
Dim hbr As Long
Select Case Msg
Case &H318 'WM_PRINTCLIENT
    GetClientRect hwnd, rct
    hbr = CreateSolidBrush(TransCol(Form1.BackColor))
    FillRect wParam, rct, hbr
    ;DeleteObject hbr
End Select
win_proc = CallWindowProc(dfPrc, hwnd, Msg, wParam, lParam)
End Function

Private Function TransCol(ByVal Clr As Long) As Long
   OleTranslateColor Clr, 0, TransCol
End Function


Ответить

Номер ответа: 3
Автор ответа:
 someone



Вопросов: 215
Ответов: 1596
 Web-сайт: 123
 Профиль | | #3
Добавлено: 12.05.07 10:51
Большое спасибо ;)

Ответить

Номер ответа: 4
Автор ответа:
 Visual Basic .NET 2005 Пиратская версия



Вопросов: 38
Ответов: 190
 Web-сайт: ex3mos.ucoz.ru
 Профиль | | #4
Добавлено: 12.05.07 22:58
Редактировать свойство Opacity:

Dim d as double = 1.0
For d = 1.0 to 0 step +(величина шага, лучше всего 0.1)-0.1
Form1.Opacity = d
Form1.Refresh()
Next

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам