XProfan

Italia

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 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

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 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

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 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

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

Kompilieren Markieren Separieren

'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