#include "FiveWin.ch"
#include "TSButton.ch"
#include "XBrowse.Ch"
#include "apollo.ch"
#define COLOR_LIGHT rgb(255,255,235)
#define COLOR_DARK rgb(192,208,179)
#define CR Chr( 13 )
static oBrwHeader,oBrwDetail
function GlCode()
local oDlg,oBtn[8],oCursorHand,lClrFlag := .f.,lExitProgram := .f.
field gl_accode,gl_descrpt
*************** use file glaccode.dbf **********************
cFile := cFileDirGL+"GLACCODE.DBF"
cIndex := cFileDirGL+"GLACCODE.CDX"
if !file(cFile)
MsgAlert("Missing "+cFile+" file, please contact your Administrator")
dbCloseAll()
return nil
endif
if !file(cIndex)
if !MsgYesNo("Missing "+cIndex+CRLF+"Do you want to create it ?")
dbCloseAll()
return nil
endif
use (cFile) new exclusive alias GLACCODE
index on gl_accode tag gl_accode to (cIndex)
index on gl_descrpt tag gl_descrpt to (cIndex)
index on left(gl_accode,3) tag gl_prefix3 to (cIndex)
index on left(gl_accode,1) tag gl_prefix1 to (cIndex)
dbCloseAll()
endif
******************* end of use file glaccode ******************
***************** use file glacsubg ********************
cFile := cFileDirGL+"GLACSUBG.DBF"
cIndex := cFileDirGL+"GLACSUBG.CDX"
if !file(cFile)
MsgAlert("Missing "+cFile+" file, please contact your Administrator")
dbCloseAll()
return nil
endif
if !file(cIndex)
if !MsgYesNo("Missing "+cIndex+CRLF+"Do you want to create it ?")
dbCloseAll()
return nil
endif
use (cFile) new exclusive alias GLACSUBG
index on ac_prefix tag ac_prefix to (cIndex)
index on ac_subgrp tag ac_subgrp to (cIndex)
dbCloseAll()
endif
dbCloseAll()
********************* end of use file glacsubg ***************
cFile := cFileDirGL+"GLACSUBG.DBF"
cIndex := cFileDirGL+"GLACSUBG.CDX"
use (cFile) new shared alias GLACSUBG
set index to (cIndex)
GLACSUBG->(ordSetFocus("ac_prefix"))
cFile := cFileDirGL+"GLACCODE.DBF"
cIndex := cFileDirGL+"GLACCODE.CDX"
use (cFile) new shared alias GLACCODE
set index to (cIndex)
glaccode->(dbSetOrder("gl_accode"))
DEFINE FONT oFontX NAME "Tahoma" size 0,-20
DEFINE FONT oFont NAME "Tahoma" size 0,-12
DEFINE FONT oFontBold NAME "Tahoma" size 0,-12 bold
DEFINE CURSOR oCursorHand NAME "hand"
define dialog oDlg from 1,1 to 500,800 pixel transparent style nOR(WS_CAPTION) ;
title "General Ledger Module"
@60,5 XBROWSE oBrwHeader ;
COLUMNS "ac_prefix", "ac_subgrp" ;
OF oDlg ;
SIZE 200,150 PIXEL ;
COLSIZES 90,260 ;
HEADERS "Prefix Ac.Code","Description" ;
ALIAS "glacsubg" AUTOSORT ;
ON CHANGE ( FilterAccCode() )
if !empty( oCol := oBrwHeader:aCols[2] )
oCol:nEditType := EDIT_GET
oCol:bOnPostEdit := { |o,u,n | PostEditHeader(o,u,n) }
endif
oBrwHeader:bKeyDown := { |nKey,nFlag| HeaderAction(nKey) }
XbrStyles( oBrwHeader )
oBrwHeader:CreateFromCode()
@60,215 XBROWSE oBrwDetail ;
COLUMNS "gl_accode", "gl_descrpt" ;
OF oDlg ;
SIZE 180,150 PIXEL ;
COLSIZES 80,250 ;
HEADERS "Acct.Code","Description" ;
ALIAS "glaccode" AUTOSORT
if !empty( oCol := oBrwDetail:aCols[2] )
oCol:nEditType := EDIT_GET
oCol:bOnPostEdit := { |o,u,n | PostEditDetail(o,u,n) }
endif
oBrwDetail:bKeyDown := { |nKey,nFlag| DetailAction(nKey) }
XbrStyles( oBrwDetail )
oBrwDetail:CreateFromCode()
/*
oBrw:oDragCursor := oCur
oBrw:bDragBegin := { |nRow,nCol,nFlags| DragBegin( nRow, nCol, nFlags, oBrw ) }
oBrw:bDropOver := { |uDropInfo, nRow, nCol, nFlags| DropOver( uDropInfo, nRow, nCol, nFlags, oBrw ) }
*/
/*
nRow := 3
nCol := 5
@nRow,nCol BTNBMP oBtn[1] size 32,32 of oDlg FILENAME "tambah1.ico","tambah.ico" NOBORDER pixel
oBtn[1]:cTooltip := "add New Record"
oBtn[1]:oCursor := oCursorHand
*/
nRow := 3
nCol := 5
@3,nCol BTNBMP oBtn[1] prompt "Add" +CRLF+"Group" size 28,42 of oDlg FILENAME ".\icons\group.ico",".\icons\group.ico" NOBORDER ACTION CreateHeader(.t.) pixel
oBtn[1]:cTooltip := "Add New Group Code"
oBtn[1]:oCursor := oCursorHand
nCol += 29
@3,nCol BTNBMP oBtn[2] prompt "Edit" +CRLF+"Group" size 28,42 of oDlg FILENAME ".\icons\group1.ico",".\icons\group1.ico" NOBORDER ACTION CreateHeader(.f.) pixel
oBtn[2]:cTooltip := "Edit Group"
oBtn[2]:oCursor := oCursorHand
nCol += 29
@3,nCol BTNBMP oBtn[3] prompt "Delete" +CRLF+"Group" size 28,42 of oDlg FILENAME ".\icons\group2.ico",".\icons\group2.ico" NOBORDER ACTION DeleteHeader() pixel
oBtn[3]:cTooltip := "Delete Group"
oBtn[3]:oCursor := oCursorHand
nCol += 29
@3,nCol BTNBMP oBtn[7] prompt "Refresh" +CRLF+"Group" size 28,42 of oDlg FILENAME ".\icons\top.ico",".\icons\top.ico" NOBORDER ;
action ( oBrwHeader:goTop(), oBrwHeader:Refresh(),FilterAccCode() ) pixel
oBtn[7]:cTooltip := "Refresh Browsing Group"
oBtn[7]:oCursor := oCursorHand
nCol += 42
@3,nCol BTNBMP oBtn[4] prompt "Add Account" +CRLF+"Detail" size 28,42 of oDlg FILENAME ".\icons\detail.ico",".\icons\detail.ico" NOBORDER ACTION CreateDetail(.t.) pixel
oBtn[4]:cTooltip := "Add Account Code Detail"
oBtn[4]:oCursor := oCursorHand
nCol += 29
@3,nCol BTNBMP oBtn[5] prompt "Edit Account" +CRLF+"Detail" size 28,42 of oDlg FILENAME ".\icons\detail1.ico",".\icons\detail1.ico" NOBORDER ACTION CreateDetail(.f.) pixel
oBtn[5]:cTooltip := "Edit Account Code Detail"
oBtn[5]:oCursor := oCursorHand
nCol += 29
@3,nCol BTNBMP oBtn[6] prompt "Delete Account" +CRLF+"Detail" size 28,42 of oDlg FILENAME ".\icons\detail2.ico",".\icons\detail2.ico" NOBORDER ACTION DeleteDetail() pixel
oBtn[6]:cTooltip := "Delete Account Code Detail"
oBtn[6]:oCursor := oCursorHand
nCol += 29
@3,nCol BTNBMP oBtn[8] prompt "Refresh" +CRLF+"Detail" size 28,42 of oDlg FILENAME ".\icons\top.ico",".\icons\top.ico" NOBORDER ;
action ( oBrwDetail:goTop(), oBrwDetail:Refresh(),FilterAccCode() ) pixel
oBtn[8]:cTooltip := "Refresh Browsing Detail"
oBtn[8]:oCursor := oCursorHand
@3,365 BTNBMP oKeluar prompt "Exit" size 32,42 of oDlg FILENAME ".\icons\keluar1.ico",".\icons\keluar.ico" NOBORDER ACTION ( lExitProgram := .t. , oDlg:End() ) pixel
oKeluar:cTooltip := "go to main menu"
oKeluar:oCursor := oCursorHand
activate dialog oDlg centered ;
on paint ( aRct := GetClientRect( oDlg:hWnd ), ;
GradColor( oDlg:hDC, aRct, nRGB(133,166,221), LightColor( 100, nRGB( 194,210,237 ) ) ), ;
GradColor( oDlg:hDC, {2,2,90,800}, cClrDegrFIn, cClrDegrIni ), ;
GradColor( oDlg:hDC, {92,2,120,800}, cClrDegrIni, cClrDegrFin ), ;
oDlg:Say(95,10,"Account Group",CLR_BLUE, ,oFontX,.t.,.t.), ;
oDlg:Say(95,430,"Account Detail",CLR_BLUE, ,oFontX,.t.,.t.) ;
) valid lExitProgram
oFontX:End()
oCursorHand:End()
dbCloseAll()
return nil
static function HeaderAction(nKey)
do case
case nKey == 45 // insert
CreateHeader(.t.)
case nKey == 46 // delete
DeleteHeader()
endcase
return nil
static function CreateHeader(lNew)
if lNew
if glacsubg->ac_limit # 0
MsgAlert("Please select Header Sub-Account code","Wrong select...!" )
return nil
endif
endif
AddHeader(lNew)
FilterAccCode()
return nil
static function AddHeader(lNew)
local oDlg,lMore := .f.
local cNewCode := spac(len(glacsubg->ac_prefix))
local cNewDesc := spac(len(glacsubg->ac_subgrp))
if !lNew
cNewCode := glacsubg->ac_prefix
cNewDesc := glacsubg->ac_subgrp
endif
if lNew
define dialog oDlg from 1,1 to 100,350 pixel style nOR(WS_CAPTION) title "Add new Sub-Account for "+glacsubg->ac_subgrp
else
define dialog oDlg from 1,1 to 100,350 pixel style nOR(WS_CAPTION) title "Edit Group Account"
endif
@3,2 say "Sub-Acc.Code :" size 60,12 of oDlg pixel right
@15,2 say "Sub-Acc.Description :" size 60,12 of oDlg pixel right
@2,65 get cNewCode size 20,11 of oDlg pixel when lNew
@14,65 get cNewDesc size 100,11 of oDlg pixel
@30,40 button "Save" size 30,12 of oDlg pixel action ( lMore := .t., SaveHeader(cNewCode,cNewDesc,lNew), oDlg:End() )
@30,80 button "Cancel" size 30,12 of oDlg pixel action oDlg:End()
activate dialog oDlg centered
if lMore .and. lNew
If MsgYesNo("Create another code")
AddHeader(lNew)
endif
endif
return nil
static function saveHeader(cNewCode,cNewDesc,lNew)
local nRec := glacsubg->(recno())
if lNew
if left(glacsubg->ac_prefix,1) # left(cNewCode,1)
MsgAlert("Wrong prefix code","Warning...!")
return nil
endif
glacsubg->(ordSetFocus("ac_prefix"))
glacsubg->(dbGotop())
if glacsubg->(dbSeek(cNewCode))
glacsubg->(dbGoto(nRec))
MsgAlert("Duplicate Sub-Account code "+cNewCode,"Warning..!!")
return nil
endif
glacsubg->(dbGoto(nRec))
if MsgYesNo("Add New Sub-Account Name ? "+alltrim(cNewDesc),"Confirmation...!")
glacsubg->(dbAppend())
if glacsubg->(dbRlock())
glacsubg->ac_prefix := cNewCode
glacsubg->ac_subgrp := cNewDesc
glacsubg->ac_limit := 99
endif
glacsubg->(dbUnlock())
oBrwHeader:Refresh()
oBrwDetail:Refresh()
endif
else
if glacsubg->(dbRlock())
glacsubg->ac_subgrp := cNewDesc
endif
glacsubg->(dbUnlock())
oBrwHeader:Refresh()
oBrwDetail:Refresh()
endif
return nil
***************** ********************
static function DeleteHeader()
if glacsubg->ac_limit == 0
MsgAlert("Can't delete Account header","Warning..!" )
return nil
endif
if MsgYesNo("All detail Account will be deleted ?","Confirmation.. !")
if MsgYesNo("Are you sure want to delete "+alltrim(glacsubg->ac_subgrp),"Confirmation.. !")
glaccode->(ordSetFocus("gl_prefix3")) // sort by 3 digit
glaccode->(dbGotop())
glaccode->(dbSeek(glacsubg->ac_prefix,.t.))
do while !glaccode->(eof()) .and. left(glaccode->gl_accode,3) == glacsubg->ac_prefix
if glaccode->(dbRlock())
glaccode->(dbDelete())
endif
glaccode->(dbUnlock())
glaccode->(dbSkip())
enddo
if glacsubg->(dbRlock())
glacsubg->(dbDelete())
endif
glacsubg->(dbUnlock())
glacsubg->(DBSKIP(1))
oBrwHeader:SetFocus()
IF glaccode->(EOF())
oBrwHeader:GoUp()
ENDIF
oBrwHeader:Refresh()
FilterAccCode()
endif
endif
return nil
static function PostEditHeader( oCol, xValue, nLastKey )
local nCol := oCol:nPos
local nOldVal
if nLastKey == 13 // press enter
nOldVal := eval( oCol:bEditValue )
if !( nOldVal == xValue )
do case
case nCol == 2
if glacsubg->(dbRlock())
glacsubg->ac_subgrp := xValue
endif
glacsubg->(dbUnlock())
endcase
endif
oCol:oBrwHeader:goRight()
endif
return nil
static function DetailAction(nKey)
do case
case nKey == 45 // insert
CreateDetail()
case nKey == 46 // delete
DeleteDetail()
endcase
return nil
static function CreateDetail(lNew)
if lNew
if glacsubg->ac_limit == 0
MsgAlert("Please select Sub-Account code","Wrong select...!" )
return nil
endif
endif
AddDetail(lNew)
return nil
static function AddDetail(lNew)
local lMore := .f.
local oDlg,cNewCode := glacsubg->ac_prefix+"-"+spac(len(glaccode->gl_accode)-4)
local cNewDesc := spac(len(glaccode->gl_descrpt))
if !lNew
cNewCode := glaccode->gl_accode
cNewDesc := glaccode->gl_descrpt
endif
if lNew
define dialog oDlg from 1,1 to 100,350 pixel style nOR(WS_CAPTION) title "Add new Account - "+glacsubg->ac_subgrp
else
define dialog oDlg from 1,1 to 100,350 pixel style nOR(WS_CAPTION) title "Edit Account Detail"
endif
@3,2 say "Account Code :" size 60,12 of oDlg pixel right
@15,2 say "Account Description :" size 60,12 of oDlg pixel right
@2,65 get cNewCode size 38,11 of oDlg pixel when lNew
@14,65 get cNewDesc size 100,11 of oDlg pixel
@30,40 button "Save" size 30,12 of oDlg pixel action ( lMore := .t., SaveDetail(cNewCode,cNewDesc,lNew), oDlg:End() )
@30,80 button "Cancel" size 30,12 of oDlg pixel action oDlg:End()
activate dialog oDlg centered
FilterAccCode()
if lMore .and. lNew
If MsgYesNo("Create another code")
AddDetail(lNew)
endif
endif
return nil
static function saveDetail(cNewCode,cNewDesc,lNew)
local nRec := glaccode->(recno())
if lNew
if glacsubg->ac_prefix # left(cNewCode,3)
MsgAlert("Wrong prefix code","Warning...!!")
return nil
endif
glaccode->(ordSetFocus("gl_accode"))
glaccode->(dbGotop())
if glaccode->(dbSeek(cNewCode))
glaccode->(dbGoto(nRec))
MsgAlert("Duplicate account code "+cNewCode,"Warning...")
return nil
endif
glaccode->(dbGoto(nRec))
if MsgYesNo("Add New Account Name ? "+alltrim(cNewDesc),"Confirmation...!")
glaccode->(dbAppend())
if glaccode->(dbRlock())
glaccode->gl_accode := cNewCode
glaccode->gl_descrpt := cNewDesc
endif
glaccode->(dbUnlock())
oBrwDetail:Refresh()
endif
else
if glaccode->(dbRlock())
glaccode->gl_descrpt := cNewDesc
endif
glaccode->(dbUnlock())
oBrwDetail:Refresh()
endif
FilterAccCode()
return nil
static function DeleteDetail()
if glacsubg->ac_limit == 0
MsgAlert("Please select Sub-Account","Warning..!" )
return nil
endif
if MsgYesNo("Are you sure want to delete "+alltrim(glaccode->gl_descrpt),"Confirmation.. !")
if glaccode->(dbRlock())
glaccode->(dbDelete())
endif
glaccode->(dbUnlock())
glaccode->(DBSKIP(1))
oBrwDetail:SetFocus()
IF glaccode->(EOF())
oBrwDetail:GoUp()
ENDIF
oBrwDetail:Refresh()
endif
return nil
static function PostEditDetail( oCol, xValue, nLastKey )
local nCol := oCol:nPos
local nOldVal
if nLastKey == 13 // press enter
nOldVal := eval( oCol:bEditValue )
if !( nOldVal == xValue )
do case
case nCol == 2
if glaccode->(dbRlock())
glaccode->gl_descrpt := xValue
endif
glaccode->(dbUnlock())
endcase
endif
oCol:oBrwDetail:goRight()
endif
return nil
static function FilterAccCode()
local cScope
if glacsubg->ac_limit == 0
cScope := left(glacsubg->ac_prefix,1)
glaccode->(ordSetFocus("gl_prefix1")) // sort by 1 digit
else
cScope := left(glacsubg->ac_prefix,3)
glaccode->(ordSetFocus("gl_prefix3")) // sort by 3 digit
endif
glaccode->(ordScope(0,cScope))
glaccode->(ordScope(1,cScope))
glaccode->(dbgotop())
oBrwDetail:goTop()
return nil
STATIC FUNCTION DragBegin( nRow, nCol, nFlags, oBrw )
SetDropInfo( EVAL( oBrw:SelectedCol():bStrData ) )
RETURN NIL
STATIC FUNCTION DropOver( uDropInfo, nRow, nCol, nFlags, oBrw )
oBrw:lButtonDown( nRow, nCol, nFlags)
oBrw:lButtonUp( nRow, nCol, nFlags)
MsgInfo( uDropInfo + CRLF + 'dropped on' + CRLF + ;
EVAL( oBrw:SelectedCol():bStrData ) )
RETURN NIL
function XbrStyles( oBrw )
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLCELL
oBrw:nColDividerStyle := LINESTYLE_LIGHTGRAY
oBrw:nRowDividerStyle := LINESTYLE_LIGHTGRAY
oBrw:lColDividerComplete := .T.
oBrw:bClrSelFocus := { ||{ CLR_BLUE, LightColor( 30, nRGB( 194,210,237 ) ) } }
return nil