Deutsch
Quelltexte/ Codesnippets

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

 

Jens-Arne
Reumschüssel
Hier wie versprochen (siehe  [...]  ) der Quelltext für 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 anzeigen
@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

Gruß, Jens-Arne
 
XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win10 64bit * PC i7-7700K@4,2GHz, 16 GB Hauptspeicher
PM: jreumsc@web.de
vor 18 Tagen  
 




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.
Gruß aus München
Rudi
 
XProfan X4
Xprofan X4

Rudolf Beske / München
vor 18 Tagen  
 




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

Gruß, Jens-Arne
 
XProfan X4
XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win10 64bit * PC i7-7700K@4,2GHz, 16 GB Hauptspeicher
PM: jreumsc@web.de
vor 17 Tagen  
 



Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

83 Betrachtungen

Unbenanntvor 0 min.
HofK vor 5 Tagen
Georg Teles vor 5 Tagen
RudiB. vor 5 Tagen
Thomas Freier vor 10 Tagen
Mehr...

Themeninformationen

Dieses Thema hat 2 Teilnehmer:

Jens-Arne Reumschüssel (2x)
RudiB. (1x)


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

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