1

Konu: Kod yaz denize at, birinin isine yarar:)

Visual Fox Pro
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

2

Re: Kod yaz denize at, birinin isine yarar:)

sen genede atma balık bilmezse halik bilir smile
guzel kod tesekkur...

http://www.soykansoft.com/images/twitter.jpghttp://www.soykansoft.com/images/wp.jpg

3

Re: Kod yaz denize at, birinin isine yarar:)

Üstat, Garanti bankası reklamı gibi oldu smile

Senin kodlarının tamamına yakını gibi tek kelimelik bir yorum olabilir ( tamamına yakın grubuna girmeyenleri anlayamadığım için kategori dışı tutuyorum ) : Harika....

Ellerine sağlık ...

Uğur
-------------------------------------------------------------------------------------------------------------
Hayat bir bisiklete binmek gibidir. Pedalı çevirmeye devam ettiğiniz sürece düşmezsiniz. Claude Peppeer
Kusuru söylenmeyen adam, ayıbını hüner sanır.  Türk Atasözü

4

Re: Kod yaz denize at, birinin isine yarar:)

hocam bu kodu halik de bilir balıkda

5

Re: Kod yaz denize at, birinin isine yarar:)

Bu koda şapkam olsaydı çıkarırdım.  Teşekkürler.:)

6

Re: Kod yaz denize at, birinin isine yarar:)

Kod için teşekkürler. Elbette işe yarar:)

7

Re: Kod yaz denize at, birinin isine yarar:)

Arkadaslar sagolun. Bazen baska forumlarda cevap verirken yazdigim ornekler ise yarar gibi gorunuyor gozume, yabana gitmesin diye buraya da yapistiriyorum (ne baslik yazacagimi da sasiriyorum:)

8

Re: Kod yaz denize at, birinin isine yarar:)

Peki bunu degişik uzantılara uygulayabilirmiyiz denedim ama isim çıkması gerekirken carpı işareti çıkıyor. örnek olarak word excel dokümlerimi sıralamak üstüne tıkladıgımdada açmak istiyorum.

9

Re: Kod yaz denize at, birinin isine yarar:)

Visual Fox Pro
*!* Excel Pivot sample

*!*    Author:Cetin Basoz
*#include 'xlConstants.h'
 
#Define xlSum  -4157
#Define xlDataField 4
#Define xlExternal 2
 
*** Constant Group: XlSourceType
#Define xlSourceWorkbook                                  0
#Define xlSourceSheet                                     1
#Define xlSourcePrintArea                                 2
#Define xlSourceAutoFilter                                3
#Define xlSourceRange                                     4
#Define xlSourceChart                                     5
#Define xlSourcePivotTable                                6
#Define xlSourceQuery                                     7
 
*** Constant Group: XlHtmlType
#Define xlHtmlStatic                                      0
#Define xlHtmlCalc                                        1
#Define xlHtmlList                                        2
#Define xlHtmlChart                                       3
 
TEXT TO m.lcSQL NOSHOW TEXTMERGE PRETEXT 15
SELECT RTRIM(emp.first_name) + ' ' +RTRIM(emp.last_name) as SalesMan,
    cs.company, pr.prod_name as ProductName, oi.quantity, od.order_date as dateOrdered
  FROM  customer cs
  INNER JOIN orders od on cs.cust_id = od.cust_id
  inner join employee emp on od.emp_id = emp.emp_id
  INNER JOIN orditems oi on od.order_id = oi.order_id
  INNER JOIN products pr on oi.product_id = pr.product_id
ENDTEXT
 
lcPageList = 'Company'
lcRowList = 'ProductName'
lcColList = 'SalesMan'
lcDataField = 'Quantity'
 
Alines(laRowFields,m.lcRowList,.T.,",")
Alines(laColFields,m.lcColList,.T.,",")
Alines(laPageFields,m.lcPageList,.T.,",")
 
lcCaption   = 'Quantity Sold'
lnFunction  = xlSum
 
lcConnStr = 'Provider=VFPOLEDB;Data Source='+_samples+'Data\Testdata.dbc'
Local oExcel As 'Excel.Application'
oExcel = Createobject('Excel.Application')
With oExcel
  .Visible = .T.
  .Workbooks.Add
  *-- Destination of the pivottable inside Excel
  .ActiveWorkbook.ActiveSheet.Name = 'Product Sales'
  With .ActiveWorkbook.ActiveSheet
    oDestination = .Range('A1')
    With oExcel.ActiveWorkbook.PivotCaches.Add(xlExternal)
      .Connection  = 'OLEDB;'+m.lcConnStr
      .CommandType = 2 && xlCmdSQL
      .CommandText = m.lcSQL
      .CreatePivotTable(oDestination, 'PivotTable')
    Endwith
 
    With .PivotTables("PivotTable")
      Do Case
        Case !Empty(m.lcRowList) And !Empty(m.lcColList) And !Empty(m.lcPageList)
          .AddFields(@laRowFields, @laColFields, @laPageFields)
        Case !Empty(m.lcRowList) And !Empty(m.lcColList)
          .AddFields(@laRowFields, @laColFields)
        Case !Empty(m.lcRowList) And !Empty(m.lcPageList)
          .AddFields(@laRowFields, , @laPageFields)
        Case !Empty(m.lcRowList)
          .AddFields(@laRowFields)
        Case !Empty(m.lcColList) And !Empty(m.lcPageList)
          .AddFields(, @laColFields, @laPageFields)
        Case !Empty(m.lcColList)
          .AddFields(, @laColFields)
        Case !Empty(m.lcPageList)
          .AddFields(, , @laPageFields)
      Endcase
      .PivotFields(lcDataField).Orientation = xlDataField
 
      With .PivotFields('Sum of '+m.lcDataField)
        .Caption  = m.lcCaption
        .Function = m.lnFunction
      Endwith
      If !Empty(m.lcRowList)
        For ix = 1 To Alen(laRowFields)
          With .PivotFields(laRowFields[ix])
            .Subtotals(1) = .T. && To turn of subtotals
            .Subtotals(1) = .F.
          Endwith
        Endfor
        *    .Mergelabels = .T.
      Endif
    Endwith
    .UsedRange.Columns.AutoFit
  Endwith
  If Type('.ActiveWorkbook.ShowPivotTableFieldList') = 'L'
    .ActiveWorkbook.ShowPivotTableFieldList = .F.
  Endif
Endwith
lcExportName = "C:\temp\EXCELHTMLExportPivotSample3.htm"
oExcel.ActiveWorkbook.PublishObjects.Add(;
  xlSourcePivotTable, m.lcExportName,    ;
  "Product Sales", "PivotTable", ;
  xlHtmlList, "", "Published From Excel").Publish(.T.)

10

Re: Kod yaz denize at, birinin isine yarar:)

Çetin abi senden daha çok öğreneceklerimiz var bu kesin. smile Özellikle Foxda Excel hükmetme konusunda senden çok şey kapacağım paylaşımlar için teşekkürler

11

Re: Kod yaz denize at, birinin isine yarar:)

Kod icin tesekkur

son kısım excel 2007 de desteklenmiyor hatası veriyor

Visual Fox Pro
oExcel.ActiveWorkbook.PublishObjects.Add(;

  xlSourcePivotTable, m.lcExportName,    ;
  "Product Sales", "PivotTable", ;
  xlHtmlList, "", "Published From Excel").Publish(.T.)
http://www.soykansoft.com/images/twitter.jpghttp://www.soykansoft.com/images/wp.jpg