Konu: fastxtab totalrows
selamlar;
fastxtab da totalrows özelliği henüz yapılmamış.
bu işlemi nasıl yapabilirim? yada yapılmışı varmı? 
Bilmediğin Neyse Yanıldığındır.
- mrduyar
- Uzman Üye
- Offline
- mrduyar
- Uzman Üye
- Offline
Re: fastxtab totalrows
Anlatamadım sanırım.
Excel de pivot tabla olduğu gibi diyebilirim.
Son satırıda toplam yapmasını nasıl sağlarım.
Bilmediğin Neyse Yanıldığındır.
- cetinbasoz
- Uzman Üye
- Offline
Re: fastxtab totalrows
sum to array ile topla, arrayi biraz edit et, cursora ekle.
4 16.05.2007 15:48:02 Son düzenleyen, ahmet (16.05.2007 17:23:21)
- mrduyar
- Uzman Üye
- Offline
Re: fastxtab totalrows
tekrar selamlar;
bir cesaretle UT ye soru gönderdim hemen cevapladılar.
Naomi Nosonovsky kendi yaptığı versiyonunu bana e-mail olarak gönderdi.
sizinle paylaşmak istedim.
Visual Fox Pro
*!* ***********************************************************************
*!* * Naomi Nosonovsky versiyonu
*!* * ltotalrows kısmı çalışıyor. toplama,sayma ve ortalama hesapları yapabiliyor.
*!* * 16/05/2007
*!* ***********************************************************************
*!* File: FastXtab.prg
*!* Version: 1.0
*!* Author: Alexander Golovlev
*!* Country: Russian Federation
*!* Email: avg.kedr@overta.ru , golovlev@yandex.ru
*!* Modified by: Nadya Nosonovsky 02/25/2002 11:58:36 AM
*!* ***********************************************************************
*!* ***********************************************************************
*!*
*!* Notes: On entry, a table should be open in the current work area,
*!* and it should contain at most one record for each cell in
*!* a cross-tabulation. This table may NOT be in row order.
*!*
*!* The rowfld field in each record becomes the y-axis (rows) for
*!* a cross-tab and the colfld field becomes the x-axis (columns)
*!* The actual cross-tab results are saved to the database name
*!* specified by "cOutFile" property.
*!*
*!* The basic strategy goes like this. Using select query get all
*!* unique values of rows and columns and totaling values for each
*!* row/column pair. Then determine the column headings in the
*!* output cursor. Next produce an empty cursor with one column
*!* for each unique value of input field colfld, plus one additional
*!* column for input field rowfld values. Finally, scan the temporary
*!* cursor and put the cell values for the row/column intersections
*!* into the output cursor.
*!*
*!* Usage: oXtab = NewObject("FastXtab", "FastXtab.prg")
*!* oXtab.lCursorOnly = .T.
*!* oXtab.lBrowseAfter = .T.
*!* oXtab.RunXtab
*!*
*!* **********************************************************************
#include "FastXtabEn.h" && English
*!* #include FastXtabRu.h && Russian
#Define nullfield 'NULL'
#Define charblank 'C_BLANK'
#Define dateblank 'D_BLANK'
#Define sum_fields 0
#Define count_fields 1
#Define percent_fields 2
#Define average_fields 3
#Define max_fields 4
#Define min_fields 5
#Define win32font 'MS Sans Serif'
#Define win95font 'Arial'
#Define dbcs_loc "81 82 86 88"
#Define c_sumfield_loc "Total"
#Define c_countfield_loc "Count"
#Define c_percentfield_loc "Percent"
External Array afldarray
Define Class fastxtab As Custom
coutfile = "xtabquery" && The name of the output file
lcursoronly = .F. && Specifies whether the input datasource is cursor
lclosetable = .T. && Specifies whether to close the source datasource after the cross tab is generated
npagefield = 0 && Specifies the field position in the datasource of the cross tab pages
nrowfield = 1 && Specifies the field position in the datasource of the cross tab rows
ncolfield = 2 && Specifies the field position in the datasource of the cross tab columns
ndatafield = 3 && Specifies the field position in the datasource of the cross tab data
ltotalrows = .F. && Specifies whether to total rows in the cross tab output
ntotaloption = 0 && Totaling options (0-sum, 1-count, 2-% of total).
ldisplaynulls = .F. && Specifies whether to display null values in the cross tab output
lbrowseafter = .F. && Specifies whether to open a Browse window on the cross tab output
sumtotalfld = c_sumfield_loc && Name of the Total Field if Option is set to 0 - sum
counttotalfld = c_countfield_loc && Name of the Total Field if Option is set to 1 - count
perctotalfld = c_percentfield_loc && Name of the Total Field if Option is set to 2 - % of total
ccountfldtype = "N"
ncountfldlen = 4
ncountflddec = 0
cpercentfldtype = "N"
npercentfldlen = 7
npercentflddec = 3
Protected badchars && String of symbols not allowed in field name
Protected repchars && String of symbols to replace bad chars
Procedure Init && Constructor
If Version(3) $ "81 82 86 88"
This.badchars = "/,-=:;!@#$%&*.<>()?[]\+"+Chr(34)+Chr(39)+" "
Else
This.badchars = " ????????S?O ?????????s ¡¢£¤¥/\,-=:;{}[]!@#$%^&*.<>()?"+ ;
"DÑOOOOÖxOUUUÜY_ßàáâaäåæçèéêëìíîïdñòóôoö÷oùúûüy_"+Chr(34)+Chr(39)+" "
*!* "+|??o Y¦§"©ª«¬®_°±I3'µ¶·,1º»¼½_¿AAAAÄÅÆÇEÉEEIIII"+
Endif
This.repchars = Replicate("_", Len(This.badchars) - 1)
Endproc
Procedure Destroy && Destructor
If Used("COLUMNS")
Use In Columns
Endif
If Used("CELLS")
Use In cells
Endif
Endproc
Function runxtab && Generates a cross tab
Local ctalkstat && SET TALK status
Local cnullstat && SET NULL status
Local coutstem && Output cursor name
Local dbfname && Input table file name
Local ngroupfields && Number of grouping fields
Wait Window "Running Cross Tab Query" Nowait
ctalkstat = Set("TALK")
Set Talk Off
cnullstat = Set("NULL")
*!* Check object properties
With This
If Vartype(.coutfile) != "C"
.coutfile = "xtabquery"
Endif
If Vartype(.lcursoronly) != "L"
.lcursoronly = .F.
Endif
If Vartype(.lclosetable) != "L"
.lclosetable = .T.
Endif
If Vartype(.npagefield) != "N"
.npagefield = 0
Endif
If Vartype(.nrowfield) != "N"
.nrowfield = 1
Endif
If Vartype(.ncolfield) != "N"
.ncolfield = 2
Endif
If Vartype(.ndatafield) != "N"
.ndatafield = 3
Endif
If Vartype(.ltotalrows) != "L"
.ltotalrows = .F.
Endif
If Vartype(.ldisplaynulls) != "L"
.ldisplaynulls = .F.
Endif
If Vartype(.lbrowseafter) != "L"
.lbrowseafter = .F.
Endif
If .ldisplaynulls
Set Null On
Else
Set Null Off
Endif
*!* Make sure that table is open in current work area
If !Used()
dbfname = Getfile('DBF',c_locatedbf)
If Empty(m.dbfname)
*!* User canceled out of dialog
Return .F.
Else
Use (m.dbfname)
Endif
Endif
*!* Check for input table properties
If Fullpath(Defaultext(Alias(),'DBF')) == Fullpath(Defaultext(.coutfile,'DBF'))
.alert(c_output)
Return .F.
Endif
If Fcount() < 3
.alert(c_need3flds)
Return .F.
Endif
If Reccount() = 0
.alert(c_emptydbf)
Return .F.
Endif
*!* Gather information on the currently selected database fields
Dimension inpfields[FCOUNT(),4]
Local numflds, pagefldname, rowfldname, ;
colfldname, cellfldname, pagefldvalue, rowfldvalue
numflds = Afields(inpfields)
*!* None of these fields are allowed to be memo fields
If .npagefield > 0
If inpfields[.nRowField,2] $ 'MGP'
.alert(c_badpagefld)
Return .F.
Endif
Endif
If inpfields[.nRowField,2] $ 'MGP'
.alert(c_badrowfld)
Return .F.
Endif
If inpfields[.nColField,2] $ 'MGP'
.alert(c_badcolfld)
Return .F.
Endif
If inpfields[.nDataField,2] $ 'MGP'
.alert(c_badcellfld)
Return .F.
Endif
If .npagefield > 0
pagefldname = inpfields[.nPageField,1]
ngroupfields = 2
Else
ngroupfields = 1
Endif
rowfldname = inpfields[.nRowField,1]
colfldname = inpfields[.nColField,1]
cellfldname = inpfields[.nDataField,1]
dbfname = Alias()
*!* Calculate all cell values
If inpfields[.nDataField,2] $ "NFYBI"
*!* SUM for numeric data types
If .npagefield > 0
Select &pagefldname As pagefld, &rowfldname As rowfld, ;
&colfldname As colfld, ;
sum(&cellfldname) As cellfld;
from (dbfname) Group By 1, 2, 3 Into Cursor cells
Else
Select &rowfldname As rowfld, &colfldname As colfld, ;
sum(&cellfldname) As cellfld;
from (dbfname) Group By 1, 2 Into Cursor cells
Endif
Else
*!* Replace for non numeric data types
If .npagefield > 0
Select &pagefldname As pagefld, &rowfldname As rowfld, &colfldname As colfld, ;
&cellfldname As cellfld;
from (dbfname) Group By 1, 2, 3 Into Cursor cells
Else
Select &rowfldname As rowfld, &colfldname As colfld, ;
&cellfldname As cellfld;
from (dbfname) Group By 1, 2 Into Cursor cells
Endif
Endif
*!* Generate column names
Select Distinct colfld As colvalue ;
from cells Group By 1 Into Cursor Columns
Index On colvalue Tag colvalue
Do Case
Case _Tally > 254
.alert(c_xsvalues)
Return .F.
Case _Tally = 0
.alert(c_nocols)
Return .F.
Endcase
*!* Create output table
Local ntotfields
ntotfields = m.ngroupfields+_Tally+Iif(.ltotalrows,1,0)
Dimension outfields[m.nTotFields,4]
*!* Page and Row fields are the same as in input table
If .npagefield > 0
outfields[1,1] = inpfields[.nPageField,1]
outfields[1,2] = inpfields[.nPageField,2]
outfields[1,3] = inpfields[.nPageField,3]
outfields[1,4] = inpfields[.nPageField,4]
Endif
outfields[m.nGroupFields,1] = inpfields[.nRowField,1]
outfields[m.nGroupFields,2] = inpfields[.nRowField,2]
outfields[m.nGroupFields,3] = inpfields[.nRowField,3]
outfields[m.nGroupFields,4] = inpfields[.nRowField,4]
Scan
outfields[m.nGroupFields+RECNO(),1] = .genname(Columns.colvalue, ;
inpfields[.nColField,4])
outfields[m.nGroupFields+RECNO(),2] = inpfields[.nDataField,2]
outfields[m.nGroupFields+RECNO(),3] = inpfields[.nDataField,3]
outfields[m.nGroupFields+RECNO(),4] = inpfields[.nDataField,4]
Endscan
If .ltotalrows
Do Case
Case .ntotaloption = count_fields
*!* Since Max columns is 256, assume N (4)
outfields[m.nTotFields,1] = .counttotalfld
outfields[m.nTotFields,2] = .ccountfldtype && field type
outfields[m.nTotFields,3] = .ncountfldlen && field length
outfields[m.nTotFields,4] = .ncountflddec && field length
Case .ntotaloption = percent_fields
*!* Percent of total, use three decimals
outfields[m.nTotFields,1] = .perctotalfld
outfields[m.nTotFields,2] = .cpercentfldtype && field type
outfields[m.nTotFields,3] = .npercentfldlen && field length
outfields[m.nTotFields,4] = .npercentflddec && decimals
Otherwise
outfields[m.nTotFields,1] = .sumtotalfld
outfields[m.nTotFields,2] = inpfields[.nDataField,2] && field type
outfields[m.nTotFields,4] = inpfields[.nDataField,4] && decimals
If Atc(inpfields[.nDataField,2],"YB")#0 && Currency
outfields[m.nTotFields,3] = inpfields[.nDataField,3] && field length
Else
*!* Add a little extra space for calculations
outfields[m.nTotFields,3] = Min(inpfields[.nDataField,3]+2,20) && field length
Endif
Endcase
Endif
.checknames(@outfields)
*!* Make sure that the output file is not already in use somewhere
coutstem = Juststem(.coutfile)
If Used(coutstem)
Use In (coutstem)
Endif
If !This.lcursoronly
Create Table (This.coutfile) From Array outfields
coutstem = Alias()
Else
Create Cursor (coutstem) From Array outfields
Endif
Local lntotalsum, lnsum, lncount
Store 0 To lntotalsum, lnsum, lncount
*!* Fill the output table
Select cells
If .ltotalrows And .ntotaloption = percent_fields
Sum cellfld All To Array asum
lntotalsum = asum[1]
Endif
If .npagefield > 0
pagefldvalue = cells.pagefld
rowfldvalue = cells.rowfld
Insert Into (coutstem) (&pagefldname, &rowfldname) Values (pagefldvalue, rowfldvalue)
Scan
If (pagefldvalue != cells.pagefld) Or (rowfldvalue != cells.rowfld)
pagefldvalue = cells.pagefld
rowfldvalue = cells.rowfld
If .ltotalrows
Do Case
Case .ntotaloption = count_fields
Replace (.counttotalfld) With m.lncount In (coutstem)
Case .ntotaloption = sum_fields
Replace (.sumtotalfld) With m.lnsum In (coutstem)
Case .ntotaloption = percent_fields
Replace (.perctotalfld) With ;
round(m.lnsum/m.lntotalsum*100,.npercentflddec)
Endcase
Endif
Insert Into (coutstem) (&pagefldname, &rowfldname) Values (pagefldvalue, rowfldvalue)
Store 0 To lnsum, lncount
Endif
*!* Translate a field value of any type into a column field name
Seek cells.colfld In Columns
replcolumn = Field(Recno('columns') + ngroupfields, coutstem)
Replace (replcolumn) With cells.cellfld In (coutstem)
If .ltotalrows
lnsum = m.lnsum + cells.cellfld
lncount = m.lncount + ;
iif(Not Isnull(cells.cellfld) And Not Empty(cells.cellfld),1,0)
Endif
Endscan
Else
rowfldvalue = cells.rowfld
Insert Into (coutstem) (&rowfldname) Values (rowfldvalue)
Scan
If rowfldvalue != cells.rowfld
rowfldvalue = cells.rowfld
If .ltotalrows
Do Case
Case .ntotaloption = count_fields
Replace (.counttotalfld) With m.lncount In (coutstem)
Case .ntotaloption = sum_fields
Replace (.sumtotalfld) With m.lnsum In (coutstem)
Case .ntotaloption = percent_fields
Replace (.perctotalfld) With ;
round(m.lnsum/m.lntotalsum*100,.npercentflddec)
Endcase
Endif
Insert Into (coutstem) (&rowfldname) Values (rowfldvalue)
Store 0 To lnsum, lncount
Endif
*!* Translate a field value of any type into a column field name
Seek cells.colfld In Columns
replcolumn = Field(Recno('columns') + ngroupfields, coutstem)
Replace (replcolumn) With cells.cellfld In (coutstem)
If .ltotalrows
lnsum = m.lnsum + cells.cellfld
lncount = m.lncount + ;
iif(Not Isnull(cells.cellfld) And Not Empty(cells.cellfld),1,0)
Endif
Endscan
Endif
Select (coutstem)
Go Top
*!* Close the input database
If .lclosetable
Use In (m.dbfname)
Endif
Use In Columns
Use In cells
Set Talk &ctalkstat
Set Null &cnullstat
Wait Clear
If .lbrowseafter
Browse Nowait Normal
Endif
Endwith
Endproc
Protected Function genname(in_name, in_dec)
*!* Generate a valid field name from field value of any type
Local retval, cfldtype, in_dec
If Parameters() = 1
in_dec = 0
Endif
cfldtype = Type("m.in_name")
Do Case
Case Isnull(m.in_name)
retval = nullfield
Case m.cfldtype $ 'CM'
Do Case
Case Empty(m.in_name)
retval = charblank
Otherwise
retval = Iif(Isalpha(m.in_name), m.in_name, 'C_'+m.in_name)
*!* Now have to truncate to 10 bytes
retval=Left(m.retval, 10)
If Len(Rightc(m.retval, 1)) = 1 And IsLeadByte(Rightc(m.retval,1)) && last byte is Double byte
m.retval = Left(m.retval,9)
Endif
Endcase
Case m.cfldtype $ 'NFIYB'
retval = 'N_'+Alltrim(Str(m.in_name, 8, Min(in_dec,7)))
Case m.cfldtype $ 'DT'
retval = Iif(Empty(m.in_name), dateblank, 'D_' + Dtos(m.in_name))
Case m.cfldtype = 'L'
retval = Iif(m.in_name, 'True', 'False')
Otherwise
*!* Should never happen
This.alert(c_unknownfld)
Return "Unknown"
Endcase
*!* We need to replace bad characters here with "_"
retval = Chrtranc(m.retval, This.badchars, This.repchars)
Return Upper(Alltrim(m.retval))
Endfunc
Protected Procedure checknames(afldarray)
*!* Checks to see if field names are unique, else assigns a new one
Local cexactstat, ntmpcnt, ctmpcntstr, coldvalue, i
For i = 1 To Alen(afldarray, 1)
Store Alltrim(afldarray[i,1]) To coldvalue, ccheckvalue
ntmpcnt = 1
Do While !This.fldunique(@afldarray, m.ccheckvalue, i)
ctmpcntstr = "_"+Alltrim(Str(m.ntmpcnt))
ccheckvalue = Left(m.coldvalue, 10 - Len(m.ctmpcntstr)) + m.ctmpcntstr
ntmpcnt = m.ntmpcnt + 1
Enddo
afldarray[i,1] = m.ccheckvalue
Endfor
Endproc
Protected Function fldunique(afldarray, ccheckvalue, npos)
*!* Checks to see if field name is unique
Local i
For i = 1 To npos - 1
If afldarray[i,1] == ccheckvalue
Return .F.
Endif
Endfor
Return .T.
Endfunc
Procedure Error(nerror, cmethod, nline)
This.alert("Line: "+Alltrim(Str(m.nline))+Chr(13) ;
+"Program: "+m.cmethod+Chr(13) ;
+"Error: "+Alltrim(Str(nerror))+Chr(13) ;
+"Message: "+Message()+Chr(13);
+"Code: "+Message(1))
Return To runxtab
Endproc
Protected Procedure alert(strg)
Messagebox(m.strg, 16, "FastXtab")
Endproc
Enddefine
*!* TODO: Support for long field names
*!* lTotalRows property
Bilmediğin Neyse Yanıldığındır.
- ugurlu2001
- Uzman Üye
- Offline
Re: fastxtab totalrows
Site arşivinde geziniyordum ve Naomi Nosonovsky 'nun yukarıdaki kodunun nasıl çalıştığını görmek istedim ama çalıştıramadım. Nasıl kullanabileceğim konusunda yardımcı olursanız sevinirim. Aldığım Hata mesajı:
Line: 241
Program :RunxTab
Erros: 1807
Message: SQL: GROUP BY CLAUSE is missing or invalid
Code: Select &rowfldname AS rowfld, ...........
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ü
-------------------------------------------------------------------------------------------------------------
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ü
- ugurlu2001
- Uzman Üye
- Offline
Re: fastxtab totalrows
Sorun benim kullanıdığım DBF 'nin yapısındaymış. Cihan Abi 'ye teşekkür ediyorum
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ü
-------------------------------------------------------------------------------------------------------------
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ü