XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Fenster scrollen (2)
(C) 2007 Rolf Koch
http://www.rokosoft.de
 $P+
SET(ERRORLEVEL,0)
********************** HINWEISE ********************************
CODE ERZEUGT MIT ROKOS OBJECT CREATOR 4.5b
DATUM  17.02.2007    um  14:39 Uhr
VERWENDETE PROFANVERSION IST 10.0-NT XPROFAN
CODE ERSTELLT UNTER WINDOWS Unbekannt
Subclass für %hwnd ist eingeschaltet!
!!! Dieser Code wird von Roc immer neu erzeugt        !!!
!!! Erst bearbeiten, wenn alle Objekte erzeugt wurden !!!
!!! Verändern Sie ggf. feste Pfade in variable Pfade  !!!
DECLARE VSCROLL1&
DECLARE TEXT1&,font&,x%
Declare untergrund&,scrollteil&
DEF GETSYSCOLOR(1) !USER32,GetSysColor
 $H WINDOWS.PH
 $H MESSAGES.PH
font&=create(FONT,MS SANS SERIF,25,0,1,0,0)
Hier nichts ändern **************************************
declare p_x1&,p_x2&

PROC INITSUBCLASS

    p_x1&=~Getwindowlong(%Hwnd,~Gwl_wndproc)
    p_x2&=Procaddr(Windowproc,4)
    ~Setwindowlong(%Hwnd,~Gwl_wndproc, p_x2&)

ENDPROC

PROC SETSTANDARDMESSAGE

    ~Setwindowlong(%Hwnd,~Gwl_wndproc, p_x1&)

ENDPROC

PROC SETEXTENDMESSAGE

    ~Setwindowlong(%Hwnd,~Gwl_wndproc, p_x2&)

ENDPROC

*********************************************************
Hier können die eigenen Abfragen hin ********************

Proc Windowproc

    Parameters Wnd&, Msg&, Wparam&, Lparam&

    If Msg& = ~Wm_close

        ~Postquitmessage(0)Programm-Ende

    Endif

    IF MSG& = ~WM_VSCROLL

        SCROLL_PROC

    ENDIF

    Return ~Callwindowproc(p_x1&,Wnd&, Msg&, Wparam&, Lparam&)

Endproc

HIER DEINE AKTIONEN WENN SCROLLER BETÄTIGT WIRD

PROC SCROLL_PROC

    setwindowpos scrollteil&=0,(-getscrollpos(vscroll1&))-(width(%hwnd)-16),5000

ENDPROC

WINDOWSTYLE 63
WINDOWTITLE The Elder scrolls *lol*
WINDOW 22,20-250,310
SET(TRUECOLOR,1)
DECLARE ENDE%
CLS GETSYSCOLOR(15)
USEFONT MS Sans Serif,13,0,0,0,0
SETDIALOGFONT 1
Set(FASTMODE,1)
VSCROLL1& = CREATE(VScroll,%HWND,VScroll,(width(%hwnd)-15),0035,0014,(height(%hwnd)-35))
SetScrollRange vscroll1&,0,5000
TEXT1& = CREATE(TEXT,%HWND,Ich bin die Überschrift,0001,0001,0358,0020)
Untergrund&=Control(STATIC,,$54001106,1,36,(width(%hwnd)-16),(height(%hwnd)-35),%hwnd,0,%hinstance,$0)
Scrollteil&=Control(STATIC,,$54001100,0,0,(width(%hwnd)-16),5000,untergrund&,0,%hinstance,$0)

whilenot x% = 240

    inc x%
    createtext(scrollteil&,Ich bin Testtext Nr. +str$(x%),10,(20*x%),200,20)

endwhile

setfont text1&,font&
INITSUBCLASSmuss an diese Position
SETSTANDARDMESSAGEmuss an diese Position
SETFOCUS(%HWND)
SETEXTENDMESSAGEmuss an diese Position

WHILENOT ENDE%

    WAITINPUT
    SETSTANDARDMESSAGEmuss an diese Position

    If %KEY=2

        ENDE%= 1

    ELSEIF %KEY=4

    ENDIF

    SETEXTENDMESSAGEmuss an diese Position

ENDWHILE

deleteobject font&