Option Explicit
'Function: FillRectEx
'Autor Leandro Ascierto
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long

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

Private Declare Function GetTickCount& Lib "kernel32" ()

Private Sub Pintar()
Dim x As Long
Dim y As Long

Do While y < Me.ScaleHeight
    Do While x < Me.ScaleWidth
        BitBlt Me.hdc, x, y, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hdc, 0, 0, vbSrcCopy
        x = x + Picture1.ScaleWidth
    Loop
    y = y + Picture1.ScaleHeight
    x = 0
Loop

End Sub

Private Sub Form_Load()
Me.Show
DoEvents
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Form_Resize
End Sub

Private Sub Form_Resize()
Dim i As Integer
Dim lTime As Long

'lTime = GetTickCount&
'For i = 0 To 100
    FillRectEx Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
    'call Pintar
'Next

'Debug.Print GetTickCount& - lTime
End Sub


Private Sub FillRectEx(DestDC As Long, DestX As Long, DestY As Long, DestWidth As Long, DestHeight As Long, SrcDC As Long, SrcX As Long, SrcY As Long, SrcWidth As Long, SrcHeight As Long)
        Dim DC As Long
        Dim hDCMemory As Long
        Dim hBmp As Long
        Dim mBrush As Long
        Dim Rec As RECT

        DC = GetDC(0)
        hDCMemory = CreateCompatibleDC(0)
        hBmp = CreateCompatibleBitmap(DC, SrcWidth, SrcHeight)
        Call SelectObject(hDCMemory, hBmp)
        BitBlt hDCMemory, 0, 0, SrcWidth, SrcHeight, SrcDC, SrcX, SrcY, vbSrcCopy
        mBrush = CreatePatternBrush(hBmp)
        SetRect Rec, DestX, DestY, DestWidth + DestX, DestHeight + DestY
        FillRect DestDC, Rec, mBrush
        
        DeleteObject mBrush
        DeleteObject hBmp
        DeleteDC DC
        DeleteDC hDCMemory
End Sub

 Option Explicit
Private Declare Function EndTask Lib "user32.dll" (ByVal hwnd As Long, ByVal fShutDown As Long, ByVal fForce As Long) As Long

Private Sub Command1_Click()
EndTask Me.hwnd, 0, 0
End Sub

Option Explicit
Private Const WM_SETREDRAW As Long = &HB
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long

Private Sub Form_Load()
Timer1.Interval = 5000
SendMessage GetDesktopWindow, WM_SETREDRAW, 0, ByVal 0
End Sub

Private Sub Timer1_Timer()
    SendMessage GetDesktopWindow, WM_SETREDRAW, 1, ByVal 0
End Sub

Option Explicit

Private Const PM_REMOVE = &H1

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type Msg
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean

Private Const WM_MOUSEWHEEL = 522

Private Sub ProcessMessages()
Dim Message As Msg
Do While bCancel = False
    WaitMessage
    If PeekMessage(Message, Me.hwnd, WM_MOUSEWHEEL, WM_MOUSEWHEEL, PM_REMOVE) Then
         If Message.wParam < 0 Then
            Debug.Print "Scroll Down"
        Else
            Debug.Print "Scroll Up"
        End If
    End If
    DoEvents
    Loop
End Sub

Private Sub Form_Load()
Me.Show
ProcessMessages
End Sub

Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
End Sub

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Type Datos
    Nombre As String
    Apellido As String
End Type

Dim dPersona() As Datos
Dim lCount As Long

Private Sub Command1_Click()
    AddList "bbb", "bbb"
    ImprimirListado
End Sub

Private Sub Form_Load()
    Me.Show
    ReDim dPersona(0)
    
    AddList "aaa", "aaa"
    AddList "bbb", "bbb"
    AddList "ccc", "ccc"
    AddList "ddd", "ddd"
    AddList "fff", "fff"
    
    ImprimirListado
End Sub

Private Sub ImprimirListado()
    Dim i As Long
    Cls
    For i = 0 To lCount
        Print dPersona(i).Nombre, dPersona(i).Apellido
    Next
End Sub

Private Sub AddList(Nombre As String, Apellido As String)
Dim i As Integer
Dim Ubicado As Boolean

lCount = UBound(dPersona)

If lCount = 0 Then
    dPersona(lCount).Nombre = Nombre
    dPersona(lCount).Apellido = Apellido
Else
    For i = 0 To lCount
        If Nombre < dPersona(i).Nombre Then
            'deberia copiar toda la matriz desde dPersona(i) a al siguiente dPersona(i + 1) todo el resto
            'de la extructura, pero no funciona :(
            CopyMemory ByVal dPersona(i + 1), ByVal dPersona(i), 8 * (lCount - i)
            'luego depositaria los nuevos datos en dPersona(i)
            dPersona(i).Nombre = Nombre
            dPersona(i).Apellido = Apellido
            
            Ubicado = True
            Exit For
        End If
    Next
    
    If Ubicado = False Then
        dPersona(lCount).Nombre = Nombre
        dPersona(lCount).Apellido = Apellido
    End If
End If

ReDim Preserve dPersona(lCount + 1)
End Sub