XProfan

Deutsch

Jörg
Sellmeyer

Wahrscheinlich überseh ich grad irgendwas total Banales aber ich bekomm es nicht hin, die Höhe dieses Rebar-Controls zu ändern. Die Breite passt sich ja wunderbar automatisch an, aber das Dingen reagiert überhaupt nicht auf SetWindowPos.

Kompilieren Markieren Separieren

'$I Rebar.inc
'{ Rebar.inc:
 $H Windows.ph
 $H Messages.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

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

Create("Container","Rebar")

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 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

'Rebar.inc Ende
'}
RBBIM_SIZE

SubClassProc

    If SubClassMessage(%hWnd, ~wm_sizing)

        Resize
        Set("WinProc", 0)

    EndIf

EndProc

Proc Resize

    SetWindowPos Rebar& = 0,0 - Width(%hwnd),(Height(%hwnd))
    'SetWindowPos hList& = 0,0 - Width(hList&),(Height(Rebar&))
    'SetWindowPos hEdit& = 0,0 - Width(hEdit&),(Height(Rebar&))

EndProc

Declare hList&, hTV&,hEdit&
Window 800,600
Var Rebar& = Create("Rebar",%hwnd,"",0,0,Width(%hwnd),Height(%hwnd),0)' wenn hier als letztes 1 angegeben wird, ist das RebarControl vertikal
hList& = Create("Listbox",%hwnd,0,0,0,0,0)
hEdit& = Create("MultiEdit",%hwnd,"",0,0,0,0)
Rebar("Add",Rebar&,hList&,50,Height(Rebar&),Width(Rebar&) / 6)
Rebar("Add",Rebar&,hEdit&,50,Height(Rebar&),Width(Rebar&) / 8 * 6)
SubClass %HWnd, 1'SubClassing des Hauptfensters einschalten
SubClass Rebar&,   1'SubClassing des Rebar einschalten

While 1

    WaitInput

    If %Key = 4

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

    EndIf

Wend

SubClass %HWnd, 0
SubClass Rebar&,0

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

16.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

« Dieser Beitrag wurde als Lösung gekennzeichnet. »

Matthias
Arlt

Ich hab mir mal die Mühe gemacht und den Source etwas umgebaut und bereinigt. Dafür war ich gestern dann doch zu müde. Nun klappt das auch mit TabControl und TreeView. Sogar ohne FastMode. Jetzt kommen auch die Benachrichtigungen vom Rebar durch.

Kompilieren Markieren Separieren

'Rebar direkt auf HWND
 $H Windows.ph
 $H Messages.ph
 $H commctrl.ph
declare rect#
dim rect#,16

proc InitCommCtrl

    declare icc#
    dim icc#,16
    long icc#,0=8
    long icc#,4=$FFFF
    external("comctl32.dll","InitCommonControlsEx",icc#)
    dispose icc#

endproc

InitCommCtrl

proc RebarBandInfo

    parameters Rebar&,msg&,num&,mask&,style&,child&
    declare Rebar#
    style&=style&*128
    dim Rebar#,80
    long Rebar#,0=80
    long Rebar#,4=mask&
    long Rebar#,8=style&
    long Rebar#,32=child&
    long Rebar#,40=height(Rebar&) - 4
    long Rebar#,44=width(child&,1) + 4
    sendmessage(Rebar&,msg&,num&,Rebar#)
    dispose Rebar#

endproc

'{ SubClassProc:

SubClassProc

    If SubClassMessage(%hWnd, 78)

        If Long(&slparam,0) = Rebar&

            If (Long(&slparam,8) = -839) or (Long(&slparam,8) = -836)'RBN_CHILDSIZE oder RBN_ENDDRAG

                Resize
                Set("WinProc", 1)

            EndIf

        ElseIf Long(&slparam,0) = hTab&

            If Long(&slparam,8) = -551'TCN_SELCHANGE

                Resize
                Set("WinProc", 1)

            EndIf

        EndIf

    EndIf

EndProc

Proc Resize

    Setwindowpos Rebar& = 0,0-width(%hwnd),height(%hwnd)
    RebarBandInfo(Rebar&,1030,0,$71,2,hTab&)
    RebarBandInfo(Rebar&,1030,1,$71,1,hEdit&)
    clear rect#
    case GetActiveTab(hTab&)=0 : sendmessage(Rebar&,~RB_GETRECT,0,rect#)
    SetWindowPos TV& = Long(rect#,0),25 - (Long(rect#,8) - 12),(Long(rect#,12) - 29);1

EndProc

declare Rebar&,hList&,hEdit&,TV&,TVR1&,hDlg&,hTab&
Declare ActiveTab%,OldTab%
cls
'{ Rebarelemente:
hDlg& = Control("DIALOG","",$54000000,2,25,180,0,%hwnd,0,%hinstance)
hEdit&=create("MultiEdit",%hwnd,"",0,0,0,0)
'}
'{ Rebar:
ReBar&=Control("ReBarWindow32","",$50000804,0,0,width(%hwnd),height(%hwnd),%hwnd,1,0)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,0,$71,2,hDlg&)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,1,$71,1,hEdit&)
'}
'{ TabCtrl:
hTab& = Create("TabCtrl",hDlg&,"Test 3",0,0,180,0)
InsertTab(hTab&,0,"Test 2")
InsertTab(hTab&,0,"Test 1")
SendMessage(hTab&,~TCM_SETCURSEL,0,0)
'}
sendmessage(Rebar&,~RB_GETRECT,0,rect#)
SetWindowPos hDlg& = Long(rect#,0),Long(rect#,4),Long(rect#,8),Long(rect#,12);1
SetWindowPos hTab& = 0,0 - Width(hDlg&),Height(hDlg&);1
'{ Treeview:
TV& = Create("TreeView",hTab&,0,2,25,(Width(hTab&) - 6),(Height(hTab&) - 29))

WhileLoop 3

    TVR1& = TreeView("InsertItem",TV&,0,0,"Root " + Str$(&Loop))
    TreeView("SetChildren", TV&,TVR1&, 1)

    WhileLoop 5

        TreeView("InsertItem",TV&,TVR1&,0,"Eintrag " +Str$(&Loop))

    Wend

    TreeView("Expand", TV&, TVR1&, 3)

Wend

'}
'Hauptsachleife:
'set("FASTMODE",1)
SubClass %HWnd, 1
Resize

while 1

    waitinput
    case %key = 4 : Resize

wend

Und die Hauptschleife ist auf einmal gaaanz schlank...

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

20.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Matthias
Arlt

Das geht mit RB_SETBANDINFO. Die gleiche REBARBANDINFO-Struktur senden, separat für jedes Band und bei .cyMinChild&=height(hwnd&) für die Höhe und .cx&=width(hwndChild&) für die Breite einsetzen. Jeweils nach dem 'SetWindowPos Rebar&...' Das SubClassing ist dafür ggf. entbehrlich.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

16.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jörg
Sellmeyer

Danke, sowas hab ich befürchtet. Dieses Strukturgeschiebe will iwie nie so richtig in meinen Kopf rein.
Das Subclassing hab ich mal ausgeschaltet und es kommen tatsächlich trotzdem Ergebnisse. Allerdings nicht, wie gewünscht. Die Liste auf der linken Seite ändert ihre Größe, wenn sie sich auch nicht an die Größe des Rebars anpassen will

Das Multiedit reagiert leider gar nicht auf den Aufruf von Rebar("Resize",...)
Vielleicht ist dieses Rebar ja auch gar njicht wirklich gedacht für diesen Einsatz. Nach allem, was ich so gelesen habe, wird es eher als Toolbar eingesetzt, und nicht so sehr, um das Fenster zu strukturieren.

Kompilieren Markieren Separieren

'$I Rebar.inc
'{ Rebar.inc:
 $H Windows.ph
 $H Messages.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

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 | ~RBBS_CHILDEDGE,x%,y%,b%,h%,hParent&,0,$60300)

EndProc

Create("Container","Rebar")

SubProc Rebar.Resize

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

    With RebarInfo#

        .Size& = SizeOf(RebarInfo#)
        .Mask& = ~RBBIM_CHILDSIZE
        .cyMinChild& = cyMinChild&
        .cx& = cx&
        .hwndChild& = hwndChild&
        SendMessage(RB&,~RB_SETBANDINFO,0,RebarInfo#)

    EndWith

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 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

'Rebar.inc Ende
'}

SubClassProc

    If SubClassMessage(%hWnd, ~wm_sizing)

        Resize
        Set("WinProc", 0)

    EndIf

EndProc

Proc Resize

    SetWindowPos Rebar& = 0,0 - Width(%hwnd),(Height(%hwnd))
    Rebar("Resize",Rebar&,hList&,Height(Rebar&),Width(hList&))
    Rebar("Resize",Rebar&,hEdit&,Height(Rebar&),Width(hEdit&))

EndProc

Declare hList&, hTV&,hEdit&
Window 800,600
Var Rebar& = Create("Rebar",%hwnd,"",0,0,Width(%hwnd),Height(%hwnd),0)' wenn hier als letztes 1 angegeben wird, ist das RebarControl vertikal
hList& = Create("Listbox",%hwnd,0,0,0,0,0)
hEdit& = Create("MultiEdit",%hwnd,"",0,0,0,0)
Rebar("Add",Rebar&,hList&,50,Height(Rebar&)-10,Width(Rebar&) / 6)
Rebar("Add",Rebar&,hEdit&,50,Height(Rebar&),Width(Rebar&) / 8 * 6)
SubClass %HWnd, 0'SubClassing des Hauptfensters einschalten
SubClass Rebar&,   0'SubClassing des Rebar einschalten

While 1

    WaitInput

    If %Key = 4

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

    EndIf

Wend

SubClass %HWnd, 0
SubClass Rebar&,0

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

16.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Matthias
Arlt

So sollte es gehen. Da FreeProfan Deinen Code nicht mochte, hab ich das mal umgeschrieben. So ist es auch kompakter.

Kompilieren Markieren Separieren

proc InitCommCtrl

    declare icc#
    dim icc#,16
    long icc#,0=8
    long icc#,4=$FFFF
    external("comctl32.dll","InitCommonControlsEx",icc#)
    dispose icc#

endproc

InitCommCtrl

proc RebarBandInfo

    parameters Rebar&,msg&,num&,mask&,style&,child&
    declare Rebar#
    dim Rebar#,80
    long Rebar#,0=80
    long Rebar#,4=mask&
    long Rebar#,8=style&
    long Rebar#,32=child&
    long Rebar#,40=height(Rebar&)
    long Rebar#,44=width(child&)
    sendmessage(Rebar&,msg&,num&,Rebar#)
    dispose Rebar#

endproc

declare Rebar&,hList&,hEdit&
cls
hList&=create("Listbox",%hwnd,"",0,0,100,0)
hEdit&=create("MultiEdit",%hwnd,"",0,0,0,0)
ReBar&=Control("ReBarWindow32","",$50000804,0,0,width(%hwnd),height(%hwnd),%hwnd,1,0)
RebarBandInfo(Rebar&,1025,0,$71,256,hList&)
RebarBandInfo(Rebar&,1025,1,$71,128,hEdit&)

while 1

    waitinput
    setwindowpos Rebar& = 0,0-width(%hwnd),height(%hwnd)
    RebarBandInfo(Rebar&,1030,0,$71,256,hList&)
    RebarBandInfo(Rebar&,1030,1,$71,128,hEdit&)

wend

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

16.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Matthias
Arlt

Und was das "Strukturgeschiebe" angeht...so schlimm ist das gar nicht. Die komplette Struktur ist halt der je nach Control immer gleich aufgebaute Block an Informationen, die das Control für Erscheinungsbild und Funktion braucht. Die Infos stehen auch i.d.R. immer an gleicher Stelle im Block. Ich muß also je Aufruf immer nur die Stellen im Block schreiben, die sich geändert haben oder für mich von Interesse sind. Um bei unserem Beispiel zu bleiben:

Ich müßte nach der Größenänderung eigentlich nur die Stellen für height() und width() mit der Message RB_SETBANDINFO senden, denn die übrigen im Block enthaltenen Infos haben sich ja nicht geändert. Das Control hat sie ja bereits. Es schadet aber auch nicht, wenn ich mask, style, child usw. erneut auch mit sende. Ich spare mir in diesem Fall eine zweite Proc und kann für Erzeugung (RB_INSERTBAND) und Resizing (RB_SETBANDINFO) ein und die selbe verwenden.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

16.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jörg
Sellmeyer

Danke! Hat mich jetzt etwas Grübelarbeit gekostet, weil ich deinen Code erstmal wieder übersetzen und verstehen musste, da du z. B. Messagenummern, anstelle der commctrl-Bezeichner nimmst. Und ich wollte ja wissen, wo in meinem Code der Fehler ist.
Letztlich war es dann nur die fehlende Indexnummer, die meinen Code ausgebremst hat. Die hatte ich vergessen anzupassen.
sendmessage(Rebar&,msg&,num&,Rebar#)

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

16.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jörg
Sellmeyer

Wie bekomme ich denn jetzt mit, wenn mittels des Rebar-Anfassers die Controls verändert werden?
Ich hab ein Tabcontrol auf einem Band und da wiederum mehrere Controls drauf. Welche Message muss ich überwachen, um die Größenänderung dann auch anzuwenden.
Das Tabcontrol passt sich ja automatisch an aber die daraufliegenden Controls natürlich nicht.

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

17.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Matthias
Arlt

Die einfachste Möglichkeit wäre, nach dem 'waitinput' die Msg RB_GETRECT zu senden:

dim rect#,16
sendmessage(Rebar&,1033,BandNum&,rect#)

Die aktuellen Koordinaten des interessierenden Bands stehen dann in rect# zur weiteren Verwendung.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

17.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jörg
Sellmeyer

Das WaitInput wird nur nicht durchbrochen, wenn man das Band "zieht". Das heißt, das Band + Child werden korrekt angepasst, während das daraufliegende Trieview sich nicht ändert. Erst nach einem Klick oder Tastendruck wird das angepasst.

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

17.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Matthias
Arlt

Dann wirst Du an dieser Stelle doch auf Subclassing zurückgreifen müssen:

Kompilieren Markieren Separieren

subclass %hwnd,1

subclassproc

    if subclassmessage(%hwnd,78)

        if long(&slparam,0) = Rebar&

            ''hier RB_GETRECT senden...

        endif

    endif

endproc

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

17.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Jörg
Sellmeyer

Ich bekomme es nicht hin. Profan empfängt von dem Rebar keine Messages, scheint es mir.

Ich hab mal zwei Codevarianten erstellt. Einmal hab ich das Rebar-Control direkt aufs Hauptfenster gepappt, da blockiert das Programm, wenn ich die Subclass-Routine einbaue.
Zweitens liegt das Rebar-Control auf einem Dialog-Static. Da läuft das Programm zwar weiter aber es werden keine Messages ausgelöst, die das Subclassing aktivieren.
Hilfreich wäre es wahrscheinlich, wenn Profan da die Notify-Messages empfangen würde aber das Rebar leitet nichts davon an Profan weiter, bzw Profan empfängt die nicht

Es gibt eine Reihe von Notify-Messages, die genau passend dafür wären. ZB:

RBN_CHILDSIZE Sent by a rebar control when a band's child window is resized. This notification code is sent in the form of a WM_NOTIFY message.

[...]

Kompilieren Markieren Separieren

'Rebar direkt auf HWND
 $H Windows.ph
 $H Messages.ph
 $H commctrl.ph
declare rect#
dim rect#,16

proc InitCommCtrl

    declare icc#
    dim icc#,16
    long icc#,0=8
    long icc#,4=$FFFF
    external("comctl32.dll","InitCommonControlsEx",icc#)
    dispose icc#

endproc

InitCommCtrl

proc RebarBandInfo

    parameters Rebar&,msg&,num&,mask&,style&,child&
    declare Rebar#,wnd&
    wnd&=external("USER32","GetParent",Rebar&)
    style&=style&*128
    dim Rebar#,80
    long Rebar#,0=80
    long Rebar#,4=mask&
    long Rebar#,8=style&
    long Rebar#,32=child&
    long Rebar#,40=height(wnd&) - 4
    long Rebar#,44=width(child&,1) + 4
    sendmessage(Rebar&,msg&,num&,Rebar#)
    dispose Rebar#

endproc

'{ SubClassProc:

SubClassProc

    If SubClassMessage(%hWnd, 78)

        If Long(&slparam,0) = Rebar&

            'hier RB_GETRECT senden
            'sendmessage(Rebar&,1033,0,rect#)
            Resize

        EndIf

        Set("WinProc", 0)

    EndIf

EndProc

Proc Resize

    Clear rect#
    Setwindowpos Rebar& = 0,0-width(%hwnd),height(%hwnd)
    RebarBandInfo(Rebar&,1030,0,$71,2,hTab&)
    RebarBandInfo(Rebar&,1030,1,$71,1,hEdit&)
    sendmessage(Rebar&,~RB_GETRECT,0,rect#)
    SetWindowPos TV& = Long(rect#,0),25 - (Long(rect#,8) - 12),(Long(rect#,12) - 29)';1

EndProc

declare Rebar&,hList&,hEdit&,TV&,TVR1&,hDlg&,hTab&
Declare ActiveTab%,OldTab%
cls
'{ Rebarelemente:
hDlg& = Control("DIALOG","",$54000000,2,25,180,0,%hwnd,0,%hinstance)
hEdit&=create("MultiEdit",%hwnd,"",0,0,0,0)
'}
'{ Rebar:
ReBar&=Control("ReBarWindow32","",$50000804,0,0,width(%hwnd),height(%hwnd),%hwnd,1,0)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,0,$71,2,hDlg&)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,1,$71,1,hEdit&)
'}
'{ TabCtrl:
hTab& = Create("TabCtrl",hDlg&,"Test 3",0,0,180,0)
InsertTab(hTab&,0,"Test 2")
InsertTab(hTab&,0,"Test 1")
SendMessage(hTab&,~TCM_SETCURSEL,0,0)
'}
sendmessage(Rebar&,~RB_GETRECT,0,rect#)
SetWindowPos hDlg& = Long(rect#,0),Long(rect#,4),Long(rect#,8),Long(rect#,12);1
SetWindowPos hTab& = 0,0 - Width(hDlg&),Height(hDlg&);1
'{ Treeview:
TV& = Create("TreeView",hTab&,0,2,25,(Width(hTab&) - 6),(Height(hTab&) - 29))

WhileLoop 3

    TVR1& = TreeView("InsertItem",TV&,0,0,"Root " + Str$(&Loop))
    TreeView("SetChildren", TV&,TVR1&, 1)

    WhileLoop 5

        TreeView("InsertItem",TV&,TVR1&,0,"Eintrag " +Str$(&Loop))

    Wend

    TreeView("Expand", TV&, TVR1&, 3)

Wend

'}
SubClass %HWnd, 1
'Hauptsachleife:

while 1

    waitinput
    WindowTitle Str$(&NotifyWnd) + " " + Str$(Rebar&) + " " + Str$(%notifycode)
    ActiveTab% = GetActiveTab(hTab&)

    If OldTab% <> ActiveTab%

        ShowWindow(Tv&,ActiveTab% = 0)
        ActiveTab% = GetActiveTab(hTab&)

        If (ActiveTab% = 0)' and GetFocus(Rebar&)

            Resize
            '    SendMessage(hTab&,~TCM_SETCURSEL,0,0)

        EndIf

    EndIf

    If %key = 4

        Resize

    EndIf

    OldTab% = GetActiveTab(hTab&)

wend

SubClass %HWnd, 0

Kompilieren Markieren Separieren

'Rebar auf Dialog-Static
 $H Windows.ph
 $H Messages.ph
 $H commctrl.ph
declare rect#
dim rect#,16

proc InitCommCtrl

    declare icc#
    dim icc#,16
    long icc#,0=8
    long icc#,4=$FFFF
    external("comctl32.dll","InitCommonControlsEx",icc#)
    dispose icc#

endproc

InitCommCtrl

proc RebarBandInfo

    parameters Rebar&,msg&,num&,mask&,style&,child&
    declare Rebar#,wnd&
    wnd&=external("USER32","GetParent",Rebar&)
    style&=style&*128
    dim Rebar#,80
    long Rebar#,0=80
    long Rebar#,4=mask&
    long Rebar#,8=style&
    long Rebar#,32=child&
    long Rebar#,40=height(wnd&) - 4
    long Rebar#,44=width(child&,1) + 4
    sendmessage(Rebar&,msg&,num&,Rebar#)
    dispose Rebar#

endproc

'{ SubClassProc:

SubClassProc

    If SubClassMessage(%hWnd, 78)

        If Long(&slparam,0) = Rebar&

            'hier RB_GETRECT senden
            'sendmessage(Rebar&,1033,0,rect#)
            Resize

        EndIf

        Set("WinProc", 0)

    EndIf

EndProc

Proc Resize

    setwindowpos hRBDlg& = 0,0-width(%hwnd),height(%hwnd)
    Clear rect#
    setwindowpos Rebar& = 0,0-width(hRBDlg&),height(hRBDlg&)
    RebarBandInfo(Rebar&,1030,0,$71,2,hTab&)
    RebarBandInfo(Rebar&,1030,1,$71,1,hEdit&)
    sendmessage(Rebar&,~RB_GETRECT,0,rect#)
    SetWindowPos TV& = Long(rect#,0),25 - (Long(rect#,8) - 12),(Long(rect#,12) - 29)';1

EndProc

declare Rebar&,hList&,hEdit&,TV&,TVR1&,hDlg&,hTab&
Declare ActiveTab%,OldTab%
cls
'{ Rebarelemente:
hDlg& = Control("DIALOG","",$54000000,2,25,180,0,%hwnd,0,%hinstance)
hEdit&=create("MultiEdit",%hwnd,"",0,0,0,0)
'}
'{ Rebar:
Var hRBDlg& = Control("DIALOG","",$54000000,0,0,Width(%hwnd),Height(%hwnd),%hwnd,0,%hinstance)
ReBar&=Control("ReBarWindow32","",$50000804,0,0,width(hRBDlg&),height(hRBDlg&),hRBDlg&,1,0)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,0,$71,2,hDlg&)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,1,$71,1,hEdit&)
'}
'{ TabCtrl:
hTab& = Create("TabCtrl",hDlg&,"Test 3",0,0,180,0)
InsertTab(hTab&,0,"Test 2")
InsertTab(hTab&,0,"Test 1")
SendMessage(hTab&,~TCM_SETCURSEL,0,0)
'}
sendmessage(Rebar&,~RB_GETRECT,0,rect#)
SetWindowPos hDlg& = Long(rect#,0),Long(rect#,4),Long(rect#,8),Long(rect#,12);1
SetWindowPos hTab& = 0,0 - Width(hDlg&),Height(hDlg&);1
'{ Treeview:
TV& = Create("TreeView",hTab&,0,2,25,(Width(hTab&) - 6),(Height(hTab&) - 29))

WhileLoop 3

    TVR1& = TreeView("InsertItem",TV&,0,0,"Root " + Str$(&Loop))
    TreeView("SetChildren", TV&,TVR1&, 1)

    WhileLoop 5

        TreeView("InsertItem",TV&,TVR1&,0,"Eintrag " +Str$(&Loop))

    Wend

    TreeView("Expand", TV&, TVR1&, 3)

Wend

'}
SubClass %HWnd, 1
'Hauptsachleife:

while 1

    waitinput
    WindowTitle Str$(&NotifyWnd) + " " + Str$(Rebar&) + " " + Str$(%notifycode)
    ActiveTab% = GetActiveTab(hTab&)

    If OldTab% <> ActiveTab%

        ShowWindow(Tv&,ActiveTab% = 0)
        ActiveTab% = GetActiveTab(hTab&)

        If (ActiveTab% = 0)

            Resize

        EndIf

    EndIf

    If %key = 4

        Resize

    EndIf

    OldTab% = GetActiveTab(hTab&)

wend

SubClass %HWnd, 0
SubClass Rebar&, 0

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

19.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Matthias
Arlt

Nach ein paar kleinen Änderungen läuft es bei mir (unter 11.2 und FreeProfan32):

Kompilieren Markieren Separieren

'Rebar direkt auf HWND
 $H Windows.ph
 $H Messages.ph
 $H commctrl.ph
declare rect#
dim rect#,16

proc InitCommCtrl

    declare icc#
    dim icc#,16
    long icc#,0=8
    long icc#,4=$FFFF
    external("comctl32.dll","InitCommonControlsEx",icc#)
    dispose icc#

endproc

InitCommCtrl

proc RebarBandInfo

    parameters Rebar&,msg&,num&,mask&,style&,child&
    declare Rebar#
    style&=style&*128
    dim Rebar#,80
    long Rebar#,0=80
    long Rebar#,4=mask&
    long Rebar#,8=style&
    long Rebar#,32=child&
    long Rebar#,40=height(Rebar&) - 4
    long Rebar#,44=width(child&,1) + 4
    sendmessage(Rebar&,msg&,num&,Rebar#)
    dispose Rebar#

endproc

'{ SubClassProc:

SubClassProc

    If SubClassMessage(%hWnd, 78)

        If Long(&slparam,0) = Rebar&

            If Long(&slparam,8) = -14'NM_NCHITTEST

                Resize
                Set("WinProc", 1)

            EndIf

        EndIf

    EndIf

EndProc

Proc Resize

    Clear rect#
    Setwindowpos Rebar& = 0,0-width(%hwnd),height(%hwnd)
    RebarBandInfo(Rebar&,1030,0,$71,2,hTab&)
    RebarBandInfo(Rebar&,1030,1,$71,1,hEdit&)
    sendmessage(Rebar&,~RB_GETRECT,0,rect#)
    SetWindowPos TV& = Long(rect#,0),25 - (Long(rect#,8) - 12),(Long(rect#,12) - 29);1

EndProc

declare Rebar&,hList&,hEdit&,TV&,TVR1&,hDlg&,hTab&
Declare ActiveTab%,OldTab%
cls
'{ Rebarelemente:
hDlg& = Control("DIALOG","",$54000000,2,25,180,0,%hwnd,0,%hinstance)
hEdit&=create("MultiEdit",%hwnd,"",0,0,0,0)
'}
'{ Rebar:
ReBar&=Control("ReBarWindow32","",$50000804,0,0,width(%hwnd),height(%hwnd),%hwnd,1,0)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,0,$71,2,hDlg&)
RebarBandInfo(Rebar&,~RB_INSERTBANDA,1,$71,1,hEdit&)
'}
'{ TabCtrl:
hTab& = Create("TabCtrl",hDlg&,"Test 3",0,0,180,0)
InsertTab(hTab&,0,"Test 2")
InsertTab(hTab&,0,"Test 1")
SendMessage(hTab&,~TCM_SETCURSEL,0,0)
'}
sendmessage(Rebar&,~RB_GETRECT,0,rect#)
SetWindowPos hDlg& = Long(rect#,0),Long(rect#,4),Long(rect#,8),Long(rect#,12);1
SetWindowPos hTab& = 0,0 - Width(hDlg&),Height(hDlg&);1
'{ Treeview:
TV& = Create("TreeView",hTab&,0,2,25,(Width(hTab&) - 6),(Height(hTab&) - 29))

WhileLoop 3

    TVR1& = TreeView("InsertItem",TV&,0,0,"Root " + Str$(&Loop))
    TreeView("SetChildren", TV&,TVR1&, 1)

    WhileLoop 5

        TreeView("InsertItem",TV&,TVR1&,0,"Eintrag " +Str$(&Loop))

    Wend

    TreeView("Expand", TV&, TVR1&, 3)

Wend

'}
'Hauptsachleife:
SubClass %HWnd, 1

while 1

    waitinput
    Resize
    WindowTitle Str$(&NotifyWnd) + " " + Str$(Rebar&) + " " + Str$(%notifycode)
    ActiveTab% = GetActiveTab(hTab&)

    If OldTab% <> ActiveTab%

        ShowWindow(Tv&,ActiveTab% = 0)
        ActiveTab% = GetActiveTab(hTab&)

        If (ActiveTab% = 0)' and GetFocus(Rebar&)

            Resize
            'SendMessage(hTab&,~TCM_SETCURSEL,0,0)

        EndIf

    EndIf

    If %key = 4

        Resize

    EndIf

    OldTab% = GetActiveTab(hTab&)

wend

SubClass %HWnd, 0

Ein weiteres Resize nach dem WaitInput war notwendig und die Auswertung von NM_NCHITTEST im SubClassing. Eleganter wäre RBN_ENDDRAG gewesen, dringt aber dort nicht durch. Ich denke, so geht das sicher auch...

Nachtrag: Mit den gleichen Änderungen läuft es auch mit dem Dialog als Parent. Das SubClassing muß dann natürlich für den Dialog erfolgen, statt für %HWND.

WinXP SP2, Win7 - XProfan 10/11/FreeProfan32 - Xpia

19.06.2020 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

►