UserForm Manage With The TaskBar Menus

'WorkBook Code Page

Option Explicit
Private Sub Workbook_Open()

On Error Resume Next
Workbooks("Kitap1").Close False
Workbooks("Book1").Close False
Application.Visible = False
ThisWorkbook.Sheets(1).Range("A1").Value = 1
UserForm1.Show

End Sub

'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
'Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\WINDOWS\system32\MSCOMCTL.OCX

'B) UserForm1'e Eklenen Araçlar (Add Tools)

'Image1, Label1, Label2
'Label3, Label4, Label5, Label6

'C) Free Icon Editor

'Sib Icon Editor: http://download.cnet.com/Sib-Icon-Editor/3000-2195_4-10546745.html

Option Explicit
Private i As Integer
Private Resim As Image
Private FormTipi As New Class1
Private AktifOlma As Boolean
Private AçMenü1 As Office.CommandBar
Private Komut As Office.CommandBarButton
Private SeçilenResim(10000) As New Image
Private Katalog As New ImageList
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] UserForm Manage With The TaskBar Menus."
Call EkranDüzenle
Pencere = FindWindow(vbNullString, Me.Caption)
Set FormTipi.IconYarat = Me
Application.Visible = False
Application.VBE.MainWindow.Visible = False
AktifOlma = False
Sonlama = False
AnaFormEtkinmi = True

End Sub
Private Sub UserForm_Activate()

On Error Resume Next
Pencere = FindWindow(vbNullString, Me.Caption)
If AktifOlma = False Then

Set FormTipi.IconTak = Me
Set FormTipi.FormKur2 = Me '[-][][x]
AktifOlma = True

End If

End Sub
Private Sub UserForm_Resize()

On Error Resume Next
Set FormTipi.FormKüçültmek = Me 'Sadece Ana Menü İçin Geçerlidir....

End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label3.SpecialEffect = fmSpecialEffectFlat
Label4.SpecialEffect = fmSpecialEffectFlat
Label5.SpecialEffect = fmSpecialEffectFlat
Label6.SpecialEffect = fmSpecialEffectFlat

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
ActiveWorkbook.Save
Set FormTipi.FormYoket = Me
Set FormTipi.FormKapatmak = Me
If Sonlama = False Then Application.Visible = True
If Sonlama = False Then Application.VBE.MainWindow.Visible = True
'Application.Quit

End Sub
Private Sub Label3_Click()

On Error Resume Next
Set FormTipi.KapatmaEtkin = Me
Label3.SpecialEffect = fmSpecialEffectRaised

End Sub
Private Sub Label3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label3.SpecialEffect = fmSpecialEffectSunken

End Sub
Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label3.SpecialEffect = fmSpecialEffectRaised
Label4.SpecialEffect = fmSpecialEffectFlat
Label5.SpecialEffect = fmSpecialEffectFlat
Label6.SpecialEffect = fmSpecialEffectFlat

End Sub
Private Sub Label4_Click()

On Error Resume Next
Set FormTipi.KapatmaEtkisiz = Me
Label4.SpecialEffect = fmSpecialEffectRaised

End Sub
Private Sub Label4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label4.SpecialEffect = fmSpecialEffectSunken

End Sub
Private Sub Label4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label3.SpecialEffect = fmSpecialEffectFlat
Label4.SpecialEffect = fmSpecialEffectRaised
Label5.SpecialEffect = fmSpecialEffectFlat
Label6.SpecialEffect = fmSpecialEffectFlat

End Sub
Private Sub Label5_Click()

On Error Resume Next
Unload Me
Label5.SpecialEffect = fmSpecialEffectRaised

End Sub
Private Sub Label5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label5.SpecialEffect = fmSpecialEffectSunken

End Sub
Private Sub Label5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label3.SpecialEffect = fmSpecialEffectFlat
Label4.SpecialEffect = fmSpecialEffectFlat
Label5.SpecialEffect = fmSpecialEffectRaised
Label6.SpecialEffect = fmSpecialEffectFlat

End Sub
Private Sub Label6_Click()

On Error Resume Next
Label6.SpecialEffect = fmSpecialEffectFlat
UserForm2.Show

End Sub
Private Sub Label6_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label6.SpecialEffect = fmSpecialEffectSunken

End Sub
Private Sub Label6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)

On Error Resume Next
Label3.SpecialEffect = fmSpecialEffectFlat
Label4.SpecialEffect = fmSpecialEffectFlat
Label5.SpecialEffect = fmSpecialEffectFlat
Label6.SpecialEffect = fmSpecialEffectRaised

End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 164
.Width = 336
.BackColor = vbWhite
With Image1

.Left = 6
.Top = 6
.Height = 18
.Width = 18
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Picture = LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
.Visible = True

End With
With Label1

.Top = 6
.Left = 36
.Height = 12
.Width = 276
.Caption = "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Font.Bold = True
.ForeColor = &H808000

End With
With Label2

.Top = 18
.Left = 36
.Height = 12
.Width = 276
.Caption = "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Font.Bold = True
.ForeColor = &H808000

End With
With Label3

.Left = 36
.Top = 36
.Height = 18
.Width = 18
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
Call ResimBul(3992): .Picture = SeçilenResim(3992).Picture
.PicturePosition = fmPicturePositionCenter
.Visible = True
.Caption = ""

End With
With Label4

.Left = 60
.Top = 36
.Height = 18
.Width = 18
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
Call ResimBul(3993): .Picture = SeçilenResim(3993).Picture
.PicturePosition = fmPicturePositionCenter
.Visible = True
.Caption = ""

End With
With Label5

.Left = 84
.Top = 36
.Height = 18
.Width = 18
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
Call ResimBul(4100): .Picture = SeçilenResim(4100).Picture
.PicturePosition = fmPicturePositionCenter
.Visible = True
.Caption = ""

End With
With Label6

.Left = 106
.Top = 36
.Height = 18
.Width = 18
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
Call ResimBul(4251): .Picture = SeçilenResim(4251).Picture
.PicturePosition = fmPicturePositionCenter
.Visible = True
.Caption = ""

End With

End With

End Sub
Sub ResimBul(ByVal No As Double)

On Error Resume Next
Set AçMenü1 = Application.CommandBars.Add("", msoBarPopup, , True)
Set Komut = AçMenü1.Controls.Add(1, , , , True)
Komut.FaceId = No
SeçilenResim(No).Picture = Komut.Picture
AçMenü1.Delete

End Sub

'UserForm2

'A) Windows XP® Office 2003® Normal Referance List

'Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
'Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\WINDOWS\system32\MSCOMCTL.OCX

'B) UserForm1'e Eklenen Araçlar (Add Tools)

'Image1, Label1, Label2

Option Explicit
Private AktifOlma As Boolean
Private FormTipi As New Class1
Private Sub UserForm_Initialize()

On Error Resume Next
If AnaFormEtkinmi = False Then End
Me.Caption = "[PBİD®] UserForm Manage With the TaskBar Menus."
Pencere = FindWindow(vbNullString, Me.Caption)
Call EkranDüzenle
Set FormTipi.IconYarat = Me
AktifOlma = False

End Sub
Private Sub UserForm_Activate()

On Error Resume Next
Pencere = FindWindow(vbNullString, Me.Caption)
If AktifOlma = False Then

Set FormTipi.IconTak = Me
Set FormTipi.FormKur2 = Me '[-][][x]
AktifOlma = True

End If
With Me

.Top = UserForm1.Top + UserForm1.Height
.Left = UserForm1.Left

End With

End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 164
.Width = 336
.BackColor = vbWhite
With Image1

.Left = 6
.Top = 6
.Height = 18
.Width = 18
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Picture = LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
.Visible = True

End With
With Label1

.Top = 6
.Left = 36
.Height = 12
.Width = 276
.Caption = "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Font.Bold = True
.ForeColor = &H808000

End With
With Label2

.Top = 18
.Left = 36
.Height = 12
.Width = 276
.Caption = "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Font.Bold = True
.ForeColor = &H808000

End With

End With

End Sub

'Module1

Option Explicit
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert 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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Long, lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hWnd As Long, lpTPMParams As Any) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Public Type NOTIFYICONDATA

cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64

End Type
Public IconTyp As NOTIFYICONDATA
Public Type RECT

Left As Long
Top As Long
Right As Long
Bottom As Long

End Type
Public Type POINTAPI

x As Long
Y As Long

End Type
Public Nokta As POINTAPI
Public Type MENUITEMINFO

cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long

End Type
Public EkranSysMnu As MENUITEMINFO
Public AnaSysMnu As Long 'AnaEkranSysMnu
Public AltSysMnu As Long 'AltEkranSysMnu
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_USER = &H400
Public Const WM_CALLBACKMSG = WM_USER + 32768
Public Const GWL_WNDPROC = (-4)
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Public Const SW_HIDE = 0
Public Const SW_NORMAL = 1
Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0&
Public Const ICON_BIG = 1&
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const TPM_RETURNCMD = &H100&
Public Const TPM_LEFTALIGN = &H0&
Public Const TPM_RIGHTBUTTON = &H2&
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
Public EkranNo As Long
Public EkranDurumu As Long
Public Simge As Long
Public Pencere As Long
Public Küçülme As Boolean
Public Ekran As Object
Public MenüKomutu As Long
Public Tercih As Long
Private i As Long, x As Long
Public Sonlama As Boolean
Public AnaFormEtkinmi As Boolean
Sub UserFormAç()

On Error Resume Next
UserForm1.Show 1

End Sub
Public Function IconYap()

On Error Resume Next
With IconTyp

.cbSize = Len(IconTyp)
.hWnd = Pencere
.uID = EkranNo
.uFlags = NIF_DOALL
.hIcon = Simge
.szTip = "[PBİD®] Ana Menü" & Chr(0)
.uCallbackMessage = WM_CALLBACKMSG

End With
Tercih = Shell_NotifyIcon(NIM_ADD, IconTyp)

End Function
Public Function IconYoket()

On Error Resume Next
Tercih = Shell_NotifyIcon(NIM_DELETE, IconTyp)

End Function
Public Function CreateFrmIcon(frm As Object, frmhdl As Long, hIcon As Long)

On Error Resume Next
Call SendMessage(frmhdl, WM_SETICON, ICON_SMALL, ByVal hIcon)
Call SendMessage(frmhdl, WM_SETICON, ICON_BIG, ByVal hIcon)

End Function
Public Function TaskBarBildir() 'AnaEkranSysMnu

On Error Resume Next
ReDim Bellek(6, 1)
AnaSysMnu = CreatePopupMenu()
Bellek(0, 0) = "Göster"
Bellek(1, 0) = "-"
Bellek(2, 0) = "Programcı Hakkında"
Bellek(3, 0) = "Program Hakkında"
Bellek(4, 0) = "-"
Bellek(5, 0) = "Çık"
Call TaskBarDüzenle(AnaSysMnu, 6, Bellek)

End Function
Public Function TaskBarDüzenle(SysMnu, ByVal Adet As Double, Bellek)

On Error Resume Next
For i = 1 To Adet

With EkranSysMnu

.cbSize = Len(EkranSysMnu)
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_DATA
.dwTypeData = Bellek((i - 1), 0)
.cch = Len(.dwTypeData)
If .cch = 1 Then

.fType = MF_SEPARATOR

Else

.fType = MF_STRING

End If
.wID = i

End With
Call InsertMenuItem(SysMnu, i, 1, EkranSysMnu)

Next i

End Function
Public Function SysMnuYakala(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Error Resume Next
If EkranNo = wParam Then

Select Case lParam

Case WM_LBUTTONDBLCLK

SetWindowLong Pencere, GWL_WNDPROC, EkranDurumu
Shell_NotifyIcon NIM_DELETE, IconTyp
DoEvents
ShowWindow Pencere, SW_NORMAL

Case WM_RBUTTONDOWN

GetCursorPos Nokta
MenüKomutu = TrackPopupMenuEx(AnaSysMnu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Nokta.x, Nokta.Y, Pencere, ByVal 0&)
Select Case MenüKomutu

Case 1: SetWindowLong Pencere, GWL_WNDPROC, EkranDurumu: Shell_NotifyIcon NIM_DELETE, IconTyp: DoEvents: ShowWindow Pencere, SW_NORMAL
Case 2: 'Seperatör
Case 3: ShellExecute 0, "Open", "http://www.excelkodklavuzu.blogspot.com", 0&, 0&, 1
Case 4: x = ShellAbout(0, " [PBİD] " + Chr(169), Chr(10) + Chr(13) + "Mustafa ULUSARAÇ Ağustos 2006", Simge)
Case 5: 'Seperatör
Case 6: Sonlama = True: PlaySound "C:\WINDOWS\Media\tada.wav", vbHide, &H0: ThisWorkbook.Save: Application.Quit

End Select

End Select

End If

SysMnuYakala = CallWindowProc(EkranDurumu, hWnd, Msg, wParam, lParam)

End Function

'Class1

Option Explicit
Private i As Integer
Private hIcon As Long, wLong As Long, hMenu As Long
Private Ekran As Object
Public Property Set IconYarat(objForm As Object)

On Error Resume Next
hIcon = objForm.Image1.Picture.Handle
Simge = hIcon
CreateFrmIcon objForm, Pencere, hIcon
If objForm.Name = "UserForm1" Then Call TaskBarBildir 'CreateRightClickMenu

End Property
Public Property Set IconTak(objForm As Object)

On Error Resume Next
If Not Ekran Is Nothing Then Exit Property
ShowWindow Pencere, SW_HIDE
SetWindowLong Pencere, (-20), GetWindowLong(Pencere, (-20)) Or &H10000 Or &H40000

End Property
Public Property Set FormKur2(objForm As Object)

On Error GoTo Hata
Set Ekran = objForm
If ThisWorkbook.Sheets("Sheet1").Range("A1") = 1 Then

For i = 0 To 255

If i = 255 Then

SetWindowLong Pencere, (-16), GetWindowLong(Pencere, (-16)) Or &H20000

Else

SetWindowLong Pencere, (-20), GetWindowLong(Pencere, (-20)) Or &H80000 Or &H20000 Or &H10000

End If
ShowWindow Pencere, SW_NORMAL
DrawMenuBar Pencere
SetLayeredWindowAttributes Pencere, 0, i, &H2
DoEvents

Next i

Else

SetWindowLong Pencere, (-16), GetWindowLong(Pencere, (-16)) Or &H20000
ShowWindow Pencere, SW_NORMAL
Set Ekran = objForm
DrawMenuBar Pencere

End If
Exit Property
Hata:
SetWindowLong Pencere, (-16), GetWindowLong(Pencere, (-16)) Or &H20000
ShowWindow Pencere, SW_NORMAL
DrawMenuBar Pencere

End Property
Public Property Set FormYoket(objForm As Object)

On Error Resume Next
If ThisWorkbook.Sheets("Sheet1").Range("A1") = 1 Then

For i = 1 To 255

SetWindowLong Pencere, (-20), GetWindowLong(Pencere, (-20)) Or &H80000 Or &H20000 Or &H10000
ShowWindow Pencere, 5
DrawMenuBar Pencere
Set Ekran = objForm
SetLayeredWindowAttributes Pencere, 0, (255 - i), &H2
DoEvents

Next i

End If

End Property
Public Property Set KapatmaEtkin(objForm As Object)

On Error Resume Next
If Application.Version > 9# Then

Pencere = FindWindow("ThunderDFrame", objForm.Caption)
hMenu = GetSystemMenu(Pencere, 1)
DeleteMenu hMenu, &HF060, 0&
DrawMenuBar Pencere

Else

Pencere = FindWindow("ThunderXFrame", objForm.Caption)
hMenu = GetSystemMenu(Pencere, 1)
DeleteMenu hMenu, &HF060, 0&
DrawMenuBar Pencere

End If

End Property
Public Property Set KapatmaEtkisiz(objForm As Object)

On Error Resume Next
If Application.Version > 9# Then

Pencere = FindWindow("ThunderDFrame", objForm.Caption)
hMenu = GetSystemMenu(Pencere, 0)
DeleteMenu hMenu, &HF060, 0&
DrawMenuBar Pencere

Else

Pencere = FindWindow("ThunderXFrame", objForm.Caption)
hMenu = GetSystemMenu(Pencere, 0)
DeleteMenu hMenu, &HF060, 0&
DrawMenuBar Pencere

End If

End Property
Public Property Set FormKüçültmek(objForm As Object)

On Error Resume Next
If objForm.Name = "UserForm1" Then

If Not Küçülme Then 'Minimize düğme kullanıldığında

EkranNo = vbNull
EkranDurumu = SetWindowLong(Pencere, GWL_WNDPROC, AddressOf SysMnuYakala)
Call IconYap 'İkon sağ köşeye geçer
objForm.Hide
Küçülme = True

Else

Küçülme = False

End If

End If

End Property
Public Property Set FormKapatmak(objForm As Object)

On Error Resume Next
Set objForm.Image1.Picture = Nothing
SetWindowLong Pencere, GWL_WNDPROC, EkranDurumu
Call IconYoket
DestroyMenu AnaSysMnu
Set Ekran = Nothing

End Property