-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Çok eski bir web tarayıcısı kullanıyorsunuz. Bu veya diğer siteleri görüntülemekte sorunlar yaşayabilirsiniz..
Tarayıcınızı güncellemeli veya alternatif bir tarayıcı kullanmalısınız.
Tarayıcınızı güncellemeli veya alternatif bir tarayıcı kullanmalısınız.
UserFormdan Sürükleme
- Konbuyu başlatan serqet
- Başlangıç tarihi
olurda birine lazım olursa;
Modüle yazılacak
Option Explicit
Option Base 0
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal _
lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength _
As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal _
fdwError As Long, ByVal lpszErrorText As String, ByVal cchErrorText As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_DIFF = 4
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function EnableWindow Lib "user32" _
(ByVal hWnd As Long, ByVal fEnable As Long) As Long
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
Public Enum enSetWindowPos
SWP_FRAMECHANGED = &H20
SWP_HIDEWINDOW = &H80
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200
SWP_NOREDRAW = &H8
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_SHOWWINDOW = &H40
End Enum
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 Enum enGetWindowLong
GWL_EXSTYLE = (-20)
GWL_HINSTANCE = (-6)
GWL_HWNDPARENT = (-8)
GWL_ID = (-12)
GWL_STYLE = (-16)
GWL_USERDATA = (-21)
GWL_WNDPROC = (-4)
End Enum
Public Enum enWindowStyles
WS_BORDER = &H800000
WS_CAPTION = &HC00000
WS_CHILD = &H40000000
WS_CLIPCHILDREN = &H2000000
WS_CLIPSIBLINGS = &H4000000
WS_DISABLED = &H8000000
WS_DLGFRAME = &H400000
WS_EX_ACCEPTFILES = &H10&
WS_EX_DLGMODALFRAME = &H1&
WS_EX_NOPARENTNOTIFY = &H4&
WS_EX_TOPMOST = &H8&
WS_EX_TRANSPARENT = &H20&
WS_EX_TOOLWINDOW = &H80&
WS_GROUP = &H20000
WS_HSCROLL = &H100000
WS_MAXIMIZE = &H1000000
WS_MAXIMIZEBOX = &H10000
WS_MINIMIZE = &H20000000
WS_MINIMIZEBOX = &H20000
WS_OVERLAPPED = &H0&
WS_POPUP = &H80000000
WS_SYSMENU = &H80000
WS_TABSTOP = &H10000
WS_THICKFRAME = &H40000
WS_VISIBLE = &H10000000
WS_VSCROLL = &H200000
WS_EX_MDICHILD = &H40
WS_EX_WINDOWEDGE = &H100
WS_EX_CLIENTEDGE = &H200
WS_EX_CONTEXTHELP = &H400
WS_EX_RIGHT = &H1000
WS_EX_LEFT = &H0
WS_EX_RTLREADING = &H2000
WS_EX_LTRREADING = &H0
WS_EX_LEFTSCROLLBAR = &H4000
WS_EX_RIGHTSCROLLBAR = &H0
WS_EX_CONTROLPARENT = &H10000
WS_EX_STATICEDGE = &H20000
WS_EX_APPWINDOW = &H40000
WS_EX_OVERLAPPEDWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
WS_EX_PALETTEWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_TOOLWINDOW Or WS_EX_TOPMOST)
End Enum
Forma yazılacak
Option Explicit
Option Base 0
Dim hWndForm As Long
Dim flgL As Boolean
Dim hMS As Integer
Dim flgD As Boolean
Dim flgN As Boolean
Property Let RuntimeFormBorderStyle(ByVal newVal As FormShowConstants)
WindowStyle(WS_BORDER) = False
WindowStyle(WS_CAPTION) = False
WindowStyle(WS_DLGFRAME) = False
WindowStyle(WS_EX_DLGMODALFRAME) = False
WindowStyle(WS_EX_TOOLWINDOW) = False
WindowStyle(WS_THICKFRAME) = False
WindowStyle(WS_VSCROLL) = False
WindowStyle(WS_EX_WINDOWEDGE) = False
WindowStyle(WS_EX_CLIENTEDGE) = False
WindowStyle(WS_EX_CONTROLPARENT) = False
WindowStyle(WS_EX_STATICEDGE) = False
WindowStyle(WS_EX_APPWINDOW) = False
End Property
Property Let WindowStyle(ByVal Index As enWindowStyles, ByVal newVal As Boolean)
Dim gwIndex As enGetWindowLong
Dim mCurStyle As Long
If Index = WS_EX_ACCEPTFILES Or Index = WS_EX_APPWINDOW _
Or Index = WS_EX_CLIENTEDGE Or Index = WS_EX_CONTEXTHELP _
Or Index = WS_EX_CONTROLPARENT Or Index = WS_EX_DLGMODALFRAME _
Or Index = WS_EX_LEFT Or Index = WS_EX_LEFTSCROLLBAR _
Or Index = WS_EX_LTRREADING Or Index = WS_EX_MDICHILD _
Or Index = WS_EX_NOPARENTNOTIFY Or Index = WS_EX_OVERLAPPEDWINDOW _
Or Index = WS_EX_PALETTEWINDOW Or Index = WS_EX_RIGHT _
Or Index = WS_EX_RIGHTSCROLLBAR Or Index = WS_EX_RTLREADING _
Or Index = WS_EX_STATICEDGE Or Index = WS_EX_TOOLWINDOW _
Or Index = WS_EX_TOPMOST Or Index = WS_EX_TRANSPARENT _
Or Index = WS_EX_WINDOWEDGE Then
gwIndex = GWL_EXSTYLE
Else
gwIndex = GWL_STYLE
End If
mCurStyle = GetWindowLong(hWndForm, gwIndex)
If newVal Then
mCurStyle = mCurStyle Or Index
Else
mCurStyle = mCurStyle And (Not Index)
End If
Call SetWindowLong(hWndForm, gwIndex, mCurStyle)
End Property
Private Sub UserForm_Activate()
EnableWindow FindWindow("XLMAIN", Application.Caption), 1
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Move (ActiveWindow.Width / 2 - Me.Width / 2), (ActiveWindow.Height / 2 - Me.Height / 2) + 50
Me.ForeColor = vbWhite
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Me.RuntimeFormBorderStyle = vbModeless
End Sub
Sub DragForm(Frm As UserForm)
On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Call DragForm(Me)
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set UserForm1 = Nothing
End Sub
Modüle yazılacak
Option Explicit
Option Base 0
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal _
lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength _
As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal _
fdwError As Long, ByVal lpszErrorText As String, ByVal cchErrorText As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_DIFF = 4
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function EnableWindow Lib "user32" _
(ByVal hWnd As Long, ByVal fEnable As Long) As Long
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
Public Enum enSetWindowPos
SWP_FRAMECHANGED = &H20
SWP_HIDEWINDOW = &H80
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200
SWP_NOREDRAW = &H8
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_SHOWWINDOW = &H40
End Enum
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 Enum enGetWindowLong
GWL_EXSTYLE = (-20)
GWL_HINSTANCE = (-6)
GWL_HWNDPARENT = (-8)
GWL_ID = (-12)
GWL_STYLE = (-16)
GWL_USERDATA = (-21)
GWL_WNDPROC = (-4)
End Enum
Public Enum enWindowStyles
WS_BORDER = &H800000
WS_CAPTION = &HC00000
WS_CHILD = &H40000000
WS_CLIPCHILDREN = &H2000000
WS_CLIPSIBLINGS = &H4000000
WS_DISABLED = &H8000000
WS_DLGFRAME = &H400000
WS_EX_ACCEPTFILES = &H10&
WS_EX_DLGMODALFRAME = &H1&
WS_EX_NOPARENTNOTIFY = &H4&
WS_EX_TOPMOST = &H8&
WS_EX_TRANSPARENT = &H20&
WS_EX_TOOLWINDOW = &H80&
WS_GROUP = &H20000
WS_HSCROLL = &H100000
WS_MAXIMIZE = &H1000000
WS_MAXIMIZEBOX = &H10000
WS_MINIMIZE = &H20000000
WS_MINIMIZEBOX = &H20000
WS_OVERLAPPED = &H0&
WS_POPUP = &H80000000
WS_SYSMENU = &H80000
WS_TABSTOP = &H10000
WS_THICKFRAME = &H40000
WS_VISIBLE = &H10000000
WS_VSCROLL = &H200000
WS_EX_MDICHILD = &H40
WS_EX_WINDOWEDGE = &H100
WS_EX_CLIENTEDGE = &H200
WS_EX_CONTEXTHELP = &H400
WS_EX_RIGHT = &H1000
WS_EX_LEFT = &H0
WS_EX_RTLREADING = &H2000
WS_EX_LTRREADING = &H0
WS_EX_LEFTSCROLLBAR = &H4000
WS_EX_RIGHTSCROLLBAR = &H0
WS_EX_CONTROLPARENT = &H10000
WS_EX_STATICEDGE = &H20000
WS_EX_APPWINDOW = &H40000
WS_EX_OVERLAPPEDWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
WS_EX_PALETTEWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_TOOLWINDOW Or WS_EX_TOPMOST)
End Enum
Forma yazılacak
Option Explicit
Option Base 0
Dim hWndForm As Long
Dim flgL As Boolean
Dim hMS As Integer
Dim flgD As Boolean
Dim flgN As Boolean
Property Let RuntimeFormBorderStyle(ByVal newVal As FormShowConstants)
WindowStyle(WS_BORDER) = False
WindowStyle(WS_CAPTION) = False
WindowStyle(WS_DLGFRAME) = False
WindowStyle(WS_EX_DLGMODALFRAME) = False
WindowStyle(WS_EX_TOOLWINDOW) = False
WindowStyle(WS_THICKFRAME) = False
WindowStyle(WS_VSCROLL) = False
WindowStyle(WS_EX_WINDOWEDGE) = False
WindowStyle(WS_EX_CLIENTEDGE) = False
WindowStyle(WS_EX_CONTROLPARENT) = False
WindowStyle(WS_EX_STATICEDGE) = False
WindowStyle(WS_EX_APPWINDOW) = False
End Property
Property Let WindowStyle(ByVal Index As enWindowStyles, ByVal newVal As Boolean)
Dim gwIndex As enGetWindowLong
Dim mCurStyle As Long
If Index = WS_EX_ACCEPTFILES Or Index = WS_EX_APPWINDOW _
Or Index = WS_EX_CLIENTEDGE Or Index = WS_EX_CONTEXTHELP _
Or Index = WS_EX_CONTROLPARENT Or Index = WS_EX_DLGMODALFRAME _
Or Index = WS_EX_LEFT Or Index = WS_EX_LEFTSCROLLBAR _
Or Index = WS_EX_LTRREADING Or Index = WS_EX_MDICHILD _
Or Index = WS_EX_NOPARENTNOTIFY Or Index = WS_EX_OVERLAPPEDWINDOW _
Or Index = WS_EX_PALETTEWINDOW Or Index = WS_EX_RIGHT _
Or Index = WS_EX_RIGHTSCROLLBAR Or Index = WS_EX_RTLREADING _
Or Index = WS_EX_STATICEDGE Or Index = WS_EX_TOOLWINDOW _
Or Index = WS_EX_TOPMOST Or Index = WS_EX_TRANSPARENT _
Or Index = WS_EX_WINDOWEDGE Then
gwIndex = GWL_EXSTYLE
Else
gwIndex = GWL_STYLE
End If
mCurStyle = GetWindowLong(hWndForm, gwIndex)
If newVal Then
mCurStyle = mCurStyle Or Index
Else
mCurStyle = mCurStyle And (Not Index)
End If
Call SetWindowLong(hWndForm, gwIndex, mCurStyle)
End Property
Private Sub UserForm_Activate()
EnableWindow FindWindow("XLMAIN", Application.Caption), 1
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Move (ActiveWindow.Width / 2 - Me.Width / 2), (ActiveWindow.Height / 2 - Me.Height / 2) + 50
Me.ForeColor = vbWhite
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Me.RuntimeFormBorderStyle = vbModeless
End Sub
Sub DragForm(Frm As UserForm)
On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Call DragForm(Me)
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set UserForm1 = Nothing
End Sub
- Katılım
- 12 Kasım 2008
- Mesajlar
- 240
- Excel Vers. ve Dili
- 2010-2013
merhabalar
sayın seqet bu kodlar söylediğiniz gibi userformu başlık menüsünün dışında sürüklemek için mi kullanılıyor. iyi çalışmalar. ve paylaşım için teşekkürlerolurda birine lazım olursa;
Modüle yazılacak
Option Explicit
Option Base 0
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal _
lpszCommand As String, ByVal lpszReturnString As String, ByVal cchReturnLength _
As Long, ByVal hwndCallback As Long) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal _
fdwError As Long, ByVal lpszErrorText As String, ByVal cchErrorText As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_DIFF = 4
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function EnableWindow Lib "user32" _
(ByVal hWnd As Long, ByVal fEnable As Long) As Long
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
Public Enum enSetWindowPos
SWP_FRAMECHANGED = &H20
SWP_HIDEWINDOW = &H80
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200
SWP_NOREDRAW = &H8
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_SHOWWINDOW = &H40
End Enum
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 Enum enGetWindowLong
GWL_EXSTYLE = (-20)
GWL_HINSTANCE = (-6)
GWL_HWNDPARENT = (-8)
GWL_ID = (-12)
GWL_STYLE = (-16)
GWL_USERDATA = (-21)
GWL_WNDPROC = (-4)
End Enum
Public Enum enWindowStyles
WS_BORDER = &H800000
WS_CAPTION = &HC00000
WS_CHILD = &H40000000
WS_CLIPCHILDREN = &H2000000
WS_CLIPSIBLINGS = &H4000000
WS_DISABLED = &H8000000
WS_DLGFRAME = &H400000
WS_EX_ACCEPTFILES = &H10&
WS_EX_DLGMODALFRAME = &H1&
WS_EX_NOPARENTNOTIFY = &H4&
WS_EX_TOPMOST = &H8&
WS_EX_TRANSPARENT = &H20&
WS_EX_TOOLWINDOW = &H80&
WS_GROUP = &H20000
WS_HSCROLL = &H100000
WS_MAXIMIZE = &H1000000
WS_MAXIMIZEBOX = &H10000
WS_MINIMIZE = &H20000000
WS_MINIMIZEBOX = &H20000
WS_OVERLAPPED = &H0&
WS_POPUP = &H80000000
WS_SYSMENU = &H80000
WS_TABSTOP = &H10000
WS_THICKFRAME = &H40000
WS_VISIBLE = &H10000000
WS_VSCROLL = &H200000
WS_EX_MDICHILD = &H40
WS_EX_WINDOWEDGE = &H100
WS_EX_CLIENTEDGE = &H200
WS_EX_CONTEXTHELP = &H400
WS_EX_RIGHT = &H1000
WS_EX_LEFT = &H0
WS_EX_RTLREADING = &H2000
WS_EX_LTRREADING = &H0
WS_EX_LEFTSCROLLBAR = &H4000
WS_EX_RIGHTSCROLLBAR = &H0
WS_EX_CONTROLPARENT = &H10000
WS_EX_STATICEDGE = &H20000
WS_EX_APPWINDOW = &H40000
WS_EX_OVERLAPPEDWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
WS_EX_PALETTEWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_TOOLWINDOW Or WS_EX_TOPMOST)
End Enum
Forma yazılacak
Option Explicit
Option Base 0
Dim hWndForm As Long
Dim flgL As Boolean
Dim hMS As Integer
Dim flgD As Boolean
Dim flgN As Boolean
Property Let RuntimeFormBorderStyle(ByVal newVal As FormShowConstants)
WindowStyle(WS_BORDER) = False
WindowStyle(WS_CAPTION) = False
WindowStyle(WS_DLGFRAME) = False
WindowStyle(WS_EX_DLGMODALFRAME) = False
WindowStyle(WS_EX_TOOLWINDOW) = False
WindowStyle(WS_THICKFRAME) = False
WindowStyle(WS_VSCROLL) = False
WindowStyle(WS_EX_WINDOWEDGE) = False
WindowStyle(WS_EX_CLIENTEDGE) = False
WindowStyle(WS_EX_CONTROLPARENT) = False
WindowStyle(WS_EX_STATICEDGE) = False
WindowStyle(WS_EX_APPWINDOW) = False
End Property
Property Let WindowStyle(ByVal Index As enWindowStyles, ByVal newVal As Boolean)
Dim gwIndex As enGetWindowLong
Dim mCurStyle As Long
If Index = WS_EX_ACCEPTFILES Or Index = WS_EX_APPWINDOW _
Or Index = WS_EX_CLIENTEDGE Or Index = WS_EX_CONTEXTHELP _
Or Index = WS_EX_CONTROLPARENT Or Index = WS_EX_DLGMODALFRAME _
Or Index = WS_EX_LEFT Or Index = WS_EX_LEFTSCROLLBAR _
Or Index = WS_EX_LTRREADING Or Index = WS_EX_MDICHILD _
Or Index = WS_EX_NOPARENTNOTIFY Or Index = WS_EX_OVERLAPPEDWINDOW _
Or Index = WS_EX_PALETTEWINDOW Or Index = WS_EX_RIGHT _
Or Index = WS_EX_RIGHTSCROLLBAR Or Index = WS_EX_RTLREADING _
Or Index = WS_EX_STATICEDGE Or Index = WS_EX_TOOLWINDOW _
Or Index = WS_EX_TOPMOST Or Index = WS_EX_TRANSPARENT _
Or Index = WS_EX_WINDOWEDGE Then
gwIndex = GWL_EXSTYLE
Else
gwIndex = GWL_STYLE
End If
mCurStyle = GetWindowLong(hWndForm, gwIndex)
If newVal Then
mCurStyle = mCurStyle Or Index
Else
mCurStyle = mCurStyle And (Not Index)
End If
Call SetWindowLong(hWndForm, gwIndex, mCurStyle)
End Property
Private Sub UserForm_Activate()
EnableWindow FindWindow("XLMAIN", Application.Caption), 1
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Move (ActiveWindow.Width / 2 - Me.Width / 2), (ActiveWindow.Height / 2 - Me.Height / 2) + 50
Me.ForeColor = vbWhite
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
Me.RuntimeFormBorderStyle = vbModeless
End Sub
Sub DragForm(Frm As UserForm)
On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Call DragForm(Me)
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set UserForm1 = Nothing
End Sub
-
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.