طريقة جعل برنامجك فوق النوافذ الأخرى (دوماً في المقدمة)
إنسخ الشيفرة التالية إلى Module
ثم أضف الشيفرة التالية في حدث التحميل (Load) للفورم
1- أنشيء فورم وضع فيه أداة CommandButton .
2- أعلن عن المتغيرات التاليه في قسم General :
3- إكتب الشفره التاليه في حدث MouseDown للأداة Command1
4- ثم أضف التالي في الحدث MouseMove للأداة Command1
لاحظ أنه يمكنك تغيير موقع زر أوصورة بنفس الطريقة ولاكن أكتب إسم العنصر الذي تريد تحريكه بدلاً من Form1 -------------------------------------------------------------------------------- تشغيل حافظة الشاشة
إصنع فورم وأضف إليه زر Command1 وإنسخ الكود التالي إلى كود الفورم دون النقر فوق الفورم مرتين أي في قسم General
-------------------------------------------------------------------------------- كود يعطيك معلومات عن محرك الأقراص . إسمه \' نظام ملفاته \' رقمه التسلسلي أنسخ الأسطر التالية في قسم Module كما هي
ثم أضف للفورم ثلاث زر Command1 و ثلاث خانات نص Text1 و Text2 و Text3 و قائمة منسدلة Combo1
ثم أنسخ الكود التالي وأضفة للفورم ، ثم نفذ( F5 ) وآختر احد الأزارير .
نبض الفورم
1 - اصنع فورم Form1 وضع فيه زر أمر Command1 وأدات التوقيت Timer1 وإنسخ مايلي الى الشيفرة
[color=940306]طريقة تشغيل موقع ويب وبريد الكتروني من داخل برنامجك(هام)[/color] ضع الشيفرة التالية في Module أي وحدة نمطية
وبالتوفيق للجميع
إنسخ الشيفرة التالية إلى Module
Public 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
ثم أضف الشيفرة التالية في حدث التحميل (Load) للفورم
Dim vWindowPos As Long
vWindowPos = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 1 Or 2)
تحريك النافذة عند النقر والسحب فوق الفورم أو أي عنصر vWindowPos = SetWindowPos(Form1.hwnd, -1, 0, 0, 0, 0, 1 Or 2)
1- أنشيء فورم وضع فيه أداة CommandButton .
2- أعلن عن المتغيرات التاليه في قسم General :
Dim vX, vY
Dim vM As Boolean
Dim vM As Boolean
3- إكتب الشفره التاليه في حدث MouseDown للأداة Command1
vX = X
vY = Y
vM = True
vY = Y
vM = True
4- ثم أضف التالي في الحدث MouseMove للأداة Command1
Dim frmX, frmY
frmX = Form1.Left + (X - vX)
frmY = Form1.Top + (Y - vY)
If vM = True Then
Form1.Move frmX, frmY
End If
- أخيراً أضف الكود التالي للحدث MouseUp التابع للأداة Command1
frmX = Form1.Left + (X - vX)
frmY = Form1.Top + (Y - vY)
If vM = True Then
Form1.Move frmX, frmY
End If
Vm = False
لاحظ أنه يمكنك تغيير موقع زر أوصورة بنفس الطريقة ولاكن أكتب إسم العنصر الذي تريد تحريكه بدلاً من Form1 -------------------------------------------------------------------------------- تشغيل حافظة الشاشة
إصنع فورم وأضف إليه زر Command1 وإنسخ الكود التالي إلى كود الفورم دون النقر فوق الفورم مرتين أي في قسم General
Option Explicit
Private Const WM_SYSCOMMAND = &H112
Private Const SC_SCREENSAVE = &HF140&
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 Sub Command1_Click()
LaunchScreenSaver Me.hwnd
End Sub Sub LaunchScreenSaver(pl_OwnerFormHwnd As Long)
Call SendMessage(pl_OwnerFormHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub
Private Const WM_SYSCOMMAND = &H112
Private Const SC_SCREENSAVE = &HF140&
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 Sub Command1_Click()
LaunchScreenSaver Me.hwnd
End Sub Sub LaunchScreenSaver(pl_OwnerFormHwnd As Long)
Call SendMessage(pl_OwnerFormHwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub
-------------------------------------------------------------------------------- كود يعطيك معلومات عن محرك الأقراص . إسمه \' نظام ملفاته \' رقمه التسلسلي أنسخ الأسطر التالية في قسم Module كما هي
Declare Function GetVolumeInformation Lib \'kernel32.dll\' Alias _
\'GetVolumeInformationA\' (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Function GetDiskProperties(strDrive As String, DiskName As String, DiskSystemFiles As String, DiskSerialNumber As Long) As Long
Dim Res As Long
DiskName = String$(255, Chr$(0))
DiskSystemFiles = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, DiskName, _
Len(DiskName), DiskSerialNumber, 0, 0, DiskSystemFiles, Len(DiskSystemFiles))
GetDiskProperties = Res
End Function
\'GetVolumeInformationA\' (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Function GetDiskProperties(strDrive As String, DiskName As String, DiskSystemFiles As String, DiskSerialNumber As Long) As Long
Dim Res As Long
DiskName = String$(255, Chr$(0))
DiskSystemFiles = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, DiskName, _
Len(DiskName), DiskSerialNumber, 0, 0, DiskSystemFiles, Len(DiskSystemFiles))
GetDiskProperties = Res
End Function
ثم أضف للفورم ثلاث زر Command1 و ثلاث خانات نص Text1 و Text2 و Text3 و قائمة منسدلة Combo1
ثم أنسخ الكود التالي وأضفة للفورم ، ثم نفذ( F5 ) وآختر احد الأزارير .
Dim NamDisk As String, SysFile As String, SerNum As Long
Dim Drive As String
Private Sub Form_Load()
Combo1.AddItem \'A:\'
Combo1.AddItem \'B:\'
Combo1.AddItem \'C:\'
Combo1.AddItem \'D:\'
Combo1.AddItem \'E:\'
Combo1.AddItem \'F:\' Combo1.ListIndex = 0 End Sub
Private Sub Command1_Click() Drive = Combo1.Text Re = GetDiskProperties(Drive, NamDisk, SysFile, SerNum) Text1.Text = NamDisk
Text2.Text = SysFile
Text3.Text = SerNum End Sub
Combo1.AddItem \'B:\'
Combo1.AddItem \'C:\'
Combo1.AddItem \'D:\'
Combo1.AddItem \'E:\'
Combo1.AddItem \'F:\' Combo1.ListIndex = 0 End Sub
Private Sub Command1_Click() Drive = Combo1.Text Re = GetDiskProperties(Drive, NamDisk, SysFile, SerNum) Text1.Text = NamDisk
Text2.Text = SysFile
Text3.Text = SerNum End Sub
نبض الفورم
1 - اصنع فورم Form1 وضع فيه زر أمر Command1 وأدات التوقيت Timer1 وإنسخ مايلي الى الشيفرة
Option Explicit
Private Declare Function FlashWindow Lib \'user32\' (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Private mb_Flashing As Boolean Private Sub Command1_Click() mb_Flashing = Not mb_Flashing
Timer1.Enabled = mb_Flashing If mb_Flashing = False Then
Call FlashWindow(Me.hwnd, 0)
End If End Sub Private Sub Timer1_Timer() Call FlashWindow(Me.hwnd, 1) End Sub
Private mb_Flashing As Boolean Private Sub Command1_Click() mb_Flashing = Not mb_Flashing
Timer1.Enabled = mb_Flashing If mb_Flashing = False Then
Call FlashWindow(Me.hwnd, 0)
End If End Sub Private Sub Timer1_Timer() Call FlashWindow(Me.hwnd, 1) End Sub
[color=940306]طريقة تشغيل موقع ويب وبريد الكتروني من داخل برنامجك(هام)[/color] ضع الشيفرة التالية في Module أي وحدة نمطية
Option Explicit
\' by kaled alzeeby alnamer soft Public Const URL = \'https://www.kaled1.jeeran.com\'
Public Const email = \'nemer_11@hotmail.com\'
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 Const SW_SHOWNORMAL = 1 Public Sub gotoweb()
Dim Success As Long Success = ShellExecute(0&, vbNullString, URL, vbNullString, \'C:\', SW_SHOWNORMAL) End Sub Public Sub sendemail()
Dim Success As Long Success = ShellExecute(0&, vbNullString, \'mailto:\' & email, vbNullString, \'C:\', SW_SHOWNORMAL) End Sub
اصنع فورم Form1 أضف اليه زرين Command1 _ Command2
أكتب في الأول الشيفرة التالية : gotoweb أكتب في الثاني الشيفرة التالية : sendemail
\' by kaled alzeeby alnamer soft Public Const URL = \'https://www.kaled1.jeeran.com\'
Public Const email = \'nemer_11@hotmail.com\'
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 Const SW_SHOWNORMAL = 1 Public Sub gotoweb()
Dim Success As Long Success = ShellExecute(0&, vbNullString, URL, vbNullString, \'C:\', SW_SHOWNORMAL) End Sub Public Sub sendemail()
Dim Success As Long Success = ShellExecute(0&, vbNullString, \'mailto:\' & email, vbNullString, \'C:\', SW_SHOWNORMAL) End Sub
وبالتوفيق للجميع
التعليقات على المقالة 2
سعيد 8-3-2015
رد
عبدالباسط 28-2-2013
رد