Buenos días. Pruebe esta nueva versión. La probé con FWH1905 y presentó "problemas", así que la corregí para que "funcione" tanto con versiones "antiguas" como nuevas. Si es posible, actualice su versión; así podrá quejarse de los DEFECTOS.
// C:\FWH2603\SAMPLES\JPJORGE1.PRG - Version: 1.3 - By Kapiaba.
#include "FiveWin.ch"
#define CLR_DARK_TEXT nRGB( 220, 220, 220 )
#define CLR_DARK_BACK nRGB( 030, 030, 030 )
#define CLR_DARK_BACK2 nRGB( 050, 050, 050 )
#define CLR_DARK_SEL nRGB( 0x33, 0x33, 0x99 )
#define CLR_DARK_ORANGE nRGB( 139, 064, 000 )
#Define CLR_TANGERINE nRGB( 240, 128, 000 )
#define METRO_TURQUE nRGB( 000, 128, 128 )
#Define aPubGrad {| lInvert | If( lInvert, ;
{ { 1 / 3, nRGB( 255, 253, 222 ), nRGB( 255, 231, 151 ) }, ;
{ 2 / 3, nRGB( 255, 215, 84 ), nRGB( 255, 233, 162 ) } ;
}, ;
{ { 1 / 2, nRGB( 219, 230, 244 ), nRGB( 207 - 50, 221 - 25, 255 ) }, ;
{ 1 / 2, nRGB( 201 - 50, 217 - 25, 255 ), nRGB( 231, 242, 255 ) } ;
} ) }
EXTERNAL HB_LANG_PT, HB_CODEPAGE_PTISO, HB_CODEPAGE_PT850
#ifNdef __XHARBOUR__ // Somente para HARBOUR, XHARBOUR nao tem isso ainda.
REQUEST HB_CODEPAGE_UTF8
REQUEST HB_CODEPAGE_UTF8EX
#endif
EXTERNAL OrdKeyNo, OrdKeyCount, OrdCreate, OrdKeyGoto
EXTERNAL _DBF, DBFCDX, DBFFPT, DBFDBT
ANNOUNCE RDDSYS // ANNOUNCE FPTCDX
STATIC oWnd, oFont, nHFont, cFont, nWFont, oBar, JorFon, oFnt
STATIC nTamano // := 64 // SIZE aqui
STATIC nAlturA // := 70 // aqui
STATIC wnWidth, nSize // aqui STATIC o PUBLIC, ok?
MEMVAR nResHoriz // aqui
MEMVAR nResVert
FUNCTION Main()
LOCAL oIco, oBmp, oBar, XEMPRESA, xOFICINA
LOCAL cTitle
PRIVATE nResHoriz // aqui
PRIVATE nResVert
HB_GCALL( .F. )
// https://vivaclipper.wordpress.com/2014/01/16/hb_cdpselect/
HB_LANGSELECT( 'PT' ) // Default language is now Portuguese
HB_SETCODEPAGE( "PT850" ) // CAMBIAR A ESPANOL.
HB_CDPSELECT( "PTISO" ) // Para DBFCDX
RDDSETDEFAULT("DBFCDX")
RDDREGISTER( "DBFCDX", 1 ) // RDT_FULL -> 20/10/2022 Joao
SET CENTURY ON
SET DATE BRITISH
SET TIME FORMAT TO "HH:MM:SS"
SET EPOCH TO YEAR( DATE() ) - 30
SET SOFTSEEK OFF
SET WRAP ON
SETCANCEL( .F. )
SET CONFIRM OFF
SET DELETED ON
SET _3DLOOK ON
SET UNIQUE OFF
SET ESCAPE OFF
SET EXACT ON
SET EXCLUSIVE OFF
SET MULTIPLE OFF
SET OPTIMIZE ON
SET BELL OFF
FW_SetUnicode( .T. )
xEMPRESA := [FIVETECH SOFTWARE ENTERPRISE]
cTitle := Oemtoansi( " Facturaci¢n V 13.13" )
xOficina := "OFICINA BINARIA THE BIN LADEN CO. LTD."
cFont := "Verdana"
nHFont := 18 // 14
SetBalloon( .T. ) // Balloon shape required for tooltips
MsgRun( "AGUARDE... ABRINDO OS BANCOS DE DATOS. ", ;
"Por Favor, Espere Apertura. Pode Demorar.", ;
{ || WinExec( APERTURA() ), 3 } )
DEFINE ICON oIco FILE "..\..\icons\fax.ico"
DEFINE FONT oFont NAME cFont SIZE 0, - nHFont
DEFINE FONT oFnt NAME 'TAHOMA' SIZE 0, - 12 BOLD
DEFINE FONT JorFon NAME "Times New Roman" bold SIZE 25, 50
DEFINE WINDOW oWnd FROM 3, 3 TO 25, 75 TITLE cTitle ICON oIco ;
MENU BuildMenu()
// NO FUNCIONA CON FWH19.05 -> SE USO: :bInit MODIFICADO EN: ACTIVATE WINDOW.
SET MESSAGE OF oWnd TO STR(YEAR(DATE())) + " © João Santos: (11) 9.5150-7341 - kapiabafwh@gmail.com " ;
FONT oFont NOINSET CLOCK DATE KEYBOARD COLOR METRO_COBALT, CLR_WHITE 2007 CENTERED
@ 5, 16 BITMAP oBmp FILENAME "logo.jpg" NOBORDER // .jpg es menor.
@ 6, 18 SAY SPACE(02) + xEMPRESA + SPACE(45) FONT JorFon ;
COLOR CLR_GRAY, CLR_WHITE TRANSPARENT CENTER
// Defecto en el FWH2603, una lástima. // aqui - 24/09/2026 - Joao.
IF FWVERSION >= "FWH 26.03"
WITH OBJECT oWnd
:bInit := {|| oWnd:Show(), oWnd:Center(), oWnd:Maximize(), DEFINEBAr(), oBmp:Center() }
END
ENDIF
/*
nResHoriz := oWnd:nHorzRes() // aqui - Camabiado para otras
nResVert := oWnd:nVertRes() // aqui - resoluciones de video.
*/
@ 37, 02 SAY SPACE(02) + xOFICINA + SPACE(45) FONT JorFon ;
COLOR CLR_GRAY, CLR_WHITE TRANSPARENT CENTER
IF FWVERSION >= "FWH 26.03" // FUNCIONA - TERRIBLE DEFECTO VIA IA.
ACTIVATE WINDOW oWnd MAXIMIZED // USAR bInit(). Habla serio...
ELSE // FUNCIONA MUI BIEN COMO SIEMPRE HA SIDO.
ACTIVATE WINDOW oWnd MAXIMIZED ON INIT( DEFINEBAr(), oBmp:Center() )
ENDIF
oFont:End()
JorFon:End()
oFnt:End()
RETURN NIL
FUNCTION DefineBar( )
LOCAL nBarClr, oBtn, oPopup, oSalida
LOCAL oBtn1, oBtn2, oBtn3, oBtn4, oBtn5, oBtn6
/* // Cambiado en: 24/09/2026 By Kapiaba. Para: SRC_RESOLUTION()
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
*/
SRC_RESOLUTION() // Configuracion de video. 24/09/2026 - Joao.
// nTamano := 64 // SIZE
// nAltura := 70
DEFINE BUTTONBAR oBar OF oWnd SIZE nTamano, nAltura 2007 // FUNCIONA
// O:
// DEFINE BUTTONBAR oBar OF oWnd SIZE nSize, nAltura 2007 // FUNCIONA
WITH OBJECT oBar
oBar:bClrGrad := aPubGrad
oBar:lVisible := .T.
oBar:SetFont( oFnt )
oBar:nClrText := CLR_DARK_ORANGE
oBar:Adjust()
END
/* // No realicé pruebas con recursos.
DEFINE BUTTON oBtn1 OF oBar resource "users" ;
ACTION clients() GROUP TOP ;
TOOLTIP "Clientes" PROMPT "Clientes"
*/
DEFINE BUTTON oBtn1 OF oBar FILENAME "..\bitmaps\32x32\Fivetech.bmp" ;
ACTION clients() GROUP TOP ;
TOOLTIP "Clientes" PROMPT "Clientes"
oBtn1:SetColor( CLR_TANGERINE, METRO_TURQUE ) // 24/09/2026 - Joao FUNCIONA.
oBtn1:lThemed := .T.
oBtn1:SetThemed( .T. ) // Bien en ambas versiones.
DEFINE BUTTON oBtn2 OF oBar resource "setup" ;
ACTION val_stk2() GROUP TOP ;
TOOLTIP "Consulta ficha de stock" ;
PROMPT "&Consulta Stock"
DEFINE BUTTON oBtn3 OF oBar resource "presupu" ;
ACTION facturas() GROUP TOP ;
TOOLTIP "Facturar" ;
PROMPT "Facturar"
DEFINE BUTTON oBtn4 OF oBar PROMPT "&Cambiar fondo" resource "app" ;
ACTION selcolorfondo() GROUP TOP ;
tooltip oemtoansi( "Cambiar color de fondo" )
DEFINE BUTTON oBtn5 OF oBar PROMPT "&Cambiar Empresa" resource "setup" ;
ACTION selempre() GROUP TOP ;
tooltip oemtoansi( "Cambiar Empresa vigente" )
DEFINE BUTTON oBtn6 OF oBar PROMPT "Color" resource "colors" GROUP TOP ;
ACTION ( nBarClr := ChooseColor( RGB( 0, 0x2E, 0x5C ) ), oBar:Refresh() )
MENU oPopup POPUP FONT oFont 2013 ADJUST NOBORDER ;
COLORMENU CLR_DARK_BACK, CLR_DARK_TEXT ;
COLORLEFT CLR_DARK_BACK, CLR_DARK_BACK ;
COLORRIGHT CLR_DARK_TEXT, CLR_DARK_BACK ;
COLORSELECT CLR_DARK_SEL, CLR_DARK_SEL, CLR_WHITE ;
COLORSEPARATOR RGB( 80, 80, 80 ) ;
COLORBOX CLR_DARK_BACK ;
ROUND 5 ;
HEIGHT 1.0 * 2
SEPARATOR
MENUITEM "&IVA Ventas" ACTION librovta() ;
MESSAGE "IVA Ventas"
SEPARATOR
MENUITEM "&Ventas anuales" ACTION vtastot() ;
MESSAGE "Ventas mensuales"
SEPARATOR
MENUITEM "&Comprobantes en la AFIP " ;
ACTION CompAFIP() ;
MESSAGE "Consulta de comprobantes emitidos"
SEPARATOR
MENUITEM "&Comprobantes en la AFIP por fecha " ;
ACTION CompAFIPFec() ;
MESSAGE "Consulta de comprobantes emitidos"
SEPARATOR
MENUITEM "&Archivos SQL" ACTION ABMSQLAll() ;
MESSAGE oemtoansi( "Editar archivos" )
SEPARATOR
MENUITEM "&Traductor" ACTION traductor() ;
MESSAGE oemtoansi( "Editar archivos" )
SEPARATOR
MENUITEM "&e-mail" ACTION ConfEmail() ;
MESSAGE oemtoansi( "Configurar e-mail" )
ENDMENU
DEFINE BUTTON oBtn OF oBar ACTION oBtn:ShowPopup() ;
RESOURCE "print" PROMPT "Listados" GROUP TOP ;
MENU oPopup TOOLTIP "Listados"
DEFINE BUTTON oSalida OF oBar resource "QUIT" ;
ACTION oWnd:End() GROUP TOP ;
MESSAGE "Finalizar El Programa" ;
TOOLTIP "Salida" PROMPT "Salir"
RETURN NIL
FUNCTION clients()
LOCAL oDlg
LOCAL oGet1, oGet2, oGet3, oGet4
LOCAL cVar1, cVar2, cVar3, cVar4
LOCAL lActive := .F.
cVar1 := 0
cVar2 := 0
cVar3 := 0
cVar4 := 0
DEFINE DIALOG oDlg TITLE "From Code" PIXEL SIZE 300, 300
@ 10, 10 GET oGet1 var cVar1 PICTURE "@E 99,999.99" of oDlg pixel size 70, 12 ;
bitmap "..\bitmaps\on.bmp" action( msginfo( "With Transparent" ) )
@ 40, 10 GET oGet2 var cVar2 bitmap "..\bitmaps\on.bmp" action( msginfo( "Without Transparent" ) ) of oDlg pixel size 60, 12
@ 70, 10 GET oGet3 var cVar3 bitmap "..\bitmaps\chkyes.bmp" action( msginfo( "With Adjust-Transparent" ) ) of oDlg pixel size 120, 12
@ 100, 10 GET oGet4 var cVar4 bitmap "..\bitmaps\chkyes.bmp" ;
action( if( lActive,oGet3:disable(),oGet3:enable() ), lActive := !lActive, oDlg:update() ) of oDlg pixel size 120, 12
oGet3:disable()
oGet3:lBtnTransparent := .T. // transparent button get oGet3
oGet3:lAdjustBtn := .T. // Button Get Adjust Witdh oGet3
oGet3:lDisColors := .F. // Deactive disable color
oGet3:nClrTextDis := CLR_WHITE // Color text disable status
oGet3:nClrPaneDis := CLR_BLUE // Color Pane disable status
oGet4:lAdjustBtn := .T.
ACTIVATE DIALOG oDlg CENTERED
RETURN NIL
FUNCTION librovta()
? [GOOD1]
RETURN NIL
FUNCTION vtastot()
? [GOOD2]
RETURN NIL
FUNCTION val_stk2()
? [GOOD4]
RETURN NIL
FUNCTION facturas()
? [GOOD5]
RETURN NIL
FUNCTION selcolorfondo()
? [GOOD6]
RETURN NIL
FUNCTION selempre()
? [GOOD7]
RETURN NIL
FUNCTION CompAFIP()
? [GOOD8]
RETURN NIL
FUNCTION CompAFIPFec()
? [GOOD9]
RETURN NIL
FUNCTION ABMSQLAll()
? [GOOD10]
RETURN NIL
FUNCTION traductor()
? [GOOD11]
RETURN NIL
FUNCTION ConfEmail()
? [EMAIL]
RETURN NIL
FUNCTION APERTURA()
RETURN NIL
FUNCTION BuildMenu()
LOCAL oMenu
// GetnWidthItem( 0.8 ) // Ajusta con un valor < 1, y comprueba 0.8
IF Type( "SetMenuItemWidth" ) == "UI"
// SetMenuItemWidth( 0.8 )
GetnWidthItem( 0.8 ) // Ajusta con un valor < 1, y comprueba 0.8
ENDIF
MENU oMenu FONT oFont 2013 ADJUST NOBORDER ;
COLORMENU CLR_DARK_BACK, CLR_DARK_TEXT ;
COLORLEFT CLR_DARK_BACK, CLR_DARK_BACK ;
COLORRIGHT CLR_DARK_TEXT, CLR_DARK_BACK ;
COLORSELECT CLR_DARK_SEL, CLR_DARK_SEL, CLR_WHITE ;
COLORSEPARATOR RGB( 80, 80, 80 ) ;
COLORBOX CLR_DARK_BACK ;
ROUND 5 ;
HEIGHT 1.0 * 2
/*
MENU oMenu FONT oFont ADJUST NOBORDER ;
COLORMENU CLR_DARK_BACK, CLR_DARK_TEXT ;
COLORLEFT CLR_DARK_BACK, CLR_DARK_BACK ;
COLORRIGHT CLR_DARK_TEXT, CLR_DARK_BACK ;
COLORSELECT CLR_DARK_SEL, CLR_DARK_SEL, CLR_WHITE ;
COLORSEPARATOR RGB( 80, 80, 80 ) ;
COLORBOX CLR_DARK_BACK ;
ROUND 5 ;
HEIGHT 32
*/
MENUITEM " &Information "
MENU
MENUITEM " &About... " ;
ACTION MsgInfo( FWDESCRIPTION ) ;
FILENAME "..\bitmaps\16x16\info.bmp"
SEPARATOR
MENUITEM " &End... " ;
ACTION oWnd:End() FILENAME "..\bitmaps\16x16\exit.bmp"
ENDMENU
MENUITEM " &Clients "
MENU
MENUITEM "&New..." ;
ACTION ( MsgStop( "New Clients" ), ;
oWnd:Say( 5, 5, "New Clients...", "GR+/G" ) ) ;
FILENAME "..\bitmaps\16x16\faces.bmp"
MENUITEM "&Modify..." ACTION MsgInfo( "Modif. Clients" ) ;
FILENAME "..\bitmaps\edit.bmp"
MENUITEM "&Delete..." ACTION MsgAlert( "Del Clients" ) ;
FILENAME "..\bitmaps\16x16\delete.bmp"
SEPARATOR
MENUITEM " &Browse... " ACTION MsgInfo( "Browse Clients" ) ;
FILENAME "..\bitmaps\16x16\browse.bmp"
ENDMENU
MENUITEM " &Utilities "
MENU
MENUITEM "&Calculator..." ACTION WinExec( "Calc" ) ;
FILENAME "..\bitmaps\16x16\calc.bmp"
MENUITEM "&Internet..." ;
ACTION WinExec( "start iexplore www.fivetech.com", 0 ) ;
FILENAME "..\bitmaps\16x16\explorer.bmp"
ENDMENU
ENDMENU
RETURN( oMenu )
// Aquí, cambie a su gusto el tamaño de los botones de la barra de botones,
// según la resolución de vídeo. -> Soy terrible. jajajajajaja.
FUNCTION SRC_RESOLUTION() //
nResHoriz := oWnd:nHorzRes() // retorna a resolucao horizontal
nResVert := oWnd:nVertRes() // retorna a resolucao vertical
IF nResHoriz = 2560 .AND. nResVert = 1600
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1440 .AND. nResVert = 900
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1366 .AND. nResVert = 768
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1360 .AND. nResVert = 768
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1280 .AND. nResVert = 768 // Mi Resolucion.
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1280 .AND. nResVert = 720
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1280 .AND. nResVert = 960
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1280 .AND. nResVert = 800
nSize := INT( nResHoriz ) / 20.00 // 64
nTamano := INT( nResHoriz ) / 20.00 // 64
nAltura := INT( nResVert ) / 10.97 // 70
oWnd:Update()
oWnd:Refresh()
ELSEIF nResHoriz = 1280 .AND. nResVert = 720
// continue...
ELSEIF nResHoriz = 1280 .AND. nResVert = 600
ELSEIF nResHoriz = 1600 .AND. nResVert = 1200
ELSEIF nResHoriz = 1680 .AND. nResVert = 1050
ELSEIF nResHoriz = 1024 .AND. nResVert = 768
ELSE
ENDIF
RETURN NIL
// FIN / END - kapiabafwh@gmail.com
Regards, saludos.
