XProfan

Español

Jörg
Sellmeyer

Hier es ahora veces mein Contribución para Thema Rebar. Es muy simpel einzusetzen y wer lo todavía no selber gemacht ha, braucht sólo una Teil como Incluir auszulagern y kann entonces con wenigen Zeilen ansprechende Rebars erzeugen.
Der Code basiert en el Minibeispiel de Uwe "Pascal" Niemeyer: [...]

Kompilieren Marca Separación

 $H windows.ph
 $H commctrl.ph

Proc InitCommControls

    Declarar cmctrl#
    Dim cmctrl#,16
    Claro cmctrl#
    Largo cmctrl#,0=8' hiermit se el Rebar-Control aktiviert
    Largo cmctrl#,4=$FFFF'---Alles inicializar
    Externo("comctl32.dll","InitCommonControlsEx",cmctrl#)
    Disponer cmctrl#

ENDPROC

'{ Rebar.inc:
'de hier a para Programmbeginn kann alles en el Rebar.inc ausgelagert voluntad
struct RebarInfo=Size&,Mask&,Style&,clrFore&,clrBack&,lpText&,cch&,iImage&,hwndChild&,\
cxMinChild&,cyMinChild&,cx&,hbmBack&,wID&,cyChild&,cyMaxChild&,cyIntegral&,\
cxIdeal&,lParam&,cxHeader&
Declarar RebarInfo#
Dim RebarInfo#,RebarInfo
Crear("Container","Rebar")

SubProc Crear.Rebar

    Parámetros hParent&,Texto$,x%,y%,b%,h%,Orientation&
    Case Orientation& = 1:Orientation& = $80'vertikales Rebar

    With RebarInfo#

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

    EndWith

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

ENDPROC

SubProc Rebar.Add

    Parámetros RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&
    Claro RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung para Breite,o. Höhe. Je después de Orientation&
        .hwndChild& = hwndChild&

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

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

        Más

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

        EndIf

    EndWith

ENDPROC

SubProc Rebar.Insert

    Parámetros RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&,Index%
    Claro RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung para Breite,o. Höhe. Je después de Orientation&
        .hwndChild& = hwndChild&

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

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

        Más

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

        EndIf

    EndWith

ENDPROC

SubProc Rebar.Delete

    Parámetros RB&,Index%
    Volver SendMessage(RB&,~RB_DELETEBAND,Index%,0)
    'en Erfolg > 0

ENDPROC

SubProc Rebar.GetCount

    Parámetros RB&
    Volver SendMessage(RB&,~RB_GETBANDCOUNT,0,0)

ENDPROC

SubProc Rebar.Show

    Parámetros RB&,Item%,Show%
    SendMessage(RB&,~RB_SHOWBAND,Item%,Show%)

ENDPROC

SubProc Rebar.SetImg

    Parámetros RB&,Index%,hImg&
    Claro 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()
'puede ser se en el Regel sparen aber sicher es sicher
Declarar bmp$,hbmp&
Cls
ShowMax
ChDir $WinPath
AddFiles "*.bmp"
bmp$ = ListBox$("",2)

If bmp$ > ""

    hBmp& = Crear("HPIC",-1,bmp$)

EndIf

Var LB& = Crear("ListBox",%hwnd,0,0,0,0,0)
Move("ListToHandle",LB&)
Var txt& = Crear("MultiEdit",%hwnd,"Cooles\nTeil\ndas!",0,0,0,0)
Var btn& = Crear("Button",%hwnd,"Test",0,0,0,0)
Var Rebar& = Crear("Rebar",%hwnd,"",0,0,Width(%hwnd),Height(%hwnd)-2,0)' si aquí como letztes 1 angegeben se, es el 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)

Mientras que 1

    WaitInput

    If %key = 4

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

    ElseIf Clicked(btn&)

        bmp$ = GetString$(LB&,GetCurSel(LB&))
        'en me se Setup.bmp siempre como ungültige Expediente angemeckert. Tal vez kann Roland como veces schauen, qué así es.
        'el Expediente es disponible y se auch z. B. con Irvanview korrekt adecuado. Windows XP SP 3

        If bmp$ > ""

            Case hBmp&:DeleteObject hBmp&
            hBmp& = Crear("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 Cita Zeilenweise Cita

Jörg
Sellmeyer

Und auch otra vez para Versionen antes X14. Ob lo con el Freewareversion se ejecuta weiß Yo no, debería se aber ligeramente adaptar dejar.

Kompilieren Marca Separación

 $H windows.ph
 $H commctrl.ph

Proc InitCommControls

    Declarar cmctrl#
    Dim cmctrl#,16
    Claro cmctrl#
    Largo cmctrl#,0=8' hiermit se el Rebar-Control aktiviert
    Largo cmctrl#,4=$FFFF'---Alles inicializar
    Externo("comctl32.dll","InitCommonControlsEx",cmctrl#)
    Disponer cmctrl#

ENDPROC

'{ Rebar.inc:
'de hier a para Programmbeginn kann alles en el Rebar.inc ausgelagert voluntad
struct RebarInfo=Size&,Mask&,Style&,clrFore&,clrBack&,lpText&,cch&,iImage&,hwndChild&,\
cxMinChild&,cyMinChild&,cx&,hbmBack&,wID&,cyChild&,cyMaxChild&,cyIntegral&,\
cxIdeal&,lParam&,cxHeader&
Declarar RebarInfo#
Dim RebarInfo#,RebarInfo

SubProc Crear.Rebar

    Parámetros hParent&,Texto$,x%,y%,b%,h%,Orientation&
    Case Orientation& = 1:Orientation& = $80'vertikales Rebar

    With RebarInfo#

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

    EndWith

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

ENDPROC

Proc Rebar.Add

    Parámetros RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&
    Claro RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung para Breite,o. Höhe. Je después de Orientation&
        .hwndChild& = hwndChild&

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

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

        Más

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

        EndIf

    EndWith

ENDPROC

Proc Rebar.Insert

    Parámetros RB&,hwndChild&,cxMinChild&,cyMinChild&,cx&,Index%
    Claro RebarInfo#

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_STYLE | ~RBBIM_CHILD | ~RBBIM_CHILDSIZE | ~RBBIM_SIZE
        .cxMinChild& = cxMinChild&
        .cyMinChild& = cyMinChild&
        .cx& = cx&' Voreinstellung para Breite,o. Höhe. Je después de Orientation&
        .hwndChild& = hwndChild&

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

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

        Más

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

        EndIf

    EndWith

ENDPROC

Proc Rebar.Delete

    Parámetros RB&,Index%
    Volver SendMessage(RB&,~RB_DELETEBAND,Index%,0)
    'en Erfolg > 0

ENDPROC

Proc Rebar.GetCount

    Parámetros RB&
    Volver SendMessage(RB&,~RB_GETBANDCOUNT,0,0)

ENDPROC

Proc Rebar.Show

    Parámetros RB&,Item%,Show%
    SendMessage(RB&,~RB_SHOWBAND,Item%,Show%)

ENDPROC

Proc Rebar.SetImg

    Parámetros RB&,Index%,hImg&
    Claro 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()
'puede ser se en el Regel sparen aber sicher es sicher
Declarar bmp$,hbmp&
Cls
ShowMax
ChDir $WinPath
AddFiles "*.bmp"
bmp$ = ListBox$("",2)

If bmp$ > ""

    hBmp& = Crear("HPIC",-1,bmp$)

EndIf

Var LB& = Crear("ListBox",%hwnd,0,0,0,0,0)
Move("ListToHandle",LB&)
Var txt& = Crear("MultiEdit",%hwnd,"Cooles\nTeil\ndas!",0,0,0,0)
Var btn& = Crear("Button",%hwnd,"Test",0,0,0,0)
Var Rebar& = Crear("Rebar",%hwnd,"",0,0,Width(%hwnd),Height(%hwnd)-2,0)' si aquí como letztes 1 angegeben se, es el 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)

Mientras que 1

    WaitInput

    If %key = 4

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

    ElseIf Clicked(btn&)

        bmp$ = GetString$(LB&,GetCurSel(LB&))
        'en me se Setup.bmp siempre como ungültige Expediente angemeckert. Tal vez kann Roland como veces schauen, qué así es.
        'el Expediente es disponible y se auch z. B. con Irvanview korrekt adecuado. Windows XP SP 3

        If bmp$ > ""

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

        EndIf

    EndIf

Wend