XProfan

English

Jörg
Sellmeyer

here's now time my Posting about Rebar. its very simply einzusetzen and who it not yet yourself made has, need only a part as Include auszulagern and can then with few Lines ansprechende Rebars produce.
The code basiert on the Minibeispiel of Uwe "Pascal" Niemeyer: [...]

Compile Mark Separation

 $H windows.ph
 $H commctrl.ph

Proc InitCommControls

    Declare cmctrl#
    Dim cmctrl#,16
    Clear cmctrl#
    Long cmctrl#,0=8' herewith becomes the Rebar-Control activate
    Long cmctrl#,4=$FFFF'---everything initialisieren
    External("comctl32.dll","InitCommonControlsEx",cmctrl#)
    Dispose cmctrl#

ENDPROC

'{ Rebar.inc:
'ex here until Programmbeginn can everything into Rebar.inc ausgelagert go
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&' Default-Settings for wide,or. Höhe. according to 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 = on last place append

        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&' Default-Settings for wide,or. Höhe. according to 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)
    'with success > 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 st$( SendMessage(RB&,~RB_SETBANDINFOA,index%,RebarInfo#))

ENDPROC

'Rebar.inc end
'}
InitCommControls()
'can itself in the rule save but sure is sure
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)' if here as letztes 1 indicated becomes, is the RebarControl Mouse and Sprite
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&))
        'by me becomes Setup.bmp always as ungültige File angemeckert. Perhaps can Roland there time look, what so is.
        'The File is present and becomes too z. B. with Irvanview correctly displayed. 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 ...

06/19/18 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

and too again for versions to X14. whether it with the Freewareversion runs white I do not, ought to itself but slight adjust let.

Compile Mark Separation

 $H windows.ph
 $H commctrl.ph

Proc InitCommControls

    Declare cmctrl#
    Dim cmctrl#,16
    Clear cmctrl#
    Long cmctrl#,0=8' herewith becomes the Rebar-Control activate
    Long cmctrl#,4=$FFFF'---everything initialisieren
    External("comctl32.dll","InitCommonControlsEx",cmctrl#)
    Dispose cmctrl#

ENDPROC

'{ Rebar.inc:
'ex here until Programmbeginn can everything into Rebar.inc ausgelagert go
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&' Default-Settings for wide,or. Höhe. according to 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 = on last place append

        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&' Default-Settings for wide,or. Höhe. according to 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)
    'with success > 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 st$( SendMessage(RB&,~RB_SETBANDINFOA,index%,RebarInfo#))

ENDPROC

'Rebar.inc end
'}
InitCommControls()
'can itself in the rule save but sure is sure
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)' if here as letztes 1 indicated becomes, is the RebarControl Mouse and Sprite
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&))
        'by me becomes Setup.bmp always as ungültige File angemeckert. Perhaps can Roland there time look, what so is.
        'The File is present and becomes too z. B. with Irvanview correctly displayed. 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