Code: Select all

#include "minigui.ch"

function Main()

   MsgInfo( Now() )

return nil

#pragma BEGINDUMP

#ifdef _CRT_SECURE_NO_WARNINGS
#undef _CRT_SECURE_NO_WARNINGS
#endif
#define _CRT_SECURE_NO_WARNINGS 1

#include <hbapi.h>

#ifdef __BORLANDC__
   #define _WIN32_WINNT 0x0502
#endif

#include <stdio.h>
#include <stdlib.h>
#include <time.h>

#ifdef __BORLANDC__
   #include <winsock2.h>
#endif

#include <ws2tcpip.h>

HB_FUNC( NOW )
{
    struct addrinfo hints;
    struct addrinfo *result;
    int sockfd;
    int rv;
    char buf[ 64 ];
    time_t now = time(NULL);
    char str[ 26 ];
    WSADATA wsaData;  

    WSAStartup(MAKEWORD(2,2), &wsaData);

    memset(&hints, 0, sizeof(struct addrinfo));
    hints.ai_family = AF_INET; /* Allow IPv4 */
    hints.ai_socktype = SOCK_STREAM; /* Stream socket */
    hints.ai_flags = AI_CANONNAME; /* Return canonical name */
   
    rv = getaddrinfo("www.google.com", "http", &hints, &result);
    if (rv != 0) {
        fprintf(stderr, "getaddrinfo: %s\n", gai_strerror(rv));
        exit(1);
    }
   
    /* Create socket */
    sockfd = socket(result->ai_family, result->ai_socktype, result->ai_protocol);
    if (sockfd == -1) {
        perror("socket");
        exit(1);
    }
   
    /* Connect */
    if (connect(sockfd, result->ai_addr, result->ai_addrlen) == -1) {
        perror("connect");
        exit(1);
    }
   
    /* Get time */
    snprintf(buf, sizeof(buf), "GET / HTTP/1.0\r\n\r\n");
    send(sockfd, buf, strlen(buf), 0);
    recv(sockfd, buf, sizeof(buf), 0);
    ctime_s( str, 26, &now );
    snprintf(buf, sizeof( buf ), "Current time: %s", str );
   
    closesocket(sockfd);
    freeaddrinfo(result);
   
    hb_retc( buf );
}

#pragma ENDDUMP

Code: Select all

/* Copyright 2013-2014 Viktor Szakats (vszakats.net/harbour) */
#include "hmg.ch"
#include "hbsocket.ch"
#include "hbver.ch"

PROCEDURE MAIN

   Set( _SET_DATEFORMAT, "yyyy.mm.dd" )

	DEFINE WINDOW Win_1 ;
		AT 0,0 ;
		WIDTH 400 ;
		HEIGHT 400 ;
		TITLE 'NTP DEMO' ;
		MAIN 

	@ 70,70 BUTTON Button_1 CAPTION 'NTP Network Time Protocol' ACTION GetTime() WIDTH 250

	END WINDOW

	CENTER WINDOW Win_1 

	ACTIVATE WINDOW Win_1 

Return

Function GetTime ()

   LOCAL tTime, i := 0, tSystemTime, tLocalTime, tOffset, cNewTime
   LOCAL aServersNTP := { "0.africa.pool.ntp.org", "0.pl.pool.ntp.org" ,"1.pl.pool.ntp.org" ,"2.pl.pool.ntp.org" ,"3.pl.pool.ntp.org" , "tempus1.gum.gov.pl", "tempus2.gum.gov.pl", "ntp.task.gda.pl", "0.europe.pool.ntp.org" }

   DO WHILE i < Len( aServersNTP )
	i ++
        WAIT WINDOW "Connecting with " + aServersNTP [i] + ".... " NOWAIT
   	tTime := hb_ntp_GetTimeUTC( aServersNTP [i], /* port 123 */ , 3000 /* 3 sec */ ) 
	tSystemTime := hb_DateTime()
	tLocalTime := tTime + hb_UTCOffset() / 86400
	IF !EMPTY(tTime)
		EXIT
	ENDIF
        WAIT WINDOW "Connecting with " + aServersNTP [i] + " no response!" NOWAIT
   ENDDO

   WAIT CLEAR 

   IF EMPTY(tTime)
	MsgStop ( "Network not available. Check Fire-Wall" )
	RETURN
   ENDIF

   tOffset := tSystemTime - tLocalTime

   MsgInfo ( "UTC    time: " + hb_valToStr ( tTime ) + " by " + aServersNTP [i] + CRLF + ;
             "Local  time: " + hb_valToStr ( tLocalTime ) + CRLF + ;
             "System time: " + hb_valToStr ( tSystemTime ) + CRLF + ;
             "Offset time: " + RoznicaCzasu ( tOffset ) )

RETURN

Function RoznicaCzasu ( tDiff )
Local tRoznica := ABS ( tDiff )
Local cGodzin := Alltrim( Str (INT( hb_NToHour (tRoznica) ), 0, 0) )
Local cMinut  := StrZero (INT( hb_NToMin (tRoznica) ) % 60, 2, 0)
Local cSekund := StrZero (INT( hb_NToSec (tRoznica) ) % 60, 2, 0)
Local cMSek   := StrZero (( hb_NToMSec (tRoznica) ) % 1000, 3, 0)
RETURN IF( tDiff < 0, "-", "" ) + cGodzin + ":" + cMinut + ":" + cSekund + "." +cMsek


/*
 * NTP functions
 *
 * Copyright 2013 Viktor Szakats (vszakats.net/harbour)
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file LICENSE.txt.  If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 * Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
 *
 * As a special exception, the Harbour Project gives permission for
 * additional uses of the text contained in its release of Harbour.
 *
 * The exception is that, if you link the Harbour libraries with other
 * files to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the Harbour library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the Harbour
 * Project under the name Harbour.  If you copy code from other
 * Harbour Project or Free Software Foundation releases into a copy of
 * Harbour, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for Harbour, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.
 *
 */


FUNCTION hb_ntp_GetTimeUTC( cServer, nPort, nTimeOut )

   LOCAL tTime := hb_SToT( "" )
   LOCAL hSocket, cBuffer

   IF HB_ISSTRING( cServer ) .AND. ! cServer == "" .AND. ;
      ! Empty( hSocket := hb_socketOpen( , HB_SOCKET_PT_DGRAM ) )
      cBuffer := hb_BChar( 8 ) + Replicate( hb_BChar( 0 ), 47 )
      IF hb_socketSendTo( hSocket, cBuffer,,, { HB_SOCKET_AF_INET, hb_socketResolveAddr( cServer ), hb_defaultValue( nPort, 123 ) } ) == hb_BLen( cBuffer )
         cBuffer := Space( 12 * 4 )
         IF hb_socketRecvFrom( hSocket, @cBuffer,,,, hb_defaultValue( nTimeOut, 10000 /* 10s */ ) ) == hb_BLen( cBuffer )
            tTime := hb_SToT( "19000101" ) + ;
               Bin2U( ntohl( hb_BSubStr( cBuffer, 10 * 4 + 1, 4 ) ) ) / 86400 + ;
               ( Bin2U( ntohl( hb_BSubStr( cBuffer, 11 * 4 + 1, 4 ) ) ) / ( 2 ^ 32 ) ) / 86400
         ENDIF
      ENDIF
      hb_socketClose( hSocket )
   ENDIF

   RETURN tTime

STATIC FUNCTION ntohl( c )

   IF hb_Version( HB_VERSION_ENDIANNESS ) == HB_VERSION_ENDIAN_LITTLE
      RETURN ;
         hb_BSubStr( c, 4, 1 ) + ;
         hb_BSubStr( c, 3, 1 ) + ;
         hb_BSubStr( c, 2, 1 ) + ;
         hb_BSubStr( c, 1, 1 )
   ENDIF

   RETURN c

STATIC FUNCTION Bin2U( c )

   LOCAL l := Bin2L( c )

   RETURN iif( l < 0, l + ( 2 ^ 32 ), l ) 
   

Code: Select all

*-------------------------------------------------------------------------
*-------------------------------------------------------------------------
*-------------------------------------------------------------------------

PROC MailCPE(cCorreo,nOperId,cDocumento)

LOCAL cSubject   := SIS_COMER + " - COMPROBANTE DE PAGO "+cDocumento
LOCAL aEnlaces   := {}
LOCAL cRespuesta := "ERROR: No se pudo enviar el correo a "+cCorreo
LOCAL cParametros:= ""
LOCAL nTrys      := 0
LOCAL cBody      := ""
LOCAL hJson      := { => }

   NubeFact_CPECons( "V" , nOperId , "generada" ) //<- consulto al PSE el estado del comprobante
   aEnlaces := GetEnlaces( cDocumento ) //<- extraigo los enlaces que proporciona el PSE para los documentos generados

   IF LEN(aEnlaces) > 0

      DELETE FILE ("sendmail.txt")

      hJson["SmtpServer"]  := "mail.corporacionemanuelfarma.com"
      hJson["SmtpPort"]    := 587 //con el puerto 465 no funciona
      hJson["EmailFrom"]   := "facturacion@corporacionemanuelfarma.com"
      hJson["EmailTo"]     := ALLTRIM(cCorreo)
      hJson["Subject"]     := cSubject
      hJson["Username"]    := "facturacion@corporacionemanuelfarma.com"
      hJson["Password"]    := "xxxxxxxxxx"
      hJson["Attachments"] := {}
      strfile( hb_jsonEncode( hJson , .t. ) , "sendmail.json" )

      cBody := ;
      "<html><body>"+;
      "<h1>Se emiti&oacute; el comprobante de pago electr&oacute;nico "+cDocumento+"</h1>"+;
      "<br />"+;
      "Puede descargarlo de los siguientes enlaces:<br />"+;
      "<br />"+;
      aEnlaces[1]+"<br /><br />"+;
      aEnlaces[2]+"<br />"+;
      REPL("<br />",8)+;
      SIS_COMER+"<br />"+;
      SIS_RUC+"<br />"+;
      "</body></html>"
      strfile( cBody , "sendbody.txt"  )

      IF FILE("sendmail.json") .AND. FILE("sendbody.txt")

         cParametros:= " sendmail.json sendbody.txt"

         ShellExecute( 0 , "open" , "SendMail.exe" , cParametros )
         DO WHILE .NOT. FILE("sendmail.txt")
            nTrys++
            IF nTrys > 5000000
               EXIT
            ENDIF
         ENDDO
         IF FILE("sendmail.txt")
            cRespuesta := hb_memoread("sendmail.txt")
         ENDIF

      ENDIF

      DELETE FILE ("sendmail.json")
      DELETE FILE ("sendbody.txt")

   ELSE

      cRespuesta := "Este documento no ha sido aceptado por Nubefact."

   ENDIF

RETURN(cRespuesta)


* ------------------------------------------------------------------------
* ------------------------------------------------------------------------
* ------------------------------------------------------------------------

FUNC GetEnlaces( cDocNum )

LOCAL aLinks    := {}
LOCAL aData     := {}
LOCAL cResp     := ""
LOCAL cRespFile := SYS_PSECNS + cDocNum + '_R' + '.json'

   IF FILE( cRespFile )
      cResp := hb_memoread( cRespFile )
      IF "enlace" $ cResp
         hb_jsondecode( cResp , @aData )
         aLinks := { aData["enlace"] , aData["enlace_del_pdf"] }
      ENDIF
   ENDIF

RETURN( aLinks )

Code: Select all

cTO = 'emailaddress@emailaddress.xxx'

@ 350,10 BUTTON Bt_SEND2;
	Caption 'Thunderbird';
	PICTURE 'MAIL' ;
	FONT 'Arial' SIZE 9		;
	HEIGHT 86 ;	 
	WIDTH  72 ;
	ACTION Thunderbird('BO', '', cLOCAL_FILE, '', '', cTO ) 




FUNCTION Thunderbird(cSOORT, cFAK_NR, cPDF_File, cFA_DATUM, cFA_TEBETDT, cTO)
/*****************************************************************************/
LOCAL cBAT, aFILES, cFILEX, A, cTABLE 
LOCAL cHTML, cTXT  

PUBLIC cZAKENKANTOOR  := 'zakenb@host.be'

aFILES := {}
AADD(aFILES , 'c:\Progra~1\Mozill~1\thunderbird.exe' )
AADD(aFILES , 'c:\Progra~1\Mozill~2\thunderbird.exe' )
AADD(aFILES , 'c:\Progra~2\Mozill~1\thunderbird.exe' )
AADD(aFILES , 'c:\Progra~2\Mozill~2\thunderbird.exe' )
cFILEX := ''
FOR A := 1 TO LEN(aFILES)
   IF FILE(aFILES [A])
      cFILEX := aFILES [A]
      cFILEX := STRTRAN(cFILEX, '.exe' , '')   
      EXIT
   ENDIF
NEXT

 
cHTML   := 'c:\zakenb\bo.html'
SET PRINTER TO &cHTML
SET PRINTER ON 
SET CONSOLE OFF
 
?'<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">'
?'<html>'
?'<head>'
?'<title>Some title</title>'
?'<meta name="Generator" content="zakenb">'
?'<meta name="Author" content="">'
?'<meta name="Keywords" content="">'
?'<meta name="Description" content="">'
?'</head>'
?'<body>'
?'Some messages<br>'
?'<br>'
?'Reagrds,<br><br>'
?'zakenb B.V.<br>'
?'Street 11 <br>'
?'1234 City<br><br>'
?'www.mysite.com     <br>'
?'Tel: 012- 34 56 78           <br>'
?'Fax: 012- 34 56 79           <br>'
?'<br><br>'
?'<b>zakenb@host.be</b><br>'
?'</body>'
?'</html>'
SET PRINTER OFF
SET PRINTER TO
SET CONSOLE ON



cBAT    := 'c:\zakenb\bo.bat'


cTXT     := cFILEX + " -compose " + '"' + "to='" + cTO + "',subject='Subject title ',format='html',body='bla',message='" + cHTML + "',attachment='" + cPDF_File + "'" + '"'
//        between item use a COMMA before and after and NO SPACES!
 

SET PRINTER TO &cBAT
SET PRINTER ON 
SET CONSOLE OFF
? cTXT
SET PRINTER OFF
SET PRINTER TO
SET CONSOLE ON
EXECUTE FILE cBAT 
RETURN

Code: Select all

@echo off
SET backup=%path%
set HB_WITH_OPENSSL=C:\OpenSSL-Win64\include
SET HMGPATH=c:\hmg.3.5
SET PATH=%HMGPATH%\harbour\bin;%HMGPATH%\mingw\bin;%PATH%

hbmk2 hbssl.hbp -i%hmgpath%\include
set path=%backup%
set backup=
pause

Code: Select all

#include "HMG.CH"

FUNCTION MAIN()
DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN
   FRASE='ESA MÁSCARA ES OK'
   LETRA='A'
   LARGO=LEN(FRASE)
   X=1
   Y=1
   DO WHILE LARGO>0
      PISO=SUBSTR(FRASE,X,1)		&& CADA LETRA
      POSI2='C'+ALLTRIM(STR(X))		&& LABEL
      IF PISO=LETRA
         IF X<25
            @ 86,X*50 LABEL &POSI2 VALUE PISO WIDTH 50 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD
          ELSE
            IF X=25
               @ 186,50 LABEL &POSI2 VALUE PISO WIDTH 50 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD
               Y=Y+1
             ELSE
               @ 186,Y*50 LABEL &POSI2 VALUE PISO WIDTH 50 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD
               Y=Y+1
            ENDIF
         ENDIF
       ELSE
         IF X>=25
            Y=Y+1
         ENDIF
      ENDIF
      X=X+1
      LARGO=LARGO-1
   ENDDO   
   ON KEY ESCAPE ACTION UNO.RELEASE
END WINDOW
UNO.MAXIMIZE
UNO.ACTIVATE
RETURN

Code: Select all

#include "HMG.CH"

FUNCTION MAIN()
DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN

//1
   LETRA='Á'
   IF LETRA=CHR(195)		// NUMBER IS SAME, WHY ?
      @ 80*1,250 LABEL A VALUE 'ESTO ES LETRA -A- CON TILDE ---> '+LETRA WIDTH 999 HEIGHT 50 FONT "TAHOMA" SIZE 24 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
   ENDIF

//2
   LETRA='É'
   IF LETRA=CHR(195)		// NUMBER IS SAME, WHY ?
      @ 80*2,250 LABEL E VALUE 'ESTO ES LETRA -E- CON TILDE ---> '+LETRA WIDTH 999 HEIGHT 50 FONT "TAHOMA" SIZE 24 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
   ENDIF

//3
   LETRA='Í'
   IF LETRA=CHR(195)		// NUMBER IS SAME, WHY ?
      @ 80*3,250 LABEL I VALUE 'ESTO ES LETRA -I- CON TILDE ---> '+LETRA WIDTH 999 HEIGHT 50 FONT "TAHOMA" SIZE 24 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
   ENDIF

//4
   LETRA='Ó'
   IF LETRA=CHR(195)		// NUMBER IS SAME, WHY ?
      @ 80*4,250 LABEL O VALUE 'ESTO ES LETRA -O- CON TILDE ---> '+LETRA WIDTH 999 HEIGHT 50 FONT "TAHOMA" SIZE 24 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
   ENDIF

//5
   LETRA='Ú'
   IF LETRA=CHR(195)		// NUMBER IS SAME, WHY ?
      @ 80*5,250 LABEL U VALUE 'ESTO ES LETRA -U- CON TILDE ---> '+LETRA WIDTH 999 HEIGHT 50 FONT "TAHOMA" SIZE 24 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
   ENDIF

   ON KEY ESCAPE ACTION UNO.RELEASE
END WINDOW

UNO.MAXIMIZE
UNO.ACTIVATE
RETURN

Code: Select all

#include "HMG.CH"
FUNCTION MAIN()
SET CODEPAGE TO UNICODE   //<----
SET LANGUAGE TO SPANISH   //<---

DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN

Code: Select all

#include "HMG.CH"

FUNCTION MAIN()
SET CODEPAGE TO UNICODE
SET LANGUAGE TO SPANISH

DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN

   FRASE='ESA MÁSCARA ES OK'
   LETRA='A'			// VOCAL SIN TILDE A BUSCAR EN LA FRASE Y MOSTRARLA

LETRA2='Ñ'		// comodín

   LARGO=LEN(FRASE)
   X=1
   Y=1
   DO WHILE LARGO>0
      LETT=SUBSTR(FRASE,X,1)		// CADA LETRA
      LABE='L'+ALLTRIM(STR(X))		// LABEL

      IF LETT=LETRA
         @ 99,X*50 LABEL &LABE VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
      ENDIF

      IF LETT=CHR(65)		// vocal sin tilde
         LETRA2='Á'		// forsa a buscar con tilde también
      ENDIF
      IF LETT=CHR(195) .AND. LETRA='A'
         @ 99,X*50 LABEL &LABE VALUE LETRA2 WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
      ENDIF

      X=X+1
      LARGO=LARGO-1
   ENDDO   
   ON KEY ESCAPE ACTION UNO.RELEASE
END WINDOW
UNO.MAXIMIZE
UNO.ACTIVATE
RETURN

Code: Select all

#include "HMG.CH"

FUNCTION MAIN()
SET CODEPAGE TO UNICODE
SET LANGUAGE TO SPANISH

DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN
   FRASE='ESA MÁSCARA CAUSA CÁNCER'
   LETRA='A'			// LETRA A BUSCAR EN LA FRASE Y MOSTRARLA

   LARGO=LEN(FRASE)
   X=1
   Y=1
   P=0
DO WHILE LARGO>0
   LETT=SUBSTR(FRASE,X,1)		// CADA LETRA
   LABE1='L'+ALLTRIM(STR(X))		// LABEL1
   LABE2='M'+ALLTRIM(STR(X))		// LABEL2
   IF P=0
      IF LETT=LETRA
         @ 99,X*50 LABEL &LABE1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
       ELSE				// PINTA LAS DEMÁS LETRAS
         @ 99,X*50 LABEL &LABE1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
      ENDIF
    ELSE				// POSICIÓN DESPUÉS DE LA LETRA CON TILDE
      IF LETT=LETRA
         @ 99,X*50 LABEL &LABE1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
       ELSE
         @ 99,X*50 LABEL &LABE1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
      ENDIF
      P=0
   ENDIF

   IF LETT=CHR(195) .AND. LETRA='A'
      P=1
      LETRA2='Á'
      @ 99,X*50 LABEL &LABE2 VALUE LETRA2 WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
   ENDIF
   X=X+1
   LARGO=LARGO-1
ENDDO   
ON KEY ESCAPE ACTION UNO.RELEASE

END WINDOW
UNO.MAXIMIZE
UNO.ACTIVATE
RETURN

Code: Select all

#include "HMG.CH"

FUNCTION MAIN()
SET CODEPAGE TO UNICODE
SET LANGUAGE TO SPANISH

DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN
   FRASE="ESA MÁSCARA CAUSA CÁNCER"
   LETRA='A'			// LETRA A BUSCAR EN LA FRASE Y MOSTRARLA

   LARGO=LEN(ALLTRIM(FRASE))
   X=1
   Y=1
DO WHILE LARGO>0
   LETT=SUBSTR(FRASE,X,1)		// CADA LETRA
   L1='L'+ALLTRIM(STR(X))		// LABEL PARA MOSTRAR TODAS LAS LETRAS MENOS LA Á (INCLUYE ESPACIOS)
   L2='M'+ALLTRIM(STR(X))		// LABEL PARA LLEVAR NUMERACIÓN DE X
 
   L3='N'+ALLTRIM(STR(Y))		// LABEL PARA A CON TILDE
   L4='O'+ALLTRIM(STR(Y))		// LABEL PARA LLEVAR NUMERACIÓN A LA PAR CON X

   NUMERO = ASC(LETT)			// PARA SABER EL # CHR

   IF LETT=CHR(195) .AND. LETRA='A'		// PINTA LAS Á
      LETRA2='Á'
      @ 099,Y*50 LABEL &L3 VALUE ALLTRIM(LETRA2) WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR GREEN BACKCOLOR {0,125,250}
      @ 200,Y*50 LABEL &L4 VALUE STR(X,2,0) WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 20 BOLD FONTCOLOR GREEN BACKCOLOR {0,125,250}
    ELSE
      IF LETT='A' .AND. NUMERO<>195		// PINTA LAS A
         @ 099,X*50 LABEL &L1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR YELLOW BACKCOLOR {0,125,250}
         @ 200,X*50 LABEL &L2 VALUE STR(X,2,0) WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 20 BOLD FONTCOLOR YELLOW BACKCOLOR {0,125,250}
       ELSE
         IF NUMERO=32		// ESPACIO EN BLANCO
            @ 099,X*50 LABEL &L1 VALUE '_' WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR BROWN BACKCOLOR {0,125,250}
            @ 200,X*50 LABEL &L2 VALUE STR(X,2,0) WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 20 BOLD FONTCOLOR BROWN BACKCOLOR {0,125,250}
          ELSE			// LAS DEMÁS LETRAS
            @ 099,X*50 LABEL &L1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
            @ 200,X*50 LABEL &L2 VALUE STR(X,2,0) WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 20 BOLD FONTCOLOR WHITE BACKCOLOR {0,125,250}
         ENDIF
      ENDIF
   ENDIF
   X=X+1
   Y=Y+1
   LARGO=LARGO-1
ENDDO   
ON KEY ESCAPE ACTION UNO.RELEASE
END WINDOW
UNO.MAXIMIZE
UNO.ACTIVATE
RETURN

Code: Select all

#include "HMG.CH"


FUNCTION MAIN()

SET CODEPAGE TO UNICODE
SET LANGUAGE TO SPANISH

DEFINE WINDOW UNO AT 0,0 WIDTH 0 HEIGHT 0 BACKCOLOR {0,125,250} NOCAPTION MAIN
   FRASE := "ESA MÁSCARA CAUSA CÁNCER"
   LETRA := { 'A', 'Á' } 			// LETRA A BUSCAR EN LA FRASE Y MOSTRARLA

   LARGO := hb_ULen(ALLTRIM(FRASE))
   X := 1
   Y := 1

DO WHILE LARGO > 0
   LETT := hb_USubStr(FRASE,X,1)		// CADA LETRA
   L1 := 'L'+ALLTRIM(STR(X))		// LABEL PARA MOSTRAR TODAS LAS LETRAS MENOS LA Á (INCLUYE ESPACIOS)
   L2 := 'M'+ALLTRIM(STR(X))		// LABEL PARA LLEVAR NUMERACIÓN DE X
 
   DO CASE
	CASE ASCAN ( LETRA, LETT ) = 2			//LETT = "Á"
		aColor := {   0 , 255 ,   0 }		//GREEN

	CASE ASCAN ( LETRA, LETT ) = 1			//LETT = "A"
		aColor := { 255 , 255 ,   0 }		//YELLOW

	CASE LETT = " "
		LETT := "_"
		aColor := { 128 ,  64 ,  64 }		//BROWN
	OTHER
		aColor := { 255 , 255 , 255 }		//WHITE
   ENDCASE

   @ 099,X*50 LABEL &L1 VALUE LETT WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 48 BOLD FONTCOLOR aColor BACKCOLOR {0,125,250}
   @ 200,X*50 LABEL &L2 VALUE STR(X,2,0) WIDTH 99 HEIGHT 70 FONT "TAHOMA" SIZE 20 BOLD FONTCOLOR aColor BACKCOLOR {0,125,250}

   X++
   Y++
   LARGO--

ENDDO   
ON KEY ESCAPE ACTION UNO.RELEASE
END WINDOW
UNO.MAXIMIZE
UNO.ACTIVATE
RETURN

Code: Select all

                Components versions: 
                -------------------- 
   
Harbour MiniGUI Extended Edition 24.04 (Release)  
   
Harbour 3.2.0dev (r2403071241)
   
Harbour Make (hbmk2) 3.2.0dev (r2024-03-07 12:41)
-------------------------------------------------