FiveTech Support Forums

FiveWin / Harbour / xBase community
Board indexAll discussionsLogin (GitHub)
Board index FiveWin para Harbour/xHarbour Windows 8 estilo Metro - Una Clase TMetro
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Windows 8 estilo Metro - Una Clase TMetro
Posted: Tue Sep 20, 2011 09:41 PM
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:



metro.prg
Code (fw): Select all Collapse
#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    

//----------------------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Tue Sep 20, 2011 10:16 PM
Usando algunos bitmaps...



metro.prg
Code (fw): Select all Collapse
#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    

//----------------------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
Bayron
Posts: 883
Joined: Thu Dec 24, 2009 12:46 AM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Tue Sep 20, 2011 10:18 PM

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...

=====>

Bayron Landaverry
xBasePHP.com
(215)2226600 Philadelphia,PA, USA
MayaBuilders@gMail.com
Guatemala

FWH25.06--Harbour 3.0.0--BCC7.7--UEstudio 10.10
Windows 10

FiveWin, One line of code and it's done...

compubrion
Posts: 132
Joined: Thu Mar 08, 2007 06:12 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Tue Sep 20, 2011 10:34 PM

Esta cool !!!!

Harbour / Bcc / MinGW / Fwh 13.9
Ruben Fernandez
Posts: 366
Joined: Wed Aug 30, 2006 05:25 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Tue Sep 20, 2011 10:45 PM

Excelente Maestro.

Saludos
Ruben Fernandez

Gracias y Saludos

Ruben Fernandez - Uruguay

FWH 11.06, Harbour, Borland 5.82
norberto
Posts: 566
Joined: Thu Aug 30, 2007 03:40 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 02:39 AM

Antonio,very good, you plans make horizontal move too? thanks

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

norberto
Posts: 566
Joined: Thu Aug 30, 2007 03:40 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 02:53 AM

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

AIDA
Posts: 880
Joined: Fri Jan 12, 2007 08:35 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 03:17 AM
Mi superman :-)


SE VE SUPER :-)


saluditos :-)
Que es mejor que programar? creo que nada :)
Atropellada pero aqui ando :P

I love Fivewin

séʌǝɹ ןɐ ɐʇsǝ opunɯ ǝʇsǝ
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 07:55 AM
Implementando acciones desde el menú principal y una idea de como integrar las ventanas tradicionales en él :-)



metro.prg
Code (fw): Select all Collapse
#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    

//----------------------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
lucasdebeltran
Posts: 1303
Joined: Tue Jul 21, 2009 08:12 AM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 08:32 AM

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 ;).

Muchas gracias. Many thanks.



Un saludo, Best regards,



Harbour 3.2.0dev, Borland C++ 5.82 y FWH 13.06 [producción]



Implementando MSVC 2010, FWH64 y ADO.



Abandonando uso xHarbour y SQLRDD.
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 08:39 AM
Fecha, hora, más aparencia Metro :-)



metro.prg
Code (fw): Select all Collapse
#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    

//----------------------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 09:18 AM

No dejeis de ver los bitmaps tan estupendos que ya ha implementado Otto:

viewtopic.php?p=119497#p119497

regards, saludos

Antonio Linares
www.fivetechsoft.com
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 09:18 AM
Usando un bitmap para el fondo... :-)



metro.prg
Code (fw): Select all Collapse
#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    

//----------------------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 09:37 AM
Usando unos bitmaps diseñador por Ruth, la hija de Otto. El resultado es realmente bonito :-)

regards, saludos

Antonio Linares
www.fivetechsoft.com
lucasdebeltran
Posts: 1303
Joined: Tue Jul 21, 2009 08:12 AM
Re: Windows 8 estilo Metro - Una Clase TMetro
Posted: Wed Sep 21, 2011 09:45 AM

Bonito no, Espectacular ;)

Muchas gracias. Many thanks.



Un saludo, Best regards,



Harbour 3.2.0dev, Borland C++ 5.82 y FWH 13.06 [producción]



Implementando MSVC 2010, FWH64 y ADO.



Abandonando uso xHarbour y SQLRDD.
Static archive · New replies & topics via GitHub Discussions