Dudas probando METRO

[Armando]

Saludos al foro:

Estoy probando la clase METRO y tengo los siguientes detalles

Hay un botón para salir de la aplicación de manera controlada con el MsgNoYes( "Desea salir ?"),
pero si doy clic izquierdo fuera de cualquier botón, la aplicación se cierre sin más, cómo obligo
a que pase por el MsgNoYes() ?????

Y una más, no encuentro cómo o donde puedo mover la fecha y RELOJ que aparecen??

Saludos

[Antonio Linares]

Estimado Armando,

Puedes copir aqui el PRG para ver como lo estás usando ? gracias

[Armando]

Master:

Por supuesto, muchas gracias

Prácticamente es el mismo a METRO.PRG

Code: Select all  Expand view  RUN

#include "FiveWin.ch"
#include "metro.ch"
#include "Ado.ch"

MEMVAR oApp

STATIC oWindow

// Para que los acentos se vean bien
REQUEST HB_LANG_ES
REQUEST HB_CODEPAGE_ESWIN

FUNCTION Main()

   LOCAL oMetro

   SET CENTURY ON
   SET DATE TO FRENCH
   SET DELETED ON
   SET OPTIMIZE ON
   SETBALLOON(.T.)

   HB_CDPSELECT("ESWIN")
   HB_LangSelect( "ESWIN" )

   FWSetLanguage( 2 )      // Para poner el PREVIEW en Español

// Para que los acentos se vean bien
   SET( _SET_CODEPAGE, "ESWIN" )

   oApp := TAplicacion()

   LeeIni()

   IF ! Conecta()
      QUIT
   ENDIF

   oApp:oCon:Execute("USE " + AllTrim(oApp:cDBName))

   DEFINE METRO oMetro ;
      TITLE "AppRpt, Archivos para contabilidad" ;
      BACKGROUND "D:\FWH2307\bitmaps\hires\earth.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Ventas del mes" COLOR CLR_WHITE, RGB( 234, 112, 39 ) ;
      IMAGE "D:\FWH2307\bitmaps\metro\Stock.bmp" ;
      ACTION AppRpt1a(oWindow)

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Cuentas por cobrar" COLOR CLR_WHITE, RGB( 181, 31, 60 ) ;
      IMAGE "D:\FWH2307\bitmaps\metro\Users.bmp" ;
      ACTION AppRpt1b(oWindow)

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Ventas del mes" COLOR CLR_WHITE, RGB( 24, 152, 78 ) ;
      IMAGE "D:\FWH2307\bitmaps\metro\utilities.bmp";
      ACTION AppRpt1c(oWindow)

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Ventas del mes" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;
      IMAGE "D:\FWH2307\bitmaps\metro\print.bmp";
      ACTION AppRpt1d(oWindow)

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Pagos recibidos del mes" COLOR CLR_WHITE, RGB( 234, 112, 39 ) ;
      IMAGE "D:\FWH2307\bitmaps\metro\graphics.bmp"

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Cuentas por cobrar del mes" COLOR CLR_WHITE, RGB( 2, 70, 133 ) LARGE ;
      IMAGE "D:\FWH2307\bitmaps\metro\internet.bmp";
      ACTION AppRpt1f(oWindow)

   DEFINE METROBUTTON OF oMetro ;
      PROMPT "Exit" COLOR CLR_WHITE, RGB( 2, 174, 224 ) ;
      IMAGE "D:\FWH2307\bitmaps\metro\exit.bmp" ;
      ACTION IF( MsgYesNo( "Seguro desea salir ?" ,oApp:cAplicacion), oMetro:End(),)

   ACTIVATE METRO oMetro

RETURN(Nil)

/*
* ---------------------------------------------------------------------------- *
*/
CLASS TAplicacion
   DATA cRazonSocial    INIT "Empresa no registrada, s.a. de c.v."
   DATA cAplicacion     INIT "© " + STR( YEAR( DATE( ) ), 4, 0 ) + " Sistema para emisión de reportes"// + SPACE(2) + FWVERSION
   DATA cAppAlias       INIT "© " + STR( YEAR( DATE( ) ), 4, 0 ) + " AppRpt"
   DATA cCopyRight      INIT "© 2024-" + STR( YEAR( DATE( ) ), 4, 0 ) + " by S.O.I., s.a. de c.v."
   DATA cVersion        INIT "Versión 1.0M00"

   DATA cDescription    INIT Nil
   DATA cServer         INIT Nil
   DATA cUser           INIT Nil
   DATA cPass           INIT Nil
   DATA nPort           INIT Nil
   DATA cDriveName      INIT Nil
   DATA cDBName         INIT Nil
   DATA oCon            INIT NIL
ENDCLASS


/*
* ---------------------------------------------------------------------------- *
*/
STATIC FUNCTION LeeIni()
    LOCAL oIni

    INI oIni FILE ".\AppRpt.Ini"
      GET oApp:cDescription   SECTION "MYSQL"      ENTRY "Description"  OF oIni DEFAULT "© Sistema para Emisión de Reportes"
      GET oApp:cServer        SECTION "MYSQL"      ENTRY "Server"       OF oIni DEFAULT "localhost"
      GET oApp:cUser          SECTION "MYSQL"      ENTRY "User"         OF oIni DEFAULT "root"
      GET oApp:cPass          SECTION "MYSQL"      ENTRY "PassWord"     OF oIni DEFAULT "91502127"
      GET oApp:nPort          SECTION "MYSQL"      ENTRY "Port"         OF oIni DEFAULT 3306
      GET oApp:cDriveName     SECTION "MYSQL"      ENTRY "DriveName"    OF oIni DEFAULT "Driver={MySQL ODBC 5.1 Driver}"
      GET oApp:cDBName        SECTION "DATABASE"   ENTRY "DBName"       OF oIni DEFAULT "SiaWin"
   ENDINI
RETURN( NIL )


/*
* ---------------------------------------------------------------------------- *
*/
STATIC FUNCTION Conecta( )
   LOCAL oError

   TRY
    oApp:oCon := TOleAuto( ) :new( "adodb.connection" )
   CATCH oError
   MsgStop( "No se ha podido crear la conexión al servidor !", oApp:cAplicacion )
   RETURN( .F. )
   END

   oApp:oCon:ConnectionString := AllTrim( oApp:cDriveName ) + ;
      ";Server=" + AllTrim( oApp:cServer ) + ;
      ";Port=" + STR( oApp:nPort ) + ;
      ";Database=" + "" + ;
      ";User=" + AllTrim( oApp:cUser ) + ;
      ";Password=" + AllTrim( oApp:cPass ) + ;
      ";Option=3;"

   oApp:oCon:CommandTimeout      := 1800     // 30 Minutos * 60 segundos
   oApp:oCon:ConnectionTimeout   := 28800    //  8 horas * 360 segundos

   TRY
      oApp:oCon:Open()
      oApp:oCon:Execute( "SET SESSION wait_timeout = 86400;" )
   CATCH oError
      MsgInfo( "No se pudo lograr la conexión al servidor, REVISE LA CONEXION DE SU RED O LA CONEXION A INTERNET !" + CRLF +;
               oApp:oCon:ConnectionString, oApp:cAplicacion )
      FW_ShowAdoError(oApp:oCon)
      RETURN( .F. )
   END
RETURN( .T. )
 

Saludos

[sysctrl2]

cierto Armando, tengo usando tmetro desde hace mucho tiempo
y no me había percatado de ese BUG,
pensé que mi cliente estaba loco

[Antonio Linares]

Armando,

En la Clase TMetro hay que hacer esta modificación: Lo incluimos en el próximo build de FWH.

Code: Select all  Expand view  RUN

METHOD Activate() CLASS TMetro

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ( cPS,;
                 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 ( nRow, nCol, nKeyFlags, ::oWnd:End() )    

return nil  

[Antonio Linares]

Aqui está la Clase TMetro modificada para poder variar la posición del título, dia, mes y hora. Incluimos estos cambios en el próximo build de FWH.

Muchas gracias por el feedback

* Enhancement: Class TMetro was exiting when clicking on the window, now it is ok. New DATAs for the
title, day, month and hour, so they can be placed on different coordinates. Many thanks to Armando feedback!

Code: Select all  Expand view  RUN

#include "FiveWin.ch"

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

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
   DATA  nTimeRow  INIT  13
   DATA  nTimeCol  INIT 135
   DATA  nTitleRow INIT   3
   DATA  nTitleCol INIT  16
   DATA  nDayRow   INIT   2
   DATA  nDayCol   INIT 130
   DATA  nMonthRow INIT   7
   DATA  nMonthCol INIT 130
   
   METHOD New( cTitle, nBtnWidth, nBtnHeight, cFileName )
   
   METHOD Activate()
   
   METHOD AddButton( cCaption, nClrText, nClrPane, lLarge, cImgName, bAction )
   
   METHOD End() INLINE ::oWnd:End(), ::oFont:End(), ::oFontB:End(), DeleteObject( ::hBitmap )
   
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( ::nTimeRow, ::nTimeCol, Time(),, CLR_BLACK, ::oFontB )
   
   ACTIVATE TIMER ::oTimer
   
return Self  

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

   ACTIVATE WINDOW ::oWnd MAXIMIZED ;
      ON PAINT ( cPS,;
                 DrawBitmap( hDC, ::hBitmap, 0, 0, GetSysMetrics( 0 ), GetSysMetrics( 1 ) ),;
                 ::oWnd:Say( ::nTitleRow, ::nTitleCol, ::cTitle,,, ::oFont,, .T. ),;
                 ::oWnd:Say( ::nDayRow, ::nDayCol, CDoW( Date() ),,, ::oFont,, .T. ),;
                 ::oWnd:Say( ::nMonthRow, ::nMonthCol, CMonth( Date() ) + " " + ;
                             AllTrim( Str( Day( Date() ) ) ),,, ::oFont,, .T. ) )
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.
   
   if File( cImgName )
      @ nX, nY BTNBMP oBtn ;
         SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
         OF ::oWnd PROMPT cCaption NOBORDER FILENAME cImgName
   else  
      @ nX, nY BTNBMP oBtn ;
         SIZE ( ::nBtnWidth * If( lLarge, 2, 1 ) ) + If( lLarge, 8, 0 ), ::nBtnHeight ;
         OF ::oWnd PROMPT cCaption NOBORDER RESOURCE cImgName
   endif  
     
   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    

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

[Armando]

Maestro Antonio:

Muchas gracias, voy a probarla.

Saludos

[Armando]

Maestro Antonio:

Ahora todo esta excelente, solo un detalle más de estética en el reloj:

Cuando el último dígito de los segundos es cero, por ejemplo :50 al pasar
al siguiente segundo :51, se queda parte del cero, es decir el 1 es menos
ancho que el cero. ojalá me haya explicado.

Gracias Antonio

Saludos

[Antonio Linares]

Armando,

Esta parece una buena y simple solución. La incluimos para el próximo build de FWH.

Code: Select all  Expand view  RUN

  DEFINE TIMER ::oTimer OF ::oWnd ;
      ACTION ::oWnd:Say( ::nTimeRow, ::nTimeCol, " " + Time() + " ",, CLR_BLACK, ::oFontB,, .F. )

[Armando]

Maestro:

Excelente, simple pero funcional.

SAludos