en Ejemplos, Harbour

Ejemplo TestOle (testole.prg)

/*
 * $Id: testole.prg 15174 2010-07-25 08:45:50Z vszakats $
 */

/*
 
* Harbour Project source code
 *
 * hbole library demo/test code
 *
 * Copyright 2007 Enrico Maria Giordano e.m.giordano at emagsoftware.it
 * Copyright 2009 Mindaugas Kavaliauskas <dbtopas at dbtopas.lt>
 * Copyright 2008 Viktor Szakats (harbour.01 syenar.hu)
 *
 * www – http://harbour-project.org
 *
 */

PROCEDURE Main()
  
LOCAL nOption

   DO WHILE .T.
     
? ""
     
? "Select OLE test:"
     
? "1) MS Excel"
     
? "2) MS Word"
     
? "3) MS Outlook (1)"
     
? "4) MS Outlook (2)"
     
? "5) Internet Explorer"
     
? "0) Quit"
     
? "> "

      nOption := Inkey( 0 )
     
?? Chr( nOption )

      IF     nOption == Asc( "1" )
        
Exm_MSExcel()
     
ELSEIF nOption == Asc( "2" )
        
Exm_MSWord()
     
ELSEIF nOption == Asc( "3" )
        
Exm_MSOutlook()
     
ELSEIF nOption == Asc( "4" )
        
Exm_MSOutlook2()
     
ELSEIF nOption == Asc( "5" )
        
Exm_IExplorer()
     
ELSEIF nOption == Asc( "0" )
        
EXIT
     
ENDIF
  
ENDDO

   RETURN

STATIC PROCEDURE Exm_MSExcel()
  
LOCAL oExcel, oWorkBook, oWorkSheet, oAS
  
LOCAL nI, nCount

   IF ( oExcel := win_oleCreateObject( "Excel.Application" ) ) != NIL

      oWorkBook := oExcel:WorkBooks:Add()

      // Enumerator test
     
FOR EACH oWorkSheet IN oWorkBook:WorkSheets
        
? oWorkSheet:Name
     
NEXT

      // oWorkBook:WorkSheets is a collection
     
nCount := oWorkBook:WorkSheets:Count()

      // Elements of collection can be accessed using :Item() method
     
FOR nI := 1 TO nCount
        
? oWorkBook:WorkSheets:Item( nI ):Name
     
NEXT

      // OLE also allows to access collection elements by passing
     
// indices to :Worksheets property
     
FOR nI := 1 TO nCount
        
? oWorkBook:WorkSheets(nI):Name
     
NEXT

      oAS := oExcel:ActiveSheet()

      // Set font for all cells
     
oAS:Cells:Font:Name := "Arial"
     
oAS:Cells:Font:Size := 12

      oAS:Cells( 1, 1 ):Value := "OLE from Harbour"
     
oAS:Cells( 1, 1 ):Font:Size := 16

      // oAS:Cells( 1, 1 ) is object,
     
// but oAS:Cells( 1, 1 ):Value has value of the cell
     
? "Object valtype:", ValType( oAS:Cells( 1, 1 ) ), ;
        "Value:"
, oAS:Cells( 1, 1 ):Value

      oAS:Cells( 3, 1 ):Value := "String:"
     
oAS:Cells( 3, 2 ):Value := "Hello, World!"

      oAS:Cells( 4, 1 ):Value := "Numeric:"
     
oAS:Cells( 4, 2 ):Value := 1234.56
     
oAS:Cells( 4, 3 ):Value := oAS:Cells( 4, 2 ):Value
     
oAS:Cells( 4, 4 ):Value := oAS:Cells( 4, 2 ):Value
     
oAS:Cells( 4, 3 ):Value *= 2
     
oAS:Cells( 4, 2 ):Value++

      oAS:Cells( 5, 1 ):Value := "Logical:"
     
oAS:Cells( 5, 2 ):Value := .T.

      oAS:Cells( 6, 1 ):Value := "Date:"
     
oAS:Cells( 6, 2 ):Value := DATE()

      oAS:Cells( 7, 1 ):Value := "Timestamp:"
     
oAS:Cells( 7, 2 ):Value := HB_DATETIME()

      // Some formatting
     
oAS:Columns( 1 ):Font:Bold := .T.
     
oAS:Columns( 2 ):HorizontalAlignment := 4152  // xlRight

      oAS:Columns( 1 ):AutoFit()
     
oAS:Columns( 2 ):AutoFit()
     
oAS:Columns( 3 ):AutoFit()
     
oAS:Columns( 4 ):AutoFit()

      oAS:Cells( 3, 2 ):Font:ColorIndex := 3  // red

      oAS:Range( "A1:B1" ):HorizontalAlignment := 7
     
oAS:Range( "A3:A7" ):Select()

      oExcel:Visible := .T.

      oExcel:Quit()
  
ELSE
     
? "Error: MS Excel not available. [" + win_oleErrorText()+ "]"
  
ENDIF

   RETURN

STATIC PROCEDURE Exm_MSWord()
  
LOCAL oWord, oText

   IF ( oWord := win_oleCreateObject( "Word.Application" ) ) != NIL

      oWord:Documents:Add()

      oText := oWord:Selection()

      oText:Text := "OLE from Harbour" + hb_eol()
     
oText:Font:Name := "Arial"
     
oText:Font:Size := 48
     
oText:Font:Bold := .T.

      oWord:Visible := .T.
     
oWord:WindowState := 1 /* Maximize */
  
ELSE
     
? "Error. MS Word not available.", win_oleErrorText()
  
ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook()
  
LOCAL oOL, oList

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL
     
oList := oOL:CreateItem( 7 /* olDistributionListItem */ )
     
oList:DLName := "Distribution List"
     
oList:Display( .F. )
  
ELSE
     
? "Error. MS Outlook not available.", win_oleErrorText()
  
ENDIF

   RETURN

STATIC PROCEDURE Exm_MSOutlook2()
  
LOCAL oOL, oLista, oMail
  
LOCAL i

   IF ( oOL := win_oleCreateObject( "Outlook.Application" ) ) != NIL

      oMail := oOL:CreateItem( 0 /* olMailItem */ )

      FOR i := 1 TO 10
        
oMail:Recipients:Add( "Contact" + LTRIM( STR( i, 2 ) ) + ;
               "<contact"
+ LTRIM( STR( i, 2 ) ) + "@server.com>" )
     
NEXT

      oLista := oOL:CreateItem( 7 /* olDistributionListItem */ )
     
oLista:DLName := "Test with distribution list"
     
oLista:Display( .F. )
     
oLista:AddMembers( oMail:Recipients )
     
oLista:Save()
     
oLista:Close( 0 )
  
ELSE
     
? "Error. MS Outlook not available.", win_oleErrorText()
  
ENDIF

   RETURN

STATIC PROCEDURE Exm_IExplorer()
  
LOCAL oIE

   IF ( oIE := win_oleCreateObject( "InternetExplorer.Application" ) ) != NIL
     
oIE:Visible := .T.
     
oIE:Navigate( "http://harbour-project.org" )
  
ELSE
     
? "Error. IExplorer not available.", win_oleErrorText()
  
ENDIF

   RETURN

30-08-2010 22-18-40

30-08-2010 22-19-50

30-08-2010 22-20-36

30-08-2010 22-21-24

30-08-2010 22-22-05