Useful UDF (User defined functions)

Source code related resources

Moderator: Rathinagiri

User avatar
Vanguarda
Posts: 543
Joined: Wed Feb 11, 2009 10:56 am
Location: Americana - SP
Been thanked: 1 time
Contact:

Re: Useful UDF (User defined functions)

Post by Vanguarda »

Hi friends,

Thanks Rathi and Mol for this nice function. Great work.

My best regards,
--
Paulo Sérgio Durço (Vanguarda)


http://hmglights.wordpress.com/

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

Post by sudip »

Hello All,

Here is a very simple function for ComboBox.

Code: Select all

Function Cbo2Code(mCboVal, aCode)
   local i
   if mCboVal = 0 .or. mCboVal > len(aCode)
      return 0
   endif
   return (aCode[mCboVal])
You can use it like:

Code: Select all

...
...
	aCust := SQL(mDb, "select Custid, Custnm from Cust order by Custnm")
	aeval(aCust, {|x| aadd(aCustId, x[1]), aadd(aCustNm, x[2])})
// aCustnm will be used with combobox, cboCustid
...
...
   mCustId := Cbo2Code(frmSale.cboCustid.value, aCustId)
This function can be used with DBF tables also :)

With best regards.

Sudip
With best regards,
Sudip

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

Post by mol »

I'm searching good working function for archiving data (rg. whole folder with application and data files).

Maybe sb. has such a function created with hmg and want to share it?
If not, I'll try to write it.

Marek

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

Post by sudip »

Hello Marek,

I wrote a small app. But it used low level functions and also some extra library. I am sure original HMG functions also do the same thing.

Please check at viewtopic.php?f=15&t=440

With best regards.

Sudip
With best regards,
Sudip

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

Post by sudip »

Hi All,

I used one function called Dbf_menu(), for lookup data in my Clipper days, originally written by ex-boss Anando Banerjee. I changed it many times and later when I started using gtwvw, I completely re-wrote the function with tBrowse class, but the name of the function remained same. Today, I created the same function with MUCH LESS CODE using HMG. I tested it by using Array RDD. Result is very good. Many thanks to Master Roberto Lopez for the latest improvement of Grid control (I used some of your codes also from Grid.26 sample) :)

Code: Select all

Function dbf_menu(mAlias, aHeader, aWidth, aFieldnm, abDynamicDisplay)
   local mOldRecno, lRecChanged := .f.
   
   mOldRecno := if((mAlias)->(eof()), 0, (mAlias)->(recno()))
   

	DEFINE WINDOW frmDbf_menu ;
		AT 0,0 ;
		WIDTH 640 ;
		HEIGHT 460 ;
		TITLE 'Find' ;
		MODAL 

		@ 10,10 GRID Grid_1 ;
			WIDTH 610 ;
			HEIGHT 380 ;
			HEADERS aHeader ;
			WIDTHS aWidth;
			ROWSOURCE mAlias ;
			COLUMNFIELDS aFieldNm ;
			DYNAMICDISPLAY	 abDynamicDisplay ;
			value {(mAlias)->(recno()), 1}
			
      @ 400, 150 button cmdOk caption "&Ok" action {|| lRecChanged := .t., frmDbf_menu.release()}
      
      @ 400, 390 button cmdCancel caption "&Cancel" action frmDbf_menu.release()			
			

	END WINDOW

   on key ESCAPE of frmDbf_menu action frmDbf_menu.release()	

	CENTER WINDOW frmDbf_menu

	ACTIVATE WINDOW frmDbf_menu
	
	if !lRecChanged
	  if mOldRecno > 0
	     (mAlias)->(dbgoto(mOldRecno))
	  endif
	endif

Return nil
Using this function is very easy.

Code: Select all

Static Function FindSale()
   dbf_menu("tempsale", {"Inv Dt", "Inv No", "Amount"}, {100, 100, 100}, {"invdt", "invno", "netamt"})
   thiswindow.setfocus()
   RefreshData()	  
	return nil   
There are lots of TO DO-s for this function.

Please send your comments regarding this :)

With best regards.

Sudip
With best regards,
Sudip

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

Post by Rathinagiri »

Great Sudip. So nice. Thanks for sharing.
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

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

Post by mol »

I want to post here function, which can be an alternative for InputWindow.
I don't know, if this function will work in future version of HMG, but works OK in 3.0.20 ;)

Code: Select all

function OknoWprowadzaniaDanych
	param cWindowTitle, aLabels, aInitialValues, aLengths, aInputMasks, aConvertToUpper, aJust, aResults
	local nWysokosc, nSzerokosc, i
	local xType , cNazwa , nMaxLength := NIL, lUpper,	lLower
	local lNumeric, lPassword := .f., uLostFocus := NIL, uGotFocus := NIL
	local uChange := NIL, uEnter := NIL, lRight, HelpId := NIL
	local lReadOnly := .f., lBold := .f., lItalic := .f., lUnderline := .f., lStrikeout := .f.
	local field := NIL
	local aBackColor := {255,255,255}
	local aFontColor := {0,0,0}
	local lInvisible := .f.
	local lNotabstop := .f.
	private nLiczbaPol
	Private lOK := .f.
	
	// aJust - contains values: 0 - for left align, 1 for right align 
	// function returns .T. when OK button is pressed, .F. when CANCEL
	// return values are copied to aResults
	
	nLiczbaPol := len(aLabels)
	nSzerokosc := 300
	for i:= 1 to nLiczbaPol
		nSzerokosc := max(nSzerokosc, aLengths[i])
	next i
	nSzerokosc := min(800,nSzerokosc)
	nWysokosc := 130 + 50*nLiczbaPol
	nWysokosc := min(500,nWysokosc)

	DEFINE WINDOW MOL_OknoWprowadzaniaDanych ;
		ROW 0 ;
		COL 0 ;
		WIDTH min(800,nSzerokosc) ;
		HEIGHT min(500,nWysokosc) ;
		TITLE cWindowTitle ;
		MODAL 
		
	for i:=1 to nLiczbaPol
		 cLbl := "Lbl_"+strzero(i,2);

	@ 20+(i-1)*50 , 10 LABEL &cLbl ;
			VALUE aLabels[i] ;
			WIDTH 200			     ;
			HEIGHT 18			     ;
			FONT "Arial" SIZE 10 BOLD;
			TRANSPARENT 

		xType := valtype(aInitialValues[i])
		cNazwa :="T_"+strzero(i,2)
		do case
			case xType == "N"
				nMaxLength := len(str(aInitialValues[i]))
			case xType == "D"
				nMaxLength := 8
			otherwise
				
				nMaxLength := len(hb_valtoExp(aInitialValues[i]))
		endcase
		lUpper := aConvertToUpper[i]
		lLower := !lUpper
		lNumeric := (xType = "N")
		lPassword := .f.
		uLostFocus := NIL
		uGotFocus := NIL
		uChange := NIL
		uEnter := NIL
		lright := aJust[i] == 1 // domyślnie numeryczne pola do prawej
		HelpId := NIL
		lReadOnly := .f.
		lBold := .f.
		lItalic := .f.
		lUnderline := .f.
		lStrikeout := .f.
		field := NIL
		aBackColor := {255,255,255}
		aFontColor := {0,0,0}
		lInvisible := .f.
		lNotabstop := .f.
		
		if len(aInputMasks[i]) > 0
			if xType == "N"
				_DefineMaskedTextBox ( cNazwa, "MOL_OknoWprowadzaniaDanych", 30, 38+(i-1)*50,aInputMasks[i],;
					aLengths[i] , aInitialValues[i], "ARIAL CE", 12, ""  ,;
					uLostFocus, uGotFocus, uChange ,;
					24 , uEnter , lRight ,;
					helpid , "" ,lBold, lItalic, lUnderline, ;
					lStrikeout , field , aBackColor , aFontColor ,;
					lReadOnly, lInvisible , lNotabstop )
			elseif xType == "C"
				_DefineCharMaskTextBox ( cNazwa, "MOL_OknoWprowadzaniaDanych", 30, 38+(i-1)*50,aInputMasks[i],;
					aLengths[i] , aInitialValues[i], "ARIAL CE", 12, ""  ,;
					uLostFocus, uGotFocus, uChange ,;
					24 , uEnter , lRight ,;
					helpid , lBold, lItalic, lUnderline, ;
					lStrikeout , field , aBackColor , aFontColor ,;
					.f., lReadOnly, lInvisible , lNotabstop )
			endif
		else
			if xType == "D"
				_DefineCharMaskTextBox ( cNazwa, "MOL_OknoWprowadzaniaDanych", 30, 38+(i-1)*50,"",;
					aLengths[i] , aInitialValues[i], "ARIAL CE", 12, ""  ,;
					uLostFocus, uGotFocus, uChange ,;
					24 , uEnter , lRight ,;
					helpid , lBold, lItalic, lUnderline, ;
					lStrikeout , field , aBackColor , aFontColor ,;
					.t., lReadOnly, lInvisible , lNotabstop )
			else
				_DefineTextBox( cNazwa, "MOL_OknoWprowadzaniaDanych", 30, 38+(i-1)*50, aLengths[i], 24, ;
								aInitialValues[i], "ARIAL CE", 12, "", nMaxLength, ;
					lUpper, lLower, lNumeric, lPassword, ;
								uLostFocus, uGotFocus, uChange , uEnter , lRight  , ;
					HelpId , lReadonly , lBold, lItalic, lUnderline, ;
					lStrikeout , field , aBackColor , aFontColor , ;
					lInvisible , lNotabstop )
			endif
		endif			
	next i
	// PRZYCISKI 
	@ nWysokosc - 80, nSzerokosc/2 - 120 BUTTON P_OK ;
		CAPTION "OK" ;
		ACTION (AEval(aResults, { | cValue, nIndex|  aResults[nIndex] := GetProperty("Mol_OknoWprowadzaniaDanych","T_"+strzero(nIndex,2),"value") } ,1, nLiczbaPol),;
				lOK := .t. , MOL_OknoWprowadzaniaDanych.Release );
		WIDTH 100 HEIGHT 28
		
	@ nWysokosc - 80, nSzerokosc/2 + 20 BUTTON P_CANCEL ;
		CAPTION "Anuluj" ;
		ACTION {|| lOK := .f., Mol_OknoWprowadzaniaDanych.Release} ;
		WIDTH 100 HEIGHT 28
	
	END WINDOW
	aResults := array(nLiczbaPol)
	ON KEY ESCAPE OF MOL_OknoWprowadzaniaDanych ACTION (MOL_OknoWprowadzaniaDanych.Release , lOK := .f.)
	center window MOL_OknoWprowadzaniaDanych
	activate window MOL_OknoWprowadzaniaDanych
		
return lOK
and a little sample, how to call it:

Code: Select all

	aRes := {}
	lRet := OknoWprowadzaniaDanych("A little sample of new InputWindow",{"Customer Name ","Customer Address","Customer ID","any other numeric ID","Date of test"} , ;
		{"name of customer for editing",space(40),space(10), 123, date()  },;
		{200,200,80,100,100},;
                { "","","P-999","9999",""},;
		{.t.,.f.,.t.,.f.,.f.},;
                {0,0,0,1,1},;
               @aRes)

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

Post by Rathinagiri »

Great Mol.

It will be useful for me since you have used date text box instead of standard date picker.

Standard date picker increases two key strokes extra. ;)
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

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

Post by sudip »

Hello All,

Some days ago our friend Rathi created a sample to show how to add items in a list of a combo box of a grid. Today I changed a few codes so that it can be used for refreshing combobox list of a grid. Here "acList" is an array of character strings.

Code: Select all

function RefreshGridEditComboItem ( cGridName, cWindowName, nColIndex, acList )
   local i := GetControlIndex ( cGridName, cWindowName )
   local aEditcontrols := _HMG_SYSDATA [ 40 ] [ i ] [ 2 ]
   
   aEditControls [nColIndex] [2] := {}
   aeval(aclist, {|x| aadd(aEditControls [nColIndex] [2], x)})
   _HMG_SYSDATA [ 40 ] [ i ] [ 2 ] := aEditControls

return nil
Thank you Rathi :)

With best regards.

Sudip
With best regards,
Sudip

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

Post by Rathinagiri »

Great Sudip. :)
East or West HMG is the Best.
South or North HMG is worth.
...the possibilities are endless.

Post Reply