XProfan

Français

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 ruban#
Dispose ruban#
end

16.07.2007 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

« cette Beitrag wurde comme Solution gekennzeichnet. »

Jörg
Sellmeyer

et aussi repariert. Mühsam ernährt sich cela écureuil...
on sollte encore hinzufügen, dass cela Rebarcontrol wohl sur einem Code de Uwe "Pascal" Niemeyer basé.

Kompilieren Marque Séparation

'Source wurde am 15.07.2007 aus qui MMJ-Quellcodesammlung (Dietmar Horn) dans qui Babyklappe sur 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#
Faible a# , 16
clear a#
Long a#,0 = 8
Long a#,4 = $FFFF'---Alles initialisieren
Externe("comctl32.dll","InitCommonControlsEx",a#)
Dispose a#
{Labels}:

subproc Créer.cText

    parameters pWnd& , text$ , x% , y% , dx% , dy%
    inc inum%
    return Contrôle("STATIC",text$,$54000001,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)

endproc

subproc Créer.rText

    parameters pWnd& , text$ , x% , y% , dx% , dy%
    inc inum%
    return Contrôle("STATIC",text$,$54000002,x%,y%,dx%,dy%,pWnd&,inum%,%hInstance)

endproc

'}Ende Labels
'{Trackbar}:

subproc Créer.TrackBar

    parameters pWnd& , options$ , x% , y% , dx% , dy%
    declare htb& , stil&
    inc inum%
    stil& = $54010040
    options$ = Upper$(options$)
    cas InStr("SEL" ,options$) : add stil& , 20
    cas InStr("BOTH",options$) : add stil& , 8
    htb& = Contrôle("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 Créer.ProgressBar

    si %pCount = 6

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

    d'autre

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

    endif

    inc inum%
    hpb& = Contrôle(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 Créer.ReBar

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

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

        inc inum%
        rebar&=Contrôle("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 pas zéro son
            .Style&      = si(fbgrip%,128,256)'--RBBS_NOGRIPPER (1. ruban sans Griff)
            .cxMinChild& = minx%'----------------Minimum Breite
            .cyMinChild& = by%'------------------Hauteur des Bandes
            .cx&         = bx%'------------------Vorgabe Breite
            .hwndChild&  = cWnd&'----------------ruban 1
            SendMessage(ReBar&,$0401,0,ReBar#)'--RB_INSERTBAND
            .handle&     = rebar&
            .bandcount%  = 1

        EndWith

        return 1

    d'autre

        return 0

    endif

endproc

proc InsertReBarBand

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

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

        With ReBar#

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

        EndWith

        return 1

    d'autre

        return 0

    endif

endproc

proc DestroyReBar

    parameters rebar#

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

        DestroyWindow(rebar#.handle&)
        Dispose rebar#

    d'autre

        return 0

    endif

endproc

'}Ende ReBarGrip
'----- Ende CONTROLS.INC --------------------------------------------------------------------------
declare ruban# , lb1& , lb2& , lb3&
Faible ruban# , ReBar
Titre de la fenêtre "Rebar-Demo de Nico Madysa"
Fenêtre 0 , 0 - 640 , 480
cls Externe("User32","GetSysColor",15)
ClearList
AddFonts
lb1& = Créer(ListBox,%hWnd,0,0,0,0,0)
MoveListToHandle(lb1&)
lb2& = Créer(ListBox,%hWnd,0,0,0,0,0)
MoveListToHandle(lb2&)
lb3& = Créer(ListBox,%hWnd,0,0,0,0,0)
MoveListToHandle(lb3&)
Créer("ReBar",ruban#,%hWnd,0,0,500,400,0,100,400,lb1&,1)
InsertReBarBand(ruban#,0,100,200,lb2&)
InsertReBarBand(ruban#,0,100,100,lb3&)

whilenot IsKey(27)

    waitinput

Wend

DestroyReBar ruban#
Dispose ruban#
end