قطعه کدهای ویژوال بیسیک (سری اول)

1. استفاده از این کد باعث می شود فرم در هر حالتی در وسط صفحه قرار گیرد.
 

Private Sub Center_This_Form(f As Form )
f.Move (Screen.Width - f.Width) \ 2 , _
( Screen.Height - f.Height) \ 2
End Sub
Private Sub Form_Load ()
Center_This_Form Me
End Sub
 

2. قرار دادن آيکن در قسمت سيستم تری
 

* ابتدا دو عدد کامند باتون و یک کامند دایلوگ روی فرم قرار داده و کد زیر را در آن کپی کنید.

Private 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

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2

Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const WM_LBUTTONDBLCLK = &H203 'Double-click
Private Const WM_LBUTTONDOWN = &H201 'Button down
Private Const WM_LBUTTONUP = &H202 'Button up

Private Const WM_RBUTTONDBLCLK = &H206 'Double-click
Private Const WM_RBUTTONDOWN = &H204 'Button down
Private Const WM_RBUTTONUP = &H205 'Button up

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim nid As NOTIFYICONDATA
 

Private Sub Command1_Click ()
nid.cbSize = Len(nid )
nid.hWnd = form1.hWnd
nid.uId = vbNull
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallBackMessage = WM_MOUSEMOVE
nid.hIcon = form1.Icon
nid.szTip = "Taskbar Status Area Sample Program" & vbNullChar
Shell_NotifyIcon NIM_ADD, nid
End Sub

Private Sub Command2_Click ()
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_Load ()
Command1.Caption = "Add an Icon "
Command2.Caption = "Delete Icon "
End Sub

Private Sub Form_Resize ()
If form1.WindowState = vbMinimized Then
Call Command1_Click
Me.Visible = False
End If
End Sub

Private Sub Form_Terminate ()
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_MouseMove _
( Button As Integer , _
Shift As Integer , _
X As Single , _
Y As Single )
Dim msg As Long
Dim sFilter As String
msg = X / Screen.TwipsPerPixelX
Select Case msg
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Me.WindowState = vbNormal
Me.Visible = True
Me.SetFocus
Case WM_LBUTTONDBLCLK
CommonDialog1.DialogTitle = "Select an Icon "
sFilter = "Icon Files (*.ico)|*.ico "
sFilter = sFilter & "|All Files (*.*)|*.*"
CommonDialog1.Filter = sFilter
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
form1.Icon = LoadPicture(CommonDialog1.FileName )
nid.hIcon = form1.Icon
Shell_NotifyIcon NIM_MODIFY, nid
End If
Case WM_RBUTTONDOWN
Dim ToolTipString As String
ToolTipString = InputBox("Enter the new ToolTip:", "Change ToolTip ")
If ToolTipString <> "" Then
nid.szTip = ToolTipString & vbNullChar
Shell_NotifyIcon NIM_MODIFY, nid
End If
Case WM_RBUTTONUP
Case WM_RBUTTONDBLCLK
End Select
End Sub
 

3 . استفاده از progressbar
 

* از اين كنترل براي نمايش مراحل اجراي يك كار استفاده مي شود.ابتدا از طريق فرمان Components كنترلهاي Microsoft windows common control 6 را فعال و ProgressBar را روي فرم قرار دهيد روي آن راست كليك و پنجره تنظيمات آنرا باز كنيد.در كادر Max عدد (مثلا 20000 ( را تايپ كنيد.كد زير را در يك دكمه فرمان كپي كنيد.برنامه را اجرا كنيد .

Private Sub Command1_Click ()
For a = 1 To 20000
p1.Value = a
Next a
Form2.Show
End Sub
 

4. باز كردن پنجره اينترنت اكسپلور از داخل برنامه
 

* براي نمونه يك سورس مي نويسم كه شما مي تونيد با اون از طريق Internet Explorer به سايت مورد نظرتون از داخل برنامه خودتون وارد بشيد :
اين كد را در قسمت Form / General بنويسيد

( Private Sub OpenUrl (URLName As String
Dim objIE As Object
(" Set objIE = CreateObject ("internetexplorer.application
objIE.Visible = True
(( objIE.Navigate (Trim(URLName
End Sub

 

بعد يك Command و يك Textbox روي صفحه بزاريد و خصوصيت Name اونها رو به ترتيب cmdGO و txtURLName قراربديد ، بعد هم مي تونيد با نوشتن كد زير در رويداد Click مربوط به cmdGo به هر صفحه اي كه در ابنترنت دوست داريد دسترسي داشته باشيد. به همين سادگي !

( ) Private Sub cmdGO_Click
( Call OpenUrl (txtURLName
End Sub
 

5 . باز و بستن درب CD ROM
 

اگر ميخواهيد توسط برنامه خود درب CD ROM را باز و بسته كنيد كافيست ابتدا كد زير را در يك ماژول كپي كنيد.

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

 

حالا كد زير را در پنجره فرم كپي كنيد.دو دكمه فرمان هم لازم است.

Private Sub CMDOPEN_Click ()
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0 &
End Sub

Private Sub CMDCLOSE_Click ()
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0 &
End Sub

* ارسال مقاله توسط عضو محترم سایت با نام کاربری : zarei6703