首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

扁圆窗口中的任意位置拖动窗体为什么实现不了,椭圆窗体、任意位置、拖动

2013-04-20 
椭圆窗口中的任意位置拖动窗体为什么实现不了,椭圆窗体、任意位置、拖动Private Type pointX As LongY As Lo

椭圆窗口中的任意位置拖动窗体为什么实现不了,椭圆窗体、任意位置、拖动

Private Type point
    X As Long
    Y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As point) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal Redraw As Long) As Long

Dim point1 As point, point2 As point, point3 As point
Dim xa As Single, ya As Single



Private Sub Form_ReSize()
    Image1.Width = Me.ScaleWidth
    Image1.Height = Me.ScaleHeight
    Dim Outer_rgn As Long
    Dim Inner_rgn As Long
    Dim Combined_rgn As Long
    Dim wid As Single
    Dim hgt As Single
    Dim border_width As Single
    Dim title_height As Single
   
    wid = Me.ScaleWidth
    hgt = Me.ScaleHeight
    
    border_width = (wid - Me.ScaleWidth) / 2
    title_height = hgt - border_width - Me.ScaleHeight
    Outer_rgn = CreateRectRgn(border_width, title_height, wid, hgt)
    Inner_rgn = CreateEllipticRgn(border_width + ScaleWidth * 0.1, title_height + ScaleHeight * 0.1, ScaleWidth * 0.9, ScaleHeight * 0.9)
    Combined_rgn = CreateRectRgn(0, 0, 0, 0)
    CombineRgn Combined_rgn, Outer_rgn, Inner_rgn, 1
    SetWindowRgn Me.hWnd, Combined_rgn, True
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
xa = X
ya = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then Me.Move Me.Left + X - xa, Me.Top + Y - ya
End Sub
拖动 VB 椭圆窗体
------解决方案--------------------



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
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const HTCAPTION = 2
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)  
  Call ReleaseCapture
  Call SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, ByVal 0&)
End Sub

你那些Rgn用完了就DeleteObject

热点排行