Posted: Thu Sep 28, 2006 1:48 am
by ShumingWang
1. insert and delete record
obrow:bKeyDown := {|nKey| if(nKey==VK_DELETE, (if(msgyesno("Delte ?","pls confirm"),(odb2:DELETE(),obrow:Refresh())),)),if(nkey==VK_INSERT,(obrow:gobottom(),obrow:godown(),obrow:goleftmost()),)) }
2. append
oCol := obrow:AddCol()
oCol:bStrData := {||odb2:stockid}
oCol:cHeader := "ID"
oCol:bEditValue := {||odb2:stockid}
oCol:nEditType := {||if(ledit,1,0)}
oCol:bOnPostEdit := {|o, v, n| if( n != VK_ESCAPE .and. v != odb2:stockid,;
(if(odb2:EOF(),;
(odb2:stockid:=v,odb2:lmrp:="Y",odb2:APPEND(),if(!oserver:lerror,obrow:SEEK(v),msgstop("！","stop"))),;
(stockid1:=odb2:stockid,odb2:stockid:=v,odb2:save(),if(oserver:lError,(msgstop("！","stop"),obrow:SEEK(stockid1)),obrow:SEEK(v)) );
),;
), ;
) }
Shuming Wang
Posted: Wed Oct 11, 2006 4:03 am
by ShumingWang
METHOD SetMySQL(oQuery)
METHOD Report( cTitle, lPreview, aheaders,afooters,oFont, nLang, cCaption, lModal )
METHOD RPTSKIP()
METHOD NTOTAL()
METHOD SAVE()
METHOD end() INLINE ::Destroy()
METHOD SetMySQL(oquery,ledit) CLASS TXBrowse
::nMarqueeStyle := MARQSTYLE_HIGHLCELL
::nColDividerStyle := LINESTYLE_LIGHTGRAY
::nRowDividerStyle := LINESTYLE_LIGHTGRAY
::lColDividerComplete := .t.
::nRowHeight := 23
::lfastedit := .t.
::nDataType := DATATYPE_MYSQL
DEFAULT ::bGoTop := {|| oQuery: GoTop() },;
::bGoBottom := {|| oQuery: GoBottom() },;
::bSkip := {| n |oQuery: SKIP( n ) },;
::bSkipper := {| n |oQuery: SKIPPER( n ) },;
::bBof := {|| oQuery: Bof() },;
::bEof := {|| oQuery: Eof() },;
::bBookMark := {| n | if( n == nil, oQuery:RecNo(),oQuery:Goto( n ))},;
::bKeyNo := ::bBookMark,;
::bKeyCount := {|| oQuery:LastRec() },;
::odbf:=oQuery
return nil
METHOD Report( cTitle, lPreview, aHeaders, aFooters, oFont,cCaption, lModal ) CLASS TXBrowse
Local oRpt, oColumn, nRecNo, nI, nAt, cType, lNoResetPos, ;
nCols := Len( ::acols ), ofont2,ofont3,nRpos,oldbskip:=::bskip
local odevice,cmsg:={"打印","日期","时间","第","页"},i
oDevice := TPrinter():New(cmsg[1],.F.)
if odevice:hdc==0; odevice:end(); return .f.; end
odevice:end()
Default cTitle := ::oWnd:GetText(), ;
lPreview := .T., ;
aHeaders := {cmsg[2] + DTOC(DATE())+ " "+cmsg[3]+TIME()},;
cCaption := ::oWnd:GetText(), ;
lModal := .F.
if SELECT("lang")>0
SELECT lang
for i:=1 TO LEN(cmsg)
lang->(DBSEEK(cmsg))
if lang->(FOUND())
cmsg:=ALLTRIM(lang->(FIELDGET(nlang)))
end
next i
if VALTYPE(ctitle)=="C"
if LEN(ctitle )>0
lang->(DBSEEK(ctitle))
if lang->(FOUND())
ctitle :=ALLTRIM(lang->(FIELDGET(nlang)))
end
end
end
if VALTYPE(ccaption)=="C"
if LEN(ccaption )>0
lang->(DBSEEK(ccaption))
if lang->(FOUND())
ccaption :=ALLTRIM(lang->(FIELDGET(nlang)))
end
end
end
if aheaders<>NIL
for i:=1 TO LEN(aheaders)
if LEN(aheaders)>0
lang->(DBSEEK(aheaders))
if lang->(FOUND())
aheaders:=ALLTRIM(lang->(FIELDGET(nlang)))
end
end
next i
end
end
if EVAL(::beof)
if (EVAL(::bBookMark)==EVAL(::bKeycount)+1).and.(len(::aSelected)==1) ; return self ; end
::SKIP(-1)
end
if ::nDataType==DATATYPE_MYSQL
::bskip:=::bskipper
end
::gotop()
define font ofont2 name "arial" size 0,-18
DEFINE font ofont3 name "Times New Roma" size 0,-11
//if ofont==nil
ofont:=ofont3
//end
If lPreview
REPORT oRpt TITLE cTitle FONT oFont3,ofont2 ;
CAPTION cCaption PREVIEW ;
HEADER aHeaders[1];
FOOTER cmsg[4] + Str( oRpt:nPage, 3 )+cmsg[5] ;
CENTER
Else
REPORT oRpt TITLE cTitle CAPTION cCaption FONT oFont3,ofont2 ;
HEADER aHeaders[1];
FOOTER cmsg[4]+ Str( oRpt:nPage, 3 )+cmsg[5] ;
CENTER
EndIf
oRpt:oDevice:lPrvModal := lModal
oRpt:bPostEnd := {|| ::SetFocus() }
// best way to make sure focus get's back to where we want, not the damn WinAPI
For nI := 1 To nCols
// If len(::aCols[ nI ]:abitmaps)==0 .and. !::aCols[nI]:lHide
If !::aCols[nI]:lHide
oRpt:AddColumn( TrColumn():New( { GenHead( ::acols, nI ) },, ;
{ GenData( ::aCols, nI ) },::acols[ni]:nwidth*0.12, ;
{ If( ! Empty( ::acols[ nI ]:cEditPicture), ;
::acols[ nI ]:cEditPicture, "" ) },, ;
( len(::acols[ nI ]:cFooter)>0 .and.::acols[nI]:nDataStrAlign==1 ),, ; // prints footings if the column has one (numeric only)
If( ::acols[nI]:nDataStrAlign==1, "RIGHT", Nil ),,,, oRpt ) )
EndIf
Next
END REPORT
oRpt:bSkip := { || oRpt:Cargo := ::rptSKIP( ) }
oRpt:Cargo := 1
oRpt:cellview()
oRpt:otitle:aFont[1] := {|| 2 }
orpt:ntitleupline:=1
orpt:ntitlednline:=1
orpt:ntotalline:=1
IF len(::aselected)>0
While AScan( ::aSelected, ;
If( ::NDATATYPE==DATATYPE_ARRAY,::nArrayAt,eval(::bKeyno)))==0
::skip(1)
End
end
ACTIVATE REPORT oRpt ;
WHILE If( ::ndatatype == DATATYPE_ARRAY,;
oRpt:nCounter <= Max( ( Eval( ::bLogicLen ) ) - 1, 1 ),;
oRpt:Cargo >= 1 )
::bskip:=oldbskip
::GoTop()
ofont2:end()
ofont3:end()
Return Self
// Call for report()
Static Function GenHead( aArray, nPos )
Return {|| aArray[nPos]:cHeader }
// Call for Report
Static Function GenData( aArray, nPos )
Return If( ValType(Eval(aArray[nPos]:bStrData)) != "U", ;
if(len(aArray[nPos]:cfooter)>=1.and.aArray[nPos]:nfootStrAlign==1,aArray[ nPos ]:bStrData,aArray[ nPos ]:bStrData), {|| "" } ) // check for "phantom" columns
Method Rptskip() class Txbrowse
local n1,n1old
n1old:=::skip(1)
n1:=n1old
IF len(::aSelected)>0
While AScan( ::aSelected, If( ::nDatatype==DATATYPE_ARRAY,::nArrayAt,eval(::bKeyno)))==0
n1+=::skip(1)
if ::nDATATYPE<>DATATYPE_ARRAY
if eval(::bKeyno)==eval(::bkeyCount)
n1:=0
exit
end
else
if ::nArrayAt==len(::aArray)
n1:=0
exit
end
end
if n1==n1old
exit
end
n1old:=n1
enddo
end
return n1
Method nTotal() class TXbrowse
local i,i2,i1
::lfooter:=.t.
if len(::acols)>1; ::acols[1]:cfooter:="合计"; end
for i:=2 to len(::acols)
if len(::acols:cfooter)>=1
::acols:cfooter:=" "
end
next
eval(::bgotop)
while !eval(::bEof)
if len(::aSelected)>0.and.aScan(::aSelected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end
for i2:=2 to len(::acols)
if len(::acols[i2]:cfooter)>=1
::acols[i2]:cfooter:=cvaltochar(val(::acols[i2]:cfooter)+val(cvaltochar(eval(::acols[i2]:bStrData))))
end
next i2
eval(::bSkip)
end
::adjust()
::GoTop()
::Refresh()
Return Nil
//-----------------------------------------
METHOD Save() CLASS TXBrowse
/*return msgrun("正在准备数据……","请稍候",{||xbrowsesave()})
STATIC function txbrowsesave()
*/
LOCAL oExcel, oHoja
LOCAL nRow := 1, nCol,i,i2,nchoice:=1,lok:=.f.
LOCAL cBuffer
local cDBF
LOCAL cValue
LOCAL cTable
LOCAL nHandle
LOCAL nFields
LOCAL nField
LOCAL nPos ,ofont14,odlg2,cvaltype
LOCAL aarray1
local Arry1:={},arry2:={},cfile1:="d:\aaa.dbf"+SPACE(15),arry3,cAlias1,utmpvar,utmpvar1
local noldrowsel:=::nrowsel
if Eval(::bKeyCount)==0; Return ""; End
nchoice:=Alert("当前表格数据另存出",{"Excel","DBF文件","XML"})
Do case
Case Nchoice==1
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:WorkBooks:Add()
oHoja := oExcel:Get( "ActiveSheet" )
Eval(::bGotop)
i2:=1
for i:=1 to len(::Acols)
if !::acols:lhide
oHoja:Cells( nRow, i2 ):Value := ::acols:cHeader
i2++
end
NEXT
Eval(::bGotop)
DO WHILE !Eval(::bEof)
if len(::aSelected)>0.and.aScan(::aSelected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end
nRow++
i2:=1
FOR nCol := 1 TO len(::Acols)
if !::acols[ncol]:lhide
utmpvar1:=EVAL(::acols[nCol]:bStrdata)
if VALTYPE(utmpvar1)=="U".or.valtype(utmpvar1)==NIL
utmpvar:=""
else
utmpvar:=utmpvar1
end
if VALTYPE(utmpvar)=="D".and.utmpvar==CTOD("..")
utmpvar:=""
end
if VALTYPE(utmpvar)=="C"
oHoja:Cells( nRow, i2 ):NumberFormat := "@"
end
oHoja:Cells( nRow, i2 ):Value := utmpvar
i2++
end
NEXT
Eval(::bSkip)
ENDDO
FOR nCol := 1 TO len(::aCols)
oHoja:Columns( nCol ):AutoFit()
NEXT
oExcel:Visible := .T.
//oHoja:End()
// oExcel:End()
case nchoice==2
if !MsgGet("文件名第一个为字母，文件名不能有汉字","另存路径和文件",@cFile1)
return NIL
end
cFile1:=alltrim(cFile1)
aarray1:={}
DEFINE dialog odlg2 from 4,6 to len(::acols)*2+5,50 title "生成DBF"
// style nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU ,WS_VSCROLL)
i:=1
i2:=1
for i:=1 to len(::acols)
if !::acols:lhide
@i2*0.86,2 say ::acols[i]:cheader of odlg2
AADD(aarray1,"a"+padl(cvaltochar(i2),3,'0')+space(11))
TGet():New( i2, 5, GenLocalBlock( aarray1, i2), odlg2, 75,12 )
i2++
end
next
@i2*0.86,2 say "注意:字段名称不能有汉字,必须以字母开头" of odlg2
@1,22 BUTTON "确定" OF odlg2 ACTION (lok:=.t.,odlg2:end())
@2,22 BUTTON "返回" OF odlg2 ACTION odlg2:end()
ACTIVATE DIALOG odlg2 CENTER
if !lok; return nil; end
i2:=1
for i:=1 to len(::aCols)
if !::acols[i]:lhide
utmpvar:=EVAL(::acols[i]:bStrdata)
cvaltype:=valtype(utmpvar)
if cvaltype<>"D".and.cvaltype<>"L".and.cvaltype<>"C".and.cvaltype<>"N"
cvaltype:="C"
end
aadd(Arry2,{aarray1[i2],cvaltype,max(len(cvaltochar(utmpvar)),int(::acols[i]:nWidth/7)),if(cvaltype=="N",len(cvaltochar(utmpvar))-at(".",cvaltochar(utmpvar)),0)})
i2+=1
end
next
dbcreate(cFile1,Arry2)
use (cfile1) new
cAlias1:=alias()
Eval(::bGoTop)
while !Eval(::bEof)
if len(::Aselected)>0.and.Ascan(::Aselected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end
select (cAlias1)
append blank
i2:=1
for i:=1 to len(::acols)
if !::acols[i]:lhide
utmpvar:=eval(::acols[i]:bStrdata)
select (cAlias1)
fieldput(i2,if(valtype(utmpvar)=="U".or.valtype(utmpvar)==NIL,cvaltochar(utmpvar),utmpvar))
i2++
end
next
Eval(::bSkip)
end
select (cAlias1)
close
msginfo(trans2("已经生成文件")+cfile1,"提示")
case Nchoice==3
if !MsgGet("另存","路径和文件",@cFile1)
return NIL
end
aarray1:={}
DEFINE dialog odlg2 from 4,6 to len(::acols)*4+5,50 title "生成XML"
i:=1
i2:=1
for i:=1 to len(::acols)
if !::acols[i]:lhide
@i2*0.9,2 say ::acols[i]:cheader of odlg2
AADD(aarray1,padr(::acols[i]:cheader,15," "))
TGet():New( i2, 5, GenLocalBlock( aarray1, i2), odlg2, 75,12 )
i2++
end
next
@i2,6 BUTTON "确定" ACTION (lok:=.t.,odlg2:end())
@i2,12 BUTTON "返回" ACTION odlg2:end()
ACTIVATE DIALOG odlg2 CENTER
if !lok; return nil; end
cfile1:=alltrim(cfile1)
cDBF := lower(cfile1)
cFile1 := StrTran( cfile1, ".dbf", ".xml" )
if !".xml"$cfile1
cfile1+=".xml"
end
cTable := Left( cDbf, At( ".", cfile1 ) - 1 )
nHandle := fCreate( cFile1 )
// Writes XML header
fWrite( nHandle, [<?xml version="1.0" encoding="GB2312" ?>] + CRLF )
fWrite( nHandle, Space( 0 ) + "<" + cDbf + ">" + CRLF )
Eval(::bGoTop)
while !Eval(::bEof)
if len(::Aselected)>0.and.Ascan(::Aselected,(Eval(::bKeyNo)))==0; Eval(::bSkip); loop; end
cBuffer := Space( 2 ) + "<" + cTable + ">" + CRLF
fWrite( nHandle, cBuffer )
i2:=1
for i:=1 to len(::acols)
if !::acols[i]:lhide
cBuffer:= Space( 4 ) + "<" + aarray1[i2] + ">"
utmpvar:=eval(::acols[i]:bStrdata)
DO CASE
CASE valtype(utmpvar) == "D"
cValue := Dtos(utmpvar)
CASE valtype(utmpvar) == "N"
cValue := Str( utmpvar)
CASE valtype(utmpvar) == "L"
cValue := If( utmpvar, "True", "False" )
OTHERWISE
cValue := cvaltochar(utmpvar)
ENDCASE
cValue:= strTran(cValue,"&","&")
cValue:= strTran(cValue,"<","<")
cValue:= strTran(cValue,">",">")
cValue:= strTran(cValue,"'","'")
cValue:= strTran(cValue,["],["])
cBuffer := cBuffer + ;
Alltrim( cValue ) + ;
"</" + ;
aarray1[i2]+ ;
">" + ;
CRLF
fWrite( nHandle, cBuffer )
i2++
endif
next
fWrite( nHandle, Space( 2 ) + "</" + cTable + ">" + CRLF )
Eval(::bSkip)
end
fWrite( nHandle, Space(0) + "</" + cDbf + ">" + CRLF )
fClose( nHandle )
msginfo(trans2("已经生成文件")+cfile1,"提示")
endcase
// Eval(::bGoTo)
::setfocus()
::refresh()
return cfile1
static function GenLocalBlock( aGets,n)
return bSETGET( aGets[ n ] )
STATIC FUNCTION GenFieldBlock( cAlias, aStruc, nField, lAsString )
local cType, cField, cMacro
local nLength, nDecim
DEFAULT lAsString := .t.
cType := aStruc[ nField, 2] //DBS_TYPE ]
cField := aStruc[ nField, 1] //DBS_NAME ]
nLength := aStruc[ nField, 3] //DBS_LEN ]
nDecim := aStruc[ nField, 4] //DBS_DEC ]
If !lAsString
cMacro := "{|| " + cAlias + "->" + cField + "}"
else
Do Case
Case cType == "C" .or. cType == "M"
cMacro := "{|| " + cAlias + "->" + cField + "}"
Case cType == "N"
cMacro := "{|| Str( " + cAlias + "->" + cField + ", " + ;
Str( nLength, 2 ) + ", " + Str( nDecim, 1 ) + " ) }"
Case cType == "L"
cMacro := "{|| iif( " + cAlias + "->" + cField + ", '.T.', '.F.' ) }"
Case cType == "D"
cMacro := "{|| Dtoc( " + cAlias + "->" + cField + " ) }"
End Case
Endif
return &cMacro