XProfan

Deutsch

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Rundes Fenster erzeugen
Lauffähig ab Profan-Version 5.0
PRFellow - Vorlage
Zeigt, wie man ein rundes Fenster simuliert
Autor: Thomas Hölzer
Benötigt Profan 6.0 (32)
Def CreateEllipticRgn(4) !GDI32,CreateEllipticRgn
Def DeleteObject(1) !GDI32,DeleteObject
Def InvertRgn(2) !GDI32,InvertRgn
Def PaintRgn(2) !GDI32,PaintRgn
Def SetWindowRgn(3) !USER32,SetWindowRgn
Def ReleaseCapture(0) !USER32,ReleaseCapture

Proc DrawTime

    Declare t$
    Rectangle 120,140-190,160
    Let t$=Time$(0);:;Left$(Time$(1),2)
    DrawText 120,140,t$

EndProc

Declare ende%,rgn&,x%,move%
SetTrueColor 1
WindowStyle $78
WindowTitle Rundes Fenster
Window 0,0-300,300
Let rgn&=CreateEllipticRgn(0,0,300,300)
SetWindowRgn(%hwnd,rgn&,1)
Cls RGB(0,0,255)
UseFont Arial,20,0,0,0,0
UseBrush 1,RGB(0,0,255)
UsePen 5,0,0
TextColor RGB(255,255,255),-1
DrawText 80,80,Rechte Maustaste!
DrawTime
SetTimer 1000

WhileNot ende%

    WaitInput

    If %wmTimer

        DrawTime

        If move%

            SetWindowPos %hwnd=x%,0-300,300
            Add x%,10
            Case Gt(x%,%maxX):Let x%=0

        EndIf

    EndIf

    If Equ(%message,$204)

        CreateMenu
        AppendMenu 1, &Invertieren

        IF move%

            AppendMenu 2,&Anhalten

        Else

            AppendMenu 2, B&ewegen

        EndIf

        AppendMenu 3,&Farbe ändern
        Separator
        AppendMenu 4,&Beenden
        TrackMenu %MouseX,%MouseY

        If MenuItem(1)

            InvertRgn(%hdc,rgn&)

        Elseif Menuitem(2)

            Let move%=Not(move%)

        ElseIf MenuItem(3)

            Randomize
            Mit Region-Funktion:
            UseBrush 1,RGB(Rnd(256),Rnd(256),Rnd(256))
            PaintRgn(%hdc,rgn&)
            Das tuts freilich auch...
            Cls RGB(Rnd(256),Rnd(256),Rnd(256))
            DrawTime

        ElseIf MenuItem(4)

            Let ende%=1

        Endif

    Elseif Equ(%message,$201)

        UseCursor 5
        Sendmessage(%hwnd,$0112,$0F012,0);
        UseCursor 0
        ReleaseCapture()

    EndIf

Wend

KillTimer
SetWindowRgn(%hwnd,0,0)
DeleteObject(rgn&)
End