Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
SCALE picture and retain shape in WORD 2000???
Message
From
08/03/2000 10:12:06
 
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
00341929
Message ID:
00343256
Views:
27
Hi Ed,

Sorry it took so long to get back to you. I have to thank you for all of your time and ideas. I read your code and BANG... I kicked it up a notch.
I found out that pictures placed in a word document are initially inserted into the text layer. You can then move them onto the drawing layer. Once you are on the drawing layer all hell breaks loose. You can totally manipulate all aspects of the picture via vfp. The .activedocument.SHAPES collection is your interface to the pictures. I placed 6 shapes on the drawing layer of a document. Each of the shapes are linked to a seperate BMP. I have a zip file which shows the 6 place holding pictures and the merge of the photos with the patient's photos. Below you will find the code. I will email you the zip file of the word documents. ENJOY and please comment
lparameters tcfiletoopen
local lcFileToOpen
lcFileToOpen = iif(type('tcFileToOpen')='C',tcFileToOpen,'')
**********************************************************
**********************************************************
**********************************************************

**  WordMe.dbf is a table on the local drive which has an ODBC connection
**  to it.  This enables WordMe to be WORD's datasource for the merge document

select 0
use c:\thx1138\wordme alias wordme
goto top

** load patient data into table Wordme for mailmerge
replace pttitle with alltrim(v_patients.ctitle) in wordme
replace ptfirst with alltrim(v_patients.cfirstname) in wordme
replace ptlast with alltrim(v_patients.clastname) in wordme
replace ptadd1 with alltrim(v_patients.caddress1) in wordme
replace ptadd2 with alltrim(v_patients.caddress2) in wordme
replace ptcsz with alltrim(v_patients.ccity) + ', ' +;
 alltrim(v_patients.cstate) + ;
  '  ' +  alltrim(v_patients.czip) in wordme

** load dds data into table Wordme for mailmerge
replace drtitle with 'Dr.'
replace drfirst with alltrim(v_onedentist.cfirstname) in wordme
replace drlast with  alltrim(v_onedentist.clastname) in wordme
replace dradd1 with alltrim(v_onedentist.caddress1) in wordme
replace dradd2 with alltrim(v_onedentist.caddress2) in wordme
replace drcsz with alltrim(v_onedentist.ccity) + ', ' +;
 alltrim(v_onedentist.cstate) + ;
 ' ' + alltrim(v_onedentist.czip) in wordme
 
 ** load guarantor data in table Wordme for mailmerge
 replace gtitle with alltrim(v_moms.ctitle) in wordme
 replace gfirst with alltrim(v_moms.cfirstname) in wordme
 replace glast with alltrim(v_moms.clastname)  in wordme
 replace gadd1 with  alltrim(v_moms.caddress1) in wordme
 replace gadd2 with alltrim(v_moms.caddress2) in wordme
 replace gcsz  with alltrim(v_moms.ccity) + ', ' + ;
 alltrim(v_moms.cstate) + '  ' + ;
  alltrim(v_moms.czip) in wordme

** select wordme
if used("wordme")
  use in wordme
endif  

*************************************************************
*************************************************************
*************************************************************

   ***/ Begin program code /***
   * Code to create a new data source to a VFP table.
   *
   * Use the Declare DLL function to prototype the
   * SQLConfigDataSource function.
   
   * Using SQLConfigDataSource prevents having to go into
   * the ODBC Driver Manager and create the DSN.
   ***

   *   DECLARE Integer SQLConfigDataSource in odbccp32.dll Integer, ;
   *   Integer, String, String

   **  you must deal with path to wordme.dbf in 3 spots
   
   ***
   *  Create a string containing the settings appropriate to the driver.
   *  The following is an example for the Microsoft VFP ODBC driver
   *  accessing the Customer.dbf file.
   ***
   *  NOTE: Ensure there are no spaces on either side of the equal sign (=).
   *** Change the path below to point to the Customer table ***
   *** in the \Samples\Data folder.                      ***
   
            settings="DSN=thx1138 Word DataSource"+chr(0)+;
	             "Description=VFP ODBC Driver"+chr(0)+;
	             "SourceDB=c:\thx1138"+chr(0)+;
	             "SourceType=DBF"
   
   ** make a new odbc data source if it is not already present           
   =SQLConfigDataSource(0,1,"Microsoft Visual FoxPro Driver",settings)
   
*!* ****************************************************************
*!* ********************
*!*	* Create word object
*!*	********************
	If type("oWordDocument") = "O" ;
	    and type("gHwndWord") = "N" ;
	    and IsWindow(gHwndWord) # 0 && Check if word window is alive
	  oWordDocument=getobject(, "Word.application")	&& get instance
   Else
	  oWordDocument=createobject("word.application") && Create word object
	Endif
*!*	********************
*!*	* Create word object
*!*	********************

    cLinkSource =''
    
	With oWordDocument
         
         dsname="c:\thx1138\wordme.dbf"
         wformat=0
         wconfirmconv=0
         wreadonly=0
         wlinktosource=0
         waddtofilelist=0
         wpassworddoc=""
         wpasswordtemp=""
         wrevert=0
         wprotectdoc=""
         wprotecttemp=""

             wconn="DSN=thx1138 Word DataSource;uid=;pwd=;"+;
	            "sourcedb=c:\thx1138;sourcetype=dbf"+;
	            "exclusive=no;backgroundfetch=yes;collate=machine;"
	         wsqlstatement="SELECT * FROM wordme" 
         
         .WindowState = 2  && Minimize

           if empty(lcFileToOpen)
            .Documents.Add      && Add new document.
           else
           .Documents.Open(lcFileToOpen) && open an existing document
           endif 
           
          .Visible=.T.      && Make Word visible.    
          .Activate      
         
         ***********************************************************************
         ** SCAN THE DOCUMENT'S DRAWING LAYER FOR SHAPES.  SHAPES WITH A 
         ** .LINKFORMAT.SOURCENAME = PHOTO1.JPG - PHOTO10.JPG ARE PHOTO PLACE 
         ** HOLDERS.  THE SHAPES DETERMINE THE TOP, 
         ** LEFT, MAX ALLOWABLE HEIGHT AND MAX ALLOWABLE WIDTH OF THE PATIENT'S 
         ** PHOTOS TO BE DISPLAYED.
         ** SET THE WIDTH AND HEIGHT OF THE PATIENT'S PHOTOS TO PRESERVE ASPECT RATIO
         ** WITHIN THE SPACE PROVIDED BY SHAPES.
         ************************************************************************
         
         ** how many shapes are in the DRAWING LAYER of the WORD document
         store .activedocument.shapes.count to nNumOfShapes  
         
         if nNumOfShapes <> 0
           
           ** loop thru the Shapes collection
           for uuu = 1 to nNumOfShapes
             
             ** collect the shape's dimensions, position and linked to file   
		     cLinkSource = juststem(.activedocument.shapes(uuu).LinkFormat.SourceName)
		     WidthAllowed = .activedocument.shapes(uuu).Width
		     HeightAllowed = .activedocument.shapes(uuu).Height
		     nTop = .activedocument.shapes(uuu).Top
		     nLeft = .activedocument.shapes(uuu).Left
		     
		     ** BitMaps.dbf is a temp cursor created by the calling module.
		     ** The calling module determines the height and width of
		     ** the BITMAP representations of each of the patient's photos.
		     ** BITMAPS has an index on the cImageName called cImage
		     
		     if seek(cLinkSource, 'BitMaps', 'cImage')
		     
		       ** get the height and width of the patient's photo
		       ** measurements are in points (72 points to the logical inch. WORD likes that)
		       HeightFactor = BitMaps.nHeight
		       WidthFactor  = BitMaps.nWidth
		       
		       
		        && Center the patient's photo in the shape, preserving the aspect ratio.
				&& Check to see if using the maximum width will make the image too tall.
				&& Set the dimensions based on the result.

				IF ((WidthAllowed * HeightFactor) / WidthFactor) < HeightAllowed 
				    .ActiveDocument.Shapes(uuu).Left = nleft + WidthAllowed/ 8
				    .ActiveDocument.Shapes(uuu).Width = WidthAllowed
				    .ActiveDocument.Shapes(uuu).Height = ;
				      (.ActiveDocument.Shapes(uuu).Width * HeightFactor) / WidthFactor
				      .ActiveDocument.Shapes(uuu).Top = (HeightAllowed - ;
				      .ActiveDocument.Shapes(uuu).Height) /2 + ntop
				    
				ELSE
				    .ActiveDocument.Shapes(uuu).Top = ntop + HeightAllowed / 8
				    .ActiveDocument.Shapes(uuu).Height = HeightAllowed
				    .ActiveDocument.Shapes(uuu).Width = ;
				      (.ActiveDocument.Shapes(uuu).Height * WidthFactor) / HeightFactor
				    .ActiveDocument.Shapes(uuu).Left = ;
				      (WidthAllowed - .ActiveDocument.Shapes(uuu).width) / 2 + ;
				      nleft
				ENDIF

		     endif seek(cLinkSource, 'BitMaps', 'cImage')
		     
		   endfor uuu = 1 to nNumOfShapes
		   
         endif nNumOfShapes <> 0
         
         ***********************************************************************
         ** SCAN THE DOCUMENT'S DRAWING LAYER FOR SHAPES.  SHAPES WITH A 
         ** .LINKFORMAT.SOURCENAME = PHOTO1.JPG - PHOTO10.JPG ARE PHOTO PLACE 
         ** HOLDERS.  THE SHAPES DETERMINE THE TOP, 
         ** LEFT, MAX ALLOWABLE HEIGHT AND MAX ALLOWABLE WIDTH OF THE PATIENT'S 
         ** PHOTOS TO BE DISPLAYED.
         ** SET THE WIDTH AND HEIGHT OF THE PATIENT'S PHOTOS TO PRESERVE ASPECT RATIO
         ** WITHIN THE SPACE PROVIDED BY SHAPES.
         ************************************************************************
         
         .WindowState = 0 && enlarge window to previous state
            
      ENDWITH

	gHwndWord = GetForegroundWindow() && Save word window handle
	Do while IsWindow(gHwndWord) # 0  && Wait while Word is alive
     =inkey(2)
	Enddo

	oWordDocument=.Null. && kill the beast and move on with vfp 
Neil
drgorin@mindsping.com

>Neil,
>
>The following is an example of the code to programmatically transfer the photos:
>
>NOTES:
>1) CheckClass verifies the existance of a registered class
>2) oRef is an object reference to a form where the grid is displayed
>3) createdir just creates the directory
>4) start_def is a application variable that holds the starting drive:\folder
>5) whichrep.scx is a modal dialog where the user may select whether they want all records, untagged records or just tagged records.
>
>If you have any problems reading this email me at ed@arismls.com
>
>Good Luck,
>
>ED
>
>PRIVATE delonly, uchoice, inarea, rcount, dtemplate, inrec, sectcnt, maxsect, ;
>  dsect, drange, rangestart, dtable, dfields, mm
>
>IF TYPE('diagnum') = 'U'
>  PUBLIC diagnum
>  diagnum = 1
>ENDIF
>inarea = ALIAS()
>IF !EOF() AND !BOF()
>  inrec = RECNO()
>ELSE
>  inrec = 0
>ENDIF
>IF CheckClass('Word.Application') AND TYPE('oRef') = 'O'
>  =createdir(start_def + 'WORDMERGE')
>  delonly = .F.
>  uchoice = 3
>  DO FORM whichrep.scx WITH 2 TO uchoice
>  DOEVENTS
>  IF uchoice = 3
>    oRef.Lead1.Setfocus()
>    RETURN
>  ELSE
>    SET SAFETY OFF
>    COPY STRUCTURE TO (start_def + 'WORDMERGE\worddata.dbf')
>    SELECT 0
>    USE (start_def + 'WORDMERGE\worddata.dbf') IN 0 EXCLUSIVE
>    SELECT (inarea)
>    GO TOP
>    DO WHILE !EOF()
>      SCATTER MEMO MEMVAR
>      IF uchoice = 1 OR (DELETED() AND uchoice = 2)
>        WAIT WINDOW "Adding Listing # " + ALLT(STR(m.mls_num)) + ;
>          " To " + start_def + 'WORDMERGE\worddata.dbf' NOWAIT
>        INSERT INTO worddata FROM MEMVAR
>      ENDIF
>      SKIP
>    ENDDO
>    SET SAFETY ON
>  ENDIF
>  SELECT worddata
>  RECALL ALL
>  rcount = RECCOUNT('worddata')
>  USE
>  IF rcount > 0
>    WAIT WINDOW 'Listings Outputted To ' + start_def + 'WORDMERGE\worddata.dbf' TIMEOUT 3
>    SET DEFAULT TO (start_def + 'WORDMERGE')
>    dtemplate = GETFILE('dot','Templates')
>    SET DEFAULT TO (start_def)
>    ON ERROR *
>    wordapp=GetObject('','Word.Application')
>    IF !EMPTY(dtemplate)
>      WAIT WINDOW "Creating Document From " + ALLT(dtemplate) NOWAIT
>      wordapp.documents.add(dtemplate)
>      mm=wordapp.activedocument.mailmerge
>      IF mm.state = 2
>        dfields = mm.fields            && Get MailMergeFields Object
>        IF dfields.count > 0
>          WAIT WINDOW "Merging Data To New Document" NOWAIT
>          mm.destination = 0          && Send To New Document
>          mm.execute              && Perform Merge
>          WAIT WINDOW "MS-Word Merge Completed" TIMEOUT 1
>        ELSE
>          =MESSAGEBOX("NO MERGE FIELDS IN MAIN MERGE DOCUMENT" + CHR(13) + ;
>            "Please Edit Your Document Template " + CHR(13) + ;
>            "(" + dtemplate + ")" + CHR(13) + ;
>            "And Add The Appropriate Fields",48,;
>            "Check You Document Template")
>          wordapp.documents.close(0)      && Close New Document
>          WAIT WINDOW "Opening " + dtemplate TIMEOUT 1
>          wordapp.documents.open(dtemplate)  && Open Template
>        ENDIF
>      ELSE
>        DO CASE
>        CASE mm.state = 0
>          =MESSAGEBOX("New Document Is Not A Main Merge Document",48,;
>            "Check You Document Template")
>        CASE mm.state = 1
>          =MESSAGEBOX("Main Merge Document Is Missing Data Source",48,;
>            "Check You Document Template")
>        ENDCASE
>        wordapp.visible = .T.
>        RETURN
>      ENDIF
>      maxsect = wordapp.activedocument.sections.count
>      sectcnt = 0
>      SELECT (inarea)
>      GO TOP
>      DO WHILE !EOF()
>        IF uchoice = 1 OR (DELETED() AND uchoice = 2)
>          sectcnt = sectcnt + 1
>          IF sectcnt <= maxsect
>            WAIT WINDOW "Adding Picture For Listing # " + ALLT(STR(mls_num)) NOWAIT
>            dsect = wordapp.activedocument.sections(sectcnt)
>            drange = dsect.range
>            rangestart = drange.start
>            drange.insertbefore('<{ARISPICTURE}>')
>            oRef.Refresh()
>            oRef.Lead1.Copy(3)
>            wordapp.selection.find.text = '<{ARISPICTURE}>'
>            wordapp.selection.find.forward = .T.
>            wordapp.selection.find.execute
>            IF !EMPTY(wordapp.selection.find.found)
>              wordapp.selection.paste()
>            ENDIF
>          ENDIF
>        ENDIF
>        SKIP
>      ENDDO
>      WAIT WINDOW "MS-Word Merge With Picture Completed" TIMEOUT 1
>      wordapp.visible = .T.
>    ELSE
>      WAIT WINDOW "Select FoxPro Files via ODBC In The Next Dialog" TIMEOUT 2
>      wordapp.documents.add()
>      mm=wordapp.activedocument.mailmerge
>      mm.maindocumenttype = 0
>      wordapp.visible = .T.
>      mm.opendatasource(start_def + 'WORDMERGE\worddata.dbf')
>    ENDIF
>    ON ERROR DO apperror WITH PROGRAM(), MESSAGE(), MESSAGE(1), ;
>      LINENO(), ERROR(), 0
>  ELSE
>    WAIT WINDOW 'No Listings Outputted' TIMEOUT 3
>  ENDIF
>  IF !EMPTY(inarea)
>    SELECT (inarea)
>    IF !EMPTY(inrec)
>      GO (inrec)
>    ELSE
>      GO TOP
>    ENDIF
>    oRef.Refresh()
>  ELSE
>    SELECT 0
>  ENDIF
>  GO TOP
>  oRef.Lead1.Setfocus()
>ELSE
>  IF !CheckClass('Word.Application')
>    WAIT WINDOW 'Sorry...Word Is Not Installed or Functioning Incorrectly' TIMEOUT 3
>  ENDIF
>ENDIF
>WAIT CLEAR
>DOEVENTS
Previous
Reply
Map
View

Click here to load this message in the networking platform