XProfan

'ampsoft(Andreas Miethe)
'Webcams mit Überblendeffekten
Dim% 10000
Declare w1%,h1%,xx%,x1%,y1%
Var breite%   = 640
Var hoehe%    = 480
Var XPlus%    = External("User32.dll","GetSystemMetrics",7)
Var YPlus%    = External("User32.dll","GetSystemMetrics",8)
Var YCaption% = External("User32.dll","GetSystemMetrics",4)
WindowStyle 536
WINDOW breite%+(XPlus%*2)6,hoehe%+((YPlus%*2)+YCaption%)
CLS 0
Randomize
breite% = width(%hwnd)
hoehe%  = height(%hwnd)
Var l1%=Create("List",0)
Var l2%=Create("List",0)
Var w% = breite%
Var h% = hoehe%
MCLS w%,h%
Var Pic& = 0
Var A&=1
Var E&=0
LC()
Settimer 15000

WhileNot E&

    WaitInput

    If %wmtimer:LC():EndIf

        If %key=2:E&=1:EndIf

            If %MouseKey = 2

                CreateMenu
                AppendMenu 100,"TimeOut 10 Sekunden"
                AppendMenu 101,"Timeout 15 Sekunden"
                AppendMenu 102,"Timeout 20 Sekunden"
                AppendMenu 103,"Timeout 30 Sekunden"
                AppendMenu 104,"Timeout  1 Minute"
                Separator
                AppendMenu 105,"Ende"
                TrackMenu %MouseX,%Mousey

                If MenuItem(100) : Killtimer:Settimer 10000:Endif

                    If MenuItem(101) : Killtimer:Settimer 15000:Endif

                        If MenuItem(102) : Killtimer:Settimer 20000:Endif

                            If MenuItem(103) : Killtimer:Settimer 30000:Endif

                                If MenuItem(104) : Killtimer:Settimer 60000:Endif

                                    If MenuItem(105) : E& = 1::Endif

                                    EndIf

                                EndWhile

                                Killtimer
                                External("Kernel32.dll","DeleteFileA",$TempDir+"~~~B.jpg")

                                Proc LC

                                    External("Kernel32.dll","DeleteFileA",$TempDir+"~~~B.jpg")

                                    If a& < 5

                                        Var u$="https://www.bicos.de/webcam/webcam"+str$(A&)+".jpg"
                                        WindowTitle "Bielefeld "+str$(A&)

                                    ElseIf a& = 5

                                        Var u$="https://www.berlin.de/webcams/_img/webcam/alex.jpg"
                                        WindowTitle "Berlin"

                                    ElseIf a& = 6

                                        Var u$ = "https://www.opentopia.com/images/data/cams/14271/big.jpg"
                                        WindowTitle "Washington"

                                    ElseIf a& = 7

                                        Var u$ = "https://129.171.33.49/jpg/image.jpg"
                                        WindowTitle "Miami"

                                    ElseIf a& = 8

                                        Var u$ = "https://abclocal.go.com/three/kabc/webcam/web1-1.jpg"
                                        WindowTitle "Long Beach LA"

                                    ElseIf a& = 9

                                        Var u$ = "https://www.esrl.noaa.gov/gmd/webdata/spo/webcam/medium.jpg"
                                        WindowTitle "Südpol"

                                    EndIf

                                    Downloadfile(u$,$TempDir+"~~~B.jpg")

                                    While %Loading

                                        Sleep 1

                                    EndWhile

                                    If &BytesRead > 0

                                        Pic& =Create("hPic", -1, $TempDir+"~~~B.jpg")

                                        If Pic& <> 0

                                            StartPaint -1
                                            DrawSizedPic Pic&,0,0-w%,h%;0
                                            EndPaint
                                            DeleteObject Pic&

                                            Select a&

                                                CaseOf 1,5

                                                OSchnitt()

                                                CaseOf 2,6

                                                LSchnitt()

                                                CaseOf 3,8

                                                LRzeilen()
                                                OTHERWISE
                                                Pixel()

                                            EndSelect

                                        Else

                                            CLS 0
                                            TextColor $00CCFF,-1
                                            DrawText 250,230,"Bild momentan nicht ladbar"

                                        EndIf

                                    Else

                                        CLS 0
                                        TextColor $00CCFF,-1
                                        DrawText 250,230,"Bild momentan nicht ladbar"

                                    EndIf

                                    Inc A&

                                    If A&=10

                                        A&=1

                                    EndIf

                                EndProc

                                Proc Pixel

                                    RECHNE(80)
                                    xx%=0

                                    WhileNot getcount(l1%)=0

                                        xx%=rnd(getcount(l1%))
                                        x1%=val(substr$(GetString$(l1%,xx%),1,","))
                                        y1%=val(substr$(GetString$(l1%,xx%),2,","))
                                        MCopyBmp X1%,Y1%-w1%,h1% > X1%,Y1%;0
                                        DeleteString(l1%,xx%)

                                    EndWhile

                                EndProc

                                Proc OSchnitt

                                    Var z%=0
                                    Var adder% = 0

                                    WhileNot z%=30

                                        WhileNot adder% > hoehe%

                                            MCopyBmp 0,(z%+adder%)-w%,1 > 0,(z%+adder%),0;0
                                            Inc adder%,30

                                        EndWhile

                                        adder% = 0
                                        Inc z%
                                        Sleep 1

                                    EndWhile

                                EndProc

                                Proc LSchnitt

                                    Var z%=0
                                    Var adder% = 0

                                    whileloop 0,40

                                        whileloop 0,w%,40

                                            MCopyBmp (z%+&loop),0-1,h% > (z%+&loop),0;0

                                        EndWhile

                                        Inc z%
                                        Sleep 1

                                    endwhile'

                                EndProc

                                Proc LRZeilen

                                    Var z1%=w%
                                    Var z%=0

                                    WhileNot z%>w%

                                        MCopyBmp z%,0-4,h% > z%,0;0
                                        MCopyBmp z1%,0-4,h% > z1%,0;0
                                        Sleep 1
                                        Add z%,4
                                        dec z1%,4

                                    EndWhile

                                EndProc

                                Proc Rechne

                                    PARAMETERS teiler%
                                    w1% = w%\Teiler%
                                    h1% = h%\Teiler%
                                    Var zahl1%=0
                                    Var zahl2%=0
                                    Var a%=0
                                    Var b%=Teiler%
                                    xx%=0

                                    While zahl1%<w%

                                        List% a%=zahl1%
                                        Inc a%
                                        Add zahl1%,w1%

                                    EndWhile

                                    While zahl2%<h%

                                        List% b%=zahl2%
                                        Inc b%
                                        Add zahl2%,h1%

                                    EndWhile

                                    Declare liste$
                                    Clearlist
                                    a%=0
                                    b%=teiler%

                                    WhileNot a%>teiler%-1

                                        WhileNot xx%>teiler%-1

                                            AddString str$(list%(a%))+","+str$(list%(b%))
                                            Inc b%
                                            Inc xx%

                                        EndWhile

                                        xx%=0
                                        b%=teiler%
                                        Inc a%

                                    EndWhile

                                    movelisttohandle(l1%)                                  movelisttohandle(l2%)

                                EndProc