FlagPic

Private Sub MnuOpen_Click()
    Dim Msg$, Pos%, Rv&
    Dim OFN As OPENFILENAME
    With OFN
        .flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
        .hInstance = App.hInstance
        .hwndOwner = Me.hWnd
        .lpstrFile = String(MAX_PATH, 0)
        .lpstrFileTitle = String(MAX_PATH, 0)
        .lpstrFilter = "Bitmap Files (*.bmp)" & vbNullChar & "*.bmp" & vbNullChar
        .lpstrFilter = .lpstrFilter & "Gif Files (*.gif)" & vbNullChar & "*.gif" & vbNullChar
        .lpstrFilter = .lpstrFilter & "Jpg Files (*.jpg, *.jpeg)" & vbNullChar & "*.jpg;*.jpeg" & vbNullChar & vbNullChar
        .nFilterIndex = 1
        .lpstrTitle = "Flags - Open"
        .lStructSize = Len(OFN)
        .nMaxFile = MAX_PATH
        .nMaxFileTitle = MAX_PATH
    End With
    Rv = GetOpenFileName(OFN)
    DoEvents
    If Rv = 1 Then
        Pos = InStr(OFN.lpstrFile, vbNullChar)
        On Error GoTo OpenError
        PicImg.Picture = LoadPicture(Left(OFN.lpstrFile, Pos - 1))
        On Error GoTo 0
        StretchBlt PicStretch.hDC, 0, 0, 200, 150, PicImg.hDC, 0, 0, PicImg.Width, PicImg.Height, vbSrcCopy
        PicImg.Picture = LoadPicture()
    End If
    Exit Sub
    OpenError:
    Msg = "Unable to load image."
    MsgBox Msg, vbExclamation, "Flag - Error"
    Err.Clear
    Exit Sub
End Sub

Private Sub Tmr_Timer()
    PicSineWave.Cls
    For K = 0 To TWOPI Step Stp
        PicSineWave.PSet (K, Sin(K + N) + 5), &HFFFFFF
    Next
    N = N + 0.5
    PicBB.Cls
    BitBlt PicBB.hDC, 0, 0, 200, 150, PicSineWave.hDC, 0, 0, vbSrcCopy
    For Dx = 0 To pW
        For Dy = 0 To pH
            If GetPixel(PicBB.hDC, Dx, Dy) Then
                BitBlt PicBB.hDC, Dx, Dy, 1, 150, PicStretch.hDC, Dx, 0, vbSrcCopy
                Exit For
            End If
        Next
    Next
    If NewLeft + Xinc + 200 > ScaleWidth Then Xinc = -Xinc
    If NewLeft + Xinc < 0 Then Xinc = -Xinc
    If NewTop + Yinc + 200 > ScaleHeight Then Yinc = -Yinc
    If NewTop + Yinc < 0 Then Yinc = -Yinc
    NewLeft = NewLeft + Xinc
    NewTop = NewTop + Yinc
    PicDisplay.Move NewLeft, NewTop
    BitBlt PicDisplay.hDC, 0, 0, 200, 200, PicBB.hDC, 0, 0, vbSrcCopy
End Sub

Private Sub MnuExit_Click()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel%)
    Tmr.Enabled = 0
End Sub

Option Explicit
Private Dx%, Dy%
Private pW%, pH%
Private K!, N!, Stp!
Private Xinc%, Yinc%
Private NewLeft%, NewTop%
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function BitBlt& Lib "gdi32" (ByVal hDestDC&, ByVal x1&, ByVal y1&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)
Private Declare Function GetOpenFileName& Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME)
Private Declare Function GetPixel& Lib "gdi32" (ByVal ahDc&, ByVal x1&, ByVal y1&)
Private Declare Function SetStretchBltMode& Lib "gdi32" (ByVal ahDc&, ByVal nStretchMode&)
Private Declare Function StretchBlt& Lib "gdi32" (ByVal ahDc&, ByVal x1&, ByVal y1&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal nSrcWidth&, ByVal nSrcHeight&, ByVal dwRop&)
Private Const COLORONCOLOR = 3
Private Const MAX_PATH = 260
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const TWOPI = 6.28318530717959
Private Sub Form_Load()
Randomize
NewLeft = Rnd * (ScaleWidth - 200)
NewTop = Rnd * (ScaleHeight - 200)
PicDisplay.Move NewLeft, NewTop, 200, 200
Do
DoEvents
Xinc = Sgn(Rnd - Rnd) * 3
Yinc = Sgn(Rnd - Rnd) * 3
Loop Until Xinc <> 0 And Yinc <> 0
PicSineWave.Scale (0, 6)-(TWOPI, 0)
Stp = TWOPI / 200
pW = 199
pH = 199
MnuExit.Caption = "E&xit" & vbTab & "Alt+F4"
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) / 3
Me.BackColor = 0
SetStretchBltMode PicStretch.hDC, COLORONCOLOR
Tmr.Enabled = 1
End Sub

Private Sub MnuOpen_Click()
Dim Msg$, Pos%, Rv&
Dim OFN As OPENFILENAME
With OFN
.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
.hInstance = App.hInstance
.hwndOwner = Me.hWnd
.lpstrFile = String(MAX_PATH, 0)
.lpstrFileTitle = String(MAX_PATH, 0)
.lpstrFilter = "Bitmap Files (*.bmp)" & vbNullChar & "*.bmp" & vbNullChar
.lpstrFilter = .lpstrFilter & "Gif Files (*.gif)" & vbNullChar & "*.gif" & vbNullChar
.lpstrFilter = .lpstrFilter & "Jpg Files (*.jpg, *.jpeg)" & vbNullChar & "*.jpg;*.jpeg" & vbNullChar & vbNullChar
.nFilterIndex = 1
.lpstrTitle = "Flags - Open"
.lStructSize = Len(OFN)
.nMaxFile = MAX_PATH
.nMaxFileTitle = MAX_PATH
End With
Rv = GetOpenFileName(OFN)
DoEvents
If Rv = 1 Then
Pos = InStr(OFN.lpstrFile, vbNullChar)
On Error GoTo OpenError
PicImg.Picture = LoadPicture(Left(OFN.lpstrFile, Pos - 1))
On Error GoTo 0
StretchBlt PicStretch.hDC, 0, 0, 200, 150, PicImg.hDC, 0, 0, PicImg.Width, PicImg.Height, vbSrcCopy
PicImg.Picture = LoadPicture()
End If
Exit Sub
OpenError:
Msg = "Unable to load image."
MsgBox Msg, vbExclamation, "Flag - Error"
Err.Clear
Exit Sub
End Sub

Private Sub Tmr_Timer()
PicSineWave.Cls
For K = 0 To TWOPI Step Stp
PicSineWave.PSet (K, Sin(K + N) + 5), &HFFFFFF
Next
N = N + 0.5
PicBB.Cls
BitBlt PicBB.hDC, 0, 0, 200, 150, PicSineWave.hDC, 0, 0, vbSrcCopy
For Dx = 0 To pW
For Dy = 0 To pH
If GetPixel(PicBB.hDC, Dx, Dy) Then
BitBlt PicBB.hDC, Dx, Dy, 1, 150, PicStretch.hDC, Dx, 0, vbSrcCopy
Exit For
End If
Next
Next
If NewLeft + Xinc + 200 > ScaleWidth Then Xinc = -Xinc
If NewLeft + Xinc < 0 Then Xinc = -Xinc
If NewTop + Yinc + 200 > ScaleHeight Then Yinc = -Yinc
If NewTop + Yinc < 0 Then Yinc = -Yinc
NewLeft = NewLeft + Xinc
NewTop = NewTop + Yinc
PicDisplay.Move NewLeft, NewTop
BitBlt PicDisplay.hDC, 0, 0, 200, 200, PicBB.hDC, 0, 0, vbSrcCopy
End Sub

Private Sub MnuExit_Click()
Unload Me
End Sub

Private Sub Form_Unload(Cancel%)
Tmr.Enabled = 0
End Sub