XProfan

' 4k-Wettbewerb 2013 @Donnie71

Proc GLScene

    oGL("Init", %hWnd, 0.0, 0.0, 0, 1)
    oGL("PosMode", 1)
    oGL("BlendMode", 1)
    textur% = oGL("GetTextureBMP",bild&, 2)
    texturb% = oGL("GetTextureBMP", dskBMP&, 3)
    'Hintergrund und Ringe erstellen
    box# = new(oglSprite)
    Ringe(box#, "TUBE", 0,0,-65, 1,1,1, texturb%, 40,40,40,360)

    with box#

        .rotx! = 0
        .rotz! = 0
        .rotdy! = 36
        .dtick& = 1000
        .alpha! = 0.6

    endwith

    zy0# = new(oglSprite)
    Ringe(zy0#, "CYLINDER", 0,0,0, 0.5,0.5,0.5, 0, 2.2,2.2,6,24)
    zy0#.alpha! = 0.7
    zy1# = new(oglSprite)
    Ringe(zy1#, "TUBE", 2.4,0,0, 1,1,1, textur%, 2.4,2.4,0.6,24)
    zy2# = new(oglSprite)
    Ringe(zy2#, "TUBE", 1.7,0,0, 1,1,1, textur%, 2.4,2.4,0.6,24)
    zy3# = new(oglSprite)
    Ringe(zy3#, "TUBE", 0.35,0,0, 1,1,1, textur%, 2.4,2.4,0.6,24)
    zy4# = new(oglSprite)
    Ringe(zy4#, "TUBE", -0.35,0,0, 1,1,1, textur%, 2.4,2.4,0.6,24)
    zy5# = new(oglSprite)
    Ringe(zy5#, "TUBE", -1.7,0,0, 1,1,1, textur%, 2.4,2.4,0.6,24)
    zy6# = new(oglSprite)
    Ringe(zy6#, "TUBE", -2.4,0,0, 1,1,1, textur%, 2.4,2.4,0.6,24)
    ende% = 0

EndProc

'Ringe(Bereich, Type, PosX,PosY,PosZ, ColorR,ColorG,ColorB, Textur, X,Y,Z,B)

proc Ringe

    Parameters nAme#, tYpe$, pX!,pY!,pZ!, cR!,cG!,cB!, tExtur%, xX!, yY!, zZ!, bB!

    with nAme#

        .typ$ = tYpe$
        .posx! = pX!
        .posy! = pY!
        .posz! = pZ!
        .colorr! = cR!
        .colorg! = cG!
        .colorb! = cB!
        .rotx!    = 197
        .rotz!    = 90
        .alpha!   = 0.7
        .textur& = tExtur%
        .x! = xX!
        .y! = yY!
        .z! = zZ!
        .b! = bB!

    endwith

endproc

proc DrawGLScene

    oGL("Clear")
    oGL("Origin",0,0,-5.1)
    oGL("Color",0,1,0,0.9)
    oGL("Quad",5.8,1.4)
    oGL("Origin", 0, 0, -7)
    oGL("Draw", box#)
    oGL("Draw", zy1#)
    oGL("Draw", zy2#)
    oGL("Draw", zy3#)
    oGL("Draw", zy4#)
    oGL("Draw", zy5#)
    oGL("Draw", zy6#)
    oGL("Draw", zy0#)

    proc Scheibe

        oGL("Color", 0, 1, 0.0, 0.8)
        oGL("Disk", 0, 0.1, 12)

    endproc

    oGL("Origin", -1 , -0.2, -4.5)
    Scheibe
    oGL("Origin", -1 , 0.2, -4.5)
    Scheibe
    oGL("Origin", 1 , -0.2, -4.5)
    Scheibe
    oGL("Origin", 1 , 0.2, -4.5)
    Scheibe
    oGL("Show")

endproc

declare ende%, zy0#, zy1#, zy2#, zy3#, zy4#, zy5#, zy6#, box#, textur%, texturb%, x!
declare Zeit$, Sek$, St$, Min$, s0!,  s1!,  m0!, m1!, h0!, h1!, xE!,yE!,wE!,hE!
'Textur für HintergrundZylinder erstellen
var dskBMP& = Create("hNewPic",40,40,Rgb(255,255,255))
Randomize
StartPaint dskBMP&

WhileLoop 20

    xE! = Rnd(40)
    yE! = Rnd(40)
    wE! = xE! + 40
    hE! = yE! + 40
    UsePen 0,5,Rgb(rnd(255),rnd(255), rnd(255))
    UseBrush 1,Rgb(rnd(255),rnd(255), rnd(255))
    Ellipse xE!,yE! - wE!,wE!

EndWhile

EndPaint
'Textur für Ringe erstellen
var bild& = Create("hNewPic", 500, 50, 31)
StartPaint bild&
TextColor @RGB(0,255,0),-1
set("Orientation", -900)
UseFont "Arial", 50, 40,0,0,0

whileLoop 0,10

    Drawtext x!,1, &loop-1
    x! = x! + 50

EndWhile

EndPaint
windowTitle "Uhr"
windowStyle 512 + 16 + 64
window %MaxX - 350, 10 - 170, 110
UseIcon "A"
GLScene
setTimer 100
'Hauptschleife

WhileNot ende%

    WaitInput

    SELECT %MouseKey

        CASEOF 1

        UseCursor 5
        SendMessage(%hwnd,$112,$F012,0)
        UseCursor 0

        CASEOF 2

        Case MessageBox("Soll die Uhr beendet werden?","Uhr Beenden?",33) = 1 : ende% = 1

    ENDSELECT

    Sek$ = Left$(Time$(1),2)
    s0! = Val(Left$(Sek$,1))*36+197
    s1! = Val(Right$(Sek$,1))*36+197
    zy1#.rotx! = s1!
    zy2#.rotx! = s0!
    Zeit$ = Time$(0)
    St$ = Left$(Zeit$,2)
    Min$ = Right$(Zeit$,2)
    m0! = Val(Left$(Min$,1))*36+197
    m1! = Val(Right$(Min$,1))*36+197
    s0! = Val(Left$(St$,1))*36+197
    s1! = Val(Right$(St$,1))*36+197
    zy3#.rotx! = m1!
    zy4#.rotx! = m0!
    zy5#.rotx! = s1!
    zy6#.rotx! = s0!
    DrawGLScene()

EndWhile

DeleteObject textur%
DeleteObject texturb%
oGL("Done")
killTimer
end