Results 1 to 2 of 2

Thread: hi i will post free codes and activex every week starting now, enjoy.

  1. #1

    Thread Starter
    Hyperactive Member snakeman's Avatar
    Join Date
    Aug 2006
    Posts
    351

    hi i will post free codes and activex every week starting now, enjoy.

    hi
    some of the following codes made by me
    and the rest from visualbasic websites.
    but any question just ask me.
    hope everybody enjoy.

    ps: i am posting this codes to make it easy to find what you need
    ps: i will post some activex control soon.
    1- open and close the cdroom.
    VB Code:
    1. Private Declare Function mciSendString Lib "winmm.dll" _
    2. Alias "mciSendStringA" ( _
    3.     ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
    4.     ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    5.    
    6. Public Sub OpenCDDriveDoor(ByVal State As Boolean)
    7.     If State = True Then
    8.         Call mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
    9.     Else
    10.         Call mciSendString("Set CDAudio Door Closed", 0&, 0&, 0&)
    11.     End If
    12. End Sub
    13.    
    14. Private Sub Command1_Click()
    15.     OpenCDDriveDoor (True)
    16. End Sub
    17.    
    18. Private Sub Command2_Click()
    19.     OpenCDDriveDoor (False)
    20. End Sub

    2- hide the caret In Textbox.

    VB Code:
    1. 'Add 1 Text Box and 1 Check Box to your form.
    2. 'Uncheck the Check Box to hide Text1 Caret. Check it again to return the caret.
    3. 'Insert the following code to your form:
    4.  
    5. Private Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As Long
    6. Private Declare Function ShowCaret& Lib "user32" (ByVal hwnd As Long)
    7.  
    8. Private Sub CheckCaret()
    9.     If Check1.Value = vbChecked Then
    10.         ShowCaret (Text1.hwnd)
    11.     Else
    12.         HideCaret (Text1.hwnd)
    13.     End If
    14. End Sub
    15.  
    16. Private Sub Form_Load()
    17.     Check1.Value = 1
    18. End Sub
    19.  
    20. Private Sub Text1_Change()
    21.     CheckCaret
    22. End Sub
    23.  
    24. Private Sub Text1_GotFocus()
    25.     CheckCaret
    26. End Sub

    3- Add A Picture In Rich Textbox.

    VB Code:
    1. 'Add 1 Command Button (named Command1),
    2. '1 Rich Text Box (named RichTextBox1) and
    3. '1 Picture Box (named Picture1) to your form.
    4. 'Add a picture to the Picture Box.
    5.  
    6. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    7. (ByVal hwnd As Long, _
    8. ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    9. Private Const WM_PASTE = &H302
    10.  
    11. Private Sub Command1_Click()
    12. 'the 2 code lines below copy the picture box's picture to the clipboard. if you will omit them,
    13. 'the picture that currently found in the clipboard will be copied to the rich text box.
    14.     Clipboard.Clear
    15.     Clipboard.SetData Picture1.Picture
    16.     SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0
    17. End Sub

    4- Add Combobox To Toolbar.

    VB Code:
    1. 'Add 1 Combo Box and 1 ToolBar to your form.
    2. 'Insert the following code to your form:
    3.  
    4. Private Sub Form_Load()
    5. Dim btnX As Button
    6. Me.Show
    7. Set btnX = Toolbar1.Buttons.Add()
    8. btnX.Style = tbrSeparator
    9. Set btnX = Toolbar1.Buttons.Add()
    10. btnX.Style = tbrPlaceholder
    11. btnX.Key = "combo"
    12. btnX.Width = 2000
    13. With Combo1
    14. .ZOrder 0
    15. .Width = Toolbar1.Buttons("combo").Width
    16. .Top = Toolbar1.Buttons("combo").Top
    17. .Left = Toolbar1.Buttons("combo").Left
    18. End With
    19. End Sub

    5- Add Checkbox In Combobox.
    VB Code:
    1. 'Add 1 Combo Box and 1 Check Box to your form.
    2. 'Set CheckBox Width property and Height property to 130.
    3. 'Insert this code to the module :
    4.  
    5. Private Const EC_LEFTMARGIN = &H1
    6. Private Const EC_RIGHTMARGIN = &H2
    7. Private Const EC_USEFONTINFO = &HFFFF&
    8. Private Const EM_SETMARGINS = &HD3&
    9. Private Const EM_GETMARGINS = &HD4&
    10. Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    11. (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    12. ByVal lpszClass As String, _
    13. ByVal lpszWindow As String) As Long
    14. Private Declare Function SendMessageLong Lib "user32" _ Alias "SendMessageA" _
    15. (ByVal hwnd As Long, ByVal wMsg As Long, _
    16. ByVal wParam As Long, ByVal lParam As Long) As Long
    17.  
    18. 'Insert the following code to your form:
    19.  
    20. Private Sub AddCheckToCombo(ByRef chkThis As CheckBox, ByRef cboThis As ComboBox)
    21. Dim lhWnd As Long
    22. Dim lMargin As Long
    23. lhWnd = FindWindowEx(cboThis.hwnd, 0, "EDIT", vbNullString)
    24. If (lhWnd <> 0) Then
    25. lMargin = chkThis.Width \ Screen.TwipsPerPixelX + 2
    26. SendMessageLong lhWnd, EM_SETMARGINS, EC_LEFTMARGIN, lMargin
    27. chkThis.BackColor = cboThis.BackColor
    28. chkThis.Move cboThis.Left + 3 * Screen.TwipsPerPixelX, cboThis.Top + 2 * Screen.TwipsPerPixelY, chkThis.Width, cboThis.Height - 4 * Screen.TwipsPerPixelY
    29. chkThis.ZOrder
    30. End If
    31. End Sub
    32.  
    33. Private Sub Form_Load()
    34. AddCheckToCombo Check1, Combo1
    35. End Sub

    6- Showing A Tooltiptext For Each Element In Listbox.
    VB Code:
    1. Private Sub List1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    2.     Dim index As Integer
    3.     On Error GoTo endList
    4.     WordHeight = 195
    5.     index = List1.TopIndex + ((y) / WordHeight)
    6.     List1.ListIndex = index
    7.     List1.ToolTipText = List1.Text
    8.     Exit Sub
    9.  
    10. endList:
    11.     List1.ListIndex = List1.ListCount - 1
    12.     List1.ToolTipText = List1.Text
    13.    
    14. End Sub

    7- Enable Or Disable All The Controls In The Frame.

    VB Code:
    1. Public Sub EnableFrame(InFrame As Frame, ByVal Flag As Boolean)
    2.     Dim Contrl As Control
    3. 'some controls don't have the Container.Name property, so instead of
    4. 'stopping the application with an error message, we ignore them.
    5.     On Error Resume Next
    6. 'enable or disable the frame that passed as parameter.
    7.     InFrame.Enabled = Flag
    8. 'passing over all controls
    9.     For Each Contrl In InFrame.Parent.Controls
    10. 'if the control is found in the frame
    11.        If (Contrl.Container.Name = InFrame.Name) Then
    12. 'if the control is a frame, and it's not the frame that passed as parameter, i.e.
    13. 'other frame that found inside our frame, recursively run this sub with this frame,
    14. 'to enable or disable all the controls in it.
    15.           If (TypeOf Contrl Is Frame) And Not (Contrl.Name = InFrame.Name) Then
    16.              EnableFrame Contrl, Flag
    17.           Else
    18. 'enable or disable the control
    19.              If Not (TypeOf Contrl Is Menu) Then Contrl.Enabled = Flag
    20.           End If
    21.        End If
    22.     Next
    23. End Sub
    24.  
    25. Private Sub Command1_Click()
    26.     EnableFrame Frame1, False
    27. End Sub
    28.  
    29. Private Sub Command2_Click()
    30.     EnableFrame Frame1, True
    31. End Sub
    Thats all for today.
    see ya
    Last edited by snakeman; Jan 9th, 2007 at 05:57 PM.

  2. #2
    Just Married shakti5385's Avatar
    Join Date
    Mar 2006
    Location
    Udaipur,Rajasthan(INDIA)
    Posts
    3,747

    Arrow Re: hi i will post free codes and activex every week starting now, enjoy.

    Can you post is the VBCODE Tag

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width