Code: Select all
#include "hmg.ch"
FUNCTION MAIN()
/***************/
PUBLIC dbo
PUBLIC pHOST := 'hostname'
PUBLIC pDBUSER := 'user'
PUBLIC pDBPW := 'pasword'
PUBLIC pDBNAME := 'dbname'
SET CENT ON
SET DATE FRENCH
If !IsWIndowActive (Form_1)
DEFINE WINDOW Form_1 ;
AT 0,0 ;
WIDTH 600 ;
HEIGHT 600;
TITLE 'Personel' ;
BACKCOLOR SILVER ;
MAIN ;
ICON "images\form_1.ico"
ON KEY ESCAPE ACTION { Form_1.Release }
ON KEY F1 ACTION { Form_1.Release }
DEFINE GRID Grid_Personel
ROW 10
COL 10
WIDTH 580
HEIGHT 400
FONTNAME "Arial"
FONTSIZE 10
HEADERS {'ID', 'Department', 'Name' , 'Family name', 'Salary' }
WIDTHS {50 , 100, 120, 120 , 70 }
JUSTIFY {GRID_JTFY_LEFT, GRID_JTFY_LEFT, GRID_JTFY_LEFT, GRID_JTFY_LEFT, GRID_JTFY_RIGHT }
ITEMS Load_Personel()
END GRID
DEFINE BUTTON BT_1
PARENT Form_1
ROW 440
COL 10
WIDTH 70
HEIGHT 70
ACTION {Print_Personel()}
CAPTION ""
TRANSPARENT .T.
TOOLTIP 'Print PDF'
PICTURE "HP_PRINT"
PICTALIGNMENT TOP
END BUTTON
END WINDOW
CENTER WINDOW Form_1
ACTIVATE WINDOW Form_1
ELSE
Form_1.SetFocus
ENDIF
RETURN NIL
FUNCTION Print_Personel()
/******************************/
PUBLIC cPDF := 'PERSONEL.PDF'
IF SQL_Connect(pHOST, pDBUSER, pDBPW, pDBNAME) == Nil // geen connectie
MSGINFO('No SQL connection', 'NOK' )
RETURN
ENDIF
cQuery1 := " SELECT PERS_ID, DEPT, NAME, FAMILY_NAME, SALARY "
cQuery1 += " FROM PERSONEL "
cQuery1 += " WHERE ACTIVE = 'J' "
cQuery1 += " ORDER BY 2,4,3 "
cQuery1 := dbo:Query( cQuery1 )
IF cQuery1:NetErr()
MSGINFO(cQuery1:Error(), 'NOK' )
RETURN
ENDIF
Personel_PDF_INIT()
Personel_PDF_CREATE()
Personel_PDF_END()
dbo:Destroy()
EXECUTE FILE cPDF
RETURN
FUNCTION Personel_PDF_INIT()
/**********************************************/
LOCAL lSuccess := .F.
PUBLIC nCurrentPage := 1
SELECT HPDFDOC cPDF TO lSuccess PAPERSIZE HPDF_PAPER_A4
SET HPDFDOC COMPRESS ALL
SET HPDFDOC PASSWORD OWNER "XPASSWORD"
SET HPDFDOC PERMISSION TO COPY
SET HPDFDOC PERMISSION TO PRINT
SET HPDFINFO AUTHOR TO "PERSONEL FILE"
SET HPDFINFO CREATOR TO "PERSONEL FILE"
SET HPDFINFO TITLE TO "PERSONEL FILE"
SET HPDFINFO SUBJECT TO "PERSONEL FILE"
SET HPDFINFO KEYWORDS TO "PERSONEL FILE"
SET HPDFINFO DATECREATED TO DATE() TIME TIME()
IF lSuccess
nCurrentPage := 1
START HPDFDOC
ENDIF
RETURN
FUNCTION Personel_PDF_END()
/***************************/
nROW := nROW + 5
END HPDFPAGE
END HPDFDOC
RETURN
FUNCTION Personel_PDF_CREATE()
/******************************/
LOCAL i
PUBLIC nROW := 30
PUBLIC nMAX_ROW := 260
PUBLIC nTOT_SALARY := 0
PUBLIC nDEPT_SALARY := 0
START HPDFPAGE
SET HPDFDOC ENCODING TO "WinAnsiEncoding"
Prt_HDR_Personel_PDF()
i := 1
DO WHILE i <= cQuery1:LastRec()
aCurRow1 := cQuery1:GetRow(i)
cDEPT := aCurRow1:fieldGet(2)
cKEY := aCurRow1:fieldGet(2)
nDEPT_SALARY := 0
Prt_Detail1_PDF( 'Department: ' + cDEPT, 5)
nROW := nROW + 5
DO WHILE i <= cQuery1:LastRec() .AND. cDEPT == cKEY
cNAME := aCurRow1:fieldGet(3)
cFAMILY_NAME := aCurRow1:fieldGet(4)
nSALARY := aCurRow1:fieldGet(5)
cNAME := STRTRAN(cNAME, "''", "'" ) // names like d''artagnan --> d'artagnan
cFAMILY_NAME := STRTRAN(cFAMILY_NAME, "''", "'" )
Prt_Detail1_PDF( ALLTRIM(STR(aCurRow1:fieldGet(1))), 5)
Prt_Detail1_PDF( cNAME, 20)
Prt_Detail1_PDF( cFAMILY_NAME, 60)
Prt_Detail1_PDF( ALLTRIM(STR(aCurRow1:fieldGet(5))), 160 ,'R' )
nROW := nROW + 5
nTOT_SALARY := nTOT_SALARY + nSALARY
nDEPT_SALARY := nDEPT_SALARY + nSALARY
NEWPAGE()
i++
aCurRow1 := cQuery1:GetRow(i)
cKEY := aCurRow1:fieldGet(2)
ENDDO
NEWPAGE()
Prt_Detail1_PDF( 'TOTAL Department: ' + cDEPT, 5)
Prt_Detail1_PDF( ALLTRIM(STR(nDEPT_SALARY)), 160 ,'R' )
nROW := nROW + 10
ENDDO
NEWPAGE()
nROW := nROW + 10
Prt_Detail1_PDF( 'TOTAAL Personel', 5 )
Prt_Detail1_PDF( ALLTRIM(STR(nTOT_SALARY)), 160 ,'R' )
RETURN
FUNCTION Prt_Detail1_PDF( cDET, nCOL, cLR )
/*****************************************/
DEFAULT cLR := 'LEFT'
IF cLR == 'LEFT'
@ nROW , nCOL HPDFPRINT cDET SIZE 8
ELSE
@ nROW , nCOL HPDFPRINT cDET SIZE 8 RIGHT
ENDIF
RETURN NIL
FUNCTION Prt_HDR_Personel_PDF()
/*******************************/
nROW := 30
@ 7,5 HPDFPRINT "Personel file" SIZE 9 COLOR RED
@ 7,160 HPDFPRINT DTOC(DATE()) + ' ' + 'Page ' + ALLTRIM(STR(nCurrentPage)) SIZE 8 COLOR RED RIGHT
@ 1, 1 HPDFPRINT RECTANGLE TO 18, 200 PENWIDTH 0 COLOR BLACK ROUNDED
nCurrentPage++
Prt_HDR_HDR_Personel()
NEWPAGE()
IF nTOT_SALARY # 0
NEWPAGE()
Prt_Detail1_PDF( 'Transfer', 110, 'R')
Prt_Detail1_PDF( ALLTRIM(STR(nDEPT_SALARY)), 160 ,'R' )
nROW := nROW + 10
ENDIF
RETURN NIL
FUNCTION Prt_HDR_HDR_Personel()
/*************************************/
NEWPAGE()
Prt_Detail1_PDF( 'ID', 5)
Prt_Detail1_PDF( 'Name', 20)
Prt_Detail1_PDF( 'Family name', 60)
Prt_Detail1_PDF( 'Salary', 160,'R')
nROW := nROW + 10
RETURN NIL
FUNCTION NEWPAGE()
/************************/
IF nROW >= nMAX_ROW
Prt_Detail1_PDF( 'Transfer', 110, 'R')
Prt_Detail1_PDF( ALLTRIM(STR(nDEPT_SALARY)), 160 ,'R' )
END HPDFPAGE
START HPDFPAGE
Prt_HDR_Personel_PDF()
ENDIF
RETURN
FUNCTION SQL_Connect(XHOST,XDBUSER,XDBPW,XDBNAME)
/**********************************************/
dbo := tmysqlserver():new(ALLTRIM(XHOST),ALLTRIM(XDBUSER),ALLTRIM(XDBPW))
IF dbo:NetErr()
RETURN nil
ENDIF
IF!EMPTY(XDBNAME)
dbo:selectdb(XDBNAME)
IF dbo:NetErr()
RETURN nil
ENDIF
ENDIF
RETURN dbo
FUNCTION Load_Personel()
/************************/
IF SQL_Connect(pHOST, pDBUSER, pDBPW, pDBNAME) == Nil
MSGINFO('NO SQL connection', 'NOK' )
RETURN
ENDIF
cQuery1 := " SELECT ID, DEPARTMENT, NAME, FAMILY_NAME, SALARY "
cQuery1 += " FROM PERSONEL "
cQuery1 += " WHERE ACTIVE = 'J' "
cQuery1 += " ORDER BY 2,4,3 "
cQuery1 := dbo:Query( cQuery1 )
IF cQuery1:NetErr()
MSGINFO(cQuery1:Error(), 'NOK' )
RETURN
ENDIF
aPersonel := {}
FOR i := 1 To cQuery1:LastRec()
aCurRow1 := cQuery1:GetRow(i)
cNAME := aCurRow1:fieldGet(3)
cFAMILY_NAME := aCurRow1:fieldGet(4)
cNAME := STRTRAN(cNAME, "''", "'" )
cFAMILY_NAME := STRTRAN(cFAMILY_NAME, "''", "'" )
AADD(aPersonel , { aCurRow1:fieldGet(1), aCurRow1:fieldGet(2) , cNAME, cFAMILY_NAME, aCurRow1:fieldGet(5) } )
NEXT i
dbo:Destroy()
RETURN aPersonel