/* * Xailer source code: * * Tabs.prg * Clase TTabs * * Copyright 2003, 2016 Ignacio Ortiz de Zuñiga * Copyright 2003, 2016 José Giménez * Copyright 2003, 2016 Xailer.com * All rights reserved * */ #include "Xailer.ch" //-------------------------------------------------------------------------- CLASS XTabs FROM TScrollingWinControl PUBLISHED: PROPERTY oImageList AS TImageList EDITOR PE_ImageList PROPERTY aItems INIT {} EDITOR PE_StringList WRITE METHOD SetItems AS TTabsItem[] PROPERTY nWidth INIT 200 PROPERTY nHeight INIT 200 PROPERTY nAlign INIT alNONE PROPERTY nClrPane INIT clWindow PROPERTY nTabsClrPane EDITOR PE_Color WRITE METHOD SetTabsClrPane INIT clBtnFace PROPERTY nTabsClrPaneSel EDITOR PE_Color WRITE METHOD SetTabsClrPaneSel INIT clWindow PROPERTY nTabsClrPaneHot EDITOR PE_Color WRITE METHOD SetTabsClrPaneHot INIT clGradientInActiveCaption PROPERTY nTabsClrPen EDITOR PE_Color WRITE METHOD SetTabsClrPen INIT cl3DLight PROPERTY nTabsClrText EDITOR PE_Color WRITE METHOD SetTabsClrText INIT clWindowText PROPERTY nTabsClrTextHot EDITOR PE_Color WRITE METHOD SetTabsClrTextHot INIT clWindowText PROPERTY nTabsClrTextSel EDITOR PE_Color WRITE METHOD SetTabsClrTextSel INIT clWindowText PROPERTY nTabsSize INIT 24 WRITE INLINE ::FnTabsSize := Value, ::Refresh( .T. ) EDITOR PE_Scale PROPERTY nTabsMargin INIT 0 WRITE INLINE ::FnTabsMargin := Value, ::Refresh( .T. ) EDITOR PE_Scale PROPERTY nOrientation INIT orTOP VALUES orLEFT, orTOP, orRIGHT, orBOTTOM ; WRITE INLINE ( ::FnOrientation := Value, ::Refresh( .T. ) ) PROPERTY nIndex INIT 0 WRITE METHOD SetIndex PROPERTY nItemPadding INIT 10 WRITE INLINE ::FnItemPadding := Value, ::Refresh( .T. ) EDITOR PE_Scale PROPERTY nPhantomImage INIT 0 WRITE INLINE ::FnPhantomImage := Value, ::Refresh( .T. ) PROPERTY nFrame INIT tfNONE VALUES tfNONE, tfTABS, tfALL ; WRITE INLINE ( ::FnFrame := Value, ::Refresh( .T. ) ) PROPERTY lFixedWidth INIT .F. WRITE INLINE ::FlFixedWidth := Value, ::Refresh( .T. ) PROPERTY lTabCloseButtons INIT .F. WRITE INLINE ::FlTabCloseButtons := Value, ::Refresh( .T. ) PROPERTY lPhantomTab INIT .F. WRITE INLINE ::FlPhantomTab := Value, ::Refresh( .T. ) PROPERTY lSameFrameSize INIT .F. WRITE INLINE ::FlSameFrameSize := Value, ::Refresh( .T. ) PROPERTY lShowTabsMenu INIT .F. WRITE INLINE ::FlShowTabsMenu := Value, ::Refresh( .T. ) PROPERTY lTabsCanMove INIT .F. PROPERTY lTabStop INIT .F. PROPERTY lTransparent INIT .F. PROPERTY lShowActive INIT .T. PROPERTY nOpacity INIT 0 EVENT OnDrawTabsBackground( oSender, hDC, aRect ) // --> lResult EVENT OnDrawTab( oSender, nIndex, @cText, @nImage, @nClrText, @nClrPane, nState, hDC, aRect ) // --> lResult EVENT OnNewTab( oSender ) // --> Nil EVENT OnChanging( oSender, nIndex, nFromTab ) // --> Nil | lResult EVENT OnChange( oSender, nIndex, nFromTab ) // --> Nil EVENT OnCalcRect( oSender, nIndex, BYREF aRect ) // --> Nil EVENT OnClick( oSender, nIndex, nX, nY ) // --> Nil EVENT OnRClick( oSender, nIndex, nX, nY ) // --> Nil EVENT OnCloseTab( oSender, nIndex ) // --> Nil PUBLIC: METHOD New( oParent ) CONSTRUCTOR METHOD Create( oParent ) CONSTRUCTOR METHOD Free() METHOD Scale( nScale ) METHOD Refresh( lRedraw ) METHOD AddItem( cText, nImage, cTooltip, nSize, nAlignment, nBmpAlignment, lVisible, lEnabled ) ; INLINE ::InsertItem( Nil, cText, nImage, cTooltip, nSize, nAlignment, nBmpAlignment, lVisible, lEnabled ) // --> oTabItem METHOD InsertItem( nItem, cText, nImage, cTooltip, nSize, nAlignment, nBmpAlignment, lVisible, lEnabled ) // --> oTabItem METHOD DeleteItem( nItem ) // --> Nil METHOD DeleteItems() // --> Nil METHOD MoveTab( nFrom, nTo ) // --> lResult METHOD SaveState() // --> cString METHOD RestoreState( cState ) // --> lResult RESERVED: DATA oTabsClrPane AS TBrush DATA oTabsClrPaneSel AS TBrush DATA oTabsClrPaneHot AS TBrush DATA oTabsPen AS TPen DATA aPaintRect, aPhantomRect, aMarginRect, aPointClick, aPrevRect, aNextRect DATA nHot INIT 0 DATA nFloat INIT 0 METHOD SetItems( aItems ) METHOD SetIndex( nIndex, lTriggerOnChange ) METHOD SetShortCuts() METHOD ShortCut( cKey ) METHOD Changing( nIndex, nFromTab ) METHOD Changed( nIndex, nFromTab ) INLINE ::OnChange( nIndex, nFromTab ) METHOD SetTooltipZones() METHOD CalcItemsRect( nLeft, nTop, nRight, nBottom ) METHOD GetItemRect( nItem, lClient ) METHOD TabIsFirst( nItem ) METHOD TabIsLast( nItem ) METHOD FirstTab() METHOD LastTab() METHOD TabDrop() METHOD ShowTabsList() METHOD ShowTab( oTab ) METHOD PaintTabs( hDC ) METHOD PaintFrame( hDC ) METHOD PaintPhantomTab( hDC ) METHOD RedrawNonClient() INLINE RedrawWindow( ::Handle, 0, 0, nOr( RDW_FRAME , RDW_INVALIDATE ) ) METHOD WMNCHitTest() METHOD WMNCCalcSize() METHOD WMNCPaint() METHOD WMNCLButtonDown( wParam, lParam, hWnd ) INLINE ::NCButtonDown( .T., wParam, lParam, hWnd ) METHOD WMNCLButtonUp( wParam, lParam, hWnd ) METHOD WMNCRButtonDown( wParam, lParam, hWnd ) INLINE ::NCButtonDown( .F., wParam, lParam, hWnd ) METHOD WMNCMouseLeave( wParam, lParam, hWnd ) METHOD WMNCMouseMove( wParam, lParam, hWnd ) METHOD WMKillFocus( hCtl ) INLINE ( ::Super:WMKillFocus( hCtl ),; IIf( GetParent( hCtl ) != ::Handle, ::RedrawNonClient(), ) ) METHOD WMSetFocus( hCtl ) INLINE ( ::Super:WMSetFocus( hCtl ),; IIf( GetParent( hCtl ) != ::Handle, ::RedrawNonClient(), ) ) METHOD WMNotify() EXTERN XControl_WMNotify() METHOD WMKeyDown( nKey, nFlags, hWnd ) METHOD WMEraseBkgnd() INLINE 1 METHOD WMPaint() EXTERN XWinControl_WMEraseBkgnd() METHOD WMPrintClient() PUBLISHED: PROPERTY cTooltip PROPERTY cToolTipTitle PROPERTY nToolTipIcon PROPERTY cText PROPERTY nClrText PROTECTED: PROPERTY nBorderStyle INIT bvNONE PROPERTY lBorder INIT .F. DATA nClassStyle INIT nOr( CS_HREDRAW, CS_VREDRAW ) DATA nStartTab INIT 1 DATA lHotTrack INIT .F. DATA lNoSpace INIT .F. METHOD SetTabsClrPane( Value ) METHOD SetTabsClrPaneSel( Value ) METHOD SetTabsClrPaneHot( Value ) METHOD SetTabsClrText( Value ) METHOD SetTabsClrTextSel( Value ) METHOD SetTabsClrTextHot( Value ) METHOD SetTabsClrPen( Value ) METHOD NCHotPos( nlParam ) // --> nPos METHOD NCButtonDown( lLeft, wParam, lParam, hWnd ) METHOD NextTab( lPrev ) ENDCLASS //-------------------------------------------------------------------------- METHOD New( oParent ) CLASS XTabs ::Super:New( oParent ) ::oImageList := TImageList():Create( Self ) ::oTabsClrPane := TBrush():Create( Nil, ::nTabsClrPane ) ::oTabsClrPaneSel := TBrush():Create( Nil, ::nTabsClrPaneSel ) ::oTabsClrPaneHot := TBrush():Create( Nil, ::nTabsClrPaneHot ) ::oTabsPen := TPen():Create( Nil, Nil, ::nTabsClrPen ) RETURN Self //-------------------------------------------------------------------------- METHOD Create( oParent ) CLASS XTabs DEFAULT ::oImageList TO TImageList():Create( Self ) DEFAULT ::oTabsClrPane TO TBrush():Create( Nil, ::nTabsClrPane ) DEFAULT ::oTabsClrPaneSel TO TBrush():Create( Nil, ::nTabsClrPaneSel ) DEFAULT ::oTabsClrPaneHot TO TBrush():Create( Nil, ::nTabsClrPaneHot ) DEFAULT ::oTabsPen TO TPen():Create( Nil, Nil, ::nTabsClrPen ) ::Super:Create( oParent ) ::SetShortCuts() ::SetTooltipZones() ::SetIndex( ::FnIndex, .F. ) RETURN Self //-------------------------------------------------------------------------- METHOD Free() CLASS XTabs AEval( ::aItems, {|v| v:Free() } ) IF ::oImageList != NIL .AND. ::oImageList:oParent == Self ::oImageList:End() ::oImageList := NIL ENDIF ::oTabsClrPane:End() ::oTabsClrPaneSel:End() ::oTabsClrPaneHot:End() ::oTabsPen:End() ::oTabsClrPane := NIL ::oTabsClrPaneSel := NIL ::oTabsClrPaneHot := NIL ::oTabsPen := NIL RETURN ::Super:Free() //-------------------------------------------------------------------------- METHOD Scale( nScale ) CLASS XTabs DEFAULT nScale TO Application:nScale IF nScale != 100 ::Super:Scale( nScale ) ::FnTabsSize := MulDiv( ::FnTabsSize, Application:nScale, 100 ) ::FnTabsMargin := MulDiv( ::FnTabsMargin, Application:nScale, 100 ) ::FnItemPadding := MulDiv( ::FnItemPadding, Application:nScale, 100 ) ENDIF RETURN Nil //---------------------------------------------------------------------------- METHOD SetIndex( nIndex, lTriggerOnChange ) CLASS XTabs LOCAL nFromTab := ::nIndex LOCAL lFull := .F. DEFAULT nIndex TO ::FnIndex DEFAULT lTriggerOnChange TO .T. IF nIndex > 0 .AND. nIndex <= Len( ::aItems ) ::FnIndex := nIndex IF !Empty( ::Handle ) IF nIndex < ::nStartTab ::nStartTab := nIndex ::CalcItemsRect() lFull := .T. ELSE DO WHILE !::aItems[ nIndex ]:lCanShow .AND. ::nStartTab <= Len( ::aItems ) ::nStartTab ++ ::CalcItemsRect() lFull := .T. ENDDO ENDIF ::Refresh( lFull ) IF lTriggerOnChange .AND. nFromTab != nIndex ::Changed( nIndex, nFromTab ) ENDIF ENDIF ENDIF RETURN nIndex //------------------------------------------------------------------------------ METHOD Refresh( lRedraw ) CLASS XTabs DEFAULT lRedraw TO .F. IF lRedraw .AND. ::lRedraw .AND. !Empty( ::Handle ) // This forces a wm_nccalcsize SetWindowPos( ::Handle, 0, 0, 0, 0, 0, nOr( SWP_DRAWFRAME, SWP_NOMOVE, SWP_NOSIZE, SWP_NOACTIVATE,SWP_NOZORDER ) ) ELSE ::RedrawNonClient() ENDIF RETURN ::Super:Refresh( lRedraw ) //------------------------------------------------------------------------------ METHOD SetTabsClrPane( Value ) CLASS XTabs DEFAULT Value TO ::FnTabsClrPane IF ::oTabsClrPane != NIL ::oTabsClrPane:nColor := Value ENDIF ::fnTabsClrPane := Value ::Refresh() RETURN Value //------------------------------------------------------------------------------ METHOD SetTabsClrPaneSel( Value ) CLASS XTabs DEFAULT Value TO ::FnTabsClrPaneSel IF ::oTabsClrPaneSel != NIL ::oTabsClrPaneSel:nColor := Value ENDIF ::fnTabsClrPaneSel := Value ::Refresh() RETURN Value //------------------------------------------------------------------------------ METHOD SetTabsClrPaneHot( Value ) CLASS XTabs DEFAULT Value TO ::FnTabsClrPaneHot IF ::oTabsClrPaneHot != NIL ::oTabsClrPaneHot:nColor := Value ENDIF ::fnTabsClrPaneHot := Value ::Refresh() RETURN Value //------------------------------------------------------------------------------ METHOD SetTabsClrText( Value ) CLASS XTabs UPDATE ::FnTabsClrText TO Value ::Refresh() RETURN Value //------------------------------------------------------------------------------ METHOD SetTabsClrTextSel( Value ) CLASS XTabs UPDATE ::FnTabsClrTextSel TO Value ::Refresh() RETURN Value //------------------------------------------------------------------------------ METHOD SetTabsClrTextHot( Value ) CLASS XTabs UPDATE ::FnTabsClrTextHot TO Value ::Refresh() RETURN Value //------------------------------------------------------------------------------ METHOD SetTabsClrPen( Value ) CLASS XTabs DEFAULT Value TO ::FnTabsClrPen IF ::oTabsPen != NIL ::oTabsPen:nColor := Value ENDIF ::fnTabsClrPen := Value ::Refresh() RETURN Value //-------------------------------------------------------------------------- METHOD TabIsFirst( nItem ) CLASS XTabs LOCAL n := 1 DO WHILE n < Len( ::aItems ) WITH OBJECT ::aItems[ n ] IF :lVisible RETURN ( nItem == n ) ENDIF END WITH n++ ENDDO RETURN .F. //-------------------------------------------------------------------------- METHOD FirstTab() CLASS XTabs LOCAL n := 1 DO WHILE n < Len( ::aItems ) IF ::aItems[ n ]:lVisible RETURN ::aItems[ n ++ ] ENDIF ENDDO RETURN NIL //-------------------------------------------------------------------------- METHOD TabIsLast( nItem ) CLASS XTabs LOCAL n := Len( ::aItems ) DO WHILE n > 0 IF ::aItems[ n ]:lVisible RETURN ( nItem == n ) ENDIF n-- ENDDO RETURN .F. //-------------------------------------------------------------------------- METHOD LastTab() CLASS XTabs LOCAL n := Len( ::aItems ) DO WHILE n > 0 IF ::aItems[ n ]:lVisible RETURN ::aItems[ n -- ] ENDIF ENDDO RETURN NIL //-------------------------------------------------------------------------- METHOD CalcItemsRect( nLeft, nTop, nRight, nBottom ) CLASS XTabs LOCAL oItem LOCAL nSize, nOffset, nMax, nLen, nPhantom, nFrom LOCAL lHorz IF nLeft != NIL ::aPaintRect := { nLeft, nTop, nRight, nBottom } ELSE nLeft := ::aPaintRect[ rtLEFT ] nTop := ::aPaintRect[ rtTOP ] nRight := ::aPaintRect[ rtRIGHT ] nBottom := ::aPaintRect[ rtBOTTOM ] ENDIF lHorz := ( ::nOrientation == orBOTTOM .OR. ::nOrientation == orTOP ) nOffset := ::nTabsMargin nPhantom := 0 IF ::lPhantomTab WITH OBJECT ::oImageList nPhantom := Max( Max( :nWidth, :nHeight ) + 4, 20 ) //+ ::nItemPadding END WITH ENDIF IF ::lFixedWidth IF lHorz nSize := ( nRight - nLeft ) ELSE nSize := ( nBottom - nTop ) ENDIF nLen := 0 AEval( ::aItems, {|v| nLen += IIF( v:IsVisible(), 1, 0 ) } ) nSize -= ::nTabsMargin IF ::lPhantomTab nSize -= ( nPhantom + 1 ) ENDIF nSize := Int( nSize / nLen ) ::lNoSpace := .F. ::nStartTab := 1 ENDIF IF lHorz nOffset += nLeft nMax := nRight ELSE nOffset += nTop nMax := nBottom ENDIF IF ::lPhantomTab nMax -= nPhantom ENDIF IF !::lFixedWidth IF ( ::lNoSpace := ( ::nStartTab > 1 ) ) IF ::lShowTabsMenu nMax -= 14 ELSE nMax -= 36 ENDIF ENDIF ENDIF IF ::nTabsMargin > 0 ::aMarginRect := { nLeft, nTop, IIF( lHorz, ::nTabsMargin, nRight) , IIF( lHorz, nBottom, ::nTabsMargin ) } ELSE ::aMarginRect := {0,0,0,0} ENDIF nLen := Len( ::aItems ) IF nLen > 0 FOR nFrom := 1 TO ::nStartTab - 1 IF nFrom <= nLen oItem := ::aItems[ nFrom ] oItem:lCanShow := .F. oItem:SetRect( {0, 0, 0, 0} ) ENDIF NEXT FOR nFrom := ::nStartTab TO nLen oItem := ::aItems[ nFrom ] IF oItem:IsVisible() IF !( oItem:lCanShow := oItem:CalcRect( @nOffset, nSize, nMax ) ) ::lNoSpace := .T. ENDIF ELSE oItem:lCanShow := .F. oItem:SetRect( {0, 0, 0, 0} ) ENDIF NEXT ENDIF IF ::lPhantomTab ::aPhantomRect := { nLeft, nTop, nRight, nBottom } IF lHorz ::aPhantomRect[ rtLEFT ] := nOffset ::aPhantomRect[ rtRIGHT] := nOffset + nPhantom ELSE ::aPhantomRect[ rtTOP ] := nOffset ::aPhantomRect[ rtBOTTOM ] := nOffset + nPhantom ENDIF nOffset += nPhantom ELSE ::aPhantomRect := NIL ENDIF IF ::lNoSpace .AND. !::lShowTabsMenu IF ::nOrientation == orTOP .OR. ::nOrientation == orBOTTOM ::aPrevRect := { ::aPaintRect[ rtRIGHT ] - 31, ::aPaintRect[ rtTOP ] + 4,; ::aPaintRect[ rtRIGHT ] - 17, ::aPaintRect[ rtTOP ] + 18 } ::aNextRect := { ::aPaintRect[ rtRIGHT ] - 15, ::aPaintRect[ rtTOP ] + 4,; ::aPaintRect[ rtRIGHT ] - 1, ::aPaintRect[ rtTOP ] + 18 } ELSE ::aPrevRect := { ::aPaintRect[ rtLEFT ] + 4, ::aPaintRect[ rtBOTTOM ] - 35,; ::aPaintRect[ rtLEFT ] + 20, ::aPaintRect[ rtBOTTOM ] - 19 } ::aNextRect := { ::aPaintRect[ rtLEFT ] + 4, ::aPaintRect[ rtBOTTOM ] - 18,; ::aPaintRect[ rtLEFT ] + 20, ::aPaintRect[ rtBOTTOM ] - 2 } ENDIF ELSE ::aPrevRect := {0, 0, 0, 0} ::aNextRect := {0, 0, 0, 0} ENDIF IF nLeft != NIL ::SetTooltipZones() ::SetShortCuts() ENDIF RETURN NIL //-------------------------------------------------------------------------- METHOD GetItemRect( nItem, lClient, aPoint ) IF nItem > 0 .AND. nItem <= Len( ::aItems ) RETURN ::aItems[ nItem ]:GetRect( lClient, aPoint ) ENDIF RETURN {0, 0, 0, 0} //-------------------------------------------------------------------------- METHOD PaintTabs( hDC ) CLASS XTabs LOCAL oItem LOCAL aRect, aPoint, aTriag LOCAL nLen, nFrom, nColor, nX, nY, nClrHot LOCAL lDarkBk LOCAL hOld IF Empty( ::aPaintRect ) RETURN NIL ENDIF aRect := AClone( ::aPaintRect ) nLen := Len( ::aItems ) IF ::nOrientation == orBOTTOM aRect[ rtBOTTOM ] -= aRect[ rtTOP ] aRect[ rtTOP ] := 0 ELSEIF ::nOrientation == orRIGHT aRect[ rtRIGHT ] -= aRect[ rtLEFT ] aRect[ rtLEFT ] := 0 ENDIF ::OnDrawTabsBackground( hDC, aRect ) // Paint orientation frame line IF ::nFrame > tfNONE hOld := SelectObject( hDC, ::oTabsPen:Handle ) SWITCH ::nOrientation CASE orTOP MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] - 1 ) LineTo( hDC, aRect[ rtRIGHT ], aRect[ rtBOTTOM ] - 1 ) EXIT CASE orBOTTOM MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ], aRect[ rtTOP ] ) EXIT CASE orLEFT MoveTo( hDC, aRect[ rtRIGHT ]-1, aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ]-1, aRect[ rtBOTTOM ] ) EXIT CASE orRIGHT MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] ) EXIT END SWITCH SelectObject( hDC, hOld ) ENDIF aPoint := ScreenToClient( ::Handle, GetCursorPos() ) // To force zero based due the use of double-buffering SWITCH ::nOrientation CASE orTOP aPoint[ 2 ] += ::nTabsSize EXIT CASE orBOTTOM aPoint[ 2 ] -= ::aPaintRect[ rtTOP ] EXIT CASE orLEFT aPoint[ 1 ] += ::nTabsSize EXIT CASE orRIGHT aPoint[ 1 ] -= ::aPaintRect[ rtLEFT ] EXIT END SWITCH IF nLen > 0 FOR nFrom := ::nStartTab TO nLen oItem := ::aItems[ nFrom ] IF ::nFloat == 0 .OR. oItem:nItem != ::nFloat oItem:Paint( hDC, aPoint ) ENDIF NEXT ENDIF IF ::nFloat > 0 ::aItems[ ::nFloat ]:Paint( hDC, aPoint ) ENDIF IF ::lPhantomTab ::PaintPhantomTab( hDC ) ENDIF IF ::lNoSpace .AND. ::nFloat == 0 IF ::lShowTabsMenu SWITCH ::nOrientation CASE orTOP CASE orBOTTOM nX := ::aPaintRect[ rtRIGHT ] - 12 nY := 2 aTriag := { nX, nY, nX + 8, nY + 8 } nColor := IIF( XA_Luminance( XA_GetPixel( hDC, nX, nY ) ) > 127, clBlack, clWhite ) XA_PaintTriangle( hDC, aTriag, nColor, orBOTTOM ) EXIT CASE orLEFT CASE orRIGHT nX := 2 nY := ::aPaintRect[ rtBOTTOM ] - 12 aTriag := { nX, nY, nX + 8, nY + 8 } nColor := IIF( XA_Luminance( XA_GetPixel( hDC, nX, nY ) ) > 127, clBlack, clWhite ) XA_PaintTriangle( hDC, aTriag, nColor, orBOTTOM ) EXIT END SWITCH ELSE SWITCH ::nOrientation CASE orTOP CASE orBOTTOM nX := ::aPaintRect[ rtRIGHT ] - 28 nY := 2 lDarkBk := ( XA_Luminance( XA_GetPixel( hDC, nX, nY ) ) < 127 ) aTriag := { nX, nY, nX + 8, nY + 8 } nColor := clGray nClrHot := IIF( lDarkBk, clWhite, clBlack ) XA_PaintTriangle( hDC, aTriag, IIF(::nHot == -4, nClrHot, nColor ), orLEFT ) aTriag[ rtLEFT ] += 14 aTriag[ rtRIGHT ] += 14 XA_PaintTriangle( hDC, aTriag, IIF(::nHot == -5, nClrHot, nColor ), orRIGHT ) EXIT CASE orLEFT CASE orRIGHT nX := 4 nY := ::aPaintRect[ rtBOTTOM ] -28 aTriag := { nX, nY, nX + 8, nY + 8 } lDarkBk := ( XA_Luminance( XA_GetPixel( hDC, nX, nY ) ) < 127 ) nColor := clGray nClrHot := IIF( lDarkBk, clWhite, clBlack ) XA_PaintTriangle( hDC, aTriag, IIF(::nHot == -4, nClrHot, nColor ), orTOP ) aTriag[ rtTOP ] += 14 aTriag[ rtBOTTOM ] += 14 XA_PaintTriangle( hDC, aTriag, IIF(::nHot == -5, nClrHot, nColor ), orBOTTOM ) EXIT END SWITCH ENDIF ENDIF RETURN NIL //-------------------------------------------------------------------------- METHOD PaintFrame( hDC ) CLASS XTabs LOCAL aRect LOCAL hOld IF ::nFrame != tfALL RETURN NIL ENDIF aRect := GetWindowRect( ::Handle ) aRect[ rtRIGHT ] -= aRect[ rtLEFT ] aRect[ rtBOTTOM ] -= aRect[ rtTOP ] aRect[ rtLEFT ] := 0 aRect[ rtTOP ] := 0 hOld := SelectObject( hDC, ::oTabsPen:Handle ) SWITCH ::nOrientation CASE orTOP aRect[ rtTOP ] += ::nTabsSize MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] -1 ) LineTo( hDC, aRect[ rtRIGHT ]-1, aRect[ rtBOTTOM ] -1 ) LineTo( hDC, aRect[ rtRIGHT ]-1, aRect[ rtTOP ] - 1 ) EXIT CASE orBOTTOM aRect[ rtBOTTOM ] -= ::nTabsSize MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] - 1 ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ] - 1, aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ] - 1, aRect[ rtBOTTOM ] - 1 ) EXIT CASE orLEFT aRect[ rtLEFT ] += ::nTabsSize MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ]-1, aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ]-1, aRect[ rtBOTTOM ] - 1 ) LineTo( hDC, aRect[ rtLEFT ] -1, aRect[ rtBOTTOM ] - 1 ) EXIT CASE orRIGHT aRect[ rtRIGHT ] -= ::nTabsSize MoveTo( hDC, aRect[ rtRIGHT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] - 1 ) LineTo( hDC, aRect[ rtRIGHT ], aRect[ rtBOTTOM ] - 1 ) END SWITCH SelectObject( hDC, hOld ) RETURN NIL //-------------------------------------------------------------------------- METHOD PaintPhantomTab( hDC ) CLASS XTabs LOCAL aRect LOCAL cText LOCAL nClrText, nClrPane, nImage, nOldCol, nOldObj, nX, nY, nState, nGap LOCAL lResult, lDelBrh IF ::nFloat > 0 RETURN NIL ENDIF aRect := AClone( ::aPhantomRect ) lDelBrh := .F. nState := IIF( ::nHot == -1, tsHOT, tsNORMAL ) cText := "+" nImage := ::nPhantomImage nClrText := IIF( nState != tsHOT, ::nTabsClrText, ::nTabsClrTextHot ) nClrPane := IIF( nState != tsHOT, ::nTabsClrPane, ::nTabsClrPaneHot ) nGap := IIF( ::lSameFrameSize, 0, Int( ::nTabsSize * 0.1 ) ) IF ::nOrientation == orBOTTOM aRect[ rtBOTTOM ] -= aRect[ rtTOP ] aRect[ rtTOP ] := 0 ELSEIF ::nOrientation == orRIGHT aRect[ rtRIGHT ] -= aRect[ rtLEFT ] aRect[ rtLEFT ] := 0 ENDIF IF ::nFrame > tfNONE SWITCH ::nOrientation CASE orTOP aRect[ rtTOP ] += nGap aRect[ rtBOTTOM ] -- EXIT CASE orBOTTOM aRect[ rtBOTTOM ] -= ( nGap + 1 ) EXIT CASE orLEFT aRect[ rtLEFT ] += nGap aRect[ rtRIGHT ] -- EXIT CASE orRIGHT aRect[ rtRIGHT ] -= ( nGap + 1 ) END SWITCH ENDIF lResult := ::OnDrawTab( -1, @cText, @nImage, @nClrText, @nClrPane, nState, hDC, aRect ) IF Empty( lResult ) IF ::nFrame > tfNONE nOldCol := SelectObject( hDC, ::oTabsPen:Handle ) MoveTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ], aRect[ rtTOP ] ) LineTo( hDC, aRect[ rtRIGHT ], aRect[ rtBOTTOM ] ) LineTo( hDC, aRect[ rtLEFT ], aRect[ rtBOTTOM ] ) SelectObject( hDC, nOldCol ) aRect[ rtLEFT ]++ ; aRect[ rtTOP ]++ ENDIF IF nClrPane != IIF( nState != tsHOT, ::nTabsClrPane, ::nTabsClrPaneHot ) nClrPane := CreateSolidBrush( nClrPane ) lDelBrh := .T. ELSE nClrPane := IIF( nState != tsHOT, ::oTabsClrPane:Handle, ::oTabsClrPaneHot:Handle ) ENDIF FillRect( hDC, aRect, nClrPane ) IF nImage == 0 SetbkMode( hDC, TRANSPARENT ) nOldObj := SelectObject( hDC, ::oFont:Handle ) nOldCol := SetTextColor( hDC, nClrText ) DrawText( hDC, cText, aRect, nOr( DT_CENTER, DT_END_ELLIPSIS, DT_VCENTER, DT_SINGLELINE ) ) SetTextColor( hDC, nOldCol ) SelectObject( hDC, nOldObj ) ELSE WITH OBJECT ::oImageList nX := aRect[ rtLEFT ] + Int( ( aRect[ rtRIGHT ] - aRect[ rtLEFT ] - :nWidth ) / 2 ) nY := aRect[ rtTOP ] + Int( ( aRect[ rtBOTTOM ] - aRect[ rtTOP ] - :nHeight ) / 2 ) DrawImage( :Handle, nImage, hDC, nX, nY ) END WITH ENDIF IF lDelBrh DeleteObject( nClrPane ) ENDIF ENDIF RETURN NIL //-------------------------------------------------------------------------- METHOD NCButtonDown( lLeft, nwParam, nlParam, hWnd ) CLASS XTabs LOCAL oItem AS CLASS TTabsItem LOCAL aPt, aComboRect, lChange LOCAL nBorder LOCAL lRet IF nwParam == HTMENU aPt := { LOINT( nlParam ), HIINT( nlParam ) } ScreenToClient( hWnd, @aPt ) IF ::nFrame > tfNONE aPt[ 1 ] ++ aPt[ 2 ] ++ ENDIF SWITCH ::nOrientation CASE orTOP aPt[ 2 ] += ::nTabsSize EXIT CASE orLEFT aPt[ 1 ] += ::nTabsSize EXIT END SWITCH IF lLeft .AND. ::lTabsCanMove ::aPointClick := aPt ENDIF IF lLeft .AND. ::lNoSpace .AND. ::lShowTabsMenu IF ::nOrientation == orTOP .OR. ::nOrientation == orBOTTOM aComboRect := { ::aPaintRect[ rtRIGHT ] - 12, ::aPaintRect[ rtTOP ] + 4,; ::aPaintRect[ rtRIGHT ] - 4, ::aPaintRect[ rtTOP ] + 12 } ELSE aComboRect := { ::aPaintRect[ rtLEFT ] + 4, ::aPaintRect[ rtBOTTOM ] - 12,; ::aPaintRect[ rtLEFT ] + 12, ::aPaintRect[ rtBOTTOM ] - 4 } ENDIF ENDIF IF ::lTabStop .AND. GetFocus() != ::Handle SetFocus( ::Handle ) ENDIF FOR EACH oItem IN ::aItems IF oItem:lCanShow .AND. oItem:lEnabled IF lLeft .AND. ::lTabCloseButtons .AND. oItem:lCloseHot IF Empty( oItem:OnClose( aPt[ 1 ], aPt[ 2 ] ) ) ::OnCloseTab( oItem:nItem, aPt[ 1 ], aPt[ 2 ] ) ENDIF RETURN 0 ENDIF IF PtInRect( oItem:GetRect(), aPt ) IF lLeft IF Empty( oItem:OnClick( aPt[ 1 ], aPt[ 2 ] ) ) IF Empty( ::OnClick( oItem:nItem, aPt[ 1 ], aPt[ 2 ] ) ) IF ( lChange := ::Changing( oItem:nItem, ::nIndex ) ) == Nil .OR. lChange ::SetIndex( oItem:nItem, .T. ) ENDIF ENDIF ENDIF ELSE IF ::EventAssigned( "OnContextMenu" ) ::OnContextMenu( aPt[ 1 ], aPt[ 2 ] ) ELSEIF Empty( oItem:OnRClick( aPt[ 1 ], aPt[ 2 ] ) ) ::OnRClick( oItem:nItem, aPt[ 1 ], aPt[ 2 ] ) ENDIF ENDIF RETURN 0 ENDIF ENDIF NEXT IF PtInRect( ::aPhantomRect, aPt ) IF lLeft IF Empty( ::OnClick( -1, aPt[ 1 ], aPt[ 2 ] ) ) ::OnNewTab() ENDIF ELSE ::OnRClick( -1, aPt[ 1 ], aPt[ 2 ] ) ENDIF ELSEIF lLeft .AND. ::lShowTabsMenu .AND. ::lNoSpace .AND. PtInRect( aComboRect, aPt ) IF Empty( ::OnClick( -3, aPt[ 1 ], aPt[ 2 ] ) ) ::ShowTabsList() ENDIF ELSEIF lLeft .AND. ::lNoSpace .AND. PtInRect( ::aPrevRect, aPt ) oItem := ::FirstTab() IF oItem != NIL .AND. !oItem:lCanShow .AND. ::nStartTab > 1 ::nStartTab -- ::CalcItemsRect() DO WHILE !::aItems[ ::nIndex ]:lCanShow .AND. ::nIndex > 1 ::nIndex -- ::CalcItemsRect() ENDDO ::Refresh(.T.) ENDIF ELSEIF lLeft .AND. ::lNoSpace .AND. PtInRect( ::aNextRect, aPt ) oItem := ::LastTab() IF oItem != NIL .AND. !oItem:lCanShow .AND. ::nStartTab <= Len( ::aItems ) ::nStartTab++ ::CalcItemsRect() DO WHILE !::aItems[ ::nIndex ]:lCanShow .AND. ::nIndex < Len( ::aItems ) ::nIndex ++ ::CalcItemsRect() ENDDO ::Refresh(.T.) ENDIF ELSEIF PtInRect( ::aPaintRect, aPt ) IIF( lLeft, ::OnClick( -2, aPt[ 1 ], aPt[ 2 ] ),; ::OnRClick( -2, aPt[ 1 ], aPt[ 2 ] ) ) ENDIF RETURN 0 ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD NCHotPos( nlParam ) CLASS XTabs LOCAL oItem LOCAL aPt, aRect LOCAL nX, nY ::nHot := 0 // Sin determinar aPt := { LOINT( nlParam ), HIINT( nlParam ) } ScreenToClient( ::Handle, @aPt ) IF ::nFrame > tfNONE aPt[ rtLEFT ] ++ aPt[ rtTOP ] ++ ENDIF IF ( ::nOrientation == orTOP ) aPt[ 2 ] += ::nTabsSize ENDIF IF ::nOrientation == orLEFT aPt[ 1 ] += ::nTabsSize ENDIF FOR EACH oItem IN ::aItems IF oItem:lCanShow IF PtInRect( oItem:GetRect(), aPt ) ::nHot := oItem:nItem // En un tab EXIT ENDIF ENDIF NEXT IF ::aPointClick != NIL .AND. ::nFloat == 0 .AND. ::nHot > 0 nX := GetSystemMetrics( SM_CXDRAG ) nY := GetSystemMetrics( SM_CYDRAG ) aRect := { ::aPointClick[ 1 ] - nX, ::aPointClick[ 2 ] - nY,; ::aPointClick[ 1 ] + nX, ::aPointClick[ 2 ] + nY } IF !PtInRect( aRect, aPt ) ::nFloat := ::nHot ENDIF ENDIF IF ::nHot == 0 IF PtInRect( ::aPhantomRect, aPt ) ::nHot := -1 // En tab fantasma ELSEIF PtInRect( ::aMarginRect, aPt ) ::nHot := -3 // En margen inicial ELSEIF PtInRect( ::aPrevRect, aPt ) ::nHot := -4 // En botón anterior ELSEIF PtInRect( ::aNextRect, aPt ) ::nHot := -5 // En botón siguiente ELSEIF PtInRect( ::aPaintRect, aPt ) ::nHot := -2 // En backgound ENDIF ENDIF RETURN ::nHot //------------------------------------------------------------------------------ METHOD WMNCLButtonUp( wParam, lParam, hWnd ) CLASS XTabs ::TabDrop() ::RedrawNonClient() RETURN Nil //------------------------------------------------------------------------------ METHOD WMNCMouseLeave( wParam, lParam, hWnd ) CLASS XTabs ::lHotTrack := .f. ::TabDrop() ::nHot := 0 ::RedrawNonClient() RETURN Nil //------------------------------------------------------------------------------ METHOD WMKeyDown( nKey, nFlags, hWnd ) CLASS XTabs LOCAL lProcessed := .F. IF lGetKeyState( VK_CONTROL ) SWITCH nKey CASE VK_NEXT ::NextTab() lProcessed := .T. EXIT CASE VK_PRIOR ::NextTab( .T. ) lProcessed := .T. EXIT CASE VK_TAB IF lGetKeyState( VK_SHIFT ) ::NextTab( .T. ) ELSE ::NextTab() ENDIF lProcessed := .T. END SWITCH ENDIF IF lProcessed ::oForm:SendMsg( WM_CHANGEUISTATE, MakeLong( UIS_CLEAR, UISF_HIDEFOCUS ) ) RETURN 0 ENDIF RETURN ::Super:WMKeyDown( nKey, nFlags, hWnd ) //------------------------------------------------------------------------------ METHOD NextTab( lPrev ) CLASS XTabs LOCAL nIndex, lChange IF Empty( lPrev ) nIndex := IIF( ::nIndex == Len( ::aItems ), 1, ::nIndex + 1 ) ELSE nIndex := IIF( ::nIndex == 1, Len( ::aItems ), ::nIndex - 1 ) ENDIF DO WHILE nIndex <= Len( ::aItems ) .AND. !( ::aItems[ nIndex ]:lEnabled .AND. ::aItems[ nIndex ]:lVisible ) .AND. nIndex != ::nIndex IF Empty( lPrev ) nIndex := IIF( nIndex == Len( ::aItems ), 1, nIndex + 1 ) ELSE nIndex := IIF( nIndex == 1, Len( ::aItems ), nIndex - 1 ) ENDIF ENDDO IF nIndex != ::nIndex IF ( lChange := ::Changing( nIndex, ::nIndex ) ) == Nil .OR. lChange ::nIndex := nIndex ENDIF ENDIF RETURN Nil //------------------------------------------------------------------------------ METHOD TabDrop() CLASS XTabs LOCAL nHot, nPos IF ::nFloat > 0 nHot := ::nHot IF nHot == -3 // Margin zone nHot := 1 DO WHILE nHot <= Len( ::aItems ) IF ::aItems[ nHot ]:lVisible EXIT ELSE nHot++ ENDIF ENDDO ELSEIF nHot == -2 // Rest Background nHot := Len( ::aItems ) DO WHILE nHot <= Len( ::aItems ) IF ::aItems[ nHot ]:lVisible EXIT ELSE nHot-- ENDIF ENDDO ENDIF IF ::nFloat > 0 .AND. nHot > 0 .AND. nHot <= Len( ::aItems ) ::MoveTab( ::nFloat, nHot ) ENDIF ::nFloat := 0 ENDIF ::aPointClick := NIL RETURN NIL //------------------------------------------------------------------------------ METHOD ShowTabsList() CLASS XTabs LOCAL oMenu, oItem LOCAL aPt, aImg LOCAL ltabStop aPt := GetCursorPos() aImg := {} ScreenToClient( ::Handle, aPt ) MENU oMenu POPUP oMenu:oImageList := ::oImageList FOR EACH oItem IN ::aItems IF oItem:lVisible .AND. oItem:lEnabled XA_MenuItem( oItem:cText, {|o| ::ShowTab( o:Cargo ) }, NIL, .T., .F., .F., .F., .F., oItem:nImage ):Cargo := oItem ENDIF NEXT ENDMENU ::ShowPopupMenu( oMenu, aPt[ 1 ], aPt[ 2 ] ) oMenu:oImageList := NIL oMenu:Destroy() RETURN NIL //------------------------------------------------------------------------------ METHOD ShowTab( oTab ) CLASS XTabs LOCAL nTab IF oTab != NIL .AND. oTab:nItem != ::nIndex IF oTab:lCanShow ::SetIndex( oTab:nItem ) ELSE nTab := ::nStartTab IF oTab:nItem > ::nStartTab DO WHILE !oTab:lCanShow .AND. ::nStartTab < oTab:nItem ::nStartTab ++ ::CalcItemsRect() ENDDO ELSE DO WHILE !oTab:lCanShow .AND. ::nStartTab > 0 ::nStartTab -- ::CalcItemsRect() ENDDO ENDIF IF oTab:lCanShow ::SetIndex( oTab:nItem ) ELSE ::nStartTab := nTab ENDIF ENDIF ENDIF RETURN NIL //------------------------------------------------------------------------------ METHOD InsertItem( nItem, cText, nImage, cTooltip, nSize, nAlignment, nBmpAlignment, lVisible, lEnabled ) CLASS XTabs LOCAL oItem oItem := TTabsItem():Create( Self, nItem, cText, nImage, cTooltip, nSize, nAlignment, nBmpAlignment, lVisible, lEnabled ) IF ::nIndex == 0 ::nIndex := oItem:nItem ENDIF RETURN oItem //-------------------------------------------------------------------------- METHODPUB SetItems( aItems ) CLASS XTabs LOCAL n ::DeleteItems() IF aItems != Nil ::lRedraw := .F. FOR n := 1 TO Len( aItems ) IF ValType( aItems[ n ] ) == "C" ::InsertItem( Nil, aItems[ n ] ) ELSEIF ValType( aItems[ n ] ) == "A" IF Len( aItems ) == 1 ::InsertItem( Nil, aItems[ n ] ) ELSEIF Len( aItems ) == 2 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ] ) ELSEIF Len( aItems ) == 3 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ] ) ELSEIF Len( aItems ) == 4 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ], aItems[ n, 4 ] ) ELSEIF Len( aItems ) == 5 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ], aItems[ n, 4 ], aItems[ n, 5 ] ) ELSEIF Len( aItems ) == 6 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ], aItems[ n, 4 ], aItems[ n, 5 ], aItems[ n, 6 ] ) ELSEIF Len( aItems ) == 7 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ], aItems[ n, 4 ], aItems[ n, 5 ], aItems[ n, 6 ], aItems[ n, 7 ] ) ELSEIF Len( aItems ) == 8 ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ], aItems[ n, 4 ], aItems[ n, 5 ], aItems[ n, 6 ], aItems[ n, 7 ], aItems[ n, 8 ] ) ELSE ::InsertItem( Nil, aItems[ n, 1 ], aItems[ n, 2 ], aItems[ n, 3 ], aItems[ n, 4 ], aItems[ n, 5 ], aItems[ n, 6 ], aItems[ n, 7 ], aItems[ n, 8 ], aItems[ n, 9 ] ) ENDIF ENDIF NEXT ::lRedraw := .T. ENDIF ::Refresh( .t. ) RETURN Nil //-------------------------------------------------------------------------- METHOD DeleteItem( nItem ) CLASS XTabs LOCAL nUpd, nLen DEFAULT nItem TO ::nIndex nLen := Len( ::aItems ) IF nItem > 0 .AND. nItem <= nLen ::aItems[ nItem ]:End() ADel( ::aItems, nItem ) ASize( ::aItems, nLen - 1 ) nLen-- nUpd := nItem IF ! Empty( ::Handle ) ::SetShortCuts() ENDIF WHILE nUpd <= nLen ::aItems[ nUpd ]:nItem := ::aItems[ nUpd ]:nItem - 1 nUpd ++ ENDDO IF ::nStartTab > 1 ::nStartTab := 1 ::CalcItemsRect() ENDIF IF nItem <= ::nIndex ::nIndex := Max( ::nIndex - 1, 1 ) ENDIF ::Refresh( .T. ) RETURN .T. ENDIF RETURN .F. //-------------------------------------------------------------------------- METHOD DeleteItems() CLASS XTabs AEval( ::aItems, {| oItem | oItem:End() } ) ::FaItems := {} ::Refresh( .T. ) RETURN Nil //-------------------------------------------------------------------------- METHOD SetShortCuts() CLASS XTabs LOCAL aKeys := {}, nAt IF ::oForm != Nil ::oForm:DelShortCut( Self ) AEval( ::aItems, {| oItem | IIf( ( nAt := At( "&", oItem:cText ) ) > 0, AAdd( aKeys, Substr( oItem:cText, nAt + 1, 1 ) ), ) } ) IF ! Empty( aKeys ) ::oForm:AddShortCut( Self, aKeys ) ENDIF ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD ShortCut( cKey ) CLASS XTabs LOCAL n, nAt, lChange IF ! Empty( cKey ) cKey := Upper( cKey ) FOR n := 1 TO Len( ::aItems ) IF ( nAt := At( "&", ::aItems[ n ]:cText ) ) > 0 .AND. Upper( Substr( ::aItems[ n ]:cText, nAt + 1, 1 ) ) == cKey IF n != ::nIndex IF ( lChange := ::Changing( n, ::nIndex ) ) == Nil .OR. lChange ::SetIndex( n ) RETURN 0 ENDIF ENDIF EXIT ENDIF NEXT ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD Changing( nIndex, nFromTab ) CLASS XTabs LOCAL lOk, lValid IF ( lOk := ::OnChanging( nIndex, nFromTab ) ) == Nil .OR. lOk IF ::oForm:oActiveControl != Nil IF ( lValid := ::oForm:oActiveControl:Valid() ) == Nil .OR. lValid ::oForm:oActiveControl:lFocused := .F. ELSE RETURN .F. ENDIF ENDIF ENDIF RETURN lOk //-------------------------------------------------------------------------- METHOD SetTooltipZones() CLASS XTabs LOCAL aZone LOCAL cTooltip LOCAL nFor IF ! ::lCreated RETURN Nil ENDIF IF ! Empty( ::Handle ) ::SetTooltip() IF Len( ::aItems ) > 0 FOR nFor := 1 TO Len( ::aItems ) aZone := ::GetItemRect( nFor, .T. ) cTooltip := ::aItems[ nFor ]:cTooltip IF ! Empty( aZone ) .AND. ! Empty( cTooltip ) ::SetTooltip( cTooltip, aZone, nFor ) ENDIF NEXT ::FcTooltip := "" ENDIF ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD MoveTab( nFrom, nTo ) CLASS XTabs LOCAL oFrom, oTo LOCAL nLen, nTab nLen := Len( ::aItems ) IF nFrom > 0 .AND. nFrom <= nLen .AND. nTo > 0 .AND. nTo <= nLen .AND. nFrom != nTo oFrom := ::aItems[ nFrom ] oTo := ::aItems[ nTo ] oFrom:nItem := nTo oTo:nItem := nFrom ::aItems[ nFrom ] := oTo ::aItems[ nTo ] := oFrom IF ::nIndex == nFrom ::nIndex := nTo ELSEIF ::nIndex == nTo ::nIndex := nFrom ENDIF nTab := ::nStartTab IF nTo > ::nStartTab DO WHILE !oTo:lCanShow .AND. ::nStartTab < oTo:nItem ::nStartTab ++ ::CalcItemsRect() ENDDO ELSE DO WHILE !oTo:lCanShow .AND. ::nStartTab > 1 ::nStartTab -- ::CalcItemsRect() ENDDO ENDIF IF !oTo:lCanShow ::nStartTab := nTab ENDIF ::Refresh( .T. ) RETURN .T. ENDIF RETURN .F. //-------------------------------------------------------------------------- METHOD SaveState() CLASS XTabs LOCAL cState LOCAL nFor, nLen nLen := Len( ::aItems ) cState := "" FOR nFor := 1 TO nLen cState += Ltrim( Str( ::aItems[ nFor ]:nOrgPos ) ) IF nFor < nLen cState += ";" ENDIF NEXT RETURN cState //-------------------------------------------------------------------------- METHOD RestoreState( cState ) CLASS XTabs LOCAL aItems LOCAL nPos, nFor IF Empty( cState ) RETURN .F. ENDIF aItems := {} nFor := 1 DO WHILE (nPos := Val( hb_TokenGet( cState, nFor++, ";" ) ) ) > 0 nPos := AScan( ::aItems, {|v| v:nOrgPos = nPos } ) IF nPos > 0 AAdd( aItems, ::aItems[ nPos ] ) ELSE EXIT ENDIF ENDDO IF Len( ::aItems ) == Len( aItems ) FOR nFor := 1 TO Len( aItems ) aItems[ nFor ]: nItem := nFor NEXT ACopy(aItems, ::aItems ) ::nStartTab := 1 ::nIndex := 1 ::CalcItemsRect() ::Refresh( .T. ) RETURN .T. ENDIF RETURN .F. //------------------------------------------------------------------------------ #pragma BEGINDUMP #include #include #include HB_FUNC_STATIC( DRAWIMAGE ) // Imagelist, nImage, hDC, nX, nY --> lValue { hb_retl( ImageList_Draw( (HIMAGELIST) hb_parnl( 1 ) , hb_parnl( 2 ) - 1, (HDC) hb_parnl( 3 ), hb_parni( 4 ), hb_parni( 5 ), ILD_TRANSPARENT ) ); } //------------------------------------------------------------------------------ #pragma ENDDUMP