Devil World

جان من نظر بدین...

Option Explicit
Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Dim OrginalColor As Long
Dim NewColor(0) As Long
Dim IndexArray(0) As Long
Private Const COLOR_BTNTEXT = 18

Private Sub Command1_Click()
    IndexArray(0) = COLOR_BTNTEXT
    NewColor(0) = QBColor(Int(Rnd * 16))
    SetSysColors 1, IndexArray(0), NewColor(0)
End Sub

Private Sub Command2_Click()
    IndexArray(0) = COLOR_BTNTEXT
    NewColor(0) = OrginalColor
    SetSysColors 1, IndexArray(0), NewColor(0)
End Sub

Private Sub Form_Load()
    OrginalColor = GetSysColor(COLOR_BTNTEXT)
    Command1.Caption = "Change Color"
    Command2.Caption = "Reset Color"
    Randomize
End Sub

این هم مرتب کردن دسکتاب جون من نظر بدین

Private Const LVA_ALLIGNLEFT = &H1
Private Const LVM_ARRANGE = &H1016
Private Const GW_CHILD = 5
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
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()
Dim lnghWnd As Long
Dim lngReturn As Long
lnghWnd = FindWindow("Program", vbNullString)
lnghWnd = GetWindow(lnghWnd, GW_CHILD)
lnghWnd = GetWindow(lnghWnd, GW_CHILD)
lngReturn = SendMessage(lnghWnd, LVM_ARRANGE, LVA_ALLIGNLEFT, 0)
End Sub

نگارش 1 ويژوال بيسيك در سال 1990 به وجود آمد . تا آن زمان برنامه نويسي براي ويندوز به وسيله زبان برنامه نويسي C-كه كار با آن بسيار دشوار بود- امكان پذيربود .براي نمونه شما مجبور بوديد پنج صفحه كد توسط زبان برنامه نويسي C بنويسيد تا يك پنجره معمولي ويندوز كه درون آن خالي است ايجاد شود! و هنچنين اگر شما ميخواستيد كنترلهاي بصري (Visual Elements) مانند دكمه ها ، جعبه ليست ها ، جعبه متن ها و ...را ايجاد نماييد بايد مقدار بسيار زيادي كد مي نوشتيد و زحمت بسياري را نيز متحمل مي شديد .
كارايي فوق العاده ويژوال بيسيك همه چيز را تغيير داد . در حال حاضر اگر شما به يك دكمه (Button) نياز داشته باشيد كافيست آن را بر روي مكاني كه ميخواهيد بكشيد و آن را در آن جا قرار دهيد يا اگر به يك جعبه متن(TextBox) احتياج داشته باشيد ميتوانيد آن را نيز در مكان دلخواه قرار دهيد بدون اينكه مجبور باشيد حتي يك خط كد هم بنويسيد . تولد ويژوال بيسيك يك انقلاب بزرگ را شكل داد و هزاران امكان قدرتمند را در اختيار برنامه نويسان ويندوز قرار داد . به طور كلي ويژوال بيسيك ،برنامه نويسي ويندوز را براي هميشه تغيير داد .
تا زماني كه ويژوال بيسيك پا به عرصه دنياي برنامه نويسي بگذارد ايجاد و مديريت يك رابط كاربري (UI كه مخفف User Interface مي باشد و به طور كلي به ظاهر برنامه گفته ميشود) بسيار دشوار بود ولي الان ايجاد رابط كاربري نه تنها ساده است بلكه در بعضي موارد يك سرگرمي نيز محسوب مي شود .
به مرور زمان نگارشهاي بعدي ويژوال بيسيك آمدند و در هر نگارش امكانات جديدي به آن اضافه شد . در برنامه نويسي ويندوز، عناصر رابط كاربري (عناصري كه كاربر با آنها سر و كار دارد) مثل دكمه ها و جعبه متن ها و و جعبه ليست ها، كنترل (Control) ناميده ميشوند . نگارش 3 ويژوال بيسيك باز هم تصويري جديد از ويژوال بيسيك را بوجود آورد و آن به خاطر اين بود كه برنامه نويسان ميتوانستند از طريق Data Access Objects(DAO) با بانك هاي اطلاعاتي ارتباط برقراركرده و با آنها كار كنند . نگارش 4 و 5 ويژوال بيسيك با هدف برنامه نويسي بر روي ويندوز 95 به وجود آمدند و مطالبي را درباره برنامه نويسي شيء گرا (OOP كه مخفف Object Oriented Programmingمي باشد) معرفي كردند .
نگارش 6 ويژوال بيسيك قابليتهاي بسيار زيادي را با خود به همراه داشت كه از مهمترين آنها ميتوان بهَADO(ActiveX Data Objects) اشاره كرد كه به شما اجازه كار با بانكهاي اطلاعاتي با منابع بسيارمتنوع و حتي بر روي اينترنت را مي داد .
توسعه وب و برنامه نويسي براي اينترنت در ويژوال بيسيك 6 راه را براي آينده و به وجود آمدن نگارشهاي جديد ويژوال بيسيك با قابليتهاي بسيار زياد هموار ساخت . مايكروسافت دريافت كه توسعه برنامه نويسي وب راهي است كه بايد ادامه دهد و به دنبال آن برود . چندين سال بعد از به وجود آمدن ويژوال بيسيك نگارش جديد اين زبان برنامه نويسي با نام Visual Basic.Net 2002 پا به دنياي برنامه نويسي نهاد كه تقريبا ويژوال بيسيك 6 را از ميان برداشت . زبان برنامه نويسي در ويژوال بيسيك دات نت رشد كرده است و بسياري از دستورهاي قديمي حذف شده اند و دستورها و قابليتهاي دستوري جديد جايگزين آنها شده اند . مراحل ساخت برنامه ها به طور كلي از پايه تغيير كرده است . در حقيقت اين به آن معناست كه قبلا شما نمي توانستيد به طور خودكار كدهاي قديمي را ارتقاء دهيد تا در نگارش جديد بتوانيد از آن استفاده كنيد . اما ويژوال بيسيك دات نت ابزاري را در اختيار شما ميگذارد كه به وسيله آن مي توانيد برنامه هايي را كه در ويژوال بيسيك 6 نوشته ايد به كد ويژوال بيسيك دات نت تبديل كنيد البته بايد توجه داشته باشيد كه اين ابزار تنها در تبديل كدها و برنامه هاي ساده به شما كمك مي كند و برنامه هاي پيشرفته و بزرگ را نميتوان از اين طريق به كد ويژوال بيسيك دات نت تبديل كرد چون ويژوال بيسيك دات نت از پايه و بنيان تغيير كرده است . نگارش بعدي اين زبان برنامه نويسي نيز Visual Basic.Net 2003 ميباشد كه امكانات بسيار زيادي به آن افزوده شده است و از موراد بسيار زيادي پشتيباني ميكند كه در زير به برخي از آنها را اشاره شده است :

• پنجره هاي غير مستطيلي
• كدهاي جديد در چارچوب كاري دات نت (.Net Framwork)
• پشتيباني بهتر براي تبديل كدهاي ويژوال بيسيك 6 به ويژوال بيسيك دات نت 2003
• ويزگي تعريف متغير براي يك حلقه (Loop) در داخل خود حلقه
• توسعه دسترسي به وب سرويس ها
• ارتقا امنيت در ديباگرها
• امكان برنامه نويسي براي دستگاههاي هوشمند( Smart Devices ) مانند Pocket PC
• پيشرفت در توسعه و گسترش برنامه هاي كاربردي و ساختن فايلهاي نصب كننده براي آنها
و بسياري امكانات ديگر

یه برنامه برای اعمال توپ در ویندوز

سه عدد OptionBox و یک عدد CommandButton

Private Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" _(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2

Public Sub Command1_Click()
if option(0).value = 1 then
ExitWindowsEx Ewx_logoff, 0&
elseif option(1).value = 1 then
ExitWindowsEx Ewx_Shutdown, 0&
elseif option(1).value = 1 then
ExitWindowsEx Ewx_Reboot, 0&
end if
End Sub

در بادی امر به ساختار دستور  Shell می پردازیم:

در  دستور Shell دو آرگومان داریم :

۱-PathName :مسیر برنامه  

۲-WindowState :شکل پنجره به حالت های مختلف مثل هاید یا ماکسیمایز یا ...

Call Shell(PathName, WindowState)

                      Control Panel
Call Shell("rundll32.exe shell32.dll,Control_RunDLL")
'Accessability Properties(Keyboard)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1")
'Accessability Properties(Sound)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2")

برای مشاهده ی ادامه اینجا را کلیک کنید

اگر نظر بدین خیلی ممنون می شوم

آیکون های دسکتاپ را چگونه محو کنیم

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 

Private Sub Cmd_HideAppearance_Click()
    subkey = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System"
    rtn = InStr(subkey, "\")
    If Left(subkey, rtn - 1) = "HKEY_CURRENT_USER" Then MainKeyHandle = &H80000001
    subkey = Right(subkey, Len(subkey) - rtn)
    entry = "NoDesktop"
    If MainKeyHandle Then
        rtn = RegOpenKeyEx(MainKeyHandle, subkey, 0, Key_Write, hKey)
        If rtn = error_success Then
            rtn = RegSetValueEx(hKey, entry, 0, REG_DWORD, 1, 4)
            rtn = RegCloseKey(hKey)
        End If
    End If
End Sub

Private Sub Cmd_ShowIcon_Click()
    subkey = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
    rtn = InStr(subkey, "\")
    If Left(subkey, rtn - 1) = "HKEY_CURRENT_USER" Then MainKeyHandle = &H80000001
    subkey = Right(sunkey, Len(subkey) - rtn)
    entry = "NoDesktop"
    If MainKeyHandle Then
        rtn = RegOpenKeyEx(MainKeyHandle, subkey, 0, Key_Write, hKey)
        If rtn = error_success Then
            rtn = RegSetValueEx(hKey, entry, 0, REG_DWORD, 0, 4)
            rtn = RegCloseKey(hKey)
        End If
    End If
End Sub

Private Sub Exit_Click()
    End
End Sub

اگه نظر بدین ممنون می شوم

روش عوض کردن برچسب درایو:

Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long

Private Sub Cmd_ChangeLabel_Click()
RootName = "C:\"
NewLabel = "Devil Soft"
(Call SetVolumeLabel(RootName, NewLabel
End Sub

باز هم مثل همیشه مشکل پرانتز ها هست

Private Declare Function GetDiskFreeSpace Lib "Kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorPerCluster As Long, lpBytesPerSector As Long, lpNumberOfClusters As Long, lpTotalNumberOfClusters As Long) As Long

Private Sub Cmd_Diskinfo_Click()
Dim lAnswer As Long
Dim lpRootPathName As String
Dim lpSectorPerCluster As Long
Dim lpBytesPerSector As Long
Dim lpNumberOfClusters As Long
Dim lpTotalNumberOfClusters As Long
Dim lBytesPerCluster As Long
Dim lNumFreeBytes As Double
Dim sString As String

lpRootPathName = "D:\"
lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorPerCluster, lpBytesPerSector, lpNumberOfClusters, lpTotalNumberOfClusters)
lBytesPerCluster = lpSectorPerCluster * lpBytesPerSector
lNumFreeBytes = lBytesPerCluster * lpNumberOfClusters
sString = "Number of Free Bytes: " & lNumFreeBytes & vbCr & vbCrLf
sString = sString & "Number of Free Kilobytes: " & CStr(lNumFreeBytes / 1024) & " K" & vbCr & vbCrLf
sString = sString & "Number of Free Megabytes: " & Format(((lNumFreeBytes / 1024) / 1024), "0.00") & " MB"
MsgBox sString
End Sub

البته همین طور که می بینید برنامه خراب شده موقع تایپ یا کپی کردن مواظب باشید

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 Cmd_NoLine_Click()
Dim lngLineCount As Long
On Error Resume Next
lngLineCount = SendMessage(Text1.hwnd, &HBA, 0&, 0&)
MsgBox Format$(lngLineCount, "##,###")
End Sub