Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
How to AddObject Ole-objects to a form at runtime?
Message
From
18/05/2005 07:24:46
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
 
To
18/05/2005 05:58:54
Evert Meulenkamp
Meulenkamp Automatisering
Hengelo Ov, Netherlands
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Environment versions
Visual FoxPro:
VFP 6 SP3
OS:
Windows '98
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01015240
Message ID:
01015263
Views:
25
>Hello,
>
>My goal is to show different pictures in the original application they were made in, after the user clicks on a button on my form.
>
>The next code does not work because the property "DocumentFile" is protected. I try to set it in the Init() of olePict, a subclass of the baseclass OleObject, to avoid the user-dialog to select a document on creation of the object.
>Does anyone have a suggestion on how to do this, or is there a better way to show pictures in their original applications on VFP6 (Windows 98) (WITHOUT using General fields).
>
>LOCAL lcPicture
>lcPicture = v_pic.pictname && Get name and location of picture from memofield
>THISFORM.AddObject("olePict1","olePict","&lcPicture")
>THISFORM.olePict1.Doverb(0)
>
>Thanks for any suggestions!
>
>Evert.

Having pictures in a general field is a bad idea IMHO. If you'd do that class is 'OleBoundControl'. For a subclassed OleBoundControl you could use the DocumentFile though (it's supported starting with SP3 but get SP5 first).ie:
lcDocument = Getfile('DOC')
Set Textmerge To Memvar myVar Noshow
Set Textmerge On
\DEFINE CLASS oleWordObject as OLEControl
\	OleClass ="Word.document"		&& Server name
\	OleTypeAllowed = 0			&& Linked
\	DocumentFile = "<<lcDocument>>"	&& This file should exist
\ENDDEFINE
Set Textmerge To
Set Textmerge Off
lcTempClass = Sys(2015)+'.prg'
Strtofile(myVar, lcTempClass)
Compile (lcTempClass)

oform = Createobject("myForm")
With oform
  .Height = 420
  .Width = 620
  .Newobject("WordObject","oleWordObject",lcTempClass)  && Add OLE object
  With .WordObject
    .Left = 5
    .Top = 5
    .Width = .Parent.Width - 10
    .Height = .Parent.Height - 10
    .Visible = .T.
  Endwith
Endwith
oform.Show
Read Events
Clear Class 'oleWordObject'
Erase (Juststem(lcTempClass)+'.*')

Define Class myForm As Form
  Procedure QueryUnload
    Clear Events
  EndProc
Enddefine
However you'd notice that you should know the server too. Say for jpg server on your box might be SomeJPEGViewer.exe and it might not exist on user's computer. You might skip specifying server to workaround but I don't know what would happen then.

For pictures you're lucky it's easier to manage (but I suggest you to forget inplace activation - it's ill behaving. If you need editing ShellExecute).
1) Use external files and keep just path&filename. Use image control on form to show.
2) Use memo binary instead of general. You could then anytime 'extract' on disk and process with say shellexecute or just show with an image control.

Using one of the above HTML is a nice and easy picture viewer. ie:
oForm = createobject('form1')
oForm.show()
Read events

Define CLASS form1 AS form
  Top = 0
  Left = 0
  Height = 470
  Width = 740
  DoCreate = .T.
  Caption = "HTML sample"
  Name = "Form1"
  HTMLFile='' && Custom prpoperty to hold temp .htm name

* This is IE control - you'd use webbrowser4 from gallery instead
* just because it already has some checks, extra pem. ie: wouldn't need readystate part
* for the sake of keeping code short here I directly use olecontrol itself
  Add OBJECT htmlviewer AS olecontrol WITH ;
    Top = 12, ;
    Left = 12, ;
    Height = 396, ;
    Width = 708, ;
    Visible = .T., ;
    Name = "HTMLViewer", ;
    OleClass = 'Shell.Explorer'

  Add OBJECT text1 AS textbox WITH ;
    Height = 25, ;
    Left = 12, ;
    Top = 432, ;
    Width = 60, ;
    Name = "Text1"

  Add OBJECT text2 AS textbox WITH ;
    Height = 23, ;
    Left = 84, ;
    Top = 432, ;
    Width = 204, ;
    Name = "Text2"

  Add OBJECT text3 AS textbox WITH ;
    Height = 23, ;
    Left = 300, ;
    Top = 432, ;
    Width = 125, ;
    Name = "Text3"

  Add OBJECT text4 AS textbox WITH ;
    Height = 23, ;
    Left = 432, ;
    Top = 432, ;
    Width = 125, ;
    Name = "Text4"

  Procedure Init
    Local lnImages, lnPerrow, lnCurrent
    lnImages = adir(arrImages,'myimages\*.gif')
    *You'd use a table let's simulate it
    Create cursor myImages (ImagePath c(50),FirstName c(12), LastName c(12))
    For ix=1 to lnImages
      Insert into myImages values ;
        ('myImages\'+arrImages[ix,1],'FirstName'+trans(ix),'LastName'+trans(ix))
    Endfor
    *Now we have a test table - create HTML
    lnPerRow = 3 && How many would we show on a line
    lnCurrent = 0 && Do not use recno() thinking it might be ordered on an index
    This.HTMLFile = sys(2015)+'.htm'

    Set textmerge on
    Set textmerge to (this.HTMLFile) noshow
    * Initialize lcHTML
		\<HTML><BODY><TABLE>
    Select myImages
    Scan
      lnCurrent = lnCurrent+1
      If (lnCurrent-1)%lnPerRow=0
        If lnCurrent>1
		\</TR>
        Endif
		\<TR>
      Endif
		\<TD><A href="<<trans(recno())>>"><img border="0" src="<<trim(chrtran(ImagePath,'\','/'))>>"></A></TD>
    Endscan
		\</TR>
		\</TABLE></BODY></HTML>
    Set textmerge to
    Set textmerge off
*!*	    Modify Command (this.HTMLFile) && If you ever wonder created HTML
    With ThisForm.htmlviewer
      .Navigate2('file://'+sys(5)+curdir()+this.HTMLFile)
      Do while .ReadyState # 4 && Wait for ready state
      Enddo
    Endwith
  Endproc


  Procedure htmlviewer.BeforeNavigate2
    *** ActiveX Control Event ***
    Lparameters pdisp, url, flags, targetframename, postdata, headers, cancel
    Cancel = .t.  && do not navigate to anywhere
    With thisform && with webbrowser4 also this.oHost is the form itself or container
      .text1.value = justfname(url)
      Go val(justfname(url)) in 'myImages'
      .text2.value = myImages.ImagePath
      .text3.value = myImages.FirstName
      .text4.value = myImages.LastName
    Endwith
  Endproc

  Procedure queryunload
    Clear events
  Endproc
  Procedure destroy
    Erase (this.HTMLFile)
  Endproc
Enddefine
PS: For the latter myImages folder has copy of images from samples data\graphics.
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform