XProfan

'##########################
'XProfan
'##########################
'Andreas Miethe
'Juli 2003
'##########################
 $H windows.ph
 $H structs.ph
 $H messages.ph
 $H commctrl.ph
 $H shellapi.ph
 $I profalt.inc
settruecolor 1

PROC ScrollWinMainProc

    PROC Max

        Parameters a&,b&

        IF a& > b&

            RETURN a&

        else

            RETURN b&

        endif

    EndProc

    PROC Min

        Parameters a&,b&

        IF a& > b&

            RETURN b&

        else

            RETURN a&

        endif

    EndProc

    Declare MinMax#
    DIM MinMax#,40
    DEF HiWord(1) Div&(&(1),$10000)
    DEF LoWord(1) And(&(1),$FFFF)
    declare srcDC&,trgDC&,Disp$,windc&
    declare ScrollInit&,HscrollPos&,HscrollMax&,VscrollPos&,VscrollMax&
    declare thumb&
    STRUCT SWindowClass = ~WndClass
    STRUCT SMsg = ~Msg
    STRUCT Sbmp = ~BITMAP
    Declare bmp#
    Declare Msg#,WindowClass#,Appname$
    Declare ImageControl&,Image&,Image$
    DIM bmp#,sbmp
    AppName$ = "ScrollDemo"
    set("FastMode",1)

    PROC WindowCallback

        parameters Wnd&, uMsg&, WParam&, LParam&

        IF uMsg& = ~WM_GETMINMAXINFO

            'Fenstergrösse einschränken
            MinMax# = lParam&
            Long MinMax#,24 = 320'Min-Breite
            Long MinMax#,28 = 240'Min-Höhe
            Long MinMax#,32 = 640'Max-Breite
            Long MinMax#,36 = 480'Max-Höhe
            RETURN 0

        Endif

        IF uMsg& = ~wm_create

            'Fenster wird angelegt
            'Screenshot erzeugen und ins Temp-Bitmap blitten
            Disp$ = "DISPLAY"
            srcDC& = ~CreateDC(addr(disp$),0,0,0)
            trgDC& = ~CreateCompatibleDC(srcdc&)
            Image& = ~CreateCompatibleBitmap(srcdc&,%maxx,%maxy)
            ~selectObject(trgdc&,Image&)
            ~BitBlt(trgdc&, 0,0 , %maxx,%maxy,srcdc&,0,0,~SRCCOPY)
            'Bitmap-Daten ermitteln
            ~GetObject(Image&,24,bmp#)

        endif

        IF uMsg& = ~wm_size

            'wird das Fenster vergrössert oder verkleinert ?
            'ScrollInit& = 1
            VscrollMax& = bmp#.bmHeight&-height(wnd&)
            ~SetScrollRange(Wnd&,~SB_VERT,0,VscrollMax&,0)
            HscrollMax& = bmp#.bmWidth&-width(wnd&)
            ~SetScrollRange(Wnd&,~SB_HORZ,0,HscrollMax&,0)
            ~BitBlt(windc&,(hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)
            SendMessage(Wnd&,~wm_Vscroll,0,0)Update
            SendMessage(Wnd&,~wm_Hscroll,0,0)Update

        endif

        IF uMsg& = ~wm_vscroll

            'es wird vertikal gescrollt

            IFNOT ScrollInit&

                ScrollInit& = 1
                VscrollMax& = bmp#.bmHeight&-height(wnd&)
                ~SetScrollRange(Wnd&,~SB_VERT,0,VscrollMax&,0)
                ~SetScrollPos(Wnd&,~SB_VERT,VscrollPos&,1)
                HscrollMax& = bmp#.bmWidth&-width(wnd&)
                ~SetScrollRange(Wnd&,~SB_HORZ,0,HscrollMax&,0)
                ~SetScrollPos(Wnd&,~SB_HORZ,hscrollPos&,1)

            endif

            IF LOWORD(wParam&) = ~SB_LINEUP

                VscrollPos& = VScrollPos& -4

                IF VscrollPos&<0

                    VscrollPos& = 0
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

                IF VscrollPos&>0

                    ~ScrollWindowEx(Wnd&,0,4,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_LINEDOWN

                VscrollPos& = VScrollPos& + 4

                IF VscrollPos&>VscrollMax&

                    VscrollPos& = VscrollMax&
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

                IF VscrollPos&<VscrollMax&

                    ~ScrollWindowEx(Wnd&,0,-4,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&,(hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_PAGEUP

                IF VscrollPos& < 16

                    VscrollPos& = 0
                    ~ScrollWindowEx(Wnd&,0,VscrollPos&,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                else

                    VscrollPos& = VscrollPos&-16
                    ~ScrollWindowEx(Wnd&,0,16,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1),(vscrollpos& * -1), %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_PAGEDOWN

                VscrollPos& = VScrollPos& +16

                IF VscrollPos&>VscrollMax&

                    VscrollPos& = VscrollMax&
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

                IF VscrollPos&<VscrollMax&

                    ~ScrollWindowEx(Wnd&,0,-16,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_THUMBTRACK

                Thumb& = HIWORD(wParam&)

                IF Thumb&>VscrollPos&

                    ~ScrollWindowEx(Wnd&,0,-(Thumb&),0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1),-(Thumb&), %maxx,%maxy,trgdc&,0,0,~SRCCOPY)
                    VscrollPos& = Thumb&

                endif

                IF Thumb&<VscrollPos&

                    ~BitBlt(windc&, (hscrollpos& * -1),-(Thumb&), %maxx,%maxy,trgdc&,0,0,~SRCCOPY)
                    VscrollPos& = Thumb&

                endif

            endif

            ~UpdateWindow(wnd&)
            VscrollPos& = Min(VscrollPos&,VscrollMax&)
            VscrollPos& = Max(0,VscrollPos&)
            ~SetScrollPos(Wnd&,~SB_VERT,VscrollPos&,1)
            RETURN 0

        endif

        IF uMsg& = ~wm_hscroll

            'es wird horizontal gescrollt

            IFNOT ScrollInit&

                ScrollInit& = 1
                VscrollMax& = bmp#.bmHeight&-height(wnd&)
                ~SetScrollRange(Wnd&,~SB_VERT,0,VscrollMax&,0)
                ~SetScrollPos(Wnd&,~SB_VERT,VscrollPos&,1)
                HscrollMax& = bmp#.bmWidth&-width(wnd&)
                ~SetScrollRange(Wnd&,~SB_HORZ,0,HscrollMax&,0)
                ~SetScrollPos(Wnd&,~SB_HORZ,hscrollPos&,1)

            endif

            IF LOWORD(wParam&) = ~SB_LINEUP

                'hscrollPos& = hScrollPos& - 4

                IF hscrollPos&<0

                    hscrollPos& = 0
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

                IF hscrollPos&>0

                    ~ScrollWindowEx(Wnd&,4,0,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_LINEDOWN

                hscrollPos& = hScrollPos& +4

                IF hscrollPos&>hscrollMax&

                    hscrollPos& = hscrollMax&
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

                IF hscrollPos&<hscrollMax&

                    ~ScrollWindowEx(Wnd&,-4,0,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_PAGEUP

                IF hscrollPos& < 16

                    hscrollPos& = 0
                    ~ScrollWindowEx(Wnd&,hscrollPos&,0,,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                else

                    hscrollPos& = hscrollPos&-16
                    ~ScrollWindowEx(Wnd&,16,0,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_PAGEDOWN

                hscrollPos& = hScrollPos& +16

                IF hscrollPos&>hscrollMax&

                    hscrollPos& = hscrollMax&
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

                IF hscrollPos&<hscrollMax&

                    ~ScrollWindowEx(Wnd&,-16,0,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, (hscrollpos& * -1), (vscrollpos& * -1) , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)

                endif

            endif

            IF LOWORD(wParam&) = ~SB_THUMBTRACK

                Thumb& = HIWORD(wParam&)

                IF Thumb&>hscrollPos&

                    ~ScrollWindowEx(Wnd&,-(Thumb&-hscrollPos&),0,,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, -(Thumb&),(vscrollpos& * -1), %maxx,%maxy,trgdc&,0,0,~SRCCOPY)
                    hscrollPos& = Thumb&

                endif

                IF Thumb&<hscrollPos&

                    ~ScrollWindowEx(Wnd&,-(Thumb&-hscrollPos&),0,,0,0,0,0,~SW_INVALIDATE)
                    ~BitBlt(windc&, -(Thumb&),(vscrollpos& * -1), %maxx,%maxy,trgdc&,0,0,~SRCCOPY)
                    hscrollPos& = Thumb&

                endif

            endif

            ~UpdateWindow(wnd&)
            hscrollPos& = Min(hscrollPos&,hscrollMax&)
            hscrollPos& = Max(0,hscrollPos&)
            ~SetScrollPos(Wnd&,~SB_HORZ,hscrollPos&,1)
            RETURN 0

        endif

        IF uMsg& = ~wm_close

            ~UnRegisterClass(WindowClass#,%hinstance)
            DISPOSE bmp#
            DISPOSE msg#
            DISPOSE WindowClass#
            DISPOSE MinMax#
            ~DeleteDC(srcdc&)
            ~DeleteDC(trgdc&)
            ~DeleteObject(Image&)
            ~PostQuitMessage(0)

        endif

        RETURN ~DefWindowProc(Wnd&, uMsg&, WParam&, LParam&)

    endproc

    PROC ScrollWinMain

        declare Window&,Icon$,Message&
        Icon$ = "A"
        DIM WindowClass#,SWindowClass
        DIM Msg#,SMsg

        WITH WindowClass#

            .style& = 0
            .lpfnWndProc& = ProcAddr(WindowCallback,4)
            .cbClsExtra& = 0
            .cbWndExtra& = 0
            .hInstance& = %HInstance
            .hIcon& = ~LoadIcon(%hInstance,addr(icon$))
            .hCursor& = ~LoadCursor(0, ~idc_Arrow)
            .hbrBackground& = ~CreateSolidBrush(~GetSysColor(~COLOR_BTNFACE))
            .lpszMenuName& = Addr(AppName$)
            .lpszClassName& = Addr(AppName$)

        endwith

        IF ~RegisterClass(WindowClass#) = 0

            Text1$ = "Fehler"
            Text2$ = "Fenster konnte nicht registriert werden!"
            ~MessageBox(0,Addr(Text2$),Addr(Text1$),0)
            end

        endif

        Window& = ~CreateWindowEx($80,Addr(AppName$),Addr(AppName$),\
        or(or(or(or(~ws_visible,~ws_vscroll),~ws_sysmenu),~ws_hscroll),~ws_sizebox),\
        10,10,320,240,0,0,%HInstance,0)
        windc& = ~GetDC(window&)
        ~BitBlt(windc&, 0,0 , %maxx,%maxy,trgdc&,0,0,~SRCCOPY)
        ~ShowWindow(Window&, ~sw_ShowNormal)
        ~UpdateWindow(Window&)
        ~setwindowpos(window&,~HWND_TOPMOST,0,0,0,0,or(~SWP_NOMOVE,~SWP_NOSIZE))

        WHILE ~GetMessage(Msg#, 0, 0, 0) > 0

            ~TranslateMessage(Msg#)
            ~DispatchMessage(Msg#)

        endwhile

        end

    endproc

    ScrollWinmain

endproc

ScrollWinMainProc