Change Color Of Pixel In PictureBox

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 CommandButton (named Command1) to your form, And 1 PictureBox
'(Named Picture1). If you want You can put picture in the picturebox. Set the
'PictureBox AutoRedraw property to True.
'Insert this code to the module :

Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long, ByVal crColor As Long) As Long

'Insert the following code to your form:

Private Sub Command1_Click()
Dim s As Long
'Replace the '10,10' below with the position of the pixel you want to change its color.
'Replace the RGB(255, 0, 0) with the color you want to assign to this pixel.
'RGB(255, 0, 0) is red color.
s = SetPixel(Picture1.hdc, 10, 10, RGB(255, 0, 0))
Picture1.Refresh
End Sub

Make 3D Rotating Cube

'Add 1 Picture Box and 1 Timer Control to your form.
'At Run-Time, Move the mouse to change the rotation speed and direction..
'Insert the following code to your form:

Private X(8) As Integer
Private y(8) As Integer
'Integer arrays that hold the actual 2D coordinates of the
'8 corners of the cube.These are the values used to plot
'the cube on the form after the X,Y,Z coordinates of each cube
'corner have been converted to 2 dimensinal X and Y coordinates.
Private Const Pi = 3.14159265358979
'Constant used to convert degrees to radians
Private CenterX As Integer
Private CenterY As Integer
'The center of the 3 dimensional plane,where it's
'X=0 , Y=0 , Z=0
Private Const SIZE = 250
'The length of the cube achmes,therefore also adjusts the overall size.
Private Radius As Integer
'The radius of the rotation.Each one of the 8 corners of the cube
'rotates around the vertical Y axis with the same angular speed and radius
'of rotation.
Private Angle As Integer
'The value of this variable loops from 0 to 360 and it is passed
'as an argument to the COS and SIN functions (sine and cosine)
'that return the changing Z and X coordinates of each corner
'as the cube rotates around the Y axis
Private CurX As Integer
Private CurY As Integer
'Variables that hold the current mouse position on the form.
Private CubeCorners(1 To 8, 1 To 3) As Integer
'The array that holds the X,Y and Z coordinates of the 8 corners
'The center of the 3D plane is right on the center of the cube.
'So ,if SIZE the length of one achmes,it's:
'CenterCube(1,1) = SIZE/2 ' X coordinate of 1st corner
'CenterCube(1,2) = SIZE/2 ' Y coordinate
'CenterCube(1,3) = SIZE/2 ' Z coordinate
'Actually,we only need to give a value for the Y coordinates
'of each corner since that will never change during the rotation
'as all corners rotate around the Y axis ,with only their Z and X
'coordinates changing periodically.
Private Sub Form_Load()
Me.ScaleMode = 3
Picture1.ScaleMode = 3
Timer1.Interval = 1
'Set here the cube Width and color.
Me.ForeColor = vbBlue
Me.DrawWidth = 3
Picture1.AutoRedraw = True
Show
Picture1.Height = Picture1.Width
Picture1.Move ScaleWidth / 2 - Picture1.ScaleWidth / 2, Picture1.Height
CenterX = ScaleWidth / 2
CenterY = ScaleHeight / 2
'Set the center of the 3D plane to reflect the center of the form.
Angle = 0
Radius = Sqr(2 * (SIZE / 2) ^ 2)
'Give a value to the radius of the rotation.This is
'the Pythagorean theorem that returns the length of the
'hypotenuse of a right triangle as the square root
'of the sum of the other two sides raised to the 2nd power.
CubeCorners(1, 2) = SIZE / 2
CubeCorners(2, 2) = SIZE / 2
CubeCorners(3, 2) = -SIZE / 2
CubeCorners(4, 2) = -SIZE / 2
CubeCorners(5, 2) = SIZE / 2
CubeCorners(6, 2) = SIZE / 2
CubeCorners(7, 2) = -SIZE / 2
CubeCorners(8, 2) = -SIZE / 2
'Assign a value to the Y coordinates of each cube.This
'will never change through out the rotation since the cube
'rotates around the Y axis.Play around with these if you like
'but the 3D prism will no longer resemble a cube...
End Sub

Private Sub DrawCube()
Cls
For i = 1 To 8
X(i) = CenterX + CubeCorners(i, 1) + CubeCorners(i, 3) / 8
y(i) = CenterY + CubeCorners(i, 2) + Sgn(CubeCorners(i, 2)) * CubeCorners(i, 3) / 8
'These two lines contain the algorith that converts the
'coordinates of a point on the 3D plane (x,y,z) ,into 2
'dimensional X and Y coordinates that can be used to plot
'a point on the form.Play around with the 8's and see what happens...
Next
Line (X(3), y(3))-(X(4), y(4))
Line (X(4), y(4))-(X(8), y(8))
Line (X(3), y(3))-(X(7), y(7))
Line (X(7), y(7))-(X(8), y(8))
Line (X(1), y(1))-(X(3), y(3))
Line (X(1), y(1))-(X(2), y(2))
Line (X(5), y(5))-(X(6), y(6))
Line (X(5), y(5))-(X(1), y(1))
Line (X(5), y(5))-(X(7), y(7))
Line (X(6), y(6))-(X(8), y(8))
Line (X(2), y(2))-(X(4), y(4))
Line (X(2), y(2))-(X(6), y(6))
Line (X(1), y(1))-(X(4), y(4))
Line (X(2), y(2))-(X(3), y(3))
Line (X(4), y(4))-(X(8), y(8))
Line (X(3), y(3))-(X(7), y(7))
'The plotting of the cube onto the form.
'We have to draw each achmes seperately and then
' "connect" the bottom square with the top square.
DoEvents
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
CurX = X
CurY = y
'Store the current position of the mouse cursor into
'the variable CurX,CurY.
End Sub

Private Sub Timer1_Timer()
Select Case CurX
Case Is > ScaleWidth / 2
Angle = Angle + Abs(CurX - ScaleWidth / 2) / 20
If Angle = 360 Then Angle = 0
Case Else
Angle = Angle - Abs(CurX - ScaleWidth / 2) / 20
If Angle = 0 Then Angle = 360
End Select
'Change the direction and the angular speed of the rotation
'according to the position of the mouse cursor.If it's near
'the left edge of the form then the rotation will be
'anti-clockwise ,it's near the right edge it will be
'clockwise. The closer to the center of the form the
'cursor is,the slower the cube rotates.
'The angular speed of the rotation is controlled by the
'pace at which 'Angle' (the value that we pass to the
'(COS and SIN functions) increases or decreases (increases
'for anti-clockwise rotation and decreases for clockwise rotation).
For i = 1 To 3 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle) * Pi / 180)
Next
For i = 2 To 4 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 2 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 2 * 45) * Pi / 180)
Next
For i = 5 To 7 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 6 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 6 * 45) * Pi / 180)
Next
For i = 6 To 8 Step 2
CubeCorners(i, 3) = Radius * Cos((Angle + 4 * 45) * Pi / 180)
CubeCorners(i, 1) = Radius * Sin((Angle + 4 * 45) * Pi / 180)
Next
'Give the new values to the X and Z coordinates of each one
'of the 8 cube corners by using the COS and SIN mathematical
'functions.Notice that corners 1 and 3 always have the same
'X and Z coordinates, as well as 2 and 4, 5 and 7,6 & 8.
'Take a look at the little scetch on the top of the form
'to see how this is explained (imagine the cube rotating
'around the Y axis)
DrawCube
End Sub

Draw 3D Text On Form

Preparations
Add 1 Command Button to your form.
Press the button to draw the text.

Form Code

Private Sub Command1_Click()

Me.AutoRedraw = True
' you can change the font size and type.
Me.FontSize = 30
Dim ShadowX
Dim ShadowY
ScaleMode = 3
ForeColor = "&H808080"
ShadowY = 5
ShadowX = 5
For i = 0 To 5
CurrentX = ShadowX + i
CurrentY = ShadowY + i
If i = 5 Then Form1.ForeColor = vbWhite
Form1.Print "VBTown!!!"
Next

End Sub

Extract Associated Icon From EXE File

'This example will show you how to extract icon from EXE file. The file has to be file that
'his associate files (the files that opens with him) got his icon. For example the file
'winamp.exe that when it's installed in your computer, all the mp3 files will get his icon.
'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 PictureBox (named Picture1) to your form.
'Insert this code to the module :

Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As _
Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal _
hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

'Insert this code to your form:

Private Sub Form_Load()
Dim Path As String, strSave As String
Dim returnl As Long, return2 As Long
strSave = String(200, Chr$(0))
Picture1.AutoRedraw = True
'Replace 'c:\windows\regedit.exe' with the name of the file that
'you want to extract his icon.
return1 = ExtractIcon(Me.hWnd, "c:\windows\regedit.exe", 2)
return2 = DrawIcon(Picture1.hdc, 0, 0, return1)
End Sub

Capture Screen Image

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 CommandButton (named Command1) to your form.
'Add 1 PictureBox (named Picture1) to your form. Enlarge the PictureBox and make it wide.
'When you will press the button, the program will capture the screen image, and draw
'it in the PictureBox.
'Insert the following code to the module :

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Integer, ByVal x As _
Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, _
ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, _
ByVal dwRop As Long) As Integer
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Const SRCCOPY = &HCC0020
Public Const SRCAND = &H8800C6
Public Const SRCINVERT = &H660046

'Insert the following code to your form:

Private Sub Command1_Click()
Dim DeskhWnd As Long, DeskDC As Long
DeskhWnd& = GetDesktopWindow()
DeskDC& = GetDC(DeskhWnd&)
'If you want to draw the captured image on the form rather than the PictureBox,
'replace the 'Picture1' below with the name of the form.
BitBlt Picture1.hDC, 0&, 0&, Screen.Width, Screen.Height, DeskDC&, 0&, 0&, SRCCOPY
End Sub

Drag Picture File To Picture Box And Display The Picture

If you will drag the file mypic.gif from Windows to the picture box, the picture will be displayed within the picture box.

Preparations
Add 1 Picture Box to your form.
Set the Picture Box OLEDropMode Property to 1 - manual.

Form Code

Private Sub Picture1_OLEDragDrop(Data As DataObject, Effect As Long, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Err
Picture1.Picture = LoadPicture(Data.Files(1))
Exit Sub
Err:
MsgBox "The Picture you dragged could not be loaded"
End Sub

Get Image Dimensions

Get the dimensions of any image file that can be loaded into an Image box.

Preparations
Add 1 Image Box to your form.
Set the Image Box Stretch property to false and the Visible property to false.

Form Code

Private Sub Form_Load()
Image1.Picture = LoadPicture("c:\mypic.gif")
'You will get the image dimensions in pixels. to get them in Twips scale, remove
' the "/ Screen.TwipsPerPixelY" and "/ Screen.TwipsPerPixelX" below.
MsgBox "Image Height: " & Image1.Height / Screen.TwipsPerPixelY & _ " Image width: " & Image1.Width / Screen.TwipsPerPixelX
End Sub

Export BMP File To Icon File

Preparations
Add 1 ImageList Control to your form.

Form Code
Private Sub Form_Load()
' Load the picture into the ImageList. replace "d:\myDir\File.bmp"
' with the BMP file name you want to export.
ImageList1.ListImages.Add , , LoadPicture("d:\myDir\File.bmp")
' Save the icon file. replace "d:\myDir2\File2.ico" with the new Icon
' file you want to create.
SavePicture ImageList1.ListImages(1).ExtractIcon, "d:\myDir2\File2.ico"
End Sub

Make A Pop Up Color Selector

Preparations

Add 1 Common Dialog Control to your form (From VB menu choose Project->Components..., then mark the Microsoft Common Dialog Control check box, and press OK. Now drag the new control to your form).

Form Code

Private Sub Command1_Click()
' The following line says: if the user will press the cancel Button,
' treat it like if an error occurred in the program.
CommonDialog1.CancelError = True
' If an error occurred in the program, jump to the
' CancelPressed part of the program, below.
On Error GoTo CancelPressed
' Pop up the Color Selector
CommonDialog1.ShowColor
' Paint the from with the chosen color.
' CommonDialog1.Color holds the color that the user has selected.
Form1.BackColor = CommonDialog1.Color
' exit the Command1_Click() sub
Exit Sub
CancelPressed:
' If the user pressed the cancel button an error was occurred, and
' the program had jumped to here.
' if the user didn't press the cancel button, the program doesn't apply this
' lines because it already has exited this sub from the "Exit Sub" line above
MsgBox "You pressed Cancel"
End Sub

Copy List Box Content To Another List Box\Combo Box

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 List Boxes, 1 Combo Box and 2 Command Buttons to your form.
'Add few Items to List1. At Run-Time press the first button to copy List1 content to List2.
'And press The second button to copy List1 content to Combo1.

'Insert the following code to your module:

Public Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long

Public Declare Function SendMessageLong Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

'Insert the following code to your form:

Private Sub Command1_Click()
Dim success As Long
success = CopyListToList(List1, List2)
End Sub

Private Sub Command2_Click()
Dim success As Long
success = CopyListToCombo(List1, Combo1)
If success Then Combo1.ListIndex = 0
End Sub

Private Function CopyListToList(source As ListBox, target As ListBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const LB_ADDSTRING = &H180

'get the number of items in the list

Dim numitems As Long
Dim sItemText As String * 255

'get the number of items in the source list

numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)

'if it has contents, copy the items

If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, LB_ADDSTRING, 0&, ByVal sItemText)
Next
End If

'get the number of items in the target list and return that as the function value

numitems = SendMessageLong(target.hWnd, LB_GETCOUNT, 0&, 0&)
CopyListToList = numitems
End Function

Private Function CopyListToCombo(source As ListBox, target As ComboBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const CB_GETCOUNT = &H146
Const CB_ADDSTRING = &H143

'get the number of items in the list

Dim numitems As Long
Dim sItemText As String * 255

'get the number of items in the source list

numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)

'if it has contents, copy the items

If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, CB_ADDSTRING, 0&, ByVal sItemText)
Next
End If

'get the number of items in the target combo and return that as the function value

numitems = SendMessageLong(target.hWnd, CB_GETCOUNT, 0&, 0&)
CopyListToCombo = numitems
End Function

Make Editable List Box

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Command Button, 1 List Box and 1 Text Box to your form.
'Insert the following code to your module:

Option Explicit
DefLng A-Z

Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Type SIZE
cx As Long
cy As Long
End Type

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Declare Function GetTextExtentPoint32 Lib "gdi32" Alias _
"GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal _
cbString As Long, lpSize As SIZE) As Long
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
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long

Public Const WM_SETREDRAW = &HB&
Public Const WM_SETFONT = &H30
Public Const WM_GETFONT = &H31
Public Const LB_GETITEMRECT = &H198
Public Const LB_ERR = (-1)
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOOWNERZORDER = &H200
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SM_CXEDGE = 45
Public Const SM_CYEDGE = 46
Public Function Max(ByVal param1 As Long, ByVal param2 As Long) As Long
If param1 > param2 Then Max = param1 Else Max = param2
End Function

'Insert the following code to your form:
Option Explicit
DefLng A-Z
Private m_bEditing As Boolean
Private m_lngCurrIndex As Long

Private Sub Command1_Click()
If Not m_bEditing Then Editing = True
End Sub

Private Sub Form_Load()
Me.ScaleMode = 3
Text1.Visible = False
Text1.Appearance = 0
Command1.Caption = "Press F2 to edit"
Dim a%
For a% = 1 To 10
List1.AddItem "Item number " & a%
Next a%
Set Text1.Font = List1.Font
End Sub

Private Sub List1_KeyUp(KeyCode As Integer, Shift As Integer)
If ((KeyCode = vbKeyF2) And (Shift = 0)) Then
If (Not m_bEditing) Then Editing = True
End If
End Sub

Private Sub Text1_LostFocus()
'If the textbox looses focus and we're editing, restore the text
'and cancel the edit
If m_bEditing = True Then
List1.List(m_lngCurrIndex) = Text1.Tag
Editing = False
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim strText As String
If KeyAscii = 10 Or KeyAscii = 13 Then
If Len(Trim$(Text1.Text)) = 0 Then
List1.List(m_lngCurrIndex) = Text1.Tag
Else
strText = Text1.Text
'assign the new text to the item
List1.List(m_lngCurrIndex) = strText
End If
Editing = False 'return to the old state
KeyAscii = 0 'avoid a beep

ElseIf KeyAscii = 27 Then 'pressed Esc to cancel the edit
List1.List(m_lngCurrIndex) = Text1.Tag 'restore the original text
Editing = False
KeyAscii = 0 'avoid a beep
End If
End Sub

Private Sub Text1_GotFocus()
'select all the text
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_Change()
Dim lpSize As SIZE
Dim phDC As Long

'adjust the size of the textbox depending on the calculated
'size of the text it contains (or 50 pixels, whatever is greater)
'note that the extent calculation fails (for some reason) when the
'font is over 14 points, but if you have a listbox with a 14 point
'font then you need some redesign there

phDC = GetDC(Text1.hwnd)
If GetTextExtentPoint32(phDC, Text1.Text, Len(Text1.Text), lpSize) = 1 Then
Text1.Width = Max(50, lpSize.cx)
End If
Call ReleaseDC(Text1.hwnd, phDC)
End Sub

Private Property Let Editing(vData As Boolean)
Dim rcItem As RECT 'RECT of the item being edited
Dim strText As String 'text of the item beign edited
Dim lpSize As SIZE 'uset to calculate the size of the textbox
Dim phDC As Long 'hDC of the listbox
On Error Resume Next

'Get the current index...

m_lngCurrIndex = List1.ListIndex

'...and split if there's no index

If m_lngCurrIndex = -1 Then Beep: Exit Property

'are we starting an edit?

If vData = True Then
strText = List1.List(m_lngCurrIndex)
If Len(strText) = 0 Then Beep: Exit Property

'try to get the RECT of the item within the list

If SendMessage(List1.hwnd, LB_GETITEMRECT, ByVal m_lngCurrIndex, rcItem) _
<> LB_ERR Then

'adjust the RECT to makeup. Note that these are client window coordinates
'That is, the RECT is in relation to the list's parent window.
'We also take into consideration the 3-D border, so remove the call to
'GetSystemMetrics() if the listbox's appearance is "flat"

With rcItem
.Left = .Left + List1.Left + GetSystemMetrics(SM_CXEDGE)
.Top = List1.Top + .Top

'why not a call to GetSysMetrics and the SM_CYEDGE?
'because we want the textbox to pop up centered over
'the list item, not flush with the top.

'Get the DC of the listbox and calculate the height and width of the
'Note that the extent calculation fails (for some reason) when the
'font is over 14 points.

phDC = GetDC(Text1.hwnd)
Call GetTextExtentPoint32(phDC, strText, Len(strText), lpSize)
Call ReleaseDC(Text1.hwnd, phDC)

'position and show the textbox, bring it to the top of the Z order.

Call SetWindowPos(Text1.hwnd, HWND_TOP, .Left, .Top, Max(50, lpSize.cx), _
lpSize.cy + 2, SWP_SHOWWINDOW Or SWP_NOREDRAW)
End With

'setting the List property of the listbox causes too
'much flashing, so turn off redrawing

Call SendMessage(List1.hwnd, WM_SETREDRAW, 0, ByVal 0&)
List1.List(m_lngCurrIndex) = ""

'save the item's text and set the focus to the textbox

With Text1
.Enabled = True
.Tag = strText
.Text = strText
.SetFocus
End With
End If
Else

'set the redraw flag so that the listbox updates itself

Call SendMessage(List1.hwnd, WM_SETREDRAW, 1, ByVal 0&)

'Get rid of the textbox and clear it

With Text1
.Enabled = False
.Visible = False
.Move 800, 800
.Text = ""
.Tag = ""
End With
m_lngCurrIndex = -1 'invalidate this for next time
End If

'save the current state

m_bEditing = vData
End Property

Scan ListBox For The Text In TextBox

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 Text Box and 1 List Box to your form. Add few items to the List Box.
'If you will type 'a' in the Text Box, the first item beginning with 'a' will be marked.

'Insert this code to the module :

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _
Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Public Const LB_FINDSTRING = &H18F

'Insert this code to your form:

Private Sub Text1_Change()
List1.ListIndex = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal CStr(Text1.Text))
End Sub

Quick Select/UnSelect All Items In List Box

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 1 List Box and 2 Command Buttons to your form.
'Set List1 MultiSelect property to 1-Simple.
'Insert the following code to your module:

Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const LB_SETSEL = &H185&

'Insert the following code to your form:

Private Sub Command1_Click()
Call SendMessageLong(List1.hwnd, LB_SETSEL, True, -1)
End Sub

Private Sub Command2_Click()
Call SendMessageLong(List1.hwnd, LB_SETSEL, False, -1)
End Sub

Sub Form_Load()
'add this code to the form load to fill
'List1 with some (15) of the system's
'screen fonts.
Dim i As Integer
Dim max As Integer
max = Screen.FontCount
If max > 15 Then max = 15
For i = 1 To max
List1.AddItem Screen.Fonts(i)
Next
End Sub

Move Multiple Items From One List Box To Other List Box/Combo Box

Preparations

Add 2 List Boxes and 1 Command Button to your form.
Set List1 MultiSelect property to 1 - Simple.

Form Code

Private Sub Command1_Click()
'if List1 is empty - exit, to avoid error
If List1.ListCount = 0 Then Exit Sub
Dim CurItem As Integer
CurItem = 0
Do
'if the item is selected
If List1.Selected(CurItem) Then
'add it to the second List Box. If you want to add it to Combo Box,
'change the "List2" below with your combo Box name
'for example: Combo1.AddItem List1.List(CurItem)
List2.AddItem List1.List(CurItem)
'and delete it from List1 List Box
List1.RemoveItem (CurItem)
Else
CurItem = CurItem + 1
End If
Loop Until CurItem = List1.ListCount
End Sub
Private Sub Form_Load()
'add few items to the List Box
For i = 1 To 10
List1.AddItem "Item " & i
Next
End Sub