*-------------------------------------------------------------------------------------------------------------------------------------------------------- * (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! *-------------------------------------------------------------------------------------------------------------------------------------------------------- *< FOXBIN2PRG: Version="1.21" SourceFile="_frm_base.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) * * DEFINE CLASS _frmbase AS _form OF "_baza.vcx" *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="_shape1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="_shape2" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Lb_titlu_alb_b121" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="BUT_TERMIN1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Gridsort1" UniqueID="" Timestamp="" /> * *m: actualizeaza_drepturi && Actualizeaza drepturile de acces pe formular. *m: actualizeaza_grid1 *m: actualizeaza_grid2 *m: aranjeaza_butoane *m: do_adauga *m: do_cauta *m: do_copiaza *m: do_copie *m: do_deschide_tranzactie *m: do_deselectall *m: do_excel *m: do_executa *m: do_help *m: do_inchide_tranzactie *m: do_listare *m: do_login *m: do_logoff *m: do_modifica *m: do_precedent *m: do_reface *m: do_renunt *m: do_reset *m: do_salvare *m: do_selectall *m: do_sterge *m: do_termin *m: do_urmator *m: do_verifica *m: filtru_traducere *m: grid_sort *m: grid_sort_bind *m: inainte_de_do_copie *m: inainte_de_do_excel *m: inainte_de_do_listare *m: inainte_de_do_modifica *m: inainte_de_do_reface *m: inainte_de_do_renunt *m: inainte_de_do_sterge *m: inainte_de_do_termin *m: modifyfontsize *m: scrie_in_log *m: setfont && * Call on the Font Handler to change the font for the\n* passed object. If there's an application object,\n* look for the Font Handler there. Otherwise, use\n* a public variable.\n *p: bvizualizare *p: cbuton1 && Buton de export in Excel. *p: cbuton2 && Buton de listare. *p: cbuton3 && Buton de modificare. *p: cbuton4 && Buton de stergere/refacere. *p: cbuton7 && Buton de executie. *p: cbuton8 && Buton adaugare *p: cgridsortlist *p: chost *p: cpassword *p: cusername *p: filtru_pretty *p: filtru_pretty_ro *p: filtru_pretty_ro_full && filtru_pretty_ro + traducerile de la restul selectiilor din formularul principal *p: lactiv1 && .T. daca utilizatorul are acces la export in Excel. *p: lactiv2 && .T. daca utilizatorul are acces la listare. *p: lactiv3 && .T. daca utilizatorul are acces la modificare. *p: lactiv4 && .T. daca utilizatorul are acces la stergere sau la refacere. *p: lactiv5 && .T. daca utilizatorul are acces la vizualizarea inregistrarilor. *p: lactiv6 && .T. daca utilizatorul are acces la vizualizarea inregistrarilor celorlalti utilizatori. *p: lactiv7 && .T. daca utilizatorul are acces la do_executa. *p: lactiv8 && daca utilizatorul are drept la adaugare *p: lhide *p: nhandle *p: nhwnd *p: nselectate * * AlwaysOnTop = .T. AutoCenter = .T. BackColor = 255,255,255 BorderStyle = 1 bvizualizare = .F. cbuton1 = but_excel1 cbuton2 = but_listare1 cbuton3 = but_modifica1 cbuton4 = but_sterge1;but_reface1 cbuton7 = cbuton8 = but_nou1;but_copiaza1 cgridsortlist = chost = cpassword = cusername = DoCreate = .T. filtru_pretty = filtru_pretty_ro = filtru_pretty_ro_full = FontCharSet = 238 FontSize = 10 Height = 250 KeyPreview = .T. lactiv1 = .F. lactiv2 = .F. lactiv3 = .F. lactiv4 = .F. lactiv5 = .F. lactiv6 = .F. lactiv7 = .F. lactiv8 = .F. lhide = .F. Name = "_frmbase" nhandle = -1 nhwnd = 0 nselectate = 0 ShowTips = .T. TitleBar = 0 Width = 375 WindowType = 1 _memberdata = * ADD OBJECT '_shape1' AS _shape WITH ; BackColor = 0,64,128, ; BorderColor = 128,128,128, ; Height = 29, ; Left = 0, ; Name = "_shape1", ; Top = 0, ; Width = 377, ; ZOrderSet = 0 *< END OBJECT: ClassLib="_baza.vcx" BaseClass="shape" /> ADD OBJECT '_shape2' AS _shape WITH ; BackColor = 255,255,255, ; Height = 29, ; Left = 322, ; Name = "_shape2", ; Top = 0, ; Visible = .F., ; Width = 52, ; ZOrderSet = 1 *< END OBJECT: ClassLib="_baza.vcx" BaseClass="shape" /> ADD OBJECT 'BUT_TERMIN1' AS but_termin WITH ; Left = 342, ; Name = "BUT_TERMIN1", ; Top = 1 *< END OBJECT: ClassLib="cmd_butoane.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Gridsort1' AS gridsort WITH ; Height = 17, ; Left = 9, ; Name = "Gridsort1", ; Top = 42, ; Width = 27 *< END OBJECT: ClassLib="gridsort.vcx" BaseClass="custom" /> ADD OBJECT 'Lb_titlu_alb_b121' AS lb_titlu_alb_b12 WITH ; Left = 6, ; Name = "Lb_titlu_alb_b121", ; Top = 6 *< END OBJECT: ClassLib="lb.vcx" BaseClass="label" /> PROCEDURE Activate *!* If This.BorderStyle= 3 *!* This.LockScreen=.T. *!* This.Left=10 *!* This.Top=10 *!* This.Height=_Screen.Height-50 *!* This.Width=_Screen.Width-100 *!* This.LockScreen=.F. *!* Endif *!* IF THIS.WindowState= 2 AND TYPE('this.resizer1')='O' *!* this.resizer1.onresize() *!* ENDIF If This.WindowState= 2 And Type('this.xresize1')='O' This.xresize1.rearrange() Endif ENDPROC PROCEDURE actualizeaza_drepturi && Actualizeaza drepturile de acces pe formular. If !Empty(gcAcces) && format gcAcces = [optiune1];[optiune2];...;[optiuneN]; && Local lcAcces,lnPozitieS,lnPozitieF,N lnPozitieS=1 For i=1 To Occurs([;],gcAcces) lnPozitieF=At([;],gcAcces,i) lcAcces=Substr(gcAcces,lnPozitieS,lnPozitieF-lnPozitieS) lcProp='thisform.lactiv'+Alltrim(lcAcces) If Type(lcProp)<>'U' &lcProp=.T. lcProp='thisform.cbuton'+Alltrim(lcAcces) If Type(lcProp)<>'U' And !Empty(&lcProp) && format lcButoane = [nume_buton1];[nume_buton2];...;[nume_butonN]; && lcButoane=&lcProp lnPS=1 lcButoane=Iif(Substr(lcButoane,Len(lcButoane)-1)=[;],lcButoane,lcButoane+[;]) For j=1 To Occurs([;],lcButoane) lnPF=At([;],lcButoane,j) lcButon=Substr(lcButoane,lnPS,lnPF-lnPS) lcProp='thisform.'+Alltrim(lcButon)+'.visible' lcProp1='!thisform.'+ALLTRIM(lcButon)+'.lvizibil' If Type(lcProp)<>'U' &lcProp=IIF(TYPE(lcProp1)<>'U' and &lcProp1,.F.,.T.) Endif lnPS=lnPF+1 Endfor Endif Endif lnPozitieS=lnPozitieF+1 Endfor Endif ENDPROC PROCEDURE actualizeaza_grid1 ENDPROC PROCEDURE actualizeaza_grid2 ENDPROC PROCEDURE aranjeaza_butoane *!* ordine : ENDPROC PROCEDURE do_adauga ENDPROC PROCEDURE do_cauta ENDPROC PROCEDURE do_copiaza ENDPROC PROCEDURE do_copie ENDPROC PROCEDURE do_deschide_tranzactie Local llReturn If Type('goExecutor')='O' goExecutor.oExecuta([select * from dual]) Endif lnSucces = SQLSetprop(gnHandle,"Transactions",2) If lnSucces < 0 amessagebox("Programul nu a reusit sa treaca pe tranzactie manuala! Reintrati in program si incercati din nou!",48,"Atentie") llReturn = .F. Else llReturn = .T. Endif Return llReturn ENDPROC PROCEDURE do_deselectall ENDPROC PROCEDURE do_excel ENDPROC PROCEDURE do_executa ENDPROC PROCEDURE do_help ENDPROC PROCEDURE do_inchide_tranzactie Lparameters tnTip Local llReturn,lnSucces,lcExplicatie If tnTip = 1 lnSucces = Sqlcommit(gnHandle) lcExplicatie = [COMMIT] Else lnSucces = Sqlrollback(gnHandle) lcExplicatie = [ROLLBACK] Endif If lnSucces < 0 amessagebox("Eroare la "+lcExplicatie+"!",48,"Atentie") llReturn = .F. Else lnSucces = SQLSetprop(gnHandle,"Transactions",1) If lnSucces < 0 amessagebox('Programul nu a reusit sa treaca pe tranzactie automata. Iesiti din program si intrati din nou!',0+48,'Atentie!') llReturn = .F. Else llReturn = .T. Endif Endif Return llReturn ENDPROC PROCEDURE do_listare ENDPROC PROCEDURE do_login ENDPROC PROCEDURE do_logoff ENDPROC PROCEDURE do_modifica ENDPROC PROCEDURE do_precedent gnButon = 3 pnButon = 3 Buton = 3 pnIesire = 3 this.Release ENDPROC PROCEDURE do_reface ENDPROC PROCEDURE do_renunt IF this.inainte_de_do_renunt() gnButon = 2 pnButon = 2 Buton = 2 pnIesire = 2 IF !this.lhide this.Release ELSE this.Hide ENDIF ENDIF ENDPROC PROCEDURE do_reset THISFORM.filtru_pretty = "" THISFORM.filtru_pretty_ro = "" THISFORM.filtru_pretty_ro_full = "" IF TYPE("this.but_start_criterii1") = 'O' THISFORM.but_start_criterii1.TOOLTIPTEXT=THISFORM.filtru_pretty_ro THISFORM.but_start_criterii1.SETFOCUS THISFORM.but_start_criterii1.pornit = "nu" ENDIF THISFORM.do_cauta() THISFORM.REFRESH ENDPROC PROCEDURE do_salvare ENDPROC PROCEDURE do_selectall ENDPROC PROCEDURE do_sterge ENDPROC PROCEDURE do_termin IF this.inainte_de_do_termin() gnButon = 1 pnButon = 1 Buton = 1 pnIesire = 1 IF !this.lhide this.Release ELSE this.Hide ENDIF ENDIF ENDPROC PROCEDURE do_urmator ENDPROC PROCEDURE do_verifica ENDPROC PROCEDURE filtru_traducere LOCAL lcTraducere lcTraducere = "" FOR EACH ITEM IN THIS.CONTROLS *!* IF (LEFT(LOWER(ITEM.NAME),2) = "ck" OR LEFT(LOWER(ITEM.NAME),3) = "chk") AND PEMSTATUS(ITEM,"cTraducere",5) IF PEMSTATUS(ITEM,"cTraducere",5) IF LEFT(LOWER(ITEM.NAME),2) = "ck" OR LEFT(LOWER(ITEM.NAME),3) = "chk" && checkboxurile doar pentru bifat IF ITEM.value = 1 lcTraducere = IIF(!EMPTY(ITEM.cTraducere), lcTraducere + " (" + ITEM.cTraducere + ")", lcTraducere) ENDIF ELSE lcTraducere = IIF(!EMPTY(ITEM.cTraducere), lcTraducere + " (" + ITEM.cTraducere + ")", lcTraducere) ENDIF ENDIF ENDFOR RETURN lcTraducere ENDPROC PROCEDURE grid_sort Aevents( laEvents, 0 ) loHeader = laEvents[ 1 ] If Vartype( loHeader ) = 'O' If Type('this.gridsort1') = 'O' This.gridsort1.oColumnReference = loHeader.Parent loGrid=loHeader.Parent.Parent This.gridsort1.gridsort(loHeader.Parent) If !Pemstatus(loGrid,"oSortColumn",5) loGrid.AddProperty("oSortColumn",Null) Endif loGrid.oSortColumn = loHeader.Parent Endif Endif ENDPROC PROCEDURE grid_sort_bind *!* 20.05.2009 *!* marius.mutu *!* tratare caz pageframe1.page1.grid, this.grid1, thisform.grid1 Local lcListaGrid, lnGridCount, loGrid, lcGrid, i, j, loHeader LOCAL loEx as Exception lcListaGrid = Alltrim(This.cGridSortList) lcListaGrid = Strtran(lcListaGrid, ',', ';') lnGridCount = Getwordcount(lcListaGrid, ';') For i = 1 To lnGridCount lcGrid = Getwordnum(lcListaGrid, i, ';') && ex: grid1 sau thisform.pageframe1.page1.grid1 If LEFT(LOWER(lcGrid),4) <> 'this' lcGrid = 'this.' + lcGrid ENDIF TRY loGrid = &lcGrid If !Pemstatus(loGrid,'name',5) Loop ENDIF For j = 1 To loGrid.ColumnCount loHeader = loGrid.Columns(j).Header1 Bindevent(loHeader, "DblClick", This, "grid_sort") ENDFOR CATCH TO loEx MESSAGEBOX(loEx.Message,0+16,_screen.Caption) ENDTRY Endfor ENDPROC PROCEDURE inainte_de_do_copie If This.lactiv3 This.do_copie() Endif ENDPROC PROCEDURE inainte_de_do_excel If This.lactiv1 This.do_excel() Endif ENDPROC PROCEDURE inainte_de_do_listare If This.lactiv2 This.do_listare Endif ENDPROC PROCEDURE inainte_de_do_modifica If This.lactiv3 This.do_modifica() Endif ENDPROC PROCEDURE inainte_de_do_reface If This.lactiv4 This.do_reface Endif ENDPROC PROCEDURE inainte_de_do_renunt RETURN .T. ENDPROC PROCEDURE inainte_de_do_sterge If This.lactiv4 This.do_sterge() Endif ENDPROC PROCEDURE inainte_de_do_termin RETURN .T. ENDPROC PROCEDURE Init Local lnFontSizePlus, lcFontName DODEFAULT() Declare ReleaseCapture In "user32" Declare Integer GetCapture In "user32" Declare Integer SetCapture In "user32"; INTEGER HWnd Declare Long SendMessage In "user32"; LONG HWnd, Long wMsg, Long wParam, Long Lparam If Version(5) < 700 *-- Need to get the forms window handle Else This.nHwnd = This.HWnd Endif This.actualizeaza_drepturi this.grid_sort_bind() *!* Locale IF TYPE('goLocale') = 'O' AND TYPE('glTraducere') = 'L' IF glTraducere golocale.SetLocale( thisform ) ENDIF ENDIF *!* Locale ^ * Reajustez dimensiunea fontului salvat in settings.ini lnFontSizePlus = INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) lcFontName = goApp.ReadIni('INTERFATA', 'FONTNAME') This.SetFont(This, m.lnFontSizePlus, m.lcFontName) ENDPROC PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl LOCAL lbviz Local lnResizeFont lbviz=THIS.bvizualizare DO CASE CASE nKeyCode=27 AND nShiftAltCtrl=0 NODEFAULT IF aMessagebox("Sunteti sigur ca doriti sa inchideti fereastra?",4+32+256,"Confirmare")==6 THIS.do_renunt() ENDIF CASE nKeyCode=5 AND nShiftAltCtrl=2 AND lbviz=.F. NODEFAULT IF PEMSTATUS(THIS,"inainte_de_do_excel",5) THIS.inainte_de_do_excel() ENDIF CASE nKeyCode=14 AND nShiftAltCtrl=2 AND lbviz=.F. && CTRL + N NODEFAULT IF PEMSTATUS(THIS,"do_adauga",5) THIS.do_adauga() ENDIF CASE nKeyCode=11 AND nShiftAltCtrl=2 AND lbviz=.F. && CTRL + K NODEFAULT IF PEMSTATUS(THIS,"do_copie",5) THIS.do_copie() ENDIF CASE nKeyCode=13 AND nShiftAltCtrl=2 AND lbviz=.F. && CTRL + M NODEFAULT IF PEMSTATUS(THIS,"inainte_de_do_modifica",5) THIS.inainte_de_do_modifica() ENDIF CASE nKeyCode=4 AND nShiftAltCtrl=2 AND lbviz=.F. && CTRL + D NODEFAULT IF PEMSTATUS(THIS,"inainte_de_do_sterge",5) THIS.inainte_de_do_sterge() ENDIF CASE nKeyCode=6 AND nShiftAltCtrl=2 && CTRL + F NODEFAULT THIS.do_termin() CASE nKeyCode=16 AND nShiftAltCtrl=2 AND lbviz=.F. && CTRL + P NODEFAULT IF PEMSTATUS(THIS,"inainte_de_do_listare",5) THIS.inainte_de_do_listare() ENDIF *!* Criterii Selectie - Vasile Cristian 25.oct.2007 CASE nKeyCode = 17 AND nShiftAltCtrl=2 && CTRL + Q NODEFAULT IF TYPE('THIS.but_start_criterii1') = 'O' THIS.but_start_criterii1.CLICK() ENDIF CASE nKeyCode = 20 AND nShiftAltCtrl=2 && CTRL + T NODEFAULT IF TYPE('THIS.but_reset_criterii1') = 'O' THIS.but_reset_criterii1.CLICK() ENDIF CASE nKeyCode = 141 AND nShiftAltCtrl = 2 && CTRL+UP MARIRE FONT NODEFAULT THIS.ModifyFontSize(1) CASE nKeyCode = 145 AND nShiftAltCtrl = 2 && CTRL+DOWN MICSORARE FONT NODEFAULT THIS.ModifyFontSize(-1) CASE nKeyCode = 26 AND nShiftAltCtrl = 2 && CTRL+LEFT RESETARE FONT NODEFAULT lnResizeFont = -INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) THIS.ModifyFontSize(m.lnResizeFont) ENDCASE ENDPROC PROCEDURE modifyfontsize LPARAMETERS nResizeFont, cFontName Local lnFontSizePlus, lcFontName This.SetFont(This, m.nResizeFont) * Salvare dimensiune font in plus/minus in settings.ini lnFontSizePlus = INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) lnFontSizePlus = m.lnFontSizePlus + m.nResizeFont goApp.WriteIni('INTERFATA', 'FONTSIZEPLUS', m.lnFontSizePlus) ENDPROC PROCEDURE RightClick Local lnOptiune, lnResizeFont lnResizeFont = 0 lnOptiune = xmenu("Mareste dimensiune font (CTRL+SAGEATA SUS);Micsoreaza dimensiune font (CTRL+SAGEATA JOS);Reseteaza dimensiune (CTRL+SAGEATA STANGA)") If Empty(m.lnOptiune) Return ENDIF DO CASE CASE m.lnOptiune = 1 lnResizeFont = 1 CASE m.lnOptiune = 1 lnResizeFont = -1 OTHERWISE lnResizeFont = -INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) ENDCASE This.ModifyFontSize(m.lnResizeFont) ENDPROC PROCEDURE scrie_in_log Lparameters tcMesaj Do Case Case Type('goLog')='O' goLog.Log(tcMesaj,Program()) Case Type('poLog') = '0' poLog.Log(tcMesaj,Program()) Otherwise Return Endcase ENDPROC PROCEDURE setfont && * Call on the Font Handler to change the font for the\n* passed object. If there's an application object,\n* look for the Font Handler there. Otherwise, use\n* a public variable.\n Lparameters oTarget, lnResizeFont, lcFontName * Make sure we have a target If Vartype(oTarget) <> "O" Error 11 Return .F. ENDIF Local oFonts Do Case Case Type("goApp") = "O" And ; PEMSTATUS(goApp, "oFontHandler",5) If Vartype(goApp.oFontHandler) <> "O" * instantiate it goApp.oFontHandler = CREATEOBJECT("cusFontHandler") && Newobject("cusFontHandler", "Accessibility") Endif oFonts = goApp.oFontHandler Case Vartype(oFontHandler) <> "O" Release oFontHandler Public oFontHandler oFontHandler = CREATEOBJECT("cusFontHandler")&& Newobject("cusFontHandler", "Accessibility") oFonts = oFontHandler Otherwise * it already exists in the public variable oFonts = oFontHandler ENDCASE IF PEMSTATUS(oFonts,'ChangeFont',5) oFonts.ChangeFont(m.oTarget, m.lnResizeFont, m.lcFontName) ENDIF ENDPROC PROCEDURE Lb_titlu_alb_b121.MouseDown Lparameters nButton, nShift, nXCoord, nYCoord If nButton = 1 thisform.MouseIcon='HMOVE.CUR' thisform.MousePointer= 99 ReleaseCapture() SendMessage(Thisform.nHWND, 0x112, 0xF012, 0x0) thisform.MousePointer= 0 SendMessage(Thisform.nHWND, 0x202, 0x0, 0x0) Endif ENDPROC PROCEDURE _shape1.DblClick IF thisform.WindowState = 2 thisform.WindowState = 0 ELSE thisform.WindowState = 2 ENDIF ENDPROC PROCEDURE _shape1.MouseDown Lparameters nButton, nShift, nXCoord, nYCoord If nButton = 1 thisform.MouseIcon='HMOVE.CUR' thisform.MousePointer= 99 ReleaseCapture() SendMessage(Thisform.nHWND, 0x112, 0xF012, 0x0) thisform.MousePointer= 0 SendMessage(Thisform.nHWND, 0x202, 0x0, 0x0) Endif ENDPROC ENDDEFINE DEFINE CLASS _frmnotitle AS _form OF "_baza.vcx" *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: do_adauga *m: do_cauta *m: do_excel *m: do_executa *m: do_listare *m: do_login *m: do_logoff *m: do_modifica *m: do_renunt *m: do_reset *m: do_selectall *m: do_sterge *m: do_termin *m: inainte_de_do_renunt *m: inainte_de_do_termin *p: chost *p: cpassword *p: cusername *p: nhandle * * AlwaysOnTop = .T. AutoCenter = .T. BackColor = 255,255,255 BorderStyle = 1 chost = cpassword = cusername = DoCreate = .T. Height = 250 Name = "_frmnotitle" nhandle = -1 ShowTips = .T. TitleBar = 0 Width = 375 * PROCEDURE Activate *!* If This.BorderStyle= 3 *!* This.LockScreen=.T. *!* This.Left=10 *!* This.Top=10 *!* This.Height=_Screen.Height-50 *!* This.Width=_Screen.Width-100 *!* This.LockScreen=.F. *!* Endif IF THIS.WindowState= 2 AND TYPE('this.resizer1')='O' this.resizer1.onresize() ENDIF ENDPROC PROCEDURE do_adauga ENDPROC PROCEDURE do_cauta ENDPROC PROCEDURE do_excel ENDPROC PROCEDURE do_executa ENDPROC PROCEDURE do_listare ENDPROC PROCEDURE do_login ENDPROC PROCEDURE do_logoff ENDPROC PROCEDURE do_modifica ENDPROC PROCEDURE do_renunt IF this.inainte_de_do_renunt() this.Release ENDIF ENDPROC PROCEDURE do_reset ENDPROC PROCEDURE do_selectall ENDPROC PROCEDURE do_sterge ENDPROC PROCEDURE do_termin IF this.inainte_de_do_termin() this.Release ENDIF ENDPROC PROCEDURE inainte_de_do_renunt RETURN .T. ENDPROC PROCEDURE inainte_de_do_termin RETURN .T. ENDPROC ENDDEFINE DEFINE CLASS _pgfrmbase AS _pageframe OF "_baza.vcx" *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> * ErasePage = .T. Name = "_pgfrmbase" Page1.Name = "Page1" Page2.Name = "Page2" * ENDDEFINE DEFINE CLASS ffergen AS form *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> * *m: do_cauta *m: do_reset *m: filtru_traducere *m: modifyfontsize *m: setfont *p: filtru_pretty *p: filtru_pretty_ro *p: filtru_pretty_ro_full * * AlwaysOnTop = .T. Caption = "" Closable = .F. ControlBox = .F. DoCreate = .T. filtru_pretty = filtru_pretty_ro = filtru_pretty_ro_full = Height = 500 Left = 0 MaxButton = .F. MinButton = .F. Movable = .F. Name = "ffergen" Top = 0 Width = 800 * PROCEDURE do_cauta ENDPROC PROCEDURE do_reset ENDPROC PROCEDURE filtru_traducere LOCAL lcTraducere lcTraducere = "" FOR EACH ITEM IN THIS.CONTROLS *!* IF (LEFT(LOWER(ITEM.NAME),2) = "ck" OR LEFT(LOWER(ITEM.NAME),3) = "chk") AND PEMSTATUS(ITEM,"cTraducere",5) IF PEMSTATUS(ITEM,"cTraducere",5) IF LEFT(LOWER(ITEM.NAME),2) = "ck" OR LEFT(LOWER(ITEM.NAME),3) = "chk" && checkboxurile doar pentru bifat IF ITEM.value = 1 lcTraducere = IIF(!EMPTY(ITEM.cTraducere), lcTraducere + " (" + ITEM.cTraducere + ")", lcTraducere) ENDIF ELSE lcTraducere = IIF(!EMPTY(ITEM.cTraducere), lcTraducere + " (" + ITEM.cTraducere + ")", lcTraducere) ENDIF ENDIF ENDFOR RETURN lcTraducere ENDPROC PROCEDURE Init Local lnFontSizePlus *!* Locale IF TYPE('goLocale') = 'O' AND TYPE('glTraducere') = 'L' IF glTraducere golocale.SetLocale( thisform ) ENDIF ENDIF *!* Locale ^ * Reajustez dimensiunea fontului salvat in settings.ini lnFontSizePlus = INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) This.SetFont(This, m.lnFontSizePlus) ENDPROC PROCEDURE KeyPress Lparameters nKeyCode, nShiftAltCtrl Local lnResizeFont Do Case Case nKeyCode==-1 && F2 Quit Case nKeyCode = 141 And nShiftAltCtrl = 2 && CTRL+UP MARIRE FONT Nodefault This.ModifyFontSize(1) Case nKeyCode = 145 And nShiftAltCtrl = 2 && CTRL+DOWN MICSORARE FONT Nodefault This.ModifyFontSize(-1) Case nKeyCode = 26 And nShiftAltCtrl = 2 && CTRL+LEFT RESETARE FONT Nodefault lnResizeFont = -Int(Val(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) This.ModifyFontSize(m.lnResizeFont) Endcase ENDPROC PROCEDURE modifyfontsize LPARAMETERS nResizeFont Local lnFontSizePlus This.SetFont(This, m.nResizeFont) * Salvare dimensiune font in plus/minus in settings.ini lnFontSizePlus = INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) lnFontSizePlus = m.lnFontSizePlus + m.nResizeFont goApp.WriteIni('INTERFATA', 'FONTSIZEPLUS', m.lnFontSizePlus) ENDPROC PROCEDURE RightClick Local lnOptiune, lnResizeFont lnResizeFont = 0 lnOptiune = xmenu("Mareste dimensiune font (CTRL+SAGEATA SUS);Micsoreaza dimensiune font (CTRL+SAGEATA JOS);Reseteaza dimensiune (CTRL+SAGEATA STANGA)") If Empty(m.lnOptiune) Return ENDIF DO CASE CASE m.lnOptiune = 1 lnResizeFont = 1 CASE m.lnOptiune = 1 lnResizeFont = -1 OTHERWISE lnResizeFont = -INT(VAL(goApp.ReadIni('INTERFATA', 'FONTSIZEPLUS'))) ENDCASE This.ModifyFontSize(m.lnResizeFont) ENDPROC PROCEDURE setfont Lparameters oTarget, nResizeFont * Make sure we have a target If Vartype(oTarget) <> "O" Error 11 Return .F. ENDIF Local oFonts Do Case Case Type("goApp") = "O" And ; PEMSTATUS(goApp, "oFontHandler",5) If Vartype(goApp.oFontHandler) <> "O" * instantiate it goApp.oFontHandler = CREATEOBJECT("cusFontHandler") && Newobject("cusFontHandler", "Accessibility") Endif oFonts = goApp.oFontHandler Case Vartype(oFontHandler) <> "O" Release oFontHandler Public oFontHandler oFontHandler = CREATEOBJECT("cusFontHandler")&& Newobject("cusFontHandler", "Accessibility") oFonts = oFontHandler Otherwise * it already exists in the public variable oFonts = oFontHandler ENDCASE oFonts.ChangeFont(m.oTarget, m.nResizeFont) ENDPROC ENDDEFINE DEFINE CLASS formtermin AS _frmbase OF "_frm_base.vcx" *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> * DoCreate = .T. Name = "formtermin" WindowType = 1 _shape1.Name = "_shape1" _shape2.Name = "_shape2" Lb_titlu_alb_b121.FontName = "Segoe UI" Lb_titlu_alb_b121.FontSize = 14 Lb_titlu_alb_b121.Left = 6 Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" Lb_titlu_alb_b121.Top = 1 BUT_TERMIN1.Name = "BUT_TERMIN1" Gridsort1.Name = "Gridsort1" * ENDDEFINE DEFINE CLASS frm_gol AS _frmbase OF "_frm_base.vcx" *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="But_cautare1" UniqueID="" Timestamp="" /> *< OBJECTDATA: ObjPath="Gridb1" UniqueID="" Timestamp="" /> * *m: actualizare *m: adauga *m: dblclickgrid *m: rightclickgrid *m: sterge *p: ccriteriu *p: ccursor *p: cform && Numele formului , fara sufixul "frm_". Se foloseste adaugare,modificare *p: cprimarykey && Numele coloanei primary key - pentru repozitionare la modificare *p: cselect *p: ctabela && Numele tabelei din oracle *p: lpaginare && Specifica daca se va face paginare * * AutoCenter = .T. Caption = "Form" ccriteriu = .F. ccursor = .F. cform = [] cprimarykey = cselect = .F. ctabela = .F. DoCreate = .T. Height = 360 lpaginare = .F. Name = "frm_gol" Width = 500 WindowType = 1 _shape1.Anchor = 10 _shape1.Height = 29 _shape1.Left = 0 _shape1.Name = "_shape1" _shape1.Top = 0 _shape1.Width = 507 _shape2.Left = 444 _shape2.Name = "_shape2" _shape2.Top = 0 Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" BUT_TERMIN1.Anchor = 8 BUT_TERMIN1.Left = 468 BUT_TERMIN1.Name = "BUT_TERMIN1" BUT_TERMIN1.Top = 1 Gridsort1.Name = "Gridsort1" * ADD OBJECT 'But_cautare1' AS but_cautare WITH ; Anchor = 8, ; Height = 28, ; Left = 396, ; Name = "But_cautare1", ; Top = 36, ; Width = 31 *< END OBJECT: ClassLib="cmd_butoane.vcx" BaseClass="commandbutton" /> ADD OBJECT 'But_modifica1' AS but_modifica WITH ; Anchor = 8, ; Left = 414, ; Name = "But_modifica1", ; Top = 1, ; Visible = .T. *< END OBJECT: ClassLib="cmd_butoane.vcx" BaseClass="commandbutton" /> ADD OBJECT 'But_nou1' AS but_nou WITH ; Anchor = 8, ; Left = 385, ; Name = "But_nou1", ; Top = 1 *< END OBJECT: ClassLib="cmd_butoane.vcx" BaseClass="commandbutton" /> ADD OBJECT 'But_sterge1' AS but_sterge WITH ; Anchor = 8, ; Left = 441, ; Name = "But_sterge1", ; Top = 1, ; Visible = .T. *< END OBJECT: ClassLib="cmd_butoane.vcx" BaseClass="commandbutton" /> ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; Anchor = 130, ; Height = 29, ; Left = 48, ; Name = "Clb_tx_simplu1", ; TabIndex = 1, ; Top = 36, ; Width = 330, ; Text_simplu1.Anchor = 130, ; Text_simplu1.Height = 23, ; Text_simplu1.Left = 81, ; Text_simplu1.Name = "Text_simplu1", ; Text_simplu1.Top = 3, ; Text_simplu1.Width = 245, ; Lb_simplu1.Caption = "Nume set", ; Lb_simplu1.Height = 17, ; Lb_simplu1.Left = 8, ; Lb_simplu1.Name = "Lb_simplu1", ; Lb_simplu1.Top = 6, ; Lb_simplu1.Width = 56 *< END OBJECT: ClassLib="lb_tx.vcx" BaseClass="container" /> ADD OBJECT 'Gridb1' AS gridb WITH ; Anchor = 10, ; FontName = "Arial Narrow", ; Height = 224, ; Left = 36, ; Name = "Gridb1", ; RecordSource = "thisform.ccursor", ; Top = 84, ; Width = 389, ; COLUMN1.ControlSource = "", ; COLUMN1.FontName = "Arial Narrow", ; COLUMN1.Header1.FontName = "Arial Narrow", ; COLUMN1.Header1.Name = "Header1", ; COLUMN1.Name = "COLUMN1", ; COLUMN1.Text1.FontName = "Arial Narrow", ; COLUMN1.Text1.Name = "Text1" *< END OBJECT: ClassLib="baza.vcx" BaseClass="grid" /> PROCEDURE actualizare Local lnSucces save_grid(Thisform.gridb1) lnSucces = goExecutor.oExecute(Thisform.cselect , Thisform.ccursor) If lnSucces < 0 Messagebox(goExecutor.cEroare,0 + 48,[Eroare]) Endif restore_grid(Thisform.gridb1) ENDPROC PROCEDURE adauga ENDPROC PROCEDURE dblclickgrid this.do_modifica() ENDPROC PROCEDURE Destroy USE IN (SELECT(thisform.ccursor)) USE IN (SELECT("lorec")) ENDPROC PROCEDURE do_adauga Local lcPrimaryKey lcPrimaryKey = This.cprimarykey Private pniesire pniesire = 0 Select(This.ccursor) Scatter Name loRec Blank lcActiune = "INSERT" Do Adauga_Modifica_Inregistrare With This.cform,loRec,,lcActiune If pniesire = 1 This.actualizare() Select(This.ccursor) Go Bottom Else Select (This.ccursor) Locate For &lcPrimaryKey = loRec.&lcPrimaryKey If !Found() Go Top Endif Endif ENDPROC PROCEDURE do_cauta Local lcTextCautat, lcCriteriu, lcAux Select (Thisform.gridb1.RecordSource) lcTextCautat = Upper(Alltrim(Thisform.clb_tx_simplu1.text_simplu1.Value)) lcCriteriu = Thisform.ccriteriu lcAux = Left(Upper(Alltrim(&lcCriteriu)),Len(lcTextCautat)) Locate For Left(Upper(Alltrim(&lcCriteriu)),Len(lcTextCautat)) = lcTextCautat If !Found() Go Top Endif Thisform.gridb1.SetFocus() ENDPROC PROCEDURE do_modifica If Empty(This.cform) Messagebox([Completati proprietatea cForm]) Return Endif If Reccount(This.ccursor) > 0 Private pniesire pniesire = 0 Local lnRec, lcPrimaryKey lcPrimaryKey = This.cprimarykey pniesire = 0 Select(This.ccursor) lnRec = Recno() lcActiune = "UPDATE" Scatter Name loRec Do Adauga_Modifica_Inregistrare With Thisform.cform, loRec, loRec.&lcPrimaryKey, lcActiune If pniesire = 1 This.actualizare() Select(This.ccursor) Locate For &lcPrimaryKey = loRec.&lcPrimaryKey If !Found() Go Top Endif Else Select(This.ccursor) Go lnRec Endif This.gridb1.SetFocus() Endif ENDPROC PROCEDURE do_sterge If Empty(This.ctabela) Messagebox([Completati proprietatea cTabela],0 + 48,[Atentie]) && specifica numele tabelei Return Endif If Empty(This.cprimarykey) Messagebox([Completati proprietatea cPrimaryKey],0 + 48,[Atentie]) && specifica numele campului Id Return Endif LOCAL lcCriteriu lcCriteriu = this.ccriteriu SELECT (thisform.gridb1.RecordSource) If Messagebox([Doriti sa stergeti inregistrarea ] + CR + LF + ; ["] + ALLTRIM(&lccriteriu) + [" ?],4 + 32) = 7 Return Endif Local lnSucces, lcSql, lcPrimaryKey, lcTabela lcPrimaryKey = This.cprimarykey lcTabela = This.ctabela Select(This.ccursor) lcSql = [delete from ] + lcTabela + [ where ] + Alltrim(This.cprimarykey) + [=?&lcPrimaryKey] lnSucces = goExecutor.oExecute(lcSql) If lnSucces < 0 Messagebox(goExecutor.cEroare,0 + 48,[Eroare]) Endif This.actualizare() ENDPROC PROCEDURE Init DoDefault() This.gridb1.RecordSource = This.ccursor Local loGrid, loColumnTexti, i loGrid = Thisform.gridb1 For i = 1 To loGrid.ColumnCount loColumnTexti= loGrid.Columns(i).text1 Bindevent(loColumnTexti,"dblClick",This,"dblClickGrid") && default apeleaza do_modifica Bindevent(loColumnTexti,"rightClick",This,"rightClickGrid") && default nu apeleaza nimic Endfor ENDPROC PROCEDURE Load *!* thisform.cselect, thisform.ccursor trebuie setate in load si apelat dodefault() *!* this.cprimarykey, this.ccriteriu trebuie completate pt modificare/stergere si cautare *!* this.cform se foloseste pt apelarea adauga_modifica_sterge Local lnSucces If Empty(This.cselect) Messagebox([Completati proprietatea cSelect]) Return Endif If Empty(This.ccursor) Messagebox([Completati proprietatea cCursor]) Return Endif lnSucces = goExecutor.oExecute(Thisform.cselect , Thisform.ccursor) If lnSucces < 0 Messagebox(goExecutor.cEroare,0 + 48) Endif this.lactiv3 = .t. && pt do_modifica this.lactiv4 = .t. && pt do_sterge ENDPROC PROCEDURE rightclickgrid ENDPROC PROCEDURE sterge ENDPROC ENDDEFINE