Txbrowse Database handle

[Ehab Samir Aziz]

What methods used in Txbrowse to add,edit,delete record browsed using Txbrowse ?

[areang]

Ehab.

create each button on your dialog
....oDlg....
....oBrw....

@20,10 button "add" size 20,12 of oDlg pixel action ( addRecord() )

@20,60 button "Del" size 20,12 of oDlg pixel action ( DeleteRecord() )


function addrecord()
mydata->(dbAppend())
oBrw:nLen += 1
oBrw:Refresh()
return nil

function Deleterecord()
mydata->(dbDelete())
oBrw:nLen -= 1
oBrw:Refresh()
return nil

areang

[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

[ShumingWang]

samples



http://www.xtech.com.cn/down/sample1.prg
http://www.xtech.com.cn/down/sample2.prg


Shuming Wang

[Ehab Samir Aziz]

What about header files ? is there english for that Chinese Site ?

[Carlos Sincuir]

ShumingWang, in your samples (sample1.prg & sample2.prg) are this lines:

Code: Select all  Expand view

obrow1 := TXBrowse():New( odlg )
obrow1:SetMySQL(@odb0)


can you show the code of the method SetMySql ?

Best regards.

Carlos Sincuir

[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[i]))
if lang->(FOUND())
cmsg[i]:=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[i])>0
lang->(DBSEEK(aheaders[i]))
if lang->(FOUND())
aheaders[i]:=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[i]:cfooter)>=1
::acols[i]: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[i]:lhide
oHoja:Cells( nRow, i2 ):Value := ::acols[i]: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[i]: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,"&","&amp;")
cValue:= strTran(cValue,"<","&lt;")
cValue:= strTran(cValue,">","&gt;")
cValue:= strTran(cValue,"'","&apos;")
cValue:= strTran(cValue,["],[&quot;])

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