XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Fenster horizontal splitten und scrollen
#############################
XProfan
#############################
Author : Andreas Miethe
2003
#############################
Thema : Horizontal-Splitter
#############################
SetTrueColor 1
set(FastMode,1)
------------------------
Header-Dateien einbinden
------------------------
 $H windows.ph
 $H structs.ph
 $H messages.ph
------------------------
------------------------
Definitionen
------------------------
DEF HiWord(1) And(&(1)>>16,$FFFF)
DEF LoWord(1) And(&(1),$FFFF)
DEF MakeLong(2) Or(&(1),&(2)<<16)
------------------------
------------------------
Strukturen
------------------------
STRUCT MyWindowClass = ~WndClass
STRUCT MyMsg = ~Msg
STRUCT rect = ~RECT
------------------------
Declare hCursor&,Classname$,WindowTitle$,WindowIcon$
Declare WindowClass#, Msg#, Size#

PROC WindowProc

    parameters Wnd&, Msg&, wParam&, lParam&

    IF Msg& = ~WM_SIZE

        IF HIWORD(lParam&) < dwSplitterPos&

            dwSplitterPos& = HIWORD(lParam&)-10

        Endif

        ~MoveWindow(Edit1&, 0, 0, LOWORD(lParam&), dwSplitterPos& , 1)
        ~MoveWindow(Edit2&, 0, dwSplitterPos&+4, LOWORD(lParam&),HIWORD(lParam&) - dwSplitterPos& -4, 1)

    Endif

    IF Msg& = ~WM_MOUSEMOVE

        Declare rect#
        DIM rect#,rect

        IF HIWORD(lParam&) > 40

            ~SetCursor(hCursor&)

            IF wParam& = ~MK_LBUTTON

                ~GetClientRect(Wnd&, rect#)

                IF (HIWORD(lParam&) > rect#.bottom& -40)

                    RETURN 0

                ENDIF

                dwSplitterPos& = HIWORD(lParam&)
                ~SendMessage(Wnd&,~WM_SIZE, 0, MAKELONG(rect#.right&, rect#.bottom&))
                ~UpdateWindow(Edit1&)
                ~UpdateWindow(Edit2&)

            ENDIF

        ENDIF

        DISPOSE Rect#

    ENDIF

    IF Msg& = ~WM_LBUTTONDOWN

        ~SetCursor(hCursor&)
        bSplitterMoving& = 1
        ~SetCapture(Wnd&)

    Endif

    IF Msg& = ~WM_LBUTTONUP

        ~ReleaseCapture()
        bSplitterMoving& = 0

    Endif

    IF Msg& = ~WM_CLOSE

        ~DeleteObject(hCursor&)
        Messagebox(und Tschüss !,Ende,64)
        ~PostQuitMessage(0)

    endif

    RETURN ~DefWindowProc(Wnd&, Msg&, wParam&, lParam&)

endproc

PROC Main

    Declare Ende&,Edit1&,Edit2&,bSplitterMoving&,dwSplitterPos&,Window&
    DIM WindowClass#,MyWindowClass
    DIM Msg#,MyMsg
    Classname$ = XPrfWndClass
    WindowTitle$ = H-Splitter
    WindowIcon$ = A

    WITH WindowClass#

        .style& = 0
        .lpfnWndProc& = ProcAddr(WindowProc,4)
        .cbClsExtra& = 0
        .cbWndExtra& = 0
        .hInstance& = %HInstance
        .hIcon& = ~LoadIcon(%hInstance,Addr(WindowIcon$))
        .hCursor& = ~LoadCursor(0, ~IDC_ARROW)
        .hbrBackground& = ~CreateSolidBrush(~GetSysColor(~COLOR_BTNFACE))
        .lpszMenuName& = Addr(Classname$)
        .lpszClassName& = Addr(Classname$)

    EndWith

    IF ~RegisterClass(WindowClass#) = 0

        MessageBox(Fehler beim Registrieren der Anwendung !,Fehler...,16)
        End

    Endif

    Window& = ~CreateWindowEx(
    0,
    Addr(Classname$),
    Addr(WindowTitle$),
    ~ws_OverlappedWindow,
    ~cw_UseDefault,
    ~cw_UseDefault,
    640,
    480,
    0,
    0,
    %HInstance,
    0)
    Edit1& = ~CreateWindowEx(~WS_EX_CLIENTEDGE,edit, 0,OR(OR(OR(OR(~WS_CHILD,~WS_VISIBLE),~WS_CLIPSIBLINGS),~ES_MULTILINE),~WS_VSCROLL),0, 0, width(window&), Height(window&)/2, window&, 1001,%hInstance,0)
    Edit2& = ~CreateWindowEx(~WS_EX_CLIENTEDGE,edit, 0,OR(OR(OR(OR(~WS_CHILD,~WS_VISIBLE),~WS_CLIPSIBLINGS),~ES_MULTILINE),~WS_VSCROLL),0, Height(Edit1&)+6, width(window&), Height(window&)/2, window&, 1002,%hInstance,0)
    ClearList
    AddFiles C:\*.*
    MoveListToEdit(Edit1&)
    MoveListToEdit(Edit2&)
    hCursor& = ~LoadCursor(0,~IDC_SIZENS)
    bSplitterMoving& = 0
    dwSplitterPos& =  (Height(window&)/2) + 4
    ~ShowWindow(Window&, ~SW_SHOWNORMAL)
    ~UpdateWindow(Window&)

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

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

    Endwhile

EndProc

Main