PROGRAM qtXLSDemoWriteTable ! Program demonstrates usage of qtXLS routines to export some data to ! an EXCEL file. ! ! We are going to create an EXCEL file named "qtXLSDemo3.xls" ! which contains a table named "qtXLSDemoTable" with ! columns: lfdNr x y Description Date_Time USE qtXLS ! qtXLS MODULE contains declarations and INTERFACES IMPLICIT NONE ! Names of variables and constants start with "qt". ! Arrays with data to be exported. INTEGER, PARAMETER :: DIMArr = 50, NoColumns = 5 CHARACTER(256) szTextArr(DIMArr) INTEGER lfdNrArr(DIMArr) ! INTEGER*4 REAL (qt_K_R8) xArr(DIMArr), yArr(DIMArr) ! REAL*8 arrays TYPE (qT_TIMESTAMP_STRUCT) TSArr(DIMArr) ! defines a date & time structure REAL (qt_K_R8) angle REAL (qt_K_R8), PARAMETER :: PI = 3.1415932654D0 INTEGER dtValues(8) ! variables to be used by qtXLS routines INTEGER (qt_K_HANDLE) hDS INTEGER (qt_K_INT4) iRet, iRow, TNLen, NoRows CHARACTER (20) szFileName TYPE (qT_SQLColumn) tColumns(NoColumns) CHARACTER (qt_I_MaxTableNameLEN) szTableName CHARACTER (1000) szTableDefinition ! prior usage of any other qtXLS function either provide the licence ! file ( (L0611-######.lic, supplied with ealier versions of qtXLS) ! or call qtSetLicence_qtXLS(). Otherwise qtXLS runs in demo mode only.) ! ! (1) in case of usage of the licence file (L0611-######.lic), you ! might want to set the path such that the licence file can be found ! CALL qtSetXLSLicencePath( szPathName ) ! change the path to a location where the licence file resides ! ! (2) if you prefer to have the licence linked into your program ! call this routine CALL qtSetLicence_qtXLS( iRet ) ! supplied in source form (file name: qtSetLicence_0611_######.f90) ! Fill arrays with values (the data we're going to export into an EXCEL file) DO iRow = 1, DIMArr lfdNrArr(iRow) = iRow xArr(iRow) = iRow * 0.01 angle = xArr(iRow) * PI yArr(iRow) = COS(angle) WRITE(szTextArr(iRow),"('Angle = ', F0.2, ' (degree)', A1)") angle * 180. / PI, CHAR(0) CALL CONTAINS_SetTSArr( iRow ) ! routine (see CONTAINS section) sets TSArr END DO ! create "empty" EXCEL file szFileName = 'qtXLSDemo3.xls' // CHAR(0) hDS = qtXLSCreateEXCELFile( szFileName ) ! returns a "data source handle" to be used with other qtXLS routines IF ( hDS == 0 ) THEN PRINT*, 'Error returned from qtXLSCreateEXCELFile =', hDS STOP ELSE PRINT*, 'qtXLSCreateEXCELFile created the file ', szFileName END IF CALL qtXLSSetErrorLevel( 1 ) ! continue, if an error occurs (if possible) !T CALL qtXLSSetErrorMessagesDisplay( 1 ) ! turn on "error display" ! Create (empty) table ! -------------------- szTableName = 'qtXLSDemoTable' // CHAR(0) ! table name (zero terminated) TNLen = qtXLSGetszStringLength( szTableName ) ! returns length of string (without terminating zero) ! check if table already exists IF ( qtXLSDoesTableNameExist( hDS, szTableName ) == 1 ) THEN PRINT*, 'Table ', szTableName(1:TNLen), ' already exists.' ELSE ! create table by setting up a command line containing the table name followed ! by a list of pairs of column names and column types (like NUMBER, DATETIME, TEXT, CURRENCY or LOGICAL). szTableDefinition = szTableName(1:TNLen) & // ' (lfdNr NUMBER, x NUMBER, y NUMBER, Description TEXT, Date_Time DATETIME)' // CHAR(0) iRet = qtXLSCreateTable( hDS, szTableDefinition ) IF ( iRet /= 0) STOP ! stop on error END IF ! Set up columns "lfdNr x y Description Date_Time" for export ! ------------------------------------------------------------------- ! 1st column tColumns(1) % Name = 'lfdNr' ! column name tColumns(1) % ArrayAddr = LOC(lfdNrArr) ! memory address of array tColumns(1) % ArrayDim = DIMArr ! array dimension tColumns(1) % ArrayType = qt_SQL_C_SLONG ! 4 byte (long) INTEGER tColumns(1) % LENArrElem = 4 ! size of an array element (in bytes) tColumns(1) % IndArrAddr = 0 ! reserved, unused (should be 0) ! and remaining columns (using the TYPE constructor function qT_SQLColumn) tColumns(2) = qT_SQLColumn('x', LOC(xArr), DIMArr, qt_SQL_C_DOUBLE, 8, 0) tColumns(3) = qT_SQLColumn('y', LOC(yArr), DIMArr, qt_SQL_C_DOUBLE, 8, 0) tColumns(4) = qT_SQLColumn('Description', LOC(szTextArr), DIMArr, qt_SQL_C_CHAR, & LEN(szTextArr(1)), 0) tColumns(5) = qT_SQLColumn('Date_Time', LOC(TSArr), DIMArr, qt_SQL_C_TIMESTAMP, 16, 0) NoRows = DIMArr ! export all values in the arrays ! Fill table with rows ! -------------------- iRet = qtXLSWriteRows( hDS, szTableName, NoColumns, NoRows, tColumns ) IF ( iRet >= 0 ) THEN PRINT*, 'qtXLSWriteRows successful. Number of rows written: ', iRet ELSE PRINT*, 'Error returned from qtXLSWriteRows; iError = ', iRet END IF iRet = qtXLSCloseEXCELFile( hDS ) IF ( iRet == 0 ) THEN PRINT*, 'Data successfully exported to EXCEL file ', szFileName PRINT*, 'qtXLS closed.' ELSE PRINT*, 'Error returned from qtXLSCloseEXCELFile = ', iRet END IF PRINT* PRINT*, '(C) QT software GmbH, Germany. All rights reserved. 2003-2007.' PRINT*, ' http://www.qtsoftware.de eMail: info@qtsoftware.de' PRINT* PAUSE 'Press Enter/Return to terminate.' STOP 'Program terminated.' CONTAINS SUBROUTINE CONTAINS_SetTSArr( j ) ! fill date & time structure with some date and time values INTEGER j, hour IF ( j == 1 ) THEN CALL DATE_AND_TIME( VALUES = dtValues ) ! F90 intrinsic function returns date & time TSArr(j) % year = dtValues(1) TSArr(j) % month = dtValues(2) TSArr(j) % day = dtValues(3) TSArr(j) % hour = dtValues(5) TSArr(j) % minute = dtValues(6) TSArr(j) % second = dtValues(7) TSArr(j) % fraction = dtValues(8) / 10 ! hundredths ELSE ! increment date and time TSArr(j) = TSArr(j-1) TSArr(j) % day = TSArr(j-1) % day + 1 IF ( TSArr(j) % day > 28 ) THEN TSArr(j) % day = 1 TSArr(j) % month = TSArr(j-1) % month + 1 IF ( TSArr(j) % month > 12 ) THEN TSArr(j) % month = 1 TSArr(j) % year = TSArr(j-1) % year + 1 END IF END IF TSArr(j) % second = TSArr(j-1) % second + 1 IF ( TSArr(j) % second > 59 ) THEN TSArr(j) % second = 1 TSArr(j) % minute = TSArr(j-1) % minute + 1 IF ( TSArr(j) % minute > 59 ) THEN TSArr(j) % minute = 1 hour = TSArr(j-1) % hour TSArr(j) % hour = MOD(hour, 24) + 1 END IF END IF END IF RETURN END SUBROUTINE END PROGRAM qtXLSDemoWriteTable