Useful UDF (User defined functions)

Source code related resources

Moderator: Rathinagiri

User avatar
Rathinagiri
Posts: 5240
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 162 times
Been thanked: 159 times
Contact:

Useful UDF (User defined functions)

Post by Rathinagiri » Wed Jan 13, 2010 7:03 am

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)
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

User avatar
mol
Posts: 3041
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 170 times
Been thanked: 92 times
Contact:

Post by mol » Wed Jan 13, 2010 8:03 am

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

User avatar
Rathinagiri
Posts: 5240
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 162 times
Been thanked: 159 times
Contact:

Post by Rathinagiri » Wed Jan 13, 2010 8:05 am

Thanks a lot Marek. It is very much useful.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

User avatar
mol
Posts: 3041
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 170 times
Been thanked: 92 times
Contact:

Post by mol » Wed Jan 13, 2010 8:50 am

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

User avatar
Rathinagiri
Posts: 5240
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 162 times
Been thanked: 159 times
Contact:

Post by Rathinagiri » Wed Jan 13, 2010 9:18 am

Great Marek.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

User avatar
sudip
Posts: 1444
Joined: Sat Mar 07, 2009 11:52 am
Location: Kolkata, WB, India
Has thanked: 4 times

Post by sudip » Wed Jan 13, 2010 10:39 am

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
With best regards,
Sudip

User avatar
Rathinagiri
Posts: 5240
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 162 times
Been thanked: 159 times
Contact:

Post by Rathinagiri » Wed Jan 13, 2010 12:32 pm

So nice of you Sudip.

Yes, we can create a set of udf with documentation. :)
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

User avatar
Rathinagiri
Posts: 5240
Joined: Tue Jul 29, 2008 6:30 pm
DBs Used: MariaDB, SQLite, SQLCipher and MySQL
Location: Sivakasi, India
Has thanked: 162 times
Been thanked: 159 times
Contact:

Post by Rathinagiri » Wed Jan 13, 2010 1:02 pm

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
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

User avatar
mol
Posts: 3041
Joined: Thu Sep 11, 2008 5:31 am
Location: Myszków, Poland
Has thanked: 170 times
Been thanked: 92 times
Contact:

Post by mol » Wed Jan 13, 2010 1:39 pm

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

User avatar
Roberto Lopez
HMG Founder
Posts: 3919
Joined: Wed Jul 30, 2008 6:43 pm
Has thanked: 15 times
Been thanked: 140 times

Post by Roberto Lopez » Wed Jan 13, 2010 2:36 pm

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!
Regards/Saludos,

Roberto


(Veritas Filia Temporis)

Post Reply