窗口移动和透明处理

Question

请问：在VB6里如何使没有标题栏的窗口可以随着在窗口任意位置按下的鼠标左键移动，就像通常我们在标题栏上按下鼠标左键可以拖动窗口一样？另，怎么实现窗口的半透明效果，是不是要使用API？

Answer 1

上面两个问题都要调用API实现。明天给你答复吧

Answer 2

http://byrenpage.myrice.com/VB/text/form/45.htm异形窗口鼠标拖动的实现　　基本原理: 当无标题栏窗口进行鼠标拖动时, 在一个最明显的事实, 就是其鼠标在窗口中的坐标始终不变, 所以如果能够在鼠标移动过程中, 通过改变窗口在桌面上的坐标, 而始终保持鼠标的相对坐标不变, 即可实现鼠标的拖动效果; 在具体的程序设计中, 先在Mousedown() 事件中记录鼠标位置, 而在Mousemove() 事件中根据鼠标的移动距离,实时修改窗体Form的Top及Left值,即可准确无误的实现窗口的鼠标拖动操作。利用此方法实现鼠标拖动,与常规的标题栏鼠标拖动在效果上有一点区别, 因为标题栏拖动时, 鼠标移动过程中不重画窗口, 只有松开鼠标后在固定位置重画窗口, 所以其速度较快, 而采用此方法拖动过程中, 每移动一步都需要重画窗口, 对速度稍有影响,在慢一些的机器上会出现轻微的拖尾现象, 但绝不会影响正常操作,而在586以上机器上或者高速显示系统下会完全克服这种现象。在实际程序设计时,窗口中可能有多种控件,若想使鼠标拖动窗口中的任何位置都可实现窗口移动, 必须对窗口中的所有控件进行上述的鼠标位置记录与移动处理, 即在MouseDown()与MouseMove()事件中加入下面的程序代码, 当然与可以在窗口内设置一个专门用于窗口拖动的区域, 这样只对此一个控件操作即可。

Answer 3

【操作VB中的无边框窗体】  
 
湖南省郴州市苏仙区信用联社(423000) 段岳辉 在VB中，BorderStyle属性为0的窗体没有边框，并且也没有与边框相关的元素。这种窗体具有简洁、占用空间少等优点，用它可以设计出某些富有个性的窗体。但是，由于它没有标题栏，窗体不能移动，同时也不能改变大小，在某些情况下会给使用者造成一定的麻烦。本文介绍在VB中如何用API函数操作无边框窗体。 
移动窗体 
新建一标准工程，设置Form1的BorderStyle属性为0。此时运行程序后，无法移动窗体。为能移动窗体，在Form1的代码窗口声明下列函数和常数： 
Option Explicit 
Private Declare Function ReleaseCapture Lib “user32” () As Long 
Private Declare Function SendMessage Lib “user32” Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
Const WM_SYSCOMMAND = ＆H112 
Const SC_MOVE = ＆HF012 
在Form_MouseDown事件中输入以下代码： 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
'按下鼠标左键 
If Button = vbLeftButton Then 
'为当前的应用程序释放鼠标捕获 
ReleaseCapture 
'移动窗体 
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0 
End If 
End Sub 
注意：此时窗体上不能放置除Shape控件以外的任何控件，否则，在被控件遮住的地方点按鼠标还是无法移动窗体。要使点按控件也能移动窗体，需再添加一个该控件的MouseDown事件过程，代码与上述过程代码相似。 
改变窗体的大小 
为了改变窗体的大小，需要添加一个Timer控件，以定时捕获鼠标在窗体中的位置。当鼠标位于窗体边缘时，改变鼠标的形状，以通知用户可以进行改变大小的操作。为此，将Timer控件的Interval属性设为100（即每过100毫秒检测一下鼠标位置），其他取默认值。 
在Form1的代码窗口中再添加下列两个函数，并定义两个自定义变量和一个字符串变量： 
'取得窗体位置的函数 
Private Declare Function GetWindowRect Lib “user32” (ByVal hwnd As Long, lpRect As RECT) As Long 
'取得鼠标位置的函数 
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long 
'鼠标位置变量 
Private Type POINTAPI 
x As Long 
y As Long 
End Type 
'窗体位置变量 
Private Type RECT 
Left As Long 
Top As Long 
Right As Long 
Bottom As Long 
End Type 
'所要执行的动作变量，是移动还是改变大小及从哪个方向改变大小 
Dim Action As String 
在Timer1控件的Timer事件过程中添加以下代码： 
Private Sub Timer1_Timer() 
Dim MyRect As RECT 
Dim MyPoint As POINTAPI 
' MyRect返回当前窗口位置 
Call GetWindowRect(Me.hwnd, MyRect) 
' MyPoint返回当前鼠标位置 
Call GetCursorPos(MyPoint) 
Select Case True 
'鼠标位于窗体左上方 
Case MyPoint.x < MyRect.Left ＋ 5 And MyPoint.y < MyRect.Top ＋ 5 
Screen.MousePointer = vbSizeNWSE 
Action = “LeftUp” 
'鼠标位于窗体右下方 
Case MyPoint.x > MyRect.Right － 5 And MyPoint.y > MyRect.Bottom － 5 
Screen.MousePointer = vbSizeNWSE 
Action = “RightDown” 
'鼠标位于窗体右上方 
Case MyPoint.x > MyRect.Right － 5 And MyPoint.y < MyRect.Top ＋ 5 
’45度双向鼠标指针 
Screen.MousePointer = vbSizeNESW 
Action = “RightUp” 
'鼠标位于窗体左下方 
Case MyPoint.x < MyRect.Left ＋ 5 And MyPoint.y > MyRect.Bottom － 5 
Screen.MousePointer = vbSizeNESW 
Action = “LeftDown” 
'鼠标位于窗体左边 
Case MyPoint.x < MyRect.Left ＋ 5 
'水平双向鼠标指针 
Screen.MousePointer = vbSizeWE 
Action = “Left” 
'鼠标位于窗体右边 
Case MyPoint.x > MyRect.Right － 5 
Screen.MousePointer = vbSizeWE 
Action = “Right” 
'鼠标位于窗体上方 
Case MyPoint.y < MyRect.Top ＋ 5 
'垂直双向鼠标指针 
Screen.MousePointer = vbSizeNS 
Action = “Up” 
'鼠标位于窗体下方 
Case MyPoint.y > MyRect.Bottom － 5 
Screen.MousePointer = vbSizeNS 
Action = “Down” 
'鼠标位于窗体其他位置 
Case Else 
'默认鼠标指针 
Screen.MousePointer = 0 
Action = “Move” 
End Select 
End Sub 
当利用SendMessage函数由系统向窗口发送改变大小的信息时，只要将上面移动窗体的语句“SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0”中的第3个参数改为相应的常数即可。 
VB中＆HF001～＆HF008分别是从左、右、上、左上、右上、下、左下、右下8个方向改变窗体大小的常数。结合移动窗体的代码，将上述Form_MouseDown事件的代码综合如下（也可以把这8个常数声明为自定义常数）： 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 
'按下鼠标左键 
If Button = vbLeftButton Then 
'为当前的应用程序释放鼠标捕获 
ReleaseCapture 
Select Case Action 
Case “Left” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF001, 0 
Case “Right” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF002, 0 
Case “Up” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF003, 0 
Case “LeftUp” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF004, 0 
Case “RightUp” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF005, 0 
Case “Down” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF006, 0 
Case “LeftDown” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF007, 0 
Case “RightDown” 
SendMessage Me.hwnd, WM_SYSCOMMAND, ＆HF008, 0 
Case “Move” 
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0 
End Select 
End If 
End Sub 

Answer 4

http://byrenpage.myrice.com/VB/text/form/183.htm

Answer 5

【用VisualBasic制作半透明窗体】  
 
作者：iProgram 函数SetLayeredWindowAttributes 　　使用这个函数，可以轻松的实现半透明窗体。按照微软的要求，透明窗体窗体在创建时应使用WS_EX_LAYERED参数（用CreateWindowEx），或者在创建后设置该参数（用SetWindowLong），我选用后者。全部函数、常量声明如下： 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 　 　其中hwnd是透明窗体的句柄，crKey为颜色值，bAlpha是透明度，取值范围是[0,255]，dwFlags是透明方式，可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，bAlpha参数有效；当取值为LWA_COLORKEY时，bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明－－这个功能很有用：我们不必再为建立不规则形状的窗体而调用一大堆区域分析、创建、合并函数了，只需指定透明处的颜色值即可，哈哈哈哈！请看具体代码。 Private Const WS_EX_LAYERED = &H80000 Private Const GWL_EXSTYLE = (-20) Private Const LWA_ALPHA = &H2 Private Const LWA_COLORKEY = &H1 代码一：一个半透明窗体 Private Sub Form_Load() 　　Dim rtn As Long 　　rtn = GetWindowLong(hwnd, GWL_EXSTYLE) 　　rtn = rtn Or WS_EX_LAYERED 　　SetWindowLong hwnd, GWL_EXSTYLE, rtn 　　SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA End Sub 
代码二：形状不规则的窗体 Private Sub Form_Load() 　　Dim rtn As Long 　　BorderStyler=0 　　rtn = GetWindowLong(hwnd, GWL_EXSTYLE) 　　rtn = rtn Or WS_EX_LAYERED 　　SetWindowLong hwnd, GWL_EXSTYLE, rtn 　　SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEY ’将扣去窗口中的蓝色 End Sub
 

Answer 6

移动无标题栏的窗体Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage hWnd, &HA1, 2, 0&End Sub

Answer 7

半透明窗体(win2000特有API)  
 
2001-11-24· · ··yesky 　　Windows2000已经出了一年多了,就先介绍一下Windows2000特有的API吧!! AnimateWindow是一个窗口打开和关闭时产生动画效果的新函数，因为是一个新的函数, 所以在 API Viewer中是找不到的,必需自己定义:　　 Public 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_ALPHA=&H2     '表示把窗体设置成半透明样式
　　Const LWA_COLORKEY=&H1     '表示不显示窗体中的透明色 
 
    
　　具体例子　　程序代码　　Module1Public 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
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
　　Form1 Private Sub Form_Load()
Dim rtn As Long　　rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)    '取的窗口原先的样式
rtn = rtn Or WS_EX_LAYERED     '使窗体添加上新的样式WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn    '把新的样式赋给窗体　　SetLayeredWindowAttributes me.hwnd, 0, 192, LWA_ALPHA　　　　'把窗体设置成半透明样式,第二个参数表示透明程度
　　　　'取值范围0--255,为0时就是一个全透明的窗体了　　End Sub

Answer 8

这个问题好复杂的，一下说不清楚，在XP以上版本下，只用一句代码就行了，在2000以下的版本是实现不了的。去http://www.vbaccelerator.com/home/NET/index.asp看，这里有你想要的代码。