模式窗体淡入淡出问题

Question

   在网上查些代码，都是无模式窗体淡入淡出，但我的大部分窗体都是有模式的。模式显示时便卡死。例如：Form1.Show vbModal
      Call dr(Form1)
dr函数里就是网上写的什么api函数GetWindowLong、SetWindowLong、SetLayeredWindowAttributes设置窗体透明度奇怪的很，show时不加vbModal就没事，加了vbModal就一点反应都没有，整个程序都被卡死不动，结束不了。求模式窗体淡入淡出的方法!

Answer 1

窗体淡入淡出后，要恢复窗口原先样式（参见我写的一个）：
http://blog.csdn.net/chenjl1031/archive/2008/10/13/3072082.aspx

Answer 2

这有什么奇怪的，
Call dr(Form1)　　应该是实现‘淡入’效果的过程吧！
如果　Form1.Show vbModal
要等 Form1 关闭后才继续执行下面的语句，当然没效果了。
而如果 Form1.Show 没有带 vbModal ，则 Form1 显示出来后就会 Call dr(Form1) ，实现‘淡入’效果。

Answer 3

Public Class Form1
    Inherits System.Windows.Forms.Form
    Declare Auto Function AnimateWindow Lib "user32" (ByVal hwnd As IntPtr, _
                                                        ByVal dwTime As Integer, _
                                                        ByVal dwFlags As Integer) _
                                                        As Boolean
    Const AW_HOR_POSITIVE = &H1       '从左往右铺出
    Const AW_HOR_NEGATIVE = &H2       '从右住左
    Const AW_VER_POSITIVE = &H4       '从上往下铺出
    Const AW_VER_NEGATIVE = &H8      '从下住上 
    Const AW_CENTER = &H10            '从中间
    
    Const AW_HIDE = &H10000           '隐藏
    Const AW_ACTIVATE = &H20000        '活动
    Const AW_SLIDE = &H40000            '这个不懂
    Const AW_BLEND = &H80000           '淡出淡入    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
   '(目标窗口句柄,时间,效果)   
        AnimateWindow(Me.Handle, 2000, AW_BLEND Or AW_ACTIVATE)
    End Sub    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        AnimateWindow(Me.Handle, 100, AW_HIDE Or AW_BLEND)    End Sub
End Class

Answer 4

Form1.Show vbModal 
//
你应该在FORM1中做这些工作吧.比如~~~先LOAD窗体,再设置全透明,再启动个定时器,接着再Show vbModal~~~在定时器的事件里完成淡入淡出即可.....

Answer 5

试试这个：http://download.csdn.net/source/1909056

Answer 6

'摘录 CBM666编程教材 窗体篇
'Form1 代码 添加 Timer1Option Explicit '强制变量不能缺
Private Sub Form_Load()
   On Error Resume Next
   '********* 设定无边框窗体并置中,此时不能有标题需先清空,再置顶层
   Me.BorderStyle = 0: Me.Caption = "" '405是任务栏的高度(大约值,在此不另写计算它的实际高度代码)
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3 '设定窗体置顶
   '***************************************** 窗体淡进
   Fadeio = 1: LVstep = 20: NowLevel = 0: TransColor = RGB(66, 66, 66)
   Call TransParent(Me.hwnd, TransColor, 0)
   Timer1.Interval = 100: Timer1.Enabled = True
End SubPrivate Sub Form_Click()
   Fadeio = 2: LVstep = -20: NowLevel = 255
   Call TransParent(Me.hwnd, TransColor, NowLevel)
   Timer1.Enabled = True
End SubPrivate Sub Timer1_Timer()
   On Error Resume Next
   If NowLevel >= 0 And NowLevel <= 255 Then Call TransParent(Me.hwnd, TransColor, NowLevel)
   NowLevel = IIf(Fadeio = 1, IIf(NowLevel + LVstep >= 255, 255, NowLevel + LVstep), IIf(NowLevel + LVstep <= 0, 0, NowLevel + LVstep))
   If NowLevel = 0 Or NowLevel = 255 Then
      Timer1.Enabled = False
      Call TransParent(Me.hwnd, TransColor, NowLevel)
      If Fadeio = 2 Then End
   End If
End Sub
'**************************** .bas 代码 设为 启动项
Option Explicit
'**************************************** 窗体置顶的 API
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'**************************************** 窗体淡进淡出用到的API 与常量宣告
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 WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
Public Const LWA_COLORKEY = &H1
'********************************* 全局变量的宣告
Global AppDisk$, VoiceDisk$, i&, Rtn&, NowLevel&, TransColor&, Fadeio%, LVstep&
Global LR As Boolean, UD As Boolean
Sub Main() '启动程序
   If App.PrevInstance Then MsgBox "本系统已运行中, 不得重复加载!!": End
   AppDisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
   Form1.Show   '进入主程序
End Sub'*********** 让窗体透明并且屏蔽指定颜色
Public Sub TransParent(ByVal Phwnd As Long, ByVal TColor As Long, Tlevel As Long)
   'On Error Resume Next
   Rtn = GetWindowLong(Phwnd, GWL_EXSTYLE)
   Rtn = Rtn Or WS_EX_LAYERED
   SetWindowLong Phwnd, GWL_EXSTYLE, Rtn
   SetLayeredWindowAttributes Phwnd, TColor, Tlevel, LWA_COLORKEY Or LWA_ALPHA '将扣去窗口中的指定颜色背景
End Sub

Answer 7

Me.BorderStyle = 0: Me.Caption = "" '405是任务栏的高度(大约值,在此不另写计算它的实际高度代码)上面这行请去掉

Answer 8

    想在窗体show 和hide时窗体淡入淡出，查了些资料都是在窗体load 和unload时淡入淡出的，自己改改，调了很久还是不见起色。因程序中的所有窗体都第一次加载后不用时便hide，用时便show。所以用定时器就不行了，不知道什么时间show，用定时器就太乱了。最好一次在模块中定义完，show时调用淡入，hide时调用淡出效果。

Answer 9

用定时器就太乱了....身为编程员 不应该有这种想法 应该要说你的程序规划 思维不够细腻再给你一个 不使用定时器 就使用 1 与 2 随时调用 进 或 出再不满意 你自己慢慢玩 俺不陪你啦..........
'*********************** Form 代码
Option Explicit
Private Sub Form_Load()
   Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
   Me.Show
   NowLevel = 0
   Call FadeProg(Me.hWnd, 1)
End SubPrivate Sub Form_Unload(Cancel As Integer)
   NowLevel = 255
   Call FadeProg(Me.hWnd, 2)
End Sub
'********************** .bas 代码
Global FadeIO%, NowLevel&, LVstep&
'****************************************************************************
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal NowLevel As Byte, ByVal dwFlags As Long) As Boolean
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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Const GWL_EXSTYLE = -20
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_ALPHA = &H2Public Sub FadeProg(Phwnd&, FIO%)
   Do
      DoEvents
      LVstep = IIf(FIO = 1, 1, -1)
      NowLevel = NowLevel + LVstep
      If FIO = 1 Then
         NowLevel = IIf(NowLevel >= 255, 255, NowLevel)
      Else
         NowLevel = IIf(NowLevel <= 0, 0, NowLevel)
      End If
      SetLayeredWindowAttributes Phwnd, 0, NowLevel, LWA_ALPHA
      If NowLevel = 0 Or NowLevel = 255 Then Exit Do
   Loop
End Sub

Answer 10

要淡入淡出,是很简单的,但是他这里要求中有个"模态",则麻烦了点,要写多些代码实现.要是不需要模态,用AnimateWindow一个API就可以搞定,嘿嘿.

Answer 11

是啊，无模式的淡入淡出，show时淡入和hide时淡出我已经实现了，但模式窗体的淡入淡出挺费脑筋的。所以来求助嘛！

Answer 12

可能只有用定时器才行。　　你 show 时不要直接 Show ，而是在窗体的代码中加个 Public的过程 作为接口，在它里面 show 和启用定时器。　　这样能够解决吧！

Answer 13

以下代码位于FORM1中:'窗体中添加一个按钮.
Option ExplicitPrivate Sub Command1_Click()
    Form2.Show vbModal
    Unload Form2
End Sub以下代码位于FORM2中:'FORM2中添加一个Timer1,Interval属性为10
Option ExplicitDim I As LongPrivate Sub Form_Load()
    I = 0
    OnTop Me, False, I          '全透明
    Timer1.Tag = "Load"
    Timer1.Enabled = True       '开始淡入
End SubPrivate Sub Form_Unload(Cancel As Integer)
    If I = 255 Then                 '卸载开始,淡出
        Cancel = 1
        Timer1.Tag = "UnLoad"
        Timer1.Enabled = True
    End If
End SubPrivate Sub Timer1_Timer()
    If Timer1.Tag = "Load" Then         '加载的情况,淡入
        I = I + 10
        If I > 255 Then I = 255
        OnTop Me, False, I
    Else                                '卸载的情况,淡出
        I = I - 10
        If I < 0 Then I = 0
        OnTop Me, False, I
    End If
    If I = 0 Or I = 255 Then
        Timer1.Enabled = False
        If I = 0 Then Me.Hide           '卸载时就隐藏,去除模态状态
    End If
End Sub就行了.......思路是,LOAD窗体时,在窗体还未显示出来的时候就设置透明度为完全透明,再启动定时器进行淡入.然后以模态显示.卸载时.....就淡出罗....这里的OnTop函数是以前写的一个封装,在这里下载:http://www.m5home.com/bbs/thread-2806-1-2.html

Answer 14

老马，楼主要求不能 Unload .........

Answer 15

楼主就不能在我的代码的基础上改改么?一次LOAD多次使用,只需要添加一个初始化过程的代码就可以实现....非要什么都做好啊?