<![CDATA[Fox4um - Com / Dcom ve OLE]]> 2012-01-13T17:33:58Z PunBB http://www.fox4um.com/ <![CDATA[Gelişmiş Ole Rtf Veya Form içinde Excel/Word]]> Selamlar;

Aşağıdaki resimde temsili olarak gösterilen değişik renk ve boylarda yazı yazabileceğim, resim ekleyebileceğim kısaca form içinde Excel veya Word özelliklerini kullanabileceğim ve bunları kaydedip, değiştirebileceğim bir araç aramaktayım.
Ücretli/Ücretsiz farketmez.

Soykana gönderidiği OLE RTF uygulamaları için teşekkür ederim. 
Daha önce de Ole rtf ile ilgilhttp://www.fox4um.com/extensions/fext_bbcode/buttons/Oxygen/img.pngi 1-2 çalışmam olmuştu.  Bunula son kullanıcı çok zorlanıyor.
Son kullanıcı için kullanımı kolay bir şey aramaktayım.
Yardımlarınızı bekliyorum. Şimdiden teşekkürler.

http://www.wagner.com.tr/vfpresim/20111221134723847kesim_1.jpg

]]> http://www.fox4um.com/user/23/ 2012-01-13T17:33:58Z http://www.fox4um.com/topic/2093/gelismis-ole-rtf-veya-form-icinde-excelword/new/posts/ <![CDATA[HTML ornek]]>
Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

Public oForm

oForm = Createobject('htmlSample', GetHTML())

oForm.Show()

 

Function GetHTML

  *Return HTMLShowerx()

  Local myVar

  TEXT to myVar noshow

<html>

<head>

<title>New User Sign Up</title>

<script language="JScript">

function LoadTreeView()

{

    var TreeView1 = document.all('Tree001');

    var oNode = TreeView1.Nodes.Add(null,0,"top","My Tree");

    TreeView1.Nodes.Add("top",4,"root0","Main node 0");

    TreeView1.Nodes.Add("top",4,"root1","Main node 1");

    TreeView1.Nodes.Add("top",4,"root2","Main node 2");

    TreeView1.Nodes.Add("root1",4,"child11","Child11");

    TreeView1.Nodes.Add("root1",4,"child12","Child12");

    TreeView1.Nodes.Add("root2",4,"child21","Child21");

    TreeView1.Nodes.Add("child11",4,"child111","child111");

    TreeView1.Nodes.Add("child11",4,"child113","child113");

    TreeView1.Nodes.Add("child113",3,"child112","child112");

    oNode.Expanded = true;

 

    var TreeView2 = document.all('Tree002');

    var oNode = TreeView2.Nodes.Add(null,0,"top","My Tree");

    TreeView2.Nodes.Add("top",4,"root0","Main node 0");

    TreeView2.Nodes.Add("top",4,"root1","Main node 1");

    TreeView2.Nodes.Add("top",4,"root2","Main node 2");

    TreeView2.Nodes.Add("root1",4,"child11","Child11");

    TreeView2.Nodes.Add("root1",4,"child12","Child12");

    TreeView2.Nodes.Add("root2",4,"child21","Child21");

    TreeView2.Nodes.Add("child11",4,"child111","child111");

    TreeView2.Nodes.Add("child11",4,"child113","child113");

    TreeView2.Nodes.Add("child113",3,"child112","child112");

    oNode.Expanded = true;

 

}

function CheckTable(dbcPath,dbfName)

{

  var strCn = "Provider=VFPOLEDB;Data Source=" + dbcPath;

  var strSQL = "select * from " + dbfName;

 

  var oConn = new ActiveXObject("Adodb.Connection");

  oConn.ConnectionString = strCn;

  oConn.Open;

  var oRS = oConn.Execute(strSQL);

 

  var lst="<TABLE border='1'><TR>";

  var Maxfields=5;

  var MaxRows=20;

 

  for (i=0;i<Math.min(oRS.Fields.Count,Maxfields);i++)

  {

    lst += "<TH>";

    lst += oRS.Fields(i).Name;

    lst += "</TH>";

  }

  lst += "</TR>";

 

  var counter=0;

  while (!oRS.eof && counter < MaxRows)

  {

    lst += "<TR>";

    for (i=0;i<Math.min(oRS.Fields.Count,Maxfields);i++)

    {

      lst += "<TD>";

      lst += oRS.Fields(i).Value;

      lst += "</TD>";

    }

    lst += "</TR>";

    oRS.MoveNext();

    counter++;

  }

  lst += "</TABLE>";

  oConn.Close();

  tablelist.innerHTML = lst;

  return true;

}

</script>

</head>

<body bgcolor=Turquoise onload="LoadTreeView();">

<h1 align="Center"><font color="#000080">New User Sign Up</font></h1>

<form method="GET" action="empty.htm" target="_self" name="myForm">

    <table border="0" cellspacing="1">

      <tr><td>ID</td><td><input type="text" name="ID" ID="SSNNumber" size="16" maxlength="16"></td></tr>

      <tr><td>First Name</td><td><input type="text" name="First" size="30" maxlength="15"></td></tr>

      <tr><td>Last Name</td><td><input type="text" name="Last" size="30" maxlength="20"></td></tr>

   <td>Gender?</td>

   <td>

     <select name="Selection1">

       <option value="0">- Gender -</option>

       <option value="1">Female</option>

       <option value="2">Male</option>

     </select></td></tr>

<tr>

   <td>Multi Selection</td>

   <td>

     <select multiple name="MulSelection">

       <option value="0">- Sports you watch -</option>

       <option value="1">Basketball</option>

       <option value="2">Soccer</option>

       <option value="3">Football</option>

       <option value="4">Volleyball</option>

       <option value="5">Formula1</option>

       <option value="6">Nascar</option>

     </select></td></tr>

    </table>

<TEXTAREA ID=txtComments STYLE="overflow:scroll; width:70%; height:150">

Sometimes an HTML based VFP form can be cool.

Think you could have syntax coloring on a form :)

Play flash movie (better play "Need For Speed" - post me too if you find a flash version), have a calendar etc.

</TEXTAREA>

  <p>

<A HREF="newpage.htm" TARGET="_self">Go to New Page.</A>

<input type=submit name=sub1 value="Write" onclick='document.all("submitter").value="writeButton";'>

<input type=submit name=sub2 value="Update" onclick='document.all("submitter").value="updateButton";'>

<input type=submit name=sub3 value="Clear" onclick='document.all("submitter").value="clearButton";'>

 

<p>

<object name="Treeview" classid="clsid:C74190B6-8589-11D1-B16A-00C0F0283628"

  id="Tree001" width="242" height="159">

  <param name="_ExtentX" value="6403">

  <param name="_ExtentY" value="4207">

  <param name="_Version" value="393217">

  <param name="HideSelection" value="0">

  <param name="Indentation" value="1000">

  <param name="LabelEdit" value="0">

  <param name="LineStyle" value="0">

  <param name="PathSeparator" value="/">

  <param name="Sorted" value="0">

  <param name="Style" value="7">

  <param name="Checkboxes" value="0">

  <param name="FullRowSelect" value="0">

  <param name="HotTracking" value="0">

  <param name="Scroll" value="1">

  <param name="SingleSel" value="0">

  <param name="ImageList" value>

  <param name="BorderStyle" value="0">

  <param name="Appearance" value="1">

  <param name="MousePointer" value="0">

  <param name="Enabled" value="1">

  <param name="OLEDragMode" value="0">

  <param name="OLEDropMode" value="0">

</object>

</p>

<p>

<object name="Treeview" classid="clsid:C74190B6-8589-11D1-B16A-00C0F0283628"

  id="Tree002" width="242" height="159">

  <param name="_ExtentX" value="6403">

  <param name="_ExtentY" value="4207">

  <param name="_Version" value="393217">

  <param name="HideSelection" value="0">

  <param name="Indentation" value="1000">

  <param name="LabelEdit" value="0">

  <param name="LineStyle" value="0">

  <param name="PathSeparator" value="/">

  <param name="Sorted" value="0">

  <param name="Style" value="7">

  <param name="Checkboxes" value="0">

  <param name="FullRowSelect" value="0">

  <param name="HotTracking" value="0">

  <param name="Scroll" value="1">

  <param name="SingleSel" value="0">

  <param name="ImageList" value>

  <param name="BorderStyle" value="0">

  <param name="Appearance" value="1">

  <param name="MousePointer" value="0">

  <param name="Enabled" value="1">

  <param name="OLEDragMode" value="0">

  <param name="OLEDropMode" value="0">

</object>

</p>

</form>

<input type=hidden name="submitter" value=0>

<p>Browse a VFP table</p>

<table>

<TR><TD>Locate DBC</TD><TD><input type='file' size='80' name='DBCLOCATION'></TD></TR>

<TR><TD>TableName</TD><TD><input type='text' size='80' name='TABLENAME'></TD></TR>

</TABLE><HR>

<input type='button' value='List' onClick="CheckTable(DBCLOCATION.value,TABLENAME.value);return;">

<div id='tablelist'></div>

</body>

</html>

  ENDTEXT

  Return myVar

 

Define Class htmlSample As Form

  Top = 0

  Left = 0

  Height = 600

  Width = 800

  DoCreate = .T.

  Caption = "HTML sample"

  cHTML = "<html><body></body></html>"

  cHTMFile = ''

  DoNotErase = .T.

 

  Add Object htmlviewer As OleControl With ;

    Top = 0, ;

    Left = 0, ;

    Height = 600, ;

    Width = 800, ;

    Visible = .T., ;

    Name = "HTMLViewer", ;

    OleClass = 'Shell.Explorer'

 

  Procedure Destroy

    If !This.DoNotErase And !Empty(This.cHTMFile) And File(This.cHTMFile)

      Erase (This.cHTMFile)

    Endif

  Endproc

 

  Procedure Init

    Lparameters tcHTML, tlIsFile

    If m.tlIsFile And !Empty(m.tcHTML) And File(m.tcHTML)

      This.cHTMFile = m.tcHTML

      This.DoNotErase = .T.

 

      With Thisform.htmlviewer

        .Navigate2('file://'+This.cHTMFile)

        Do While .ReadyState # 4 && Wait for ready state

        Enddo

      Endwith

    Else

      If !Empty(m.tcHTML)

        This.cHTMFile = Forcepath(Sys(2015)+'.htm',Sys(2023))

        This.DoNotErase = .F.

        Strtofile(m.tcHTML, This.cHTMFile)

 

        With Thisform.htmlviewer

          .Navigate2('file://'+This.cHTMFile)

          Do While .ReadyState # 4 && Wait for ready state

          Enddo

        Endwith

      Else

        With This.htmlviewer

          .Navigate2("about:blank")

          .Document.Write(This.cHTML)

        Endwith

      Endif

    Endif

  Endproc

 

  Procedure htmlviewer.NavigateError

    Lparameters pdisp, url, frame, statuscode, Cancel

    TEXT to m.lcParamList textmerge noshow

  pdisp = pdisp

  url = <<url>>

  frame = <<frame>>

  statuscode = <<statuscode>>

  Cancel = <<Cancel>>

    ENDTEXT

    Messagebox(m.lcParamList)

    Cancel = .T.

  Endproc

 

 

  Procedure htmlviewer.BeforeNavigate2

    Lparameters pdisp, url, Flags, targetframename, postdata, headers, Cancel

    TEXT to m.lcParamList textmerge noshow

  pdisp = pdisp

  url = <<url>>

  flags = <<flags>>

  targetframename = <<targetframename>>

  postdata = <<postdata>>

  headers = <<headers>>

  Cancel = <<Cancel>>

    ENDTEXT

    Messagebox(m.lcParamList)

 

    *  oFrm = This.Object.Document.myForm

    lcVals = ""

    If This.Object.Document.Forms.Length > 0

      For Each oFrm In This.Object.Document.Forms

        lcVals = lcVals + oFrm.Name + Chr(13)

        If oFrm.elements.Length > 0

          For Each oElem In oFrm.elements

            If oElem.Name = "Treeview"

              lcVals = lcVals + "Name :" + oElem.Name + '::'+ oElem.Id +  '::'+ "/Value:"+;

                Iif(!Isnull(oElem.SelectedItem),;

                oElem.SelectedItem.Key,"NULL") + Chr(13)

            Else

              If oElem.Type = "select-multiple"

                lcList=''

                For ix=0 To oElem.Length-1

                  If oElem.Item(ix).Selected

                    lcList = lcList + Iif(Empty(lcList),'',',')+oElem.Item(ix).Value

                  Endif

                Endfor

                lcVals = lcVals + "Name :" + oElem.Name +  '::'+ oElem.Id +  '::'+ "/Value:"+lcList + Chr(13)

              Else

                lcVals = lcVals + "Name :" + oElem.Name + '::'+ oElem.Id +  '::'+ "/Value:"+oElem.Value + Chr(13)

              Endif

            Endif

            oElem = .Null.

          Endfor

        Endif

        oFrm = .Null.

      Endfor

    Endif

    Cancel = .T.  && prevents actual navigation

    lcVals = lcVals + Chr(13)+Chr(10)+;

      'Submitted by:'+Transform(This.Object.Document.All("submitter").Value)

    Messagebox(lcVals)

  Endproc

 

  Procedure htmlviewer.Refresh

    Nodefault

  Endproc

Enddefine
]]> http://www.fox4um.com/user/11/ 2011-12-02T09:45:59Z http://www.fox4um.com/topic/903/html-ornek/new/posts/ <![CDATA[Modemin Hangi portu kullandığını bulmak]]> Sevgili Arkadaşlar,
Nereden bulduğumu hatırlayamadığım ve tamamını sizlerle paylaştığım aşağıdaki ücretsiz bir kod ile program içerisinden telefonu çevirip konuşabiliyordum.

Visual Fox Pro
1

2

3

4

5

6

7

WITH THISFORM.oleControl1

    .Enabled = .T.    

    .sThreshold = 1

    .rThreshold = 1

    .CommPort = 3

    .PortOpen = .T.

    .Output = [ATDT]+ALLT(THISFORM.text1.Value)+CHR(13)


Dün bilgisayarımda bir takım değişiklikler yapılınca program çalışmamaya başladı.
Çalışmamanın nedenin araştırınca modemin COM3 ü değil de COM4 ü kulandığını gördüm. Programdaki .CommPort = 3 komutunu .CommPort = 4 yapınca herşey normale döndü.
Sizlerden ricam şu:
Acaba modemin hangi portu kullandığını otomatik olarak bulabilir miyiz?
Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim.
Sevgilerimle.
Erdal

]]> http://www.fox4um.com/user/794/ 2011-02-10T10:26:20Z http://www.fox4um.com/topic/1914/modemin-hangi-portu-kullandigini-bulmak/new/posts/ <![CDATA[Kod yaz denize at, birinin isine yarar:)]]>
Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

Public oForm

oForm = Createobject('form1')

oForm.Show()

 

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,_samples+'data\graphics\*.gif')

    *You'd use a table let's simulate it

    Create Cursor myImages (ImagePath m,FirstName c(12), LastName c(12))

    For ix=1 To lnImages

      Insert Into myImages Values ;

        (_samples+'data\graphics\'+arrImages[ix,1],'FirstName'+Trans(ix),'LastName'+Trans(ix))

    Endfor

    *Now we have a test table - create HTML

    lnPerRow = 5 && 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" height="100" width="60" 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 Destroy

    Erase (This.HTMLFile)

  Endproc

Enddefine
]]> http://www.fox4um.com/user/11/ 2010-10-21T08:14:14Z http://www.fox4um.com/topic/1645/kod-yaz-denize-at-birinin-isine-yarar/new/posts/ <![CDATA[Grafik - ornek]]> Baska bir nedenle elimden geciyordu buraya atayim dedim, hem sessizligi biaz bozmus olayim:)

Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

*#INCLUDE "mschrt20.h"

#Define VtChChartType3dBar                                0

#Define VtChChartType2dBar                                1

 

#Define VtChLabelComponentValue 1   && The value of the data point appears in the label.

#Define VtChLabelComponentPercent   2   && The value of the data point is displayed in the label as a percentage of the total value of the series.

 

#Define VtOrientationHorizontal 0   && Horizontal text

#Define VtOrientationVertical   1   && Vertical text

#Define VtOrientationUp 2   && Up oriented text

#Define VtOrientationDown   3   && Down oriented text

 

#Define VtChLabelLocationTypeNone   0   && Label Location - None

#Define VtChLabelLocationTypeAbovePoint 1   && Label Location - AbovePoint

#Define VtChLabelLocationTypeBelowPoint 2   && Label Location - BelowPoint

#Define VtChLabelLocationTypeCenter 3   && Label Location - Center

#Define VtChLabelLocationTypeBase   4   && Label Location - Base

#Define VtChLabelLocationTypeInside 5   && Label Location - Inside pie or doughnut

#Define VtChLabelLocationTypeOutside    6   && Label Location - Outside pie or doughnut

#Define VtChLabelLocationTypeLeft   7   && Label Location - Left

#Define VtChLabelLocationTypeRight  8   && Label Location - Right

 

Public loCharter

loCharter = Createobject('myCharter')

loCharter.Show

 

Define Class myCharter As Form

  DataSession = 2

  Height = 600

  Width = 800

  Add Object myGrid As Grid With ;

    left=10,Top=10,Height=580,Width=360,Anchor=1+2+4+128

  Add Object Chart As OleControl With ;

    left=375,Top=10,Height=580,Width=415,Anchor=1+8+4+32, ;

    OleClass="MSChart20Lib.MSChart.2"

 

  Procedure Load

    Use (_samples+'data\Customer')

  Endproc

 

  Procedure Init

    This.UpdateChart()

  Endproc

 

  Procedure myGrid.AfterRowColChange

    Lparameters nColIndex

    * VFP7 and up - earlier no if control

    If This.RowColChange%2 = 1

      Thisform.UpdateChart()

    Endif

  Endproc

 

  Procedure UpdateChart

    Select ;

      emp.First_Name - (' '+emp.Last_Name) As employee,;

      sum(order_net) As totalSale ;

      FROM (_samples+'data\orders') ord ;

      INNER Join (_samples+'data\employee') emp On emp.emp_id = ord.emp_id ;

      WHERE ord.cust_id == customer.cust_id ;

      GROUP By 1 ;

      ORDER By 1 ;

      INTO Cursor crsChartData

    If _Tally > 0

      With Thisform.Chart

        .ChartType = VtChChartType2dBar && VtChChartType2dBar

        rowLabelCount = 1

        rowCount = Reccount()

        columnLabelCount = 0

        ColumnCount = 1

        .DataGrid.SetSize(m.rowLabelCount, m.columnLabelCount, ;

          m.rowCount, m.ColumnCount )

 

        .Column = 1

        Scan

          .Row = Recno()

          .Data = totalSale

          .DataGrid.RowLabel(Recno(),1) = employee

        Endscan

 

        For Each serX In .Plot.SeriesCollection

          With serX.Datapoints.Item(-1).DatapointLabel

            .Component = VtChLabelComponentValue  && Show value

            .LocationType = VtChLabelLocationTypeAbovePoint && Above

            .ValueFormat = '$#,##0.00'

          Endwith

        Endfor

        .Visible = .T.

      Endwith

    Else

      Thisform.Chart.Visible = .F.

    Endif

  Endproc

Enddefine
]]> http://www.fox4um.com/user/11/ 2010-04-23T08:26:12Z http://www.fox4um.com/topic/1119/grafik-ornek/new/posts/ <![CDATA[InternetExplorer.Application]]> Arkadaşlar selam,

Internet.Explorer nesnesini kullanarak bir deneme yaptım. Açılmış Html dokumanı üzerinde değişiklik yapılabiliyor, hatta oradan istediğiniz html parçalarını VFP içine alabiliyorsunuz. Yada Html içindeki nesnelere değer atayabiliyorsunuz.

Gayet güzel ve çalışıyor. Fakat Html içinde var olan bir scripti (Java yada VB ) VFP içinden çalıştırmak istediğimde ;

o.Document.Script.girdidenetle("xyz")

sonucunda "OLE Error Code 0X800220006: Bilinmeyed Ad" 

Hata mesajını aldım. Rick Strahl bir makalesinde, bunun fonksiyon ismindeki büyük/küçük harf uyuşmazlığından kaynaklandığı yazıyordu. Yani Html Dokumanındaki java fonksiyonun adı küçük harflerden oluşmalı diyordu. Bunu denedim ama sonuç aynı.

Bu hata mesajını biraz araştırdığımda bunu VFP nin bir bug ı olduğunu ve VFP 8 SP1 ile düzeltildiğini öğrendim. VFP 9 için böyle bir bug yokmuş.

Ama ben bu hatayı VFP 9 da alıyorum.

Konu hakkında bir öneriniz yada bilginiz varsa yardımcı olursanız sevinirim.

]]> http://www.fox4um.com/user/184/ 2010-04-07T16:51:01Z http://www.fox4um.com/topic/1599/internetexplorerapplication/new/posts/ <![CDATA[MSN messenger ile mesaj ...]]> gondermek icin elinde hazir kodu olan var mi?
Simdiden tesekkurler.

]]> http://www.fox4um.com/user/11/ 2010-03-16T14:42:09Z http://www.fox4um.com/topic/1571/msn-messenger-ile-mesaj/new/posts/ <![CDATA[Başka Bir Pcnin Mac Adresini almak]]> Öncelikle Herkese Merhabalar;
Benim Sorum İstediğim Kendi Ağımda olan bir pcnin mac adresini aldırabilir miyim ?
Sorumu Cevaplayanlara Şimdiden teşekkürler

]]> http://www.fox4um.com/user/172/ 2010-03-08T22:14:26Z http://www.fox4um.com/topic/1562/baska-bir-pcnin-mac-adresini-almak/new/posts/ <![CDATA[Form Üzerinde Html Sayfada Döviz Kurları Gösterimi]]> Arkadaşlar kendimde kullanmayı düşündüğüm bir sey geliştirdim sizlerlede paylaşmak istedim

Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

PUBLIC odaily_currency

 

odaily_currency=NEWOBJECT("daily_currency")

odaily_currency.Show

RETURN

 

 

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

*-- Form:         daily_currency (d:\soykan\mysoftware\depomatik\form\daily_currency.scx)

*-- ParentClass:  form

*-- BaseClass:    form

*-- Time Stamp:   02/15/10 11:35:04 AM

*

DEFINE CLASS daily_currency AS form

 

 

    Top = 0

    Left = 0

    Height = 410

    Width = 211

    DoCreate = .T.

    Tag = "daily_currency"

    BorderStyle = 0

    Caption = "Döviz Kurları"

    MaxButton = .F.

    MinButton = .F.

    Movable = .F.

    Icon = "..\static\vs_ico.ico"

    Name = "daily_currency"

 

 

    ADD OBJECT oie AS olecontrol WITH ;

        Top = 0, ;

        Left = 0, ;

        Height = 410, ;

        Width = 210, ;

        Name = "OIE",;

     OleClass = 'Shell.Explorer'

 

 

 

    PROCEDURE Destroy

        ERASE 'doviz.htm'

        ERASE 'NoDoviz.htm'

    ENDPROC

 

 

    PROCEDURE Init

        Local lcDovizHtml,lcNoDovizHtml

        lcDovizHtml = Sys(5)+Curdir()+'doviz.htm'

        lcNoDovizHtml = Sys(5)+Curdir()+'Nodoviz.htm'

 

        Local lcURL

        lcURL=[http://www.google.com/]

 

        Declare Integer InternetCheckConnection In Wininet.Dll String Url, Long dwFlags, Long Reserved

        If InternetCheckConnection(lcURL, 1, 0) != 0

            *Return .T.

            TEXT TO m.lcDoviz TEXTMERGE noshow

        <script type="text/javascript" src="http://www.doviz.com/script/widget.js">

        </script>

        <script type="text/javascript">_dovizCurrency('USD_EUR','','http://www.doviz.com/')</script>

        <div style="width:100%;text-align:center;font-size:11px">

        <a style="text-decoration:none;color:#000000" href="http://www.doviz.com/" title="Döviz, Dolar, Euro, Sterlin" target="_blank">

        </a>

        </div>

            ENDTEXT

 

 

            If ! File('doviz.htm')

                Strtofile(m.lcDoviz,m.lcDovizHtml)

            Endif

 

            With Thisform.OIE

                .Navigate2('file://'+m.lcDovizHtml)

                Do While .ReadyState # 4 && Wait for ready state

                Enddo

            Endwith

 

        Else

            *Return .F.

            *Messagebox('bla bla',16,_Screen.Caption)

            Local NoInternetImage

            NoInternetImage = 'static/internet-main_full.jpg' 

 

            TEXT TO m.lcNoDoviz TEXTMERGE noshow

        <html>

        <head>

        <title>Doviz Kurları</title>

        <style type="text/css">

        .Soykan {

        font-family:,Georgia,ms trebuchet,tahoma,Verdana, Arial, Helvetica, sans-serif;

        font-size:12px;

        font-weight: bold;

        color:Red;

        text-align:center;

        }

        .GreyBox {border: 1px solid #CCCCCC;}

        #fox4um

        {

            width:160px;

            height:330px;

            padding:1px;

        }

        </style>

        </head>

        <body>

        <div id="fox4um"class="GreyBox">

        <span class="Soykan">Internet Baglantiniz Yok !!! </span>

        <br />

        <img src= "static/internet-main_full.jpg" width="159" height="329" /></img>

        </div>

        </body>

        </html>

            ENDTEXT

 

            If ! File('NoDoviz.htm')

                Strtofile(m.lcNoDoviz,m.lcNoDovizHtml)

            Endif

 

 

            With Thisform.OIE

                .Navigate2('file://'+m.lcNoDovizHtml)

                Do While .ReadyState # 4 && Wait for ready state

                Enddo

            Endwith

        Endif

 

        With This As Form

            .Width = .OIE.Width

            .Height = .OIE.Height

            .Left = (Sysmetric(1)-.Width)-10

        Endwith

    ENDPROC

 

 

ENDDEFINE

*

*-- EndDefine: daily_currency

**************************************************
]]> http://www.fox4um.com/user/4/ 2010-02-15T14:45:18Z http://www.fox4um.com/topic/1537/form-uzerinde-html-sayfada-doviz-kurlari-gosterimi/new/posts/ <![CDATA[dll parametre]]> long GetCashDrawerStatus ( unsigned char *Status );


bu "unsigned char *Status " parametresini ne yapmam gerekir? string yaptım yemedi.

]]> http://www.fox4um.com/user/39/ 2009-12-02T15:26:51Z http://www.fox4um.com/topic/1442/dll-parametre/new/posts/ <![CDATA[OCR]]> slm,
aşağıdaki kodla ocr çıktısı alabiliyorum. ancak bu bütün metni boşlukları yokederek veriyor. boşlukları yoketmeden veya metnin istediğimiz bir parçasını almanın bir yolu var mı?

Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

Lparameters xfile

Local miDoc,miLayout,lcStr

lcStr=''

CREATE CURSOR mondocument (mondococr m)

Public midoc

miDoc = Createobject('MODI.Document')

miDoc.Create( m.xfile)

miDoc.Images(0).OCR

miLayout = miDoc.Images(0).Layout

strLayoutInfo ="Language: " + Transform(miLayout.Language )+Chr(13)+Chr(10)

strLayoutInfo=strLayoutInfo+"Number of characters: " + Transform(miLayout.NumChars)+Chr(13)+Chr(10)

strLayoutInfo=strLayoutInfo+"Number of fonts: "+ Transform(miLayout.NumFonts )+Chr(13)+Chr(10)

strLayoutInfo=strLayoutInfo+"Number of words: " + Transform(miLayout.NumWords)+Chr(13)+Chr(10)+Chr(13)+Chr(10)

strLayoutinfo = strLayoutinfo+miLayout.text

INSERT INTO mondocument (mondococr) VALUES (strLayoutinfo)

MODIFY MEMO mondocument.mondococr

tif dosyasının istediğimiz belli bir parçasını cut edip yeni bir dosyaya kaydedebilme imkanı varsa o da şimi görür.

]]> http://www.fox4um.com/user/39/ 2009-10-26T16:26:33Z http://www.fox4um.com/topic/1397/ocr/new/posts/ <![CDATA[Serafettin Mentes in istegi uzerine VFP&Open Office Otomasyon Ornegi]]>
Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

703

704

705

706

707

708

709

710

711

712

713

714

715

716

717

718

719

720

721

722

723

724

725

726

727

728

729

730

731

732

733

734

735

736

737

738

739

740

741

742

743

744

745

746

747

748

749

750

751

752

753

754

755

756

757

758

759

760

761

762

763

764

765

766

767

768

769

770

771

772

773

774

775

776

777

778

779

780

781

782

783

784

785

786

787

788

789

790

791

792

793

794

795

796

797

798

799

800

801

802

803

804

805

806

807

808

809

810

811

812

813

814

815

816

817

818

819

820

821

822

823

824

825

826

827

828

829

830

831

832

833

834

835

836

837

838

839

840

841

842

843

844

845

846

847

848

849

850

851

852

853

854

855

856

857

858

859

860

861

862

863

864

865

866

867

868

869

870

871

872

873

874

875

876

877

878

879

880

881

882

883

884

885

886

887

888

889

890

891

892

893

894

895

896

897

898

899

900

901

902

903

904

905

906

907

908

909

910

911

912

913

914

915

916

917

918

919

920

921

922

923

924

925

926

927

928

929

930

931

932

933

934

935

936

937

938

939

940

941

942

943

944

945

946

947

948

949

950

951

952

953

954

955

956

957

958

959

960

961

962

963

964

965

966

967

968

969

970

971

972

973

974

975

976

977

978

979

980

981

982

983

984

985

986

***    Here is a very similar Visual FoxPro - Open Office example that.....

***    1. Creates an OOo Calc spreadsheet

***    2. Puts some strings into it.

***    3. Puts some numbers into it.

***    4. Puts some dates into it (as formulas)

***    5. Saves it in Calc format (as C:\Example.sxw)

***    6. Saves it in Excel format (as C:\Example.xls)

***    7. Closes the document -- but this line is commented to leave the spreadsheet open in OOo

 

***    Code:

VfpOOoCalcExample()

 

PROCEDURE VfpOOoCalcExample()

   * Create a spreadsheet.

   LOCAL oDoc

   

   oDoc = OOoOpenURL( "private:factory/scalc" )

    

   * Get first sheet

   LOCAL oSheet

   oSheet = oDoc.getSheets().getByIndex( 0 )

    

   *-----

   * Put some sales figures onto the sheet.

   oSheet.getCellByPosition( 0, 0 ).setString( "Month" )

   oSheet.getCellByPosition( 1, 0 ).setString( "Sales" )

   oSheet.getCellByPosition( 2, 0 ).setString( "End Date" )

    

   oSheet.getCellByPosition( 0, 1 ).setString( "Jan" )

   oSheet.getCellByPosition( 0, 2 ).setString( "Feb" )

   oSheet.getCellByPosition( 0, 3 ).setString( "Mar" )

   oSheet.getCellByPosition( 0, 4 ).setString( "Apr" )

   oSheet.getCellByPosition( 0, 5 ).setString( "May" )

   oSheet.getCellByPosition( 0, 6 ).setString( "Jun" )

   oSheet.getCellByPosition( 0, 7 ).setString( "Jul" )

   oSheet.getCellByPosition( 0, 8 ).setString( "Aug" )

   oSheet.getCellByPosition( 0, 9 ).setString( "Sep" )

   oSheet.getCellByPosition( 0, 10 ).setString( "Oct" )

   oSheet.getCellByPosition( 0, 11 ).setString( "Nov" )

   oSheet.getCellByPosition( 0, 12 ).setString( "Dec" )

    

   oSheet.getCellByPosition( 1, 1 ).setValue( 3826.37 )

   oSheet.getCellByPosition( 1, 2 ).setValue( 3504.21 )

   oSheet.getCellByPosition( 1, 3 ).setValue( 2961.45 )

   oSheet.getCellByPosition( 1, 4 ).setValue( 2504.12 )

   oSheet.getCellByPosition( 1, 5 ).setValue( 2713.98 )

   oSheet.getCellByPosition( 1, 6 ).setValue( 2448.17 )

   oSheet.getCellByPosition( 1, 7 ).setValue( 1802.13 )

   oSheet.getCellByPosition( 1, 8 ).setValue( 2203.22 )

   oSheet.getCellByPosition( 1, 9 ).setValue( 1502.54 )

   oSheet.getCellByPosition( 1, 10 ).setValue( 1207.68 )

   oSheet.getCellByPosition( 1, 11 ).setValue( 1819.71 )

   oSheet.getCellByPosition( 1, 12 ).setValue( 986.03 )

    

   oSheet.getCellByPosition( 2, 1 ).setFormula( "=DATE(2004;01;31)" )

   oSheet.getCellByPosition( 2, 2 ).setFormula( "=DATE(2004;02;29)" )

   oSheet.getCellByPosition( 2, 3 ).setFormula( "=DATE(2004;03;31)" )

   oSheet.getCellByPosition( 2, 4 ).setFormula( "=DATE(2004;04;30)" )

   oSheet.getCellByPosition( 2, 5 ).setFormula( "=DATE(2004;05;31)" )

   oSheet.getCellByPosition( 2, 6 ).setFormula( "=DATE(2004;06;30)" )

   oSheet.getCellByPosition( 2, 7 ).setFormula( "=DATE(2004;07;31)" )

   oSheet.getCellByPosition( 2, 8 ).setFormula( "=DATE(2004;08;31)" )

   oSheet.getCellByPosition( 2, 9 ).setFormula( "=DATE(2004;09;30)" )

   * Note that these last three dates are not set as DATE() function calls.

   oSheet.getCellByPosition( 2, 10 ).setFormula( "10/31/2004" )

   oSheet.getCellByPosition( 2, 11 ).setFormula( "11/30/2004" )

   oSheet.getCellRangeByName( "C13" ).setFormula( "12/31/2004" )

   *-----

    

   * Format the date cells as dates.    

   oFormats = oDoc.getNumberFormats()

   oLocale = OOoCreateStruct( "com.sun.star.lang.Locale" )

   * com.sun.star.util.NumberFormat.DATE = 2

   nDateKey = oFormats.getStandardFormat( 2, oLocale )

   oCell = oSheet.getCellRangeByName( "C2:C13" )

   oCell.NumberFormat = nDateKey

    

   LOCAL ARRAY aOneArg[1]

   LOCAL cFile, cURL

    

*   cFile = GetDesktopFolderPathname()+"example"

   cFile = "c:\example"

 

   * Now save the spreadsheet.

   cURL = OOoConvertToURL( cFile + ".sxw" )

   aOneArg[1] = OOoMakePropertyValue( "Overwrite", .T. )

   oDoc.storeToUrl( cURL, @ aOneArg )

    

   * Now save it as Excel

   cURL = OOoConvertToURL( cFile + ".xls" )

   aOneArg[1] = OOoMakePropertyValue( "FilterName", "MS Excel 97" )

   oDoc.storeToUrl( cURL, @ aOneArg )

    

   * Close the document.

*   oDoc.close( 1 ) && TRUE

ENDPROC

 

 

 

 

 

* Open or Create a document from it's URL.

* New documents are created by URL's such as:

*   private:factory/sdraw

*   private:factory/swriter

*   private:factory/scalc

*   private:factory/simpress

FUNCTION OOoOpenURL( cURL )

*   LOCAL oPropertyValue

*   oPropertyValue = OOoCreateStruct( "com.sun.star.beans.PropertyValue" )

 

*   LOCAL ARRAY aNoArgs[1]

*   aNoArgs[1] = oPropertyValue

*   aNoArgs[1].Name = "ReadOnly"

*   aNoArgs[1].Value = .F.

 

   * These two lines replace the alternate version above,

   *  which are left commented for the insight they provide.

   LOCAL ARRAY aNoArgs[1]

   aNoArgs[1] = OOoMakePropertyValue( "Hidden", .F. )

    

   LOCAL oDesktop

   oDesktop = OOoGetDesktop()

 

   LOCAL oDoc

   oDoc = oDesktop.LoadComponentFromUrl( cURL, "_blank", 0, @ aNoargs )

    

   * Make sure that arrays passed to this document are passed zero based.

   COMARRAY( oDoc, 10 )

    

   RETURN oDoc

ENDFUNC

 

* Create a com.sun.star.beans.PropertyValue struct and return it.

FUNCTION OOoMakePropertyValue( cName, uValue, nHandle, nState )

   LOCAL oPropertyValue

   oPropertyValue = OOoCreateStruct( "com.sun.star.beans.PropertyValue" )

    

   oPropertyValue.Name = cName

   oPropertyValue.Value = uValue

    

   IF TYPE([nHandle])="N"

      oPropertyValue.Handle = nHandle

   ENDIF

   IF TYPE([nState])="N"

      oPropertyValue.State = nState

   ENDIF

    

   RETURN oPropertyValue

ENDFUNC

 

 

 

* Sugar coated routine to create any UNO struct.

* Use the Bridge_GetStruct() feature of the OLE-UNO bridge.

FUNCTION OOoCreateStruct( cTypeName )

   LOCAL oServiceManager

   oServiceManager = OOoGetServiceManager()

    

   LOCAL oStruct

   oStruct = .NULL.

 

   LOCAL cOldErrHandler

   cOldErrHandler = ON( "ERROR" )

   ON ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) )

      oStruct = oServiceManager.Bridge_GetStruct( cTypeName )

   ON ERROR &cOldErrHandler

    

   IF ISNULL( oStruct )

      =__OOoReleaseCachedVars()

      oServiceManager = OOoGetServiceManager()

      oStruct = oServiceManager.Bridge_GetStruct( cTypeName )

   ENDIF

 

   RETURN oStruct

ENDFUNC

 

 

* Return the OpenOffice.org desktop object.

* Cache it in a global variable.

* Create it if not already cached.

FUNCTION OOoGetDesktop()

   IF (TYPE([goOOoDesktop])!="O")  OR  ISNULL( goOOoDesktop )

      PUBLIC goOOoDesktop

      goOOoDesktop = OOoServiceManager_CreateInstance( "com.sun.star.frame.Desktop" )

      COMARRAY( goOOoDesktop, 10 )

   ENDIF

   RETURN goOOoDesktop

ENDFUNC

 

 

 

* Return the OpenOffice.org service manager object.

* Cache it in a global variable.

* Create it if not already cached.

FUNCTION OOoGetServiceManager()

   IF (TYPE([goOOoServiceManager])!="O")  OR  ISNULL( goOOoServiceManager )

      PUBLIC goOOoServiceManager

      goOOoServiceManager = CREATEOBJECT( "com.sun.star.ServiceManager" )

   ENDIF

   RETURN goOOoServiceManager

ENDFUNC

 

 

* Sugar coated routine to ask the service manager to

*  create you an instance of some other OpenOffice.org UNO object.

FUNCTION OOoServiceManager_CreateInstance( cServiceName )

   LOCAL oServiceManager

   oServiceManager = OOoGetServiceManager()

    

   LOCAL oInstance

   oInstance = .NULL.

 

   LOCAL cOldErrHandler

   cOldErrHandler = ON( "ERROR" )

   ON ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) )

      oInstance = oServiceManager.createInstance( cServiceName )

   ON ERROR &cOldErrHandler

    

   IF ISNULL( oInstance )

      =__OOoReleaseCachedVars()

      oServiceManager = OOoGetServiceManager()

      oInstance = oServiceManager.createInstance( cServiceName )

   ENDIF

 

   RETURN oInstance

ENDFUNC

 

 

PROCEDURE DoNothing__ErrorHandler( pnError, pcErrMessage, pnLineNo, pcProgramFileSys16, pcProgram, pcErrorParamSys2018 )

ENDPROC

 

 

PROCEDURE __OOoReleaseCachedVars()

   RELEASE goOOoServiceManager, goOOoDesktop, goOOoCoreReflection

ENDPROC

 

 

* Convert a local filename to an OOo URL.

FUNCTION OOoConvertToURL( cFilename )

   * Ensure leading slash.

   IF LEFT( cFilename, 1 ) != "/"

      cFileName = "/" + cFileName

   ENDIF

    

   LOCAL cURL

   cURL = CHRTRAN( cFilename, "\", "/" )   && change backslashes to forward slashes.

   cURL = "file://" + cURL

   RETURN cURL

ENDFUNC

stirfry (Programmer)     

4 Dec 08 12:51

Thanks ronald777. star for you.

 

Thats the best conversion I have ever seen!

 

You should write it up as a FAQ

 

Andrew

Nifrabar (Programmer)     

9 Dec 08 10:29

I once found this code somewhere on the net.

Maybe this helps you again a step further.

Calc is included as well.

-Bart

CODE

*

*    Library of routines to manipulate OpenOffice.org.

*

*

* http://kosh.datateamsys.com/~danny/OOo/VisualFoxPro-OOo/LibOOo-2003-11-17-01.prg

 

*############################################################

*    Public API

*    High level routines.

*############################################################

 

 

* Return .T. if OpenOffice.org is installed.

* Return .F. if not installed.

FUNCTION OOoIsInstalled()

    LOCAL oServiceManager

    oServiceManager = .NULL.

 

    LOCAL cOldErrHandler

    cOldErrHandler = ON( "ERROR" )

    ON ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) )

        oServiceManager = OOoGetServiceManager()

    ON ERROR &cOldErrHandler

    

    * If we could create a Service Manager,

    *  then OpenOffice.org must be installed.

    RETURN NOT ISNULL( oServiceManager )

ENDFUNC

 

 

 

 

* Easy way to create a new Draw document.

FUNCTION OOoCreateNewDrawDocument()

    LOCAL oDrawDoc

    oDrawDoc = OOoOpenURL( "private:factory/sdraw" )

    RETURN oDrawDoc

ENDFUNC

 

 

* Easy way to create a new Writer document.

FUNCTION OOoCreateNewWriterDocument()

    LOCAL oWriterDoc

    oWriterDoc = OOoOpenURL( "private:factory/swriter" )

    RETURN oWriterDoc

ENDFUNC

 

 

* Easy way to create a new Calc document.

FUNCTION OOoCreateNewCalcDocument()

    LOCAL oCalcDoc

    oCalcDoc = OOoOpenURL( "private:factory/scalc" )

    RETURN oCalcDoc

ENDFUNC

 

 

* Easy way to create a new Impress document.

FUNCTION OOoCreateNewImpressDocument()

    LOCAL oImpressDoc

    oImpressDoc = OOoOpenURL( "private:factory/simpress" )

    RETURN oImpressDoc

ENDFUNC

 

 

 

FUNCTION OOoOpenFile( cFilename )

    LOCAL cURL

    cURL = OOoConvertToURL( cFilename )

    

    LOCAL oDoc

    oDoc = OOoOpenURL( cURL )

    RETURN oDoc

ENDFUNC

 

 

PROCEDURE OOoTerminateProgram()

    LOCAL oDesktop

    oDesktop = OOoGetDesktop()

    oDesktop.Terminate()

    

    =__OOoReleaseCachedVars()

ENDPROC

 

 

* Convert a local filename to an OOo URL.

FUNCTION OOoConvertToURL( cFilename )

    * Ensure leading slash.

    IF LEFT( cFilename, 1 ) != "/"

        cFileName = "/" + cFileName

    ENDIF

    

    LOCAL cURL

    cURL = CHRTRAN( cFilename, "\", "/" )    && change backslashes to forward slashes.

    cURL = "file://" + cURL

    RETURN cURL

ENDFUNC

 

 

 

 

*############################################################

*    Draw specific tools

*############################################################

 

 

* Page zero is the first page.

* Once you have a drawing document, obtain one of its pages.

FUNCTION OOoGetDrawPage( oDrawDoc, nPageNum )

    LOCAL oPages

    oPages = oDrawDoc.GetDrawPages()

    LOCAL oPage

    oPage = oPages.GetByIndex( nPageNum )

    RETURN oPage

ENDFUNC

 

 

* Given a draw document, create a shape.

* The shape must be added to the draw page, by calling

*  the draw page's Add() method.

* The oPosition and oSize arguments are optional, but you may

*  pass a Point and Size struct for these arguments.

 

FUNCTION OOoMakeRectangleShape( oDrawDoc, oPosition, oSize )

    LOCAL oShape

    oShape = OOoMakeShape( oDrawDoc, "com.sun.star.drawing.RectangleShape", oPosition, oSize )

    RETURN oShape

ENDFUNC

 

FUNCTION OOoMakeEllipseShape( oDrawDoc, oPosition, oSize )

    LOCAL oShape

    oShape = OOoMakeShape( oDrawDoc, "com.sun.star.drawing.EllipseShape", oPosition, oSize )

    RETURN oShape

ENDFUNC

 

FUNCTION OOoMakeLineShape( oDrawDoc, oPosition, oSize )

    LOCAL oShape

    oShape = OOoMakeShape( oDrawDoc, "com.sun.star.drawing.LineShape", oPosition, oSize )

    RETURN oShape

ENDFUNC

 

FUNCTION OOoMakeTextShape( oDrawDoc, oPosition, oSize )

    LOCAL oShape

    oShape = OOoMakeShape( oDrawDoc, "com.sun.star.drawing.TextShape", oPosition, oSize )

    RETURN oShape

ENDFUNC

 

 

* Create and return a Point struct.

FUNCTION OOoPosition( nX, nY )

    LOCAL oPoint

    oPoint = OOoCreateStruct( "com.sun.star.awt.Point" )

    oPoint.X = nX

    oPoint.Y = nY

    RETURN oPoint

ENDFUNC

 

* Create and return a Size struct.

FUNCTION OOoSize( nWidth, nHeight )

    LOCAL oSize

    oSize = OOoCreateStruct( "com.sun.star.awt.Size" )

    oSize.Width = nWidth

    oSize.Height = nHeight

    RETURN oSize

ENDFUNC

 

 

* Given a shape, alter its position.

PROCEDURE OOoSetPosition( oShape, nX, nY )

    LOCAL oPosition

    oPosition = oShape.Position

    oPosition.X = nX

    oPosition.Y = nY

    oShape.Position = oPosition

ENDPROC

 

* Given a shape, alter its size.

PROCEDURE OOoSetSize( oShape, nWidth, nHeight )

    LOCAL oSize

    oSize = oShape.Size

    oSize.Width = nWidth

    oSize.Height = nHeight

    oShape.Size = oSize

ENDPROC

 

 

* Given a draw document, create a shape.

* Optional:  oPosition, oSize can receive a Point or Size struct.

FUNCTION OOoMakeShape( oDrawDoc, cShapeClassName, oPosition, oSize )

    LOCAL oShape

    oShape = oDrawDoc.CreateInstance( cShapeClassName )

    

    IF (TYPE([oPosition])="O")  AND  (NOT ISNULL( oPosition ))

        oShape.Position = oPosition

    ENDIF

    IF (TYPE([oSize])="O")  AND  (NOT ISNULL( oSize ))

        oShape.Size = oSize

    ENDIF

    

    RETURN oShape

ENDFUNC

 

 

 

*############################################################

*    Color conversion utilities

*    --------------------------

*    Visual FoxPro and OpenOffice.org do not represent

*     color values the same way.

*    Conversion routines in both directions are provided

*     to keep things easy.

*    In addition, extremely convenient HSV routines are provided.

*    See LibGraphics for discussion of HSV color model.

*############################################################

 

 

* Similar to VFP's built in RGB() function.

* Pass in R,G,B values and out comes an OpenOffice.org color value.

* Note that this is DIFFERENT from how VFP constructs color values.

FUNCTION OOoRGB( nRed, nGreen, nBlue )

    RETURN BITOR( BITOR( BITLSHIFT( nRed, 16 ), BITLSHIFT( nGreen, 8 ) ), nBlue )

ENDFUNC

 

* Translate between a Visual FoxPro color and an OpenOffice.org color

*  by using a simple formula.

* Pass in a VFP color, out comes an OOo color.  And vice versa.

FUNCTION OOoColor( nColor )

    LOCAL nTranslatedColor

    nTranslatedColor = (INT( nColor / 65536 )) + (INT( INT( nColor / 256 ) % 256 ) * 256) + (INT( nColor % 256 ) * 65536)

    RETURN nTranslatedColor

ENDFUNC

 

* Extract the Red component from an OpenOffice.org color.

* SImilar to the RGBRed() function in LibGraphics.

FUNCTION OOoRed( nOOoColor )

*    RETURN INT( nOOoColor / 65536 )

    RETURN BITRSHIFT( BITAND( nOOoColor, 0x00FF0000 ), 16 )

ENDFUNC

 

* Extract the Green component from an OpenOffice.org color.

* SImilar to the RGBGreen() function in LibGraphics.

FUNCTION OOoGreen( nOOoColor )

*    RETURN INT( INT( nOOoColor / 256 ) % 256 )

    RETURN BITRSHIFT( BITAND( nOOoColor, 0x0000FF00 ), 8 )

ENDFUNC

 

* Extract the Blue component from an OpenOffice.org color.

* SImilar to the RGBBlue() function in LibGraphics.

FUNCTION OOoBlue( nOOoColor )

*    RETURN INT( nOOoColor % 256 )

    RETURN BITAND( nOOoColor, 0x000000FF )

ENDFUNC

 

* Convenient way to construct an OOo color from HSV components.

* See LibGraphics for information about HSV.

* Note nHue is a number from 0.0 to 1.0.

FUNCTION OOoHSV( nHue, nSaturation, nBrightness )

    LOCAL nColor

    nColor = MakeHSVColor( nHue * 6.0, nSaturation, nBrightness )

    nColor = OOoColor( nColor )

    RETURN nColor

ENDFUNC

 

* Convenient way to extract the Hue component from an OOo color.

* See LibGraphics for information about HSV.

* Note nHue is a number from 0.0 to 1.0.

FUNCTION OOoHue( nOOoColor )

    RETURN HSVHue( OOoColor( nOOoColor ) ) / 6.0

ENDFUNC

 

* Convenient way to extract the Saturation component from an OOo color.

* See LibGraphics for information about HSV.

FUNCTION OOoSaturation( nOOoColor )

    RETURN HSVSaturation( OOoColor( nOOoColor ) )

ENDFUNC

 

* Convenient way to extract the Brightness component from an OOo color.

* See LibGraphics for information about HSV.

FUNCTION OOoBrightness( nOOoColor )

    RETURN HSVValue( OOoColor( nOOoColor ) )

ENDFUNC

 

 

 

*############################################################

 

 

 

PROCEDURE DoNothing__ErrorHandler( pnError, pcErrMessage, pnLineNo, pcProgramFileSys16, pcProgram, pcErrorParamSys2018 )

ENDPROC

 

 

* Return the OpenOffice.org service manager object.

* Cache it in a global variable.

* Create it if not already cached.

FUNCTION OOoGetServiceManager()

    IF (TYPE([goOOoServiceManager])!="O")  OR  ISNULL( goOOoServiceManager )

        PUBLIC goOOoServiceManager

        goOOoServiceManager = CREATEOBJECT( "com.sun.star.ServiceManager" )

    ENDIF

    RETURN goOOoServiceManager

ENDFUNC

 

 

* Sugar coated routine to ask the service manager to

*  create you an instance of some other OpenOffice.org UNO object.

FUNCTION OOoServiceManager_CreateInstance( cServiceName )

    LOCAL oServiceManager

    oServiceManager = OOoGetServiceManager()

    

    LOCAL oInstance

    oInstance = .NULL.

 

    LOCAL cOldErrHandler

    cOldErrHandler = ON( "ERROR" )

    ON ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) )

        oInstance = oServiceManager.createInstance( cServiceName )

    ON ERROR &cOldErrHandler

    

    IF ISNULL( oInstance )

        =__OOoReleaseCachedVars()

        oServiceManager = OOoGetServiceManager()

        oInstance = oServiceManager.createInstance( cServiceName )

    ENDIF

 

    RETURN oInstance

ENDFUNC

 

 

* Sugar coated routine to create any UNO struct.

* Use the Bridge_GetStruct() feature of the OLE-UNO bridge.

FUNCTION OOoCreateStruct( cTypeName )

    LOCAL oServiceManager

    oServiceManager = OOoGetServiceManager()

    

    LOCAL oStruct

    oStruct = .NULL.

 

    LOCAL cOldErrHandler

    cOldErrHandler = ON( "ERROR" )

    ON ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) )

        oStruct = oServiceManager.Bridge_GetStruct( cTypeName )

    ON ERROR &cOldErrHandler

    

    IF ISNULL( oStruct )

        =__OOoReleaseCachedVars()

        oServiceManager = OOoGetServiceManager()

        oStruct = oServiceManager.Bridge_GetStruct( cTypeName )

    ENDIF

 

    RETURN oStruct

ENDFUNC

 

 

* Return the OpenOffice.org desktop object.

* Cache it in a global variable.

* Create it if not already cached.

FUNCTION OOoGetDesktop()

    IF (TYPE([goOOoDesktop])!="O")  OR  ISNULL( goOOoDesktop )

        PUBLIC goOOoDesktop

        goOOoDesktop = OOoServiceManager_CreateInstance( "com.sun.star.frame.Desktop" )

        COMARRAY( goOOoDesktop, 10 )

    ENDIF

    RETURN goOOoDesktop

ENDFUNC

 

 

*!*    * Return an instance of com.sun.star.reflection.CoreReflection.

*!*    * Cache it in a global variable.

*!*    * Create it if not already cached.

*!*    FUNCTION OOoGetCoreReflection()

*!*        IF (TYPE([goOOoCoreReflection])!="O")  OR  ISNULL( goOOoCoreReflection )

*!*            PUBLIC goOOoCoreReflection

*!*            goOOoCoreReflection = OOoServiceManager_CreateInstance( "com.sun.star.reflection.CoreReflection" )

*!*            COMARRAY( goOOoCoreReflection, 10 )

*!*        ENDIF

*!*        RETURN goOOoCoreReflection

*!*    ENDFUNC

 

 

*!*    * Create a UNO struct object and return it.

*!*    * This routine is now obsolete.

*!*    * See a superior implementation of this routine elsewhere

*!*    *  which uses the Bridge_GetStruct() feature of the OLE-UNO bridge.

*!*    FUNCTION OOoCreateStruct( cTypeName )

*!*        * Ask service manager for a CoreReflection object.

*!*        LOCAL oCoreReflection

*!*        oCoreReflection = OOoGetCoreReflection()

*!*        

*!*        * Get the IDL Class for the type name.

*!*        LOCAL oXIdlClass

*!*        oXIdlClass = .NULL.

 

*!*        LOCAL cOldErrHandler

*!*        cOldErrHandler = ON( "ERROR" )

*!*        ON ERROR = DoNothing__ErrorHandler( ERROR(), MESSAGE(), LINENO(), SYS(16), PROGRAM(), SYS(2018) )

*!*            oXIdlClass = oCoreReflection.forName( cTypeName )

*!*        ON ERROR &cOldErrHandler

*!*        

*!*        IF ISNULL( oXIdlClass )

*!*            =__OOoReleaseCachedVars()

*!*            oCoreReflection = OOoGetCoreReflection()

*!*            oXIdlClass = oCoreReflection.forName( cTypeName )

*!*        ENDIF

*!*        

*!*        * Create a variable to hold the created Struct.

*!*        * Assign it some initial value.

*!*        LOCAL oStruct

*!*        oStruct = CREATEOBJECT( "relation" ) && assign some kind of object initially

 

*!*        * Ask the class definition to create an instance.

*!*        oXIdlClass.CreateObject( @oStruct )

*!*        

*!*        RETURN oStruct

*!*    ENDFUNC

 

 

* Create a com.sun.star.beans.PropertyValue struct and return it.

FUNCTION OOoPropertyValue( cName, uValue, nHandle, nState )

    LOCAL oPropertyValue

    oPropertyValue = OOoCreateStruct( "com.sun.star.beans.PropertyValue" )

    

    oPropertyValue.Name = cName

    oPropertyValue.Value = uValue

    

    IF TYPE([nHandle])="N"

        oPropertyValue.Handle = nHandle

    ENDIF

    IF TYPE([nState])="N"

        oPropertyValue.State = nState

    ENDIF

    

    RETURN oPropertyValue

ENDFUNC

 

 

 

* Open or Create a document from it's URL.

* New documents are created by URL's such as:

*    private:factory/sdraw

*    private:factory/swriter

*    private:factory/scalc

*    private:factory/simpress

FUNCTION OOoOpenURL( cURL )

*    LOCAL oPropertyValue

*    oPropertyValue = OOoCreateStruct( "com.sun.star.beans.PropertyValue" )

 

*    LOCAL ARRAY aNoArgs[1]

*    aNoArgs[1] = oPropertyValue

*    aNoArgs[1].Name = "ReadOnly"

*    aNoArgs[1].Value = .F.

 

    * These two lines replace the alternate version above,

    *  which are left commented for the insight they provide.

    LOCAL ARRAY aNoArgs[1]

    aNoArgs[1] = OOoPropertyValue( "Hidden", .F. )

    

    LOCAL oDesktop

    oDesktop = OOoGetDesktop()

 

    LOCAL oDoc

    oDoc = oDesktop.LoadComponentFromUrl( cURL, "_blank", 0, @ aNoargs )

    

    * Make sure that arrays passed to this document are passed zero based.

    COMARRAY( oDoc, 10 )

    

    RETURN oDoc

ENDFUNC

 

 

PROCEDURE __OOoReleaseCachedVars()

    RELEASE goOOoServiceManager, goOOoDesktop, goOOoCoreReflection

ENDPROC

 

 

 

*############################################################

 

 

* Experimental stuff

 

 

 

*SET PROCEDURE TO LibOOo ADDITIVE

*oDoc = OOoOpenFile( GetDesktopFolderPathname() + "test.sxw" )

 

 

* This is an attempt to print a document.

PROCEDURE PrintExperiment( oDoc )

    LOCAL ARRAY aArgs[1]

    aArgs[1] = OOoPropertyValue( "CopyCount", 1, -1, 0 )

*    aArgs[1] = OOoPropertyValue( "Collate", .F. )

    

    oDoc.Print( @ aArgs )

ENDPROC

 

 

*############################################################

 

 

PROCEDURE TestOOoDraw()

    * Create a drawing.

    LOCAL oDoc

    oDoc = OOoCreateNewDrawDocument()

    

    * Get the first page of the drawing.

    LOCAL oPage

    oPage = OOoGetDrawPage( oDoc, 0 )

    

    LOCAL nHue, nSaturation, nBrightness

    LOCAL nRow, nCol

    LOCAL oShape

 

    * Now let's draw some rectangles.

 

    *-----

    *    Notes about HSV color notation.

    * Imagine hue is a "rainbow" of colors, from 0.0 to 1.0.

    * 0.0 is red, then you progress to orange, yellow, green, blue, purple, and

    *  then back to red again.  (Not like a real rainbow.)  1.0 is red also.

    * HSV colors are easy for HUMANS, while RGB colors are easy for COMPUTERS.

    * Quick, what is the RGB for Pink?  Brown?

    * In HSV, you would think Pink is a low-saturation red at full brightness,

    *  thus you could say H=0.0, S=0.5, B=1.0; and that's off the top of my head.

    * Brown is a low brightness Orange, so H=0.0888, S=1.0, B=0.6; right out of thin air.

    * Need a highly contrasting color?  Easy in HSV coordinates.

    * Just pick the opposite hue, maybe maximize saturation (opposite of other color),

    *  and maybe also a min or max brightness.  Can't easily come up with highly

    *  contrasting colors in RGB coordinates in RGB space.

    * Need to "soften" colors?  Take each HSV coordinate, and lower the saturation

    *  by 10 %.

    * Need to "darken" colors?  Lower the brightness of each pixel by 10 %.

    *-----

    

    * Let's vary the hue and saturation, while keeping the brightness constant.

    * But you could vary any two parameters, while keeping the third constant.

    

    nBrightness = 1.0 && full brightness

    FOR nRow = 0 TO 9

        FOR nCol = 0 TO 9

            * Create a shape

            oShape = OOoMakeRectangleShape( oDoc )

            * Calculate color

            nHue = nCol / 9 && hue varies *across* by column

            nSaturation = nRow / 9 && saturation varies *down* by row

            * set color of shape

            * oShape.FillColor = OOoRGB( 255, 255, 255 )

            oShape.FillColor = OOoHSV( nHue, nSaturation, nBrightness )

            * Position and size the shape

            OOoSetSize( oShape, 500, 500 ) && 1/2 cm by 1/2 cm

            OOoSetPosition( oShape, 1000 + nCol * 600, 1000 + nRow * 600 )

            * Add shape to page

            oPage.Add( oShape )

        ENDFOR

    ENDFOR

 

 

    * Let's vary the hue and saturation, while keeping the brightness constant.

    * This time, we'll use less-brightness

    * But you could vary any two parameters, while keeping the third constant.

    

    nBrightness = 0.7 && less brightness

    FOR nRow = 0 TO 9

        FOR nCol = 0 TO 9

            * Create a shape

            oShape = OOoMakeRectangleShape( oDoc )

            * Calculate color

            nHue = nCol / 9 && hue varies *across* by column

            nSaturation = nRow / 9 && saturation varies *down* by row

            * set color of shape

            oShape.FillColor = OOoHSV( nHue, nSaturation, nBrightness )

            * Position and size the shape

            OOoSetSize( oShape, 500, 500 ) && 1/2 cm by 1/2 cm

            OOoSetPosition( oShape, 9000 + nCol * 600, 1000 + nRow * 600 )

            * Add shape to page

            oPage.Add( oShape )

        ENDFOR

    ENDFOR

 

 

    * Let's vary the hue and brightness, while keeping the saturation constant.

    * But you could vary any two parameters, while keeping the third constant.

    

    nSaturation = 1.0 && full saturation

    FOR nRow = 0 TO 9

        FOR nCol = 0 TO 9

            * Create a shape

            oShape = OOoMakeRectangleShape( oDoc )

            * Calculate color

            nHue = nRow / 9 && hue varies *down* by row

            nBrightness = nCol / 9 && brightness varies *across* by column

            * set color of shape

            oShape.FillColor = OOoHSV( nHue, nSaturation, nBrightness )

            * Position and size the shape

            OOoSetSize( oShape, 500, 500 ) && 1/2 cm by 1/2 cm

            OOoSetPosition( oShape, 1000 + nCol * 600, 9000 + nRow * 600 )

            * Add shape to page

            oPage.Add( oShape )

        ENDFOR

    ENDFOR

 

 

    * Let's vary the saturation and brightness, while keeping the hue constant.

    * The hue will be yellow.

    * But you could vary any two parameters, while keeping the third constant.

 

    nHue = 0.1666 && yellow

    FOR nRow = 0 TO 9

        FOR nCol = 0 TO 9

            * Create a shape

            oShape = OOoMakeRectangleShape( oDoc )

            * Calculate color

            nSaturation = nRow / 9 && saturation varies *down* by row

            nBrightness = nCol / 9 && brightness varies *across* by column

            * set color of shape

            oShape.FillColor = OOoHSV( nHue, nSaturation, nBrightness )

            * Position and size the shape

            OOoSetSize( oShape, 500, 500 ) && 1/2 cm by 1/2 cm

            OOoSetPosition( oShape, 9000 + nCol * 600, 9000 + nRow * 600 )

            * Add shape to page

            oPage.Add( oShape )

        ENDFOR

    ENDFOR

    

    

    * Gee, you don't suppose someone out there could take the knowledge represented

    *  by this code and figure out how to make OpenOffice.org draw bar charts?

    

ENDPROC

 

 

PROCEDURE TestOOoCalc()

    * Create a spreadsheet.

    LOCAL oDoc

    oDoc = OOoCreateNewCalcDocument()

    

    * Get first sheet

    LOCAL oSheet

    oSheet = oDoc.getSheets().getByIndex( 0 )

    

    * Plug in some stuff...

    oSheet.getCellByPosition( 0, 0 ).setFormula( "Month" )

    oSheet.getCellByPosition( 1, 0 ).setFormula( "Sales" )

    oSheet.getCellByPosition( 0, 1 ).setFormula( "Jan" )

    oSheet.getCellByPosition( 0, 2 ).setFormula( "Feb" )

    oSheet.getCellByPosition( 0, 3 ).setFormula( "Mar" )

    oSheet.getCellByPosition( 0, 4 ).setFormula( "Apr" )

    oSheet.getCellByPosition( 0, 5 ).setFormula( "May" )

    oSheet.getCellByPosition( 0, 6 ).setFormula( "Jun" )

    oSheet.getCellByPosition( 1, 1 ).setValue( 3826 )

    oSheet.getCellByPosition( 1, 2 ).setValue( 3504 )

    oSheet.getCellByPosition( 1, 3 ).setValue( 2961 )

    oSheet.getCellByPosition( 1, 4 ).setValue( 2504 )

    oSheet.getCellByPosition( 1, 5 ).setValue( 2102 )

    oSheet.getCellByPosition( 1, 6 ).setValue( 1756 )

    

    LOCAL ARRAY aOneArg[1]

    LOCAL cFile, cURL

    

*    cFile = GetDesktopFolderPathname()+"example"

    cFile = "c:\example"

 

    * Now save the spreadsheet.

    cURL = OOoConvertToURL( cFile + ".sxw" )

    aOneArg[1] = OOoPropertyValue( "Overwrite", .T. )

    oDoc.storeToUrl( cURL, @ aOneArg )

    

    * Now save it as Excel

    cURL = OOoConvertToURL( cFile + ".xls" )

    aOneArg[1] = OOoPropertyValue( "FilterName", "MS Excel 97" )

    oDoc.storeToUrl( cURL, @ aOneArg )

ENDPROC

 

 

 

 

PROCEDURE CreateHueRainbow()

    * Create a drawing.

    LOCAL oDoc

    oDoc = OOoCreateNewDrawDocument()

    

    * Get the first page of the drawing.

    LOCAL oPage

    oPage = OOoGetDrawPage( oDoc, 0 )

    

    LOCAL nHue, nSaturation, nBrightness

    LOCAL nCol

    LOCAL oShape

 

    * Now let's draw some rectangles.

 

    * Let's vary the hue and saturation, while keeping the brightness constant.

    * But you could vary any two parameters, while keeping the third constant.

    

    nBrightness = 1.0 && full brightness

    nSaturation = 1.0 && full saturation

    FOR nCol = 0 TO 200

        * Create a shape

        oShape = OOoMakeRectangleShape( oDoc )

        * Calculate color

        nHue = nCol / 200 && hue varies *across* by column

        * set color of shape

        * oShape.FillColor = OOoRGB( 255, 255, 255 )

        oShape.FillColor = OOoHSV( nHue, nSaturation, nBrightness )

        * Position and size the shape

        OOoSetSize( oShape, 52, 2000 ) && 0.05 cm by 2 cm

        OOoSetPosition( oShape, 1000 + nCol * 50, 1000 )

        oShape.LineStyle = 0

        * Add shape to page

        oPage.Add( oShape )

    ENDFOR

    

    LOCAL cFile, cURL

*    cFile = GetDesktopFolderPathname()+"hue rainbow"

    cFile = "c:\hue rainbow"

    cURL = OOoConvertToURL( cFile + ".sxd" )

    LOCAL ARRAY aOneArg[1]

    aOneArg[1] = OOoPropertyValue( "Overwrite", .T. )

    oDoc.storeAsUrl( cURL, @ aOneArg )

*    oDoc.dispose()

ENDPROC
]]> http://www.fox4um.com/user/4/ 2009-08-31T10:24:13Z http://www.fox4um.com/topic/1319/serafettin-mentes-in-istegi-uzerine-vfpopen-office-otomasyon-ornegi/new/posts/ <![CDATA[eta dan dosya okuma/bağlantı]]> etanın eski versiyonlarından (v4)  bilgi aktarımı yapan varmı ?.stok,sipariş,hareket gibi dosyalarından nasıl veri alabiliriz.  etadan excele alıp fox a çekmeye çalışıyorum direkt etadan fox a alabilirmiyiz.bu şekilde çalışma yapan arkadaşlar varsa yardımcı olabilirmi ?

]]> http://www.fox4um.com/user/8/ 2009-08-28T08:09:45Z http://www.fox4um.com/topic/1306/eta-dan-dosya-okumabaglanti/new/posts/ <![CDATA[Baska seyle ugrasirken eski koda denk geldim...]]> iyi kodlardan birisi gibi geldi. Umarim birinin isine yarar. Sag klik denemeyi unutmayin:

Visual Fox Pro
1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

Public oForm

oForm = NewObject('HTMLViewerForm')

oForm.Show

 

Local loDocument

loDocument = oForm.htMLVIEWER.obJECT.document

Select cust_id,company,contact,country,region from customer into cursor crsCustomer

 

loTableX = _GetTable(loDocument)

loDocument.body.AppendChild(loTableX)

_cliptext = loDocument.body.outerHTML

 

Procedure _GetTable

Lparameters toDocument

Local Array aHeaders[1], aColumns[1]

 

Local oTable,oThead,oTFoot,oTBody,oCaption, jx

oTable = toDocument.createElement("TABLE")

oThead = toDocument.createElement("THEAD")

oTBody1 = toDocument.createElement("TBODY")

oTBody2 = toDocument.createElement("TBODY")

oTBody3 = toDocument.createElement("TBODY")

oTFoot = toDocument.createElement("TFOOT")

oCaption = toDocument.createElement("CAPTION")

 

* Insert the created elements into oTable.

With oTable

    .Border = 1

    .Id = 'customers'

    *.Style.borderCollapse="collapse"

    .Style.BorderColor = "#000000"

    .Style.BorderWidth = "thin"

    .Style.BorderStyle = "solid"

    .appendChild(oThead)

    .appendChild(oTBody1)

    .appendChild(oTBody2)

    .appendChild(oTBody3)

    .appendChild(oTFoot)

    .appendChild(oCaption)

    .cellSpacing = 0

    .cellPadding = 0

Endwith

oTBody1.bgColor = "#E0E0E0"

oTBody2.bgColor = "#00FFFF"

oTBody3.bgColor = "#FF00FF"

 

Select crsCustomer

* Insert a row into the header and set its background color.

oThead.bgColor = "lightskyblue"

lcHeaders = "cust_id,company,contact,country"

 

oRow = toDocument.createElement("TR")

    oCell = toDocument.createElement("TH")

    oCell.rowspan = 2

    oCell.innerText = "Customer ID"

    oRow.appendChild(oCell)

 

    oCell = toDocument.createElement("TH")

    oCell.rowspan = 2

    oCell.innerText = "Company"

    oRow.appendChild(oCell)

 

    oCell = toDocument.createElement("TH")

    oCell.colspan = 2

    oCell.innerText = "Showed Up"

    oRow.appendChild(oCell)

 

oThead.appendChild(oRow)

oRow = toDocument.createElement("TR")

    oCell = toDocument.createElement("TH")

    oCell.innerText = "Contact"

    oRow.appendChild(oCell)

    oCell = toDocument.createElement("TH")

    oCell.innerText = "Country"

    oRow.appendChild(oCell)

oThead.appendChild(oRow)

 

 

Scan

    oRow = toDocument.createElement("TR")

    If country='USA'

    oTBody2.appendChild(oRow)

    Else

    If country='Germany'

    oTBody1.appendChild(oRow)

    Else

    oTBody3.appendChild(oRow)

    endif

    endif

 

*CustID

        oCell = toDocument.createElement("TD")

        oCell.Rowspan=2

        oCell.style.fontWeight = "bold"

        oCell.innerText = Trim(cust_id)

        oRow.appendChild(oCell)

*Company

        oCell = toDocument.createElement("TD")

*       oCell.Rowspan=2

        oCell.innerText = Trim(company)

        oRow.appendChild(oCell)

*Contact

        oCell = toDocument.createElement("TD")

*       oCell.Rowspan=2

        oCell.innerText = Trim(contact)

        oRow.appendChild(oCell)

* Country and region

        oCell = toDocument.createElement("TD")

*       oCell.Rowspan=2

        oCell.innerText = Trim(country)

        oRow.appendChild(oCell)

 

    oSubRow = toDocument.createElement("TR")

    If country='USA'

    oTBody2.appendChild(oSubRow)

    Else

    If country='Germany'

    oTBody1.appendChild(oSubRow)

    Else

    oTBody3.appendChild(oSubRow)

    endif

    endif

 

* Country and region

        oCell = toDocument.createElement("TD")

        oCell.colspan=3

        oCell.style.fontStyle = "italic"

        oCell.innerText = Trim(country - (' - ' + region))

        

If region='WA'

    oCell.bgColor = "#FF2020"

endif

        oSubRow.appendChild(oCell)

        

Endscan

 

* Create and insert rows and cells into the footer row.

oRow = toDocument.createElement("TR")

oTFoot.appendChild(oRow)

oCell = toDocument.createElement("TD")

oRow.appendChild(oCell)

oCell.innerText = Textmerge("Total <<Reccount()>>")

oCell.colSpan = 4

oCell.bgColor = "lightskyblue"

 

* Set the innerText of the caption and position it at the bottom of the table.

oCaption.innerText = "Caption Here"

oCaption.Style.FontSize = "14 pt"

oCaption.Style.Color = "Blue"

oCaption.Align = "top"

Return oTable

 

Define Class HTMLViewerForm As Form

  DataSession = 2

  Top = 0

  Left = 0

  Height = 500

  Width = 800

  DoCreate = .T.

  Caption = "HTML sample"

  cHTML = ""

  cHTMFile = Forcepath(Sys(2015)+'.htm',Sys(2023))

  EmptyHTM = Forcepath('empty.htm',Sys(2023))

  DoNotErase = .F.

 

  Add Object htmlviewer As OleControl With ;

    Top = 0, Left = 0, Height = 500, Width = 800, Visible = .T., ;

    OleClass = 'Shell.Explorer'

 

  Procedure Init

  Text to m.lcBody noshow

<html>

<HEAD>

<STYLE>

.menuItem {font-family:sans-serif;font-size:10pt;width:100;padding-left:20;

   background-Color:menu;color:black}

.highlightItem {font-family:sans-serif;font-size:10pt;width:100;padding-left:20;

   background-Color:highlight;color:white}

.clickableSpan {padding:4;width:500;background-Color:blue;color:white;border:5px gray solid}

</STYLE>

 

<SCRIPT>

//<!--

 

function displayMenu() {

   whichDiv=event.srcElement;

   menu1.style.leftPos+=10;

   menu1.style.posLeft=event.clientX;

   menu1.style.posTop=event.clientY;

   menu1.style.display="";

   menu1.setCapture();

}

function switchMenu() {   

   el=event.srcElement;

   if (el.className=="menuItem") {

      el.className="highlightItem";

   } else if (el.className=="highlightItem") {

      el.className="menuItem";

   }

}

function clickMenu() {

   menu1.releaseCapture();

   menu1.style.display="none";

   el=event.srcElement;

   if (el.id=="mnuRed") {

      whichDiv.style.backgroundColor="red";

   } else if (el.id=="mnuGreen") {

      whichDiv.style.backgroundColor="green";   

   } else if (el.id=="mnuBlue") {

      whichDiv.style.backgroundColor="blue";   

   } else if (el.id=="mnuYellow") {

      whichDiv.style.backgroundColor="yellow";   

   }

}

 

//-->

</SCRIPT>

</HEAD>

 

<body oncontextmenu="if (!event.ctrlKey){displayMenu();return false;}">

<div id=menu1 onclick="clickMenu()" onmouseover="switchMenu()" onmouseout="switchMenu()" style="position:absolute;display:none;width:100;background-Color:menu; border: outset 3px gray">

<div class="menuItem" id=mnuRed>Red</div>

<div class="menuItem" id=mnuGreen>Green</div>

<div class="menuItem" id=mnuBlue>Blue</div>

<div class="menuItem" id=mnuYellow>Yellow</div>

</div><body></html> 

  endtext

  

  

  

*   StrToFile('<HTML><BODY oncontextmenu="return  false"></BODY></HTML>',this.cHTMFile)

    StrToFile(m.lcBody,this.cHTMFile)

    

    This.htmlviewer.navigate2('file://'+this.cHTMFile)

*!*     This.htmlviewer.navigate2('about:blank')

*!*     With This.htmlviewer.Document

*!*       oBody = .createElement('body')

*!*       oBody.oncontextmenu = "return false"

*!*       .appendChild(oBody)

*!*     Endwith

  EndProc

   Procedure Destroy

   Erase (this.cHTMFile)

   endproc

 

  Procedure htmlviewer.Refresh

    Nodefault

  Endproc

 

  Procedure Resize

    This.htmlviewer.Height = This.Height

    This.htmlviewer.Width  = This.Width

  Endproc

Enddefine
]]> http://www.fox4um.com/user/11/ 2008-10-25T08:36:11Z http://www.fox4um.com/topic/1159/baska-seyle-ugrasirken-eski-koda-denk-geldim/new/posts/ <![CDATA[Regedit'e Bilgi Yazmak]]> Öncelikle Herkese Merhaba,
Var Olan Bi Kağıt Tipim Var Regedit dosyası şeklinde Bunu Program İlk Açılışında Regeditin İçine Atmasını İstiyorum.Oraya eklemek gerekiyor ama daha bi çözüme ulaşamadım yardımlarınız için şimdiden teşekkür ederim

]]> http://www.fox4um.com/user/172/ 2008-09-01T11:05:34Z http://www.fox4um.com/topic/1110/regedite-bilgi-yazmak/new/posts/