Userform ekranı kapla düğmesi

[zafer]

Merhaba

Sayın Raiderin yapmış olduğu aşağıdaki çalışmada userform düğmelerinde ekranı kapla düğmesinin olmaması için ne yapmamız gerekiyor.


Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 ShowWindow Lib "User32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long


Private Sub UserForm_Initialize()
Dim hWndForm As Long, frmStyle As Long
Dim MyFile As String


hWndForm = FindWindow(vbNullString, Me.Caption)
frmStyle = GetWindowLong(hWndForm, (-16))
frmStyle = frmStyle Or &H80000 Or &H70000 Or &H10000
SetWindowLong hWndForm, (-16), frmStyle
ShowWindow hWndForm, 5
DrawMenuBar hWndForm

End sub

Saygılarımla

 

[Tarkan VURAL]

Merhaba;
Formunuzun başlıksız olması için bu deklerasyonu modül sayfasına,

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

bu koduda userform kod sayfasına yerleştirin.

Private Sub UserForm_Activate()
    Dim lngFormHwnd As Long
    Dim lngFormStyle As Long
    
    If Application.Version < 9 Then
        lngFormHwnd = FindWindow("THUNDERXFRAME", Me.Caption)
    Else
        lngFormHwnd = FindWindow("THUNDERDFRAME", Me.Caption)
    End If
    lngFormStyle = GetWindowLong(lngFormHwnd, (-16))
    lngFormStyle = lngFormStyle And Not &H800000
    SetWindowLong lngFormHwnd, (-16), lngFormStyle
    DrawMenuBar lngFormHwnd
End Sub

Sagılarımla;
Tarkan VURAL

 

[zafer]

Teşekkür ederim.

 

[Mahmut1950]

Sorunuza cevap olarak bir yerden api bulup kopyalamak tek çaresidir arkadaşlarda bunu yapmışlar.

 

[Tarkan VURAL]

Estağfurullah

 

[mustim1547]

Estağfurullah

Userformda ekranı kapla,simge durumuna küçült simgelerinin çıkması için aşağıdaki kodu ekledim ,userform üzerinde ekranı kapla kapat ve simge durumuna küçült simgeleri çıkıyor fakat bu seferde userformum çalışmıyor tanımlanmamış değişken hatası veriyor.. Sebebi sizce ne olabilir?


Eklediğim kod:
Option Explicit

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 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () 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
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Private Sub UserForm_Activate()
Dim hWnd As Long
hWnd = FindWindow(vbNullString, Me.Caption)
SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) Or &H10000 _
Or &H20000 Or &H40000
AddIcon
AddMinimiseButton
AppTasklist Me
End Sub

Private Sub AddIcon()
Dim hWnd As Long
Dim lngRet As Long
Dim hIcon As Long
hIcon = Sayfa1.Image1.Picture.Handle
hWnd = FindWindow(vbNullString, Me.Caption)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
lngRet = DrawMenuBar(hWnd)
End Sub

Private Sub AddMinimiseButton()
Dim hWnd As Long
hWnd = GetActiveWindow
Call SetWindowLong(hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) Or WS_MINIMIZEBOX)
Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE)
End Sub

Private Sub AppTasklist(myForm)
Dim WStyle As Long
Dim Result As Long
Dim hWnd As Long
hWnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_HIDEWINDOW)
Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Sub

Private Sub UserForm_Initialize()
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = 0: X2 = 0: Y1 = 0: Y2 = 0: CX = 0: CY = 0
X1 = Me.Width
Y1 = Me.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1 - 3
Me.Height = Y1 - 3
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Visible = True
End Sub