Userformun açılışta tam ekran olması

[İsmail Küçükşengün]

Merhaba;

Userformun Kod sayfasının ilk başında alttaki kod var

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&

Activate kısmında ise;

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

Ve diğer kodları ise:

Private Sub AddIcon()
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = Sheet1.Image7.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

Şeklindedir.

Görev çubuğuna (ikonlu olarak) minimize oluyor.

Kapat düğmesinin yanındaki (Kapat ile minimize butonlarının ortasındaki) buton ise ilk açılışta tam ekran açılmıyor, bu butona tıkladığımda tam ekran oluyor.

Userform ilk açılırken (Yukarıdaki kodlar da nazara alınara ve bu kodlarla çakışmamak üzere) kendiliğinde tam ekran olarak açılması için (Ortadaki butonun Tek kare değil de 2 kare şeklinde olması için):

Kodlarda ne gibi değişiklik ya da ilave gerekir.

Şimdiden teşekkürlerimle.

Şimdiden teşekkürlerimle.

 

[Zeki Gürsoy]

Form üzerine 3 buton ekleyip test edin. Sonuç olumluysa cmdMax altındaki yapıyı "Activate" altına ilave edersiniz.

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
[COLOR=DarkGreen] '------------------------------[/COLOR]
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow 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&
[COLOR=DarkGreen] '-------------------------------------[/COLOR]
Private Const SW_MAXIMIZE As Long = 3
Private Const SW_MINIMIZE As Long = 6
Private Const SW_HIDE As Long = 0
Private Const SW_NORMAL As Long = 1

Private Sub cmdMax_Click()
Dim myForm As Long
[COLOR=DarkGreen] '// Buton..[/COLOR]
myForm = FindWindow(vbNullString, Me.Caption)
ShowWindow myForm, SW_MAXIMIZE
End Sub

Private Sub cmdMin_Click()
Dim myForm As Long
[COLOR=DarkGreen] '// Buton..[/COLOR]
myForm = FindWindow(vbNullString, Me.Caption)
ShowWindow myForm, SW_MINIMIZE

End Sub

Private Sub cmdNormal_Click()
Dim myForm As Long
[COLOR=DarkGreen] '// Buton..[/COLOR]
myForm = FindWindow(vbNullString, Me.Caption)
ShowWindow myForm, SW_NORMAL
End Sub

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 = Sheet1.Image7.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

 

[Zeki Gürsoy]

Bu da benimde bir dönem ihtiyaç duyduğum arşivimdeki örneğim.

 

[İsmail Küçükşengün]

Sayın Zeki Gürsoy;

Activate kısmına ekledim. Fakat;
ShowWindow

Kısmı hata işareti veriyor.

 

[Zeki Gürsoy]

ShowWindow API yi de ekleyin. Olmazsa ekli örneğimi inceleyin.

 

[İsmail Küçükşengün]

Sayın Zeki Gürsoy;

Dim myForm As Long
myForm = FindWindow(vbNullString, Me.Caption)
ShowWindow myForm, SW_MAXIMIZE

İbaresini Activate kısmına yazınca oldu.

Çok TEŞEKKÜRLER.

(Bizim şu XML konusu da yavaş yavaş gündeme gelse.)

Selamlarımla.

 

[Zeki Gürsoy]

.
.
(Bizim şu XML konusu da yavaş yavaş gündeme gelse.)

Selamlarımla.

O da olacak inşallah.