Classe Metro

[Antonio Linares]

Joao,

Please check in FWH\source\classes\metropnl.prg if Method AddButton() returns oBtn:

Code: Select all  Expand view  RUN

METHOD AddButton( lLarge, nGroup, cCaption, bAction, nClrText, nClrPane, cImgName, oFont, ;
                  nAlign, nBmpAlign, nBmpWidth, nBmpHeight, cText, nTextAlign, ;
                  oTextFont, oSubMetro, cBackImage, cAction, cSub ) CLASS TMetroPanel

   local oBtn
   local nX := ::nMetroMargin + ( ::nRow * ( ::nBtnSize + 8 ) )
   local nY := ::nMetroTop + ( ::nCol * ( ::nBtnSize + 8 ) )

   DEFAULT lLarge := .F.
   DEFAULT nClrText := CLR_WHITE, nClrPane := NextClr()

   oBtn  := TMetroBtn():New( nX, nY, lLarge, Self, cCaption, cImgName, bAction, nAlign, ;
            nBmpAlign, nBmpWidth, nBmpHeight, oFont, cText, nTextAlign, oTextFont, oSubMetro, ;
            nGroup, cBackImage, cAction, cSub )

   oBtn:SetColor( nClrText, nClrPane )
   oBtn:nClrCaption  := nClrText
   if ValType( cBackImage ) == 'C' .and. File( cBackImage )
      oBtn:SetBackGround( cBacKImage )
   endif

   AAdd( ::aButtons, oBtn )

   ::nCol++
   if lLarge
      ::nCol++
   endif

   if ::nCol > 5
      ::nRow++
      ::nCol = 0
   endif

return oBtn
 

[Joaoalpande]

Gracias Antonio , si addbutton return obtn , fontes:

teste.prg :

Code: Select all  Expand view  RUN

#include "fivewin.ch"
#include "metropnl.ch"

static oMetro, oMetro1, oMetro2, oMetro3, lMetro[3], oTools, oSBtn[6], oFont1, oFont2, oBigfont
static nClrBack   := CLR_GREEN, aRect[4], nPanel := 1
static lMainBar := .F., lSubBar := .F., c_Path, c_Path1, oMainBar, oSubBar, nWColorT := 0
static nWStyle := 4, nWColorF := 16443068, nWColorB := 10899511, nWGradPos := 0.2
static lWDirect := .T., cWBrush := "BluStone.Bmp", cWImage := "Fantasy2.Jpg"

FUNCTION MAIN( cParam )
LOCAL oWnd, oBar, oBrush
LOCAL cTitle := "CATALOGO VINHOS "

   SET DELETED ON
   SET SOFTSEEK OFF
   SET EPOCH TO 1950
   SET DATE FORMAT "dd/mm/yyyy"

oFont1 := TFont():New("Arial",0,-16,.F.,.T.,0,0,0,.F. )
oFont2 := TFont():New("Arial",0,-25,.F.,.T.,0,0,0,.F. )
oBigFont := TFont():New("Arial",0,-38,.F.,.T.,0,0,0,.F. )
oSmallFont := TFont():New("Arial",0,-12,.F.,.T.,0,0,0,.F. )

aRect[3] := GetSysmetrics( 1 ) - 25 // Screen-Height
aRect[4] := GetSysmetrics( 0 ) // Screen-Width

c_path := cFilePath(GetModuleFileName( GetInstance() ) )
// lChDir( "../" ) // needed starting from a subdirectory
c_path1 := c_path + "Bitmaps\"
c_path2 := c_path + "Bitmaps\Hires\"
c_path3 := c_path + "Bitmaps\AlphaBmp\"
c_path4 := c_path + "Bitmaps\Metro\"

lMetro[1] := .F.
lMetro[2] := .F.
lMetro[3] := .F.

REQUEST DBFCDX

IF FILE( c_Path + "F_REG.DBF" )
    DBSELECTAREA( 1 )
    NET_USE (c_Path + "F_REG.DBF", 3,.T.)
ELSE
        MSGALERT("ARQUIVO REGIÕES INEXISTENTE","Atenção")
ENDIF

DEFINE WINDOW oWnd TITLE cTitle STYLE nOr( WS_POPUP, WS_MAXIMIZE );
COLOR 255, CLR_GREEN

oMetro1 := MakeMetroPanel( oWnd )

oMetro1:bRClicked := { |Row,Col,f,o| IIF( lSubBar = .F., MAIN_MOVE() , ;
                                                                                                     ( oSubBar:End(), MAIN_MOVE() ) ) }

ACTIVATE WINDOW oWnd MAXIMIZED ;
ON INIT ( STARTUP(oMetro1,1), ;
                  oMetro1:Show(), ;
                  oWnd:Move( 0, 0, aRect[4], aRect[3], .f. ) ) // Top, left, width, height

oFont1:End()
oFont2:End()
oBigFont:End()
oSmallFont:End()

RETURN NIL
//----------------------------------------------------------------------------//

STATIC FUNCTION MAKEMETROPANEL( oWnd )
local oMetro1, oBtn,cnt:=0,oBt[50],nRec[20],aNReg:={},aCReg:={},NBTNPOS,octl

DEFINE METROPANEL oMetro1 OF oWnd TITLE "Catálogo de Vinhos" ;
ON CLICK oWnd:End()

oMetro1:lDesignMode := .t.
lMetro[1] := .T.
DBSELECTAREA(1)
DBGOTOP()

while !eof()
      DEFINE METROBUTTON oBtn OF oMetro1 ;
         PROMPT FieldGet( 1 ) COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;  // 1 primer campo
         IMAGE "..\bitmaps\metro\files.bmp" ;
         ACTION ShowRecords( ::Cargo )
      oBtn:Cargo := RecNo()
      DbSkip()
end


DEFINE METROBUTTON oBt OF oMetro1 ;
COLOR   CLR_WHITE,RGB( 255,  0,  66 ) ;
CAPTION   "Exit" ;
ALIGN   "TOPRIGHT" ;
GROUP   2 ;
BITMAP   c_path4 + "exit.bmp" ;
BMPALIGN   "BOTTOMLEFT" ;
SIZE   48, 48 ;
ACTION   If( MsgYesNo( "Want to exit ?" ), oWnd:End(),)



RETURN oMetro1

FUNCTION ShowRecords()
  //aqui preciso saber o recno() para fazer o filtro do artigos.dbf e mostrar em metrobutton
RETURN  NIL

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

FUNCTION STARTUP(oMetro,nPanel)

DBSELECTAREA(1)
DBGOTO(nPanel)

oMetro:SetColor( nWColorT,  )
IF nWStyle = 1 // Color
    D_BACKGRD( oMetro, 1, nWColorF )
ELSEIF nWStyle = 2 // Gradient
    D_BACKGRD( oMetro, 2, nWColorF, nWColorB, nWGradPos, lWDirect )
ELSEIF nWStyle = 3 // BRUSH
    D_BACKGRD( oMetro, 3, , , , , c_path1 + cWBrush )
ELSEIF nWStyle = 4 // Image
    D_BACKGRD( oMetro, 4, , , , , , c_path2 + cWImage )
ENDIF

RETURN( NIL )
// ----------------------------------------------------------------------------

FUNCTION MAIN_MOVE()
LOCAL nStepL := 0, nLPos := aRect[4]

IF lMainBar = .F.  // Move IN
    DO WHILE .T.
        nStepL := nStepL + 6
        IF nStepL >  100
            EXIT
        ENDIF
        INKEY(0.02)
        nLPos := aRect[4] - nStepL
        oMainBar:Move( 0, nLPos, , aRect[3], .f. ) // Top, left, width, height
    ENDDO
    lMainBar = .T.
ELSE
    DO WHILE .T.
        nStepL := nStepL + 6
        IF nStepL >  100
            EXIT
        ENDIF
        INKEY(0.02)
        nLPos := aRect[4] - 100 + nStepL
        oMainBar:Move( 0, nLPos, , aRect[3], .f. ) // Top, left, width, height
    ENDDO
    lMainBar = .F.
ENDIF

RETURN NIL

// --------  WINDOW / DIALOG - Background ---------------

FUNCTION D_BACKGRD( oDlg, nStyle, nColor1, nColor2, nMove, lDirect, cBrush, cImage )
LOCAL oBrush, hDC, aGrad, oImage
LOCAL aRect := GETCLIENTRECT( oDlg:hWnd )

IF nStyle = 1 // COLOR
    DEFINE BRUSH oBrush COLOR nColor1
    oDlg:SetBrush( oBrush )
    oBrush:End()
ENDIF
IF nStyle = 2 // GRADIENT Brush
    aGrad := { { nMove, nColor1, nColor2 }, { nMove, nColor2, nColor1 } }
    hDC = CreateCompatibleDC( oDlg:GetDC() )
    hBmp = CreateCompatibleBitMap( oDlg:hDC, oDlg:nWidth, oDlg:nHeight )
    hBmpOld = SelectObject( hDC, hBmp )
    GradientFill( hDC, 0, 0, oDlg:nHeight, oDlg:nWidth, aGrad, lDirect ) // .T: = Vertical
    DeleteObject( oDlg:oBrush:hBrush )
    oBrush := TBrush():New( ,,,, hBmp )
    oBrush:Cargo  := aGrad
    SelectObject( hDC, hBmpOld )
    ReleaseDC(hDC)
    oDlg:SetBrush( oBrush )
    oBrush:End()
ENDIF
IF nStyle = 3 // BMP-BRUSH
    DEFINE BRUSH oBrush FILE  cBrush
    oDlg:SetBrush( oBrush )
    oBrush:End()
ENDIF
IF nStyle = 4 // Image ADJUSTED
    IF FILE( cImage )
        DEFINE IMAGE oImage FILE cImage
        oBrush := TBrush():new( ,,,, ResizeBmp( oImage:hBitmap,  aRect[4], aRect[3], .T. ) )
        oImage:End()
        oDlg:SetBrush( oBrush )
        oBrush:End()
    ELSE
        IF !EMPTY(cImage)
            MsgAlert( "File : " + cImage + CRLF + ;
                    "does not exist" + CRLF + ;
                        "to show Image !", "ATTENTION" )
        ENDIF
    ENDIF
ENDIF

RETURN( NIL )

// ---------- NET - FUNCTIONS ----------------------------

FUNCTION NET_USE ( cDBName1, ntrials, net)

LOCAL lReturn  := .T.
LOCAL lOpen    := .F.
LOCAL close := 1

ntrcount   := ntrials
JaNein    := .F.

// SHARED    all Users
// EXCLUSIVE  1 User

IF File( cDBName1 )
    ntrials := ntrcount
    DO WHILE !lOpen
        close := 2
        DO WHILE .T.
            IF !net
                USE &cDBName1 EXCLUSIVE
            ELSE
                USE &cDBName1 SHARED
            ENDIF
            IF !NetErr()
                lReturn   := .T.
                lOpen     := .T.
                ntrials := 0
            ELSE
                IF net = .T.
                    status := "SHARED"
                ELSE
                    status := "EXCLUSIVE"
                ENDIF
                IF ntrcount = ntrials
                    xName := WNetGetUser()
                    IF MsgYesNo( "Open " + status + "  of " + upper(cDBName1) + " not possible !" + ;
                                                   " try again ?", "Network-error -> &xName !" )
                        ntrials := ntrcount
                        JaNein    := .T.
                    ELSE
                        ntrials := 0
                        JaNein    := .F.
                    ENDIF
                ENDIF
                IF JaNein = .T.
                    ntrials --
                    IF ntrials > 0 .AND. ntime > 0
                        NET_WAIT ( ntrcount, ntrials, ntime)
                    ENDIF
                    IF ntrials = 0
                        ntrials := ntrcount
                    ENDIF
                ELSE
                    lReturn   := .F.
                    lOpen     := .T.
                    ntrials := 0
                ENDIF
            ENDIF
            IF ntrials = 0
                lOpen := .T.
                EXIT
            ENDIF
        ENDDO
    ENDDO
ELSE
    nMsgBox ("File -> " + cDBName1 + " is missing !", "Attention !")
    SET RESOURCES to
    set _3DLOOK OFF
    FreeLibrary()
    close database
    QUIT
ENDIF

RETURN lReturn

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

FUNCTION NET_RLOCK( ntrials, ntime )

LOCAL   lReturn   := .F.
LOCAL   ntrcount   := 0
LOCAL   nZSek     := 0
ntrcount := ntrials
DO WHILE !lReturn
    DO WHILE ntrials > 0
        IF !RLock()
            ntrials --
            IF ntrials > 0 .AND. ntime > 0
                NET_WAIT ( ntrcount, ntrials, ntime )
            ENDIF
        ELSE
            lReturn := .T.
            EXIT
        ENDIF
    ENDDO
    IF ntrials = 0
        IF MsgYesNo( "Not possible, to lock the record !" + ;
                       " Try again ?", "Network Error !" )
            lOpen     :=.T.
            ntrials := ntrcount
        ELSE
            lReturn := .F.
            lOpen   := .F.
            EXIT
        ENDIF
    ENDIF
ENDDO
IF lReturn = .F.
    nMsgBox ("Files are not saved !!!", "Attention !")
ENDIF

RETURN lReturn

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

FUNCTION NET_ULOCK ()

LOCAL   lReturn   := .F.
LOCAL   ntrcount   := 0
LOCAL   nZSek     := 0

IF len(fieldname(1)) > 0                        && DB offen ?
    UNLOCK                                       && ja
ENDIF

RETURN lReturn

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

FUNCTION NET_CLOSE(ntrials, ntime, net)

LOCAL lReturn  := .T.
LOCAL lOpen    := .F.
LOCAL close := 1

ntrcount   := ntrials
JaNein    := .F.
JaNein    := .F.

cDBName1 := DBF()

DO WHILE !lOpen
    close := 1
    DO WHILE ntrials > 0
        USE
        IF NetErr()
            ntrials --
            IF MsgYesNo( "Close of file : " + upper(cDBName1) + " not possible !" + ;
                " Try again ?", "Network-Error !" )
                lOpen :=.T.
                ntrials := ntrcount
                IF ntrials > 0 .AND. ntime > 0
                    NET_WAIT ( ntrcount, ntrials, ntime)
                ENDIF
            ELSE
                lReturn   := .F.
                lOpen     := .T.
                ntrials := 0
            ENDIF
        ELSE
            geschloss := .T.
            lReturn   := .T.
            lOpen     := .T.
            ntrials := 0
        ENDIF
    ENDDO
ENDDO

RETURN lReturn

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

FUNCTION NET_WAIT ( ntrcount, ntrials, ntime )

local oMeter, oText1

MsgMeter( { | oMeter, oText1 | ;
SHOW_WAIT(ntrcount, ntrials, ntime, oMeter, oText1) } , ;
"rest trials : " + ltrim(str(ntrials)) + ". trial..." )

RETURN nil

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

STATIC FUNCTION SHOW_WAIT(ntrcount, ntrials, ntime, oMeter, oText1)

oMeter:nTotal = ntrcount
nZSek := Seconds()
oText1:SetText( "rest of trials : " + ltrim(str(ntrials)))
oMeter:Set( ntrials )
SysRefresh()
DO WHILE Seconds() < nZSek + ntime
ENDDO

RETURN nil

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

FUNCTION NET_DELETE ( nSeconds )

LOCAL lReturn := .F.
LOCAL ntrcount := 0
LOCAL cDatabase := DBF()

ntrcount :=  nSeconds

DO WHILE !lReturn
    DO WHILE  nSeconds > 0
        IF !RLock()
            nSeconds --
            IF  nSeconds > 0
                NET_WAIT (  nSeconds )
            ENDIF
        ELSE
            DELETE
            lReturn := .T.
            EXIT
        ENDIF
    ENDDO
    IF  nSeconds = 0
        IF MsgYesNo( "Not possible to delete a Record of" + upper(cDatabase) + ;
                     " try again ?", "Network-Error !" )
             nSeconds := ntrcount
        ELSE
            lReturn := .F.
            EXIT
        ENDIF
    ENDIF
ENDDO
if lReturn = .F.
    MsgAlert("The Record is not deleted !!!", "Attention !")
endif

RETURN lReturn

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

FUNCTION NET_APPEND ( ntrials, ntime )

LOCAL   lReturn := .F.
LOCAL   ntrcount := 0
LOCAL   nZSek   := 0

ntrcount := ntrials

DO WHILE !lReturn
    DO WHILE ntrials > 0
        DBAppend()
        IF NetErr()
            ntrials --
            IF ntrials > 0 .AND. ntime > 0
                NET_WAIT ( ntrcount, ntrials, ntime )
            ENDIF
        ELSE
            lReturn := .T.
            EXIT
        ENDIF
    ENDDO
    IF ntrials = 0
        IF MsgYesNo( "Append in : " + upper(cDBName) + " not possible !" + ;
                                " Try again ?", "Network Error !" )
            lOpen     :=.T.
            ntrials := ntrcount
        ELSE
            lReturn := .F.
            lOpen   := .F.
            EXIT
        ENDIF
    ENDIF
ENDDO
if lReturn = .F.
    nMsgBox ( "No Record appended !!!", "Attention !")
endif

RETURN lReturn

// ----------------------------------------
// --------- DBF Array ----------------

STATIC FUNCTION NEW_DBF()
LOCAL DBFARRAY := {}

AADD(DBFARRAY, { "CODIGO",              "C",  2, 0 })
AADD(DBFARRAY, { "N_FAM",               "C", 250, 0 })

cDbfName := c_Path + "F_REG.DBF"

DELETE FILE &cDbfName

IF LEN(DBFARRAY) == 0
    MsgInfo( "DBF Structure-Error", "New Structure" )
    RETURN NIL
ENDIF

DBCREATE( cDbfName, DBFARRAY )
// DbCreate(cDir+'CL',{ {aClienti[1],aClienti[2],aClienti[3],aClienti[4]}} , 'DBFCDX')

DBSELECTAREA( 1 )
NET_USE (c_Path + "F_REG.DBF", 3,.T.)

NET_APPEND ( 3, 3 )
IF NET_RLOCK( 5, 5 )
    (1)->CODIGO :=  "DOURO"
    (1)->NOME   :=  "REGIÃO DO DOURO"
    NET_ULOCK()
ENDIF
NET_APPEND ( 3, 3 )
IF NET_RLOCK( 5, 5 )
    (1)->CODIGO :=  "ALENTEJO"
    (1)->NOME   :=  "REGIÃO DO ALENTEJO"
    NET_ULOCK()
ENDIF
NET_APPEND ( 3, 3 )
IF NET_RLOCK( 5, 5 )
    (1)->CODIGO :=  "LISBOA"
    (1)->NOME   :=  "REGIÃO DE LISBOA"
    NET_ULOCK()
ENDIF

COMMIT
DBGOTOP()
NET_CLOSE ( 3,5,.T.)

IF File( cDbfName )
    MsgInfo( "Novo DBF Criado! ( " + ALLTRIM(STR(LEN(DBFARRAY))) + " registos )", "Nova Estrutura" )
ELSE
    MsgAlert( "Não consiguiu criar novo ficheiro!","Projecto-Ficheiro")
ENDIF

RETURN NIL

metropnl.ch

Code: Select all  Expand view  RUN

/*
*
*   MetroPnl.ch
*
*
*/

#include "fivewin.ch"

#ifndef DT_TOP
#define DT_TOP              0
#define DT_LEFT             0
#define DT_CENTER           1
#define DT_RIGHT            2
#define DT_VCENTER          4
#define DT_BOTTOM           8
#define DT_WORDBREAK       16
#define DT_SINGLELINE      32
#define DT_CALCRECT      1024
#endif

#xcommand DEFINE METROPANEL <oMetro> OF <oWnd> ;
            [ TITLE <cTitle> ] ;
            [ COLOR <nClrText>, <nClrPane> ] ;
            [ TILESIZE <nSize> ] ;
            [ ON CLICK <uAction> ] ;
            [ SCROLLBARCOLOR <nClrThumb>, <nClrScroll> ] ;
          => ;
          <oMetro> := TMetroPanel():New( <oWnd>, <cTitle>, <nClrText>, <nClrPane>, <{uAction}>, <nSize>, ;
                         <nClrThumb>, <nClrScroll> )

#xcommand DEFINE METROBUTTON [<oBtn>] OF <oMetro> ;
            [ <prmt:PROMPT,CAPTION> <cPrompt> ] ;
            [ COLOR <nClrText>, <nClrPane> ] ;
            [ ALIGN <nAlign> ] ;
            [ FONT  <oFont>  ] ;
            [ GROUP <nGroup> ] ;
            [ MENU <oSub> ] ;
            [ <bmp:BITMAP,IMAGE> <cImgName> [ BMPALIGN <nBmpAlign> ] [ SIZE <nBmpWidth>,<nBmpHeight> ] ] ;
            [ BACKGROUND <cImage> ] ;
            [ <large: LARGE> ] ;
            [ <txt:BODY,BODYTEXT,TEXT> <cText> [ TEXTALIGN <nTextAlign> ] [ TEXTFONT <oTextFont> ] ] ;
            [ ACTION <uAction,...> ] ;
          => ;
            [ <oBtn> := ] <oMetro>:AddButton( <.large.>, <nGroup>, <cPrompt>, [<{uAction}>], <nClrText>, <nClrPane>,  ;
                     <cImgName>, <oFont>, <nAlign>, <nBmpAlign>, <nBmpWidth>, <nBmpHeight>, ;
                     <cText>, <nTextAlign>, <oTextFont>, <oSub>, <cImage>, <"uAction">, <"oSub"> )

#xcommand ADD [<oBtn>] TO METRO <oMetro> [<clauses,...>] => ;
          DEFINE METROBUTTON [<oBtn>] OF <oMetro> [<clauses>]
 

metropnl.prg

Code: Select all  Expand view  RUN

/*
*
*  MetroPnl.Prg
*
*/

#include "fivewin.ch"
#include "metropnl.ch"
#include "hbcompat.ch"  // important

// CLASSES: TMetroPanel and TMetroBtn

#define BTN_GAP       8
#define GRP_GAP      32
#define SCRLB_HEIGHT 20

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

static oDragWnd

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

CLASS TMetroPanel FROM TPanel

   CLASSDATA lRegistered AS LOGICAL
   CLASSDATA oActive  // for internal use

   //
   CLASSDATA nBtnSize, nMetroRows, nMetroTop, nMetroMargin, nSliderTop
   //
   DATA  nOffset        INIT 0
   DATA  nScrollRange   INIT 0
   DATA  nScrollRatio   INIT 1
   DATA  oFont, oFontB
   DATA  oBtnFont, oTextFont
   DATA  nGroups        INIT 1
   DATA  aButtons       INIT Array(0)
   DATA  lArranged      INIT .f.
   DATA  lDesignMode    INIT .f.
   DATA  nClrScroll
   DATA  nClrThumb
   DATA  nMetroWidth, nThumbSize, nThumbWidth
   DATA  nThumbPos      INIT 60
   DATA  hPen

   DATA  cTitle
   DATA  nRow, nCol
   DATA  oParent

   // lDrag, nDragRow, nOldCol used for metro sliding by dragging on screen or scrollbar
   DATA  lDrag INIT .F.
   DATA  nDragRow
   DATA  nOldCol INIT 0

   DATA  nScrollBarTop

   METHOD New( oWnd, cTitle, nClrText, nClrPane, bLClicked, nBtnSize, ;
               nClrThumb, nClrScroll ) CONSTRUCTOR

   METHOD Paint()
   METHOD AddButton( lLarge, nGroup, cCaption, bAction, nClrText, nClrPane, cImgName, oFont, ;
                     nAlign, nBmpAlign, nBmpWidth, nBmpHeight, cText, nTextAlign, ;
                     oTextFont, oSubMetro, cBackImage )
   METHOD Show() INLINE ( ::Arrange(), ::oBrush:ReSize( Self ), Super:Show(), ::lVisible := .t. )
   METHOD Hide() INLINE ( Super:Hide(), ::lVisible := .f. )
   METHOD Arrange()

   METHOD LButtonDown( nRow, nCol, nFlags )
   METHOD LButtonUp( nRow, nCol, nFlags )
   METHOD MouseMove( nRow, nCol, nFlags )

   METHOD MoveBtn( oBtnDrag, oBtnOver )
   METHOD SwitchTo( oNext, lRight )
   METHOD MouseWheel( nKey, nDelta, nXPos, nYPos )
   METHOD Slide( nPixels )
   METHOD ProgramCode()
   METHOD Destroy()

ENDCLASS

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

METHOD New( oWnd, cTitle, nClrText, nClrPane, bLClicked, nBtnSize, ;
            nClrThumb, nClrScroll ) CLASS TMetroPanel

   DEFAULT cTitle := "Start", nClrText := CLR_WHITE, nClrPane := CLR_GREEN

   DEFAULT ::nBtnSize      := IfNil( nBtnSize, 132 )
   DEFAULT ::nMetroRows    := Int( GetSysMetrics( 1 ) / ( ::nBtnSize + BTN_GAP ) ) - 1
   DEFAULT ::nMetroTop     := ::nBtnSize
   DEFAULT ::nMetroMargin  := ::nBtnSize

   Super:New( 0, 0, GetSysMetrics( 1 ) , GetSysMetrics( 0 ), oWnd )

   ::cTitle     = cTitle
   ::nRow       =   0
   ::nCol       =   0
   ::nClrThumb  = nClrThumb
   ::nClrScroll = nClrScroll
   ::hPen       = CreatePen( PS_SOLID, 2, CLR_BLACK )

   DEFAULT ::nClrScroll := RGB( 108, 110, 190 ), ;
           ::nClrThumb  := RGB( 148, 150, 230 )

   DEFINE FONT ::oFont  NAME "Segoe UI Light" SIZE 0, -52
   DEFINE FONT ::oFontB NAME "Segoe UI Light" SIZE 0, -60 BOLD

   DEFINE FONT ::oBtnFont  NAME "Segoe UI Light" SIZE 0, -20 BOLD
   DEFINE FONT ::oTextFont NAME "Segoe UI Light" SIZE 0, -16 BOLD

   ::lVisible  := .t.

   ::SetColor( nClrText, nClrPane )
   ::bLClicked    := bLClicked

   if ::oActive == nil
      ::oActive := Self
   endif

   DEFAULT ::bLClicked := { || If( ::oParent == nil,, ::SwitchTo( ::oParent, .t. ) ) }

   ::oWnd:oClient    := Self
   ::Hide()

return Self

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

METHOD Paint() CLASS TMetroPanel

   local aInfo
   local oRect    := ::GetCliRect()
   local hScrollBrush, hThumbBrush
   local nBarTotal

   aInfo := ::DispBegin()

   FillRect( ::hDC, oRect:aRect, ::oBrush:hBrush )
   ::Say( ( ::nBtnSize - ::oFont:nHeight ) / 2, ::nMetroTop, ::cTitle,,, ::oFont, .t., .t. )

   if ::nScrollRange > 0
      hScrollBrush      := CreateSolidBrush( ::nClrScroll )
      hThumbBrush       := CreateSolidBrush( ::nClrThumb  )
      ::nThumbWidth     := Int( ::nThumbSize * ( oRect:nWidth - 120 ) )
      nBarTotal         := oRect:nWidth - 120 - ::nThumbWidth
      ::nThumbPos       := Int( Abs( ::nOffSet / ::nScrollRange ) * nBarTotal ) + 60
      oRect:nTop        := oRect:nBottom - SCRLB_HEIGHT
      oRect:nHeight     := SCRLB_HEIGHT
      ::nScrollBarTop   := oRect:nTop
      ::nScrollRatio    := ( ::nScrollRange / nBarTotal )

      FillRect( ::hDC, oRect:aRect, hScrollBrush )
      FillRect( ::hDC, { oRect:nTop, oRect:nLeft + ::nThumbPos, oRect:nBottom, ;
            oRect:nLeft + ::nThumbPos + ::nThumbWidth }, hThumbBrush )
      DeleteObject( hScrollBrush )
      DeleteObject( hThumbBrush )

      MoveTo( ::hDC, oRect:nLeft + 32, oRect:nTop +  4 )
      LineTo( ::hDC, oRect:nLeft + 24, oRect:nTop + 10, ::hPen )
      LineTo( ::hDC, oRect:nLeft + 32, oRect:nTop + 16, ::hPen )

      MoveTo( ::hDC, oRect:nRight - 32, oRect:nTop +  4 )
      LineTo( ::hDC, oRect:nRight - 24, oRect:nTop + 10, ::hPen )
      LineTo( ::hDC, oRect:nRight - 32, oRect:nTop + 16, ::hPen )

   else
      ::nScrollBarTop   := oRect:nBottom + 2
   endif

   if ValType( ::bPainted ) == "B"
      Eval( ::bPainted, ::hDC, ::cPS, Self )
   endif

   ::DispEnd( aInfo )

return 0

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

METHOD Arrange( lReArrange ) CLASS TMetroPanel

   local nGrpLeft    := ::nMetroMargin + ::nOffset
   local nGrpRight
   local nGroup
   local aBtns, nBtns, oBtn, nCols
   local nRow, nCol, n

   if lReArrange == .t.
      ::lArranged := .f.
   endif

   if ::lArranged
      return Self
   endif

   for nGroup := 1 to ::nGroups
      aBtns       := {}
      nBtns       := 0
      for each oBtn in ::aButtons
         if oBtn:nGroup == nGroup
            AAdd( aBtns, oBtn )
            nBtns++
            if oBtn:lLarge
               nBtns++
            endif
         endif
      next
      nCols     := Ceiling( nBtns / ::nMetroRows )
      nRow := nCol := 0
      nGrpRight         := nGrpLeft
      for each oBtn in aBtns
         if If( oBtn:lLarge, nCol + 1, nCol ) > nCols
            nRow++
            nCol        := 0
         endif
         oBtn:nTop      := ::nMetroTop  + nRow * ( ::nBtnSize + BTN_GAP )
         oBtn:nLeft     := nGrpLeft + nCol * ( ::nBtnSize + BTN_GAP )
         nGrpRight      := Max( nGrpRight, oBtn:nLeft + oBtn:nWidth )
         nCol++
         if oBtn:lLarge
            nCol++
         endif
      next
      ::nScrollRange    := nGrpLeft - ::nMetroMargin - ::nOffSet
      nGrpLeft          := nGrpRight + GRP_GAP
      nGrpRight         := nGrpLeft

   next nGroup

   ::nMetroWidth     := nGrpRight - ::nOffSet
   ::nScrollRange    := Max(( ::nMetroWidth - ScreenWidth() ), ::nScrollRange )
   ::nScrollRange    := Max( 0, ::nScrollRange )
   ::nThumbSize      := 1 - ( ::nScrollRange / ::nMetroWidth )

   ::lArranged := .t.

return Self

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

METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TMetroPanel

   if nRow < ::nScrollBarTop .or. ( nCol >= ::nThumbPos .and. nCol <= ( ::nThumbPos + ::nThumbWidth ) )
      ::lDrag     = .T.
      ::nDragRow  = nRow
      ::nOldCol   = nCol
   endif

return nil

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

METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TMetroPanel

   ::lDrag     = .F.
   ::nDragRow  = nil

return nil

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

METHOD MouseMove( nRow, nCol, nFlags ) CLASS TMetroPanel

   if ::lDrag .and. ::nScrollRange > 0
      if ::nDragRow < ::nScrollBarTop .and. nRow < ::nScrollBarTop
         ::Slide( nCol - ::nOldCol )
      elseif ::nDragRow > ::nScrollBarTop .and. nRow > ::nScrollBarTop
         ::Slide( ( Int( ::nOldCol - nCol ) * ::nScrollRatio ) )
      else
         ::lDrag     := .f.
         ::nDragRow  := nil
      endif
      ::nOldCol = nCol
   endif

return nil

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

METHOD MoveBtn( oBtnDrag, oBtnOver ) CLASS TMetroPanel

   local nDrag, nOver

   SysRefresh()

   if oDragWnd != nil
      oDragWnd:End()
      oDragWnd    := nil
   endif

   if oBtnDrag == oBtnOver
      return Self
   endif

   nDrag    := AScan( ::aButtons, { |o| o == oBtnDrag } )
   ADel( ::aButtons, nDrag, .t. )
   nOver    := AScan( ::aButtons, { |o| o == oBtnOver } )
   AIns( ::aButtons, nOver + If( nDrag == nOver, 1, 0 ), oBtnDrag, .t. )
   oBtnDrag:nGroup   := oBtnOver:nGroup
   ::lArranged := .f.
   ::Arrange()
   ::Refresh()
   AEval( ::aButtons, { |o| o:Refresh() } )

return Self

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

METHOD ProgramCode( lShow ) CLASS TMetroPanel

   local cPrg  := ''
   local oTile

   DEFAULT lShow := .f.

   cPrg  := "static function MakeMetroPanel( oWnd )" + CRLF + CRLF
   cPrg  += "   local oMetro, oBtn" + CRLF + CRLF
   cPrg  += '   DEFINE METROPANEL oMetro OF oWnd TITLE "' + ::cTitle + '" ;' + CRLF
   cPrg  += '      COLOR ' + cClrToCode( ::nClrText ) + ', ' + cClrToCode( ::nClrPane ) + ' ;' + CRLF
   cPrg  += '      ON CLICK oWnd:End()' + CRLF + CRLF

   if ::lDesignMode
      cPrg  += '   oMetro:lDesignMode := .t.' + CRLF + CRLF
   endif

   for each oTile in ::aButtons
      cPrg     += oTile:ProgramCode()
   next

   cPrg  += CRLF + "return oMetro" + CRLF + CRLF

   if lShow
      ViewCode( cPrg )
   endif

return cPrg

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

METHOD Destroy() CLASS TMetroPanel

   RELEASE FONT ::oFont, ::oFontB, ::oBtnFont, ::oTextFont
   DeleteObject( ::hPen )

return Super:Destroy()

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

METHOD SwitchTo( oNext, lRight ) CLASS TMetroPanel

   ::Hide()
   ::oWnd:oClient := oNext
   oNext:Show()
   ::oActive   := oNext

return Self

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

METHOD AddButton( lLarge, nGroup, cCaption, bAction, nClrText, nClrPane, cImgName, oFont, ;
                  nAlign, nBmpAlign, nBmpWidth, nBmpHeight, cText, nTextAlign, ;
                  oTextFont, oSubMetro, cBackImage, cAction, cSub ) CLASS TMetroPanel

   local oBtn
   local nX := ::nMetroMargin + ( ::nRow * ( ::nBtnSize + 8 ) )
   local nY := ::nMetroTop + ( ::nCol * ( ::nBtnSize + 8 ) )

   DEFAULT lLarge := .F.
   DEFAULT nClrText := CLR_WHITE, nClrPane := NextClr()

   oBtn  := TMetroBtn():New( nX, nY, lLarge, Self, cCaption, cImgName, bAction, nAlign, ;
            nBmpAlign, nBmpWidth, nBmpHeight, oFont, cText, nTextAlign, oTextFont, oSubMetro, ;
            nGroup, cBackImage, cAction, cSub )

   oBtn:SetColor( nClrText, nClrPane )
   oBtn:nClrCaption  := nClrText
   if ValType( cBackImage ) == 'C' .and. File( cBackImage )
      oBtn:SetBackGround( cBacKImage )
   endif

   AAdd( ::aButtons, oBtn )

   ::nCol++
   if lLarge
      ::nCol++
   endif

   if ::nCol > 5
      ::nRow++
      ::nCol = 0
   endif

return oBtn

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

METHOD MouseWheel( nKey, nDelta, nXPos, nYPos ) CLASS TMetroPanel

   local nMove    := Int( nDelta / 3 )
   local n, oBtn

   ::oActive:Slide( nDelta / 3 )

return nil

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

METHOD Slide( nPixels ) CLASS TMetroPanel

   local aRect

   if ::nScrollRange > 0
      if nPixels > 0
         nPixels  := Min( nPixels, -::nOffSet )
      endif

      if ::nOffSet + nPixels < -::nScrollRange
         nPixels  := -::nScrollRange- ::nOffSet
      endif

      if nPixels != 0
         aRect       = GetClientRect( ::hWnd )
         aRect[ 1 ]  = IfNil( ::nSliderTop, ::nMetroTop )
         aRect[ 3 ] -= ( SCRLB_HEIGHT + 2 )
         ScrollWindow( ::hWnd, nPixels, 0, 0, aRect )
         ::nOffSet    += nPixels
         if ::nScrollRange > 0
            ::Refresh()
         endif
      endif
   endif

return Self

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

CLASS TMetroBtn FROM TBtnBmp

   CLASSDATA lRegistered AS LOGICAL

   DATA nGroup       INIT 1
   DATA nMargin      INIT 8
   DATA lLarge       INIT .f.

   DATA nCapAlign    INIT nOr( DT_TOP, DT_RIGHT )
   DATA nBmpAlign    INIT nOr( DT_BOTTOM, DT_LEFT )
   DATA nBmpTop, nBmpLeft, nBmpWidth, nBmpHeight
   DATA cBmpSource

   DATA cText
   DATA nTextAlign   INIT nOr( DT_RIGHT, DT_VCENTER )
   DATA nClrCaption
   DATA oTextFont
   DATA cAction, cSub
   DATA oSub

   METHOD New( nTop, nLeft, lLarge, oMetro, cCaption, uImage, bAction, nAlign, ;
          nBmpAlign, nBmpWidth, nBmpHeight, oFont, oSub, nGroup, cBackImage, cAction, cSub ) CONSTRUCTOR

   METHOD LoadBitmaps( uBmp )
   METHOD Paint()
   METHOD DrawPrompt( cPrompt, oFont, nColor, nAlign )
   METHOD DrawMultiLine( cText, oFont, nColor, nAlign )
   METHOD DesignMenu()
   METHOD AlignObject( nRow, nCol )
   METHOD CalcBmpAlign( lRecalc )
   METHOD SetBackGround( cImage )
   METHOD SetBitmap( cImage )
   METHOD ToggleSize()
   METHOD ProgramCode()
   METHOD Destroy()

ENDCLASS

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

METHOD New( nTop, nLeft, lLarge, oMetro, cCaption, uImage, bAction, nAlign, ;
            nBmpAlign, nBmpWidth, nBmpHeight, oFont, cText, nTextAlign, ;
            oTextFont, oSub, nGroup, cBackImage, cAction, cSub ) CLASS TMetroBtn

   local nWidth   := oMetro:nBtnSize + If( lLarge, oMetro:nBtnSize + 8, 0 )

   DEFAULT nAlign := nOr( DT_TOP, DT_RIGHT ), nBmpAlign := nOr( DT_BOTTOM, DT_LEFT ), ;
           cText  := '', nTextAlign := nOr( DT_VCENTER, DT_RIGHT )

   if ValType( nAlign ) == 'C'
      nAlign      := StrToAlign( nAlign, DT_TOP + DT_RIGHT )
   endif
   if ValType( nBmpAlign ) == 'C'
      nBmpAlign   := StrToAlign( nBmpAlign, DT_BOTTOM + DT_LEFT )
   endif
   if ValType( nTextAlign ) == 'C'
      nTextAlign  := StrToAlign( nTextAlign, DT_VCENTER + DT_RIGHT )
   endif

   DEFAULT nGroup := oMetro:nGroups
   oMetro:nGroups := Max( oMetro:nGroups, nGroup )
  ::nGroup       := nGroup

   ::lLarge       := lLarge
   ::lTransparent    := .f.
   ::nCapAlign    := nAlign
   ::nBmpAlign    := nBmpAlign
   ::nBmpWidth    := nBmpWidth
   ::nBmpHeight   := nBmpHeight
   ::cText        := cText
   ::nTextAlign   := nTextAlign
   ::oTextFont    := oTextFont
   ::oSub         := oSub
   ::cAction      := cAction
   ::cSub         := cSub

   if ValType( ::cText ) == 'C'
      ::cText     := StrTran( ::cText, ';', CRLF )
   endif

   Super:New( nTop, nLeft, nWidth, oMetro:nBtnSize, uImage, nil, nil, nil, bAction, ;
              oMetro, nil, nil, .f., .t., cCaption, oFont, nil, nil, .f., 'BOTTOM', ;
              .f. )

   DEFAULT ::bAction := { || If( ::oSub == nil,, ( ::oSub:oParent := ::oWnd, ::oWnd:SwitchTo( ::oSub ) ) ) }

   DEFINE CURSOR ::oDragCursor DRAG

   ::bDragBegin   := { |r,c,f,o| BtnDragBegin( r,c,f,o ) }
   ::bRClicked    := { |r,c,f| ::DesignMenu(r,c,f) }

   ::bMMoved      := { |r,c,f,lDrag| if( oDragWnd == nil, ;
                     If( ::nLeft + ::nWidth > ::oWnd:oWnd:nWidth, ::oWnd:Slide( ::oWnd:oWnd:nWidth - ::nLeft - ::nWidth ),;
                     If( ::nLeft < 0 , ::oWnd:Slide( -::nLeft + 8 ) , nil ) ), ;
                     If( lDrag == .t., oDragWnd:Move( ::nTop + r -oDragWnd:Cargo[1], ;
                        ::nLeft + c - oDragWnd:Cargo[2], ::nWidth, ::nHeight, .t. ), ;
                         (oDragWnd:End(),oDragWnd := nil ) ) ) }

   ::OnClick      := { || If( ::bAction == nil,,Eval( ::bAction, Self )) }

return Self

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

METHOD Paint() CLASS TMetroBtn

   local aInfo, nStyle, aRect, hOldFont, hBmpOld, nOldClr, nZeroZeroClr
   local cText

   aInfo       := ::DispBegin()
   FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   if ! Empty( ::hBitmap1 )
      if HasAlpha( ::hBitmap1 )
         ABPaint( ::hDC, ::nBmpLeft, ::nBmpTop, ::hBitmap1, 255 )
      elseif .f.
         DrawTransparent( ::hDC, ::hBitmap1, ::nBmpTop, ::nBmpLeft )
      elseif .t.

         hBmpOld        := SelectObject( ::hDC, ::hBitmap1 )
         nZeroZeroClr   := GetPixel( ::hDC, 0, 0 )
         SelectObject( ::hDC, hBmpOld )

//         nOldClr = SetBkColor( ::hDC, CLR_WHITE )
         TransBmp( ::hBitmap1, ::nBmpWidth, ::nBmpHeight, nZeroZeroClr, ::hDC, ;
                   ::nBmpLeft, ::nBmpTop, ::nBmpWidth, ::nBmpHeight )
//         SetBkColor( ::hDC, nOldClr )
      endif
   endif

   if ! Empty( ::cCaption )
      ::DrawPrompt(  ::cCaption, IfNil( ::oFont, ::oWnd:oBtnFont ),  ;
                     IfNil( ::nClrCaption, ::nClrText ), ::nCapAlign )
   endif

   if ! Empty( ::cText )
      ::DrawPrompt(  ::cText, IfNil( ::oTextFont, ::oFont, ::oWnd:oTextFont ), ;
                     ::nClrText, ::nTextAlign )
   endif

   ::DispEnd( aInfo )

return nil

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

METHOD DrawPrompt( cText, oFont, nColor, nAlign ) CLASS TMetroBtn

   local aRect, hOldFont

   if ValType( cText ) == 'B'
      cText       := Eval( cText, Self )
   endif
   cText    := AllTrim( cValToChar( cText ) )
   if CRLF $ cText
      return ::DrawMultiLine( cText, oFont, nColor, nAlign )
   else
      SetTextColor( ::hDC, nColor )
      SetBkMode( ::hDC, 1 )
      hOldFont    := SelectObject( ::hDC, oFont:hFont )
      aRect       := { ::nMargin, ::nMargin, ::nHeight - ::nMargin, ::nWidth - ::nMargin }
      DrawTextEx( ::hDC, cText, aRect, nOr( nAlign, DT_SINGLELINE )  )
      SelectObject( ::hDC, hOldFont )
   endif

return nil

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

METHOD DrawMultiLine( cText, oFont, nColor, nAlign ) CLASS TMetroBtn

   local aRect, hOldFont, nTextHeight

   SetTextColor( ::hDC, nColor )
   SetBkMode( ::hDC, 1 )
   hOldFont    := SelectObject( ::hDC, oFont:hFont )
   aRect       := { ::nMargin, ::nMargin, ::nHeight - ::nMargin, ::nWidth - ::nMargin }
   if lAnd( nAlign, nOr( DT_VCENTER, DT_BOTTOM ) )
      nTextHeight := DrawTextEx( ::hDC, cText, aRect, nOr( DT_CALCRECT, DT_WORDBREAK ) )
      if lAnd( nAlign, DT_BOTTOM )
         aRect[ 1 ]  := ::nHeight - ::nMargin - nTextHeight
      else
         aRect[ 1 ]  := ( ::nHeight - nTextHeight ) / 2
      endif
   endif

   DrawTextEx( ::hDC, cText, aRect, nAlign )
   SelectObject( ::hDC, hOldFont )

return nil

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

METHOD LoadBitmaps( uBmp ) CLASS TMetroBtn

   local hBmp  := 0
   local hBmp1, nBmpWidth, nBmpHeight

   if ValType( uBmp ) == 'N' .and. uBmp != 0
      if IsGdiObject( uBmp )
         hBmp                     := uBmp
      else
         hBmp := LoadBitmap( GetInstance(), uBmp )
      endif
   elseif ValType( uBmp ) == 'C'
      if '.' $ uBmp
         if File( uBmp )
            if Lower( Right( uBmp, 4 ) ) == '.bmp'
               hBmp := ReadBitmap( 0, uBmp )
            else
               hBmp  := FILoadImg( uBmp )
            endif
         endif
      else
         hBmp := LoadBitmap( GetInstance(), uBmp )
      endif
   endif

   if ! Empty( hBmp )
      ::cBmpSource   := uBmp
      nBmpWidth   := nBmpWidth(  hBmp )
      nBmpHeight  := nBmpHeight( hBmp )
      DEFAULT ::nBmpWidth := nBmpWidth, ::nBmpHeight := nBmpHeight
      if nBmpWidth != ::nBmpWidth .or. nBmpHeight != ::nBmpHeight
         hBmp     := ResizeImg( ( hBmp1 := hBmp ), ::nBmpWidth, ::nBmpHeight )
         DeleteObject( hBmp1 )
      endif
      ::CalcBmpAlign()
   endif

   ::hBitmap1  := hBmp

return Self

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

METHOD CalcBmpAlign( lRecalc ) CLASS TMetroBtn

   DEFAULT lRecalc := .f.

   if lRecalc
      ::nBmpTop := ::nBmpLeft := nil
   endif

   if ! Empty( ::nBmpWidth ) .and. ! Empty( ::nBmpHeight )
      if ::nBmpTop == nil
         if lAnd( ::nBmpAlign, DT_BOTTOM )
            ::nBmpTop  := ::nHeight - ::nMargin - ::nBmpHeight
         elseif lAnd( ::nBmpAlign, DT_VCENTER )
            ::nBmpTop  := ( ::nHeight - ::nBmpHeight ) / 2
         else
            ::nBmpTop  := ::nMargin
         endif
      endif
      if ::nBmpLeft == nil
         if lAnd( ::nBmpAlign, DT_RIGHT )
            ::nBmpLeft := ::nWidth - ::nMargin - ::nBmpWidth
         elseif lAnd( ::nBmpAlign, DT_CENTER )
            ::nBmpLeft := ( ::nWidth - ::nBmpWidth ) / 2
         else
            ::nBmpLeft := ::nMargin
         endif
      endif
   endif

return Self

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

METHOD DesignMenu( nRow, nCol, nFlags ) CLASS TmetroBtn

   local oPop, c

   if ! ::oWnd:lDesignMode
      return nil
   endif

   MENU oPop POPUP 2007
      MENUITEM "Large Size"   WHEN { |o| o:SetCheck( ::lLarge ), .t. }  ;
                              ACTION oMenuItem:SetCheck( ::ToggleSize() )
      SEPARATOR
      MENUITEM "Colors"
      MENU
         MENUITEM "Tile"      ACTION ::SelColor( .f. )
         MENUITEM "Caption"   ACTION ( ::nClrCaption := ChooseColor( ::nClrCaption ), ::Refresh() )
         MENUITEM "BodyText"  ACTION ( ::nClrText := ChooseColor( ::nClrText ), ::Refresh() )
      ENDMENU
      MENUITEM "Set Images"
      MENU
         MENUITEM "Tile"      ACTION ::SetBackGround()
         MENUITEM "Bitmap"    ACTION ::SetBitmap()
      ENDMENU
      MENUITEM "Edit Text"
      MENU
         MENUITEM "Caption"   ACTION ( c  := PadR( IfNil( ::cCaption, '' ), 15 ), ;
                              If( MsgGet( "Caption", "Enter 15 Chars for Caption", @c ), ;
                                 ( ::cCaption := AllTrim( c ), ::Refresh() ), nil ) )
         MENUITEM "BodyText"  ACTION ( c := PadR( IfNil( ::cText, '' ), 45 ), ;
                              If( MsgGet( "Body Text", "Enter 45 Chars for Body", @c ), ;
                                 ( ::cText := StrTran( AllTrim( c ), ';', CRLF ), ;
                                 ::Refresh() ), nil ) )
      ENDMENU
      MENUITEM "Align Elements"
      MENU
         MENUITEM "Caption"   ACTION ( ::nCapAlign  := ::AlignObject( nRow, nCol ), ::Refresh() )
         MENUITEM "BodyText"  ACTION ( ::nTextAlign := ::AlignObject( nRow, nCol ), ::Refresh() )
         MENUITEM "Bitmap"    ACTION ( ::nBmpAlign  := ::AlignObject( nRow, nCol ), ;
                                       ::CalcBmpAlign( .t. ), ::Refresh() ) ;
                              WHEN ! Empty( ::hBitmap1 )
      ENDMENU
      SEPARATOR
      MENUITEM "Add New Tile" ACTION ( ::oWnd:AddButton( ::lLarge, ::nGroup, "New" ), ::oWnd:Arrange( .t. ):Refresh() )
      MENUITEM "Insert New Tile" ACTION ::oWnd:MoveBtn( ::oWnd:AddButton( ::lLarge, ::nGroup, "New" ), Self )
      SEPARATOR
      MENUITEM "GenerateCode"
      MENU
         MENUITEM "Tile"      ACTION ::ProgramCode( .t. )
         MENUITEM "Metro"     ACTION ::oWnd:ProgramCode( .t. )
      ENDMENU
   ENDMENU

   oPop:Activate( nRow, nCol, Self )

return nil

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

METHOD AlignObject( nRow, nCol ) CLASS TMetroBtn

   local nAlign
   local n  := ::nWidth / 3

   nAlign   := If( nCol > n, If( nCol > ( n + n ), 2, 1 ), 0 )
   n        := ::nHeight / 3
   nAlign   += If( nRow > n, If( nRow > ( n + n ), 8, 4 ), 0 )

return nAlign

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

METHOD SetBackGround( cImage ) CLASS TMetroBtn

   local lSet  := .f.
   local oBrush

   DEFAULT cImage := cGetFile( "Image File (*.bmp,*.jpg,*.png)|*.bmp;*.jpg;*.png|", ;
                     "Select Background Image",,CurDir() )

   if ! Empty( cImage )

      DEFINE BRUSH oBrush FILE cImage RESIZE
      ::SetBrush( oBrush )
      ::oBrush:Resize( Self )
      ::Refresh()
      RELEASE BRUSH oBrush
      lSet     := .t.
   endif

return lSet

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

METHOD SetBitmap( cImage ) CLASS TMetroBtn

   local w, h, hBmp

   DEFAULT cImage := cGetFile( "Image File (*.bmp,*.jpg,*.png,*.ico)|*.bmp;*.jpg;*.png;*.ico|", ;
                     "Select Bitmap File",,CurDir() )

   if ! Empty( cImage )

      if ! Empty( ::hBitmap1 )
         DeleteObject( ::hBitmap1 )
      endif
      ::nBmpTop := ::nBmpLeft := nil
      ::nBmpWidth := ::nBmpHeight := 50
      ::LoadBitmaps( cImage )
/*
      w        := nBmpWidth( ::hBitmap1 )
      h        := nBmpHeight(::hBitmap1 )
      if w > ::nWidth / 3 .or. h > ::nHeight / 3
         hBmp  := ResizeBitmap( ::hBitmap1, ::nWidth / 3, ::nHeight / 3, 3 )
         DeleteObject( ::hBitmap1 )
         ::hBitmap1  := hBmp
         ::CalcBmpAlign( .t. )
      endif
*/
      ::Refresh()

   endif

return Self

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

METHOD ToggleSize() CLASS TMetroBtn

   ::lLarge       := ! ::lLarge
   ::nWidth       := ::oWnd:nBtnSize + If( ::lLarge, ::oWnd:nBtnSize + BTN_GAP, 0 )
   ::CalcBmpAlign( .t. )
   ::oWnd:Arrange( .t. ):Refresh()
   AEval( ::oWnd:aButtons, { |o| o:Refresh() } )

return ::lLarge

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

METHOD ProgramCode( lShow ) CLASS TMetroBtn

   local cPrg  := ''

   DEFAULT lShow := .f.

#define NL  ' ;' + CRLF

   cPrg     := '   DEFINE METROBUTTON oBtn OF oMetro'
   cPrg     += NL + '        COLOR   ' + cClrToCode( ::nClrText ) + ',' + cClrToCode( ::nClrPane )

   if ! Empty( ::cCaption )
      cPrg  += NL + '      CAPTION   "' + ::cCaption + '"'
      cPrg  += NL + '        ALIGN   "' + AlignStr( ::nCapAlign ) + '"'
   endif
   if ::nGroup > 1
      cPrg  += NL + '        GROUP   ' + LTrim( Str( ::nGroup ) )
   endif
   if ! Empty( ::hBitmap1 ) .and. ! Empty( ::cBmpSource )
      cPrg  += NL + '       BITMAP   "' + ::cBmpSource + '"'
      cPrg  += NL + '     BMPALIGN   "' + AlignStr( ::nBmpAlign ) + '"'
      cPrg  += NL + '         SIZE   ' + LTrim( Str( ::nBmpWidth ) ) + ', ' + ;
                                    LTrim( Str( ::nBmpHeight ) )
   endif
   if ! Empty( ::cText )
      cPrg  += NL + '     BODYTEXT   "' + StrTran( ::cText, CRLF, ';' ) + '"'
      cPrg  += NL + '    TEXTALIGN   "' + AlignStr( ::nTextAlign ) + '"'
   endif
   if ! Empty( ::oBrush:hBitmap ) .and. ! Empty( ::oBrush:cBmpFile )
      cPrg  += NL + '   BACKGROUND   "' + ::oBrush:cBmpFile + '"'
   endif
   if ::lLarge
      cPrg  += NL + '        LARGE   '
   endif

   if ! Empty( ::cSub )
      cPrg += NL +  '         MENU   ' + ::cSub
   elseif ! Empty( ::cAction )
      cPrg += NL +  '       ACTION   ' + ::cAction
   endif
   cPrg += CRLF
   if ::nClrCaption != ::nClrText
      cPrg  += '   oBtn:nClrCaption := ' + cClrToCode( ::nClrCaption ) + CRLF
   endif
   cPrg     += CRLF

   if lShow
      ViewCode( cPrg )
   endif

#undef NL

return cPrg

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

METHOD Destroy() CLASS TMetroBtn

   if ::oDragCursor != nil
      RELEASE CUSROR ::oDragCursor
   endif

return Super:Destroy()

//----------------------------------------------------------------------------//
// SUPPORT FUNCTIONS
//----------------------------------------------------------------------------//

static function StrToAlign( cAlign, nDefault )

   local x, y

   DEFAULT nDefault := 0
   cAlign      := Upper( cAlign )

   x  := If( 'LEF' $ cAlign, 0, If( 'CEN' $ cAlign, 1, If( 'RIG' $ cAlign, 2, nAnd( nDefault,  3 ) ) ) )
   y  := If( 'TOP' $ cAlign, 0, If( 'MID' $ cAlign, 4, If( 'BOT' $ cAlign, 8, nAnd( nDefault, 12 ) ) ) )

return nOr( x, y )

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

static function AlignStr( nAlign )

   local cAlign   := ''
   local n        := nAnd( nAlign, 12 )

   cAlign   := If( n == 8, 'BOTTOM', If( n == 4, 'MIDDLE', 'TOP' ) )
   n        := nAnd( nAlign, 3 )
   cAlign   += If( n == 2, 'RIGHT', If( n == 1, 'CENTER', 'LEFT' ) )

return cAlign

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

static function NextClr()

   static n    := 1

   local cClr  := "E0AE022770EA3C1FB54E98188546020EB15601B1D5ADA6491B30BB008DD49E313A00AB899B83715A0061863B0DADA84B"
   local nClr  := HexToNum( SubStr( cClr, n, 6 ) )

   n  += 6
   if n > Len( cClr )
      n  := 1
   endif

return nClr

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

static function BtnDragBegin( nRow, nCol, nFlags, oBtn )

   local oBmp, hBmp

   SetDropInfo( oBtn )

   if oDragWnd != nil
      oDragWnd:End()
      oDragWnd    := nil
   endif

   hBmp     := WndBitmap( oBtn:hWnd )
   DEFINE WINDOW oDragWnd COLOR oBtn:nClrText, oBtn:nClrPane ;
      STYLE nOr( WS_POPUP, WS_VISIBLE )
   oDragWnd:nOpacity := 180
   @ 0,0 BITMAP oBmp OF oDragWnd SIZE oBtn:nWidth, oBtn:nHeight PIXEL
   oBmp:hBitmap   := hBmp
   oBmp:bDropOver  := { |u,r,c,f| BtnDragEnd( u,r,c,f ) }
   oDragWnd:Cargo := { nRow, nCol }
   ACTIVATE WINDOW oDragWnd  ;
      ON INIT ( oDragWnd:Move( oBtn:nTop,oBtn:nLeft,oBtn:nWidth,oBtn:nHeight,.t. ) )

return nil

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

static function BtnDragEnd( oDragged, nRow, nCol, nFlags )

   local oMetro   := oDragged:oWnd
   local hDropBtn, oDroppedOn
   local r, c, o

   if oDragWnd != nil
      oDragWnd:End()
      oDragWnd := nil
   endif

   r  := oDragged:nTop  + nRow
   c  := oDragged:nLeft + nCol

   if r > 0x8000
      r  -= 0xffff
   endif
   if c > 0x8000
      c  -= 0xffff
   endif

   for each o in oMetro:aButtons
      if r >= o:nTop .and. r <= o:nTop + o:nHeight
         if c >= o:nLeft .and. c <= o:nLeft + o:nWidth
            oDroppedOn := o
            exit
         endif
      endif
   next

   if oDroppedOn != nil .and. oDroppedOn:IsKindOf( 'TMETROBTN' )
      oMetro:MoveBtn( oDragged, oDroppedOn )
   endif

return nil

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

static function ViewCode( cCode )

   local oGet
   local oDlg
   local oFont

#define DLGWD  350 //250
#define DLGHT  250

   DEFINE FONT oFont NAME 'LUCIDA CONSOLE' SIZE 0,-12
   DEFINE DIALOG oDlg SIZE DLGWD*2, DLGHT*2 PIXEL ;
      TITLE "Program Code Generated" ;
      FONT oFont

   @ 10,10 GET oGet VAR cCode TEXT ;
      SIZE DLGWD-10,DLGHT-45 PIXEL ;
      OF oDlg FONT oFont

   @ DLGHT-20,05 BUTTONBMP BITMAP '..\bitmaps\copy3.bmp' SIZE 16,16 PIXEL OF oDlg ;
      ACTION CopyToClip( cCode )

   @ DLGHT-20,DLGWD-21 BUTTONBMP BITMAP '..\bitmaps\close.bmp' ;
      SIZE 16,16 PIXEL OF oDlg ;
      ACTION oDlg:End()

   ACTIVATE DIALOG oDlg CENTERED

   RELEASE FONT oFont

return nil

//----------------------------------------------------------------------------//
static function CopyToClip( cText )

   local oClip

   oClip := TClipBoard():New()
   if oClip:Open()
      oClip:SetText( cText )
      oClip:Close()
   endif
   oClip:End()

return nil

[Antonio Linares]

I can't understand why oBtn is nil after the first command:

Code: Select all  Expand view  RUN

     DEFINE METROBUTTON oBtn OF oMetro1 ;
         PROMPT FieldGet( 1 ) COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;  // 1 primer campo
         IMAGE "..\bitmaps\metro\files.bmp" ;
         ACTION ShowRecords( ::Cargo )
      oBtn:Cargo := RecNo()

Someone else see where the fail comes from ? We may be missing something...

[Joaoalpande]

Antonio Linares,

acho que os usuarios nao entram no forum portugues só entram no spanish ou english.

com esse teste dá error:

Error description: Error BASE/1003 Variable does not exist: SELF

[Antonio Linares]

Debes estar usando nuevamente un metro.ch equivocado

Genera el fichero PPO y copialo aqui, gracias

[Joaoalpande]

Antonio, neste teste uso o metropnl.ch do \fwh\include e não o metro.ch compilado

Code: Select all  Expand view  RUN

oMetro1 := TMetroPanel():New( oWnd, "Catálogo de Vinhos",,, {|| msgalert(ownd:oCtlFocus())},,, )

oMetro1:lDesignMode := .T.
lMetro[1] := .T.
DBSELECTAREA(1)
DBGOTOP()

while !eof()



      oBtn := oMetro1:AddButton( .F.,, FieldGet( 1 ), {|| ShowRecords( ::Cargo )}, 16777215, ( 2 + ( 174 * 256 ) + ( 224 * 65536 ) ), "..\bitmaps\metro\files.bmp",,,,,,,,,,, "ShowRecords( ::Cargo )", )
      oBtn:Cargo := RecNo()
      DbSkip()
end

 

[Antonio Linares]

Aqui falta Self:

{| Self | ShowRecords( ::Cargo )}

Falta la modificación al CH que te indiqué

[Joaoalpande]

Antonio ,

A alteração que indicou foi no metro.ch mas nao funciona , teste alterar o metropnl.ch e funciona bem :

Code: Select all  Expand view  RUN

[ <oBtn> := ] <oMetro>:AddButton( <.large.>, <nGroup>, <cPrompt>, [{| Self |<uAction>}], <nClrText>, <nClrPane>,  ;
                     <cImgName>, <oFont>, <nAlign>, <nBmpAlign>, <nBmpWidth>, <nBmpHeight>, ;
                     <cText>, <nTextAlign>, <oTextFont>, <oSub>, <cImage>, <"uAction">, <"oSub"> )

funciona bem com metropnl.ch e nao com metro.ch.


Gracias Maestro

[Antonio Linares]

Ya no te da el error de Cargo ?

[Joaoalpande]

no da error nenhum , quando click button return o recno()

Gracias

[Antonio Linares]

No entiendo bien lo que dices

Sigue dando error ?

[Joaoalpande]

Antonio,

No, everything is fine, has no error , return the recno () right.

when I click the right mouse button opens a menu, how to remove this menu?

Thank´s

[Joaoalpande]

Bom dia,

Tem como fazer uma pesquisa , exemplo pesquisar o metrobutton que tem nClrCaption :="Nome Teste" e dar o focus nesse metrobutton , o metropanel deslizar para esse metrobutton?

Cumprimentos

João Alpande

[Antonio Linares]

Joao,

Antonio,

No, everything is fine, has no error , return the recno () right.

when I click the right mouse button opens a menu, how to remove this menu?

Thank´s

Could you post a screenshot ? thanks

[Antonio Linares]

Joao,

Bom dia,

Tem como fazer uma pesquisa , exemplo pesquisar o metrobutton que tem nClrCaption :="Nome Teste" e dar o focus nesse metrobutton , o metropanel deslizar para esse metrobutton?

Cumprimentos

João Alpande

Please post a screenshot or an example to test here. I don't understand what you mean, thanks