Italia
Fonte/ Codesnippets

TabControl mit "neu"-Tab und "Schließen-X"

 

Jens-Arne
Reumschüssel
Hier wie versprochen (siehe  [...]  ) der Quelltext per TabControls mit "neu"-Tab und "Schließen-X" auf den Tabs. Alles in reinem XProfanX4 geschrieben.

'TabControl mit "neu"-Tab und "Schließen-X"

$H windows.ph
$H messages.ph
$H commctrl.ph

STRUCT S_RECT=left&,top&,right&,bottom&
STRUCT S_DRAWITEMSTRUCT=CtlType&,CtlID&,itemID&,itemAction&,itemState&,hwndItem&,hDC&,rcX1&,rcY1&,rcX2&,rcY2&,itemData&
STRUCT S_TCITEM=mask&,dwState&,dwStateMask&,pszText&,cchTextMax&,iImage&,lParam&

declare _hTC%,_hIL%,_hBMP%,_hWhiteBrush%,_hIclose%,_ende%,_MaxTab%,_TabNr%

SUBCLASSPROC
declare dis#,rect#,tcitem#,b#,t$,mx%,my%,i%,o%
if &sWnd=%HWnd
'{ 'Schließen-X auf Tabs malen
if %sMessage=~WM_DRAWITEM
dim dis#,S_DRAWITEMSTRUCT
dis#=&slParam
if dis#.hwndItem&=_hTC%
dim rect#,S_RECT
dim tcitem#,S_TCITEM
rect#.left&=dis#.rcX1&+~GetSystemMetrics(~SM_CXEDGE)
rect#.top&=dis#.rcY1&+~GetSystemMetrics(~SM_CYEDGE)
rect#.right&=dis#.rcX2&-~GetSystemMetrics(~SM_CXEDGE)
rect#.bottom&=dis#.rcY2&
tcitem#.mask&=~TCIF_TEXT | ~TCIF_STATE
tcitem#.dwStateMask&=$FFFFFFFF
dim b#,1000
tcitem#.psztext&=b#
tcitem#.cchtextmax&=1000
@sendmessage(_hTC%,~TCM_GETITEMA,dis#.itemID&,tcitem#)
if TCITEM#.dwstate&=1
~FillRect(dis#.hDC&,rect#,_hWhiteBrush%)
~SetBkMode(dis#.hDC&,~TRANSPARENT)
rect#.left&=rect#.left&+4
rect#.top&=rect#.top&+2
endif
t$=@string$(b#,0)
dispose b#
'~selectobject(DIS#.hDC&,_hTabFont)
~drawtext(dis#.hDC&,@addr(t$),-1,rect#,~DT_LEFT | ~DT_SINGLELINE)
if tcitem#.dwstate&<>1
rect#.right&=rect#.right&+4
endif
if t$<>" *neu"
~DrawIconEx(dis#.hDC&,rect#.right&-16-2,rect#.top&,_hIclose%,16,16,0,0,~DI_IMAGE | ~DI_MASK)
endif
dispose rect#,tcitem#
endif
dispose dis#
endif
'}
elseif &sWnd=_hTC%
'{ 'Schließen-X oder "*neu"-Tab angeklickt
if %smessage=~WM_LBUTTONDOWN
mx%=@mouseabsx()
my%=@mouseabsy()
dim rect#,S_RECT
for i%,0,_MaxTab%-1
@sendmessage(_hTC%,~TCM_GETITEMRECT,i%,rect#)
if i%<_MaxTab%-1
if (mx%>=rect#.right&-16-2+@GetAbsWindowPosX1(_hTC%)) and (mx%<=rect#.right&+@GetAbsWindowPosX1(_hTC%)) and (my%>=rect#.top&+@GetAbsWindowPosY1(_hTC%)) and (my%<=rect#.top&+16+@GetAbsWindowPosY1(_hTC%))
@sendmessage(_hTC%,~TCM_DELETEITEM,i%,0)
dec _MaxTab%
'for o%,0,_MaxTab%-2
' settext _hTC%,o%,"Tab "+@str$(o%+1)+" "
'endfor 'o%
break
endif
else
if (mx%>=rect#.left&+@GetAbsWindowPosX1(_hTC%)) and (mx%<=rect#.right&+@GetAbsWindowPosX1(_hTC%)) and (my%>=rect#.top&+@GetAbsWindowPosY1(_hTC%)) and (my%<=rect#.bottom&+@GetAbsWindowPosY2(_hTC%))
inc _TabNr%
inserttab(_hTC%,_MaxTab%-1,"Tab "+@str$(_TabNr%)+" ")
inc _MaxTab%
break
endif
endif
endfor 'i%
dispose rect#
endif
'}
endif
ENDPROC 'SUBCLASSPROC

'{ 'Hilfsfunktionen
PROC MouseAbsX
Declare Point#,XX&
Dim Point#,8
@external("user32.dll","GetCursorPos",Point#)
XX&=@long(Point#,0)
Dispose Point#
Return XX&
ENDPROC 'MouseAbsX
PROC MouseAbsY
Declare Point#,YY&
Dim Point#,8
@external("user32.dll","GetCursorPos",Point#)
YY&=@long(Point#,4)
Dispose Point#
Return YY&
ENDPROC 'MouseAbsY
PROC GetAbsWindowPosX1
parameters hW&
declare b#,ret&
dim b#,4*4
@external("user32.dll","GetWindowRect",hW&,b#)
ret&=@long(b#,0)
dispose b#
return ret&
ENDPROC 'GetAbsWindowPosX1
PROC GetAbsWindowPosY1
parameters hW&
declare b#,ret&
dim b#,4*4
@external("user32.dll","GetWindowRect",hW&,b#)
ret&=@long(b#,4)
dispose b#
return ret&
ENDPROC 'GetAbsWindowPosY1
PROC GetAbsWindowPosX2
'Es wird die absolute Position ermittelt! Für Breite/Höhe GetWindowSpan verwenden!
parameters hW&
declare b#,ret&
dim b#,4*4
@external("user32.dll","GetWindowRect",hW&,b#)
ret&=@long(b#,8)
dispose b#
return ret&
ENDPROC 'GetAbsWindowPosX2
PROC GetAbsWindowPosY2
'Es wird die absolute Position ermittelt! Für Breite/Höhe GetWindowSpan verwenden!
parameters hW&
declare b#,ret&
dim b#,4*4
@external("user32.dll","GetWindowRect",hW&,b#)
ret&=@long(b#,12)
dispose b#
return ret&
ENDPROC 'GetAbsWindowPosY2
'}


'Hauptprogramm:
cls
usermessages $10
_hWhiteBrush%=~CreateSolidBrush(@rgb(255,255,255))
_hBMP%=Create("HPIC",0,"TOOLBAR")
_hIL%=@Create("IMAGELIST",16,16,_hBMP%,@rgb(192,192,192))
_hIclose%=~ImageList_GetIcon(_hIL%,10,~ILD_NORMAL)
deleteobject _hBMP%
_hTC%=@Create("TABCTRL",%HWnd,_hIL%,0,0,@width(%HWnd),24)
setstyle _hTC%,@getstyle(_hTC%) | ~TCS_OWNERDRAWFIXED
@set("FASTMODE",1)
subclass %HWnd,1
subclass _hTC%,1
inserttab(_hTC%,1,"Tab 1 ") 'drei Spaces rechts, damit das Schließen-X-Icon hineinpasst
inserttab(_hTC%,1,"Tab 2 ")
inserttab(_hTC%,2," *neu")
waitinput 1 'TabControl 1x Mostra
@set("FASTMODE",0) 'Fastmode kann jetzt wieder ausgeschaltet werden
_MaxTab%=3
_TabNr%=2
while _ende%=0
waitinput
if (%uMessage=$10) or ((~GetForegroundWindow()=%HWnd) and @iskey(27))
while @iskey(27)
sleep 25
endwhile
_ende%=1
endif
endwhile
subclass _hTC%,0
subclass %HWnd,0
deleteobject _hIL%
deleteobject _hWhiteBrush%
deleteobject _hIclose%
usermessages 0
end

Saluto, Jens-Arne
 
XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win11 Pro 64bit * PC i7-7700K@4,2GHz, 32 GB RAM
PM: jreumsc@web.de
18.09.2022  
 




RudiB.
Das ist ja Spitze....richtig gut !!! Nur eins habe ich festgestellt.
Beim löschen eines Tabs, sollte da nicht auch genau z.B. Tab3 gelöscht werden, und nicht immer der zuletzt erzeugte Tab.
Habe mal 10 Tabs erzeugt und Tab1 löschen wollen. Bis zum bitteren Ende blieb Tab1.
Oder soll das so sein ?
Aber sonst genial....kann man auch leicht abändern. Ich werd mal was probieren.
Saluto aus München
Rudi
 
XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM
18.09.2022  
 




Jens-Arne
Reumschüssel
Ja, das sollte per das Beispiel tatsächlich so sein. Aber wenn ich mir das jetzt recht überlege, ist das naturalmente in der Tat Quatsch. Ich habe das Beispiel daher angepasst. Jetzt bleiben die Beizeichnungen der Tabs erhalten, wenn man einen löscht.

Saluto, Jens-Arne
 
XProfan X4
XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win11 Pro 64bit * PC i7-7700K@4,2GHz, 32 GB RAM
PM: jreumsc@web.de
19.09.2022  
 




Sven
Bader
Danke per den tollen Code! Sowohl Redraw als auch Mausposition sind ja wirklich fummelig aber es scheint der einzige Weg zu sein. Für meine Bedürfnisse hat ein Multiplikationszeichen × zum schließen gereicht, weshalb ich mir zumindest den Ownder-Draw sparen kann. Mit Stukturen statt Hilfsfunktionen ist es noch etwas kürzer geworden.

Wer es brauchen kann hier mein angepasster Code.

Viele Grüße

Sven
'TabControl mit "neu"-Tab und "Schließen-X"
 $H windows.ph
 $H messages.ph
 $H commctrl.ph
STRUCT S_RECT      = left&,top&,right&,bottom&
STRUCT S_TABRECT   = x1&,y1&,x2&,y2&
STRUCT S_MOUSE     = mx&,my&
declare tabcontrol&,_hIL%,_ende%,_MaxTab%,_TabNr%, hFont%

SUBCLASSPROC

    declare rect#,i%,o%,tabrect#,mouse#

    If SubClassMessage(Tabcontrol&, ~WM_LBUTTONDOWN)

        '{ 'Schließen-X oder "*neu"-Tab angeklickt
        dim rect#,S_RECT
        dim mouse#,S_MOUSE
        dim tabrect#,S_TABRECT
        external("user32.dll","GetCursorPos",mouse#)
        external("user32.dll","GetWindowRect",Tabcontrol&,tabrect#)
        for i%,0,_MaxTab%-1
        sendmessage(Tabcontrol&,~TCM_GETITEMRECT,i%,rect#)

        if i%<_MaxTab%-1

            if (mouse#.mx&>=rect#.right&-16-2+tabrect#.x1&) and (mouse#.mx&<=rect#.right&+tabrect#.x1&) and (mouse#.my&>=rect#.top&+tabrect#.y1&) and (mouse#.my&<=rect#.top&+16+tabrect#.y1&)

                sendmessage(Tabcontrol&,~TCM_DELETEITEM,i%,0)
                dec _MaxTab%
                break

            endif

        else

            if (mouse#.mx&>=rect#.left&+tabrect#.x1&) and (mouse#.mx&<=rect#.right&+tabrect#.x1&) and (mouse#.my&>=rect#.top&+tabrect#.y1&) and (mouse#.my&<=rect#.bottom&+tabrect#.x2&)

                inc _TabNr%
                inserttab(Tabcontrol&,_MaxTab%-1,"Tab "+str$(_TabNr%)+"  × ")
                inc _MaxTab%
                break

            endif

        endif

        endfor'i%
        dispose rect#, mouse#, tabrect#
        '}

    endif

ENDPROC'SUBCLASSPROC

'Hauptprogramm:
cls
hFont% = Create("Font","segoe ui",16,0,0,0,0)
SetDialogFont  hFont%
usermessages $10
Tabcontrol&=Create("TABCTRL",%HWnd,_hIL%,0,0,width(%HWnd),24)
subclass Tabcontrol&,1
set("FASTMODE",1)
inserttab(Tabcontrol&,1,"Tab 1  × ")'drei Spaces rechts, damit das Schließen-X-Icon hineinpasst
inserttab(Tabcontrol&,1,"Tab 2  × ")
inserttab(Tabcontrol&,2,"  *neu")
waitinput 1'TabControl 1x Mostra
set("FASTMODE",0)'Fastmode kann jetzt wieder ausgeschaltet werden
_MaxTab%=3
_TabNr%=2

while _ende%=0

    waitinput

    if (%uMessage=$10) or ((~GetForegroundWindow()=%HWnd) and iskey(27))

        while iskey(27)

            sleep 25

        endwhile

        _ende%=1

    endif

endwhile

subclass Tabcontrol&,0
usermessages 0
end

So sieht es dann im fertigen Programm aus:


78 kB
Hochgeladen:14.03.2023
Downloadcounter61
Download
 
14.03.2023  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

2.629 Views

Untitledvor 0 min.
Member 862464112.05.2024
Axel Berse08.11.2023
Sven Bader31.08.2023
Thomas Zielinski28.06.2023
Di più...

Themeninformationen



Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


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