مسائل جالب در vb6(سورس کدهای جالب کامپوننت های جالب و....)

يه فرم جديد ايجاد كنين و يه عدد چك باكس بهش اضافه كنين و اسم چك باكس بزارين بمونه همون Check1
بعد كد زير رو به برنامتون وارد كنين

کد:

---

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const REG_SZ = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const HKEY_CURRENT_USER = &H80000001

Private Sub SaveStringWORD(hKey As Long, strPath As String, strValue As String, strData As String)
'----------------------------------------------------------------------------
'Argument      :  Handlekey, Name of the Value in side the key
'Return Value  :  Nil
'Function      :  To store the value into a key in the Registry
'Comments      :  None
'----------------------------------------------------------------------------

    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Set the key's value
    RegSetValueEx Ret, strValue, 0, REG_DWORD, CLng(strData), 4
    'close the key
    RegCloseKey Ret
End Sub

Private Sub Check1_Click()
    SaveStringWORD HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\policies\system", "DisableTaskMgr", Val(Check1.Value)
End Sub

Private Sub Form_Load()
    Check1.Caption = "Disable Task Manager"
End Sub

---

کد:

---

Imports System
Imports System.Windows.Forms
Imports Microsoft.VisualBasic
Imports System.Drawing

Class reken
        Inherits System.Windows.Forms.Form
       
        Public Shared Sub Main()
                Application.Run(New reken())
        End Sub
        'form setting
        Public Sub New()
                Text = "Hi"
                Name = "Mehdi Rekening"

                Width = 400
                Height = 400
                MaximizeBox = False
                MinimizeBox = False
                HelpButton = True
                FormBorderStyle = FormBorderStyle.FixedDialog
                'BackGroundImage = Image.FromFile ("Calc3.Bmp")
                Txbx()
                Bttn()
        End Sub
        Private WithEvents Tx1 As New Textbox      'text box
        Private WithEvents Mehdi As New Button()  'change templet button
        'text box setting
        Private Sub Txbx()
                With mehdi
                        .flatstyle = flatstyle.system
                        .width = 40
                        .height = 20
                        .top = 4
                        .left = 4
                        .backcolor = backcolor.red
                End With
                Controls.Add(Mehdi)
                With Tx1
                        .Font = New Font("Arial", 10)
                        .MaxLength = 50
                        .TextAlign = HorizontalAlignment.Right
                        .Readonly = True
                        .Multiline = True
                        .Acceptsreturn = True
                        .Acceptstab = True
                        .Wordwrap = True
                        .Text = "0"
                        .Height = 25
                        .Width = 340
                        .Top = 30
                        .Left = 30
                End With
                Me.Controls.Add(Tx1)
        End Sub
       
        'button
       
        Private WithEvents Btn1 As New Button
        Private WithEvents Btn2 As New Button
        Private WithEvents Btn3 As New Button
        Private WithEvents Btn4 As New Button
        Private WithEvents Btn5 As New Button
        Private WithEvents Btn6 As New Button
        Private WithEvents Btn7 As New Button
        Private WithEvents Btn8 As New Button
        Private WithEvents Btn9 As New Button
        Private WithEvents Btn10 As New Button
        Private WithEvents Btn11 As New Button
        Private WithEvents Btn12 As New Button
        Private WithEvents Btn13 As New Button
        Private WithEvents Btn14 As New Button
        Private WithEvents Btn15 As New Button
        Private WithEvents Btn16 As New Button
       
        'set buttons
       
        Private Sub Bttn()
                With Btn1
                        .Text = "1"
                        .Top = 90
                        .Left = 40
                        .FlatStyle = FlatStyle.system
                End With               
                With Btn2
                        .Text = "2"
                        .Top = 90
                        .Left = 40 + 80
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn3
                        .Text = "3"
                        .Top = 90
                        .Left = 40 + 160
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn4
                        .Text = "+"
                        .Top = 90
                        .Left = 40 + 240
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn5
                        .Text = "4"
                        .Top = 130
                        .Left = 40
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn6
                        .Text = "5"
                        .Top = 130
                        .Left = 40 + 80
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn7
                        .Text = "6"
                        .Top = 130
                        .Left = 40 +160
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn8
                        .Text = "7"
                        .Top = 170
                        .Left = 40
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn9
                        .Text = "8"
                        .Top = 170
                        .Left = 40 + 80
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn10
                        .Text = "9"
                        .Top = 170
                        .Left = 40 + 160
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn11
                        .Text = "0"
                        .Top = 210
                        .Left = 40 + 80
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn12
                        .Text = "X"
                        .Top = 210
                        .Left = 40 + 240
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn13
                        .Text = "__"
                        .Top = 170
                        .Left = 40 + 240
                        .FlatStyle = FlatStyle.System
                End With
                With Btn14
                        .Text = "/"
                        .Top = 130
                        .Left = 40 + 240
                        .FlatStyle = FlatStyle.System
                End With               
                With Btn15
                        .Text = "="
                        .Top = 210
                        .Left = 40 + 160
                        .FlatStyle = FlatStyle.System
                End With       
                With Btn16
                        .Text = "C"
                        .Top = 250
                        .Left = 40
                        .Width = 200 + 115
                        .FlatStyle = FlatStyle.System
                End With       
               
                'add buttons
               
                Controls.Add(Btn1)
                Controls.Add(Btn2)
                Controls.Add(Btn3)
                Controls.Add(Btn4)
                Controls.Add(Btn5)
                Controls.Add(Btn6)
                Controls.Add(Btn7)
                Controls.Add(Btn8)
                Controls.Add(Btn9)
                Controls.Add(Btn10)
                Controls.Add(Btn11)
                Controls.Add(Btn12)
                Controls.Add(Btn13)
                Controls.Add(Btn14)
                Controls.Add(Btn15)
                Controls.Add(Btn16)
        End Sub
        Dim Sym As New Integer
        Dim Number1 As New Double
        Dim Number2 As New Double
       
        'buttons click
        'number 1
        Private Sub Klick1(Sender As Object,E As EvenTargs) Handles Btn1.click
                Tx1.Appendtext("1")
               
        End Sub
        'number 2
        Private Sub Klick2(Sender As Object,E As EvenTargs) Handles Btn2.Click
                Tx1.Appendtext("2")
        End Sub
        'number 3
        Private Sub Klick3(Sender As Object,E As EvenTargs) Handles Btn3.Click
                Tx1.Appendtext("3")
        End Sub
        'plus
        Private Sub Klick4(Sender As Object,E As EvenTargs) Handles Btn4.Click
                Number1 = 0
                Number1 = Tx1.Text
                Sym = 1
                Tx1.Clear
                Tx1.Text = 0
        End Sub
        'number 4
        Private Sub Klick5(Sender As Object,E As EvenTargs) Handles Btn5.Click
                Tx1.Appendtext("4")
        End Sub
        'number 5
        Private Sub Klick6(Sender As Object,E As EvenTargs) Handles Btn6.Click
                Tx1.Appendtext("5")
        End Sub
        'number 6
        Private Sub Klick7(Sender As Object,E As EvenTargs) Handles Btn7.Click
                Tx1.Appendtext("6")
        End Sub
        'number 7
        Private Sub Klick8(Sender As Object,E As EvenTargs) Handles Btn8.Click
                Tx1.Appendtext("7")
        End Sub
        'number 8
        Private Sub Klick9(Sender As Object,E As EvenTargs) Handles Btn9.Click
                Tx1.Appendtext("8")
        End Sub
        'number 9
        Private Sub Klick10(Sender As Object,E As EvenTargs) Handles Btn10.Click
                Tx1.Appendtext("9")
        End Sub
        'number 0
        Private Sub Klick11(Sender As Object,E As EvenTargs) Handles Btn11.Click
                Tx1.Appendtext("0")
        End Sub
        ' /
        Private Sub Klick12(Sender As Object,E As EvenTargs) Handles Btn14.Click
                Number1 = 0
                Number1 = Tx1.Text
                Sym = 2
                Tx1.Clear
                Tx1.Text = 0
        End Sub
       
        ' min
        Private Sub Klick13(Sender As Object,E As EvenTargs) Handles Btn13.Click
                Number1 = 0
                Number1 = Tx1.Text
                Sym = 3
                Tx1.Clear
                Tx1.Text = 0
        End Sub
        'x
        Private Sub Klick14(Sender As Object,E As EvenTargs) Handles Btn12.Click
                Number1 = 0
                Number1 = Tx1.Text
                Sym = 4
                Tx1.Clear
                Tx1.Text = 0
        End Sub
        'clear
        Private Sub Klick16(Sender As Object,E As EvenTargs) Handles Btn16.Click
                Number1 = 0
                Number2 = 0
                Tx1.Clear
                Tx1.Text = 0
        End Sub
        '=
        Private Sub Klick15(Sender As Object,E As EvenTargs) Handles Btn15.Click
                Number2 = Tx1.Text
                If Sym = 1
                        Tx1.Text = Number1 + Number2
                End If
                If Sym = 2
                        Tx1.Text = Number1 / Number2
                End If
                If Sym = 3
                        Tx1.Text = Number1 - Number2
                End If
                If Sym = 4
                        Tx1.Text = Number1 * Number2
                End If
        End Sub
        Dim Number3 As Integer = 0
        'templet
        Private Sub Checkboxclick(Sender As Object,E As EvenTargs) Handles Mehdi.Click
                Number3 = Number3 + 1

                If Number3 = 1
                        'Backgroundimage = Image.Fromfile("Calc.Bmp")
                End If
                If Number3 = 2
                        'Backgroundimage = Image.Fromfile("Calc2.Bmp")
                End If
                If Number3 = 3
                        'Backgroundimage = Image.Fromfile("Calc3.Bmp")
                End If
                If Number3 = 4
                        'Backgroundimage = Image.Fromfile("Calc4.Bmp")
                End If
                If Number3 = 5
                        'Backgroundimage = Image.Fromfile("Calc5.Bmp")
                End If
                If Number3 = 5
                        Number3 = 0
                End If

        End Sub
End Class

---

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

کد:

---

Public Const WM_RBUTTONUP = &H205
Global Const WM_MOUSEMOVE = &H200
Global Const NIM_ADD = 0
Global Const NIM_DELETE = 2
Global Const NIM_MODIFY = 1
Global Const NIF_ICON = 2
Global Const NIF_MESSAGE = 1
Global Const ABM_GETTASKBARPOS = &H5
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
Global Notify As NOTIFYICONDATA
Global BarData As APPBARDATA
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Sub AddIcon(Form1 As Form, IconID As Long, Icon As Object, ToolTip As String)
Dim Result As Long
BarData.cbSize = 36&
Result = SHAppBarMessage(ABM_GETTASKBARPOS, BarData)
Notify.cbSize = 88&
Notify.hwnd = Form1.hwnd
Notify.uID = IconID
Notify.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
Notify.uCallbackMessage = WM_MOUSEMOVE
Notify.hIcon = Icon
Notify.szTip = ToolTip & Chr$(0)
Result = Shell_NotifyIcon(NIM_ADD, Notify)
End Sub
Sub delIcon(IconID As Long)
Dim Result As Long
Notify.uID = IconID
Result = Shell_NotifyIcon(NIM_DELETE, Notify)
End Sub

---

حالا توي فرمتون هم يه متغير تعريف كنين يعني اين كد رو كپي كنين به اول فرمتون

کد:

---

Public IconObject As Object

---

بعدش توي تابع لود شدن فرمتون اين كدها ..

کد:

---

Set IconObject = Form1.Icon
AddIcon Form1, IconObject.Handle, IconObject, "TrayIcon"
Me.Popup.Visible = False

---

و تو تابع خارج شدن از فرم (unload) اين كدها رو وارد كنين

کد:

---

delIcon IconObject.Handle
delIcon Form1.Icon.Handle

---

حالا يه منو درست كنين و اسمش رو بزارين pupop بعد اينكه منو رو ساختين و چند تا زير شاخه بهش دادين اين كدها رو تو تابع mouse_move فرمتون كپي كنين

کد:

---

Static Message As Long
Message = X / Screen.TwipsPerPixelX
Select Case Message
Case WM_RBUTTONUP:
Me.PopupMenu Popup
End Select

---

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

يه سوال:يه كد مي خواستم كه باهاش بتونم در سيدي رام و رايتر باز و بسته كنم
يه سورس دارم ولي فقط يكيشونو باز ميكنه
ممنون...

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

يه چندايي پيدا كردم ولي همشون فقط روي IDE primery master كار ميكنن!!! vروي primery slave كار نمي كنن.

ویبی دم دستم نیست برات بنویسم ولی قول نمی دم اگه یه دونه پیدا کردم برات می زارم

سلام عاليه لطفا
پلاگين شبيح ويندوز و ياويندوز تری
را دوباره قرار بده چون نمي گرفت
ممنون موفق باشي

حتما دوست عزیز .
فکر کنم چون با پرشین گیگ آپ شده چند بار سعی کنی در زمان های متفاوت درست می شه

ممنو همشون خوبن خيلي استفاده كردم