HMG 3.1.1

HMG Unicode versions 3.1.x related

Moderator: Rathinagiri

User avatar
danielmaximiliano
Posts: 1992
Joined: Fri Apr 09, 2010 4:53 pm
Location: Argentina
Has thanked: 25 times
Been thanked: 9 times
Contact:

Re: HMG 3.1.1

Post by danielmaximiliano » Fri Feb 15, 2013 1:13 am

Hola Polo : gracias por compartir el ejemplo .
intenta cuando te sea posible utilizar el boton señalado en la imagen para colocar codigo fuente en el.
HMGforum.jpg
HMGforum.jpg (51.02 KiB) Viewed 1816 times
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`.HMG : It's magic !
(¸.·``··*

Saludos / Regards
DaNiElMaXiMiLiAnO

Whatsapp / Telegrams To cel +54 011 690 26 142

Leopoldo Blancas
Posts: 317
Joined: Wed Nov 21, 2012 7:14 pm
Location: México

Post by Leopoldo Blancas » Fri Feb 15, 2013 1:22 am

Jajaja si, nunca lo he tocado... Y es que tenia tiempo de no usar esa rutina y escarve un buen rato y la encontre en un libro... de Clipper jijiji

Saludos
Polo

User avatar
CarlosRD
Posts: 63
Joined: Thu Jan 31, 2013 9:20 pm
Location: Orizaba, México

Post by CarlosRD » Fri Feb 15, 2013 1:23 am

Leopoldo Blancas wrote:Hola Carlos y DanielMaximiliano y todos los del Foro!!!

Aquí tengo una rutina que me ayuda mucho al Grabar Arrays a Ficheros y recuperarlos...
Espero que sea de su utilidad....

/ * * *
* SAVE_ARR.CH *
* Fichero de cabecera para grabar/restaurar arrays
*
*/
// En las siguientes macros fh es un handle de fichero
// Escribir elemento carácter:
// C<5 dígitos de longitudxvalor del carácter>
#define SAVE_CHAR(fh, cv) ;
FWrite(fh, "C" + Str(Len(cv), 5) + cv)
// Escribir elemento fecha: D<cadena de fecha>
#define SAVE_DATE(fh, dv) FWrite(fh, "D" + Dtoc(dv))
// Escribir elemento lógico: L<carácter T or F>
#define SAVE_LOG(fh, lv);
FWrite(fh, "L" + Iif(lv, "T", "F"))
// Escribir elemento numérico:
// N<longitud de 2 dígitos>
// <número formateado como una cadena>
#define SAVE_NUM(fh, nv) ;
FWrite(fh, "N" + Str(Len(Str(nv)),2) + ;
Str(nv))
// Escribir cabecera del array:
// A<longitud del array de 4 dígitos>
#define WRITE_AHD(fh, av) FWrite(fh, "A" + Str(Len(av), 4))
// Leer un tipo
#define GET_TYPE(fh) FReadStr(fh, 1)
// Leer tamaño del array
#define GET_AR_SIZE(fh) Val(FReadStr(fh, 4))
// Leer un elemento carácter
#define GET_CHAR(fh) FReadStr(fh, Val(FReadStr(fh, 5)))
// Leer un elemento de fecha
#define GET_DATE(fh) Ctod(FReadStr(fh, 8))
// Leer un elemento lógico
#define GET_LOG(fh) FReadStr(fh, 1) == "T"
// Leer un elemento numérico
#define GET_NUM(fh) Val(FReadStr(fh, Val(FReadStr(fh, 2))))









/ * * *
* SAVE_ARR.PRG *
* Fichero de programa que contiene las funciones SaveArray()
* y RestArray() para grabar y restaurar arrays a / desde
* disco
*/

#include "Save_arr.ch"

I * * *
* SaveArray(aArray, cFileName) *
* aArray[] - -Array a grabar
* cFileName - -Fichero en el que se grabará el array
*/
FUNCTION SaveArray(aArray, cFileName)
LOCAL fHandle := FCreate(cFileName)
SaveArr(fHandle, aArray)
FClose(fHandle)
RETURN NIL
STATIC FUNCTION SaveArr(fHandle, aArray)
LOCAL LenArray, ElemType, i
// Escribir la cabecera del array WRITE_AHD(fHandle, aArray) LenArray := Len(aArray)
// Escribir cada elemento en el array
FOR i := 1 TO LenArray
ElemType := ValType(aArray)

DO CASE
CASE ElemType == "A"
//A subarray, recurse ~EL
SaveArr(fHandle, aArray)
CASE ElemType == "B"
// Error fatal - no podemos escribir los code blocks ? "ERROR: NO SE PUEDE GRABAR UN CODE BLOCK
InKey(0)
CASE ElemType == "C"
// Grabar un elemento de tipo carácter SAVE_CHAR(fHandle, aArray)
CASE ElemType == "D"
// Grabar un elemento de tipo fecha SAVE_DATE(fHandle, aArray)
CASE ElemType == "L"
// Grabar un elemento de tipo lógico SAVE_LOG(fHandle, aArray)
CASE ElemType == "N"
// grabar un elemento de tipo numérico
SAVE_NUM(fHandle, aArray)
ENDCASE
NEXT
RETURN NIL




/ * * *
* RestArray(cFileName) *
* cFileName - -Fichero desde el que se recuperará el array
*/
FUNCTION RestArray(cFileName)
LOCAL aRestArr, fHandle := FOpen(cFileName)
GET_TYPE(fHandle)
aRestArr := RestArr(fHandle)
FClose(fHandle)
RETURN aRestArr

FUNCTION RestArr(fHandle)
LOCAL LenArray, i, ElemType, aArray
// Determinar el tamaño del array
LenArray := GET_AR_SIZE(fHandle)
aArray := Array(LenArray)
// Restaurar cada elemento
FOR i := 1 TO LenArray
// Determinar su tipo
ElemType := GET_TYPE(fHandle)
DO CASE
CASE ElemType == "A"
// Si se trata de otro array usamos recursividad
aArray := RestArr(fHandle)
CASE ElemType == "B"
// Error fatal - No se grabó
CASE ElemType == "C"
aArray := GET_CHAR(fHandle)

CASE ElemType == “D”
aArray := GET_DATE(fHandle)
CASE ElemType == “L”
aArray := GET_LOG(fHandle)
CASE ElemType == “N”
aArray[i] := GET_NUM(fHandle)
ENDCASE
NEXT
RETURN aArray

/*************************************************************************
*Tenemos que hacer dos ficheros con la información arriba descrita
*1.- Save_arr.ch // que va a ser un archivo de cabecera y
*2.- SAVE_ARR.PRG // que va a tener las funciones para grabar y restaurar arrays a disco.
*/

//////////////////////////////////////////////////////////////////////////////////////////////////////////////
*Y con solo poner en tu código:

#include <hmg.ch>
#include "Fileio.ch"
#include "Dbstruct.ch"
#include "SAVE_ARR.CH "

SaveArray(aMiArray,GuardaMiArray.txt) //Graba en el disco el fichero que contiene la información del array.
*y con:

aMiArray := RestArray(GuardaMiArray.txt) //Carga el array con los valores que guardo mi archivo *.txt

#include "SAVE_ARR.PRG "


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Espero que haya sido claro.

Saludos
Polo


Hola Polo:

apenas vi tu ejemplo, ya lo tengo guardado, mañana primero Dios con mas calma lo corro y te comento. no tengo ninguna duda en que será de gran utilidad para mi y la comunidad. GRACIAS por compartir.
Todo en el Nombre de Jesus / All in the name of Jesus
Carlos RD

User avatar
esgici
Posts: 4282
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Has thanked: 166 times
Been thanked: 61 times
Contact:

Post by esgici » Fri Feb 15, 2013 2:30 pm

This job should be more simple ;)

Please look at here and please give me your valuable comments ;)
Viva INTERNATIONAL HMG :D

Leopoldo Blancas
Posts: 317
Joined: Wed Nov 21, 2012 7:14 pm
Location: México

Post by Leopoldo Blancas » Sat Feb 16, 2013 4:58 pm

En verdad simple, sencillo y bueno...., en el caso de la pregunta de Carlos este ejemplo esta hecho a la medida,.... y con tu ejemplo se puede adaptar a cualquier array.... muy bien Esgici.
Polo
*----------------------------------------------------------------------------------------------------------------------------
In simple truth, simple and good ...., in the case of the question of Carlos This example is made ​​to order, .... and your example can be adapted to any array .... Esgici well.
Polo

User avatar
meneale
Posts: 51
Joined: Sat Jan 12, 2013 2:05 am
Location: Campinas -SP, Brasil

Post by meneale » Sun Feb 17, 2013 8:46 pm

:oops: Hmg's
I'm new in the Forum but i have a bad reply :(
The RichText Editor object does not support RTF code like the earlier versions of HMG when compiled into Unicode

HMG 3.0.45 BUILDED:
hmg-nunicode.jpg
Hmg 3.0.45
hmg-nunicode.jpg (46.58 KiB) Viewed 1710 times
HMG 3.1.1 BUILDED UTF-8/UNICODE
hmg-unicode.jpg
hmg 3.1.1 unicode
hmg-unicode.jpg (38.84 KiB) Viewed 1710 times
AMD Phenom II X6 1090T 3.2GHz (OverClock 3.9GHz) | Windows 8.1 Pro 64-bit
4GB DDR3 | GTX 550 Ti 1GB | MSI 880GMA-E35

User avatar
srvet_claudio
Posts: 1919
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Has thanked: 25 times
Been thanked: 95 times
Contact:

Post by srvet_claudio » Mon Mar 04, 2013 1:47 am

Hi All.
I attached a patch for source code of HMG.3.1.1

Best regards,
Claudio.

Code: Select all

Summary all of the changes made to the source code:
---------------------------------------------------

1) I set the compiler warnings to W2.

2) I fixed Browse control problem.

3) I fixed the problem in IMAGE property in COMBOBOX control.

4) I added functions HMG_LOWER() and HMG_UPPER() 
(see source\Unicode_Strings.PRG) for support LowerCase and UpperCase of 
strings in Unicode.

5) I added functions HMG_PADC(), HMG_PADL() and HMG_PADR() 
(see source\Unicode_Strings.PRG) for Unicode string padded.

6) I replaced in the source code: ANSI functions strings with UNICODE/ANSI functions strings equivalent:

UNICODE/ANSI            ANSI Only
------------            ---------
HMG_LEN()         <=>   LEN()
HMG_LOWER()       <=>   LOWER()
HMG_UPPER()       <=>   UPPER()
HMG_PADC()        <=>   PADC()
HMG_PADL()        <=>   PADL()
HMG_PADR()        <=>   PADR()

HB_USUBSTR()      <=>   SUBSTR()
HB_ULEFT()        <=>   LEFT()
HB_URIGHT()       <=>   RIGHT()
HB_UAT()          <=>   AT()
HB_UTF8RAT()      <=>   RAT()
HB_UTF8STUFF()    <=>   STUFF()
Attachments
HMG.3.1.1_SOURCE_patch(2013-03-03).rar
(560.54 KiB) Downloaded 173 times
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com

User avatar
danielmaximiliano
Posts: 1992
Joined: Fri Apr 09, 2010 4:53 pm
Location: Argentina
Has thanked: 25 times
Been thanked: 9 times
Contact:

Post by danielmaximiliano » Mon Mar 04, 2013 1:55 am

srvet_claudio wrote:Hi All.
I attached a patch for source code of HMG.3.1.1

Best regards,
Claudio.
Claudio como siempre gracias por el trabajo en HMG.
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`.HMG : It's magic !
(¸.·``··*

Saludos / Regards
DaNiElMaXiMiLiAnO

Whatsapp / Telegrams To cel +54 011 690 26 142

Leopoldo Blancas
Posts: 317
Joined: Wed Nov 21, 2012 7:14 pm
Location: México

Post by Leopoldo Blancas » Mon Mar 04, 2013 2:54 am

Gracias nuevamente... por ese interes en HMG... Felicidades.

Polo
*------------------------------------------------------------------------
Thanks again ... for that interest in HMG ... Congratulations.
Polo

User avatar
esgici
Posts: 4282
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Has thanked: 166 times
Been thanked: 61 times
Contact:

Post by esgici » Mon Mar 04, 2013 9:39 am

Hola Doc

Thanks you very much to your invaluable support to HMG :)

Saludos cordiales :D
Viva INTERNATIONAL HMG :D

Post Reply

Who is online

Users browsing this forum: No registered users and 1 guest