XProfan

Español

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
RebarWindow (2)
(C) 2006 Nico Madysa
----- Beginn CONTROLS.INC ------------------------------------------------------------------------------
Struct ReBar = Size& , Mask& , Style& , clrFore& , clrBack& ,
lpText& , cch& , iImage& , hwndChild& , cxMinChild& ,
cyMinChild& , cx& , hbmBack& , wID& , cyChild& ,
cyMaxChild& , cyIntegral& , cxIdeal& , lParam& ,
cxHeader& , handle& , bandcount%
declare inum% , a#
Dim a# , 16
clear a#
Long a#,0 = 8
Long a#,4 = $FFFF---Alles initialisieren
External(comctl32.dll,InitCommonControlsEx,a#)
Dispose a#
{Labels}:

subproc Create.cText

    parameters pWnd& , text$ , x% , y% , dx% , dy%
    inc inum%
    return Control(STATIC,text$,$54000001,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)

endproc

subproc Create.rText

    parameters pWnd& , text$ , x% , y% , dx% , dy%
    inc inum%
    return Control(STATIC,text$,$54000002,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)

endproc

}Ende Labels

{Trackbar}:

subproc Create.TrackBar

parameters pWnd& , options$ , x% , y% , dx% , dy%
declare htb& , stil&
inc inum%
stil& = $54010040
options$ = Upper$(options$)
case InStr(SEL ,options$) : add stil& , 20
case InStr(BOTH,options$) : add stil& , 8
htb& = Control(msctls_trackbar32,,stil&,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance,$00000)
SetTrackRange htb& , val(SubStr$(options$,2,;)) , val(SubStr$(options$,3,;))
SetTrackPos htb& , val(SubStr$(options$,1,;))
return htb&

endproc

proc SetTrackPos

parameters h& , pos%
SendMessage(h&,$0405,1,pos%)

endproc

proc GetTrackPos

parameters h&
return SendMessage(h&,$0400,0,0)

endproc

proc SetTrackRange

parameters h& , anf% , end%
SendMessage(h&,$0406,1,MakeLong(anf%,end%))

endproc

}Ende TrackBar

{Progressbar}:

subproc Create.ProgressBar

if %pCount = 6

parameters pWnd& , stil& , x% , y% , dx% , dy%
declare hpb&
stil& = stil& + $50000000

else

parameters pWnd& , frame% , smooth% , x% , y% , dx% , dy%
declare hpb& , stil&
stil& = $50000000 + if(smooth%,1,0) + if(frame%,$800000,0)

endif

inc inum%
hpb& = Control(msctls_progress32,,stil&,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)
return hpb&

endproc

proc SetProgPos

parameters h& , pos%
return Sendmessage(h&,$402,pos%,0)

endproc

}Ende ProgressBar

{ReBarGrip}:

subproc Create.ReBar

parameters rebar# , pWnd& , x% , y% , dx% , dy% , minx% , bx% , by% , cWnd& , fbgrip%
declare rebar&

if lower$(ClassOf(ReBar#)) = rebar

inc inum%
rebar&=Control(ReBarWindow32,,$50000804 ,x%,y%,dx%,dy%,pWnd&,inum%,0)

With Rebar#

.Size&       = SizeOf(ReBar#) - 6
.Mask&       = $71--RBBIM_STYLE | RBBIM_CHILD | RBBIM_CHILDSIZE | RBBIM_SIZE
.cyMaxChild& = 1  ------------------Darf nicht Null sein
.Style&      = if(fbgrip%,128,256)--RBBS_NOGRIPPER (1. Band ohne Griff)
.cxMinChild& = minx%----------------Minimum Breite
.cyMinChild& = by%------------------Höhe des Bandes
.cx&         = bx%------------------Vorgabe Breite
.hwndChild&  = cWnd&----------------Band 1
SendMessage(ReBar&,$0401,0,ReBar#)--RB_INSERTBAND
.handle&     = rebar&
.bandcount%  = 1

EndWith

return 1

else

return 0

endif

endproc

proc InsertReBarBand

parameters ReBar# , minx% , bx% , by% , cWnd&

if lower$(ClassOf(ReBar#)) = rebar

With ReBar#

.Style&      = 128-----------------RBBS_GRIPPERALWAYS (folgende Bänder mit Griff)
.cxMinChild& = minx%---------------Minimum Breite
.cyMinChild& = by%-----------------Höhe des Bandes
.cx&         = bx%-----------------Vorgabe Breite
.hwndChild&  = cWnd&---------------Band 2
SendMessage(.handle&,$0401,.bandcount%,ReBar#)--RB_INSERTBAND
.bandcount%  = .bandcount% + 1

EndWith

return 1

else

return 0

endif

endproc

proc DestroyReBar

parameters rebar#

if lower$(ClassOf(rebar#)) = rebar

DestroyWindow(rebar#.handle&)
Dispose rebar#

else

return 0

endif

endproc

}Ende ReBarGrip

----- Ende CONTROLS.INC --------------------------------------------------------------------------
declare band# , lb1& , lb2& , lb3&
Dim band# , ReBar
WindowTitle Rebar-Demo von Nico Madysa
Window 0 , 0 - 640 , 480
cls External(User32,GetSysColor,15)
ClearList
AddFonts
lb1& = Create(ListBox,%hWnd,0,0,0,0,0)
MoveListToHandle(lb1&)
lb2& = Create(ListBox,%hWnd,0,0,0,0,0)
MoveListToHandle(lb2&)
lb3& = Create(ListBox,%hWnd,0,0,0,0,0)
MoveListToHandle(lb3&)
Create(ReBar,band#,%hWnd,0,0,500,400,0,100,400,lb1&,1)
InsertReBarBand(band#,0,100,200,lb2&)
InsertReBarBand(band#,0,100,100,lb3&)

whilenot IsKey(27)

waitinput

wend

DestroyReBar band#
Disponer band#
end

16.07.2007 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

« Dieser Contribución wurde como Solución gekennzeichnet. »

Jörg
Sellmeyer

Und auch repariert. Mühsam ernährt se el Eichhörnchen...
Man debería todavía hinzufügen, dass el Rebarcontrol wohl en una Code de Uwe "Pascal" Niemeyer basiert.

Kompilieren Marca Separación

'Source wurde al 15.07.2007 de el MMJ-Quellcodesammlung (Dietmar Horn) en el Babyklappe en XProfan.Com abgelegt:
'RebarWindow (2)
'(C) 2006 Nico Madysa
'----- Beginn CONTROLS.INC ------------------------------------------------------------------------------
Struct ReBar = Size& , Mask& , Style& , clrFore& , clrBack& ,\
lpText& , cch& , iImage& , hwndChild& , cxMinChild& ,\
cyMinChild& , cx& , hbmBack& , wID& , cyChild& ,\
cyMaxChild& , cyIntegral& , cxIdeal& , lParam& ,\
cxHeader& , handle& , bandcount%
declarar inum% , a#
Dim a# , 16
clear a#
Largo a#,0 = 8
Largo a#,4 = $FFFF'---Alles inicializar
Externo("comctl32.dll","InitCommonControlsEx",a#)
Disponer a#
{Labels}:

subproc Crear.cText

    parámetros pWnd& , texto$ , x% , y% , dx% , dy%
    inc inum%
    volver Control("STATIC",texto$,$54000001,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)

ENDPROC

subproc Crear.rText

    parámetros pWnd& , texto$ , x% , y% , dx% , dy%
    inc inum%
    volver Control("STATIC",texto$,$54000002,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)

ENDPROC

'}Ende Labels
'{Trackbar}:

subproc Crear.TrackBar

    parámetros pWnd& , options$ , x% , y% , dx% , dy%
    declarar htb& , stil&
    inc inum%
    stil& = $54010040
    options$ = Upper$(options$)
    caso InStr("SEL" ,options$) : add stil& , 20
    caso InStr("BOTH",options$) : add stil& , 8
    htb& = Control("msctls_trackbar32","",stil&,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance,$00000)
    SetTrackRange htb& , val(Substr$(options$,2,;)) , val(Substr$(options$,3,;))
    SetTrackPos htb& , val(Substr$(options$,1,;))
    volver htb&

ENDPROC

proc SetTrackPos

    parámetros h& , pos%
    SendMessage(h&,$0405,1,pos%)

ENDPROC

proc GetTrackPos

    parámetros h&
    volver SendMessage(h&,$0400,0,0)

ENDPROC

proc SetTrackRange

    parámetros h& , anf% , end%
    SendMessage(h&,$0406,1,MakeLong(anf%,end%))

ENDPROC

'}Ende TrackBar
'{Progressbar}:

subproc Crear.ProgressBar

    if %pCount = 6

        parámetros pWnd& , stil& , x% , y% , dx% , dy%
        declarar hpb&
        stil& = stil& + $50000000

    más

        parámetros pWnd& , frame% , smooth% , x% , y% , dx% , dy%
        declarar hpb& , stil&
        stil& = $50000000 + if(smooth%,1,0) + if(frame%,$800000,0)

    endif

    inc inum%
    hpb& = Control(msctls_progress32,,stil&,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)
    volver hpb&

ENDPROC

proc SetProgPos

    parámetros h& , pos%
    volver SendMessage(h&,$402,pos%,0)

ENDPROC

'}Ende ProgressBar
'{ReBarGrip}:

subproc Crear.ReBar

    parámetros rebar# , pWnd& , x% , y% , dx% , dy% , minx% , bx% , by% , cWnd& , fbgrip%
    declarar rebar&

    if lower$(ClassOf(ReBar#)) = "rebar"

        inc inum%
        rebar&=Control("ReBarWindow32","",$50000804 ,x%,y%,dx%,dy%,pWnd&,inum%,0)

        With Rebar#

            .Size&       = SizeOf(ReBar#) - 6
            .Mask&       = $71'--RBBIM_STYLE | RBBIM_CHILD | RBBIM_CHILDSIZE | RBBIM_SIZE
            .cyMaxChild& = 1' ------------------Darf no Null ser
            .Style&      = if(fbgrip%,128,256)'--RBBS_NOGRIPPER (1. Band sin Griff)
            .cxMinChild& = minx%'----------------Minimum Breite
            .cyMinChild& = by%'------------------Höhe des Bandes
            .cx&         = bx%'------------------Vorgabe Breite
            .hwndChild&  = cWnd&'----------------Band 1
            SendMessage(ReBar&,$0401,0,ReBar#)'--RB_INSERTBAND
            .handle&     = rebar&
            .bandcount%  = 1

        EndWith

        volver 1

    más

        volver 0

    endif

ENDPROC

proc InsertReBarBand

    parámetros ReBar# , minx% , bx% , by% , cWnd&

    if lower$(ClassOf(ReBar#)) = "rebar"

        With ReBar#

            .Style&      = 128'-----------------RBBS_GRIPPERALWAYS (folgende Bänder con Griff)
            .cxMinChild& = minx%'---------------Minimum Breite
            .cyMinChild& = by%'-----------------Höhe des Bandes
            .cx&         = bx%'-----------------Vorgabe Breite
            .hwndChild&  = cWnd&'---------------Band 2
            SendMessage(.handle&,$0401,.bandcount%,ReBar#)'--RB_INSERTBAND
            .bandcount%  = .bandcount% + 1

        EndWith

        volver 1

    más

        volver 0

    endif

ENDPROC

proc DestroyReBar

    parámetros rebar#

    if lower$(ClassOf(rebar#)) = "rebar"

        DestroyWindow(rebar#.handle&)
        Disponer rebar#

    más

        volver 0

    endif

ENDPROC

'}Ende ReBarGrip
'----- Ende CONTROLS.INC --------------------------------------------------------------------------
declarar band# , lb1& , lb2& , lb3&
Dim band# , ReBar
Título de la ventana "Rebar-Demo de Nico Madysa"
Ventana 0 , 0 - 640 , 480
cls Externo("User32","GetSysColor",15)
ClearList
AddFonts
lb1& = Crear("ListBox",%hWnd,0,0,0,0,0)
MoveListToHandle(lb1&)
lb2& = Crear("ListBox",%hWnd,0,0,0,0,0)
MoveListToHandle(lb2&)
lb3& = Crear("ListBox",%hWnd,0,0,0,0,0)
MoveListToHandle(lb3&)
Crear("ReBar",band#,%hWnd,0,0,500,400,0,100,400,lb1&,1)
InsertReBarBand(band#,0,100,200,lb2&)
InsertReBarBand(band#,0,100,100,lb3&)

whilenot IsKey(27)

    waitinput

wend

DestroyReBar band#
Disponer band#
end