Hur ändrar man storlek på ett fönster som inte har nån border? (BorderStyle = None)

Thomas

Prova denna kod.

Klistra in koden i en tomt formulär.

Option Explicit


Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (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
Private fXPos As Single
Private fYPos As Single
Private fX As Single
Private fY As Single
Private fbolDrag As Boolean
'The size of the title area on the form
Private Const fcTitleSize = 22
'the offset needed to make the form move
' smoothly
Private Const fcBorderSize = 4


Private Sub Form_Load()
Dim rRect As RECT
Dim ret As Long
rRect.Left = 0
rRect.Top = fcTitleSize
rRect.Right = Me.Width
rRect.Bottom = Me.Height
ret = CreateRectRgnIndirect(rRect)
SetWindowRgn Me.hWnd, ret, True
End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim rPos As POINTAPI
GetCursorPos rPos
fX = X * 15
fY = Y * 15
fXPos = (rPos.X * 15) - X
fYPos = (rPos.Y * 15) - Y
fbolDrag = True
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)


If fbolDrag = True Then
Me.Move fXPos, fYPos
End If
End Sub


Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
fbolDrag = False
End Sub


Private Sub Timer1_Timer()
Dim rPos As POINTAPI


If fbolDrag = True Then
GetCursorPos rPos
fXPos = (rPos.X * 15) - (fX + (fcBorderSize * 15))
fYPos = (rPos.Y * 15) - (fY + ((fcTitleSize + 1) * 15))
Me.Move fXPos, fYPos
End If
End Sub


mvh
Johan