XProfan

English

Jörg
Sellmeyer

probably überseh I strain something utterly Banales but I bekomm not there, the level this Rebar-Controls To Change. The wide fit itself Yes wonderful automatically on, but the Things reacted not at all on SetWindowPos.

Compile Mark Separation

'$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' herewith becomes the Rebar-Control activate
    Long cmctrl#,4=$FFFF'---everything 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&' 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

'Rebar.inc end
'}
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)' if here as letztes 1 indicated becomes, is the RebarControl Mouse and Sprite
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 the Mainwindow on
SubClass Rebar&,   1'SubClassing the Rebar on

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

06/16/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

« this Posting watts as Solution marked. »

Matthias
Arlt

I Have me times the trouble made and the Source something rebuilt and bereinigt. For this i was yesterday then still To tired. now works the too with TabControl and TreeView. even without FastMode. now come too The Benachrichtigungen of Rebar through.

Compile Mark Separation

'Rebar directly on 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 or 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

and the Hauptschleife is at a single blow gaaanz slender...

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

06/20/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

the goes with RB_SETBANDINFO. The same REBARBANDINFO-structure Send, self-contained for each volume and with .cyMinChild&=height(hwnd&) for Höhe and .cx&=width(hwndChild&) for wide bring into action. Jeweils to the 'SetWindowPos Rebar&...' the SubClassing is for ggf. entbehrlich.

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

06/16/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

thanks, something like Have I befürchtet. this Strukturgeschiebe wants iwie never so correctly. in my head mere.
the Subclassing Have I time off and it come objectively nevertheless Results. though not, How desired. The list on the left Page changes your Size, as they itself neither on The Size the Rebars adjust wants

the MultiEdit reacted unfortunately none on the appeal of Rebar("Resize",...)
Perhaps is this Rebar indeed quite njicht really virtual for this employment. After everything, I so red have, becomes it sooner as Toolbar inserted, and not so very, around the Window To strukturieren.

Compile Mark Separation

'$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' herewith becomes the Rebar-Control activate
    Long cmctrl#,4=$FFFF'---everything 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&' 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

'Rebar.inc end
'}

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)' if here as letztes 1 indicated becomes, is the RebarControl Mouse and Sprite
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 the Mainwindow on
SubClass Rebar&,   0'SubClassing the Rebar on

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

06/16/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

so ought to it weg. there FreeProfan your Sourcecode not liked, Have I the time rewritten. so is it too kompakter.

Compile Mark Separation

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

06/16/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

and what the "Strukturgeschiebe" angeht...so bad is the none. The complete structure is hold the according to Control always same aufgebaute block on Information, The the control for Erscheinungsbild and function need. The Info stand too i.d.R. always on same place in the block. I must means apiece appeal always only The to put in the block write, which changed having or for me of interest are. circa with unserem example To stay:

I should to the Resize really only The to put for height() and width() with the Message RB_SETBANDINFO Send, because The übrigen in the block encompassed Info having itself Yes not changed. the Control has tappt im dunkeln Yes already. it harm but neither, if I mask, style, child etc. anew too with send. I save me in this drop a second Proc and can for Erzeugung (RB_INSERTBAND) and Resizing (RB_SETBANDINFO) one and the same use.

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

06/16/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

thanks! has me now something Grübelarbeit cost[ed], because I your code first again translate and understand had, there You z. B. Messagenummern, in lieu of the commctrl-Bezeichner take. what about me wished Yes know, where in my code the Error is.
Letztlich was is then only The fehlende Indexnummer, The my code ausgebremst has. The I had forgotten anzupassen.
sendmessage(Rebar&,msg&,num&,Rebar#)

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

06/16/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

How do I get because now with, if through the Rebar-Anfassers The Controls changed go?
I Have one TabControl on one volume and there against several Controls on it. which Message must I to supervise, around the Resize then too anzuwenden.
the TabControl fit itself Yes automatically on but the daraufliegenden Controls naturally not.

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

06/17/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

The simplest Possibility would, to the 'waitinput' The Msg RB_GETRECT To Send:

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

The actually Coordinates the interessierenden Bands stand then in rect# to further usage.

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

06/17/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

the WaitInput becomes only not durchbrochen, if to the volume "zieht". that is, the volume + Child go correctly adjusted, during the daraufliegende Trieview not changes. first to one Click or Tastendruck becomes the adjusted.

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

06/17/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

then become You on this place still on Subclassing zurückgreifen must:

Compile Mark Separation

subclass %hwnd,1

subclassproc

    if subclassmessage(%hwnd,78)

        if long(&slparam,0) = Rebar&

            ''here RB_GETRECT Send...

        endif

    endif

endproc

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

06/17/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

I get not there. Profan receiving from the Rebar no Messages, shining it me.

I Have time two Codevarianten prepares. once Have I the Rebar-Control directly aufs Mainwindow gepappt, there blockiert the program, if I The Subclass-routine einbaue.
secondly lying the Rebar-Control on one dialog-Static. there runs the program of course moreover but it go no Messages triggered, The the Subclassing enable.
helpful would it probably, if Profan since the Notify-Messages receive would but the Rebar heading nothing of it to profane moreover, or Profan receiving The not

there's a row of Notify-Messages, The very properly for wären. ZB:

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

[...]

Compile Mark Separation

'Rebar directly on 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&

            'here RB_GETRECT Send
            '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
    Window Title 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

Compile Mark Separation

'Rebar on dialogue-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&

            'here RB_GETRECT Send
            '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
    Window Title 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 ...

06/19/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Matthias
Arlt

after a couple small Changes runs it by me (under 11.2 and FreeProfan32):

Compile Mark Separation

'Rebar directly on 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
    Window Title 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

One further Resize to the WaitInput was necessary and the Auswertung of NM_NCHITTEST in the SubClassing. Eleganter would RBN_ENDDRAG been, dringt but there not through. i think, so does it sure too...

Nachtrag: with the equal Changes runs it too with the dialog as Parent. the SubClassing must then naturally for dialog erfolgen, instead of for %HWND.

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

06/19/20 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

►