Page 1 of 4
Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 7:03 am
by Rathinagiri
Hi,
Here we can accumulate useful HMG related UDF (User Defined Functions)
First I start with GetWindowControls(cFormName) Function. The function returns an array of control names.
Code: Select all
function GetWindowControls(cForm)
local aControlList := {}
local i := 0
for i := 1 to len(_HMG_SYSDATA[4])
if _HMG_SYSDATA[4,i] == GetFormHandle(cForm)
if len(alltrim(_HMG_SYSDATA [ 2,i])) > 0
aadd(aControlList,_HMG_SYSDATA [ 2,i])
endif
endif
next i
return aclone(aControlList)
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 8:03 am
by mol
I want to put CopyToClipBoard function - maybe someone will search it:
Code: Select all
function CopyToClipboard
param cText
#define HB_GTI_CLIPBOARDDATA 15
hb_gtInfo( HB_GTI_CLIPBOARDDATA, cText )
return
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 8:05 am
by Rathinagiri
Thanks a lot Marek. It is very much useful.
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 8:50 am
by mol
Another function, which I want to share, is function for changing statusbar item.
Code below is well documented, I think. One comment:
bStatusBarItemAction should be passed as compiled block, eg:
Code: Select all
bStatusBarItemAction := &("{ || MsgBox('New statusbar item message' ) } ")
SetStatusBarItem( cCurrentWindow, DBFilterStatusBarItem, "FILTR",;
bStatusBarItemAction )
and whole function below:
Code: Select all
function SetStatusBarItem
param cWindowName, nStatusBarItemNumber, cStatusBarItemValue, bStatusBarItemAction
local bOldErrorBlock
local i
local lRet := .f.
bOldErrorBlock := ErrorBlock({|e| break(e)})
BEGIN SEQUENCE
// Add information to StatusBar about defined filter
if IsControlDefined( StatusBar, &cWindowName)
// StatusBarItem is deined, we can change its value
SetProperty(cWindowName,"StatusBar","Item",nStatusBarItemNumber, cStatusBarItemValue )
if type("bStatusBarItemAction") == "B"
// changing action for item
// first:
// retrieve action for StatusBar actions
i := GetControlIndex ( "StatusBar" , cWindowName )
abActions := _HMG_SYSDATA [ 6 ] [i]
if valtype(abActions) <> "A"
// it won't happpen
abActions := array(nStatusBarItemNumber)
elseif len(abActions) < nStatusBarItemNumber
// I think, it won't happen too
abActions := asize( abActions, nStatusBarItemNumber)
endif
// set code block for StatusBar Item
abActions[ nStatusBarItemNumber ] := bStatusBarItemAction
_HMG_SYSDATA [ 6 ] [i] := abActions
endif
lRet := .t.
else
//StatusBar is not defined
// nothing to do
endif
RECOVER
// catch for error when StatusBar is not defined
END SEQUENCE
ErrorBlock(bOldErrorBlock)
return lRet
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 9:18 am
by Rathinagiri
Great Marek.
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 10:39 am
by sudip
Thanks a lot Rathi and Marek,
Those functions are very useful. BTW, I am already using Rathi's several functions in my code
, eg, NumWinOpened() (number of windows opened) and many SQL functions.
Is it possible to archive these UDFs with proper documentation and small usage examples? IMHO, this will be extremely helpful
I also want to re-share (
) my DbCreaChk() function which will check and create .dbf table using following logic:
1) Create if table doesn't exist.
2) Alter/Add/Remove columns from existing table.
Code: Select all
#include "dbstruct.ch"
#include "minigui.ch"
FUNCTION dbCreaChk(fname, adbf)
local aStruct, option, lChange := .f., lNew := .f., i, newrec, oldrec
fname := upper(fname)
if !file(fname+".dbf")
set exclusive on
dbcreate(fname, adbf)
set exclusive off
return .t.
endif
use (fname)
aStruct = dbstruct()
use
if len(aStruct) != len(adbf)
lChange = .t.
else
i = 1
do while i <= len(aStruct) .and. !lNew .and. !lChange
if len(aStruct[i, DBS_NAME]) != len(adbf[i, DBS_NAME]) ;
.or. upper(aStruct[i, DBS_NAME]) != upper(adbf[i, DBS_NAME]) ;
.or. upper(aStruct[i, DBS_TYPE]) != upper(adbf[i, DBS_TYPE]) ;
.or. aStruct[i, DBS_LEN] != adbf[i, DBS_LEN] ;
.or. aStruct[i, DBS_DEC] != adbf[i, DBS_DEC]
lChange = .t.
endif
i++
enddo
endif
if lChange
if msgyesno(fname+" structure has been changed. Change";
+" the structure ?")
set exclusive on
use (fname)
pack
oldrec = reccount()
use
deletefile("settemp.dbf")
if renamefile(fname+".dbf", "settemp.dbf") != 0
msginfo("Cannot change file structure!",)
QUIT
ENDIF
dbcreate(fname, adbf)
use (fname)
append from settemp
newrec = reccount()
use
if newrec != oldrec
msginfo("Problem in creating file :"+fname+;
". You can get all records in the file SETTEMP.DBF")
quit
endif
deletefile("settemp.dbf")
set exclusive off
return .t.
else
msginfo(fname+" structure mismatch")
quit
endif
endif
return .f.
function NetSelect(cTable)
if select(cTable) = 0
use &cTable shared new
endif
select (cTable)
return nil
With best regards.
Sudip
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 12:32 pm
by Rathinagiri
So nice of you Sudip.
Yes, we can create a set of udf with documentation.
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 1:02 pm
by Rathinagiri
This is a group of udf for just showing a text file.
Usage: ShowTextFile(cFilename)
Notes: Any number of lines more than 150000 are truncated.
Code: Select all
function ShowTextFile(_filename)
local _winname := "showtext"
private _winwidth := thiswindow.width - 20
private _winheight := thiswindow.height - 60
if iswindowdefined(&_winname)
release window &_winname
endif
define window &_winname at 0,0 width _winwidth height _winheight title _filename modal nosize on init textshow(_filename,_winname)
@ _winheight - 60,int(_winwidth /2)-50 button exit1 caption "Exit" width 100 action textshowexit(_winname)
end window
center window &_winname
activate window &_winname
return nil
function textshowexit(_winname)
release window &_winname
return nil
function textshow(_filename,_winname)
local lines1 := {}
local handle := fopen(_filename,0)
local size1 := 0
local size2 := 0
local sample := 0
local lineno := 0
local eof1 := .f.
local linestr := ""
local c := ""
local len1 := 0
local x := 0
local finished := .f.
local m := 0
local length1 := 0
local totpages := 0
local linecount := 0
local length2 := 0
local pagecount := 0
local start := 0
local end := 0
local v := 0
local v1 := 0
if handle == -1
return nil
endif
size1 := fseek(handle,0,2)
size2 := size1
if size1 > 65000
sample := 65000
else
sample := size1
endif
fseek(handle,0)
lineno := 1
aadd(lines1,"")
c := space(sample)
eof1 := .f.
linestr := ""
len1 := 0
do while .not. eof1
x := 0
x := fread(handle,@c,sample)
len1 := len1 + sample
if x < 1
eof1 := .t.
lines1[lineno] := linestr
else
finished := .f.
do while .not. finished
m := at(chr(13),c)
if m > 0
if m == 1
linestr := ""
lineno := lineno + 1
aadd(lines1,"")
c := substr(c,m+1,len(c))
else
if len(alltrim(linestr)) > 0
linestr := linestr + substr(c,1,m-1)
else
linestr := substr(c,1,m-1)
endif
c := substr(c,m+1,len(c))
lines1[lineno] := linestr
linestr := ""
lineno := lineno + 1
aadd(lines1,"")
endif
else
linestr := c
finished := .t.
endif
enddo
c := space(sample)
endif
enddo
fclose(handle)
define tab pages of &_winname at 10,10 width _winwidth - 20 height _winheight - 90
length1 := len(lines1)
if length1 <= 10000
totpages := 1
else
totpages := 0
length2 := length1
do while length2 > 0
length2 := length2 - 10000
totpages := totpages + 1
enddo
endif
if totpages > 15
return nil
endif
for pagecount := 1 to totpages
start := ((pagecount-1) * 10000) + 1
if pagecount == totpages
end := len(lines1)
else
end := start + 9999
endif
page "Page "+alltrim(str(pagecount))
v := "lb"+alltrim(str(pagecount))
v1 := "page"+alltrim(str(pagecount))
&v1 := {}
for linecount := start to end
aadd(&v1,{substr(lines1[linecount],2,len(lines1[linecount]))})
next j
@ 25,10 grid &v width _winwidth - 50 height _winheight - 120 headers {_filename} widths {800} items &v1 value 1 font "courier new" size 10 nolines
end page
next pagecount
end tab
return nil
function textfileprint(_filename)
copy file (_filename) to lpt1
return nil
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 1:39 pm
by mol
I think, that great idea launched by Rathi can give us big library of useful functions.
Everyone should be a little documented, maybe with small sample of use.
Bravo Rathi for start!
Thanks Sudip for joining!
Marek
Re: Useful UDF (User defined functions)
Posted: Wed Jan 13, 2010 2:36 pm
by Roberto Lopez
mol wrote:I think, that great idea launched by Rathi can give us big library of useful functions.
Everyone should be a little documented, maybe with small sample of use.
Nice Idea!