Deutsch
Quelltexte/ Codesnippets

Rebarwindow - 2

 
- Seite 1 -



KompilierenMarkierenSeparieren
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#
Dispose band#
end
 
16.07.2007  
 



« Dieser Beitrag wurde als Lösung gekennzeichnet. »


Jörg
Sellmeyer

Und auch repariert. Mühsam ernährt sich das Eichhörnchen...
Man sollte noch hinzufügen, dass das Rebarcontrol wohl auf einem Code von Uwe "Pascal" Niemeyer basiert.
'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#
Dispose band#
end
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
18.06.2018  
 



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

1.480 Betrachtungen

Unbenanntvor 0 min.
Thomas Zielinski06.09.2019
Pedro Miguel17.05.2019
Sascha Haak13.01.2019
Peter Max Müller05.01.2019
Mehr...

Themeninformationen

Dieses Thema hat 2 Teilnehmer:

Jörg Sellmeyer (1x)
unbekannt (1x)


AGB  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Impressum  |  Mart  |  Support  |  Suche

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie