Demo Program Akuntansi ( GL)

Download GL Demo

Membuat Form Jadi Transparan (Visual Foxpro)

* Penulisanya
* 1. Ketik Di Form procedure - init
* : transparent(thisform.HWnd, thisform.BackColor)
* 2. buat background formnya : RGB(255,0,255)
* 3. ShowWindow=2
* 4. Ketik di Form procedure - unload
* CLEAR DLLS GetWindowLong,SetWindowLong,SetLayeredWindowAttributes
*------------------------------------------------------------------------
PROCEDURE transparenci
LPARAMETERS nHWND, nColor
DECLARE INTEGER GetWindowLong IN user32.DLL INTEGER hWnd, ;
INTEGER nIndex
DECLARE INTEGER SetWindowLong IN user32.DLL INTEGER hWnd, ;
INTEGER nIndex, ;
INTEGER dwNewLong
DECLARE INTEGER SetLayeredWindowAttributes IN WIN32API INTEGER HWND, ;
INTEGER crKey, ;
INTEGER bAlpha,;
INTEGER dwFlags
*********************************************************************************************
#DEFINE LWA_TRANSPARENT 1
#DEFINE GWL_EXSTYLE -20
#DEFINE WS_EX_LAYERED 0x00080000

LOCAL lnFlags
*********************************************************************************************
lnFlags = GetWindowLong(nHWND, GWL_EXSTYLE) && Gets the existing flags from the window
lnFlags = BITOR(lnFlags, WS_EX_LAYERED) && Appends the Layered flag to the existing ones
SetWindowLong(nHWND, GWL_EXSTYLE, lnFlags) && Sets the new flags to the window
SetLayeredWindowAttributes(nHWND, nColor, 0, LWA_TRANSPARENT)
ENDPROC
* HexToStr
*******************************************
Function HexToStr(cBytes)
Local cReturn,n
cReturn=""
For n=Len(cBytes)/2 to 1 step -1
nChr=eval("0x"+SubStr(cBytes,(n-1)*2+1,2))
cReturn=cReturn+chr(nChr)
endfor
Return cReturn
EndFunc

Get Default Printer (Visual Foxpro)

* Penulisannya
* =GetdefaPrn()
*----------------------------------------------------------------------------
PROCEDURE getdefaprn
DECLARE INTEGER GetDefaultPrinter IN winspool.drv;
STRING @ pszBuffer,;
INTEGER @ pcchBuffer

* returns default printer name (WinNT)
nBufsize = 250
cPrinter = REPLICATE(Chr(0), nBufsize)

= GetDefaultPrinter(@cPrinter, @nBufsize)
cPrinter = SUBSTR(cPrinter, 1, AT(Chr(0),cPrinter)-1)
RETURN cPrinter
ENDPROC

Sinkronisasi Jam Local dengan Jam Server (Visual Foxpro)

* sinkronisasi jam dengan server
* =timeserver(cNamesvr)
*-------------------------------------
FUNCTION timeserver
PARAMETERS cNmsvr
myServerName=cNmsvr
lcCmd = GETENV("ComSpec") + " /C NET TIME \\"+ ;
myServerName+" /SET /YES"
loShell = CREATEOBJECT("wscript.shell")
loShell.Run(lcCmd,0,.t.)
ENDFUNC

Dapatkan nomor transaksi terakhir (Visual Foxpro)

FUNCTION getnum
PARAMETERS lcalias,lddate,lckey,fld,cPP
PRIVATE lcoldalias,bd,BL
lcoldalias = Alias()
bl=bulan(lddate)
bd=SUBSTR(lckey,1,3)+SUBSTR(DTOC(lddate),9,2)+bl
BLN=MONTH(lddate)
THN=YEAR(lddate)
*------------------------------------------------------
lup="Select * from &lcalias where !DELETED() and MONTH(tgltrn)="+TRANSFORM(MONTH(lddate),'99')+"AND YEAR(tgltrn)="+TRANSFORM(YEAR(lddate),'9999')

ll=SQLEXEC(lnHandle,lup,'temnum')
SELECT temnum
CALCULATE MAX(&fld) FOR SUBSTR(&fld,1,6)=BD TO MCT
MCT=VAL(RIGHT(MCT,5))+1
lcreturn=bd+ALLTRIM(NtoC(mct,5))
SELECT(lcoldalias)
Return lcreturn
ENDFUNC

FUNCTION ntoc
PARAMETER NVAR, NLEN
IF PARAMETERS()=1
NLEN = 10
ENDIF
RETURN STRTRAN(STR(NVAR, NLEN), ' ', '0')
ENDFUNC

Open Database & Langsung open table (Visual Foxpro)

*------------------------------------------------
* Open Database & table dbf
* used =opendbc("c:\datadbc\esoft.dbc")
*------------------------------------------------
FUNCTION opendbc
PARAMETERS cdbc
OPEN DATABASE &cdbc
local laTABLES[1], lnTABLES, lnI
lnTABLES = adbobjects(laTABLES, 'Table')
for lnI = 1 to lnTABLES
use (laTABLES[lnI]) in 0
next lnI
return .T.

Compile prg to exe (Visual Foxpro)

*--------------------------
* Cara penulisannya
* =prg2exe("c:\test.prg")
*---------------------------
FUNCTION PRG2EXE
LPARAMETERS srcPrg
* Add some error checking...
CREATE PROJECT Autoexe SAVE NOWAIT noshow
cp=application.Projects['Autoexe.pjx']
cp.files.Add(srcPrg+'.prg')
cp.SetMain(srcPrg)
rv=cp.Build(srcPrg,3)
IF rv && Built! Notify or not at your leisure
endif
cp.close
ERASE autoexe.pj?
RETURN rv