5أكواد لجميع المبرمجبن (الجزء الثاني)

[Aboud Aboud]

1
اخفاء / اظهار شريط العنوان

'----This example allow you also to make A Resizeable form without titlebar.
'Add 2 Command Buttons to your Form. By clicking the first, you will hide the titlebar.
'By clicking the second, you will show it again. Warning: if you will click one of the
'buttons twice a row, For example pressing the hide titlebar button when the titlebar
'is already hidden, and vise versia, you will have errors.
'Insert the following code to your form:

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 GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000

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 Enum ESetWindowPosStyles
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_FRAMECHANGED = &H20
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200
SWP_NOREDRAW = &H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
End Enum

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Function ShowTitleBar(ByVal bState As Boolean)
Dim lStyle As Long
Dim tR As RECT

GetWindowRect Me.hwnd, tR

lStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
If (bState) Then
Me.Caption = Me.Tag
If Me.ControlBox Then
lStyle = lStyle Or WS_SYSMENU
End If
If Me.MaxButton Then
lStyle = lStyle Or WS_MAXIMIZEBOX
End If
If Me.MinButton Then
lStyle = lStyle Or WS_MINIMIZEBOX
End If
If Me.Caption <> "" Then
lStyle = lStyle Or WS_CAPTION
End If
Else
Me.Tag = Me.Caption
Me.Caption = ""
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
End If
SetWindowLong Me.hwnd, GWL_STYLE, lStyle

SetWindowPos Me.hwnd, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
Me.Refresh
End Function

Private Sub Command1_Click()
ShowTitleBar False
End Sub

Private Sub Command2_Click()
ShowTitleBar True
End Sub

-----------------------------------------
2
ازالة ال X من النافذة

Private Declare Function DrawMenuBar& Lib "user32" (ByVal hwnd As Long)
Private Declare Function GetMenuItemCount& Lib "user32" (ByVal hMenu As Long)
Private Declare Function GetSystemMenu& Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long)
Private Declare Function RemoveMenu& Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long)

Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000

Private Sub Form_Load()
Dim hMenu As Long
Dim lngMnuCount As Long
hMenu = GetSystemMenu(Form1.hwnd, 0)
lngMnuCount = GetMenuItemCount(hMenu)
RemoveMenu hMenu, lngMnuCount - 1, MF_REMOVE Or MF_BYPOSITION
RemoveMenu hMenu, lngMnuCount - 2, MF_REMOVE Or MF_BYPOSITION
DrawMenuBar Form1.hwnd
End Sub

-----------------------------------------
3
اضافة زر تصغير للنافذة

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 Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000

Private Function AddMinimizeButton(po_Form As Form)
Dim ll_Style As Long
'Get window style
ll_Style = GetWindowLong(po_Form.hwnd, GWL_STYLE)
'Add the minimize button
Call SetWindowLong(po_Form.hwnd, GWL_STYLE, ll_Style Or WS_MINIMIZEBOX)
End Function

Private Sub Form_Load()
AddMinimizeButton Me
End Sub

-----------------------------------------
4
تحريك النص في العنوان و Text

Private strText As String
Private Sub Form_Load()
Timer1.Interval = 75
strText = "Guten Tag! Wie ght's Ihnen? Ich hoffe Ihnen alles Gutes!"
strText = Space(50) & strText
End Sub
Private Sub Timer1_Timer()
strText = Mid(strText, 2) & Left(strText, 1)
Text1.Text = strText
Me.Caption = strText
End Sub

-----------------------------------------
5
تحريك النافذة بواسطة Lable

Dim vX, vY
Dim vM As Boolean

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
vX = X
vY = Y
vM = True
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim frmX, frmY
frmX = Form1.Left + (X - vX)
frmY = Form1.Top + (Y - vY)
If vM = True Then
Form1.Move frmX, frmY
End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
vM = False
End Sub

[Jordan_Eyes]

شكراً .. بس لو انك نسقتهم كويس

[Aboud Aboud]

شكرا على الردود المشجّعة

[ABCARINO77]

مشكوووووووووووووووووووووووور بس أرجو التنظيم
فى حالة التنظيم سيكون الكود سهل الفهم فهذا أول درس للمبرمجين
و شكرا مره تانيه ............................

[Aboud Aboud]

شكرا على الردور وان شاء الله في المرة القادمة ارتبها اكثر