منبع سورس های مفید

برای این کار فقط کافیه این کد ها رو در فورمتون قرار بدین

[HTML]Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long

Private Sub Form_Load()
SHShutDownDialog 0
End Sub
[/HTML]


یا حق :5:

فقط کافیه 2 عدد command button به فرمتون اظافه کنید و کد های زیر رو در فرمتون بزارید

[HTML]Private 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 Command1_Click()
mciSendString "set cdaudio door open", "", 0, 0
End Sub
Private Sub Command2_Click()
mciSendString "set cdaudio door closed", "", 0, 0
End Sub
[/HTML]

به امید همکاری دوستان ................ :10:

سلام به همه

سونامی عزیز کجایی پس ؟

یک تایمر و دو Label به فرم اضافه کنید و سپس کدها را کاملا پاک کرده و کدهای زیر را وارد کنید

[HTML]Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CurPos As POINTAPI
Private Sub Form_Load()
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
GetCursorPos CurPos
Label1.Caption = "X : " + Str(CurPos.X)
Label2.Caption = "Y : " + Str(CurPos.Y)
End Sub
[/HTML]

موفق باشید :5:

من امدم این چند روزه که نبودم سیم کشی ساختمونمون به هم ریخته بود .ولی الان درست شده و به زودی شروع میکنم براتون کد کذاشتن

با این کد می توانید:

1) پخش فایل های صوتی
2)نور دادن به taskbar ( اگر نفهمیدید آن را امتحان کنید)
3)ایجاد شفافیت
4)آوردن فرم بر روی تمامی برنامه ها
5)غیر فعال کردن دکمه ی Close
6)نمایش / مخفی Start Menu
7)غیر فعال / فعال TaskManager
8)نمایش / مخفی آبکون های روی Desktop
9)نمایش خصوصیات یک فایل
10)خالی کردن سطل آشغال
11)نمایش محل نصب ویندوز
12)رفتن به یک سایت
13)مخفی کردن یک رنگ در فرم

کد زیر را در یک Module قرار دهید.

کد:

---

'______________________________________________________________________________
'Number      Title                      preamble                Keyword    |
'------------------------------------------------------------------------------
'| 1  |  PlaySound          |  only wav format            |  SoundPlay    |
'---------------------------------------------------------------------------- |
'| 2  |  FlashWindow        |  In the taskbar              |  TaskbarFlash |
'---------------------------------------------------------------------------- |
'| 3  |  Transparency        |  opacity                    |  Transparency |
'---------------------------------------------------------------------------- |
'| 4  |  AlwaysOnTop        |  Bring to front              |  alwaysOnTop  |
'---------------------------------------------------------------------------- |
'| 5  |  XButton            |  Disable X button            |  Xbutton      |
'---------------------------------------------------------------------------- |
'| 6  |  StartMenu          |  hide/show start menu        |  StartMenu    |
'---------------------------------------------------------------------------- |
'| 7  |  Ctrl + Alt + Delete |  disabe Ctrl + Alt + Delete  |  C_A_D        |
'---------------------------------------------------------------------------- |
'| 8  |  DesktopIcon        |  Show/Hide desktop icon      |  DesktopIcon  |
'---------------------------------------------------------------------------- |
'| 9  |  ShowProperties      |  show properties of a file  |  ShowPro      |
'---------------------------------------------------------------------------- |
'| 10 |  EmptyRecycleBin    |  EmptyRecycleBin            |  EmpthRe      |
'-----------------------------------------------------------------------------|
'|    |                      |  Get system dir ( before use,|                |
'|    |                      |  first type GD  and  then  in|                |
'| 11 |  GD and systemDic    |  the new  line use systemDic.|  GD and then: |
'|    |                      |  For  examole : first trpe GD|  SystemDic    |
'|    |                      |  and in new line type:      |                |
'|    |                      |  MsgBox SystemDic            |                |
'------------------------------------------------------------------------------
'| 12 |  WWW                |  Go to web site              |  go to web site|
'------------------------------------------------------------------------------
'| 13 |  TransOne            |  Do not show a color        |  TransOne      |
'------------------------------------------------------------------------------

'ENJOY IT :]
'SMNsoft®


Option Explicit
Const SWP_NOMOVE = 2
Const SWP_NOSIZE = 1
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
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 Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Private 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
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Dim hWnd1 As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const ATTR_NORMAL = 0
Public Const ATTR_READONLY = 1
Public Const ATTR_HIDDEN = 2
Public Const ATTR_SYSTEM = 4
Public Const ATTR_VOLUME = 8
Public Const ATTR_DIRECTORY = 16
Public Const ATTR_ARCHIVE = 32
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOPROGRESSUI = &H2
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public SystemDic As String
Public SysDirectory As Long



Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
ShellExecuteEX SEI
ShowFileProperties = SEI.hInstApp
End Function




Public Sub Xbutton(Name_Of_Your_FORM As Form)
Dim hMenu As Long
hMenu = GetSystemMenu(Name_Of_Your_FORM.hwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (Name_Of_Your_FORM.hwnd)
End If
End Sub

Public Function TaskbarFlash(Name_Of_Your_FORM As Form)
FlashWindow Name_Of_Your_FORM.hwnd, 1
End Function

Public Function SoundPlay(Adress_Of_Music_File As String, Play As Boolean)
If Play = True Then
  PlaySound Adress_Of_Music_File, 1, 1
ElseIf Play = False Then
  PlaySound Adress_Of_Music_File, 6, 6
End If
End Function

Public Function AlwaysOnTop(hwnd As Long, Topmost As Boolean)
If Topmost = True Then
AlwaysOnTop = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
AlwaysOnTop = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
AlwaysOnTop = False
End If
End Function

Public Function Trans(Name_Of_Your_FORM As Form, Opacity As Double)
On Error Resume Next
    Dim Ret As Long
    Ret = GetWindowLong(Name_Of_Your_FORM.hwnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    SetWindowLong Name_Of_Your_FORM.hwnd, GWL_EXSTYLE, Ret
        SetLayeredWindowAttributes Name_Of_Your_FORM.hwnd, 0, Opacity, LWA_ALPHA
End Function

Public Function StartMenu(Show_Start_Menu As Boolean)
If Show_Start_Menu = True Then
    Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
ElseIf Show_Start_Menu = False Then
  hWnd1 = FindWindow("Shell_traywnd", "")
  Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
End Function

Public Function C_A_D(Enable__CTRL_ALT_DELETE As Boolean)
If Enable__CTRL_ALT_DELETE = True Then
Dim Ret0002 As Long
Dim pOld As Boolean
Ret0002 = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
ElseIf Enable__CTRL_ALT_DELETE = False Then
Dim Ret0001 As Long
Dim pOld001 As Boolean
Ret0001 = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld001, 0)
End If
End Function

Public Function DesktopIcon(ShowIcon As Boolean)
If ShowIcon = True Then
Dim hWnd001 As Long
hWnd001 = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd001, 5
ElseIf ShowIcon = False Then
Dim hWnd002 As Long
hWnd002 = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd002, 0
End If
End Function

Public Function ShowPro(Name_Of_Your_FILE As String, Name_Of_Your_FORM As Form)
ShowFileProperties Name_Of_Your_FILE, Name_Of_Your_FORM.hwnd
End Function

Public Function EmptyRe(Name_Of_Your_FORM As Form)
Dim retvaL
retvaL = SHEmptyRecycleBin(Name_Of_Your_FORM.hwnd, "", SHERB_NOPROGRESSUI)
End Function

Public Function GD()
Dim WinDirectory As String
SystemDic = Space(255)
WinDirectory = GetWindowsDirectory(SystemDic, 255)
SystemDic = Left$(SystemDic, WinDirectory)
End Function

Public Sub www(ByRef Site As String)
On Error Resume Next
    ShellExecute 0, "Open", Site, "", "", vbNormalFocus
End Sub

Public Function TransOne(Red As Byte, Green As Byte, Blue As Byte, Name_Of_Form As Form) As Long
On Error Resume Next
  Dim Ret As Long
  Dim CLR As Long
  CLR = RGB(Red, Green, Blue)
  Ret = GetWindowLong(Name_Of_Form.hwnd, GWL_EXSTYLE)
  Ret = Ret Or WS_EX_LAYERED
  SetWindowLong Name_Of_Form.hwnd, GWL_EXSTYLE, Ret
  SetLayeredWindowAttributes Name_Of_Form.hwnd, CLR, 20, LWA_COLORKEY
End Function

---

اگر نمی توانید این کار را انجام بدهید فایل module را از اینجا دانلود کنید:

کد:

---

http://smn-soft.persiangig.com/VB/SMNsoft_CODE.bas

---

حالا اگر با استفاده از آن مشکل دارید یک نممونه از استفاده از آن را از اینجا دانلود کنید.

کد:

---

http://smn-soft.persiangig.com/VB/SMNsoft%20Code%20collection%20v%201.zip

---

چرا هیچ کسی دیگه نمیاد من این چند روز پشت سرهم به مشکل خوردم الان تا حدودی حل شده خوب باید شروع کنم به جست وجو