XProfan

Drehbares Lesezeichen XProfan 11.2
13.09.2009 - Andreas Miethe
########################################
Bedienung Tastatur :
Pfeil links - Lesezeichen links drehen
Pfeil rechts - Lesezeichen rechts drehen
Pfeil runter - Lesezeichen nach unter
Pfeil hoh - Lesezeichen nach oben
Pos1(HOME) - Lesezeichen gerade richten
Bild runter - Lesezeichen schneller nach unten
Bild hoch - Lesezeichen schneller nach oben
Ende - Lesezeichen mittig ausrichten
Bedienung Maus :
Linke Taste über Lesezeichen gedrückt halten und
Lesezeichen verschieben.
##########################################
 $H Windows.ph
 $H Messages.ph
###############################
Strukturen
###############################
Struct RECT = left&,top&,right&,bottom&
Struct  XFORM =  eM11!,eM12!,eM21!,eM22!,eDx!,eDy!
Hintergrundbild
Var hPic& = Create("hPic",0,"&DSKBMP")
Var XStart& = 0
Var RgnStart& = 0
Var RgnEnd& = 0
Var RgnHeight& = 10
Var IsInvert& = 0
Var Oldmx& = 0
Var Oldmy& = 0
CLS ~GetSysColor(~COLOR_BTNFACE)
~MoveWindow(%hwnd,0,0,%maxx,%maxy,1)
~SetClassLong(%hwnd,~GCL_STYLE,(~GetClassLong(%hwnd,~GCL_STYLE)- ~CS_HREDRAW - ~CS_VREDRAW))
Useicon "A"
SetDialogFont ~GetStockObject(~ANSI_VAR_FONT)
Hintergrundbild anzeigen
DrawSizedPic hPic&,0,0-width(%hwnd),height(%hwnd);0
SubClassing einschalten
###############################
SubClass %HWnd, 1
###############################
Var Button& = Create("Button",%hwnd,"Ende",Width(%hwnd)-120,10,80,24)
Button vom Neuzeichnen ausnehmen, so kann die Region hinter den Button geschoben werden
###############################
Var Rect# = New(RECT)
~GetClientRect(Button&,Rect#)
~MapWindowpoints(Button&,%hwnd,Rect#,2)
~ExcludeClipRect(%hdc,Rect#.left&,Rect#.top&,Rect#.right&,rect#.bottom&)
Dispose rect#
Region erzeugen
Var DC& = ~CreateCompatibleDC(0)
~BeginPath(DC&)
~MoveToEx(DC&,0,RgnStart&,0)
~LineTo(DC&,Width(%hwnd),0)
~LineTo(DC&,Width(%hwnd),RgnHeight&)
~LineTo(DC&,0,RgnStart&+RgnHeight&)
~CloseFigure(DC&)
~EndPath(DC&)
Var hRgn& = ~PathToRegion(DC&)
~DeleteDC(DC&)
DrawRgn(1)

Proc UpdateRgn

    Parameters Richtung&
    Var DC& = ~CreateCompatibleDC(0)

    If Richtung& = 1

        Dec RgnStart&
        Inc RgnEnd&

    Elseif Richtung& = 2

        Inc RgnStart&
        Dec RgnEnd&
        Dec XStart&

    Endif

    ~BeginPath(DC&)

    If Richtung& = 3

        ~Rectangle(DC&,XStart&,RgnStart&,Width(%hwnd),RgnStart&+RgnHeight&)

    Elseif Richtung& = 4

        ~Rectangle(DC&,0,((Height(%hwnd)/2)-(RgnHeight&/2)),Width(%hwnd),((Height(%hwnd)/2)+(RgnHeight&/2)))

    Else

        ~MoveToEx(DC&,XStart&,RgnStart&,0)
        ~LineTo(DC&,Width(%hwnd),RgnEnd&)
        ~LineTo(DC&,Width(%hwnd),RgnEnd&+RgnHeight&)
        ~LineTo(DC&,XStart&,RgnStart&+RgnHeight&)

        If Richtung& = 1

            ~LineTo(DC&,0,RgnEnd&)

        Elseif Richtung& = 2

            ~LineTo(DC&,XStart&,RgnStart&+RgnHeight&)

        Endif

    Endif

    ~EndPath(DC&)
    ~DeleteObject(hRgn&)
    hRgn& = ~PathToRegion(DC&)
    ~DeleteDC(DC&)
    Repaint
    DrawRgn(0)

EndProc

Hautpschleife
#############
Var Ende& = 0

Whilenot Ende&

    Waitinput

    If (%key = 2) Or Clicked(Button&)

        ~DeleteObject(hPic&)
        Ende& = 1

    Endif

EndWhile

SubClassing-Procedur
###############################

SubClassProc

    If SubClassMessage(%hWnd, ~WM_MOUSEMOVE)

        If (~PtInRegion(hRgn&,Loword(&sLParam),HiWord(&sLParam))) And (IsInvert& = 0)

            DrawRgn(0)
            IsInvert& = 1

        ElseIf ((~PtInRegion(hRgn&,Loword(&sLParam),HiWord(&sLParam)))=0) And (IsInvert& = 1)

            DrawRgn(1)
            IsInvert& = 0

        Endif

        If &swParam = ~MK_LBUTTON

            If IsInvert& = 1

                Repaint
                ~OffsetRgn(hRgn&,0,Hiword(&sLParam)-OldmY&)
                DrawRgn(0)
                OldmX& = Loword(&sLParam)
                OldmY& = Hiword(&sLParam)

            Endif

        Endif

    Endif

    If SubClassMessage(%hWnd, ~WM_LBUTTONDOWN)

        If (~PtInRegion(hRgn&,Loword(&sLParam),HiWord(&sLParam))) and (IsInvert& = 1)

            DrawRgn(0)
            OldmX& = Loword(&sLParam)
            OldmY& = Hiword(&sLParam)
            UseCursor 10

        Endif

    Endif

    If SubClassMessage(%hWnd, ~WM_LBUTTONUP)

        If (~PtInRegion(hRgn&,Loword(&sLParam),HiWord(&sLParam))) and (IsInvert& = 1)

            DrawRgn(1)

        Endif

        UseCursor 0
        UpdateRgnBox()

    Endif

    If SubClassMessage(%hWnd, ~WM_KEYDOWN)

        Select &swParam

            Caseof ~VK_DOWN

            Repaint
            ~OffsetRgn(hRgn&,0,4)
            DrawRgn(0)
            UpdateRgnBox()

            Caseof ~VK_UP

            Repaint
            ~OffsetRgn(hRgn&,0,-4)
            DrawRgn(0)
            UpdateRgnBox()

            Caseof ~VK_NEXT

            Repaint
            ~OffsetRgn(hRgn&,0,40)
            DrawRgn(0)
            UpdateRgnBox()

            Caseof ~VK_PRIOR

            Repaint
            ~OffsetRgn(hRgn&,0,-40)
            DrawRgn(0)
            UpdateRgnBox()

            Caseof ~VK_LEFT

            UpdateRgn(2)

            Caseof ~VK_RIGHT

            UpdateRgn(1)

            Caseof ~VK_HOME

            UpdateRgn(3)
            UpdateRgnBox(1)

            Caseof ~VK_END

            UpdateRgn(4)
            UpdateRgnBox()

        Endselect

    Endif

    If SubClassMessage(%hWnd, ~WM_KEYUP)

        Repaint
        DrawRgn(1)

    Endif

EndProc

###############################

Proc UpdateRgnBox

    Var RgnBox# = New(RECT)
    ~GetRgnBox(hRgn&,RgnBox#)

    If &(1)= 1

        RgnStart& = RgnBox#.Top&
        RgnEnd& = RgnBox#.Bottom&+RgnHeight&

    Else

        RgnStart& = RgnBox#.Bottom&-RgnHeight&
        RgnEnd& = RgnBox#.Top&

    Endif

    Dispose RgnBox#

EndProc

Proc DrawRgn

    Parameters F&

    If F& = 1

        UseBrush 1,$8080FF
        ~PaintRgn(%hdc,hRgn&)
        ~FrameRgn(%hdc,hRgn&,~GetStockObject(~BLACK_BRUSH),1,1)

    Else

        UseBrush 1,$FF
        ~PaintRgn(%hdc,hRgn&)
        ~FrameRgn(%hdc,hRgn&,~GetStockObject(~BLACK_BRUSH),1,1)

    Endif

ENDPROC