Code Program

	ADMIN - REFRESH
GASY Script

CODE_MENU - 75

Lparameters pKode,pJudul PUBLIC oaplikasi oaplikasi=CREATEOBJECT("aplikasi",pKode,pJudul) oaplikasi.Show RETURN DEFINE CLASS aplikasi AS FORM DataSession = 1 Height = 500 Width = 793 DoCreate = .T. ShowTips = .T. AutoCenter = .T. BorderStyle = 3 Caption = "Gasy Software" HalfHeightCaption = .F. MaxButton = .F. MinButton = .F. MaxHeight = 500 MaxWidth = 793 MinHeight = 500 MinWidth = 793 Enabled = .T. Icon = "BMPS\GASY.ico" TitleBar = 1 WindowType = 0 WindowState = 0 BackColor = RGB(144,176,168) Name = "Aplikasi" laporan = .F. pmklp = .F. oldtgl = .F. ADD OBJECT pf AS pageframe WITH ; ErasePage = .T., ; TabStyle = 0, ; Top = 123, ; Left = 8, ; Width = 773, ; Height = 336, ; TabIndex = 3, ; ZOrderSet = 0 ADD OBJECT kembali AS commandbutton WITH ; Top = 467, ; Left = 696, ; Height = 27, ; Width = 84, ; Cancel = .T., ; Caption = "E\<XIT", ; TabIndex = 19, ; ZOrderSet = 1 ADD OBJECT shape1 AS shape WITH ; Top = 80, ; Left = 8, ; Height = 41, ; Width = 771, ; SpecialEffect = 0, ; ZOrderSet = 2 ADD OBJECT tgllapor AS TEXTBOX WITH ; Height = 23, ; Left = 58, ; TabIndex = 5, ; Top = 89, ; Width = 89, ; VALUE=DATE(),; ZOrderSet = 3 ADD OBJECT atur AS commandbutton WITH ; AutoSize = .F., ; Top = 36, ; Left = 10, ; Height = 42, ; Width = 769, ; FontBold = .T., ; FontSize = 27, ; FontUnderline = .F., ; Caption = "\<MENU APLIKASI", ; TabIndex = 16, ; ToolTipText = "Menentukan pilihan aplikasi sesuai kelompok atau keseluruhan", ; SpecialEffect = 2, ; ForeColor = RGB(0,0,64), ; ZOrderSet = 4 ADD OBJECT label4 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "S/D", ; Height = 15, ; Left = 252, ; Top = 92, ; Width = 22, ; TabIndex = 8, ; ColorSource = 4, ; ZOrderSet = 5 ADD OBJECT hal02 AS spinner WITH ; FontName = "MS Sans Serif", ; Height = 24, ; Increment = 1.00, ; Left = 277, ; SelectOnEntry = .T., ; SpecialEffect = 0, ; TabIndex = 9, ; Top = 88, ; Width = 71, ; ZOrderSet = 6, ; Value = 6500 ADD OBJECT hal01 AS spinner WITH ; FontName = "MS Sans Serif", ; Height = 24, ; Increment = 1.00, ; Left = 204, ; SelectOnEntry = .T., ; SpecialEffect = 0, ; TabIndex = 7, ; Top = 89, ; Width = 43, ; ZOrderSet = 7, ; Value = 1 ADD OBJECT label3 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Halaman", ; Height = 15, ; Left = 155, ; Top = 93, ; Width = 44, ; TabIndex = 6, ; ZOrderSet = 8 ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Cetak:", ; Height = 15, ; Left = 353, ; Top = 92, ; Width = 33, ; TabIndex = 10, ; ColorSource = 0, ; ZOrderSet = 9 ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Tanggal", ; Height = 15, ; Left = 14, ; Top = 92, ; Width = 41, ; TabIndex = 4, ; ZOrderSet = 10 ADD OBJECT tcetak AS optiongroup WITH ; ButtonCount = 4, ; BackStyle = 0, ; BorderStyle = 1, ; Value = 1, ; Height = 27, ; Left = 387, ; Top = 87, ; Width = 299, ; TabIndex = 18, ; ColorSource = 0, ; ZOrderSet = 11, ; Name = "TCETAK", ; Option1.FontName = "MS Sans Serif", ; Option1.BackStyle = 0, ; Option1.Caption = "\<1 View", ; Option1.Value = 1, ; Option1.Height = 17, ; Option1.Left = 5, ; Option1.Style = 0, ; Option1.Top = 5, ; Option1.Width = 90, ; Option1.AutoSize = .F., ; Option1.Name = "Option1", ; Option2.FontName = "MS Sans Serif", ; Option2.BackStyle = 0, ; Option2.Caption = "\<2.Default", ; Option2.Value = 0, ; Option2.Height = 17, ; Option2.Left = 59, ; Option2.Style = 0, ; Option2.Top = 5, ; Option2.Width = 90, ; Option2.AutoSize = .F., ; Option2.Name = "Option2", ; Option3.FontName = "MS Sans Serif", ; Option3.BackStyle = 0, ; Option3.Caption = "\<3.Select Printer", ; Option3.Height = 17, ; Option3.Left = 122, ; Option3.Style = 0, ; Option3.Top = 5, ; Option3.Width = 90, ; Option3.AutoSize = .F., ; Option3.Name = "Option3", ; Option4.BackStyle = 0, ; Option4.Caption = "\<4.Modifikasi", ; Option4.Height = 17, ; Option4.Left = 212, ; Option4.Style = 0, ; Option4.Top = 5, ; Option4.Width = 90, ; Option4.AutoSize = .F., ; Option4.Name = "Option4" ADD OBJECT rangkap AS spinner WITH ; FontName = "MS Sans Serif", ; Height = 24, ; Increment = 1.00, ; Left = 731, ; SelectOnEntry = .T., ; SpecialEffect = 0, ; TabIndex = 11, ; Top = 91, ; Width = 43, ; ZOrderSet = 7, ; Value = 1 ADD OBJECT label5 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Copy", ; Height = 15, ; Left = 699, ; Top = 94, ; Width = 26, ; TabIndex = 12, ; ZOrderSet = 8, ; ToolTipText = "Pencetakan rangkap, jika pilihan cetak = Default" ADD OBJECT command1 AS commandbutton WITH ; Top = 467, ; Left = 9, ; Height = 27, ; Width = 84, ; Caption = "\<Validasi", ; TabIndex = 17, ; ZOrderSet = 1 ADD OBJECT label6 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "CARI MENU", ; Height = 17, ; Left = 516, ; Top = 10, ; Width = 68, ; TabIndex = 1 ADD OBJECT text1 AS textbox WITH ; Height = 23, ; Left = 593, ; TabIndex = 2, ; Top = 7, ; Width = 185 ADD OBJECT label7 AS label WITH ; AutoSize = .T., ; BackStyle = 0, ; Caption = "Kategori Menu", ; Height = 17, ; Left = 13, ; Top = 10, ; Width = 81, ; TabIndex = 13, ; ToolTipText = "Refresh Kategori Menu" ADD OBJECT combo1 AS combobox WITH ; ColumnCount = 2, ; Height = 24, ; Left = 99, ; Style = 2, ; TabIndex = 14, ; Top = 6, ; Width = 70 ADD OBJECT command2 AS commandbutton WITH ; AutoSize = .F., ; Top = 5, ; Left = 171, ; Height = 26, ; Width = 27, ; Picture = "bmps\wznew.bmp", ; Caption = "", ; ToolTipText = "Buka Window Baru" PROCEDURE TGLLAPOR.RIGHTCLICK MYKALENDER(THISFORM,THIS) ENDPROC PROCEDURE jalan PARAMETERS iPro,iCetak,iJudul LOCAL mPro, pax1, pax2, pax3, pax4, pax5, pax6 pax1=Thisform.TglLapor.Value pax2=Thisform.tCETAK.Value pax3=Thisform.HAL01.Value pax4=Thisform.HAL02.Value pax5=Thisform.Rangkap.Value pax6=iCetak IF LEFT(iPro,1)='0' mPro=SUBSTR(iPro,2) &mPro ELSE IF !FILE(iPro+'.Fxp') WAIT WINDOW 'File prosedur belum dibuat' ELSE IF pax2=4 IF !EMPTY(pax6) MODIFY REPORT (pax6) ELSE WAIT WINDOW 'Prosedur ini tidak berisi file laporan' ENDIF RETURN ENDIF IF !EMPTY(pax6) XXJUDUL=ALLTRIM(SUBSTR(ALLTRIM(iJudul),RAT('.',iJudul))) DO (iPro) WITH pax1, pax2, pax3, pax4, pax5, pax6 ELSE DO (iPro) ENDIF ENDIF ENDIF RETURN ENDPROC PROCEDURE carilagi Thisform.Oldtgl=Gasy_Tgl Thisform.Closable= .T. FOR nPos=1 TO 18 this.sembunyikan(nPos) ENDFOR IF !THIS.BUkagasypros() RETURN ENDIF LLKODE='' ICARI=UPPER(ALLTRIM(THIS.TExt1.Value)) IF EMPTY(llKode) nPos=0 IF EMPTY(ICARI) SELECT * FROM GASYPROS ORDER BY NMMENU INTO CURSOR HASILPRO ELSE SELECT * FROM GASYPROS WHERE OCCURS(ICARI,UPPER(NMMENU))>0 ORDER BY NMMENU INTO CURSOR HASILPRO ENDIF SELECT HASILPRO Thisform.PMKLP='PRO' GO Top this.isipage1 ENDIF TUTUP("HASILPRO") ENDPROC PROCEDURE bukagasypros LOCAL mDbf TUTUP("GASYPROS") mDbf=ALAMATDL+'PROS_108' IF !FILE(mDbf+".Dbf") CREATE TABLE (mDbf) ; (; KODE C(3), ; NMR C(3), ; NMMENU C(60), ; NMPROSEDUR C(100), ; NMLAPORAN C(100), ; SBR C(1), ; CATATAN C(100)) USE ENDIF RETURN(BUKA(.F.,mDbf,"GASYPROS")) ENDPROC PROCEDURE sembunyikan LPARAMETERS nPos1 LOCAL nPos,mOk1 FOR nPos=1 TO 18 mOk1="Thisform.PF.PAGE"+TRANSFORM(nPos1)+".Command"+TRANSFORM(nPos) &mOk1..Visible=.F. NEXT ENDPROC PROCEDURE isipage LPARAMETERS nPage,nCommand,nRekord mOk1="Thisform.PF.PAGE"+TRANSFORM(nPage)+".Command"+TRANSFORM(nCommand) &mOk1..Visible=.t. &mOk1..Caption=TRANSFORM(nRekord)+". "+ALLTRIM(nmmenu) &mOk1..StatusBarText=IIF(EMPTY(NMPROSEDUR),ALAMATDL+'Proses\'+KODE+NMR,; IIF(SUBSTR(NMPROSEDUR,2,1)=":",ALLTRIM(NMPROSEDUR),ALAMATDL+'Proses\'+ALLTRIM(NMPROSEDUR))) &mOk1..Comment=IIF(EMPTY(NMLAPORAN),"",; IIF(SUBSTR(NMLAPORAN,2,1)=":",ALLTRIM(NMLAPORAN),ALAMATDL+'Laporan\'+ALLTRIM(NMLAPORAN))) IF SBR='0' &mOk1..StatusBarText='0'+ALLTRIM(NMPROSEDUR) ENDIF ENDPROC PROCEDURE isipage1 DO WHILE NOT EOF() nPos=nPos+1 IF BETWEEN(nPOS,1,126) DO CASE CASE BETWEEN(nPos,1,18) This.isipage(1,nPos,RECNO()) CASE BETWEEN(nPos,19,36) This.isipage(2,nPos-18,RECNO()) CASE BETWEEN(nPos,37,54) This.isipage(3,nPos-36,RECNO()) CASE BETWEEN(nPos,55,72) This.isipage(4,nPos-54,RECNO()) CASE BETWEEN(nPos,73,90) This.isipage(5,nPos-72,RECNO()) CASE BETWEEN(nPos,91,108) This.isipage(6,nPos-90,RECNO()) CASE BETWEEN(nPos,109,126) This.isipage(7,nPos-108,RECNO()) ENDCASE ENDIF SKIP ENDDO ENDPROC PROCEDURE Init Parameters LLKODE, mJudul THIS.Caption='Gasy Software : '+TTOC(DATETIME()) if type('this.pf.page1')<>'O' this.pf.addobject('page1','page_x') this.pf.addobject('page2','page_x') this.pf.addobject('page3','page_x') this.pf.addobject('page4','page_x') this.pf.addobject('page5','page_x') this.pf.addobject('page6','page_x') this.pf.addobject('page7','page_x') this.pf.addobject('page8','page_x') this.pf.addobject('page9','page_x') this.pf.addobject('page10','page_x') this.pf.addobject('page11','page_x') this.pf.addobject('page12','page_x') this.pf.addobject('page13','page_x') this.pf.addobject('page14','page_x') this.pf.addobject('page15','page_x') this.pf.addobject('page16','page_x') this.pf.addobject('page17','page_x') this.pf.addobject('page18','page_x') this.pf.addobject('page19','page_s') endif IF TYPE('MJUDUL')='C' AND !EMPTY(MJUDUL) Thisform.Atur.CaptioN=MJUDUL ELSE Thisform.Atur.Caption='MENU APLIKASI' ENDIF Thisform.PF.PAGE19.KodeUsr.Value=ALLTRIM(MPHOTO) Thisform.PF.PAGE19.Enabled=DADI(41) Thisform.Oldtgl=Gasy_Tgl Thisform.Closable= .T. IF TYPE('LLKODE')=='C' Thisform.PMKLP=LLKODE THIS.COMbo1.Value=LLKODE Thisform.PF.PAGE19.ckLP.Value=LLKODE ENDIF FOR nPos=1 TO 18 this.sembunyikan(nPos) ENDFOR IF !THIS.BUkagasypros() RETURN ENDIF IF !EMPTY(llKode) nPos=0 SELECT * FROM GASYPROS WHERE KODE==LLKODE ORDER BY NMR INTO CURSOR HASILPRO SELECT HASILPRO this.isipage1 ENDIF IF EMPTY(llKode) Thisform.PF.PAGE19.ckLP.Value='PRO' nPos=0 SELECT * FROM GASYPROS ORDER BY KODE,NMR INTO CURSOR HASILPRO SELECT HASILPRO Thisform.PMKLP='PRO' GO Top this.isipage1 ENDIF TUTUP("HASILPRO") ENDPROC PROCEDURE Destroy GASY_TGL=Thisform.Oldtgl ENDPROC PROCEDURE Load PUBLIC ALAMATDL,MPHOTO,GASY_TGL,DADIMENU DADIMENU=REPL('1',200) GASY_TGL=DATE() MPHOTO="PRO" ALAMATDL=ALAMATNYA("ADIDL") CHEKFOLDER(ALAMATDL) IF !FILE(ALAMATDL+"GASYKLAS.DBF") REINDEKS('GASYKLAS','',ALAMATDL) ENDIF ENDPROC PROCEDURE kembali.Click Thisform.Release ENDPROC PROCEDURE tgllapor.Init THIS.Value=DATE() ENDPROC PROCEDURE tgllapor.LostFocus Gasy_Tgl=This.Value ENDPROC PROCEDURE atur.Click IF THIS.Parent.COMbo1.ListCount>0 THIS.Parent.COMbo1.SetFocus KEYBOARD '{F4}' ELSE THISFORM.Init() ENDIF ENDPROC PROCEDURE hal02.LostFocus THIS.Value=Max(This.Value,1) ENDPROC PROCEDURE hal01.LostFocus THIS.Value=Max(This.Value,1) ENDPROC PROCEDURE tcetak.Option4.Init This.Enabled=DADI(54) ENDPROC PROCEDURE rangkap.LostFocus THIS.Value=Max(This.Value,1) ENDPROC PROCEDURE text1.InteractiveChange THISFORM.PF.ActivePage=1 THISFORM.Carilagi() ENDPROC PROCEDURE text1.DblClick THISFORM.PF.ActivePage=1 THIS.Value='' THISFORM.Carilagi() ENDPROC PROCEDURE label7.Click THIS.Parent.COMbo1.Init this.Parent.combo1.SetFocus ENDPROC PROCEDURE combo1.Init THIS.Clear this.ColumnWidths=TRANSFORM(this.Width-17) IF Gasyklas() SELECT KODE,KETERANGAN FROM GASYKLAS WHERE KLP=='NFP' AND LEFT(KODE,3)=MPHOTO ORDER BY Keterangan INTO CURSOR JNSLAPOR SELECT JNSLAPOR GO TOP SCAN this.AddListItem(SUBSTR(kode,4,3),RECNO(),1) this.AddListItem(ALLTRIM(keterangan),RECNO(),2) ENDSCAN this.AddListItem('',RECNO()+1,1) this.AddListItem('Semua',RECNO()+1,2) TUTUP("JNSLAPOR") ENDIF ENDPROC PROCEDURE combo1.InteractiveChange THISFORM.PF.ActivePage=1 This.Parent.Init(this.Value,this.ListItem(this.ListIndex,2)) ENDPROC PROCEDURE combo1.RightClick THISform.INIT(this.Value,this.ListItem(this.ListIndex,2)) ENDPROC PROCEDURE command2.Click this.Parent.combo1.RightClick ENDPROC ENDDEFINE * *-- EndDefine: aplikasi ************************************************** DEFINE CLASS PAGE_X AS PAGE ADD OBJECT command1 AS commandbutton WITH ; AutoSize = .T., ; Top = 5, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command1" ADD OBJECT command2 AS commandbutton WITH ; AutoSize = .T., ; Top = 38, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command2" ADD OBJECT command3 AS commandbutton WITH ; AutoSize = .T., ; Top = 71, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command3" ADD OBJECT command4 AS commandbutton WITH ; AutoSize = .T., ; Top = 104, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command4" ADD OBJECT command5 AS commandbutton WITH ; AutoSize = .T., ; Top = 137, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command5" ADD OBJECT command6 AS commandbutton WITH ; AutoSize = .T., ; Top = 170, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command6" ADD OBJECT command7 AS commandbutton WITH ; AutoSize = .T., ; Top = 203, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command7" ADD OBJECT command8 AS commandbutton WITH ; AutoSize = .T., ; Top = 236, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command8" ADD OBJECT command9 AS commandbutton WITH ; AutoSize = .T., ; Top = 269, ; Left = 2, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command9" ADD OBJECT command10 AS commandbutton WITH ; AutoSize = .T., ; Top = 5, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command10" ADD OBJECT command11 AS commandbutton WITH ; AutoSize = .T., ; Top = 38, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command11" ADD OBJECT command12 AS commandbutton WITH ; AutoSize = .T., ; Top = 71, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command12" ADD OBJECT command13 AS commandbutton WITH ; AutoSize = .T., ; Top = 104, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command13" ADD OBJECT command14 AS commandbutton WITH ; AutoSize = .T., ; Top = 137, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command14" ADD OBJECT command15 AS commandbutton WITH ; AutoSize = .T., ; Top = 170, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command15" ADD OBJECT command16 AS commandbutton WITH ; AutoSize = .T., ; Top = 203, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command16" ADD OBJECT command17 AS commandbutton WITH ; AutoSize = .T., ; Top = 236, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command17" ADD OBJECT command18 AS commandbutton WITH ; AutoSize = .T., ; Top = 269, ; Left = 390, ; Height = 32, ; Width = 99, ; FontBold = .F., ; FontName = "Garamond", ; FontSize = 12, ; Caption = "Command1", ; SpecialEffect = 2, ; Name = "Command18" ADD OBJECT line1 AS line WITH ; Height = 305, ; Left = 388, ; Top = 1, ; Width = 0, ; Name = "Line1" ADD OBJECT line2 AS line WITH ; Height = 0, ; Left = 0, ; Top = 0, ; Width = 769, ; Name = "Line2" Procedure Init This.Caption=strtran(upper(This.Name),'PAGE','') Endproc PROCEDURE command1.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command2.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command3.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command4.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command5.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command6.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command7.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command8.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command9.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command10.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command11.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command12.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command13.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command14.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command15.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command16.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command17.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command18.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command1.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command2.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command3.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command4.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command5.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command6.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command7.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command8.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command9.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command10.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command11.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command12.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command13.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command14.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command15.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command16.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command17.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC PROCEDURE command18.Click Thisform.Jalan(This.StatusBarText,This.Comment,This.Caption) ENDPROC ENDDEFINE DEFINE CLASS PAGE_S AS PAGE Caption="Setup" ADD OBJECT label1 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Kode/Nama Menu", ; Height = 15, ; Left = 125, ; Top = 109, ; Width = 90, ; TabIndex = 17, ; ZOrderSet = 1, ; Name = "Label1" ADD OBJECT label5 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Nomer Sub Menu", ; Height = 15, ; Left = 125, ; Top = 133, ; Width = 85, ; TabIndex = 18, ; ZOrderSet = 1, ; Name = "Label5" ADD OBJECT label7 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Nama File Prosedur", ; Height = 15, ; Left = 125, ; Top = 155, ; Width = 94, ; TabIndex = 19, ; ZOrderSet = 40, ; Name = "Label7" ADD OBJECT mno AS textbox WITH ; Alignment = 2, ; Enabled = .T., ; Format = "XXX", ; Height = 23, ; InputMask = "XXX", ; Left = 226, ; MaxLength = 3, ; TabIndex = 3, ; Top = 129, ; Width = 37, ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 52, ; Name = "mNo" ADD OBJECT mnama AS textbox WITH ; Enabled = .T., ; Height = 23, ; Left = 263, ; MaxLength = 60, ; TabIndex = 4, ; Top = 129, ; Width = 272, ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 64, ; Name = "mNama" ADD OBJECT mfile AS textbox WITH ; Enabled = .T., ; Height = 25, ; Left = 226, ; MaxLength = 150, ; TabIndex = 5, ; Top = 152, ; Width = 309, ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 65, ; Name = "mFile" ADD OBJECT cklp AS textbox WITH ; Alignment = 2, ; Enabled = .T., ; Format = "XXX", ; Height = 23, ; InputMask = "XXX", ; Left = 226, ; MaxLength = 3, ; TabIndex = 1, ; Top = 104, ; Width = 37, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 52, ; Name = "cKLP" ADD OBJECT rekam AS commandbutton WITH ; Top = 147, ; Left = 567, ; Height = 27, ; Width = 95, ; Caption = "\<Rekam", ; TabIndex = 9, ; Name = "Rekam" ADD OBJECT hapus AS commandbutton WITH ; Top = 174, ; Left = 567, ; Height = 27, ; Width = 95, ; Caption = "\<Hapus", ; TabIndex = 10, ; Name = "Hapus" ADD OBJECT namakelompok AS textbox WITH ; Enabled = .T., ; Height = 23, ; Left = 263, ; MaxLength = 60, ; TabIndex = 2, ; Top = 104, ; Width = 272, ; Style = 0, ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 64, ; Name = "NamaKelompok" ADD OBJECT proses2 AS commandbutton WITH ; AutoSize = .F., ; Top = 59, ; Left = 567, ; Height = 32, ; Width = 95, ; Caption = "\<Program Baru", ; TabIndex = 11, ; Name = "Proses2" ADD OBJECT proses1 AS commandbutton WITH ; AutoSize = .F., ; Top = 91, ; Left = 567, ; Height = 27, ; Width = 95, ; Caption = "\<Compile", ; TabIndex = 12, ; Name = "Proses1" ADD OBJECT kodeusr AS textbox WITH ; FontSize = 12, ; Alignment = 2, ; BorderStyle = 1, ; Enabled = .F., ; Format = "XXX", ; Height = 33, ; InputMask = "XXX", ; Left = 461, ; MaxLength = 3, ; TabIndex = 14, ; Top = 59, ; Width = 73, ; DisabledBackColor = RGB(128,128,128), ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 52, ; Name = "KodeUsr" ADD OBJECT command1 AS commandbutton WITH ; AutoSize = .T., ; Top = 58, ; Left = 125, ; Height = 36, ; Width = 331, ; FontBold = .T., ; FontName = "MS Sans Serif", ; FontSize = 12, ; WordWrap = .F., ; Caption = "Modifikasi Prosedur/Kode Akses User", ; TabIndex = 13, ; Name = "Command1" ADD OBJECT adaprogram AS optiongroup WITH ; AutoSize = .T., ; ButtonCount = 2, ; Value = 2, ; Height = 27, ; Left = 226, ; Top = 230, ; Width = 136, ; TabIndex = 8, ; Name = "AdaProgram", ; Option1.Caption = "Intenal", ; Option1.Value = 0, ; Option1.Height = 17, ; Option1.Left = 5, ; Option1.Style = 0, ; Option1.Top = 5, ; Option1.Width = 62, ; Option1.AutoSize = .F., ; Option1.Name = "Option1", ; Option2.Caption = "External", ; Option2.Value = 1, ; Option2.Height = 17, ; Option2.Left = 69, ; Option2.Style = 0, ; Option2.Top = 5, ; Option2.Width = 62, ; Option2.AutoSize = .F., ; Option2.Name = "Option2" ADD OBJECT label2 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Nama File Laporan", ; Height = 15, ; Left = 125, ; Top = 181, ; Width = 91, ; TabIndex = 20, ; ZOrderSet = 40, ; Name = "Label2" ADD OBJECT mfilelapor AS textbox WITH ; Enabled = .T., ; Height = 25, ; Left = 226, ; MaxLength = 150, ; TabIndex = 6, ; Top = 177, ; Width = 309, ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 65, ; Name = "mFileLapor" ADD OBJECT label4 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Catatan", ; Height = 15, ; Left = 125, ; Top = 207, ; Width = 39, ; TabIndex = 21, ; ZOrderSet = 40, ; Name = "Label4" ADD OBJECT xcatatan AS textbox WITH ; Enabled = .T., ; Height = 25, ; Left = 226, ; MaxLength = 100, ; TabIndex = 7, ; Top = 202, ; Width = 309, ; DisabledForeColor = RGB(0,0,0), ; ZOrderSet = 65, ; Name = "xCatatan" ADD OBJECT label6 AS label WITH ; AutoSize = .T., ; FontName = "MS Sans Serif", ; BackStyle = 0, ; Caption = "Sumber Program", ; Height = 15, ; Left = 125, ; Top = 233, ; Width = 80, ; TabIndex = 22, ; ZOrderSet = 40, ; Name = "Label6" ADD OBJECT commandBrowse AS commandbutton WITH ; Top = 201, ; Left = 567, ; Height = 27, ; Width = 95, ; Caption = "\<Browse" PROCEDURE mfilelapor.RightClick This.Value = GETFILE('FRX') ENDPROC PROCEDURE commandBrowse.RightClick IF !GASYKLAS() RETURN ENDIF IF USED('GASYKLAS') SELECT GASYKLAS GBROWSE("GASYKLAS") ENDIF ENDPROC PROCEDURE commandBrowse.Click IF !THISFORM.BUkagasypros() RETURN ENDIF IF USED('GASYPROS') SELECT GASYPROS GBROWSE("GASYPROS") ENDIF ENDPROC PROCEDURE mno.RightClick IF !THISFORM.BUkagasypros() RETURN ENDIF IF USED('GASYPROS') SELECT NMR,NMMENU FROM GASYPROS WHERE KODE==This.Parent.cKLP.Value ORDER BY NMR INTO CURSOR DAFTAR SELECT DAFTAR DEFINE POPUP Daftar FONT "Courier",8 PROMPT FIELD ; NMR+" "+ALLTRIM(NMMENU) SCROLL SHORTCUT TITLE ; "DAFTAR SUB MENU APLIKASI" FROM MROW(),MCOL() ON SELECTION POPUP Daftar BAR() ACTIVATE POPUP Daftar DEACTIVATE POPUP Daftar SELECT Daftar IF BAR()>0 GOTO BAR() This.Value=NMR ENDIF TUTUP("DAFTAR") ENDIF ENDPROC PROCEDURE mno.LostFocus LOCAL mDbf IF !EMPTY(This.Value) This.Value=RIGHT('000'+ALLTRIM(This.Value),3) IF !THISFORM.BUkagasypros() RETURN ENDIF SELECT GASYPROS Locate For KODE==This.Parent.CKLP.Value And NMR==This.Value If Found() This.Parent.AdaProgram.Value=IIF(SBR='0',1,2) This.Parent.mNama.Value=NMMENU This.Parent.mFile.Value=NMPROSEDUR This.Parent.mFilelapor.Value=NMLAPORAN This.Parent.xCatatan.Value=Catatan ELSE This.Parent.AdaProgram.Value=2 This.Parent.mNama.Value="" This.Parent.mFile.Value="" This.Parent.mFilelapor.Value="" This.Parent.xCatatan.Value="" ENDIF ENDIF ENDPROC PROCEDURE mno.GotFocus IF EMPTY(THIS.Parent.CKLP.Value) THIS.Parent.CKLP.SetFocus RETURN ENDIF ENDPROC PROCEDURE mfile.RightClick This.Value = GETFILE('FXP') ENDPROC PROCEDURE cklp.LostFocus IF !EMPTY(This.Value) IF GASYKLAS() SELECT GASYKLAS LOCATE FOR KLP=='NFP' AND SUBSTR(KODE,4,3)==This.Value IF FOUND() This.Parent.NamaKelompok.Value=ALLTRIM(Keterangan) THIS.Parent.NamaKelompok.Style= 1 ENDIF ENDIF ELSE This.Parent.NamaKelompok.Value="Menu Aplikasi" ENDIF ENDPROC PROCEDURE cklp.RightClick IF GASYKLAS() SELECT GASYKLAS SELECT KODE,KETERANGAN FROM GASYKLAS WHERE KLP=='NFP' AND LEFT(KODE,3)=MPHOTO ORDER BY KODE INTO CURSOR DAFTAR SELECT DAFTAR DEFINE POPUP Daftar FONT "Courier",8 PROMPT FIELD ; ALLTRIM(KODE)+" "+ALLTRIM(KETERANGAN) SCROLL SHORTCUT TITLE ; "DAFTAR MENU APLIKASI" FROM MROW(),MCOL() ON SELECTION POPUP Daftar BAR() ACTIVATE POPUP Daftar DEACTIVATE POPUP Daftar SELECT Daftar IF BAR()>0 GOTO BAR() This.Value=SUBSTR(KODE,4,3) ENDIF TUTUP("DAFTAR") ENDIF ENDPROC PROCEDURE cklp.GotFocus IF !EMPTY(This.Value) IF GASYKLAS() SELECT GASYKLAS LOCATE FOR KLP=='NFP' AND SUBSTR(KODE,4,3)==This.Value IF FOUND() This.Parent.NamaKelompok.Value=ALLTRIM(Keterangan) THIS.Parent.NamaKelompok.Style= 1 ENDIF ENDIF ELSE This.Parent.NamaKelompok.Style= 1 ENDIF ENDPROC PROCEDURE rekam.Click IF !THISFORM.BUkagasypros() RETURN ENDIF IF USED('GASYPROS') AND !EMPTY(This.Parent.mNo.Value) SELECT GASYPROS Locate For KODE==This.Parent.CKLP.Value And NMR==This.Parent.Mno.Value If !Found() IF KUNCI_FI(5) APPEND BLANK UNLOCK ENDIF ENDIF IF KUNCI_RC(5) REPLACE KODE WITH This.Parent.CKLP.Value,; NMR WITH This.Parent.Mno.Value,; SBR WITH IIF(This.Parent.AdaProgram.Value=2,'X','0'),; NMMENU WITH This.Parent.mNama.Value,; NMPROSEDUR WITH This.Parent.mFile.Value,; NMLAPORAN WITH This.Parent.mFileLapor.Value,; SBR WITH IIF(This.Parent.AdaProgram.Value=2,'X','0'),; Catatan WITH This.Parent.xCatatan.Value FLUSH UNLOCK ENDIF This.Parent.mNo.Value="" This.Parent.mNama.Value="" This.Parent.mFile.Value="" This.Parent.mFileLapor.Value="" This.Parent.xCatatan.Value="" This.Parent.mNo.SetFocus ENDIF ENDPROC PROCEDURE hapus.Click IF !THISFORM.BUkagasypros() RETURN ENDIF IF USED('GASYPROS') SELECT GASYPROS Locate For KODE==This.Parent.CKLP.Value And NMR==This.Parent.Mno.Value If Found() IF KUNCI_RC(5) DELETE UNLOCK ENDIF This.Parent.mNo.Value="" This.Parent.mNama.Value="" This.Parent.mFile.Value="" This.Parent.mFileLapor.Value="" This.Parent.mNo.SetFocus ENDIF ENDIF ENDPROC PROCEDURE namakelompok.LostFocus IF !EMPTY(This.Parent.cKLP.Value) AND !EMPTY(This.Value) IF GASYKLAS() SELECT GASYKLAS LOCATE FOR KLP=='NFP' AND LEFT(KODE,6)==MPHOTO+This.Parent.cKLP.Value IF !FOUND() IF Kunci_Fi(5) APPEND BLANK REPLACE KLP WITH 'NFP',; KODE WITH MPHOTO+This.Parent.cKLP.Value,; NAMAKLP WITH 'MENU APLIKASI',; KETERANGAN WITH This.VALUE FLUSH UNLOCK ENDIF ELSE IF Kunci_RC(5) REPLACE KETERANGAN WITH This.VALUE FLUSH UNLOCK ENDIF ENDIF ENDIF ENDIF ENDPROC PROCEDURE proses2.Click IF This.Parent.AdaProgram.Value=2 mFile1=IIF(EMPTY(This.Parent.mFile.Value),ALAMATDL+'Proses\'+; This.Parent.cKlp.Value+This.Parent.mNo.Value,; IIF(SUBSTR(This.Parent.mFile.Value,2,1)=":",ALLTRIM(This.Parent.mFile.Value),; ALAMATDL+'Proses\'+ALLTRIM(This.Parent.mFile.Value))) CHEKFOLDER(MFILE1) MODIFY COMMAND (mFile1) ENDIF ENDPROC PROCEDURE proses1.Click IF This.Parent.AdaProgram.Value=2 mFile1=IIF(EMPTY(This.Parent.mFile.Value),ALAMATDL+'Proses\'+; This.Parent.cKlp.Value+This.Parent.mNo.Value,; IIF(SUBSTR(This.Parent.mFile.Value,2,1)=":",ALLTRIM(This.Parent.mFile.Value),; ALAMATDL+'Proses\'+ALLTRIM(This.Parent.mFile.Value))) COMPILE (mFile1) ENCRYPT NODEBUG ENDIF ENDPROC ENDDEFINE

ADMIN REFRESH UDF FORM GASY_UDF DATA PROSES LAPORAN

CODE_MENU - 75