A következő programban megpróbálom bemutatni a megismert nyelvi elemek használatát.
A program a programozási nyelvek szemináriumra íródott, így igény szerint elérhető a kurzus hallgatóinak.
CSV kimenetet generáló modul
! Product : CSV Output Generator
! Name : csv_functions.sqr
!
! Function: Export report data to csv format
!
! Revision History :
! Author Changed Description
! Adonics Zoltán 2011.05.21 Base Functionality
!******************************************
! Tömb inicializálása
begin-setup
CREATE-ARRAY NAME = CSVLine SIZE = {CSVColNumMax}
field=Value:TEXT
end-setup
!******************************************
!******************************************
! Adott oszlopba érték tárolása, majd oszlop léptetés
begin-procedure saveCSVLineValue($Value)
Add 1 to #_CSVColNum
if #_CSVColNum < {CSVColNumMax} - 1
Let CSVLine.Value(#_CSVColNum) = $Value
end-if
end-procedure
!******************************************
!******************************************
! Oszlop pozíciójának alapértékre állítása
begin-procedure clearCSVLine
move -1 to #CSVColNum
end-procedure
!******************************************
!******************************************
! CSV fájl létrehozása (a .pdf kimenet elnevezése alapján -> csak .pdf kimenetre mûködik)
begin-procedure openCSVFile
let $CSVFile = replace($sqr-report, '.pdf', '.csv')
open $CSVFile as 1 FOR-WRITING RECORD={RecordLength} :FIXED
do clearCSVLine
end-procedure
!******************************************
!******************************************
! CSV fájl lezárása
begin-procedure closeCSVFile
close 1
end-procedure
!******************************************
!******************************************
! 1 sor kiírása a csv fájlba, majd sordobás
begin-procedure writeCSVFile
Let #CSVActCol = 0
Let $CSVLine = ''
While #CSVActCol <= #CSVColNum
GET $CSVLineValue FROM CSVLine(#CSVActCol) Value
Let $CSVLine = $CSVLine || $CSVLineValue || {FieldSeparator}
Add 1 to #CSVActCol
end-while
write 1 from $CSVLine
do clearCSVLine
end-procedure
!******************************************
!******************************************
! Üres csv fájl kiírása
begin-procedure writeEmptyCSVFile
Let #CSVActCol = 0
Let $CSVLine = ' '
write 1 from $CSVLine
do clearCSVLine
end-procedure
!******************************************
!******************************************
! Numerikus érték tárolása aktuális oszlop pozícióra, majd oszlop pozíció növelés
begin-procedure saveCSVLineNumValue(#Value)
move #Value to $Value
do saveCSVLineValue($Value)
end-procedure
!******************************************
!******************************************
! Dátum érték tárolása aktuális oszlop pozícióra megadott formázási maszkkal, majd oszlop pozíció növelés
begin-procedure saveCSVLineDateValue($pValue, $pDateFormat)
DECLARE-VARIABLE
DATE $pValue
END-DECLARE
let $dateValue = edit($pValue, $pDateFormat)
do saveCSVLineValue($dateValue)
end-procedure
!******************************************
Segédmodul
! Product : Main general functions
! Name : main_general_functions.sqr
!
! Function: Main general functions
!
! Revision History :
! Author Changed Description
! Adonics Zoltán 2011.05.21 Base Functionality
!******************************************
! Adott érétket jobbra rendezve írja ki a kimenetre (szám értékek megjelenítése miatt)
begin-procedure AlignRight ($String,#Font,#PointSize,#COLUMN)
if #PointSize = 1
move 1 to #Factor
else
move 1.66 to #Factor
end-if
Alter-Printer Font=#Font Point-Size=#pointsize
Let #COL = #COLUMN - length($String) * #POINTSIZE / #Factor
if #COL <= 0
move 1 to #COL
end-if
POSITION (,#COL)
end-procedure
!******************************************
!******************************************
! Szám értékû oszlop elnevezésének jobbra rendezése
begin-procedure alignColHeadRight ($pString, $pNumberFormat, #pFont, #pPointSize, #pColPos)
if #pPointSize = 1
move 1 to #Factor
else
move 1.66 to #Factor
end-if
let #Column = #pColPos + length($pNumberFormat) * #pPointSize / #Factor
do AlignRight ($pString, #pFont, #pPointSize, #Column)
end-procedure
!******************************************
Főmodul
! Product : Main program
! Name : main_program.sqr
!
! Function: Main program
!
! Revision History :
! Author Changed Description
! Adonics Zoltán 2011.05.21 Base Functionality
!******************************************
! Konstansok definiálása
! CSV kimenethez szükséges konstansok definiálása (hossz, maximális oszlopszám, elválasztó-karakter)
#define RecordLength 1000
#define CSVColNumMax 22
#define FieldSeparator ';'
! Szám értékek formázáshoz szükséges konstansok
#define number_format_3_0 '999'
#define number_format_4_0 '9999'
#define number_format_9_2 '999,999,999.99'
#define number_format_10_2 '9999999999.99'
! Alapvetõ riport kimenet beállítások (fejléc, lábléc stb.)
#define HeaderHeight 45
#define RowHeight 8
#define PointSize 10
#define FooterHeight 24
! Oszlop pozíciók beállítása
#define ColPos01 1 !
#define ColPos02 90 !
#define ColPos03 220 !
#define ColPos03b 280 !
#define ColPos04 370 !
#define ColPos05 525 !
#define ColPos06 660 !
!******************************************
!******************************************
! Kiegészítõ modulok beimportálása
#include 'csv_functions.sqr'
#include 'main_general_functions.sqr'
!******************************************
!******************************************
! Alapvetõ riport kimenet beállítások (setup szekció)
Begin-Setup
Declare-Layout Default
Orientation = Landscape
Paper-Size = (A4)
Line-Height = 1
Char-Width = 1
End-Declare
End-Setup
!******************************************
!******************************************
! Fejléc
Begin-Heading {HeaderHeight}
move 1 to #ActRow
Alter-Printer Font=3 Point-Size={PointSize}
!print maker name
print 'Adonics Zoltán' ({RowHeight}, 1)
! print report name
Alter-Printer Font=300 Point-Size={PointSize}
print 'Programozási nyelvek és paradigmák összehasonlítása 2.' ({RowHeight}) center
!print date and time
Let $out = ltrim(rtrim(edit($current-date,'YYYY.MM.DD. HH:MI'),' '),' ')
do AlignRight ($out,3,{PointSize},761)
print $out ({RowHeight})
! print report id
Add 16 to #ActRow
do AlignRight ($PARM_NAME,3,{PointSize},761)
Print $PARM_NAME (#ActRow)
! print column headings
do printColumnHeadings
Add 3 to #ActRow
graphic (#ActRow, 1, 760) horz-line
End-Heading
!******************************************
!******************************************
! Lábléc
begin-footing {FooterHeight}
graphic ({RowHeight}, 1, 760) horz-line
Let #Row = {RowHeight} * 2
move '' to $PrintLine
Let $PrintLine = 'Adonics Zoltán'
print $PrintLine (#Row, 1)
let $page-count = #page-count
print #page-count (#Row, 685) edit '999999'
print '/' (#Row, 722)
last-page (,730)
end-footing
!******************************************
!******************************************
! Oszlop elnevezések kiíratása
Begin-Procedure printColumnHeadings
Add 16 to #ActRow
print 'Cégadatok' (#ActRow, {ColPos01})
print 'Ügyféladatok' (#ActRow, {ColPos02})
print 'Számla száma' (#ActRow, {ColPos03})
print 'Számla pénzneme' (#ActRow, {ColPos04})
print 'Nettó összeg' (#ActRow, {ColPos05})
print 'Bruttó összeg' (#ActRow, {ColPos06})
End-Procedure
!******************************************
!******************************************
! Programot indító szekció (program szekció)
Begin-Program
do openCSVFile
do printCSVHeader
do Master-Query
do closeCSVFile
End-Program
!******************************************
!******************************************
! Oszlop elnevezések kiíratása a CSV kimenetre
Begin-Procedure printCSVHeader
do saveCSVLineValue('Cég azonosító')
do saveCSVLineValue('Cég név')
do saveCSVLineValue('Ügyfélnév')
do saveCSVLineValue('Anyja neve')
do saveCSVLineValue('Szül. helye')
do saveCSVLineValue('Szül. ideje')
do saveCSVLineValue('Foly. számla száma')
do saveCSVLineValue('Pénznem')
do saveCSVLineValue('Számla száma')
do saveCSVLineValue('Számla pénzneme')
do saveCSVLineValue('Nettó összeg')
do saveCSVLineValue('Bruttó összeg')
do writeCSVFile
End-Procedure
!******************************************
!******************************************
! Fõ program lekérdezés része
Begin-Procedure Master-Query
Begin-Select
company.id &company=number () on-break save=$OldCompany print=never level=1 before=beforeCompany after=afterCompany
company.name & ' ' & company.companytype &companyfullname=text
customer.lastname & ' ' & customer.firstname &custname=text () on-break save=$OldCustomerName print=never level=2 before=beforeCustomer after=afterCustomer
customer.mothername &mothername
customer.birthplace &birthplace
customer.birthdate &birthdate=date
account.accountnum &accountnum=number
account.currency ¤cy=text
bill.ledgerentryno &ledgerentryno=text
bill.currency &billcurrency=text
bill.netamount &netamount=number
bill.grossamount &grossamount=number
do printLines
do generateCSVRow
let #sumCompany = #sumCompany + &grossamount
let #sumCustomer = #sumCustomer + &grossamount
from customer, company, account, bill
where company.id = customer.company
and account.custid = customer.id
and account.id = bill.accountid
order by company.id, customer.id
End-Select
End-Procedure
!******************************************
!******************************************
! Egy sor kiíratása (SQL eredmény soronként)
Begin-Procedure printLines
Alter-Printer Font=3 Point-Size={PointSize} ! Set font to normal
next-listing no-advance need={RowHeight}
print &ledgerentryno ({RowHeight}, {ColPos03})
print &billcurrency ({RowHeight}, {ColPos04})
print &netamount ({RowHeight}, {ColPos05}) edit {number_format_9_2}
print &grossamount ({RowHeight}, {ColPos06}) edit {number_format_9_2}
End-Procedure
!******************************************
!******************************************
! Egy sor kiíratása CSV kimenetre (SQL eredmény soronként)
Begin-Procedure generateCSVRow
move &company to $companytxt {number_format_3_0}
do saveCSVLineValue($companytxt)
do saveCSVLineValue(&companyfullname)
do saveCSVLineValue(&custname)
do saveCSVLineValue(&mothername)
do saveCSVLineValue(&birthplace)
do saveCSVLineDateValue(&birthdate, 'YYYY-MM-DD')
move &accountnum to $accountnumtxt {number_format_4_0}
do saveCSVLineValue($accountnumtxt)
do saveCSVLineValue(¤cy)
do saveCSVLineValue(&ledgerentryno)
do saveCSVLineValue(&billcurrency)
move &netamount to $netamounttxt {number_format_10_2}
do saveCSVLineValue($netamounttxt)
move &grossamount to $grossamounttxt {number_format_10_2}
do saveCSVLineValue($grossamounttxt)
do writeCSVFile
End-Procedure
!******************************************
!******************************************
! Összesítõ sor kiíratása (Cég szám változása elõtt)
Begin-Procedure beforeCompany
move 0 to #sumCompany
next-listing skiplines={RowHeight}
Alter-Printer Font=300 Point-Size={PointSize} ! Set font to normal
move &company to $companytxt {number_format_3_0}
let $fullCompanyTxt = $companytxt || ' - ' || &companyfullname
print $fullCompanyTxt ({RowHeight}, {ColPos01})
Alter-Printer Font=3 Point-Size={PointSize}
End-Procedure
!******************************************
!******************************************
! Összesítõ sor kiíratása (Cég szám változása után)
Begin-Procedure afterCompany
next-listing skiplines={RowHeight}
Alter-Printer Font=300 Point-Size={PointSize} ! Set font to normal
move #sumCompany to $sumCompanyTxt {number_format_9_2}
let $sum = 'Összesen (' || $OldCompany || '): ' || $sumCompanyTxt
print $sum ({RowHeight}, {ColPos01})
Alter-Printer Font=3 Point-Size={PointSize}
End-Procedure
!******************************************
!******************************************
! Összesítõ sor kiíratása (Ügyfél szám változása elõtt)
Begin-Procedure beforeCustomer
move 0 to #sumCustomer
next-listing skiplines={RowHeight}
Alter-Printer Font=300 Point-Size={PointSize} ! Set font to normal
let $fullCustomerNameTxt = 'Ügyfélnév: ' || &custname
print $fullCustomerNameTxt ({RowHeight}, {ColPos02})
next-listing skiplines={RowHeight}
move &birthdate to $birthDateTxt 'YYYY-MM-DD'
let $fullBirthTxt = 'Születési ideje: ' || $birthDateTxt || ' (' || &birthplace || ')'
print $fullBirthTxt ({RowHeight}, {ColPos02})
next-listing skiplines={RowHeight}
move &accountnum to $accountNumTxt
let $fullAccountTxt = 'Folyószámla: ' || $accountNumTxt
print $fullAccountTxt ({RowHeight}, {ColPos02})
let $fullCurrencyTxt = 'Pénznem: ' || ¤cy
print $fullCurrencyTxt ({RowHeight}, {ColPos03})
Alter-Printer Font=3 Point-Size={PointSize}
next-listing skiplines={RowHeight}
End-Procedure
!******************************************
!******************************************
! Összesítõ sor kiíratása (Ügyfél szám változása után)
Begin-Procedure afterCustomer
next-listing skiplines={RowHeight}
Alter-Printer Font=300 Point-Size={PointSize} ! Set font to normal
move #sumCustomer to $sumCustomerTxt {number_format_9_2}
let $sum = 'Összesen (' || $OldCustomerName || '): '
print $sum ({RowHeight}, {ColPos02})
print $sumCustomerTxt ({RowHeight}, {ColPos03b})
Alter-Printer Font=3 Point-Size={PointSize}
next-listing skiplines={RowHeight}
End-Procedure
!******************************************