XProfan

Italia

Jörg
Sellmeyer

Hier ist jetzt mal mein Beitrag zum Thema Rebar. Es ist sehr simpel einzusetzen und wer es noch nicht selber gemacht hat, braucht nur einen Teil als Include auszulagern und kann dann mit wenigen Zeilen ansprechende Rebars erzeugen.
Der Code basiert auf dem Minibeispiel von Uwe "Pascal" Niemeyer: [...]

Kompilieren Markieren Separieren

 $H windows.ph
 $H commctrl.ph

Proc InitCommControls

    Declare cmctrl#
    Dim cmctrl#,16
    Clear cmctrl#
    Long cmctrl#,0=8' hiermit wird das Rebar-Control aktiviert
    Long cmctrl#,4=$FFFF'---Alles initialisieren
    External("comctl32.dll","InitCommonControlsEx",cmctrl#)
    Dispose cmctrl#

EndProc

'{ Rebar.inc:
'ab hier bis zum Programmbeginn kann alles in die Rebar.inc ausgelagert werden
struct RebarInfo=Size&,Mask&,Style&,clrFore&,clrBack&,lpText&,cch&,iImage&,hwndChild&,\
cxMinChild&,cyMinChild&,cx&,hbmBack&,wID&,cyChild&,cyMaxChild&,cyIntegral&,\
cxIdeal&,lParam&,cxHeader&
Declare RebarInfo#
Dim RebarInfo#,RebarInfo
Create("Container","Rebar")

SubProc Create.Rebar

    Parameters hParent&,Text$,x%,y%,b%,h%,Orientation&
    Case Orientation& = 1:Orientation& = $80'vertikales Rebar

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE

    EndWith

    Return Control(~REBARCLASSNAME,Text$,$50000804  | Orientation&  | ~RBS_DBLCLKTOGGLE | ~RBS_AUTOSIZE,x%,y%,b%,h%,hParent&,0,$60300)

EndProc

SubProc Rebar.Add

    Parameters RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&
    Clear RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung per Breite,bzw. Höhe. Je nach Orientation&
        .hwndChild& = hwndChild&

        If Rebar("GetCount",RB&) = 0

            .Style&=~RBBS_NOGRIPPER | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,0,RebarInfo#)

        Else

            .Style&=~RBBS_GRIPPERALWAYS | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,-1,RebarInfo#)
            '-1 = an letzter Stelle anhängen

        EndIf

    EndWith

EndProc

SubProc Rebar.Insert

    Parameters RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&,Index%
    Clear RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung per Breite,bzw. Höhe. Je nach Orientation&
        .hwndChild& = hwndChild&

        If Rebar("GetCount",RB&) = 0

            .Style&=~RBBS_NOGRIPPER | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,0,RebarInfo#)

        Else

            .Style&=~RBBS_GRIPPERALWAYS | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,Index%,RebarInfo#)

        EndIf

    EndWith

EndProc

SubProc Rebar.Delete

    Parameters RB&,Index%
    Return SendMessage(RB&,~RB_DELETEBAND,Index%,0)
    'bei Erfolg > 0

EndProc

SubProc Rebar.GetCount

    Parameters RB&
    Return SendMessage(RB&,~RB_GETBANDCOUNT,0,0)

EndProc

SubProc Rebar.Show

    Parameters RB&,Item%,Show%
    SendMessage(RB&,~RB_SHOWBAND,Item%,Show%)

EndProc

SubProc Rebar.SetImg

    Parameters RB&,Index%,hImg&
    Clear RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_IMAGE | ~RBBIM_BACKGROUND
        .hbmBack& = hImg&

    EndWith

    windowtitle str$( SendMessage(RB&,~RB_SETBANDINFOA,Index%,RebarInfo#))

EndProc

'Rebar.inc Ende
'}
InitCommControls()
'kann man sich in der Regel sparen aber sicher ist sicher
Declare bmp$,hbmp&
Cls
ShowMax
ChDir $Winpath
AddFiles "*.bmp"
bmp$ = ListBox$("",2)

If bmp$ > ""

    hBmp& = Create("hPic",-1,bmp$)

EndIf

Var LB& = Create("ListBox",%hwnd,0,0,0,0,0)
Move("ListToHandle",LB&)
Var txt& = Create("MultiEdit",%hwnd,"Cooles\nTeil\ndas!",0,0,0,0)
Var btn& = Create("Button",%hwnd,"Test",0,0,0,0)
Var Rebar& = Create("Rebar",%hwnd,"",0,0,Width(%hwnd),Height(%hwnd)-2,0)' wenn hier als letztes 1 angegeben wird, ist das RebarControl vertikal
Rebar("Add",Rebar&,LB&,50,Height(Rebar&),Width(Rebar&) / 8)
Rebar("Add",Rebar&,Txt&,50,Height(Rebar&),Width(Rebar&) / 8 * 6)
Rebar("Add",Rebar&,btn&,50,40,Width(Rebar&) / 8)
Rebar("SetImg",Rebar&,2,hBmp&,50,40,40)

While 1

    WaitInput

    If %key = 4

        SetWindowPos Rebar& = 0,0 - Width(%hwnd),Height(%hwnd)-2

    ElseIf Clicked(btn&)

        bmp$ = GetString$(LB&,GetCurSel(LB&))
        'bei mir wird Setup.bmp immer als ungültige File angemeckert. Vielleicht kann Roland da mal schauen, was damit ist.
        'die File ist vorhanden und wird auch z. B. mit Irvanview korrekt angezeigt. Windows XP SP 3

        If bmp$ > ""

            Case hBmp&:DeleteObject hBmp&
            hBmp& = Create("hPic",-1,bmp$)
            Rebar("SetImg",Rebar&,2,hBmp&,50,40,40)

        EndIf

    EndIf

Wend

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

19.06.2018 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

Jörg
Sellmeyer

Und auch nochmal per Versionen vor X14. Ob es mit der Freewareversion corre weiß ich nicht, sollte sich aber leicht anpassen lassen.

Kompilieren Markieren Separieren

 $H windows.ph
 $H commctrl.ph

Proc InitCommControls

    Declare cmctrl#
    Dim cmctrl#,16
    Clear cmctrl#
    Long cmctrl#,0=8' hiermit wird das Rebar-Control aktiviert
    Long cmctrl#,4=$FFFF'---Alles initialisieren
    External("comctl32.dll","InitCommonControlsEx",cmctrl#)
    Dispose cmctrl#

EndProc

'{ Rebar.inc:
'ab hier bis zum Programmbeginn kann alles in die Rebar.inc ausgelagert werden
struct RebarInfo=Size&,Mask&,Style&,clrFore&,clrBack&,lpText&,cch&,iImage&,hwndChild&,\
cxMinChild&,cyMinChild&,cx&,hbmBack&,wID&,cyChild&,cyMaxChild&,cyIntegral&,\
cxIdeal&,lParam&,cxHeader&
Declare RebarInfo#
Dim RebarInfo#,RebarInfo

SubProc Create.Rebar

    Parameters hParent&,Text$,x%,y%,b%,h%,Orientation&
    Case Orientation& = 1:Orientation& = $80'vertikales Rebar

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE

    EndWith

    Return Control(~REBARCLASSNAME,Text$,$50000804  | Orientation&  | ~RBS_DBLCLKTOGGLE | ~RBS_AUTOSIZE,x%,y%,b%,h%,hParent&,0,$60300)

EndProc

Proc Rebar.Add

    Parameters RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&
    Clear RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung per Breite,bzw. Höhe. Je nach Orientation&
        .hwndChild& = hwndChild&

        If SendMessage(RB&,~RB_GETBANDCOUNT,0,0) = 0

            .Style&=~RBBS_NOGRIPPER | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,0,RebarInfo#)

        Else

            .Style&=~RBBS_GRIPPERALWAYS | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,-1,RebarInfo#)
            '-1 = an letzter Stelle anhängen

        EndIf

    EndWith

EndProc

Proc Rebar.Insert

    Parameters RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&,Index%
    Clear RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung per Breite,bzw. Höhe. Je nach Orientation&
        .hwndChild& = hwndChild&

        If SendMessage(RB&,~RB_GETBANDCOUNT,0,0) = 0

            .Style&=~RBBS_NOGRIPPER | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,0,RebarInfo#)

        Else

            .Style&=~RBBS_GRIPPERALWAYS | ~RBBS_CHILDEDGE
            SendMessage(RB&,~RB_INSERTBANDA,Index%,RebarInfo#)

        EndIf

    EndWith

EndProc

Proc Rebar.Delete

    Parameters RB&,Index%
    Return SendMessage(RB&,~RB_DELETEBAND,Index%,0)
    'bei Erfolg > 0

EndProc

Proc Rebar.GetCount

    Parameters RB&
    Return SendMessage(RB&,~RB_GETBANDCOUNT,0,0)

EndProc

Proc Rebar.Show

    Parameters RB&,Item%,Show%
    SendMessage(RB&,~RB_SHOWBAND,Item%,Show%)

EndProc

Proc Rebar.SetImg

    Parameters RB&,Index%,hImg&
    Clear RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_IMAGE | ~RBBIM_BACKGROUND
        .hbmBack& = hImg&

    EndWith

    windowtitle str$( SendMessage(RB&,~RB_SETBANDINFOA,Index%,RebarInfo#))

EndProc

'Rebar.inc Ende
'}
InitCommControls()
'kann man sich in der Regel sparen aber sicher ist sicher
Declare bmp$,hbmp&
Cls
ShowMax
ChDir $Winpath
AddFiles "*.bmp"
bmp$ = ListBox$("",2)

If bmp$ > ""

    hBmp& = Create("hPic",-1,bmp$)

EndIf

Var LB& = Create("ListBox",%hwnd,0,0,0,0,0)
Move("ListToHandle",LB&)
Var txt& = Create("MultiEdit",%hwnd,"Cooles\nTeil\ndas!",0,0,0,0)
Var btn& = Create("Button",%hwnd,"Test",0,0,0,0)
Var Rebar& = Create("Rebar",%hwnd,"",0,0,Width(%hwnd),Height(%hwnd)-2,0)' wenn hier als letztes 1 angegeben wird, ist das RebarControl vertikal
Rebar.Add(Rebar&,LB&,50,Height(Rebar&),Width(Rebar&) / 8)
Rebar.Add(Rebar&,Txt&,50,Height(Rebar&),Width(Rebar&) / 8 * 6)
Rebar.Add(Rebar&,btn&,50,40,Width(Rebar&) / 8)
Rebar.SetImg(Rebar&,2,hBmp&,50,40,40)

While 1

    WaitInput

    If %key = 4

        SetWindowPos Rebar& = 0,0 - Width(%hwnd),Height(%hwnd)-2

    ElseIf Clicked(btn&)

        bmp$ = GetString$(LB&,GetCurSel(LB&))
        'bei mir wird Setup.bmp immer als ungültige File angemeckert. Vielleicht kann Roland da mal schauen, was damit ist.
        'die File ist vorhanden und wird auch z. B. mit Irvanview korrekt angezeigt. Windows XP SP 3

        If bmp$ > ""

            Case hBmp&:DeleteObject hBmp&
            hBmp& = Create("hPic",-1,bmp$)
            Rebar.SetImg(Rebar&,2,hBmp&,50,40,40)

        EndIf

    EndIf

Wend