Deutsch
Quelltexte/ Codesnippets

Rebar Splitter einfach Include

 

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: [...] 
 $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 für 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 für 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 Datei angemeckert. Vielleicht kann Roland da mal schauen, was damit ist.
        'die Datei 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  
 




Jörg
Sellmeyer
Und auch nochmal für Versionen vor X14. Ob es mit der Freewareversion läuft weiß ich nicht, sollte sich aber leicht anpassen lassen.
 $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 für 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 für 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 Datei angemeckert. Vielleicht kann Roland da mal schauen, was damit ist.
        'die Datei 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

 
XProfan X4
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
19.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

575 Betrachtungen

Unbenanntvor 0 min.
Thomas Zielinski06.09.2019
Pedro Miguel17.05.2019
Rainer Hoefs01.04.2019
Uwe Lang21.02.2019
Mehr...

Themeninformationen

Dieses Thema hat 1 Teilnehmer:

Jörg Sellmeyer (2x)


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