  ! This software AUTODICE.F90 is part of the Compaq Visual Fortran kit.
  ! 
  ! This software is provided as an example that demonstrates a particular
  ! feature/function of the licensed product. The software is not intended to
  ! provide a complete solution to any application problem but rather is provided
  ! as a teaching mechanism.
  ! 
  ! Users may incorporate any part of this sample into their own source after 
  ! making appropriate changes to make it suitable for the intended application.

  ! This sample program takes 12 numbers and uses
  ! Automation to tell EXCEL 97 to draw a histogram of the numbers.
  ! The EXCEL97A module generated by the Fortran Module Wizard
  ! is used as the interface to EXCEL.  EXCEL97A supports the following EXCEL
  ! interfaces:
  !     _Application, _Chart, _Workbook, _Worksheet, Axes, Charts, Range,
  !     Workbooks, Worksheets
  !
  ! NOTES: 
  !     1.  Modify the file specification below if you have installed Visual
  !         Fortran in a directory other than 
  !         C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO
  !     2.  After running this sample, if you save the changes to HISTO.XLS,
  !         you must re-copy the original version from the Visual Fortran 
  !         CD-ROM for this sample to work correctly.
  !

    PROGRAM ExcelSample

	  USE DFLIB
	  USE DFWIN
	  USE DFCOM
	  USE DFCOMTY
	  USE DFAUTO
	  USE ADOBJECTS
	  USE EXCEL97A
      IMPLICIT NONE                       
	
	! Variables
	  INTEGER*4 status
	  INTEGER*4 loopCount
	  INTEGER*4 die1
	  INTEGER*4 die2
	  INTEGER*4 roll
	  INTEGER*4 maxScale
	  CHARACTER (LEN = 32) :: loopc
	  INTEGER   i
      REAL*4    rnd
	  INTEGER*2, DIMENSION(1:12) :: cellCounts

	! Variant arguments
	  TYPE (VARIANT) :: vBSTR1
	  TYPE (VARIANT) :: vBSTR2
	  TYPE (VARIANT) :: vBSTR3
	  TYPE (VARIANT) :: vInt

	! Initialize object pointers
	  CALL INITOBJECTS()

	! Create an Excel object
	  CALL COMINITIALIZE(status)
      CALL COMCREATEOBJECT ("Excel.Application.8", excelapp, status)
 	  IF (excelapp == 0) THEN
		  WRITE (*, '(" Unable to create Excel object; Aborting")')
		  CALL EXIT()
	  END IF
      CALL $Application_SetVisible(excelapp, .TRUE.)

	! Here is a sketch of the code below in pseudocode...
	!
	!	workbooks = excelapp.GetWorkbooks()
	!	workbook = workbooks.Open(spreadsheet)
	!	worksheet = workbook.GetActiveSheet
	!	range = worksheet.GetRange("A1", "L1")
	!	range.Select()
	!	charts = workbook.GetCharts()
	!	chart = charts.Add()
	!	chart.ChartWizard(gallery=chartType, title=title, categoryTitle=title, valueTitle=title)
	!	valueAxis = chart.Axes(type=xlValue, axisGroup=xlPrimary)
	!   valueAxis.MaximumScale(loopcount/5)

	! Get the WORKBOOKS object
	  workbooks = $Application_GetWorkbooks(excelapp, $STATUS = status)
	  CALL Check_Status(status, " Unable to get WORKBOOKS object")

	! Open the specified spreadsheet file (note: specify the full file path)
	  workbook = Workbooks_Open(workbooks, &
        "C:\PROGRAM FILES\MICROSOFT VISUAL STUDIO\DF98\SAMPLES\ADVANCED\COM\AUTODICE\HISTO.XLS", &
        $STATUS = status)
	  CALL Check_Status(status, " Unable to get WORKBOOK object; ensure that the file path is correct")

	! Get the worksheet
	  vInt%VT = VT_I4
	  vInt%VU%LONG_VAL = 1
      worksheet = $Workbook_GetActiveSheet(workbook, status)
	  CALL Check_Status(status, " Unable to get WORKSHEET object")

	! Initialize the cell counts
	  DO i=1,12
		  range = 0
		  cells(i) = range
		  cellCounts(i) = 0
	  END DO

	! Create a new chart
	  CALL VariantInit(vBSTR1)
	  vBSTR1%VT = VT_BSTR
	  bstr1 = ConvertStringToBSTR("A1")
	  vBSTR1%VU%PTR_VAL = bstr1
	  CALL VariantInit(vBSTR2)
	  vBSTR2%VT = VT_BSTR
	  bstr2 = ConvertStringToBSTR("L1")
	  vBSTR2%VU%PTR_VAL = bstr2
	  range = $Worksheet_GetRange(worksheet, vBSTR1, vBSTR2, status)
	  CALL Check_Status(status, " Unable to get RANGE object")
	  status = VariantClear(vBSTR1)
	  bstr1 = 0
	  status = VariantClear(vBSTR2)
	  bstr2 = 0

	  status = AUTOSETPROPERTY (range, "VALUE", cellCounts)
	  CALL Range_Select(range, status)
	  charts = $Workbook_GetCharts(workbook, $STATUS = status)
	  CALL Check_Status(status, " Unable to get CHARTS object")
	  chart = Charts_Add(charts, $STATUS = status)
	  CALL Check_Status(status, " Unable to add CHART object")

	! Invoke the ChartWizard to format the chart
	!	chart.ChartWizard(gallery=chartType, title=title, categoryTitle=title, valueTitle=title)
	  CALL VariantInit(vInt)
	  vInt%VT = VT_I4
	  vInt%VU%LONG_VAL = 11
	  CALL VariantInit(vBSTR1)
	  vBSTR1%VT = VT_BSTR
	  bstr1 = ConvertStringToBSTR("Dice Histogram")
	  vBSTR1%VU%PTR_VAL = bstr1
	  CALL VariantInit(vBSTR2)
	  vBSTR2%VT = VT_BSTR
	  bstr2 = ConvertStringToBSTR("Roll")
	  vBSTR2%VU%PTR_VAL = bstr2
	  CALL VariantInit(vBSTR3)
	  vBSTR3%VT = VT_BSTR
	  bstr3 = ConvertStringToBSTR("Times")
	  vBSTR3%VU%PTR_VAL = bstr3
 	  CALL $Chart_ChartWizard(chart, &
			Gallery = vInt, &
			Title = vBSTR1, &
			CategoryTitle = vBSTR2, &
			ValueTitle = vBSTR3, &
			$STATUS = status)
	  CALL Check_Status(status, " Unable to invoke ChartWizard")
	  status = VariantClear(vBSTR1)
	  bstr1 = 0
	  status = VariantClear(vBSTR2)
	  bstr2 = 0
	  status = VariantClear(vBSTR3)
	  bstr3 = 0

	! Determine the number of times to roll the dice
	  IF (NARGS() > 1) THEN
		  CALL GETARG(1_2, loopc)
		  READ(loopc, *) loopcount
	  ELSE
		  loopcount = 1000;
	  END IF

	! Set some chart properties
	  CALL VariantInit(vInt)
	  vInt%VT = VT_I4
	  vInt%VU%LONG_VAL = xlValue
	  valueAxis = $Chart_Axes(chart, vInt, xlPrimary, $STATUS = status)
	  CALL Check_Status(status, " Unable to get AXIS object")

	  maxScale = loopcount/5
	  status = AUTOSETPROPERTY (valueAxis, "MaximumScale", maxScale)
	  CALL Check_Status(status, " Unable to set AXIS MaximumScale")

	! Loop the specified number of times 
	  CALL SEED(RND$TIMESEED)
	  DO i=1,loopcount
		  CALL RANDOM(rnd)
		  die1 = NINT((rnd * 6) + 0.5)
		  CALL RANDOM(rnd)
		  die2 = NINT((rnd * 6) + 0.5)
		  roll = die1 + die2
		  cellCounts(roll) = cellCounts(roll) + 1
		  IF (MOD(i, 200) == 0) THEN
			  status = AUTOSETPROPERTY (range, "VALUE", cellCounts)
			  CALL Check_Status(status, " Unable to set RANGE value")
		  END IF
	  END DO

	! Release all objects
	  CALL RELEASEOBJECTS()
	  CALL COMUNINITIALIZE()

    END PROGRAM


	SUBROUTINE Check_Status(olestatus, errorMsg)
	  USE ADOBJECTS
      IMPLICIT NONE                       

	  INTEGER*4 olestatus
	  CHARACTER (LEN = *) :: errorMsg

	  IF (olestatus >= 0) THEN
		  RETURN
	  END IF

	! Error handling code
	  CALL RELEASEOBJECTS()
	  WRITE (*, '(A, "; OLE error status = 0x", Z8.8, "; Aborting")') TRIM(errorMsg), olestatus
	  CALL SLEEPQQ(5000)
	  CALL EXIT(-1)

    END SUBROUTINE
