H o w     t o ... ,

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 Const CB_FINDSTRING = &H14C
Private Const CB_SELECTSTRING = &H14D
Private Const CB_LIMITTEXT = &H141
Private Const CB_ERR = (-1)

Dim r As DAO.Recordset


Private Sub Combo1_KeyPress(KeyAscii As Integer)
Dim t$, rez&, l&
Combo1.SelText = ""
t$ = Combo1.Text & Chr$(KeyAscii)
rez& = SendMessage(Combo1.hwnd, CB_FINDSTRING, -1,ByVal t$)
If rez& <> CB_ERR Then
    l& = Len(t$)
    Combo1.Text = Combo1.List(rez&)
    KeyAscii = 0
    Combo1.SelStart = l&
    Combo1.SelLength = Len(Combo1.Text) - l&
End If
End Sub

Private Sub Combo1_LostFocus()
Dim t$, rez&
t$ = Combo1.Text
rez& = SendMessage(Combo1.hwnd, CB_FINDSTRING, -1, ByVal t$)
If rez& = CB_ERR Then
    Combo1.AddItem Combo1.Text
    'trebuie adaugat si in baza de date
End If
End Sub

Private Sub Form_Load()
Set r = DBEngine(0).OpenDatabase("C:\Program Files\DevStudio\VB\BIBLIO.MDB").OpenRecordset("Authors")
While Not r.EOF
    Combo1.AddItem r.Fields(1)
    r.MoveNext
Wend
r.Close
Set r = Nothing
End Sub

Pe lângă soluția cu Timer sau folosirea funcției API Sleep se poate face astfel:

Private Sub Pause(interval) ' New sub
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

Sursa este in Picture1 și va fi mutată în Picture2.

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source


Private Sub Picture1_Click()
StretchBlt Picture2.hdc, 0, 0, Picture2.Width \ Screen.TwipsPerPixelX, Picture2.Height \ Screen.TwipsPerPixelY, _
    Picture1.hdc, 0, 0, Picture1.Width \ Screen.TwipsPerPixelX, Picture1.Height \ Screen.TwipsPerPixelY, SRCCOPY
Picture2.Top = 0
End Sub

'  add three command buttons and two pictureboxes. Load a bitmap into picture1 in design
'  mode. Set both box to the same size. Routines execute 3 times faster than routines
'  found in Microsoft's Knowledge Base.

               private Const SRCCOPY = &HCC0020
               private Const Pi = 3.14159265359
               private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
               private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
               private Declare Function StretchBlt% Lib "GDI32" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)

               Sub Form_Load ()
                picture1.ScaleMode = 3
                picture2.ScaleMode = 3
               End Sub


               Sub Command1_Click ()
               'flip horizontal
                picture2.Cls
                px% = picture1.ScaleWidth
                py% = picture1.ScaleHeight
                retval% = StretchBlt(picture2.hDC, px%, 0, -px%, py%, picture1.hDC, 0, 0, px%, py%, SRCCOPY)
               End Sub


               Sub Command2_Click ()
                'flip vertical
                picture2.Cls
                px% = picture1.ScaleWidth
                py% = picture1.ScaleHeight
                retval% = StretchBlt(picture2.hDC, 0, py%, px%, -py%, picture1.hDC, 0, 0, px%, py%, SRCCOPY)
               End Sub

               Sub Command3_Click ()
                'rotate 45 degrees
                picture2.Cls
                Call bmp_rotate(picture1, picture2, 3.14 / 4)
               End Sub


               Sub bmp_rotate (pic1 As PictureBox, pic2 As PictureBox, ByVal theta!)
                ' bmp_rotate(pic1, pic2, theta)
                ' Rotate the image in a picture box.
                '   pic1 is the picture box with the bitmap to rotate
                '   pic2 is the picture box to receive the rotated bitmap
                '   theta is the angle of rotation
                Dim c1x As Integer, c1y As Integer
                Dim c2x As Integer, c2y As Integer
                Dim a As Single
                Dim p1x As Integer, p1y As Integer
                Dim p2x As Integer, p2y As Integer
                Dim n As Integer, r   As Integer

                c1x = pic1.ScaleWidth \ 2
                c1y = pic1.ScaleHeight \ 2
                c2x = pic2.ScaleWidth \ 2
                c2y = pic2.ScaleHeight \ 2

                If c2x < c2y Then n = c2y Else n = c2x
                n = n - 1
                pic1hDC% = pic1.hDC
                pic2hDC% = pic2.hDC

                For p2x = 0 To n
                  For p2y = 0 To n
                    If p2x = 0 Then a = Pi / 2 Else a = Atn(p2y / p2x)
                    r = Sqr(1& * p2x * p2x + 1& * p2y * p2y)
                    p1x = r * Cos(a + theta!)
                    p1y = r * Sin(a + theta!)
                    c0& = GetPixel(pic1hDC%, c1x + p1x, c1y + p1y)
                    c1& = GetPixel(pic1hDC%, c1x - p1x, c1y - p1y)
                    c2& = GetPixel(pic1hDC%, c1x + p1y, c1y - p1x)
                    c3& = GetPixel(pic1hDC%, c1x - p1y, c1y + p1x)
                    If c0& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2x, c2y + p2y, c0&)
                    If c1& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2x, c2y - p2y, c1&)
                    If c2& <> -1 Then xret& = SetPixel(pic2hDC%, c2x + p2y, c2y - p2x, c2&)
                    If c3& <> -1 Then xret& = SetPixel(pic2hDC%, c2x - p2y, c2y + p2x, c3&)
                  Next
                  t% = DoEvents()
                Next
               End Sub

Private Declare Function waveOutGetNumDevs Lib "MMSYSTEM" () As Integer

i% = waveOutGetNumDevs()
If i% > 0 Then 
	MsgBox "You Can Play Wave Data" 
Else 
	MsgBox "Cannot Play Wave Data"
End If

Dim X
'"MyConnectionsName" is the name under the icon in Dial-up Networking
X = Shell("rundll32.exe rnaui.dll,RnaDial " & "MyConnectionsName", 1)
DoEvents
'You can type in your password before the { below.
SendKeys "{enter}", True
DoEvents
End Sub

Private Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWid As Integer, ByVal nHt As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer

Private Sub Tile(picParent As PictureBox, picTile As PictureBox)
'This subroutine tiles a picture onto another picture.
'call syntax: Tile Picture1, Picture2
'             Tile (destination), (source)
Dim TileIt As Integer
Const SRCCOPY = &HCC0020
Dim X As Integer, Y As Integer
Dim MaximumX As Integer, MaximumY As Integer
MaximumX = picParent.Width + picTile.Width
MaximumY = picParent.Height + picTile.Height
MaximumX = MaximumX \ Screen.TwipsPerPixelX
MaximumY = MaximumY \ Screen.TwipsPerPixelY
Dim TileWidth As Integer, TileHeight As Integer
TileWidth = picTile.Width \ Screen.TwipsPerPixelX
TileHeight = picTile.Height \ Screen.TwipsPerPixelY
For Y = 0 To MaximumY Step TileHeight
  For X = 0 To MaximumX Step TileWidth
    TileIt = BitBlt(picParent.hDC, X, Y, TileWidth, TileHeight, picTile.hDC, 0, 0, SRCCOPY)
  Next
Next
End Sub

Private 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

Dim maxhgt As Long, maxwid As Long
Dim pwid As Integer, phgt As Integer

Sub Form_Load ()
	picture1.ScaleMode = 3
        picture1.Visible = False
        picture1.AutoSize = True
        picture1.AutoRedraw = True
        pwid = picture1.ScaleWidth
        phgt = picture1.ScaleHeight 
End Sub

Sub Form_Paint ()
	phDC& = picture1.hDC
        frmhdc& = hdc
	For j% = 0 To maxhgt Step phgt
        	For i% = 0 To maxwid Step pwid
                	X% = BitBlt(frmhdc&, i%, j%, pwid, phgt, phDC&, 0, 0, &HCC0020)
                Next
        Next
End Sub

Sub Form_Resize ()
	maxhgt = Height \ screen.TwipsPerPixelY
        maxwid = Width \ screen.TwipsPerPixelX
End Sub

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long


'Place the following code in under a command button or in a menu, etc...

source = "C:\myfile.txt"
target = "C:\Windows\myfile.txt"


'Copy File
A = CopyFile(Trim$(Source), Trim(Target), False)
If A Then
        MsgBox "File copied!"
Else
        MsgBox "Error. File not moved!"
End If

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" ( ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

Dim free_Space As Long
ChDrive "C:"
Dim numSectorsPerCluster As Long
Dim numBytesPerSector As Long
Dim numFreeClusters As Long
Dim numTotalClusters As Long
Dim success As Boolean
success = GetDiskFreeSpace("C:\", numSectorsPerCluster, numBytesPerSector,  numFreeClusters, numTotalClusters)
free_Space = numSectorsPerCluster * numBytesPerSector * numFreeClusters
Label1.Caption = "The total free space on Drive C: = " & format(Str$(free_Space/1024),"###,### ") & " KB"

Function IsLeapYear(ByVal sYear As String) As Boolean
 	If IsDate("02/29/" & sYear) Then
        	IsLeapYear = True
	Else
        	IsLeapYear = False
	End If
End Function

Public Function IsWeekend(ByVal vntDate As Variant) As Boolean
     Dim bResult         As Boolean
     If IsDate(vntDate) Then
       If (WeekDay(vntDate) Mod 6 = 1) Then bResult = True Else bResult = False
     Else
       Err.Raise 13, "Type Mismatch, Must Be Date"
     End If
     IsWeekend = bResult
End Function