// PRUEBAS CON FONTS
// FWH32 VERSION 14.11 + xHarbour Dic.2014
// Fecha: 14-12-2014
/* EL ERROR QUE DA ES QUE AL PULSAR POR TERCERA VEZ CUALQUIERA DE LOS BOTONES
EL TIPO DE LETRA DEL DIALOGO SE REDUCE DE TAMAÑO Y SE QUITA EL NEGRILLA.
ASÍ MISMO SE GENERA UN EL FICHERO FONTTEST.LOG CON EL CONTENIDO SIGUIENTE:
14-12-14 15:45:30: EXCESS RELEASE OF FONT MS Sans Serif[ hFont : 0] ( nCount : 0 )
<-TFONT:END(246) <-TCONTROL:DESTROY(2178) <-(b)TWBROWSE:TWBROWSE(650) <-TWBROWSE:DESTROY(0)
<-TWINDOW:HANDLEEVENT(0) <-TWBROWSE:HANDLEEVENT(1733) <-_FWH(3341) <-DIALOGBOX(0)
<-TDIALOG:ACTIVATE(286)
*/
#include 'inkey.ch'
#include 'set.ch'
#include 'report.ch'
#include 'fivewin.ch'
#include 'rddsys.ch'
#include "common.ch"
#include "DLL.ch"
#include 'ord.ch' //Para CDX
#include 'Image.ch'
#include "fileio.ch"
#include "Struct.ch"
// Valores para la funcion cGetDir
#define BIF_NONEWFOLDERBUTTON 0x200
#define BIF_RETURNONLYFSDIRS 0x0001
#define BIF_DONTGOBELOWDOMAIN 0x0002
#define BIF_STATUSTEXT 0x0004
#define BIF_RETURNFSANCESTORS 0x0008
#define BIF_EDITBOX 0x0010
#define BIF_VALIDATE 0x0020
#define BIF_NEWDIALOGSTYLE 0x0040
#define BIF_USENEWUI (BIF_NEWDIALOGSTYLE|BIF_EDITBOX)
#define BIF_BROWSEINCLUDEURLS 0x0080
#define BIF_BROWSEFORCOMPUTER 0x1000
#define BIF_BROWSEFORPRINTER 0x2000
#define BIF_BROWSEINCLUDEFILES 0x4000
#define BIF_SHAREABLE 0x8000
external dbfcdx, ordkeyno, ordkeycount, ordkeygoto //Para CDX
static oWnd
// Variables de Tipos de Letra PUBLICAS PARA TODA LA APLICACION
static oFont
static oFontDoble
static oFontDobleN
static oFontGigant
#command EJECT =>
function main()
local oBtn1
local oBtn2
public oSayUltDoc , cUltDoc:= "DOCUMENTO 1"
public oSayUltHora , CuLThORA:=dtoc(date())
public oSayUltImporte, cUltImporte:=125
public oSayUltCli , cUltCli:="Teodosio"
public oSayDiaHora , cSayDiaHora :=space(40)
public oSayLineaAvisos, cSayLineaAvisos:=space(40)
public oSayGigante, cSayGigante:='Pruebas'
public nSizeCond:= 8
public nSizeNorm:=10
public oBru
// Establece los sets de la forma de trabajo.
set DELETED ON
set SOFTSEEK OFF
set DATE ITALIAN //set DATE FORMAT TO "DD/MM/YYYY"
set EPOCH TO 2000
set SCOREBOARD OFF
set WRAP ON
DEFINE BRUSH oBru COLOR nrgb(0,0,30)
DEFINE FONT oFont NAME "MS Sans Serif" SIZE 0,-14
DEFINE FONT oFontDoble NAME "MS Sans Serif" SIZE 0,-16
DEFINE FONT oFontDobleN NAME "MS Sans Serif" SIZE 0,-16 BOLD
DEFINE FONT oFontGigant NAME "Arial" SIZE 0,-36 BOLD
//* Ventana principal
DEFINE WINDOW oWnd TITLE 'PRUEBAFONT' BRUSH oBru MENU MenuPpal()
CreaLineasMensajes_oWnd()
@ 14 ,4 SAY oSayUltDoc VAR cUltDoc FONT oFontDoble;
COLOR nrgb(0,0,170),nrgb(220,220,220);
SIZE 250, 24 ;
OF oWnd
@ 15.6,4 SAY oSayUltHora VAR cUltHora FONT oFont;
COLOR nrgb(0,0,170),nrgb(240,240,240);
SIZE 250, 24 ;
OF oWnd
@ 17.2,4 SAY oSayUltImporte VAR cUltImporte FONT oFontDobleN;
COLOR nrgb(50,250,50),nrgb(0,0,0);
SIZE 250, 24 ;
OF oWnd
@ 18.9,4 SAY oSayUltCli VAR cUltCli FONT oFont;
COLOR nrgb(0,0,170),nrgb(240,240,240);
SIZE 250, 24 ;
OF oWnd
// Botón para hacer una nueva venta.
@ 18,10 BUTTON oBtn1 PROMPT 'Fonts Publicas' OF oWnd;
ACTION DialogoPublic(oWnd);
SIZE 150,40; // Ancho, Alto
UPDATE
// Botón para hacer una nueva venta.
@ 18,50 BUTTON oBtn2 PROMPT 'Fonts Locales' OF oWnd;
ACTION DialogoLocal(oWnd);
SIZE 150,40; // Ancho, Alto
UPDATE
DEFINE BUTTONBAR oBar SIZE 33,33 3D TOP OF oWnd
set MESSAGE OF oWnd TO CurDir() CLOCK DATE KEYBOARD
ACTIVATE WINDOW oWnd MAXIMIZED
return NIL
function CreaLineasMensajes_oWnd()
@ 25,2 SAY oSayDiaHora VAR cSayDiaHora FONT oFont;
COLOR nrgb(240,240,240),rgb(0,50,50);
SIZE 250, 20 OF oWnd
@ 25,40 SAY oSayLineaAvisos VAR cSayLineaAvisos FONT oFont;
COLOR nrgb(240,240,240),rgb(0,50,50);
SIZE 250, 20 OF oWnd
//Tipo de letra Gigante
@ 8,52 SAY oSayGigante VAR cSayGigante FONT oFontGigant;
COLOR nrgb(240,240,240),nrgb(0,0,30);
SIZE 500,40 OF oWnd
return
// Función para pruebas usando las variables PUBLICAS en el diálogo.
static function DialogoPublic(oPadre)
local Coloract:=SetColor()
local oDlg
local oTbr
local oBtn1, oBtn2, oBtn3, oBtnSalir
local oSayTotal, nSayTotal:=0, oSayTot, cSayTot:='MS Sans Serif (Dbl)- NEGRITA'
local oSayDia, cFecha:=dtoc(date())
local aRolloCalc:={1,2,3,4,5,6,7,8,9}
DEFINE FONT oFont1 NAME "Arial" SIZE 0,-20
DEFINE DIALOG oDlg RESOURCE 'DIALOGO' OF oPadre;
TITLE 'Dialogo con Fonts Publicas';
FROM 1,10 TO 15,80;
FONT oFont
REDEFINE SAY oSayTot VAR cSayTot ID 100 OF oDlg FONT oFontDobleN COLOR nrgb(0,0,200) UPDATE
REDEFINE SAY oSayTotal VAR nSayTotal ID 101 OF oDlg FONT oFont COLOR nrgb(50,250,50),nrgb(0,0,0) UPDATE
REDEFINE SAY oSayDia VAR cFecha ID 103 OF oDlg FONT oFontDobleN COLOR nrgb(0,0,200) UPDATE
REDEFINE BUTTON oBtn1 ID 401 OF oDlg MESSAGE 'Hace una Factura Simplificada de contado';
ACTION ( iif(Opcion(1,nSayTotal,oDlg),(lCierraDlg:=.t., oDlg:End()),) )
REDEFINE BUTTON oBtn2 ID 402 OF oDlg MESSAGE 'Hace un Albarán de crédito';
ACTION ( iif(Opcion(2,nSayTotal,oDlg),(lCierraDlg:=.t., oDlg:End()),) )
REDEFINE BUTTON oBtn3 ID 403 OF oDlg MESSAGE 'Hace una Factura Completa de contado';
ACTION ( iif(Opcion(3,nSayTotal,oDlg),(lCierraDlg:=.t., oDlg:End()),) )
REDEFINE BUTTON oBtnSalir ID 404 OF oDlg MESSAGE 'Hace una devolución a tienda';
ACTION ( (lCierraDlg:=.t., oDlg:End()) )
REDEFINE LISTBOX oTbr FIELDS ;
aRolloCalc;
HEAD 'valor';
ID 212 OF oDlg FONT oFontDobleN COLOR nrgb(0,0,0),nrgb(255,255,200) ;
UPDATE
oTbr:nLineStyle = 2
oTbr:aJustify:={.t.,.f.,.t.,.t.,.t.}
oTbr:nClrLine:=nrgb(200,200,200)
oTbr:aColSizes:=aMatrizTc({7,32,12,11,12},oFontDobleN)
// Pinta líneas de colores distintas si son pares o impares.
oTbr:nClrPane:={|| iif((oTbr:cAlias)->(ordkeyno())%2==0,ClrFlbxPar,ClrFlbxImp) }
oDlg:lHelpIcon:=.f.
ACTIVATE DIALOG oDlg
return nil
// Función para pruebas con variables locales en el diálogo.
static function DialogoLocal(oPadre)
local Coloract:=SetColor()
local oDlg
local oTbr
local oBtn1, oBtn2, oBtn3, oBtnSalir
local oSayTotal, nSayTotal:=0, oSayTot, cSayTot:='MS Sans Serif (Dbl)- NEGRITA'
local oSayDia, cFecha:=dtoc(date())
local oFontDlg:=oFont, oFontSayDblN:=oFontDobleN
local aRolloCalc:={1,2,3,4,5,6,7,8,9}
DEFINE FONT oFont1 NAME "Arial" SIZE 0,-20
DEFINE DIALOG oDlg RESOURCE 'DIALOGO' OF oPadre;
TITLE 'Dialogo con Fonts Locales';
FROM 1,10 TO 15,80;
FONT oFontDlg
REDEFINE SAY oSayTot VAR cSayTot ID 100 OF oDlg FONT oFontSayDblN COLOR nrgb(0,0,200) UPDATE
REDEFINE SAY oSayTotal VAR nSayTotal ID 101 OF oDlg FONT oFontDlg COLOR nrgb(50,250,50),nrgb(0,0,0) UPDATE
REDEFINE SAY oSayDia VAR cFecha ID 103 OF oDlg FONT oFontSayDblN COLOR nrgb(0,0,200) UPDATE
REDEFINE BUTTON oBtn1 ID 401 OF oDlg MESSAGE 'Hace una Factura Simplificada de contado';
ACTION ( iif(Opcion(1,nSayTotal,oDlg),(lCierraDlg:=.t., oDlg:End()),) )
REDEFINE BUTTON oBtn2 ID 402 OF oDlg MESSAGE 'Hace un Albarán de crédito';
ACTION ( iif(Opcion(2,nSayTotal,oDlg),(lCierraDlg:=.t., oDlg:End()),) )
REDEFINE BUTTON oBtn3 ID 403 OF oDlg MESSAGE 'Hace una Factura Completa de contado';
ACTION ( iif(Opcion(3,nSayTotal,oDlg),(lCierraDlg:=.t., oDlg:End()),) )
REDEFINE BUTTON oBtnSalir ID 404 OF oDlg MESSAGE 'Hace una devolución a tienda';
ACTION ( (lCierraDlg:=.t., oDlg:End()) )
REDEFINE LISTBOX oTbr FIELDS ;
aRolloCalc;
HEAD 'valor';
ID 212 OF oDlg FONT oFontSayDblN COLOR nrgb(0,0,0),nrgb(255,255,200) ;
UPDATE
oTbr:nLineStyle = 2
oTbr:aJustify:={.t.,.f.,.t.,.t.,.t.}
oTbr:nClrLine:=nrgb(200,200,200)
oTbr:aColSizes:=aMatrizTc({7,32,12,11,12},oFontSayDblN)
// Pinta líneas de colores distintas si son pares o impares.
oTbr:nClrPane:={|| iif((oTbr:cAlias)->(ordkeyno())%2==0,ClrFlbxPar,ClrFlbxImp) }
oDlg:lHelpIcon:=.f.
ACTIVATE DIALOG oDlg
//oFontDlg:end()
//oFontSayDblN:end()
return nil
function Opcion(nOpcion,nTotal,oPadre)
return .t.
/****
TC devuelve el tamaño de un campo en funcion del tipo de letra
El cálculo es empírico.
****/
static function tc(lenCampo, oFuente)
local valor:=1
if oFuente<>NIL
valor := GetFontInfo(oFuente)[2] * 1.25 * lenCampo
else
valor := 8.5 * lenCampo
endif
return valor
static function aMatriztc(atc,oFuente)
local aMatriz:={}, i:=0
for i=1 TO len(atc)
aadd( aMatriz,tc(atc[i],oFuente) )
next i
return aMatriz
static function MenuPpal()
local oMenu
MENU oMenu
MENUITEM '&Publicas' ACTION DialogoPublic(oWnd) MESSAGE 'Opción con variables publicas'
MENUITEM '&Locales' ACTION DialogoLocal(oWnd) MESSAGE 'Opción con variables locales'
MENUITEM '&Salida' ACTION Cerrar() MESSAGE 'Salida del Programa'
ENDMENU
return oMenu
function Cerrar()
oWnd:end() // Es obligatorio poner esto porque llama a la funcion KillApp() que
// contiene acciones para la salida del programa.
return NIL