FiveTech Software tech support forums

www.FiveTechSoft.com
https://fivetechsupport.com/forums/

Windows 8 estilo Metro - Una Clase TMetro

https://fivetechsupport.com/forums/viewtopic.php?f=6&t=22428

Page 1 of 3

Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Tue Sep 20, 2011 9:41 pm
by Antonio Linares
Esto es sólo un prototipo muy básico para hacernos una idea de como podríamos usar el estilo Metro en nuestras aplicaciones en FWH :-)

Código fuente completo incluido:

Image

metro.prg
Code: Select all  Expand view

#include "FiveWin.ch"

#xcommand DEFINE METRO <oMtr> ;
             [ BACKGROUND <cFileName> ] ;
             [ BTNSIZE <nBtnWidth>, <nBtnHeight> ] ;
             [ TITLE <cTitle> ] ;
          => ;
          <oMtr> := TMetro():New( <cTitle>, <nBtnWidth>, <nBtnHeight>, <cFileName> )
         
#xcommand DEFINE METROBUTTON [<oBtn>] ;
             [ PROMPT <cPrompt> ] ;
             [ COLOR <nClrText>, <nClrPane> ] ;
             [ OF <oMetro> ] ;
             [ <large: LARGE> ] ;
          => ;
             [ <oBtn> := ] <oMetro>:AddButton( <cPrompt>, <nClrText>, <nClrPane>, <.large.> )              
         
#xcommand ACTIVATE METRO <oMtr> => <oMtr>:Activate()          

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

function Main()

   local oMetro

   DEFINE METRO oMetro ;
      TITLE "My FWH Metro app"
     
   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 )    

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Customers" COLOR CLR_WHITE, RGB( 234, 112, 39 )    

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Stock" COLOR CLR_WHITE, RGB( 181, 31, 60 ) LARGE

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Utilities" COLOR CLR_WHITE, RGB( 24, 152, 78 )

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Reports" COLOR CLR_WHITE, RGB( 2, 174, 224 )    

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Graphics" COLOR CLR_WHITE, RGB( 234, 112, 39 ) LARGE  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Internet" COLOR CLR_WHITE, RGB( 2, 70, 133 ) LARGE  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Calculator" COLOR CLR_WHITE, RGB( 86, 177, 14 )  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Contact" COLOR CLR_WHITE, RGB( 213, 177, 1 )  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Exit" COLOR CLR_WHITE, RGB( 2, 174, 224 )    

   ACTIVATE METRO oMetro

return nil  

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

CLASS TMetro

   DATA  oWnd, oFont
   DATA  cFileName
   DATA  aButtons
   DATA  nOriginX, nOriginY
   DATA  nBtnWidth, nBtnHeight
   DATA  cTitle
   DATA  nRow, nCol
   
   METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName )
   
   METHOD Activate()
   
   METHOD AddButton( cCaption, nClrText, nClrPane, lLarge )
   
ENDCLASS

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

METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName ) CLASS TMetro

   DEFAULT cTitle := "MyApp", nBtnWidth := 132, nBtnHeight := 132
   
   ::cTitle     = cTitle
   ::aButtons   = {}
   ::nBtnWidth  = nBtnWidth
   ::nBtnHeight = nBtnHeight
   ::nOriginX   = 200
   ::nOriginY   = 200
   ::nRow       =   0
   ::nCol       =   0  
 
   DEFINE FONT ::oFont NAME "Segoe UI Light" SIZE 0, -52

   DEFINE WINDOW ::oWnd STYLE nOr( WS_POPUP, WS_VISIBLE ) ;
      COLOR CLR_WHITE, RGB( 15, 109, 57 )
   
return Self  

//----------------------------------------------------------------------------//
   
METHOD Activate() CLASS TMetro

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ::oWnd:Say( 3, 16, ::cTitle,,, ::oFont ) ;
      ON CLICK ::oWnd:End()

return nil  

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

METHOD AddButton( cCaption, nClrText, nClrPane, lLarge ) CLASS TMetro

   local oBtn
   local nX := ::nOriginX + ( ::nRow * ( ::nBtnHeight + 8 ) )
   local nY := ::nOriginY + ( ::nCol * ( ::nBtnWidth + 8 ) )
   
   DEFAULT lLarge := .F.
   
   @ nX, nY BTNBMP oBtn ;
      SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
      PIXEL OF ::oWnd PROMPT cCaption NOBORDER
     
   oBtn:SetColor( nClrText, nClrPane )    
   
   AAdd( ::aButtons, oBtn )
   
   ::nCol++
   if lLarge
      ::nCol++
   endif  
   if ( ATail( ::aButtons ):nLeft + ATail( ::aButtons ):nWidth ) > ( ::nOriginY * 4 ) + 50
      ::nRow++
      ::nCol = 0
   endif  
   
return nil    

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

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Tue Sep 20, 2011 10:16 pm
by Antonio Linares
Usando algunos bitmaps...

Image

metro.prg
Code: Select all  Expand view
#include "FiveWin.ch"

#xcommand DEFINE METRO <oMtr> ;
             [ BACKGROUND <cFileName> ] ;
             [ BTNSIZE <nBtnWidth>, <nBtnHeight> ] ;
             [ TITLE <cTitle> ] ;
          => ;
          <oMtr> := TMetro():New( <cTitle>, <nBtnWidth>, <nBtnHeight>, <cFileName> )
         
#xcommand DEFINE METROBUTTON [<oBtn>] ;
             [ PROMPT <cPrompt> ] ;
             [ COLOR <nClrText>, <nClrPane> ] ;
             [ IMAGE <cImgName> ] ;
             [ OF <oMetro> ] ;
             [ <large: LARGE> ] ;
          => ;
             [ <oBtn> := ] <oMetro>:AddButton( <cPrompt>, <nClrText>, <nClrPane>, <.large.>, <cImgName> )              
         
#xcommand ACTIVATE METRO <oMtr> => <oMtr>:Activate()          

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

function Main()

   local oMetro

   DEFINE METRO oMetro ;
      TITLE "My FWH Metro app"
     
   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;
      IMAGE "..\bitmaps\AlphaBmp\files.bmp"  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Customers" COLOR CLR_WHITE, RGB( 234, 112, 39 ) ;    
      IMAGE "..\bitmaps\32x32\users.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Stock" COLOR CLR_WHITE, RGB( 181, 31, 60 ) LARGE ;
      IMAGE "..\bitmaps\32x32\task.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Utilities" COLOR CLR_WHITE, RGB( 24, 152, 78 ) ;
      IMAGE "..\bitmaps\32x32\setup.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Reports" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\print.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Graphics" COLOR CLR_WHITE, RGB( 234, 112, 39 ) LARGE ;  
      IMAGE "..\bitmaps\32x32\graphics.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Internet" COLOR CLR_WHITE, RGB( 2, 70, 133 ) LARGE ;
      IMAGE "..\bitmaps\32x32\internet.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Calculator" COLOR CLR_WHITE, RGB( 86, 177, 14 ) ;
      IMAGE "..\bitmaps\32x32\calc.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Contact" COLOR CLR_WHITE, RGB( 213, 177, 1 ) ;  
      IMAGE "..\bitmaps\32x32\info.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Exit" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\quit.bmp"

   ACTIVATE METRO oMetro

return nil  

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

CLASS TMetro

   DATA  oWnd, oFont
   DATA  cFileName
   DATA  aButtons
   DATA  nOriginX, nOriginY
   DATA  nBtnWidth, nBtnHeight
   DATA  cTitle
   DATA  nRow, nCol
   
   METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName )
   
   METHOD Activate()
   
   METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName )
   
ENDCLASS

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

METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName ) CLASS TMetro

   DEFAULT cTitle := "MyApp", nBtnWidth := 132, nBtnHeight := 132
   
   ::cTitle     = cTitle
   ::aButtons   = {}
   ::nBtnWidth  = nBtnWidth
   ::nBtnHeight = nBtnHeight
   ::nOriginX   = 200
   ::nOriginY   = 200
   ::nRow       =   0
   ::nCol       =   0  
 
   DEFINE FONT ::oFont NAME "Segoe UI Light" SIZE 0, -52

   DEFINE WINDOW ::oWnd STYLE nOr( WS_POPUP, WS_VISIBLE ) ;
      COLOR CLR_WHITE, RGB( 15, 109, 57 )
   
return Self  

//----------------------------------------------------------------------------//
   
METHOD Activate() CLASS TMetro

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ::oWnd:Say( 3, 16, ::cTitle,,, ::oFont ) ;
      ON CLICK ::oWnd:End()

return nil  

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

METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName ) CLASS TMetro

   local oBtn
   local nX := ::nOriginX + ( ::nRow * ( ::nBtnHeight + 8 ) )
   local nY := ::nOriginY + ( ::nCol * ( ::nBtnWidth + 8 ) )
   
   DEFAULT lLarge := .F.
   
   @ nX, nY BTNBMP oBtn ;
      SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
      PIXEL OF ::oWnd PROMPT cCaption NOBORDER FILENAME cImgName
     
   oBtn:SetColor( nClrText, nClrPane )    
   
   AAdd( ::aButtons, oBtn )
   
   ::nCol++
   if lLarge
      ::nCol++
   endif  
   if ( ATail( ::aButtons ):nLeft + ATail( ::aButtons ):nWidth ) > ( ::nOriginY * 4 ) + 50
      ::nRow++
      ::nCol = 0
   endif  
   
return nil    

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

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Tue Sep 20, 2011 10:18 pm
by Bayron
Nice...

Ahora aunque Windows 8 no ha salido, nosotros ya tenemos una clase para apantallar...

Me encantaria tener una clase tMetro bien pulidita con algunos efectos especiales para usar en monitores touch en un futuro no muy lejano...

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Tue Sep 20, 2011 10:34 pm
by compubrion
Esta cool !!!!

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Tue Sep 20, 2011 10:45 pm
by Ruben Fernandez
Excelente Maestro.

Saludos
Ruben Fernandez

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 2:39 am
by norberto
Antonio,very good, you plans make horizontal move too? thanks

i read about metro ui only in html 5 + js.

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 2:53 am
by norberto
Antonio, error at : Ambiguous reference: 'PIXEL'

@ nX, nY BTNBMP oBtn ;
SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
PIXEL OF ::oWnd PROMPT cCaption NOBORDER

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 3:17 am
by AIDA
Mi superman :mrgreen: Image


SE VE SUPER :D


saluditos :wink:

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 7:55 am
by Antonio Linares
Implementando acciones desde el menú principal y una idea de como integrar las ventanas tradicionales en él :-)

Image

metro.prg
Code: Select all  Expand view
#include "FiveWin.ch"

#xcommand DEFINE METRO <oMtr> ;
             [ BACKGROUND <cFileName> ] ;
             [ BTNSIZE <nBtnWidth>, <nBtnHeight> ] ;
             [ TITLE <cTitle> ] ;
          => ;
          <oMtr> := TMetro():New( <cTitle>, <nBtnWidth>, <nBtnHeight>, <cFileName> )
         
#xcommand DEFINE METROBUTTON [<oBtn>] ;
             [ PROMPT <cPrompt> ] ;
             [ COLOR <nClrText>, <nClrPane> ] ;
             [ IMAGE <cImgName> ] ;
             [ OF <oMetro> ] ;
             [ <large: LARGE> ] ;
             [ ACTION <uAction,...> ] ;
          => ;
             [ <oBtn> := ] <oMetro>:AddButton( <cPrompt>, <nClrText>, <nClrPane>, <.large.>, <cImgName>, [{||<uAction>}] )              
         
#xcommand ACTIVATE METRO <oMtr> => <oMtr>:Activate()          

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

function Main()

   local oMetro

   DEFINE METRO oMetro ;
      TITLE "My FWH Metro app"
     
   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;
      IMAGE "..\bitmaps\AlphaBmp\files.bmp" ;
      ACTION Files()  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Customers" COLOR CLR_WHITE, RGB( 234, 112, 39 ) ;    
      IMAGE "..\bitmaps\32x32\users.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Stock" COLOR CLR_WHITE, RGB( 181, 31, 60 ) LARGE ;
      IMAGE "..\bitmaps\32x32\task.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Utilities" COLOR CLR_WHITE, RGB( 24, 152, 78 ) ;
      IMAGE "..\bitmaps\32x32\setup.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Reports" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\print.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Graphics" COLOR CLR_WHITE, RGB( 234, 112, 39 ) LARGE ;  
      IMAGE "..\bitmaps\32x32\graphics.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Internet" COLOR CLR_WHITE, RGB( 2, 70, 133 ) LARGE ;
      IMAGE "..\bitmaps\32x32\internet.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Calculator" COLOR CLR_WHITE, RGB( 86, 177, 14 ) ;
      IMAGE "..\bitmaps\32x32\calc.bmp" ;
      ACTION WinExec( "calc" )

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Contact" COLOR CLR_WHITE, RGB( 213, 177, 1 ) ;  
      IMAGE "..\bitmaps\32x32\info.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Exit" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\quit.bmp" ;
      ACTION If( MsgYesNo( "Want to exit ?" ), oMetro:End(),)

   ACTIVATE METRO oMetro

return nil  

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

function Files()

   local oWnd, oBar
   
   DEFINE WINDOW oWnd TITLE "Files"
   
   DEFINE BUTTONBAR oBar OF oWnd 2007 SIZE 80, 80
   
   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\new.bmp" PROMPT "New"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\edit.bmp" PROMPT "Edit"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\quit.bmp" PROMPT "Exit" ;
      ACTION oWnd:End()
   
   DEFINE MESSAGE OF oWnd 2007 PROMPT "Files management"
   
   ACTIVATE WINDOW oWnd
   
return nil  

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

CLASS TMetro

   DATA  oWnd, oFont
   DATA  cFileName
   DATA  aButtons
   DATA  nOriginX, nOriginY
   DATA  nBtnWidth, nBtnHeight
   DATA  cTitle
   DATA  nRow, nCol
   
   METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName )
   
   METHOD Activate()
   
   METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction )
   
   METHOD End() INLINE ::oWnd:End()
   
ENDCLASS

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

METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName ) CLASS TMetro

   DEFAULT cTitle := "MyApp", nBtnWidth := 132, nBtnHeight := 132
   
   ::cTitle     = cTitle
   ::aButtons   = {}
   ::nBtnWidth  = nBtnWidth
   ::nBtnHeight = nBtnHeight
   ::nOriginX   = 200
   ::nOriginY   = 200
   ::nRow       =   0
   ::nCol       =   0  
 
   DEFINE FONT ::oFont NAME "Segoe UI Light" SIZE 0, -52

   DEFINE WINDOW ::oWnd STYLE nOr( WS_POPUP, WS_VISIBLE ) ;
      COLOR CLR_WHITE, RGB( 15, 109, 57 )
   
return Self  

//----------------------------------------------------------------------------//
   
METHOD Activate() CLASS TMetro

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ::oWnd:Say( 3, 16, ::cTitle,,, ::oFont ) ;
      ON CLICK ::oWnd:End()

return nil  

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

METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction ) CLASS TMetro

   local oBtn
   local nX := ::nOriginX + ( ::nRow * ( ::nBtnHeight + 8 ) )
   local nY := ::nOriginY + ( ::nCol * ( ::nBtnWidth + 8 ) )
   
   DEFAULT lLarge := .F.
   
   @ nX, nY BTNBMP oBtn ;
      SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
      PIXEL OF ::oWnd PROMPT cCaption NOBORDER FILENAME cImgName
     
   oBtn:bAction = bAction  
     
   oBtn:SetColor( nClrText, nClrPane )    
   
   AAdd( ::aButtons, oBtn )
   
   ::nCol++
   if lLarge
      ::nCol++
   endif  
   if ( ATail( ::aButtons ):nLeft + ATail( ::aButtons ):nWidth ) > ( ::nOriginY * 4 ) + 50
      ::nRow++
      ::nCol = 0
   endif  
   
return nil    

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

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 8:32 am
by lucasdebeltran
Antonio,

Enhorabuena. Es muy importante tener el look Windows 8 listo para poder sacar nuestras aplicaciones a la vez que el nuevo S.O., pues con la crisis hay que hacer milagros.

Es extraordinario que Fivetech ya esté trabajando en ello ;).

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 8:39 am
by Antonio Linares
Fecha, hora, más aparencia Metro :-)

Image

metro.prg
Code: Select all  Expand view
#include "FiveWin.ch"

#xcommand DEFINE METRO <oMtr> ;
             [ BACKGROUND <cFileName> ] ;
             [ BTNSIZE <nBtnWidth>, <nBtnHeight> ] ;
             [ TITLE <cTitle> ] ;
          => ;
          <oMtr> := TMetro():New( <cTitle>, <nBtnWidth>, <nBtnHeight>, <cFileName> )
         
#xcommand DEFINE METROBUTTON [<oBtn>] ;
             [ PROMPT <cPrompt> ] ;
             [ COLOR <nClrText>, <nClrPane> ] ;
             [ IMAGE <cImgName> ] ;
             [ OF <oMetro> ] ;
             [ <large: LARGE> ] ;
             [ ACTION <uAction,...> ] ;
          => ;
             [ <oBtn> := ] <oMetro>:AddButton( <cPrompt>, <nClrText>, <nClrPane>, <.large.>, <cImgName>, [{||<uAction>}] )              
         
#xcommand ACTIVATE METRO <oMtr> => <oMtr>:Activate()          

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

function Main()

   local oMetro

   DEFINE METRO oMetro ;
      TITLE "My FWH Metro app"
     
   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;
      IMAGE "..\bitmaps\AlphaBmp\files.bmp" ;
      ACTION Files()  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Customers" COLOR CLR_WHITE, RGB( 234, 112, 39 ) ;    
      IMAGE "..\bitmaps\32x32\users.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Stock" COLOR CLR_WHITE, RGB( 181, 31, 60 ) LARGE ;
      IMAGE "..\bitmaps\32x32\task.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Utilities" COLOR CLR_WHITE, RGB( 24, 152, 78 ) ;
      IMAGE "..\bitmaps\32x32\setup.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Reports" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\print.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Graphics" COLOR CLR_WHITE, RGB( 234, 112, 39 ) LARGE ;  
      IMAGE "..\bitmaps\32x32\graphics.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Internet" COLOR CLR_WHITE, RGB( 2, 70, 133 ) LARGE ;
      IMAGE "..\bitmaps\32x32\internet.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Calculator" COLOR CLR_WHITE, RGB( 86, 177, 14 ) ;
      IMAGE "..\bitmaps\32x32\calc.bmp" ;
      ACTION WinExec( "calc" )

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Contact" COLOR CLR_WHITE, RGB( 213, 177, 1 ) ;  
      IMAGE "..\bitmaps\32x32\info.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Exit" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\quit.bmp" ;
      ACTION If( MsgYesNo( "Want to exit ?" ), oMetro:End(),)

   ACTIVATE METRO oMetro

return nil  

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

function Files()

   local oWnd, oBar
   
   DEFINE WINDOW oWnd TITLE "Files"
   
   DEFINE BUTTONBAR oBar OF oWnd 2007 SIZE 80, 80
   
   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\new.bmp" PROMPT "New"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\edit.bmp" PROMPT "Edit"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\quit.bmp" PROMPT "Exit" ;
      ACTION oWnd:End()
   
   DEFINE MESSAGE OF oWnd 2007 PROMPT "Files management"
   
   ACTIVATE WINDOW oWnd
   
return nil  

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

CLASS TMetro

   DATA  oWnd, oFont, oFontB
   DATA  cFileName
   DATA  aButtons
   DATA  nOriginX, nOriginY
   DATA  nBtnWidth, nBtnHeight
   DATA  cTitle
   DATA  nRow, nCol
   DATA  oTimer
   
   METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName )
   
   METHOD Activate()
   
   METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction )
   
   METHOD End() INLINE ::oWnd:End()
   
ENDCLASS

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

METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName ) CLASS TMetro

   DEFAULT cTitle := "MyApp", nBtnWidth := 132, nBtnHeight := 132
   
   ::cTitle     = cTitle
   ::aButtons   = {}
   ::nBtnWidth  = nBtnWidth
   ::nBtnHeight = nBtnHeight
   ::nOriginX   = 200
   ::nOriginY   = 200
   ::nRow       =   0
   ::nCol       =   0  
 
   DEFINE FONT ::oFont NAME "Segoe UI Light" SIZE 0, -52

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

   DEFINE WINDOW ::oWnd STYLE nOr( WS_POPUP, WS_VISIBLE ) ;
      COLOR CLR_WHITE, RGB( 15, 109, 57 )
   
   DEFINE TIMER ::oTimer OF ::oWnd ACTION ::oWnd:Say( 13, 135, Time(),,, ::oFontB )
   
   ACTIVATE TIMER ::oTimer
   
return Self  

//----------------------------------------------------------------------------//
   
METHOD Activate() CLASS TMetro

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ( ::oWnd:Say( 3, 16, ::cTitle,,, ::oFont ),;
                 ::oWnd:Say( 2, 130, CDoW( Date() ),,, ::oFont ),;
                 ::oWnd:Say( 7, 130, CMonth( Date() ) + " " + ;
                             AllTrim( Str( Day( Date() ) ) ),,, ::oFont ) ) ;
      ON CLICK ::oWnd:End()

return nil  

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

METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction ) CLASS TMetro

   local oBtn
   local nX := ::nOriginX + ( ::nRow * ( ::nBtnHeight + 8 ) )
   local nY := ::nOriginY + ( ::nCol * ( ::nBtnWidth + 8 ) )
   
   DEFAULT lLarge := .F.
   
   @ nX, nY BTNBMP oBtn ;
      SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
      PIXEL OF ::oWnd PROMPT cCaption NOBORDER FILENAME cImgName
     
   oBtn:bAction = bAction  
     
   oBtn:SetColor( nClrText, nClrPane )    
   
   AAdd( ::aButtons, oBtn )
   
   ::nCol++
   if lLarge
      ::nCol++
   endif  
   if ( ATail( ::aButtons ):nLeft + ATail( ::aButtons ):nWidth ) > ( ::nOriginY * 4 ) + 50
      ::nRow++
      ::nCol = 0
   endif  
   
return nil    

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

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 9:18 am
by Antonio Linares
No dejeis de ver los bitmaps tan estupendos que ya ha implementado Otto:

viewtopic.php?p=119497#p119497

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 9:18 am
by Antonio Linares
Usando un bitmap para el fondo... :-)

Image

metro.prg
Code: Select all  Expand view
#include "FiveWin.ch"

#xcommand DEFINE METRO <oMtr> ;
             [ BACKGROUND <cFileName> ] ;
             [ BTNSIZE <nBtnWidth>, <nBtnHeight> ] ;
             [ TITLE <cTitle> ] ;
          => ;
          <oMtr> := TMetro():New( <cTitle>, <nBtnWidth>, <nBtnHeight>, <cFileName> )
         
#xcommand DEFINE METROBUTTON [<oBtn>] ;
             [ PROMPT <cPrompt> ] ;
             [ COLOR <nClrText>, <nClrPane> ] ;
             [ IMAGE <cImgName> ] ;
             [ OF <oMetro> ] ;
             [ <large: LARGE> ] ;
             [ ACTION <uAction,...> ] ;
          => ;
             [ <oBtn> := ] <oMetro>:AddButton( <cPrompt>, <nClrText>, <nClrPane>, <.large.>, <cImgName>, [{||<uAction>}] )              
         
#xcommand ACTIVATE METRO <oMtr> => <oMtr>:Activate()          

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

function Main()

   local oMetro

   DEFINE METRO oMetro ;
      TITLE "My FWH Metro app" ;
      BACKGROUND "..\bitmaps\hires\earth.bmp"
     
   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Files" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;
      IMAGE "..\bitmaps\AlphaBmp\files.bmp" ;
      ACTION Files()  

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Customers" COLOR CLR_WHITE, RGB( 234, 112, 39 ) ;    
      IMAGE "..\bitmaps\32x32\users.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Stock" COLOR CLR_WHITE, RGB( 181, 31, 60 ) LARGE ;
      IMAGE "..\bitmaps\32x32\task.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Utilities" COLOR CLR_WHITE, RGB( 24, 152, 78 ) ;
      IMAGE "..\bitmaps\32x32\setup.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Reports" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\print.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Graphics" COLOR CLR_WHITE, RGB( 234, 112, 39 ) LARGE ;  
      IMAGE "..\bitmaps\32x32\graphics.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Internet" COLOR CLR_WHITE, RGB( 2, 70, 133 ) LARGE ;
      IMAGE "..\bitmaps\32x32\internet.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Calculator" COLOR CLR_WHITE, RGB( 86, 177, 14 ) ;
      IMAGE "..\bitmaps\32x32\calc.bmp" ;
      ACTION WinExec( "calc" )

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Contact" COLOR CLR_WHITE, RGB( 213, 177, 1 ) ;  
      IMAGE "..\bitmaps\32x32\info.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Exit" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;    
      IMAGE "..\bitmaps\32x32\quit.bmp" ;
      ACTION If( MsgYesNo( "Want to exit ?" ), oMetro:End(),)

   ACTIVATE METRO oMetro

return nil  

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

function Files()

   local oWnd, oBar
   
   DEFINE WINDOW oWnd TITLE "Files"
   
   DEFINE BUTTONBAR oBar OF oWnd 2007 SIZE 80, 80
   
   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\new.bmp" PROMPT "New"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\edit.bmp" PROMPT "Edit"

   DEFINE BUTTON OF oBar FILENAME "..\bitmaps\32x32\quit.bmp" PROMPT "Exit" ;
      ACTION oWnd:End()
   
   DEFINE MESSAGE OF oWnd 2007 PROMPT "Files management"
   
   ACTIVATE WINDOW oWnd
   
return nil  

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

CLASS TMetro

   DATA  oWnd, oFont, oFontB
   DATA  cFileName
   DATA  aButtons
   DATA  nOriginX, nOriginY
   DATA  nBtnWidth, nBtnHeight
   DATA  cTitle
   DATA  nRow, nCol
   DATA  oTimer
   DATA  hBitmap
   
   METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName )
   
   METHOD Activate()
   
   METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction )
   
   METHOD End() INLINE ::oWnd:End()
   
ENDCLASS

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

METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName ) CLASS TMetro

   DEFAULT cTitle := "MyApp", nBtnWidth := 132, nBtnHeight := 132
   
   ::cTitle     = cTitle
   ::aButtons   = {}
   ::nBtnWidth  = nBtnWidth
   ::nBtnHeight = nBtnHeight
   ::nOriginX   = 200
   ::nOriginY   = 200
   ::nRow       =   0
   ::nCol       =   0
   
   if File( cFileName )
      ::hBitmap = ReadBitmap( 0, cFileName )
   endif    
 
   DEFINE FONT ::oFont NAME "Segoe UI Light" SIZE 0, -52

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

   DEFINE WINDOW ::oWnd STYLE nOr( WS_POPUP, WS_VISIBLE ) ;
      COLOR CLR_WHITE, RGB( 15, 109, 57 )
   
   DEFINE TIMER ::oTimer OF ::oWnd ACTION ::oWnd:Say( 13, 135, Time(),, CLR_BLACK, ::oFontB )
   
   ACTIVATE TIMER ::oTimer
   
return Self  

//----------------------------------------------------------------------------//
   
METHOD Activate() CLASS TMetro

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ( DrawBitmap( hDC, ::hBitmap, 0, 0, GetSysMetrics( 0 ), GetSysMetrics( 1 ) ),;
                 ::oWnd:Say( 3, 16, ::cTitle,,, ::oFont,, .T. ),;
                 ::oWnd:Say( 2, 130, CDoW( Date() ),,, ::oFont,, .T. ),;
                 ::oWnd:Say( 7, 130, CMonth( Date() ) + " " + ;
                             AllTrim( Str( Day( Date() ) ) ),,, ::oFont,, .T. ) ) ;
      ON CLICK ::oWnd:End()

return nil  

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

METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction ) CLASS TMetro

   local oBtn
   local nX := ::nOriginX + ( ::nRow * ( ::nBtnHeight + 8 ) )
   local nY := ::nOriginY + ( ::nCol * ( ::nBtnWidth + 8 ) )
   
   DEFAULT lLarge := .F.
   
   @ nX, nY BTNBMP oBtn ;
      SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
      PIXEL OF ::oWnd PROMPT cCaption NOBORDER FILENAME cImgName
     
   oBtn:bAction = bAction  
     
   oBtn:SetColor( nClrText, nClrPane )    
   
   AAdd( ::aButtons, oBtn )
   
   ::nCol++
   if lLarge
      ::nCol++
   endif  
   if ( ATail( ::aButtons ):nLeft + ATail( ::aButtons ):nWidth ) > ( ::nOriginY * 4 ) + 50
      ::nRow++
      ::nCol = 0
   endif  
   
return nil    

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

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 9:37 am
by Antonio Linares
Usando unos bitmaps diseñador por Ruth, la hija de Otto. El resultado es realmente bonito :-)

Image

Re: Windows 8 estilo Metro - Una Clase TMetro

PostPosted: Wed Sep 21, 2011 9:45 am
by lucasdebeltran
Bonito no, Espectacular ;)
All times are UTC
Page 1 of 3
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/