Antonio,
Também compilei o seu fonte (com algumas modificações que vou explicitar) e obtive um resultado semelhante ao do asimoes. A tela ficou igualzinha.
Como uso xharbour 1.0 fiz algumas modificações:
Em vez de #include "hbgtinfo.ch"
coloquei #include "GTINFO.CH"
Em vez de
Do Case
Case HB_gtinfo(HB_GTI_DESKTOPWIDTH) >= 1024
Wvt_SetFont('VisualLib',28,11,FW_MEDIUM,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
Case HB_gtinfo(HB_GTI_DESKTOPWIDTH) >= 800
Wvt_SetFont('VisualLib',21,11,FW_MEDIUM,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
OtherWise
Wvt_SetFont('VisualLib',15,7,FW_MEDIUM,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
EndCase
coloquei
Do Case
Case gtinfo(GTI_DESKTOPWIDTH) > 1023
Wvt_SetFont('VisualLib',28,11,,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
CAse gtinfo(GTI_DESKTOPWIDTH) > 799
Wvt_SetFont('VisualLib',21,11,,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
Other
Wvt_SetFont('VisualLib',15,7,,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
EndCase
=========
Bom,
1-) Tenho a fonte visuallib.ttf instalada pelo Painel de Controle do windows;
2-) Pelo hbmake setei apenas os prg's teste.prg e vlib.prg. As libs setei para usar a lib GTWVT e depois marquei a lib what32.lib
3-) No Vlib.prg fornecido pelo asimoes deu pau da linha 2536, na função function vl850. Mas aí comentei as linhas
* if lCallSetMode
* vlsetmode(25, MaxCol()+1)
* end
deu tudo bleza.
Código: Selecionar todos
#include "inkey.ch"
#include "visual2.ch"
# include "GTINFO.CH"
*#include "hbgtinfo.ch" // HB_GTI_DESKTOPWIDTH
INIT FUNCTION MOLDER()
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
HB_LANGSELECT("PT")
HB_SetCODEPAGE( "PT850" )
REQUEST WVT_SETCODEPAGE
WVT_SETCODEPAGE(255) //850
SETMODE(25,80)
* AddFont()
SET TYPEAHEAD TO 0
SET INTENSITY ON
SET SCOREBOARD OFF
SET DELETED ON
SET SAFETY OFF
SET DATE BRITISH
SET ESCAPE ON
SET CENTURY ON
SET DELIMITERS TO
SET CURSOR OFF
SET EXCLUSIVE OFF
SET WRAP ON
SET EPOCH TO 1990
Do Case
Case gtinfo(GTI_DESKTOPWIDTH) > 1023
Wvt_SetFont('VisualLib',28,11,,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
CAse gtinfo(GTI_DESKTOPWIDTH) > 799
Wvt_SetFont('VisualLib',21,11,,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
Other
Wvt_SetFont('VisualLib',15,7,,2) //28,10,0 FW_NORMAL, FW_BOLD, FW_BLACK
EndCase
WvT_SetAltF4Close( .F. )
*WvT_SetPointer( 0, 100 ) // AQUI DA PAU ACREDITO QUE SEJA ALGO RELACIONADO COM O PONTEIRO DO MOUSE, NÃO VOU USAR
WvT_SetTITLE('Sistema X - Vs.1.0')
RETURN Nil
FUNCTION MAIN()
MENSAGEM :="Agendament System Protocol & Service"
DESKTOP( MENSAGEM , WT_VERM1CINZA , WD_VERM1CINZA )
* Menu do Sistema
mBar := NewBarMenu()
mARQ := NewDownMenu()
mARQ1 := NewDownMenu()
AddDownItem( mARQ , "&1 - Clientes" , Hb_AnsiToOem("Sistema Cadastro de Clientes"),)
AddDownSep ( mARQ )
AddDownItem( mARQ , "&2 - Protocolos" , Hb_AnsiToOem("Sistema Cadastro de Protocolos de Remessa e Recebimento"),mARQ1 )
AddDownItem( mARQ1 , "&A - Protocolos Remessa " , Hb_AnsiToOem("Cadastro de Protocolos de Remessa") , {|| Msgbox("oi") , WaitState(), RstEnv( aEnv ) })
AddDownItem( mARQ1 , "&B - Protocolos Recebimento" , Hb_AnsiToOem("Cadastro de Protocolos de Recebimento"), {|| MsgBox1("E ai?"), WaitState(), RstEnv( aEnv ) })
AddBarItem( mBar, "&Arquivos" , "Sistema Controle de Clientes" , mARQ )
Private aENV := SavEnv(0,0,24,79)
while .t.
BarMenu( mBar )
set key K_F10 to
SetKeyMouse( K_F10, {} )
VLExit()
set key K_F10 to saida()
SetKeyMouse( K_F10, { 24, 24, 72, 79 } )
End
* End of Function Main()
RETURN nil
FUNCTION Saida()
aKM := SetKeyMouse( K_F10, {} )
set key K_F10 to
VLExit()
set key K_F10 to saida()
SetKeyMouse( K_F10, aKM )
RETURN nil
STATIC FUNCTION AddFont()
Local nRet := AddFontResource("VISUALLIB.TTF")
If nRet == 0
MsgBox("A fonte VISUALLIB.TTF não foi adicionada ao sistema.")
Else
MsgBox("A fonte VISUALLIB.TTF foi adicionada ao sistema.")
EndIf
RETURN Nil
STATIC FUNCTION RemoveFont()
Local lRet := RemoveFontResource("VISUALLIB.TTF")
If lRet == .f.
MsgBox("Houve um erro na remoção da fonte VISUALLIB.TTF.","Aviso")
Else
MsgBox("A fonte VISUALLIB.TTF foi removida com sucesso.","Aviso")
EndIf
RETURN Nil
