tsbutton+xbrowse done a google like app help

tsbutton+xbrowse done a google like app help

Postby ShumingWang » Thu Jul 24, 2008 10:01 am

Hi,
After two days working,done a google search mode app.exe manual help.
Image
Codes are simple.

FUNCTION weihu17(cvar0)
local odlg,obrow,cvar1:=SPACE(30),aRight:=if(ASCAN(aFunctions,"weihu17")>0,aRights[ASCAN(aFunctions,"weihu17")],{"","","","","","",""})
local ledit:=aright[2]=="Y"
local ofont1,ofont2,font3
private odb1

DEFINE FONT ofont1 NAME 'arial' underline SIZE 0,-16
DEFINE FONT ofont2 NAME 'arial' SIZE 0,-12
DEFINE FONT ofont3 NAME 'arial' underline SIZE 0,-12

if cvar0<>nil;cvar1:=cvar0+SPACE(20); end
odb1:=oserver:query("select * from help where belongto like '%"+ALLTRIM(cvar1)+"%'")
DEFINE DIALOG odlg RESOURCE "help" TITLE "帮助" FONT oFont14


REDEFINE GET cvar1 ID 101 OF odlg
REDEFINE SBUTTON ID 102 OF odlg PROMPT "搜索" xp ACTION weihu1701(cvar1,odb1,obrow)
REDEFINE SBUTTON ID 103 OF odlg PROMPT "详细>>" xp ACTION weihu1702(odb1,obrow,ledit)

obrow := TXBrowse():New( odlg )
obrow:SetMySQL(@odb1)
obrow:BLDBLClick:={||weihu1702(odb1,obrow,ledit)}


oCol := obrow:AddCol()
oCol:bStrData := {||ALLTRIM(odb1:ctitle)+CRLF+ALLTRIM(odb1:descrip)+CRLF+ALLTRIM(odb1:belongto)}
oCol:cHeader := "说明"
ocol:nHeadStrAlign :=AL_LEFT
if rsl0<=1
ocol:nwidth:=460
else
ocol:nwidth:=560
end

obrow:nDataLines := 2
obrow:nrowheight:=92

obrow:CreateFromReSource(201)

obrow:nColDividerStyle := LINESTYLE_NOLINES
obrow:nRowDividerStyle := LINESTYLE_NOLINES
obrow:lColDividerComplete := .f.
obrow:lHScroll:=.f.
//obrow:nHeaderLines := 0
//obrow:lheader:=.f.

//if cvar0<>nil
// obrow:bskip:=obrow:bskipper
obrow:lRecordSelector:=.f.
obrow:nMarqueeStyle := MARQSTYLE_NOMARQUEE
//end

with object obrow:acols[1]
:bPaintText := { |oCol, hDC, cText, aCoord| DrawText( oCol, hDC, cText, aCoord, ofont1, ofont2,ofont3 ) }
END

REDEFINE SBUTTON ID 301 OF odlg PROMPT "网页格式帮助" nobox COLORS { |oBtn| If( ! oBtn:lActive, CLR_HBLUE, ;
If( oBtn:lMouseOver, CLR_HBLUE, ;
If( oBtn:lPressed, CLR_HRED, CLR_BLUE ) ) ) };
ACTION htmhelp()
REDEFINE SBUTTON ID 302 OF odlg PROMPT "流程图" nobox COLORS { |oBtn| If( ! oBtn:lActive, CLR_HBLUE, ;
If( oBtn:lMouseOver, CLR_HBLUE, ;
If( oBtn:lPressed, CLR_HRED, CLR_BLUE ) ) ) };
ACTION fromto(cvar0)
REDEFINE SBUTTON ID 303 OF odlg PROMPT "打印" nobox COLORS { |oBtn| If( ! oBtn:lActive, CLR_HBLUE, ;
If( oBtn:lMouseOver, CLR_HBLUE, ;
If( oBtn:lPressed, CLR_HRED, CLR_BLUE ) ) ) };
ACTION obrow:report()
REDEFINE SBUTTON ID 304 OF odlg PROMPT "退出" nobox COLORS { |oBtn| If( ! oBtn:lActive, CLR_HBLUE, ;
If( oBtn:lMouseOver, CLR_HBLUE, ;
If( oBtn:lPressed, CLR_HRED, CLR_BLUE ) ) ) };
ACTION odlg:end()
ACTIVATE DIALOG odlg
// on INIT (odlg:autoresize())
odb1:end()
RELEASE FONT ofont1
RELEASE FONT ofont2
RELEASE FONT ofont3
return

static function DrawText( oCol, hDC, cText, aCoord, ofont1, ofont2,ofont3 )

local nTop := aCoord[ 1 ], nLeft := aCoord[ 2 ]
local nBottom := aCoord[ 3 ], nRight := aCoord[ 4 ]
local nRow := nTop
local cLine, nFontHt

SetTextColor( hDC, CLR_HBLUE)
ofont1:Activate( hDC )
nFontHt := GetTextHeight( oCol:oBrw:hWnd, hDC )
DrawTextEx( hDC, ALLTRIM(odb1:ctitle), { nRow, nLeft, nRow + nFontHt + 4, nRight }, oCol:nDataStyle )
ofont1:DeActivate( hDC )

SetTextColor( hDC, CLR_BLACK)
nRow += nFontHt + 4
ofont2:Activate( hDC )
DrawTextEx( hDC, odb1:descrip, { nRow, nLeft, nRow + 2*nFontHt + 2, nRight }, oCol:nDataStyle )
ofont2:DeActivate( hDC )

SetTextColor( hDC, CLR_GREEN)
nRow += 2*nFontHt
ofont3:Activate( hDC )
DrawTextEx( hDC, "适用表单:"+ALLTRIM(odb1:belongto), { nRow, nLeft, nbottom, nRight }, oCol:nDataStyle )
ofont3:DeActivate( hDC )


return nil

FUNCTION weihu1701(cvar1,odb1,obrow)
local ccol
local array1:={}
cvar1:=ALLTRIM(cvar1)
cvar1:=STRTRAN(cvar1," ",",")

ccol:=StrToken( cvar1, 1, "," )
AADD(array1,ccol)
nfor:=1

while .t.
cCol := StrToken( cvar1, nFor + 1, "," )
if EMPTY(ccol)
exit
end
AADD(array1,ccol)
nfor ++

end

do case
case LEN(array1)==1
csql1:="select * from help where belongto like '%"+ALLTRIM(array1[1])+"%' or ctitle like '%"+ALLTRIM(array1[1])+"%' or descrip like '%"+ALLTRIM(array1[1])+"%'";
+" order by ctitle"
case LEN(array1)==2
csql1:="select * ";
+"from ";
+"( select * from help where belongto like '%"+ALLTRIM(array1[1])+"%' or ctitle like '%"+ALLTRIM(array1[1])+"%' or descrip like '%"+ALLTRIM(array1[1])+"%'";
+") a1";
+" where belongto like '%"+ALLTRIM(array1[2])+"%' or ctitle like '%"+ALLTRIM(array1[2])+"%' or descrip like '%"+ALLTRIM(array1[2])+"%'";
+" order by ctitle"

otherwise
csql1:="select * ";
+" from (select * ";
+" from ( select * from help where belongto like '%"+ALLTRIM(array1[1])+"%' or ctitle like '%"+ALLTRIM(array1[1])+"%' or descrip like '%"+ALLTRIM(array1[1])+"%'";
+") a1";
+" where belongto like '%"+ALLTRIM(array1[2])+"%' or ctitle like '%"+ALLTRIM(array1[2])+"%' or descrip like '%"+ALLTRIM(array1[2])+"%'";
+") b1 ";
+" where belongto like '%"+ALLTRIM(array1[3])+"%' or ctitle like '%"+ALLTRIM(array1[3])+"%' or descrip like '%"+ALLTRIM(array1[3])+"%'";
+" order by ctitle"
end

odb1:cquery:=csql1
odb1:refresh()
obrow:refresh()
return

FUNCTION weihu1702(odb0,obrow,ledit)
local odlg,mid1:=odb0:mid,odb1:=oserver:query("select * from help where "+if(mid1==0,"0>1","mid="+cvaltochar(mid1)))

DEFINE DIALOG odlg RESOURCE "help02" TITLE "帮助详细" FONT oFont14

if ledit
REDEFINE GET odb1:ctitle ID 101 OF odlg
REDEFINE GET odb1:descrip TEXT ID 102 OF odlg
REDEFINE GET odb1:belongto TEXT ID 103 OF odlg
else
REDEFINE GET odb1:ctitle TEXT ID 101 OF odlg readonly
REDEFINE GET odb1:descrip TEXT ID 102 OF odlg readonly
REDEFINE GET odb1:belongto TEXT ID 103 OF odlg readonly
end

REDEFINE group ID 901 PROMPT "项目" OF odlg transparent
REDEFINE group ID 902 PROMPT "详细说明" OF odlg transparent
REDEFINE group ID 903 PROMPT "适用表单" OF odlg transparent



REDEFINE SBUTTON ID 301 OF odlg PROMPT "保存" xp ACTION (if( odb1:EOF(),odb1:APPEND(),odb1:SAVE())) WHEN ledit
REDEFINE SBUTTON ID 302 OF odlg PROMPT "退出" xp ACTION odlg:end()

ACTIVATE DIALOG odlg on INIT (odlg:autoresize()) center
odb0:refresh()
obrow:refresh()
return

Regards!
Shuming Wang
ShumingWang
 
Posts: 465
Joined: Sun Oct 30, 2005 6:37 am
Location: Guangzhou(Canton),China

Postby Antonio Linares » Thu Jul 24, 2008 12:04 pm

Shuming,

Nice! Thanks for sharing it :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 42080
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain


Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 57 guests