How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Topic Specific Tutorials and Tips.

Moderator: Rathinagiri

User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Rathinagiri »

Sure, with pleasure Esgici.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by esgici »

Rathinagiri wrote:Sure, with pleasure Esgici.
Thank you very much Mr. Rathinagiri :D

I want make more quotations from you;

would you give me a 'global' permit please :P

Best regards
Viva INTERNATIONAL HMG :D
User avatar
Rathinagiri
Posts: 5471
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Contact:

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Rathinagiri »

Why not Esgici. Go ahead.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by esgici »

Rathinagiri wrote:Why not Esgici. Go ahead.
Thank you Mr. Rathinagiri :)

It's here when you want to see.

Regards
Viva INTERNATIONAL HMG :D
Jeff Stone
Posts: 44
Joined: Fri Jun 20, 2014 8:41 pm

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Jeff Stone »

As a VFP user with several large applications, I have been faced with the dilemma of having to prepare for the day
when VFP will no longer function in Windows. Additionally, we have clients that occasionally ask us to develop
applications for them. Since these clients are typically large international financial organizations, applications
developed in VFP are no longer an option as the clients' internal system requirements will no longer accept
applications written in languages that are no longer actively supported. Finally, we are cautious about converting our
programs and want to be able to run in parallel for at least 6 months. As our applications may get enhanced monthly,
the ability to have a single set of .PRGs that could run on VFP and the new compiler would be preferable.

I translated some of our applications into VB and C#, but performance was noticeably slower when signicant
database operations were being performed. I also investigated Lianja, Alaska Xbase++ and others. Finally, I
came to Harbour and HMG. I have found the combination of these two open source programs have met our needs
best in terms of minimizing the effort required to adapt our VFP .PRGs, getting a similar look and feel, and
overall program performance. (Let me state here that our VFP applications are not heavily GUI dependent. Also,
our applications made minimal use of .DBC files which Harbour does not support.)

Below are notes that I put together converting our .PRGs to enable them to run in Harbour/HMG and VFP. They are not
comprehensive in terms of addressing all the issues that a VFP user might encounter, but I hope are helpful to others.
I have also tried to be as accurate in my statements as possible, but please accept that I may have misunderstood
certain aspects of Harbour and HMG; so, there may be errors. I hope that others on the board will correct these
errors, add additional notes, and improve any code I've provided below.

Below I sometimes show procedures/functions missing in Harbour to provide VFP equivalent functionality.
I did not write all of these procedures. Some were posted by Harbour User Group members, and I was able to use
them successfully in my testing. Unfortunately, I didn't note who created the original code, so please forgive me for
not giving those of you who wrote the procedures/functions explicit credit.

People can feel free to pull information from this post and put it elsewhere (VivaClipper, etc.), if deemed worthy.

Finally, thanks to everyone on this forum who has helped me get up to speed with HMG and Harbour.

--Jeff


Harbour and HMG Differences Worth Noting
========================================
Harbour is designed to operated on multiple platforms in addition to Windows. HMG is only for Windows.

Harbour and HMG are both Open Source development systems but they are independent. HMG incorporates Harbour into its
builds but as both Harbour and HMG are supported by helpful, busy individuals, there is a lag in HMG being updated
with the most recent Harbour nightly build. So, if you notice some issues with Harbour that are newly addressed,
there may be a lag in those issues being incorporated into HMG. It also seems that HMG does not have all of the
latest Harbour \contrib code. This may be because of certain compatibility issues, but I'm not sure.

While Harbour can be compiled with MinGW, MS Visual Studio, and others, HMG can only be compiled with MinGW. (?)



Harbour and VFP Differences/Observations
========================================
Below are differences noted between Harbour and VFP. Some of these differences can be addressed by
compiling with hbfoxpro.ch which is in the contrib\ portion of Harbour. This file uses the #translate/
#command preprocessor directives to substitute VFP syntax with Harbour equivalents. For simplicity,
I have pasted hbfoxpro.ch below after that are some of my #translate/#command additions:

From hbfoxpro.ch
----------------
/* messages in FP */
#xtranslate .<!msg!> => :<msg>


/* array declarations */
#xtranslate __FP_DIM( <exp> ) => <exp>
#xtranslate __FP_DIM( <!name!>( <dim,...> ) ) => <name>\[ <dim> \]

#command PUBLIC <var1> [, <varN> ] => ;
<@> PUBLIC __FP_DIM( <var1> ) [, __FP_DIM( <varN> ) ]
#command PRIVATE <var1> [, <varN> ] => ;
<@> PRIVATE __FP_DIM( <var1> ) [, __FP_DIM( <varN> ) ]
#command DIMENSIONS <!name1!>( <dim1,...> ) [, <!nameN!>( <dimN,...> ) ] => ;
PRIVATE <name1>\[ <dim1> \] [, <nameN>\[ <dimN> \] ]


/* workaround for problem with command using FIELDS keyword which can
wrongly translate FIELD->fieldname.
*/
#translate FIELD-><!name!> => _FIELD-><name>


/* commands using FIELDS clause which is not accepted by Clipper */
#command DISPLAY [FIELDS <v,...>] [<off:OFF>] ;
[<prn:TO PRINTER>] [TO FILE <(f)>] ;
[FOR <for>] [WHILE <while>] [NEXT <next>] ;
[RECORD <rec>] [<rest:REST>] [<all:ALL>] => ;
__dbList( <.off.>, { <{v}> }, <.all.>, ;
<{for}>, <{while}>, <next>, ;
<rec>, <.rest.>, <.prn.>, <(f)> )


/* commands and standard functions with alias */
#command SEEK <exp> [<soft: SOFTSEEK>] [<last: LAST>] ;
[TAG <tag>] [IN <wa>] => ;
__fox_Seek( <exp>, iif( <.soft.>, .T., NIL ), ;
iif( <.last.>, .T., NIL ), ;
<(wa)>, <(tag)> )
#command SET FILTER TO <exp> IN <wa> [NOOPTIMIZE] => ;
<wa>->( DbSetFilter( <{exp}>, <"exp"> ) )
#command SKIP [<n>] IN <wa> => <wa>->( DbSkip( <n> ) )
#command UNLOCK IN <wa> => <wa>->( DbUnlock() )
#command GO TOP IN <wa> => <wa>->( DbGoTop() )
#command GO BOTTOM IN <wa> => <wa>->( DbGoBottom() )
#command GOTO <nRec> IN <wa> => <wa>->( DbGoTo( <nRec> ) )

#xtranslate SEEK( <x>, <wa> ) => (<wa>)->( DbSeek( <x> ) )
#xtranslate RECCOUNT( <wa> ) => (<wa>)->( RecCount() )
#xtranslate RECSIZE( <wa> ) => (<wa>)->( RecSize() )
#xtranslate FCOUNT( <wa> ) => (<wa>)->( FCount() )
#xtranslate RECNO( <wa> ) => (<wa>)->( RecNo() )
#xtranslate RLOCK( <wa> ) => (<wa>)->( Rlock() )

#xtranslate USED( <wa> ) => __fox_Used( <wa> )


/* other commands */
#command SCAN [FOR <for>] [WHILE <while>] [NEXT <next>] ;
[RECORD <rec>] [<rest:REST>] [ALL] [NOOPTIMIZE] => ;
__dbLocate( <{for}>, <{while}>, <next>, <rec>, <.rest.> ) ;;
WHILE Found()
#command ENDSCAN => __dbContinue(); ENDDO

#command EJECT PAGE => __Eject()
#command FLUSH => DbCommitAll()
#command REGIONAL [<defs,...>] => LOCAL <defs>


Some of my #translate/#command additions
-----------------------------------------
#translate .NULL. => NIL
#translate WshShell.Run => WshShell:Run
#translate CreateObject("WScript.Shell") => win_OleCreateObject("WScript.Shell")
#translate GETE(<cString>) => GETENV(<cString>)
#translate SET CPDIALOG OFF =>
#translate SHOW WINDOW <cstring> =>
#translate RELEASE WINDOW <cstring> =>
#translate SET COMPATIBLE ON =>
#translate THIS. => ::
#translate SYS(5) => diskname()+":\"
#translate RTRIM(SYS(5)+SYS(2003)) => ALLTRIM(DISKNAME()+":\"+CURDIR())
#translate cd (<cstring>) => hbr_chgdir(<cstring>)
#translate parameters() => pcount()
#translate PROGRAM() => PROCNAME()
#translate PROGRAM( <x> ) => PROCNAME( <x> )
#translate LINENO() => PROCLINE()
*#translate FCLOSE(<x>) => =FCLOSE(<x>)
#translate RECCOUNT() => LASTREC()
**NOTE: Harbour displays one less space than VFP when the transform() function is called with
** a picture display such as "@( 99,999,999,999.99" or "@( 9,999,999,999.99"
** which in Harbour need to be "@( 999,999,999,999.99" and "@( 99,999,999,999.99" respectively to display the same
** #translate directives cannot be used to correct this issue as the directives will
** either effect themselves or the results. So, we had to declares these separately using #IFNDEF
**
** Sometimes Harbour will report that a function or procedure .PRG cannot be opened and is assumed to be external
** when the function or procedure is contained in a different .PRG file. This occurs when the function/procedure
** in question is called with "do function with..." syntax. The error disappears if the function/procedure is called
** in the function format "function()"

//NOTE: Preprocessor translates strings delimited with aprostrophies to strings delimited with quotes!
#translate getfile("CSV:csv", <cstring,...>) => getfile({{"CSV","*.csv"}}, <cstring>)
#translate getfile(<cstring1>, <cstring2>, <cstring3>, 0, <cstring4>) => getfile(<cstring1>, <cstring4>, '', .f., .t.)
#command append from (<cstring>) type csv => append_from_csv(<cstring>)
#command append from (<cstring>) csv => append_from_csv(<cstring>)
#command dimension <arraynme>(<arrsize>) => <arraynme> = array(<arrsize>)
#command wait window [<msg>] timeout <xtime> => eti_timeout(<xtime>)
#command wait timeout <xtime> => eti_timeout(<xtime>)
#command Wait Window [<cmsg>] at <coords> Nowait => Wait Window <cmsg> NoWait
#xtranslate WaitWindow (<xlist, ...>) timeout <millisecs> => eti_timeout(<millisecs>)
#xtranslate WaitWindow ( <cmsg>, .F.) at <top>, <left> Nowait => WaitWindow(<cmsg>, .T.)
//NOTE: Preprocessor can translates messagebox to messageboxw
#xcommand messagebox(<cmsg>) => eti_msgbox(<cmsg>)
#xcommand messageboxw(<cmsg>) => eti_msgbox(<cmsg>)
#xcommand messageboxw(<cmsg>, <ctitle>) => eti_msgbox(<cmsg>, <ctitle>)
#command open database (<cmsg>) =>
#command close databases =>
#xcommand if used(<filename>) => if select(<filename>) > 0
#xcommand if .not. used(<filename>) => if select(<filename>) <= 0
#translate &xcmd => (xcmd) &&VFP cannot execute (xcmd) and Harbour cannot execute &xcmd

Harbour requires the use of brackets with arrays whereas VFP also allows parentheses.

Harbour seems to have an issue with .PRG files that contain multiple Procedures/Functions but are named
for the top Procedure/Function in the file which is naturally missing the Procedure/Function declaration
statement. This will result in a link error that says there are multiple definitions of that top
Procedure/Function. Rename the PRG and give the top Procedure/Function a proper declaration statement to
resolve the issue.

A related Harbour issue is you may get a build error that states Harbour:
Cannot open XXXXXXX.prg, assumed external
where xxxxxxx is the top Procedure/Function of one of the renamed .PRGs. This seems to occur if the
Procedure/Function is called with the DO With command. Changing the procedure call from "DO" style to
function style seems tocorrect this problem; e.g.,
DO Load_Data with "loans.csv"
to
Load_Data("loans.csv")

Harbour does not have the EXECSCRIPT() function. Below is an equivalent created procedure; however, the use of
this function uses the Harbour compiler which is GPL. This means if you use the below EXECSCRIPT(), you
have to make your code open source.

#IFDEF HBR
Procedure Execscript
parameter xCode
local CONTENT, HANDLE_HRB, PRG, HRBCODE, EOL
PRG := "proc P()" + crlf+;
xCode + crlf+;
"return"
HRBCODE := hb_compileFromBuf( PRG, "harbour", "\n")
hb_hrbRun(HRBCODE)
return
#ENDIF

Harbour does not seem to have an equivalent to VFP ALINES(). For Harbour users who are interested, Alines()
parses a char field or memo field to an array. I have not had the time to create a Harbour equivalent
function yet, nor have I found coding for one.

I don't think Harbour allows SQL queries against DBF files. However, you can create
functions to accomplish many of the same tasks that you would want to accomplish with SQL.
Below is code to enable you to add a field to a .DBF:
Function Add_Field(laliasname, newfield, fldtype, fldlen, flddec)
local a, x
x = Ascan(::aFaliases, upper(laliasname))
if x = 0
***report error that laliasname wasn't found
endif
select (laliasname)
a := dbStruct()
close (laliasname)
aadd( a, {newfield, fldtype, fldlen, flddec} )
dbCreate( "newDbf", a, , .T. )
APPEND FROM (::aFnames[x])
close newdbf
Ferase( ::aFnames[x] )
Frename( "newDbf.dbf", (::aFnames[x]) )
select 0
use (::aFnames[x]) alias (::aFaliases[x])
return

Harbour has no COPY TO ARRAY command, so below is a routine you can use to populate an array
with DBF field data:

**routine assumes field to list is in current work area dbf
PROCEDURE Copy_To_Array(FieldName, aField)
Local x
Asize(aField, Reccount())
For x = 1 to Reccount()
aField[x] = (FieldName)
Next
Return

**Sample call
Local aField[1]
Copy_To_Array("ID_Code", @aField)

While Harbour's COPY TO command can create a delimited file, it can not create a .CSV file which
is a delimited file with a header record listing the fields. Below is a routine to create a
.CSV file in Harbour
**routine to create a csv file for HBR
procedure make_csv()
parameter csvfilename
local x, xhdr, xtemp, WshShell
xtemp = "temp1.dat"
xhdr = ""
FOR x := 1 to FCOUNT()
xhdr = xhdr + '"'+rtrim(FieldName(x))+'",'
NEXT
fhandle = fcreate(xtemp, 0)
if fhandle < 0
eti_msgbox("Error creating error file: "+ xtemp)
wait
quit
endif
writelen = fwrite(fhandle, xhdr)
if writelen <> len(xhdr)
eti_msgbox("Error writing to "+ xtemp)
quit
endif
fclose(fhandle)
copy to temp2.dat delimited
WshShell = win_OleCreateObject("WScript.Shell")
run_command = 'copy temp1.dat + temp2.dat '+csvfilename+' & del temp1.dat & del temp2.dat & exit'
WshShell:Run("cmd /K "+run_command, 0, 1)
return


Similarly, Harbour does not enable appending from a .CSV file. Below is a procedure to enable
appending from a .CSV file:
***routine to append from a CSV file for HBR
procedure append_from_csv()
parameter csvfile
local curr_rec
curr_rec = reccount()
append from &csvfile delimited
go curr_rec + 1
delete next 1
return


When appending one DBF to another, VFP will automatically convert fields with the same name
that have different field types. HBR does not. Below is code and an example created by Zoran Sibinovic
to handle this issue:
#command APPCONV [FROM <(f)>] [FIELDS <fields,...>] [FOR <for>] [VIA <rdd>] [EMPTYDEST <empty>] => ;
__dbmyapp( <(f)>, { <(fields)> }, <{for}>, <rdd>, <.empty.> )

#include "common.ch"

****************
PROCEDURE MAIN()

SET EXACT ON
SET DATE GERM
SET CENT ON

?time()

USE arhiva1 NEW

APPCONV FROM arhiva FIELDS objasn,ime,jedinica,za_mesec EMPTYDEST .T.

?time()
wait

*********************************************
PROCEDURE __dbmyapp(cBaseOld, aFields, bFor, rdd, empty )
Local aBaseOld, aBaseNew, aFieldsDiff:={}, mSelectOld, mSelectNew, i, aFieldsOk:={}, aTemp
Local aTempNew:={}, aTempOld:={}, SelNew, SelOld, nOrder:=INDEXORD(), nCountOld:=0, nCountNew

DEFAULT empty TO .f.

AEVAL(aFields,{|aVal,nIndex| aFields[nIndex] := UPPER(aFields[nIndex]) })
aFields:=IF(EMPTY(aFields),nil,aFields)

mSelectNew:=SELECT()
aBaseNew:=DBSTRUCT()
IF empty = .t. ; ZAP ; ENDIF
nCountNew=LASTREC()

DBUSEAREA( .t.,rdd, (cBaseOld),,.t.,.t.)
IF !HB_ISNIL(bFor)
DBEVAL({|| nCountOld++ },bfor )
ELSE
nCountOld:=LASTREC()
ENDIF

mSelectOld:=SELECT()
aBaseOld:=DBSTRUCT()

** shrink the arrays if aFields<>nil
IF !HB_ISNIL(aFields)
aTemp:={}
AEVAL(aBaseNew,{|aVal,nIndex| IF(ASCAN(aFields,aBaseNew[nIndex,1])<>0,AADD(aTemp,aBaseNew[nIndex]),"") })
aBaseNew:=aTemp

aTemp:={}
AEVAL(aBaseOld,{|aVal,nIndex| IF(ASCAN(aFields,aBaseOld[nIndex,1])<>0,AADD(aTemp,aBaseOld[nIndex]),"") })
aBaseOld:=aTemp
ENDIF

** find where the fields exist and of what type they are
FOR i = 1 TO LEN(aBaseOld)
IF (nPos:=ASCAN(aBaseNew,{ |x| x[1] == aBaseOld[i,1] }))<>0
AADD(aTempNew,aBaseNew[nPos]) // exist in both
AADD(aTempOld,aBaseOld) // exist in both
ENDIF
NEXT

aBaseNew:=atempNew
aBaseOld:=atempOld

FOR i = 1 TO LEN(aBaseOld)
IF ( nPos:=ASCAN( aBaseNew,{ |x| x[1] == aBaseOld[i,1] } ) ) <> 0 .AND. aBaseOld[i,2] <> aBaseNew[nPos,2]
AADD(aFieldsDiff,{ aBaseOld[i,1],aBaseOld[i,2]+aBaseNew[nPos,2],aBaseOld[i,3],aBaseOld[i,4] } ) // fields of different type
ELSE
AADD(aFieldsOk,{ aBaseOld[i,1] } ) // fields of same type
ENDIF
NEXT
aFieldsOk:=IF(EMPTY(aFieldsOk),nil,aFieldsOk)

*******************
CLOSE (mSelectOld)
SELECT (mSelectNew)
DBSETORDER(0)

IF EMPTY(aFieldsDiff)
__dbApp( cBaseOld, aFieldsOk, bFor,,,,,rdd )
DBSETORDER(nOrder)
RETURN
ENDIF

IF !HB_ISNIL(aFieldsOk)
__dbapp( cBaseOld, aFieldsOk, bFor,,,,,rdd )
ELSE
DO WHILE nCountOld--<>0 ; DBAPPEND() ; ENDDO
ENDIF

IF LASTREC()=nCountNew ; DBSETORDER(nOrder) ; RETURN ; ENDIF
DBGOTO(nCountNew+1)

DBUSEAREA( .t.,rdd, (cBaseOld),,.t.,.t.)
mSelectOld:=SELECT()
DBSETORDER(0)
IF !HB_ISNIL(bFor) ; DBSETFILTER(bFor) ; ENDIF
DBGOTOP()

DO WHILE !EOF()
FOR i = 1 TO LEN(aFieldsDiff)
xField=aFieldsDiff[i,1]
(mSelectNew)->&xField:=DOCONVERT(aFieldsDiff[i,1],aFieldsDiff[i,2],aFieldsDiff[i,3],aFieldsDiff[i,4])
NEXT
DBSKIP()
(mSelectNew)->(DBSKIP())
ENDDO

DBCLOSEAREA()

SELECT (mSelectNew)
DBSETORDER(nOrder)

*******************
FUNCTION DOCONVERT( cName, cTypeTo, nLength, nDecimals )

Local xValue := &cName

DO CASE

CASE cTypeTo = "CN" ; xValue = VAL( xValue )
CASE cTypeTo = "CD" ; xValue = CTOD( ALLTRIM( xValue ) )
CASE cTypeTo = "CL" ; xValue = IF( LEFT( xValue,1 ) $ "1Tt",.t.,.f. )
CASE cTypeTo = "CM" ; xValue = ALLTRIM( xValue )

CASE cTypeTo = "NC" ; xValue = STR( xValue, nLength, nDecimals )
CASE cTypeTo = "ND" ; xValue = DTOC("")
CASE cTypeTo = "NL" .AND. LEN(xValue)=1 ; xValue = IF( xValue = 1,.t.,.f. )
CASE cTypeTo = "NL" ; xValue = .f.
CASE cTypeTo = "NM" ; xValue = ALLTRIM( STR( xValue, nLength, nDecimals ) )

CASE cTypeTo $ "DC DM" ; xValue = DTOC( xValue )
CASE cTypeTo $ "DN DL" ; xValue = 0

CASE cTypeTo $ "LC LM" ; xValue = IF( xValue, "T", "F" )
CASE cTypeTo = "LN" ; xValue = IF( xValue, 1, 0 )
CASE cTypeTo = "LD" ; xValue = DTOC( "" )

CASE cTypeTo = "MC" ; xValue = ALLTRIM( xValue )
CASE cTypeTo = "MN" ; xValue = VAL( ALLTRIM( xValue ) )
CASE cTypeTo = "MD" ; xValue = CTOD( ALLTRIM( xValue ) )
CASE cTypeTo = "ML" ; xValue = IF( LEFT( xValue,1 ) $ "1Tt",.t.,.f. )

ENDCASE

RETURN xValue
****end APPCONV relate code from Zoran Sibinovic
************************************************************************************************************
************************************************************************************************************

Harbour did not seem to process the change directory "CD" command in the same manner as VFP.
Here is a routine to change directory equivalent to VFP CD command. Used in conjunction with the
"#translate cd (<cstring>) => hbr_chgdir(<cstring>)" preprocessor command, you don't have to change
your code:

procedure hbr_chgdir
parameter newdir
result := dirchange(rtrim(right(padr(newdir,50),48)))
if result != 0
? "Failed to change directory to", newdir
quit
endif
diskchange(left(newdir,2))
return


HMG and VFP Differences/Observations
====================================
It would be unrealistic to expect HMG to be able to read/convert VFP .SCX files. However, I believe that
it is possible to create a set of functions/procedures to do some of the conversion where VFP and HMG have
the same type of screen objects. While I have not created those functions/procedures, there are some steps
that I have figured out to simplify the conversion. The first step is to convert the .SCX file into a
.PRG file:
From the main VFP IDE menu:
-Tools --> Class Browser --if nothing comes up then do:
Tools --> Component Gallery
-Click on the Class Browser Icon on the Component Gallery form
-Click Open (the yellow folder icon).
-From the Files of type drop-down, choose Form.
-Select the form you wish to open.
-In the class browser, click View Class Code (fourth icon from the left).
-You can copy and paste this into a .PRG or other text file which can then be converted for HMG

Like VFP, the HMG IDE allows you to design a window form with objects. The HMG IDE will put the results of your design
into a .FMG file which is functionally like a .PRG file. You could add comments, procedures and functions to the
.FMG file; however, it is not recommended as modifying form with HMG IDE deletes comments, procedures and functions; so,
put procedures and functions into their own .PRG file.

Check boxes seem to align and size best with height and width are both 13.

I think VFP has the default Form Font and Font Size listed under Options/Debug/Environment:Foxpro Frame:Font.
I am not sure where the default HMG font and size are set.

Currently, in HMG, when you "DO FORM", HMG apparently #includes the form into the calling .PRG. So, if you have an
error in your form construction that causes a runtime error, the stack display of the runtime error does
not list the form. Instead, the stack display lists the procedure that called the form but rather than showing the
line number where that procedure calls the problematic form, it shows the last line number of the form object that
is causing the problem.

HMG does not have an UNLOAD event. Use the RELEASE method instead.

HMG GRIDs do not naturally display logical fields as CHECKBOXs. However, there is a way to make grids
work the same way at:
viewtopic.php?f=24&t=3583&p=32962&hilit ... cia#p32962

While a Listbox in VFP can list the contents of a DBF field, HMG's Listbox only lists the contents of
an array. Since HMG/Harbour has no COPY TO ARRAY command, use the Copy_To_Array Procedure listed above
to populate an array with DBF field data

When you look at HMG TEXTBOX and other object Events, you may notice that CLICK, DBLCLICK Events, etc.
are missing. Don't worry. A neat feature has been added to HMG that allows you to create/define such
Events using code similar to:
CREATE EVENT PROCNAME Textbox_Name_DBLCLICK() HWND Window_Name.Textbox_Name.HANDLE STOREINDEX nIndex
EventProcessAllHookMessage ( nIndex, .T. )
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by esgici »

Hi Jeff

Thank you for this valuable article and information included. As you state this will be helpful for too many people preliminary VFP users.
And separate thanks to allowing borrow.
... I also investigated Lianja, Alaska Xbase++ and others. Finally, I came to Harbour and HMG. I have found the combination of these two open source programs have met our needs best in terms of minimizing the effort required to adapt our VFP .PRGs, getting a similar look and feel, and overall program performance.
This is important for Harbour + HMG performance noticed as a expert view of point.
... I hope that others on the board will correct these errors, add additional notes, and improve any code I've provided below.
I have some first look considerations and I hope these will be helpful:
... It also seems that HMG does not have all of the latest Harbour \contrib code. This may be because of certain compatibility issues, but I'm not sure.
IMHO reason is : HMG include only part of Harbour necessary for build process of HMG based application / program and HMG libs. Most of Harbour package components (including \contrib section) remain intact and not change generally while new release. And including that sections in HMG package will grown up setup file considerably.
... While Harbour can be compiled with MinGW, MS Visual Studio, and others, HMG can only be compiled with MinGW. (?)
This is correct HMG official only. HMG extended accepts Borland C++ (most often used), MinGW, Open Watcom or Pelles C compilers.
... Harbour seems to have an issue with .PRG files that contain multiple Procedures/Functions but are named
for the top Procedure/Function in the file which is naturally missing the Procedure/Function declaration
statement.
...
A related Harbour issue is you may get a build error that states Harbour: Cannot open XXXXXXX.prg, assumed external ...
This is one of biggest handicap while migration to Harbour; not only from VFP but from Clipper too. Thank to clarify and solution.
Harbour does not seem to have an equivalent to VFP ALINES().
I'm not sure, but it seem [x]Harbour equivalent may be HB_ATokens()
I don't think Harbour allows SQL queries against DBF files. ...
Could you clarify please "aFaliases" and "::aFaliases" :?
Harbour has no COPY TO ARRAY command, ...
SCATTER and GATHER functions of VFP successfully converted to Harbour by our friend Santy (Oleksandr Antypenko); will be easily translate to COPY TO ARRAY and APPEND FROM ARRAY commands.
While Harbour's COPY TO command can create a delimited file, it can not create a .CSV file which
is a delimited file with a header record listing the fields.

Not deeply tested but AFAIK using .CSV ( Comma Separated Value) files is possible within COPY TO and APPEND FROM commands via

Code: Select all

[SDF | DELIMITED [WITH BLANK | <xcDelimiter>]
clause; such as

Code: Select all

DELIMITED  WITH "," 
I think VFP has the default Form Font and Font Size listed under Options/Debug/Environment:Foxpro Frame:Font.
I am not sure where the default HMG font and size are set.

As far as I observe default values (set internally) of font info in HMG is : Arial, 9; other value are .F. or depends to other global settings. Ability of setting default font info for both .prg and .fmg; especially in IDE for .fmg's will be too much useful.
HMG GRIDs do not naturally display logical fields as CHECKBOXs.

GRID control allow CHECKBOXs via COLUMNCONTROLS <Control Definition Array> sentence.
While a Listbox in VFP can list the contents of a DBF field, HMG's Listbox only lists the contents of
an array.

See above SCATTER function.

Again, many thanks to your dedication.

Regards
Viva INTERNATIONAL HMG :D
Jeff Stone
Posts: 44
Joined: Fri Jun 20, 2014 8:41 pm

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Jeff Stone »

Hi Esgici,

Thanks for the additional comments.

One thing was clarified for me by folks in the Harbour Users Group and that relates to the Preprocessor command:
#translate &xcmd => (xcmd) &&VFP cannot execute (xcmd) and Harbour cannot execute &xcmd
I was using it because I had the following VFP code lines:
xcmd = "seek temp->"+tmp_loan_id
&xcmd
However, the PP command will not make this command work correctly in Harbour. So, I had to change the code lines to:
xcmd = "seek "+"temp->"+tmp_loan_id
&xcmd
and then add the following PP command:
#translate "seek "<seekstr> => "dbseek(<seekstr>)"
But, please note that because DBSEEK part of a string, the Harbour compiler will not link in DBSEEK() to the executable unless there is an actual DBSEEK() command somewhere else in the code.

Przemek in the Harbour users also pointed out that some of my PP commands are not needed; however, I think they may be needed in HMG because the Contrib files aren't the same. Anyway, if they are helpful for anyone, his comments are here:
https://groups.google.com/forum/#!topic ... stuMICerLY

Regards,

Jeff
Jeff Stone
Posts: 44
Joined: Fri Jun 20, 2014 8:41 pm

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Jeff Stone »

Hi Everyone,
I recently came across the attached .PRG at https://github.com/VFPX/AlternateSCCText. SccTextX.prg is designed to be run in VFP v9.x. Among other things it can convert .SCX files (form files for those not familiar with VFP) to text files which will contain all of the form settings needed to then be able to create an equivalent .FMG/.PRG file in HMG. I think it would be possible to programmatically convert the text file values to HMG should someone feel motivated to do so.

SccTextx.prg is invoked like: DO SccTextx WITH "Form1.SCX"

I hope this is useful to some former VFP users.

Regards,

Jeff
Attachments
AlternateSCCText-master.zip
(16.83 KiB) Downloaded 228 times
Red2
Posts: 271
Joined: Sat May 18, 2019 2:11 pm
DBs Used: Visual FoxPro, FoxPro
Location: United States of America

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Red2 »

Thank you Jeff,

I am new to HMG but with years in VFP. This should be quite useful to me so I appreciate your sharing this. (I was not previously aware of this work).

Thanks again,

Red2
Jeff Stone
Posts: 44
Joined: Fri Jun 20, 2014 8:41 pm

Re: How To Help Clipper & Foxpro Users Catch Harbour-HMG ASAP!

Post by Jeff Stone »

Hi Red2,

Happy to be helpful as I have experienced the effort required to transition programs to Harbour. FWIW, Harbour lacks copy to/append from functionality for CSV files. I posted code here: viewtopic.php?f=24&t=1615 to do these actions.

You may also find it helpful to look at posts on the Harbour Users Group on Google to learn about Harbour/VFP differences, creating a .DLL, working with an external .DLL, etc. There is an include file hbfoxpro.ch that is helpful for VFP users. I noted some additions that I would add it it here: https://groups.google.com/forum/#!searc ... 48VmkvAQAJ which uses Harbour's preprocessor. You should get familiar with the preprocessor directives. (Also, note that not all of my code was correct, so read the comments from others that followed my post.) This string of posts may also be helpful viewtopic.php?f=5&t=4483&p=42739&hilit= ... ess#p42739.

Regards,

Jeff
Post Reply