Formun Unload Olayını Engellemek



‘Aşağıdaki kodları formunuza kopyalayın



Private Sub Form_Unload(Cancel As Integer )

Cancel = 1

End Sub

Formun Tüm Sayfayı Kaplaması



‘Projeye 1 adet modül ekleyin

‘Formunuza 2 buton ekleyin



Aşağıdakileri modüle kopyalayın



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

Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public Const SM_CXSCREEN = 0

Public Const SM_CYSCREEN = 1

Public Const HWND_TOP = 0

Public Const SWP_SHOWWINDOW = &H40



‘Aşağıdakileri formunuza kopyalayın



Private Sub Command1_Click()

Dim ll_Width As Long

Dim ll_Height As Long

If Me.WindowState = vbMaximized Then

WindowState = vbNormal

End If

ll_Width = GetSystemMetrics(SM_CXSCREEN)

ll_Height = GetSystemMetrics(SM_CYSCREEN)

Call SetWindowPos(Me.hwnd, HWND_TOP, 0, 0, ll_Width, ll_Height, SWP_SHOWWINDOW)

End Sub

Private Sub Command2_Click()

WindowState = vbMaximized

End Sub

Formun Hep Üstte Kalması



‘Projeye 1 adet modül ekleyin

'Formunuza 2 adet buton ekleyin

‘1.buton hep üstte kalmayı aktif hale getirir

‘2.buton eski haline getirir



‘Aşağıdaki kodları modüle kopyalayın



Declare Function SetWindowPos Lib "user32" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal F%) As Integer

Global Const SWP_NOMOVE = 2

Global Const SWP_NOSIZE = 1

Global Const flags = SWP_NOMOVE Or SWP_NOSIZE

Global Const HWND_TOPMOST = -1

Global Const HWND_NOTOPMOST = -2



'Aşağıdaki kodları forma kopyalayın



Private Sub Command1_Click()

res = SetWindowPos(Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags)

End Sub



Private Sub Command2_Click()

res = SetWindowPos(Form1.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags)

End Sub

Form İçine Hapsolan Form



'Projeye 1 adet modül ekleyin

'2. bir form ekleyin



'Aşağıdaki kodları modüle kopyalayın



Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long



'Aşağıdaki kodları form1’e kopyalayın



Private Sub Form_Load()

Load Form2

Form2.Show

End Sub



'Aşağıdaki kodları form2’ye kopyalayın



Private Sub Form_Load()

r = SetParent(Me.hWnd, Form1.hWnd)

End Sub

Form Başlığını Ortalamak



‘Formunuza 1 adet modül ekleyin



‘Aşağıdakileri modüle kopyalayın



Public Sub CenterC(frm As Form)

Dim SpcF As Integer

Dim clen As Integer

Dim oldc As String

Dim i As Integer

oldc = frm.Caption

Do While Left(oldc, 1) = Space(1)

DoEvents

oldc = Right(oldc, Len(oldc) - 1)

Loop

Do While Right(oldc, 1) = Space(1)

DoEvents

oldc = Left(oldc, Len(oldc) - 1)

Loop

clen = Len(oldc)

If InStr(oldc, "!") <> 0 Then

If InStr(oldc, " ") <> 0 Then

clen = clen * 1.5

Else

clen = clen * 1.4

End If

Else

If InStr(oldc, " ") <> 0 Then

clen = clen * 1.4

Else

clen = clen * 1.3

End If

End If

SpcF = frm.Width / 61.2244

SpcF = SpcF - clen

If SpcF > 1 Then

DoEvents

frm.Caption = Space(Int(SpcF / 2)) + oldc

Else

frm.Caption = oldc

End If

End Sub



‘Aşağıdakileri forma kopyalayın



Dim oldsize As Long



Private Sub Form_Resize()

If Me.Width = oldsize Then

Exit Sub

Else

CenterC Me

oldsize = Me.Width

End If

End Sub



Private Sub Form_Load()

CenterC Me

oldsize = Me.Width

End Sub

Form Başlığını Form İçinde Göstermek



'Projenize 1 adet modül ekleyin

'Formunuzun Borderstyle özelliğini 0 yapın

'Aşağıdaki kodları modüle kopyalayın



Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Declare Function DrawCaption Lib "User32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As RECT, ByVal un As Long) As Long

Declare Function SetRect Lib "User32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Sub ReleaseCapture Lib "User32" ()

Public Const WM_NCLBUTTONDOWN = &HA1

Public Const HTCAPTION = 2



‘Aşağıdaki kodları forma kopyalayın



Const TitleWidth = 20

Dim r As RECT



Private Sub Form_Load()

Form1.AutoRedraw = True

Me.Cls

Me.ScaleMode = vbPixels

SetRect r, 0, 0, Me.ScaleWidth, TitleWidth

DrawCaption Me.hwnd, Me.hdc, r, &H9

End Sub



Private Sub Form_Resize()

SetRect r, 0, 0, Me.ScaleWidth, TitleWidth

DrawCaption Me.hwnd, Me.hdc, r, &H9

End Sub

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

If Y > TitleWidth Then Exit Sub

Dim lngReturnValue As Long

If Button = 1 Then

Call ReleaseCapture

lngReturnValue = SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

End If

End Sub