Az SQR programozási nyelv

Egy komplett program

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 !******************************************