Latest Developments in Harbour by Viktor Szakáts

CCH: As posted in the Guest Book by Viktor

Hi All,

I’ve updated the unified release to the latest Harbour version;

www.syenar.hu/harbour/harbour-11-win-20090530.7z (36MB)
www.syenar.hu/harbour/harbour-11-win-20090530.exe (38MB)
Installed size; 167MB (37MB - 250MB)

Changes since previous release;
- Harbour updated to r11179 (from r10819)
- Full and now standalone ’examples’
- ’tests’ with subdirs included.
- No longer included pocc/pocc64/poccarm libs.
- QT updated to 4.5.1
- MinGW updated to 4.4.0

The default installation will install MinGW compiler + x86 static and
shared libs, MSVC and BCC x86 libs and examples.

Options; x86 shared tools, x64 shared tools, MinGW x64 and WinCE-ARM libs,
MSVC x64 libs, Open Watcom x86 libs, shared x64/WinCE-ARM libs.

Usage;
1) install/unpack to any directory (C;\harbour-11)
2) go to bin dir (optional if you specify path for hbmk2)
3) For x86 executable type; ’hbmk2 ../tests/hello.prg’
4) For x64 executable type; ’hbmk2 ../tests/hello.prg -comp=mingw64’
5) For WinCE/ARM executable type; ’hbmk2 ../tests/hello.prg -comp=mingwarm’
(or just; ’hbmk2 ../tests/hello.prg -arch=wce’)

Tools/libs used to create the package;
MinGW 4.4.0, MinGW64 4.4.0, MinGWCE 4.1.0, BCC 5.5.1, Open Watcom 1.8,
MSVC 2008 SP1, ace 9.10, allegro 4.2.2, blat 2.6.2, libcurl 7.19.3,
firebird 2.1.1,
freeimage 3.11.0, gd 2.0.34, mysql 5.0.67, openssl 0.9.8j, pgsql 8.3.3, qt 4.5.1

This release is very close to RC1.

Brgds,
Viktor

Exporting DBF to MySQL

CCH : Have you ever wondered whether we can export our DBFs to MySQL ?
Well Sudip with the help of Rathinagiri (owner of HMG Forum) came out with this working version of DBF2MYSQL using Harbour+HMG as built by HMG IDE. BTW, this working prg also clearly demonstrates how we can connect to MySQL via Harbor + HMG.

BTW, the original codes for connecting to MySQL may have come from Mitja Podgornik





#Include "MiniGui.ch"
#include "DbStruct.ch"


Procedure Main()
Private Dbo := Nil
Private cHostName:= "localhost"
Private cUser:= "root"
Private cPassWord:= ""
Private cDatabase:= ""
Private cDbf:= ""
Private cTable:= ""
Private lOpened := .f.
Private lLogin:= .F.

DEFINE WINDOW frmMain ;
AT 5,5 ;
WIDTH 640 ;
HEIGHT 480;
TITLE "DBF To 'New' MySql Table (Created with help from Rathinagiri)" ;
MAIN ;
NOSIZE ;
ON INIT MySQL_Login() ;
ON RELEASE MySQL_Logout()


@ 30, 30 label lblDatabase value "Database:" ;
width 100
@ 30, 100 textbox txtDatabase ;
width 150

@ 30, 300 listbox lstDatabase width 200 height 200 ;
on dblclick { frmMain.txtDatabase.value := frmMain.lstDatabase.item(frmMain.lstDatabase.value)}


@ 200, 100 button cmdSelectDbf caption "Select &Dbf" width 150 ;
on click SelectDbf()

@ 240, 100 label lblDbf value "" width 150

@ 280, 100 button cmdExport caption "&Export to MySql" width 150 ;
on click ExportToMySql()

@ 350, 100 PROGRESSBAR pgbExport ;
VALUE 0 ;
RANGE 0 , 100 ;
WIDTH 300 ;
HEIGHT 26 ;


DEFINE STATUSBAR
STATUSITEM " "
END STATUSBAR

DEFINE MAIN MENU
POPUP "&File"
Item "E&xit" action thiswindow.release()
end popup
END MENU

END WINDOW

frmMain.pgbExport.visible := .f.
CENTER WINDOW frmMain
ACTIVATE WINDOW frmMain

Return Nil



static function MySql_login()
DEFINE WINDOW frmLogon ;
AT 0,0 ;
WIDTH 280 HEIGHT 190 ;
TITLE 'Login MySql' ;
MODAL ;
NOSYSMENU

@ 20,30 LABEL lblHostName ;
VALUE "HostName/IP" ;
WIDTH 150 ;
HEIGHT 35

@ 20,120 TEXTBOX txtHostName ;
HEIGHT 25 ;
VALUE cHostName ;
WIDTH 120 ;
ON ENTER iif( !Empty(frmLogon.txtHostName.Value), frmLogon.txtUser.SetFocus, frmLogon.txtHostName.SetFocus )

@ 50,30 LABEL lblUser ;
VALUE "User" ;
WIDTH 120 ;
HEIGHT 35

@ 50,120 TEXTBOX txtUser ;
HEIGHT 25 ;
VALUE cUser ;
WIDTH 120 ;
ON ENTER iif( !Empty(frmLogon.txtUser.Value), frmLogon.txtPassword.SetFocus, frmLogon.txtuser.SetFocus )

@ 80,30 LABEL lblPassword ;
VALUE "Password" ;
WIDTH 120 ;
HEIGHT 35

@ 80,120 TEXTBOX txtPassword ;
VALUE cPassWord ;
PASSWORD ;
ON ENTER frmLogon.cmdLogin.SetFocus

@ 120,30 BUTTON cmdLogin ;
CAPTION '&Login' ;
ACTION SQL_Connect()

@ 120,143 BUTTON cmdLogoff ;
CAPTION '&Cancel' ;
ACTION frmMain.Release

END WINDOW

CENTER WINDOW frmLogon
ACTIVATE WINDOW frmLogon

Return Nil






Function SQL_Connect()
cHostName:= AllTrim( frmLogon.txtHostName.Value )
cUser:= AllTrim( frmLogon.txtUser.Value )
cPassWord:= AllTrim( frmLogon.txtpassword.Value )

Dbo := TMySQLServer():New(cHostName, cUser, cPassWord )
If Dbo:NetErr()
MsGInfo("Error connecting to SQL server: " + Dbo:Error() )
Release Window ALL
Quit
Endif
lLogin := .T.
frmLogon.Release
frmMain.StatusBar.Item(1) := "MySql Server Connected!!!"

frmMain.lstDatabase.DeleteAllItems()
AEVAL( dbo:ListDbs(), { | a | frmMain.lstDatabase.AddItem( a ) } )

Return Nil




Function SelectDbf()
cDbf := alltrim(GetFile({{"DBF Files","*.dbf"}},"Select a dbf file",,.f.,.f.))
frmMain.lblDbf.caption := cDbf
if len(alltrim(cDbf)) > 0
if file(cDbf)
use &cDbf
lOpened := .t.
endif
endif
RETURN NIL



Function ExportToMySql()
local aStruct := {}, cSql, i, mFldNm, mFldtype, mFldLen, mFldDec, mSql

cDatabase := frmMain.txtDatabase.value
if empty(cDatabase)
MsgInfo("Please specify Database name")
frmMain.txtDatabase.setfocus
return nil
endif

if !DbExist(dbo, cDatabase)
if !miscsql(dbo, "CREATE DATABASE "+cDatabase)
return nil
endif
endif

if !miscsql(dbo, "USE "+cDatabase)
return nil
endif

if empty(cDbf)
MsgInfo("Please select a Dbf table")
frmMain.cmdSelectDbf.setfocus
return nil
endif

cTable := ALLTRIM(substr(cDbf,Rat('\',cDbf)+1))
cTable :=substr(cTable,1,len(cTable)-4)

select &cTable
aStruct = DbStruct()

mSql := "CREATE TABLE IF NOT EXISTS "+cTable+" ("

for i := 1 to len(aStruct)
mFldNm := aStruct[i, DBS_NAME]
mFldType := aStruct[i, DBS_TYPE]
mFldLen := aStruct[i, DBS_LEN]
mFldDec := aStruct[i, DBS_DEC]

if i > 1
mSql += ", "
endif
mSql += alltrim(mFldnm)+" "

do case
case mFldType = "C"
mSql += "CHAR("+LTRIM(STR(mFldLen))+")"
case mFldType = "D"
mSql += "DATE"
case mFldType = "T"
mSql += "DATETIME"
case mFldType = "N"
mSql += "DECIMAL("+LTRIM(STR(mFldLen))+", "+LTRIM(STR(mFldDec))+")"
case mFldType = "F"
mSql += "FLOAT"
case mFldType = "I"
mSql += "INTEGER"
case mFldType = "B"
mSql += "DOUBLE"
case mFldType = "Y"
mSql += "DECIMAL(20, 4)"
case mFldType = "L"
mSql += "SMALLINT(1)"
case mFldType = "M"
mSql += "TEXT"
case mFldType = "G"
mSql += "BLOB"
otherwise
msginfo("Invalid Field Type: "+mFldType)
return nil
endcase
next

mSql += ")"

//msginfo(mSql)

if !miscsql(dbo, mSql)
return nil
endif

frmMain.pgbExport.value := 0
frmMain.pgbExport.visible := .t.
select &cTable
go top
do while !eof()
do events
frmMain.pgbExport.value := recno()/reccount()*100

mSql := "INSERT INTO "+cTable+" VALUES ("

for i := 1 to len(aStruct)
mFldNm := aStruct[i, DBS_NAME]

if i > 1
mSql += ", "
endif

mSql += c2sql(&mFldNm)
next

mSql += ")"

if !miscsql(dbo, mSql)
msgbox("Problem in Query: "+mSql)
return nil
endif

select &cTable
skip
enddo
frmMain.pgbExport.value := 0
frmMain.pgbExport.visible := .f.

return nil










Function MySQL_Logout()
if Dbo != Nil
Dbo:Destroy()
Dbo := Nil
EndIf
Return Nil



Function MySQL_Connect()
If Dbo != Nil
Return Nil
Endif
Dbo := TMySQLServer():New(cHostName, cUser, cPassWord )
If Dbo:NetErr()
MsGInfo("Error connecting to SQL server: " + Dbo:Error() )
Release Window ALL
Quit
Endif
return nil



Function DbExist(dbo, cDatabase)
local aDbList := {}
cDatabase := lower(cDatabase)
aDbList := dbo:ListDbs()
if dbo:neterr()
msginfo("Error in varifying database list: "+dbo:error())
return .f.
endif
return (ascan(aDbList, {|x| lower(x) == lower(cDatabase)}) > 0)



Function TableExist(dbo, cTable)
local aTableList := {}
cTable = lower(cTable)
aTableList := dbo:ListTables()
if dbo:neterr()
msginfo("Error in varifying table list: "+dbo:error())
return .f.
endif
return (ascan(aTableList, {|x| lower(x) == lower(cTable)}) > 0)



//dbo is a public variable holding the database object
FUNCTION connect2db(host,user,password,dbname)
dbo := tmysqlserver():new(AllTrim(host),AllTrim(user),AllTrim(password))
IF dbo:NetErr()
msginfo(dbo:ERROR())
RETURN .f.
ENDIF
dbo:selectdb(dbname)
IF dbo:NetErr()
msginfo(dbo:ERROR())
RETURN .f.
ENDIF
//msginfo("Successfully Connected to the MySQL Server")
RETURN .t.



function sql(dbo1,qstr)
local i, j
local table := nil
local currow := nil
local tablearr := {}
local rowarr := {}
local curdateformat := set(_SET_DATEFORMAT)
set date ansi
table := dbo1:query(qstr)
set(_SET_DATEFORMAT,curdateformat)
if table:neterr()
msgstop(table:error())
table:destroy()
return tablearr
else
if table:lastrec() > 0
asize(tablearr,0)
for i := 1 to table:lastrec()
asize(rowarr,0)
currow := table:getrow(i)
for j := 1 to table:fcount()
aadd(rowarr,currow:fieldget(j))
next j
aadd(tablearr,aclone(rowarr))
next i
endif
table:destroy()
return tablearr
endif
return tablearr



function miscsql(dbo,qstr)
local curdateformat := set( _SET_DATEFORMAT)
set date ansi
table := dbo:query(qstr)
set( _SET_DATEFORMAT,curdateformat)
if table:NetErr()
msgstop(table:ERROR())
table:destroy()
return .f.
endif
table:destroy()
return .t.



function C2SQL(Value)

local cValue := ""
local cFormatoDaData := set(4)
do case
case Valtype(Value) == "N"
cValue := AllTrim(Str(Value))

case Valtype(Value) == "D"
if !empty(Value)
cValue := "'"+DTOS(value)+"'"
else
cValue := "'00000000'"
endif
case Valtype(Value) $ "CM"
IF Empty( Value)
cValue="''"
ELSE
cValue := "'"
Value:=DATATOSQL(value)
cValue+= value+ "'"
ENDIF

case Valtype(Value) == "L"
cValue := AllTrim(Str(iif(Value == .F., 0, 1)))

otherwise
cValue := "''" // NOTE: Here we lose values we cannot convert

endcase

return cValue


/*
So, our insert query may be like this.
qsuccess := miscsql(dbo,"insert into table1 (name, address1,city) values ("+c2sql(form1.name1.value)+","+c2sql(form1.address1.value)+","+c2sql(form1.city.value)+")")
*/


/*
Select query may be like this.
tablearray := sql(dbo,"select * from table1 where city = "+c2sql(form1.city.value))
*/

Clipper to Harbour - A Visual Tour by Pritpal Bedi

Hello Again

This time with an overview of visual tour depicting transition from Clipper to Harbour | from console to GUI.

Please note that this has been achieved with adding few more lines of code than channging any thing else. Also note that as my applications are dictionary based, i.e., data for every object, may it be input screen or selections or browsers, coming from data-dictionaries, I had to adopt the GUI interface at the minimum as executable has objcts only working on data not embedded in the PRG.

The objective of this artical is to provide insight to my fellow developers who are still starvng to enterthe GUI world and do not have enough time and/or means to other solutions.

1. The startup screen;

Clipper


Harbour + Gtwvg

The window contains a child window which hosts an AChoice routine foe selection. If you click on main window the titlebar of selection window flashes, a true parent child implementation.




2. Main Screen;

Clipper


Harbour + Gtwvg



3. Menu System;

Clipper


Harbour + Gtwvg

Every menu is presented in another window but applcation retains the same behavior that of Clipper, i.e., navigation with left-right arrow keys closes previous menu window and opens new one.




4. Data Entry Screen;

Clipper


Harbour + Gtwvg

This window is resizable by font size, i.e., when you resize, number of rows and columns remain the same. Fonts and GUI elements resized to relative coordinates.




5. Browser;

Clipper


Harbour + Gtwvg

NOTE; The icons depicted on toolbar of browser window are lifted from [ourXDbu] application. Marchuet, if you have any reservations please let me know, I will replace this icon set with my old one.

The bowser window is resizable with different attributes. Font and other GUI elements remain the same size instead rows and columns go on increasing/decreasing.




6. Only in Harbour;

Harbour + Gtwvg

This window is not resizable. It remains static because text fonts and picture has been tuned to this size only.




Hope it will be useful for you.

Regards
Pritpal Bedi

HMG Coding Tips by Esgici

CCH: The following are useful tips by Esgici of the HMG Forum in response to one of my posts.

By Esgici - 10th May 2009

For any code BEFORE defining Main Form must don't include any GUI control.

In summary :

- Every HMG appl must one only one Main Window

- The message functions ( MsgXXXX() ) are only exceptions of this rule, as explained in one of HMG Help topics .

- Since the message functions are special cases, there isn't any way to add another control such as Progress Bar. A messages window with such control may be only an user defined form or control and so must depend to main form ( by a direct or indirect way )

- Code placed BEFORE defining and activating Main Form must don't have any GUI control.

- Code between DEFINE WINDOW and END WINDOW are definitions statement only.

- Form and controls included in a form will be realized by ACTIVATE command, not when defined.

- ON INIT is a event definition and will be fired first when ACTIVATE command executed. So you can reference a control defined in this window in a ON INIT procedure / function / code block.

As far as know there isn't any special case when an appl launched by another one ( except any communication betwwen them ). An appl work rightly stand alone must also work by calling another one.

Reporting with HMG : Part II

In the previous article Reporting with HMG : Part I, I had shown you how easy it was to code a report using HMG's DO REPORT command.

But what should you do if you have the need to customise your standard application reports for different customers and yet maintain only one executable ?

In this respect, HMG allows you to define and even edit a report format using any text editor (including Notepad) and then print within your Harbour+HMG application without recompiling.

Here is how to achieve the above :-

#include 'minigui.ch'

procedure main()
//
define window MainForm ;
at 0,0 ;
width 100;
height 100 ;
title 'FAS4HMG' ;
main

DEFINE MAIN MENU
POPUP 'File'
ITEM 'Print GL Chart of Accounts ' ACTION PrintExternalGlChart()
END POPUP
END MENU
end window
//
activate window MainForm

Return Nil

function PrintExternalGlChart()
cClient:='Clipper... Clipper... Clipper'
use GLAC
index on glcode to printexternalglchart
go top
DO REPORT FORM GlChart
use
return


GlChart.rpt

DEFINE REPORT TEMPLATE
TITLE 'GL Chart of Accounts|' + cClient
HEADERS {'',' ',' ',' '} , {'GL CODE','GL NAME','GL GROUP','GL TYPE'}
FIELDS {'glcode','glname','glgroup','gltype'}
WIDTHS {10,40,20,10}
TOTALS {.F.,.F.,.F.,.F.}
NFORMATS { , , ,}
WORKAREA glac
LPP 50
CPL 80
LMARGIN 4
PREVIEW
SELECT
IMAGE {'client.jpg', 0,1,1,1 }
GROUPED BY 'GLGROUP'
HEADRGRP 'GL Group:'
END REPORT



More to come..

Reporting with HMG : Part I

It is amazingly easy to create and print reports using HMG...

All you have to do is as follows :-

#include 'minigui.ch'

procedure main()
//
define window MainForm ;
at 0,0 ;
width 100;
height 100 ;
title 'FAS4HMG' ;
main

DEFINE MAIN MENU
POPUP 'File'
ITEM 'Print GL Chart of Accounts ' ACTION PrintGLChart()
END POPUP
END MENU
end window
//
activate window MainForm

Return Nil



function PrintGLChart()
//
use GLAC
index on glcode to printglchart
//
set date british
set century on
//
DO REPORT ;
TITLE 'GL Chart of Accounts' ;
HEADERS {'','','',''} , {'GL CODE','DESCRIPTION','GL GROUP','GL TYPE'} ;
FIELDS {'glcode','glname','glgroup','gltype'} ;
WIDTHS {10,40,20,10} ;
TOTALS {.F.,.F.,.F.,.F.} ;
NFORMATS {'','','',"} ;
WORKAREA GLAC ;
LPP 50 ;
CPL 80 ;
LMARGIN 2 ;
PAPERSIZE DMPAPER_A4 ;
PREVIEW ;
SELECT ;
MULTIPLE ;
GROUPED BY 'glgroup' ;
HEADRGRP 'GL Group'
//

Return Nil


After Clicking Yes


After Choosing Thumbnails



If the above-mentioned codes are recompiled with MiniGui ie HMG Extended




Next : Reporting with HMG : Part II