Re: Project Free HRD & Payroll Application
Posted: Mon Oct 20, 2014 11:19 am
Gracias Agil por compartir estos buenos ejemplos...
Agil Thanks for sharing these good examples ...
Agil Thanks for sharing these good examples ...
Exclusive forum for HMG, a Free / Open Source xBase WIN32/64 Bits / GUI Development System
http://hmgforum.com/
Code: Select all
***mancomped.fmg*** (sample pieces) Window Template generated with IDE
*
* HMG-IDE UNICODE Form Designer Generated Code
* (c) Roberto Lopez - http://sites.google.com/site/hmgweb
DEFINE WINDOW TEMPLATE AT 143 , 386 WIDTH 438 HEIGHT 453 VIRTUAL WIDTH Nil VIRTUAL HEIGHT Nil TITLE "Company Record" ICON NIL CHILD
NOMAXIMIZE NOMINIMIZE NOSYSMENU CURSOR NIL ON INIT Nil ON RELEASE Nil ON INTERACTIVECLOSE Nil ON MOUSECLICK Nil ON MOUSEDRAG Nil ON
MOUSEMOVE Nil ON SIZE Nil ON MAXIMIZE Nil ON MINIMIZE Nil ON PAINT Nil BACKCOLOR {142,238,150} NOTIFYICON NIL NOTIFYTOOLTIP NIL ON
NOTIFYCLICK Nil ON GOTFOCUS Nil ON LOSTFOCUS Nil ON SCROLLUP Nil ON SCROLLDOWN Nil ON SCROLLLEFT Nil ON SCROLLRIGHT Nil ON HSCROLLBOX
Nil ON VSCROLLBOX Nil
DEFINE LABEL Lab_Compcode
ROW 20
COL 20
WIDTH 120
HEIGHT 24
VALUE "Company#"
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP ""
FONTBOLD .T.
FONTITALIC .T.
FONTUNDERLINE .F.
FONTSTRIKEOUT .F.
HELPID Nil
VISIBLE .T.
TRANSPARENT .F.
ACTION Nil
AUTOSIZE .F.
BACKCOLOR {142,238,150}
FONTCOLOR NIL
RIGHTALIGN .T.
END LABEL
DEFINE TEXTBOX Text_Compcode
ROW 20
COL 160
WIDTH 30
HEIGHT 24
FONTNAME "Arial"
FONTSIZE 9
TOOLTIP ""
ONCHANGE Nil
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
FONTBOLD .F.
FONTITALIC .F.
FONTUNDERLINE .F.
FONTSTRIKEOUT .F.
ONENTER Nil
HELPID Nil
TABSTOP .T.
VISIBLE .T.
READONLY .F.
RIGHTALIGN .F.
DISABLEDBACKCOLOR Nil
DISABLEDFONTCOLOR Nil
CASECONVERT UPPER
MAXLENGTH 2
BACKCOLOR NIL
FONTCOLOR NIL
INPUTMASK Nil
FORMAT "'!!'"
VALUE ""
END TEXTBOX
//--- the rest (in the middle) are repetations of above definition with different control-name,
//--- with ROW pos different at 30 line each
DEFINE RADIOGROUP Radio_Company
ROW 370
COL 60
WIDTH 250
HEIGHT 28
OPTIONS { 'Accept','Cancel'}
VALUE 1
FONTNAME "Arial"
FONTSIZE 18
TOOLTIP ""
ONCHANGE Nil
FONTBOLD .T.
FONTITALIC .F.
FONTUNDERLINE .F.
FONTSTRIKEOUT .F.
HELPID Nil
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .F.
SPACING 125
BACKCOLOR {0,128,64}
FONTCOLOR {0,0,255}
READONLY Nil
HORIZONTAL .T.
END RADIOGROUP
DEFINE BUTTON Button_Go
ROW 365
COL 320
WIDTH 70
HEIGHT 40
ACTION ( MancompGetentry(.T.), MancompGetoption(.T.), MancompValidateentry() )
CAPTION "GO"
FONTNAME "Arial"
FONTSIZE 18
TOOLTIP "Go To Process"
FONTBOLD .T.
FONTITALIC .F.
FONTUNDERLINE .F.
FONTSTRIKEOUT .F.
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
HELPID Nil
FLAT .F.
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .T.
MULTILINE .F.
PICTURE Nil
PICTALIGNMENT TOP
END BUTTON
END WINDOW
//----------------------------------------------------------------------------
**manmastbl.prg (sample pieces)
***************************
* Activate/Deactivate Form Company Data entry
* Flag .T. activate/show, .F. to Hide
***************************
Function ManActivateCompEntry(Flag)
IF Flag==.T.
if .not. isWindowdefined(Form_MancompEntry)
LOAD WINDOW Mancomped AS Form_MancompEntry
endif
else
if isWindowdefined(Form_MancompEntry)
//-optional method: release, hide, disabled=.T.
Form_MancompEntry.hide
endif
endif
Return
*
*
********************************
* COMP: Edit company's existing record
* Grid value (row post) return in array (row, col) because option CELLNAVIGATION is used
********************************
Procedure ManEditCompany()
LOCAL cKey, aInitvalues, aResults, nRecord
//---Send&Set mode of operation to Update=2
MancompEntrymode( .T. , 2)
//---get record from grid
nRecord := Form_Master.Grid_Company.value[1]
aResults := aInitValues:= Form_Master.Grid_Company.item(nRecord)
//---Activate template, Send record to template, get user entry, do validation from template
//---Protect key-field Compcode from editing
ManActivateCompEntry(.T.)
MancompSetentry (aResults)
Form_MancompEntry.Text_compcode.Readonly:=.T.
Form_MancompEntry.Text_compname.Setfocus
Form_MancompEntry.Activate
//--if ACCEPT then check entry option & Validation of entry
IF MancompGetoption() == 1 .and. MancompValidateentry(.T.)==.T. //Option ACCEPT & Valid entry
aResults := MancompGetentry(.F.)
ELSE
RETURN .F.
ENDIF
If .not.Msgyesno("Update record?") //to test only
return .F.
endif
//--Edit records to Database, Sent modified records to Database
//--Make sure field length of key-field is exactly equal to field length in Database
cKey:= padr( aResults[COMP_KEY_COL]), COMP_KEY_COL )
IF ManCompUpdate(aResults, cKey)
//--go ahead
else
Msgstop('Error: Upadate record to Company Database')
Return .F.
endif
//--Edit modify Array of records in grid
Form_Master.Grid_Company.Item(nRecord) := aResults
Form_Master.Grid_Company.Setfocus
Return
*
********************************
* COMP: Validate data entry
* lGetValid : .T. to get value of lValid, else to do validation
* lValid : .T. oke, .F. wrong
* nEntryMode: 1=Add/Update, 2=Update
********************************
Function MancompValidateentry(lGetValid)
STATIC lValid := .F.
Local aResults := MancompGetentry(.F.)
Local nEntryMode:= MancompEntrymode(.F.)
IF .not.lGetValid == NIL .and. lGetValid==.T. //Get last validation value
Return lValid
ENDIF
lValid := .F.
IF MancompGetoption() == 2 //CANCEL
Form_MancompEntry.release
Form_Master.Grid_Company.Setfocus
Return ( lValid := .F. )
ElseIF MancompGetoption() == 1 //ACCEPT entry
//--NOT Valid for Append & Update
if empty( aResults[COMP_KEY_COL]) .or. empty( aResults[2])
MsgExclamation('Invalid empty entry on Code or Name')
Form_MancompEntry.Text_compcode.Setfocus
elseif aResults[COMP_KEY_COL] = "**" .or. left(aResults[2], 1) = "*"
MsgExclamation('Invalid entry ** on Code or Name')
Form_MancompEntry.Text_compcode.Setfocus
//--NOT Valid for Append only
elseIF nEntryMode==1 .and. ManFindCompGrid( aResults[COMP_KEY_COL] ) >= 1
MsgExclamation(aResults[UNIT_KEY_COL] + ' already exists in grid.')
Form_MancompEntry.Text_compcode.Setfocus
else
lValid := .T.
Form_MancompEntry.release
Form_Master.Grid_Company.Setfocus
Endif
endif
Return lValid
*
*
************************
* Find existing record of Company in Grid
************************
Function ManFindCompGrid( cKey )
Static nRow := 0
Local nRecNo := 1, i:=0
FOR i=1 TO Form_Master.Grid_Company.ItemCount
if HMG_UPPER( Form_Master.Grid_Company.CellEx(i, COMP_KEY_COL) ) == cKey
nRecno := nRow := i
//--test Msginfo("found at grid rec#" +str(i))
EXIT
endif
NEXT
IF nRecNo>0
Form_Master.Grid_Company.value :=nRecNo //found, move pointer of grid
else
Form_Master.Grid_Company.value :=nRow //pointer to last record-search found
endif
Return nRecNo
*
***********************************
* COMP: Set/Fill in form for data entry
***********************************
Function MancompSetentry(aValues)
Form_MancompEntry.Text_compcode.value := aValues[1]
Form_MancompEntry.Text_compname.value := aValues[2]
Form_MancompEntry.Text_compctx.value := aValues[3]
Form_MancompEntry.Text_compaddr.value := aValues[4]
Form_MancompEntry.Text_compaddr2.value := aValues[5]
Form_MancompEntry.Text_compcity.value := aValues[6]
Form_MancompEntry.Text_compzip.value := aValues[7]
Form_MancompEntry.Text_comptelp.value := aValues[8]
Form_MancompEntry.Text_compfax.value := aValues[9]
Form_MancompEntry.Text_compemail.value := aValues[10]
Form_MancompEntry.Text_compweb.value := aValues[11]
Return
*
***********************************
* COMP: Get/Fill in form for data entry
***********************************
Function MancompGetentry(lNew)
STATIC aValues[11]
if lNew
aValues[1]:= Form_MancompEntry.Text_compcode.value
aValues[2]:= Form_MancompEntry.Text_compname.value
aValues[3]:= Form_MancompEntry.Text_compctx.value
aValues[4]:= Form_MancompEntry.Text_compaddr.value
aValues[5]:= Form_MancompEntry.Text_compaddr2.value
aValues[6]:= Form_MancompEntry.Text_compcity.value
aValues[7]:= Form_MancompEntry.Text_compzip.value
aValues[8]:= Form_MancompEntry.Text_comptelp.value
aValues[9]:= Form_MancompEntry.Text_compfax.value
aValues[10]:= Form_MancompEntry.Text_compemail.value
aValues[11]:= Form_MancompEntry.Text_compweb.value
endif
Return aValues
*
***********************************
* COMP: Get/Set Option dataentry: Accept=1, Cancel=2
***********************************
Function MancompGetoption(lSetNew)
STATIC nOption:=0
lSetnew := if(lSetnew==NIL, .F., lSetNew)
if lSetNew
nOption:=Form_MancompEntry.Radio_Company.value
else
nOption := if( .not.Valtype(nOption)="N", 0, nOption)
endif
Return nOption
*
***********************************
* COMP: Get/Set Mode of dataentry: 0=No action, 1=Add/append, 2=Update, 3=Delete, 4=Copy-to-append
***********************************
Function MancompEntrymode(lSetNew, nModeValue)
STATIC nMode:=0
lSetnew := if(lSetnew==NIL, .F., lSetNew)
if lSetNew
nMode:= nModeValue
endif
Return nMode
*
Man thanks for kind suggestion. But, I failed to download your link. I stoped downloading before it finished.Bpd2000 wrote;
Suggestion: keep 10 field as user defined so user can define, store data and use same filed for reporting
Download payroll program that will give you more idea
http://www.busywin.com/busydata/PAY%201.0%20(k-4" onclick="window.open(this.href);return false;)/SETUP.EXE
Code: Select all
#include "hmg.ch" //added by Agil
REQUEST HB_GT_WIN_DEFAULT //added by Agil
**************
Procedure Main //added by Agil
ServerMain() //added by Agil
Return //added by Agil
*
******************
* On side of Server Application (console, multi-threaded in this sample):
******************
Procedure Servermain() // changedd by Agil..... Procedure main()
local pSockSrv , nPort , cIfAddr, cRootDir, lRPC, cPasswd, nCompressionLevel, nStrategy
SetMode(25,80) // added by Agil
cls
nPort := 65000 // or anyone you like
cIfAddr := '0.0.0.0'
cRootDir := '.'
lRPC := .T.
cPasswd := 'secret'
nCompressionLevel := 9
nStrategy := NIL
pSockSrv := NETIO_MTSERVER( nPort , cIfAddr , cRootDir , lRPC , cPasswd , nCompressionLevel , nStrategy )
if empty( pSockSrv )
? "Can't startl server !!!"
wait "Press any key to exit..."
quit
endif
? 'NETIO Server Started!'
hb_idleSleep( 0.1 )
DO WHILE .T.
INKEY(0)
IF LASTKEY() == 27 // Esc
? 'Stopping... ESC to stop'
netio_serverstop( pSockSrv, .t. )
EXIT
ELSE
LOOP
ENDIF
ENDDO
CLS
ALERT('SERVER STOPPED!')
return
**