/*
 * CardItem.prg
 * Clase TCardItem
 *
 * Copyright 2020 Ignacio Ortiz de Zúñiga
 * Copyright 2020 https://Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"

//------------------------------------------------------------------------------

CLASS XCardItem FROM TComponent

PUBLISHED:
   PROPERTY oFont       READ GetFont  WRITE SetFont EDITOR PE_Font AS TFont
   PROPERTY oCursor     WRITE METHOD SetCursor  EDITOR PE_Cursor AS TCursor

   PROPERTY nColumn        INIT 0 WRITE INLINE ( ::FnColumn := Value, ::Refresh(), Value )
   PROPERTY nAlign         INIT alLEFT WRITE INLINE ( ::FnAlign := Value, ::ReCalc(), Value ) ;
                           VALUES alLEFT, alTOP, alRIGHT, alBOTTOM, alCLIENT
   PROPERTY nAlignment     INIT taCENTER WRITE INLINE ( ::FnAlignment := Value, ::Refresh(), Value );
                           VALUES taLEFT, taRIGHT, taCENTER
   PROPERTY nVAlignment    INIT vaCENTER WRITE INLINE ( ::FnVAlignment := Value, ::Refresh(), Value );
                           VALUES vaTOP, vaBOTTOM, vaCENTER
   PROPERTY nTextPad       INIT 5 WRITE INLINE ( ::FnTextPad := Value, ::Refresh(), Value )
   PROPERTY nType          INIT ctLABEL WRITE INLINE ( ::FnType := Value, ::Refresh(), Value ) ;
                           VALUES ctLABEL, ctLABELEX, ctPICTURE, ctIMAGEINDEX
   PROPERTY nSize          INIT 20 WRITE INLINE ( ::FnSize := Value, ::ReCalc(), Value )
   PROPERTY nAlignWeight   INIT 0 WRITE INLINE ( ::FnAlignWeight := Value, ::ReCalc(), Value )
   PROPERTY nSiblingWeight INIT 0 WRITE INLINE ( ::FnSiblingWeight := Value, ::ReCalc(), Value )
   PROPERTY nClrText       INIT Nil EDITOR PE_ColorOrNil;
                           WRITE INLINE ( ::FnClrText := Value, ::Refresh(), Value )
   PROPERTY nClrLink       INIT Nil EDITOR PE_ColorOrNil;
                           WRITE INLINE ( ::FnClrLink := Value, ::Refresh(), Value )
   PROPERTY lVisible       INIT .T. WRITE INLINE ( ::FlVisible := Value, ::ReCalc(), Value )
   PROPERTY lParentFont    INIT .T. WRITE INLINE ( ::FlParentFont := Value, ::Refresh(), Value )
   PROPERTY lHotTrack      INIT .F. WRITE INLINE ( ::FlHotTrack := Value, ::Refresh(), Value )
   PROPERTY lButton        INIT .F. WRITE INLINE ( ::FlButton := Value, ::Refresh(), Value )
   PROPERTY lAutoFit       INIT .F. WRITE INLINE ( ::FlAutoFit := Value, ::Refresh(), Value )
   PROPERTY lMultiLine     INIT .F. WRITE INLINE ( ::FlMultiLine := Value, ::Refresh(), Value )

PUBLIC:
   PROPERTY oParent READONLY AS TCardBox
//   PROPERTY Value   READ GetValue
   PROPERTY nItem   INIT 0 READONLY

   METHOD New( oParent )    CONSTRUCTOR
   METHOD Create( oParent ) CONSTRUCTOR
   METHOD Delete()          INLINE IIF( ::oParent != NIL, ::oParent:DeleteItem( ::nItem ), )
   METHOD IsSelected()      INLINE ::oParent:ItemSelected( ::nItem )
   METHOD IsActive()        INLINE ::oParent:ItemIndex( ::nItem )
   METHOD Value( nPos )     INLINE ::GetValue( nPos )

RESERVED:
   METHOD Free()
   METHOD IsVisible()         INLINE ::lVisible // --> lValue (needed on the IDE)
   METHOD GetRect()           INLINE ::aPaintRect
   METHOD SetRect( aRect )    INLINE ::aPaintRect := aRect
   METHOD Refresh()           INLINE ::oParent:Refresh()
   METHOD ReCalc()            INLINE ::oParent:CalcItemsRect( .T. )
   METHOD Paint( hDC, nPos, nX, nY, lActive, lHot, lSel )
   METHOD PointInRect( nX, nY, aPoint )
   METHOD CheckScroll()

PROTECTED:
   DATA aPaintRect
   DATA Handle      INIT 0

   METHOD oForm()   INLINE ::oParent:oForm
   METHOD GetFont() EXTERN XControl_GetFont()
   METHOD SetFont() EXTERN XControl_SetFont()
   METHOD GetValue( nPos )
   METHOD SetCursor( oCursor )

ENDCLASS

//------------------------------------------------------------------------------

METHOD New( oParent ) CLASS XCardItem

   ::oParent := oParent

RETURN ::Super:New( ::oParent )

//------------------------------------------------------------------------------

METHODPUB Create( oParent, nItem ) CLASS XCardItem

   UPDATE ::oParent TO oParent
   UPDATE ::nItem   TO nItem

   ::Super:Create( ::oParent )

   IF Empty( ::nItem ) .OR. ::nItem > Len( ::oParent:aItems )
      AAdd( ::oParent:aItems, Self )
      ::nItem := Len( ::oParent:aItems )
   ELSE
      AAdd( ::oParent:aItems, Nil )
      AIns( ::oParent:aItems, ::nItem )
      ::oParent:aItems[ ::nItem ] := Self
      nItem := ::nItem + 1
      WHILE nItem <= Len( ::oParent:aItems )
         WITH OBJECT ::oParent:aItems[ nItem ]
            IF :nColumn == :nItem
               :nColumn ++
            ENDIF
            :nItem ++
         END WITH
         nItem ++
      ENDDO
   ENDIF

   IF Empty( ::nColumn )
      ::nColumn := ::nItem
   ENDIF

   WITH OBJECT ::oParent
      :CalcItemsRect( .T. )
   END WITH

RETURN Self

//------------------------------------------------------------------------------

METHOD Free() CLASS XCardItem

   ::oFont   := Nil
   ::oParent := Nil

RETURN ::Super:Free()

//------------------------------------------------------------------------------

METHOD GetValue( nPos ) CLASS XCardItem

   LOCAL Value

   WITH OBJECT ::oParent
      IF !Empty( nPos ) .AND. nPos <= Len( :aData ) .AND. ::nColumn > 0 .AND. ::nColumn <= Len( :aData[ nPos ] )
         Value := :aData[ nPos ][ ::nColumn ]
      ELSE
         Value := "Error: First parameter <nPos>, missing or invalid."
      ENDIF
   END WITH

RETURN Value

//--------------------------------------------------------------------------

METHOD SetCursor( oCursor ) CLASS XCardItem

   IF ::FoCursor != Nil
      IF !( ::FoCursor == Screen:oCursorArrow )
         ::FoCursor:Destroy()
      ENDIF
      ::FoCursor := Nil
   ENDIF

   IF oCursor != Nil
      IF ValType( oCursor ) != "O"
         oCursor := TCursor():Create( oCursor )
      ENDIF
      ::FoCursor := oCursor
   ENDIF

RETURN ::FoCursor

//------------------------------------------------------------------------------

METHOD PointInRect( nX, nY, aPoint ) CLASS XCardItem

   LOCAL aRect := AClone( ::aPaintRect )

   aRect[ rtLEFT ]   += nX
   aRect[ rtTOP ]    += nY
   aRect[ rtRIGHT ]  += nX
   aRect[ rtBOTTOM ] += nY

RETURN PtInRect( aRect, aPoint )

//------------------------------------------------------------------------------

METHOD Paint( hDC, nPos, nX, nY, lActive, lHot, lSel ) CLASS XCardItem

   LOCAL oPict
   LOCAL aRect
   LOCAL cValue
   LOCAL nClrText, nClrLink, nClrPane, nFlags, nVAlign, nHAlign, nPad
   LOCAL hOldFont, hPaneBrush, hHotBrush
   LOCAL lItemHot, lFree, lRet
   LOCAL Value

   IF !::IsVisible() .OR. Empty( ::aPaintRect )
      RETURN NIL
   ENDIF

   aRect    := AClone( ::aPaintRect )
   Value    := ::GetValue( nPos )
   nClrText := IIF( ::nClrText != NIL, ::nClrText, ::oParent:nClrText )
   nPad     := ::nTextPad
   lItemHot := .f.

   aRect[ rtLEFT ]   += nX
   aRect[ rtTOP ]    += nY
   aRect[ rtRIGHT ]  += nX
   aRect[ rtBOTTOM ] += nY

   WITH OBJECT ::oParent
      IF !lHot .AND. ::lHotTrack .AND. :nHotItem == ::nItem  .AND. :nHotPos == nPos
         lItemHot := .T.
      ENDIF
      IF lHot
         nClrPane := :nCardClrHot
      ELSEIF lSel
         nClrPane := :nCardClrSel
      ELSEIF lActive .AND. :nCardClrAct != NIL
         nClrPane := :nCardClrAct
      ELSE
         nClrPane := :nCardClrPane
      ENDIF
   END WITH

   lRet := ::oParent:OnCardPaint( Self, @Value, @nClrText, @nClrPane, nPos, lActive, hDC, aRect )

   IF lRet == NIL .OR. lRet

      cValue := ToString( Value )

      hPaneBrush := CreateSolidBrush( nClrPane )

      WITH OBJECT ::oParent
         IF ::lButton .AND. :nClickPos == nPos .AND. :nClickItem == ::nItem
            hHotBrush := CreateSolidBrush( nClrPane - RGB( 50,50,50 ) )
            FillRect( hDC, aRect, hHotBrush )
            DeleteObject( hHotBrush )
            IF ::lHotTrack
               InflateRect( aRect, -1, -1 )
            ENDIF
         ELSEIF lItemHot
            hHotBrush := CreateSolidBrush( nClrPane - RGB( 50,50,50 ) )
            FillRect( hDC, aRect, hPaneBrush )
            FrameRect( hDC, aRect, hHotBrush )
            InflateRect( aRect, -1, -1 )
            FrameRect( hDC, aRect, hHotBrush )
            DeleteObject( hHotBrush )
         ELSE
            FillRect( hDC, aRect, hPaneBrush )
            IF ::lHotTrack
               InflateRect( aRect, -1, -1 )
            ENDIF
         ENDIF
      END WITH

      SWITCH ::nType
      CASE ctLABEL
         IF nPad > 0
            IF ::nVAlignment == vaTOP
               InflateRect( aRect, -nPad, -nPad )
            ELSE
               aRect[ rtLEFT ] += nPad
            ENDIF
         ENDIF
         nHAlign := IIF( ::nAlignment == taCENTER, DT_CENTER, IIF( ::nAlignment == taLEFT, DT_LEFT, DT_RIGHT ) )
         IF !::lMultiLine
            nVAlign := IIF( ::nVAlignment == vaCENTER, DT_VCENTER, IIF( ::nVAlignment == vaTOP, DT_TOP, DT_BOTTOM ) )
            nFlags  := nOr( DT_SINGLELINE, DT_END_ELLIPSIS, DT_NOPREFIX, nVAlign, nHAlign )
         ELSE
            nVAlign := DT_TOP
            nFlags  := nOr( DT_WORDBREAK, nVAlign, nHAlign )
         ENDIF
         SetbkMode( hDC, TRANSPARENT )
         hOldFont := SelectObject( hDC, ::oFont:Handle )
         SetTextAlign( hDC, nOr( TA_TOP, TA_LEFT, TA_NOUPDATECP ) )
         SetTextColor( hDC, nClrText )
         DrawText( hDC, cValue, aRect, nFlags )
         SelectObject( hDC, hOldFont )
         EXIT
      CASE ctLABELEX
         IF nPad > 0
            IF ::nVAlignment == vaTOP
               InflateRect( aRect, -nPad, -nPad )
            ELSE
               aRect[ rtLEFT ] += nPad
            ENDIF
         ENDIF
         SetbkMode( hDC, TRANSPARENT )
         hOldFont := SelectObject( hDC, ::oFont:Handle )
         nClrLink := IIF( ::nClrLink != NIL, ::nClrLink, ::oParent:nCardClrLink )
         SetTextColor( hDC, nClrText )
         XA_DrawTextEx2( hDC, cValue, aRect, IIF( ::lMultiLine, 100, -1 ), ::nVAlignment, ::nAlignment, nClrLink, .T. )
         SelectObject( hDC, hOldFont )
         EXIT
      CASE ctPICTURE
         IF ValType( Value ) == "C" .AND. Len( Value ) > 512
            oPict := TPicture():LoadFromStream( Value )
            lFree := .T.
         ELSEIF ValType( Value ) == "O" .AND. Value:IsKindOf( "TPicture" )
            lFree := .F.
            oPict := Value
         ENDIF
         IF oPict != NIL
            WITH OBJECT oPict
               :Paint( hDC, aRect[ rtLEFT ], aRect[ rtTOP ], aRect[ rtRIGHT ], aRect[ rtBOTTOM ], .F., .T., ::lAutoFit )
            END WITH
            IF lFree
               oPict:End()
            ENDIF
         ENDIF
         EXIT
      CASE ctIMAGEINDEX
         XA_DrawBitmapByPos( hDC, ::oParent:oImageList:Handle, Value, aRect )
         EXIT
      END SWITCH

      DeleteObject( hPaneBrush )

   ENDIF

RETURN NIL

//------------------------------------------------------------------------------

METHOD CheckScroll( nPos, nX, nY )  CLASS XCardItem

   LOCAL aRect, aRect2
   LOCAL nSize, hDC, nFlag, nClrText, nClrPane, hOldFont
   LOCAL Value

   IF ::nVAlignment != vaTOP .OR. ( ::nType != ctLABEL .AND. ::nType != ctLABELEX )
      RETURN .F.
   ENDIF

   aRect := AClone( ::aPaintRect )
   Value := ::GetValue( nPos )
   hDC   := GetDC( 0 )
   nFlag := IIF( ::nAlignment == taCENTER, DT_CENTER, IIF( ::nAlignment == taLEFT, DT_LEFT, DT_RIGHT ) )

   nClrText := IIF( ::nClrText != NIL, ::nClrText, ::oParent:nClrText )

   WITH OBJECT ::oParent
      nY -= :nClientTop
      IF :nCardClrAct != NIL
         nClrPane := :nCardClrAct
      ELSE
         nClrPane := :nCardClrPane
      ENDIF
   END WITH

   aRect[ rtLEFT ]   += nX
   aRect[ rtTOP ]    += nY
   aRect[ rtRIGHT ]  += nX
   aRect[ rtBOTTOM ] += nY

   ::oParent:OnCardPaint( Self, @Value, @nClrText, @nClrPane, nPos, .F., 0, aRect )

   InflateRect( aRect, -::nTextPad, -::nTextPad )

   SWITCH ::nType
   CASE ctLABEL
      hOldFont := SelectObject( hDC, ::oFont:Handle )
      aRect2 := AClone( aRect )
      SetTextAlign( hDC, nOr( TA_TOP, TA_LEFT, TA_NOUPDATECP ) )
      SetTextColor( hDC, nClrText )
      DrawText( hDC, ToString( Value ), @aRect2,  nOr( nFlag, DT_CALCRECT ) )
      nSize := RectHeight( aRect2 )
      SelectObject( hDC, hOldFont )
      EXIT
   CASE ctLABELEX
      hOldFont := SelectObject( hDC, ::oFont:Handle )
      nSize := DrawTextExSize( hDC, ToString( Value ), aRect )
      SelectObject( hDC, hOldFont )
      EXIT
   END SWITCH

   ReleaseDC( 0, hDC )

   IF nSize > RectHeight( aRect )
      WITH OBJECT ::oParent:oLabelEx
         :nClrText := nClrText
         :nClrPane := nClrPane
         :oFont := ::oFont:Clone()
         :nClientTop := 0
         :SetBounds( aRect[ rtLEFT ], aRect[ rtTOP ], RectWidth( aRect ), RectHeight( aRect ) )
         :cText := ToString( Value )
         :lVisible := .t.
         :SetFocus()
      END WITH
      RETURN .T.
   ENDIF

RETURN .F.

//------------------------------------------------------------------------------

#pragma BEGINDUMP

#include <windows.h>
#include <commctrl.h>
#include <xailer.h>
#include <constants.ch>
#include <colors.ch>

//------------------------------------------------------------------------------

HB_FUNC_STATIC( DRAWTEXTEXSIZE ) // DrawTextExSize( hDC, Value, aRect ) --> nSize
{
   HDC hdc = (HDC) hb_parnl( 1 );
   RECT rc;

   rc.left   = hb_parvnl( 3, 1 );
   rc.top    = hb_parvnl( 3, 2 );
   rc.right  = hb_parvnl( 3, 3 );
   rc.bottom = hb_parvnl( 3, 4 );

   hb_retnl( XA_DrawTextEx( hdc, (LPSTR) hb_parc( 2 ), hb_parclen( 2 ), &rc, DT_CALCRECT, 0, NULL, NULL, NULL) );
}

//------------------------------------------------------------------------------

#pragma ENDDUMP