commit 63f3828d5e787af9c7fa4221cf73584315dffc18 Author: Marius Mutu Date: Thu Jul 23 17:08:56 2026 +0300 Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored) Co-Authored-By: Claude Fable 5 Claude-Session: https://claude.ai/code/session_012P75yL9Fc9EcT33tMbuxcF diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bd517d1 --- /dev/null +++ b/.gitignore @@ -0,0 +1,105 @@ +# ============================================================================= +# Flux text FoxBin2Prg: git urmareste DOAR versiunile text .??2 (in arbore), +# nu binarele VFP. Binarele convertibile si indecsii regenerabili se ignora. +# SVN ramane sursa de adevar pentru binare (via global-ignores pe .??2). +# ============================================================================= + +# --- Binare VFP convertibile in text .??2 (ambele forme de caz) --- +*.vcx +*.VCX +*.vct +*.VCT +*.scx +*.SCX +*.sct +*.SCT +*.frx +*.FRX +*.frt +*.FRT +*.mnx +*.MNX +*.mnt +*.MNT +*.lbx +*.LBX +*.lbt +*.LBT +*.pjx +*.PJX +*.pjt +*.PJT +*.dbc +*.DBC +*.dct +*.DCT + +# --- Indecsi regenerabili (nu se transporta in .db2/.dc2) --- +*.cdx +*.CDX +*.dcx +*.DCX + +# --- Tabele .dbf convertite in .db2 (lista explicita; restul .dbf raman binare) --- +datemenu/Vechi/menu1.dbf +datemenu/Vechi/menu1.FPT +datemenu/Vechi/nom_meniu.dbf +datemenu/Vechi/refaceri.dbf +datemenu/Vechi/tabela_fisa_cont.dbf +datemenu/Vechi/tabela_fisa_cont.FPT +Grafice/DKCONTRL.DBF +Programe/Vechi/genhtml.dbf +Programe/Vechi/genhtml.fpt + +# --- Fisiere generate/compilate Visual FoxPro --- +*.fxp +*.FXP +*.mpr +*.MPR +*.mpx +*.MPX +*.qpx +*.QPX +*.vcr +*.VCR +*.src + +# --- Backup-uri si fisiere temporare create de editorul VFP --- +*.bak +*.BAK +*.TBK +*.tmp +*.TMP +*.err +*.ERR +*.Stats +*.stackdump + +# --- Executabile compilate --- +*.exe +*.EXE +*.PreARM + +# --- Stare locala / specifica masinii, nu proiectului --- +roaregistratura_ref.DBF +roaregistratura_ref.FPT +FOXUSER.DBF +FOXUSER.FPT +log.txt +LOG.txt +*.lnk +Thumbs.db +Desktop.ini +bash.exe.stackdump + +# --- Setari locale Claude Code (specifice masinii, nu proiectului) --- +.claude/ + +# --- Notite locale neversionate (credentiale, specifice masinii) --- +docs/local/ + +# --- Subversion (working copy paralela) --- +.svn/ + +# --- COMUN este gestionat separat, prin propriul sau git (romfast/comun.git) --- +COMUN/ diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..efae158 --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,25 @@ +# CLAUDE.md + +This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. + +## What this is + +ROAREGISTRATURA este aplicaÈ›ia VFP9 de **registratură** din suita ROA (ROA Romfast SRL), frate cu ROAGEST/ROACONT/ROAACNPRO din `D:\ROA`. Proiectul propriu este `roaRegistratura.pjx`; framework-ul partajat este subfolderul `COMUN\` (svn:external, comun tuturor aplicaÈ›iilor ROA). ConvenÈ›iile generale (build în VFP9 IDE, `.prg` = sursă / binare VFP editate prin fluxul text, changelog `changelog_roaRegistratura.txt`) sunt aceleaÈ™i ca la ROAGEST — vezi `D:\ROA\ROAGEST\CLAUDE.md` ca referință de suită. + +## Version control: git alongside SVN + +Git rulează în paralel cu SVN-ul legacy, nu îl înlocuieÈ™te. SVN rămâne sursa "vie" (mai ales pentru `COMUN/`), sincronizat manual către git. + +- Repo-ul principal (rădăcina acestui folder) e propriul lui `.git`, remote `git@gitea.romfast.ro:romfast/roaregistratura.git`. **Flux text FoxBin2Prg în-arbore**: git urmăreÈ™te DOAR versiunile text `.??2` (`.vc2`/`.sc2`/`.fr2`/`.mn2`/`.pj2`/`.db2`…) generate lângă binare; binarele VFP sunt git-ignored, iar SVN le ignoră pe cele text (global-ignores pe `.??2`). +- `COMUN/` are propriul `.git` separat, remote `git@gitea.romfast.ro:romfast/comun.git` — **acelaÈ™i repo partajat de toate aplicaÈ›iile ROA**. O modificare împinsă acolo afectează toate proiectele; fără `push --force` fără aprobare explicită. +- Refresh text înainte de orice căutare/editare/commit (È™i după orice sesiune VFP IDE): + +```powershell +& 'D:\ROA\UTIL\foxbin2prg\git_sync.ps1' -ProjectRoot 'D:\ROA\ROAREGISTRATURA' -DbfList @('datemenu\Vechi\*.dbf','Grafice\DKCONTRL.DBF','Programe\Vechi\genhtml.dbf','COMUN\clase\Locale\*.dbf','COMUN\datemenu\*.dbf','COMUN\datemenu\xold\*.dbf','COMUN\Drepturi utilizatori\*\*.dbf','COMUN\utile\GridExtras\gridextras.dbf','COMUN\utile\ListProperty\lproperty.dbf','COMUN\utile\hpdf\*.dbf','COMUN\utile\hpdf\ReportOutput\*.dbf') +``` + +- Editare cod în `.vcx`/`.scx`: editezi textul `.vc2`/`.sc2` (format poziÈ›ional, byte-preserving — nu Edit/Write UTF-8, doar PowerShell CP1252/raw bytes), apoi write-back cu `txt2vcx.ps1 -TextFile -ProjectRoot 'D:\ROA\ROAREGISTRATURA'`. `.frx/.mnx/.lbx/.pjx/.dbc/.dbf` rămân doar-citire (editare în IDE). Èšinte sub `COMUN\` cer `-AllowComun` + aprobare explicită. Detalii: `D:\ROA\UTIL\foxbin2prg\CLAUDE.md` È™i `COMUN\docs\flux-editare-vfp-text.md`. + +## Reguli de lucru si testare + +ÃŽnainte de orice modificare de cod sau testare, citeÈ™te `COMUN\docs\reguli_lucru.md` (obligatoriu — reguli de livrare, diff ca fiÈ™ier + aprobare înainte de write-back, convenÈ›ii per zonă). Fără commit fără review: Marius vede întâi diff-ul. diff --git a/Clase/Copy of ferestre_registratura.vc2 b/Clase/Copy of ferestre_registratura.vc2 new file mode 100644 index 0000000..46b43b2 --- /dev/null +++ b/Clase/Copy of ferestre_registratura.vc2 @@ -0,0 +1,6809 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="copy of ferestre_registratura.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +*< LIBCOMMENT: Application Wizard framework class library. /> +* +DEFINE CLASS ct_contracte AS _ctfrmbase OF "..\comun\clase\_ct_base.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="grid_contracte" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cNume.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cNume.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cDurata.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cDurata.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cNume_val.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cNume_val.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cNr_ctr.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cNr_ctr.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cData_ctr.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cData_ctr.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cValvaluta.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cValvaluta.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cTipc.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cTipc.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cValctva.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cValctva.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cSemnat.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cSemnat.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cIncetat.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cIncetat.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cInactiv.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.cInactiv.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column12.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column12.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column13.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column13.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column14.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column14.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column15.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column15.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column16.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column16.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column17.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column17.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column18.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column18.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column19.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column19.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column20.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_contracte.Column20.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_data_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="optIncetat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_valftva" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_valctva" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="optInactiv" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_listare1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_excel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_nume" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_nr_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_nume_val" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_tipc" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_reset1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_denumire_tip" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_istoric" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_aa" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou2" UniqueID="" Timestamp="" /> + + * + *m: do_adauga_act_aditional + *p: nireg + * + + * + BackColor = 255,255,255 + cgridsortlist = grid_contracte + Height = 362 + Name = "ct_contracte" + nireg = 0 + Width = 800 + Gridsort1.Name = "Gridsort1" + _ct_controller_keypress1.Name = "_ct_controller_keypress1" + * + + ADD OBJECT 'But_excel1' AS but_excel WITH ; + Left = 391, ; + Name = "But_excel1", ; + TabIndex = 18, ; + Top = 2, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_listare1' AS but_listare WITH ; + Left = 363, ; + Name = "But_listare1", ; + TabIndex = 17, ; + Top = 2, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 3, ; + Left = 306, ; + Name = "But_nou1", ; + Picture = ..\comun\grafice\nou_sus.bmp, ; + TabIndex = 14, ; + ToolTipText = "Adaugare contract (CTRL+N)", ; + Top = 2 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou2' AS but_nou WITH ; + caction = do_adauga_act_aditional, ; + Left = 391, ; + Name = "But_nou2", ; + ToolTipText = "Adaugare act aditional", ; + Top = 30 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 3, ; + Left = 335, ; + Name = "But_sterge1", ; + TabIndex = 15, ; + Top = 2, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'ck_aa' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Acte aditionale", ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,128, ; + Height = 18, ; + Left = 306, ; + Name = "ck_aa", ; + Top = 29, ; + Width = 78 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'Ck_data_ctr' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = data, ; + Caption = "Data ctr.", ; + FontName = "Arial Narrow", ; + Left = 113, ; + Name = "Ck_data_ctr", ; + TabIndex = 3, ; + tip = D, ; + Top = 10, ; + ZOrderSet = 32 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_denumire_tip' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = denumire_tip, ; + Caption = "Tip contract", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 113, ; + Name = "Ck_denumire_tip", ; + TabIndex = 7, ; + Top = 29, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'ck_istoric' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Istoric", ; + FontName = "Arial Narrow", ; + ForeColor = 0,128,0, ; + Height = 18, ; + Left = 306, ; + Name = "ck_istoric", ; + Top = 43, ; + Width = 43 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'Ck_nr_ctr' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = numar_aa, ; + Caption = "Nr. ctr.", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 63, ; + Name = "Ck_nr_ctr", ; + TabIndex = 2, ; + Top = 10, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_nume' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = denumire, ; + Caption = "Partener", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 8, ; + Name = "Ck_nume", ; + TabIndex = 1, ; + Top = 10, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_nume_val' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = nume_val, ; + Caption = "Valuta", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 8, ; + Name = "Ck_nume_val", ; + TabIndex = 5, ; + Top = 29, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_tipc' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = denumire_tip, ; + Caption = "Tip ctr.", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 63, ; + Name = "Ck_tipc", ; + TabIndex = 6, ; + Top = 29, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_valctva' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = valctva, ; + Caption = "Valoare ctr. (cu TVA)", ; + FontName = "Arial Narrow", ; + Left = 182, ; + mask = (get_mask(12,gnPa)), ; + Name = "Ck_valctva", ; + nrzec = (gnPa), ; + TabIndex = 8, ; + Top = 29, ; + ZOrderSet = 27 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'ck_valftva' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = valftva, ; + Caption = "Valoare ctr. (fara TVA)", ; + FontName = "Arial Narrow", ; + Left = 182, ; + mask = (get_mask(12,gnPa)), ; + Name = "ck_valftva", ; + nrzec = (gnPa), ; + TabIndex = 4, ; + Top = 10, ; + ZOrderSet = 27 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Anchor = 12, ; + Height = 27, ; + Left = 632, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 16, ; + Top = 331, ; + Width = 153, ; + Text_simplu1.ControlSource = "this.parent.parent.nIreg", ; + Text_simplu1.Height = 21, ; + Text_simplu1.Left = 76, ; + Text_simplu1.Name = "Text_simplu1", ; + Text_simplu1.ReadOnly = .T., ; + Text_simplu1.Top = 3, ; + Text_simplu1.Width = 72, ; + LB_SIMPLU1.Caption = "Inregistrari", ; + LB_SIMPLU1.Name = "LB_SIMPLU1" + *< END OBJECT: ClassLib="..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Anchor = 3, ; + Comment = "*:OnResize=LT", ; + Height = 23, ; + Left = 693, ; + Name = "Cmd_cauta1", ; + TabIndex = 9, ; + Top = 4, ; + Width = 67, ; + ZOrderSet = 20 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_reset1' AS cmd_reset WITH ; + Anchor = 3, ; + Comment = "*:OnResize=LT", ; + Height = 23, ; + Left = 693, ; + Name = "Cmd_reset1", ; + TabIndex = 13, ; + Top = 28, ; + Width = 67, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_contracte' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 20, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + GridLineColor = 192,192,192, ; + HeaderHeight = 38, ; + Height = 270, ; + HighlightStyle = 2, ; + Left = 8, ; + Name = "grid_contracte", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "cContracte", ; + TabIndex = 10, ; + Top = 59, ; + Width = 777, ; + Column1.ColumnOrder = 1, ; + Column1.ControlSource = "denumire", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "cNume", ; + Column1.ReadOnly = .T., ; + Column1.Width = 193, ; + Column2.ColumnOrder = 13, ; + Column2.ControlSource = "durata", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cDurata", ; + Column2.ReadOnly = .T., ; + Column2.Width = 43, ; + Column3.ColumnOrder = 10, ; + Column3.ControlSource = "nume_val", ; + Column3.FontName = "Arial Narrow", ; + Column3.Name = "cNume_val", ; + Column3.ReadOnly = .T., ; + Column3.Width = 63, ; + Column4.ColumnOrder = 2, ; + Column4.ControlSource = "iif(tip_istoric='A',numar_aa,numar)", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "cNr_ctr", ; + Column4.ReadOnly = .T., ; + Column4.Width = 48, ; + Column5.ColumnOrder = 3, ; + Column5.ControlSource = "data", ; + Column5.FontName = "Arial Narrow", ; + Column5.Format = "d", ; + Column5.Name = "cData_ctr", ; + Column5.ReadOnly = .T., ; + Column5.Width = 51, ; + Column6.ColumnOrder = 8, ; + Column6.ControlSource = "valftva", ; + Column6.FontName = "Arial Narrow", ; + Column6.Format = "rk", ; + Column6.InputMask = (get_mask(14,gnPA)), ; + Column6.Name = "cValvaluta", ; + Column6.ReadOnly = .T., ; + Column6.Width = 72, ; + Column7.ColumnOrder = 14, ; + Column7.ControlSource = "denumire_tip", ; + Column7.FontName = "Arial Narrow", ; + Column7.Name = "cTipc", ; + Column7.ReadOnly = .T., ; + Column7.Width = 170, ; + Column8.ColumnOrder = 9, ; + Column8.ControlSource = "valctva", ; + Column8.FontName = "Arial Narrow", ; + Column8.Format = "rk", ; + Column8.InputMask = (get_mask(14,gnPA)), ; + Column8.Name = "cValctva", ; + Column8.ReadOnly = .T., ; + Column8.Width = 73, ; + Column9.Alignment = 2, ; + Column9.ColumnOrder = 16, ; + Column9.ControlSource = "semnat", ; + Column9.FontName = "Arial Narrow", ; + Column9.Name = "cSemnat", ; + Column9.ReadOnly = .T., ; + Column9.Sparse = .F., ; + Column9.Width = 42, ; + Column10.Alignment = 2, ; + Column10.ColumnOrder = 17, ; + Column10.ControlSource = "abs(incetat-1)", ; + Column10.FontName = "Arial Narrow", ; + Column10.Name = "cIncetat", ; + Column10.ReadOnly = .T., ; + Column10.Sparse = .F., ; + Column10.Width = 52, ; + Column11.Alignment = 2, ; + Column11.ColumnOrder = 19, ; + Column11.ControlSource = "abs(inactiv-1)", ; + Column11.FontName = "Arial Narrow", ; + Column11.Name = "cInactiv", ; + Column11.ReadOnly = .T., ; + Column11.Sparse = .F., ; + Column11.Width = 29, ; + Column12.ColumnOrder = 7, ; + Column12.ControlSource = "descriere", ; + Column12.FontName = "Arial Narrow", ; + Column12.Name = "Column12", ; + Column12.ReadOnly = .T., ; + Column13.ColumnOrder = 15, ; + Column13.ControlSource = "selectie", ; + Column13.FontName = "Arial Narrow", ; + Column13.Name = "Column13", ; + Column13.ReadOnly = .T., ; + Column14.ColumnOrder = 5, ; + Column14.ControlSource = "numar_intern", ; + Column14.FontName = "Arial Narrow", ; + Column14.Name = "Column14", ; + Column14.ReadOnly = .T., ; + Column14.Width = 45, ; + Column15.ColumnOrder = 6, ; + Column15.ControlSource = "data_intern", ; + Column15.FontName = "Arial Narrow", ; + Column15.Name = "Column15", ; + Column15.ReadOnly = .T., ; + Column15.Width = 51, ; + Column16.ColumnOrder = 11, ; + Column16.ControlSource = "data_inceput", ; + Column16.FontName = "Arial Narrow", ; + Column16.Name = "Column16", ; + Column16.ReadOnly = .T., ; + Column16.Width = 50, ; + Column17.ColumnOrder = 12, ; + Column17.ControlSource = "data_sfarsit", ; + Column17.FontName = "Arial Narrow", ; + Column17.Name = "Column17", ; + Column17.ReadOnly = .T., ; + Column17.Width = 50, ; + Column18.ColumnOrder = 18, ; + Column18.ControlSource = "data_incetat", ; + Column18.FontName = "Arial Narrow", ; + Column18.Name = "Column18", ; + Column18.ReadOnly = .T., ; + Column18.Width = 47, ; + Column19.Alignment = 2, ; + Column19.ColumnOrder = 20, ; + Column19.ControlSource = "are_link", ; + Column19.FontName = "Arial Narrow", ; + Column19.Name = "Column19", ; + Column19.ReadOnly = .T., ; + Column19.Sparse = .F., ; + Column19.Width = 85, ; + Column20.ColumnOrder = 4, ; + Column20.ControlSource = "numar_ult_aa", ; + Column20.FontName = "Arial Narrow", ; + Column20.Name = "Column20", ; + Column20.ReadOnly = .T., ; + Column20.Width = 36 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_contracte.cData_ctr.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data contr.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cData_ctr.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cDurata.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Durata (Luni)", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cDurata.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cInactiv.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + Height = 17, ; + Left = 33, ; + Name = "Check1", ; + Top = 60, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'grid_contracte.cInactiv.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Activ", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cIncetat.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + Height = 17, ; + Left = 37, ; + Name = "Check1", ; + Top = 24, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'grid_contracte.cIncetat.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "In desfasurare", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cNr_ctr.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. contr.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cNr_ctr.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cNume.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Partener", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cNume.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cNume_val.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valuta", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cNume_val.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column12.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Descriere", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column12.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column13.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Modul de selectie", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column13.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column14.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. inreg.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column14.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column15.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data inreg.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column15.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column16.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data inceput", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column16.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column17.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data sfarsit", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column17.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column18.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data incetarii", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column18.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.Column19.Check1' AS checkbox WITH ; + Alignment = 2, ; + Caption = "", ; + Centered = .T., ; + FontName = "Arial Narrow", ; + Height = 17, ; + Left = 14, ; + Name = "Check1", ; + Top = 48, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'grid_contracte.Column19.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Atasamente", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + Picture = ..\grafice\attach.bmp + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column20.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Ultimul act ad.", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.Column20.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cSemnat.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + Height = 17, ; + Left = 46, ; + Name = "Check1", ; + ReadOnly = .T., ; + Top = 24, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'grid_contracte.cSemnat.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Semnat", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cTipc.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Tip contract", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cTipc.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cValctva.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare contract (cu TVA)", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cValctva.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_contracte.cValvaluta.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare contract (fara TVA)", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_contracte.cValvaluta.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'optInactiv' AS optiongroup WITH ; + Anchor = 3, ; + BackStyle = 0, ; + ButtonCount = 3, ; + Height = 49, ; + Left = 573, ; + Name = "optInactiv", ; + TabIndex = 12, ; + Top = 4, ; + Value = 1, ; + Width = 111, ; + Option1.BackStyle = 0, ; + Option1.Caption = "Contractele active", ; + Option1.FontName = "Arial Narrow", ; + Option1.Height = 18, ; + Option1.Left = 5, ; + Option1.Name = "Option1", ; + Option1.Top = 1, ; + Option1.Value = 1, ; + Option1.Width = 126, ; + Option2.BackStyle = 0, ; + Option2.Caption = "Contractele inactive", ; + Option2.FontName = "Arial Narrow", ; + Option2.Height = 18, ; + Option2.Left = 5, ; + Option2.Name = "Option2", ; + Option2.Top = 15, ; + Option2.Width = 99, ; + Option3.BackStyle = 0, ; + Option3.Caption = "Toate contractele", ; + Option3.FontName = "Arial Narrow", ; + Option3.Height = 18, ; + Option3.Left = 5, ; + Option3.Name = "Option3", ; + Option3.Top = 29, ; + Option3.Width = 100 + *< END OBJECT: BaseClass="optiongroup" /> + + ADD OBJECT 'optIncetat' AS optiongroup WITH ; + Anchor = 3, ; + BackStyle = 0, ; + ButtonCount = 3, ; + Height = 49, ; + Left = 435, ; + Name = "optIncetat", ; + TabIndex = 11, ; + Top = 4, ; + Value = 1, ; + Width = 134, ; + Option1.BackStyle = 0, ; + Option1.Caption = "Contractele in desfasurare", ; + Option1.FontName = "Arial Narrow", ; + Option1.Height = 18, ; + Option1.Left = 4, ; + Option1.Name = "Option1", ; + Option1.Top = 1, ; + Option1.Value = 1, ; + Option1.Width = 126, ; + Option2.BackStyle = 0, ; + Option2.Caption = "Contractele incetate", ; + Option2.FontName = "Arial Narrow", ; + Option2.Height = 18, ; + Option2.Left = 4, ; + Option2.Name = "Option2", ; + Option2.Top = 15, ; + Option2.Width = 99, ; + Option3.BackStyle = 0, ; + Option3.Caption = "Toate contractele", ; + Option3.FontName = "Arial Narrow", ; + Option3.Height = 18, ; + Option3.Left = 4, ; + Option3.Name = "Option3", ; + Option3.Top = 29, ; + Option3.Width = 87 + *< END OBJECT: BaseClass="optiongroup" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + + LOCAL lcFiltru + lcFiltru = pcFiltru + IF EMPTY(lcFiltru) + lcFiltru = poCtr.ca_baza1.cfiltru + ENDIF + + save_grid_tag(THIS.grid_contracte) + poCtr.ca_baza1.cfiltru = lcFiltru + poCtr.ca_baza1.afisare() + + SELECT cContracte + IF RECCOUNT()>0 + THIS.nireg = RECCOUNT() + ELSE + THIS.nireg = 0 + ENDIF + + restore_grid_tag(THIS.grid_contracte) + IF RECCOUNT('cContracte')>0 + SELECT cContracte + LOCATE FOR id_ctr = goContract.id_ctr + IF !FOUND() + GO TOP + ENDIF + + THIS.grid_contracte.SETFOCUS() + ENDIF + + THIS.clb_tx_simplu1.text_simplu1.REFRESH + + ENDPROC + + PROCEDURE do_adauga + LOCAL lcAlias, lnId_ctr + lcAlias = THIS.grid_contracte.RECORDSOURCE + STORE 0 TO lnId_ctr + + lnId_ctr = adauga_contract(lcAlias) + + THIS.actualizeaza_grid1() + + + SELECT (lcAlias) + LOCATE FOR id_ctr = lnId_ctr + IF FOUND() + THIS.grid_contracte.SETFOCUS() + *this.grid_contracte.AfterRowColChange + + oprinc.pagefr1.page3.enabled = .T. + oprinc.pagefr1.ACTIVEPAGE = 3 + oprinc.pagefr1.page3.CLICK() + ENDIF + + + ***-------------------------- + + ENDPROC + + PROCEDURE do_adauga_act_aditional + Select cContracte + Scatter Name loRec Blank + + Do Adauga_Modifica_Inregistrare With 'actaditional',loRec,,"INSERT" In oproceduri_ams.prg + + this.do_cauta() + + + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru = "" + + If This.ck_nume.Value = 1 + lcFiltru = lcFiltru + This.ck_nume.filtru + Endif + + If This.ck_nr_ctr.Value = 1 + lcFiltru = lcFiltru + This.ck_nr_ctr.filtru + Endif + + If This.ck_data_ctr.Value = 1 + lcFiltru = lcFiltru + This.ck_data_ctr.filtru + Endif + + If This.ck_nume_val.Value = 1 + lcFiltru = lcFiltru + This.ck_nume_val.filtru + Endif + + If This.ck_denumire_tip.Value = 1 + lcFiltru = lcFiltru + This.ck_denumire_tip.filtru + Endif + + If This.ck_tipc.Value = 1 + lcFiltru = lcFiltru + This.ck_tipc.filtru + Endif + + If This.ck_valftva.Value=1 + lcFiltru = lcFiltru + This.ck_valftva.filtru + Endif + + If This.ck_valctva.Value=1 + lcFiltru = lcFiltru + This.ck_valctva.filtru + Endif + + Do Case + Case This.optIncetat.Value = 1 + lcFiltru = lcFiltru + [ and incetat = 0] + Case This.optIncetat.Value = 2 + lcFiltru = lcFiltru + [ and incetat = 1] + Case This.optIncetat.Value = 3 + lcFiltru = lcFiltru + [ and (incetat = 0 or incetat = 1)] + Endcase + + Do Case + Case This.optInactiv.Value = 1 && active + lcFiltru = lcFiltru + [ and inactiv = 0] + Case This.optInactiv.Value = 2 && inactive + lcFiltru = lcFiltru + [ and inactiv = 1] + Case This.optInactiv.Value = 3 && toate + lcFiltru = lcFiltru + [ and (inactiv = 0 or inactiv = 1)] + Endcase + + If This.ck_istoric.Value = 1 AND This.ck_aa.Value = 0 + lcFiltru = lcFiltru + [ and (tip_istoric = 'C' or tip_istoric = 'I')] + Endif + + If This.ck_aa.Value = 1 AND This.ck_istoric.Value = 0 + lcFiltru = lcFiltru + [ and (tip_istoric = 'C' or tip_istoric = 'A')] + ENDIF + + IF This.ck_istoric.Value = 0 AND This.ck_aa.Value = 0 + lcFiltru = lcFiltru + [ and tip_istoric = 'C'] + ENDIF + + IF This.ck_istoric.Value = 1 AND This.ck_aa.Value = 1 + lcFiltru = lcFiltru + [ and (tip_istoric = 'C' or tip_istoric = 'A' or tip_istoric = 'I')] + ENDIF + + + If !Empty(lcFiltru) + lcFiltru = Substr(lcFiltru,6) + Else + lcFiltru = [] + Endif + + This.actualizeaza_grid1(lcFiltru) + If Reccount('cContracte')=0 + Messagebox("Cautarea nu a intors rezultate!",0+48,"Info cautare") + + Select cContracte + Scatter Name goContract Memo Blank + Endif + This.grid_contracte.SetFocus() + + ENDPROC + + PROCEDURE do_reset + With This + For i=1 To .Objects.Count + If Upper(.Objects(i).BaseClass)='CHECKBOX' + .Objects(i).Value=0 + Endif + Endfor + ENDWITH + + this.optIncetat.Value=1 + this.optInactiv.Value=1 + + this.ck_nume.SetFocus() + + ENDPROC + + PROCEDURE inainte_de_do_excel + DO export_excel_grid WITH this.grid_contracte + + + ENDPROC + + PROCEDURE inainte_de_do_listare + *Thisform.AlwaysOnTop = .F. + + lcmenu="\0 + This.nireg = Reccount() + ELSE + This.nireg = 0 + ENDIF + + this.clb_tx_simplu1.text_simplu1.Refresh + ENDPROC + + PROCEDURE grid_contracte.AfterRowColChange + LPARAMETERS nColIndex + + LOCAL lcTabel + lcTabel = this.RecordSource + + SELECT (lcTabel) + SCATTER NAME goContract MEMO + ENDPROC + + PROCEDURE grid_contracte.cNume.Text1.RightClick + Local lcMenu, lnx + lcMenu = "Lista facturilor pentru contractul selectat" + lnx = xmenu(lcMenu) + + Do Case + Case lnx = 1 + llContract = .T. + Do Case + Case gnParametru_prog = 1 + Do lans_ireg_parteneri With .F., gcCont411, .T.,,,,,llContract + Case gnParametru_prog = 2 + Do lans_ireg_parteneri With .F.,'401', .F.,,,,,llContract + Endcase + Endcase + + ENDPROC + + PROCEDURE grid_contracte.Init + this.SetAll("DynamicBackColor","iif(inactiv=1,RGB(200,200,200),RGB(255,255,255))","Column") + this.SetAll("DynamicForeColor","iif(tip_istoric='I',RGB(0,128,0),IIF(tip_istoric='A',RGB(0,0,128),RGB(0,0,0)))","Column") + + ENDPROC + +ENDDEFINE + +DEFINE CLASS ct_date_generale AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="outlook2003bar1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="outlook2003bar1.Panes.Pane1.Olecontrol1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="outlook2003bar1.Panes.Pane1.Olecontrol2" UniqueID="" Timestamp="" /> + + * + BackColor = 255,255,255 + Height = 401 + Name = "ct_date_generale" + Width = 800 + * + + ADD OBJECT 'outlook2003bar1' AS outlook2003bar WITH ; + Anchor = 7, ; + Left = 5, ; + Name = "outlook2003bar1", ; + Top = 1, ; + Panes.ErasePage = .T., ; + Panes.Height = 328, ; + Panes.Name = "Panes", ; + Panes.PageCount = 7, ; + Panes.Pane1.Caption = "Date generale", ; + Panes.Pane1.Name = "Pane1", ; + Panes.Pane1.picture16 = Email Envelope 16.png, ; + Panes.Pane1.picture24 = Email Envelope 24.png, ; + Panes.Pane2.Caption = "Obiectul si valoarea contractului", ; + Panes.Pane2.Name = "Pane2", ; + Panes.Pane2.picture16 = Contacts 16.png, ; + Panes.Pane2.picture24 = Contacts 24.png, ; + Panes.Pane3.Caption = "Termene de facturare si achitare", ; + Panes.Pane3.Name = "Pane3", ; + Panes.Pane3.picture16 = Favourites 16.png, ; + Panes.Pane3.picture24 = Favourites 24.png, ; + Panes.Pane4.Caption = "Termene de livrare/receptie si garantii", ; + Panes.Pane4.Enabled = .F., ; + Panes.Pane4.Name = "Pane4", ; + Panes.Pane4.picture16 = Calendar Multiweek 16.png, ; + Panes.Pane4.picture24 = Calendar Multiweek 24.png, ; + Panes.Pane5.Caption = "Facturare", ; + Panes.Pane5.Name = "Pane5", ; + Panes.Pane5.picture16 = Games 16.png, ; + Panes.Pane5.picture24 = Games 24.png, ; + Panes.Pane6.Caption = "Clauze speciale si observatii", ; + Panes.Pane6.Name = "Pane6", ; + Panes.Pane6.picture16 = Help 2 16.png, ; + Panes.Pane6.picture24 = Help 2 24.png, ; + Panes.Pane7.Caption = "Documente atasate", ; + Panes.Pane7.Name = "Pane7", ; + Panes.Pane7.picture16 = Music Player 1 16.png, ; + Panes.Pane7.picture24 = Music Player 1 24.png, ; + Panes.Top = 33, ; + overflowpanel.MenuButton.imgPicture.Height = 16, ; + overflowpanel.MenuButton.imgPicture.Name = "imgPicture", ; + overflowpanel.MenuButton.imgPicture.Width = 16, ; + overflowpanel.MenuButton.Name = "MenuButton", ; + overflowpanel.Name = "overflowpanel", ; + SplitBar.imgSplitter.Height = 3, ; + SplitBar.imgSplitter.Name = "imgSplitter", ; + SplitBar.imgSplitter.Width = 35, ; + SplitBar.Name = "SplitBar", ; + Panel.Name = "Panel", ; + Splitter.Name = "Splitter", ; + Title.lblCaption.Name = "lblCaption", ; + Title.linBorder.Name = "linBorder", ; + Title.Name = "Title" + *< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" /> + + ADD OBJECT 'outlook2003bar1.Panes.Pane1.Olecontrol1' AS olecontrol WITH ; + Anchor = 15, ; + Height = 328, ; + Left = 0, ; + Name = "Olecontrol1", ; + Top = 0, ; + Width = 198 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7///8EAAAA/v///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAECFvJ3sxccBAwAAAIACAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAigAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAA8BAAAAAAAABwAAAAIAAAD+////BAAAAAUAAAAGAAAACQAAAAgAAAD+/////v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAAB3FAAA5iEAALE8wWoBAAYAIgAAAD0AMgCNAQAACAAAAHFIHwAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEBAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAaNYaADwAAAABAACADgAAAEhpZGVTZWxlY3Rpb24ABQAAAEwAAAAADAAAAEluZGVudGF0aW9uABEAAABODQAAAAcAAAAAAAAAAAAuQAoAAABMYWJlbEVkaXQACQAAAEkKAAAAAQAAAAoAAABMaW5lU3R5bGUACQAAAEkKAAAAAQAAAA0AAABNb3VzZVBvaW50ZXIACQAAAEkKAAAAAAAAAA4AAABQYXRoU2VwYXJhdG9yAAoAAABIAAAAAAEAAABcDAAAAE9MRURyYWdNb2RlAAkAAABJCgAAAAAAAAAMAAAAT0xFRHJvcE1vZGUACQAAAEkKAAAAAAAAAAwAAABCb3JkZXJTdHlsAAAFAEBKHwAGAAAAAAAAAAUAAIBs5xIAAQAAAFwAH97svQEABQCx5xIAA1LjC5GPzhGd4wCqAEu4UQEAAACQAURCAQAFQXJpYWxCAV0gWwB4AxUASMIaADUAbAB7AD0AYwBkAFIAJgBhAEYAIQBaAFoAdQBbAEwAfQAtADkAKwBlAAkAAABJCgAAAAAAAAAAJQB5AEkAeAA5AGoAXQB5AFUANgBgAHsAPQB0ADYAQQBzADIAWgB4AEoAMwBFAFUAKgA0AEMAXQB9AFcAdgBQAHQALABeAD8AVQBbACgAQwAoAHMAcABaAHUAYgBtAC4ANAAlAGIALgBDAHoAMgA9AHgAQwBYAFEAQABBACUAagBQAFAARQBlAC0AKwBtACgAXgBdAE8APQBxAEEAawBBAHMAYQB7AHEALgAhAE8ARABzAEMATgBYAFEAXgB9AEAAMgBbADQAPQBhAEUAMQBTAHYAawBCACgAVAAsAHMAaABtAFgAQwA/ACgAMwBYAFEAYABZAHcAQAA2AF8AQwB0AGUAJQBrAHoAWABeAG4AOABAAGoALQB6AGEAWABdAEgAdwBOAFMAVABxAE0AeABFAD0AQABZAD0AKQApAFcAJQBvACYAcwBpADIAZQA0AHsAJABhAD0ASQBNACUANgA/AGUAdgBhAGwANgB4AHUAcgB3AGMAQgBiAHUAdwAuACUAcgBwAFYAOQArAFQAbgBTAC0AbgAsAGUATABDAFYARgBvAGwAJgAhAGwAMABWAD8A" /> + + ADD OBJECT 'outlook2003bar1.Panes.Pane1.Olecontrol2' AS olecontrol WITH ; + Height = 150, ; + Name = "Olecontrol2", ; + Visible = .F., ; + Width = 200 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+////BQAAAAYAAAAHAAAACAAAAAkAAAAKAAAACwAAABYAAAANAAAADgAAAA8AAAAQAAAAEQAAABIAAAATAAAAFAAAABUAAAAEAAAAFwAAABgAAAD+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAECFvJ3sxccBAwAAAAABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMAAAADikAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAFcAAAAAAAAAAQAAAP7///8DAAAA/v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9cAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAJAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADkzNjgyNjVFLTg1RkUtMTFkMS04QkUzLTAwMDBGODc1NERBMSQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RQEAAIAMAAAASW1hZ2VIZWlnaHQACQAAAEkKAAAAEAAAAAsAAABJbWFnZVdpZHRoAAkAAABJCgAAABAAAAANAAAAVXNlTWFza0NvbG9yAAUAAABMAQAAAABJCgAAABgAAAALAAAASW1hZ2V3aWR0aAAJAAAASQoAAAAYAAAADQAAI38kLJGF0RGxagDA8Cg2KCFDNBIIAAAA7QMAAO0DAACAfuHmAAAGAAgAAAAQABAAwMDAAP//AAAB782rAAAFAOBLHwAGAAAA/////wUAAIAAAAAADAAAAAETAAAARABhAHQAZQBsAGUAIABjAG8AbgB0AHIAYQBjAHQAdQBsAHUAaQABEAAAAEMAYQBpAHgAYQAgAGQAZQAgAGUAbgB0AHIAYQBkAGEAAQ4AAABDAGEAaQB4AGEAIABkAGUAIABzAGEA7QBkAGEAAQ4AAABJAHQAZQBuAHMAIABlAG4AdgBpAGEAZABvAHMAAQ8AAABJAHQAZQBuAHMAIABlAHgAY///5I50/+3h/+bU/tjE/cy2/sSr67+yT6rnA7P/D5H+XpTShn98qKio4ODg+/v7////55N4/MWq+7ma+8au/+LR/+jW8trTMdL1AMf/B7P+H474PHmsg4ODtra25eXl+/v79+Tf/fDj+97P8KOH85Ry/MCl/cCniMbMBNz+AMH/DK79I4/5SXighoaGubm56enp/////O3d//bs++nh8aB+/9/G/9vC+c65bNjkAtv/AL//JanwXozCcXN5jIyMxsbG/////////OjX/u/i+7uY/9S0/97D/+XL793ORt3xJdTzi6DITl7aID3ZX2B/qamp//////////38+eXa97OT/93G/+XK/+HE/+DB2eDYfrPMe4fvRGv/EUT/Hj3UtLS0/////////////v797rKg4o555peC8bik+9vI/9vGt3N2gJTwVXr/OGD+Xnbe3Nzc/////////////////////v39+enl7Lqs5J6K435e2aqhubvfg5btoazr3d/p+Pj4BwAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////f398/Pz6Ojo5+fn6+vr8fHx+Pj4/f39/////////////////////////v7+/Pz89PT01tbWsrKyqKiosrKyvb29y8vL2tra5eXl7+/v+fn5/v7+////////9/f34uLi2Lmt4LGhx56QsYBxn3ZqkHt1i4aFlZWVpaWlvr6+4ODg+fn5/////f39zdnhmqu2k46R/9/O//fs/u/i+9/O88Sx3aOQv4FvpnFjkoaCwsLC8fHx////9PT0VazcDrz+U6HC+tfH//Dl/dfI/tW9/9zA/+XL//Df+93Mp3tvuLi47u7u/v7+stHlFbLzHcv/dcTS/+bX//Pr/eTc/dG9/s+0/+LJ//jt/eTTr4R4u7u78PDw+/v7b7viEcT+Mcj2tc7I//Pp/uba/dC9/c22/cy1/cmy/smq/drFpH1wubm57+/v5+7zNrnrGMv/S8To693N//38/eDV/dfH/c+7/c+5/Myz/9a689HAf3yCsLCw6+vrvtrrL8n6INH/e8LV//Lm//z7/+ff/+jh/ePa/dfG/ciu/9zF39DCVpe1qqqq6Ojols3oO9j/Ndb+p8PF+e3p9erm89jO+NbK/drO/dnM/dfG/+PSzdvNZKrCqqqq5+fngcfoTeT/Rt3+qry75byo17OmyZyQxLa0/f///////////OznwdrOba7Gra2t6Ojods3tZvP/U9/7l+P2+f32//Hh9MKvzquh////////////8eHbuNfWdq3FsbGx6urqgs3ubOr8aer8atz3huX6z+7x+trJ2L60////////////9ePax9rae6rEwsLC8PDw9fr90Of2sNvwktLscsnrZdLypNfhybes8ufc8+PW4drS3MjA3uDdkrvV4uLi+Pj4/////////////////v7++Pz+4fD5gsTlhPT1gvT2cebxaafIq8bY1uTt+vr6/v7+////////////////////////////1en2h9Dud9jxcs3sz93m9fX1/v7+////////CAAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////////////////////////////////+vr67u7u6Ojo8fHx/Pz8/////////////////////v7++fn59/f3+vr6/v7+////7e3twsLCrKyswcHB4uLi8vLy+Pj4/f39////////9vb23d3dy8vL1dXV5+fn8vLy3J2K3KSIm3Bjh4eHqampwsLC2NjY8/Pz/////v7+y9rkfqnBg4ySk5OTrKyswL296IRj//jR+d+5qXFekW1jmXtzr6+v5+fn////9/f3Wa7dGr74JrHmQZC4YoCRjXl1+Jhw/ujB//DI/ezF/O3G2a+Qo6Oj5OTk////y97pFrX1KcX5Mdj/Kdn/SbHSw4p7/8Sb/du0/d63/uS9//PMyZp/p6en5ubm/v7+gcDjEsL9NMj3Ref/dcHM7LCL/7+W/Mqk/Mym/dGr/dav/+W+uoZwo6Oj5eXl+Pn5TrvpHMr/Pcz3Wuv6gM3S5sWj/8We/LuV+76Y+8Se/Mmj/9avx410o6Oj5OTk3OnxNcT1KNL/SdH2s8zBn8O8hL6+srSh+saf/LKM+7eS/riQ/bqU15J1ra2t6enpttfrPtX8NdX/VtX04+bU/8ur9cSns6yd1sCi/7aO/6B43KOGqsi9mYB6t7e37u7un9TrT+D+Rdv+cNr04tC89cq4/9bB08i6s7+z/6yB1YVuitDemPf3f5uovLy87+/vjs/tafL/Wub+ft35ydvT7NvQ//Ho3NjPmtTgn6uzjsjch9v0o9/tfaS1xMTE8vLyodXwadr0Z+b6Zdv2ct/6h+P2neLztubvvvb+vfn/vvX/seHwv+TsiKe61dXV+Pj4/f7+8Pj8zub1rNvwk9XubsjsYNHxXNj2bNz3f973lOH4td3uw+DusMfW7u7u/f39////////////////////////9fv9i9HuePj/dfr/XuL5iLDJvNLh8PP1/f39////////////////////////////////4fD5n9jwhdLtjMrn7e3t+vr6////////////CQAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////////v7+/Pz89/f37e3t5ubm5eXl5eXl6+vr9fX1+/v7/v7+////////////////////+Pj44+PjzMzMtbW1pqampKSkpaWlsLCwyMjI39/f9fX1////////////////////5N3ss6XFlnHApWvojmLBoGjgkWPHfW+Ni4CXsrKy6Ojo/////v7+9fX16Ojo6Ojot4Txs3H/tXb9vIP/vIH/vIL/t3r+s3H/mmLcmpqa4ODg////9/f31tbWr6+vqampqnXowIr/v4j/v4n/wIr/wIn/v4f/v4n/pW3nmpqa4ODg////ytznPq3gQKLLWYOcmmrYxZT/xJP/xpT/xpX/xZT/xJH/xJD/p3Dmmpqa4ODg/Pz8crvhGr74LtP/Ls/9i3rwzKD/y5//zaL/0qX/zqL/ypz/zZ7/rHjmmpqa4ODg6+/zLrXsHsD4Rt3+RuH/k4r40ar/0an/zqj6tpXexJ7w0ab/t5LkmmzOmpqa4ODguNboIcf8J8f7YtrwX+HympD51rP/2LL/oI63LC4tbGN3wKTgUVJSUTlto6Oj5OTkfMTmM9j/MdD+r9XQ0ryjq4jh3Lz/2rv+sqfBrrGtop2puaPSub20oYPDvb297+/vacXqROL/QNH6wOLd/8qt353A0an/6NL/49L0xbXXybHn2rn+xabqqYjP4eHh+/v7YdTzWu7/V9j7ydnS/9nI/+DNrYri1rP/7+D/79z/4sb/0ar/roHh4eDj+fn5////cczuZ+H3Z+H5iuXzoNvoueTwuebsqL/4s6P5uJn3oYblqI/F4N/h/Pz8////////+fz+4O/4tt3xlNXuasvuWtLzY9z4f9/3k9/2wuPxqMjb39/f9/f3/////////////////////////////f7+4/H6btjyev3/Wtr1l7bJytrl+vr6/v7+////////////////////////////////////wuP1kNXvmM3o8fHx+/v7////////////////////CgAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////////////////////+vr67Ozs4uLi6enp+Pj4/////////v7+/v7+/////////////////f39+vr6+/v76+vrv7+/oKCgs7Oz4ODg+Pj48vLy4uLi4ODg8PDw/Pz8/////v7+8fHx2tra1dXVfHR1STs/QUBCgYGBwsLC6urqzMzMn5+foKCgyMjI8fHx////+fn5tcnXkKOtkpKSp3Bz2IyRbkxRVlZXs7Ozvbu8W0lNPzY5WltcoaGh4+Pj////2uXrLKzmHrnyN5TAdX+V9KSmrGZqUlFToKCgrJWX2I6Vr3N5QTk7m5ub3d3d/f39hcHgFrj2LdD+LNb/Ksr5U63JY3aHXG6Ce31+kJGUxIiE5JaaYUVKr6+v4uLi8vT2PLbqGMD7QtX7R+D/RuD/Pun/TLDJYpOpQrjfUnuPaHR/iXuAeWJktra25eXlyd7sIsL5IMb7Udr6V+v/W+7/XfP/YbTDbJ+rVvb/Xff/VOD0VoihcGJop6en4+PjlMvnLNH/J87/cdHlqca6gMzPbOXsd8TOq4GJjJiheKiybsLGU6rAZ1lelpaW3d3ddMPnPNz/NNH9jNzm/9q8+cCh2r6mjp+cz3eB0G92ql5khFNYWENIOzM2nJyc4ODgZsjsTub/QtT8od7j8c67/865/82ysMG6nauzo4+XkG15f1ZgY0JGNy4xvLy87+/vY9b0Y/L/V9f4quvy4cu4/ujd/+rgvdfVhOX7gNnvhtXsgrzRgqKuc3Fz2dnZ+/v7ac7wbev7ZuT5c973h+T4nOHyvuTpwOvxv/T9v/X9p+T4suLwotbnsbKy5+fn////7/f7yuP0qtrwjc/sbcvtXdDyWdT1a9v4ft33leH3ruX34fL1nsjg19na9PT0/////////////////////f7+8fj8yOP0Zdv1d/z/bfT+WsLlmrjNwdfm+Pj4/f39////////////////////////////////rtzyhtPud9fvos3k8PDw+/v7////////////CwAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////////v7+9vb26+vr6Ojo6+vr8vLy+/v7////////////////////////////////////+vr639/fuLi4qqqqsLCwwcHB3d3d9PT0/v7+////////////////+/v77+/v6Ojo5dfS4rqpw5mIwJmHpIN2hIKBoqKiysrK5+fn9/f3/f39/////v7+7Ozsw8PDrKysuaii//To/+bU/+zd/uXS0Z+Jh3Vujo6OsLCw1tbW9fX1////+vr6iLzbPKraTYuqhZyn0+S4993J+eLS//Pj/+/c67idrXtolH11tbW16+vr////3ufuKLDsJtL/KND/jtDLgNZ258m344Fd7bmX/+vW/+zY/+TGzZJ6t7e37u7u/v7+mMfhFb/7OM/7Str8rta6v+ojfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAugEAABAAEADAwMAA//8AAAHvzasAAAUA4EsfAAYAAAD/////BQAAgAAAAAAMAAAAARMAAABEAGEAdABlAGwAZQAgAGMAbwBuAHQAcgBhAGMAdAB1AGwAdQBpAAEQAAAAQwBhAGkAeABhACAAZABlACAAZQBuAHQAcgBhAGQAYQABDgAAAEMAYQBpAHgAYQAgAGQAZQAgAHMAYQDtAGQAYQABDgAAAEkAdABlAG4AcwAgAGUAbgB2AGkAYQBkAG8AcwABDwAAAEkAdABlAG4AcwAgAGUAeABjAGwAdQDtAGQAbwBzAAEJAAAAUgBhAHMAYwB1AG4AaABvAHMAASEAAABPAGIAaQBlAGMAdAB1AGwAIABzAGkAIAB2AGEAbABvAGEAcgBlAGEAIABjAG8AbgB0AHIAYQBjAHQAdQBsAHUAaQABIAAAAFQAZQByAG0AZQBuAGUAIABkAGUAIABmAGEAYwB0AHUAcgBhAHIAZQAgAHMAaQAgAGEAYwBoAGkAdABhAHIAZQABBQAAAEoAbwBnAG8AcwABBwAAAE0A+gBzAGkAYwBhAHMAAQUAAABGAG8AdABvAHMAAQYAAABWAO0AZABlAG8AcwAMAAAAAQAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////////+/v77u7u5ubm7Ozs9/f3/f39////////////////////////////////////////7e3twsLCp6ensrKyzMzM4+Pj8vLy+/v7////////////////////////////+/v715iH13NVrGtYi3JrjIyMpqamwMDA2NjY6+vr9/f3/f39////////////////8Ojm1WNE7ohj8Y9r4XpZuWhQlGldh399mJiYsrKyzMzM4+Pj8vLy+/v7/v7+////4bOo3GNA6YRf9aJ+9Jx385dy74pm0nJVpmVTi3JrjIyMpaWlw8PD4uLi+fn5/f392Ypz4G9L6IZi96+K9KaB9KJ99KB79J158pVw4X9dumlRlm1ij4aEu7u77e3t9e/t3XlZ5HxY6Ytm+LWN+rGI/LGJ+K2H9KeC9KWA9KN99J5575FssG5apqam5ubm683F5oJf6Ydh6ZFtsbmzqKmf0aiO66yI97WO9bGL9a2I9KmE9qyHx39kp6en5ubm5bSn7JRv7I9p6pdyr93egub5e8ncia6236+P+8Ka97yW9reS97aRxIxzq6ur6Ojo4aKP8aR+7pZw66WBt+Dfi9v0ddL1hd/1xKqU9q2F8rKM9bqU88CcwpR9ra2t6Ojo45yE9bKM8qB69biQjdbfjtHqs+f7oODzyLKc9raN8LON7qeC6bOQwZmDsLCw6enp6Z2B/MWe97SO9LKK3tG0xdjR3OfixeHk5dKy98ig8LWQ8bWP5rSRw52Hs7Oz6enp7bWl66WH7qWD75969qqC9a2E8bOM7cOg9s+o+dy1/Oa/+Nex59WzyqiSw8PD7u7u/////fn49d3X8dHH6bOh55+H6p1+7Jhz8aiD8KmD8K2I7bSO5NCx17Og4+Pj9/f3/////////////////////////fj27Lao+b+Y/caf+r+Z14Rnyayk6NTO+vr6/v7+/////////////////////////////PXz66mT66aI76aD37Gl7+/v/Pz8////////AgAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////////////////////v7++Pj46+vr5ubm7+/v+/v7/////////////////f399fX18vLy+Pj4/v7+/v7+8vLy1tbWs7OzpqamwMDA6enp/f39////////////8fHx0dHRwcHBz8/P4+Pj5eXltsC2WKZmVMx1T4ZXjY2NxcXF8fHx/v7+////+/v72rWrvH9ujn15jo6OpKSkjqKPN6pKR+lxVPSDUed+WnZdm5ub1tbW+Pj4////8Ovq1WZJ7odj5X1bwWZRaGxLEJcnMtdTO9xfRONsVPOCRr5jdn52uLi47u7u/v7+4LOn3GM/7Itn9p9795h1kIdEIooXDaggL9JOO9teReRtU/OCTZRZs7Oz7Ozs+/v72YVt4XFN6o1o+K+I9aaB/6GEqZZWB6gXIsk+MNNQO9xfQeFoQKBWxMTE9PT08+nm33lX5HxY6ZNu6bOS9a2F/7KOuKloELckGcEwJcpBK9pTW6ZGhYF3yMjI9vb26Ma96Ilk6YZh5Jl4kcTNmbi5wKmen6ZuI8g+DbgiFr0rGc4+cKtSoHlyxcXF9PT05K6e75x27ZNs6aaFrOnxeNz7dNPza7GiPshTLNJQJdVNFM09c65aqYF3xcXF8vLy46KN9KyF8p946LaVetHpldXwmuT9pMjMza+Bsbt8is1+jbNr0LKPr4t/ysrK9PT06J+G+8Kc9KuE9cCZttbMyeDgyuz0vNHP9sOd/bmW8qiF66eF4b6hrYl+0tLS9/f37bSj7KSE76WB76B796Z+77GM7LuZ8sij+tu0+du1+dmy6cyp3sOlvKGZ4eHh+/v7/////fr5+u3o78q/7b2t56GJ6JZ38aB78aeB8KmD8LGL37eY4bKW4NPQ9PT0/v7+/////////////////////////vv66qeP/MSe/MSe6pRxzLWv6NnV+vr6/v7+////////////////////////////////+Ofj8MOz7LWg5bir8/Pz/Pz8////////////AwAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////f398fHx2dnZycnJy8vLyMjItra2t7e32NjY9fX1/v7+////////////+fn57Ozs4ODgtL60bY5tb4Jveoh8RYlLQpBNeYF6pKSk2NjY+Pj4/////////Pz85eXlu7u7gpmMGJkaKchEMcBMKqtALLhGVO2CR65gc3pzqqqq39/f+vr6////8fLyZbDXPaLYL4ViGsQqKM1EMtZTPN9iQuBoS+l3WvmLPo1KgICAsLCw4uLi/v7+rc/jFbn2JcD/IJ+RMNNJIcY7Isc9Lc9LNthZP95lSul0Ue19Q4NLh4eHv7+/+vr6W7jkFML8NcH8KKWTT+5zH8Q3E7onIcU6Ks5HM9VUPNxhSOhyTux6S4hSvr6+4OrwJr3zGcL7P8f8K6SqSdttOttVGsMsFr4rHcI1KMtDMdRQONtYOs1QUZhW2dnZr9ToJcv9IsX7WNj4S7DUJ5uiLLKaIrJcE7AmE70nF8AqHsAyNMVmR5GMqKio5ubmhMXlM9f/J8r9e9vo17qhuLawgam8S5i/JqtjLdFEIrBEUM+lffT1X6DDo6Oj4+PjaMHoROL/NM/9gdrn+d3G/8mr/8ilvJaLPKeYY9qzh+71lP//mfv7cbnNnqCg4ODgVc/zU+j/RNf+nNjf8r2j98++/97L1burftDtgN/+iOT5heL2ouzwh8zcoqWm4+PjXdn2aPT/Wtr5oez64NO/+dvN/+jd4sKyjdPkjN/1j9/0itjxsubshb3Sq62t6OjocdPxaeb5aOf7ceP6ddj1m9fku+Lnwd/mzvz+xvj+s+v4ruT0xeXsfarDv7+/7u7u7PT7yeX0tOHxhM3rcNXwYtT0XNb2beP8eNz3it32sOv6x+v24vT6jrnT39/f9/f3////////////////////8vj8z+b1c9Duefz/cfX/Zen8aazQscna1OHq+Pj4/v7+////////////////////////////xuP1e8/uct7zcdXuxNbi9PT0/f39////////BAAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA+/v77Ozs2dnZy8vLyMjIwsLCsLCwsrKy19fX9vb2/v7+////////////////////6enps7u0dY12aIFoan9rOn89K5U1d313o6Oj1tbW9fX1/v7+////////////////gbKGRctmPtViNM1SKL5BHbk0G8UyJI0uc3lzoKCgy8vL4+Pj7+/v+Pj4/f39////S89uW/yOTvF9PedqLtVOIsg8GL4tDrggHIUgenhyjIyMo6Ojubm5zc3N4ODg8fHxZuiNdveiYNd6a9F2QtBiLdFMFcAsF8k4HL88u7aI0J6Mq4x+koN9i4uLpaWl0dHRmO+2HaItcpZC/62Xl6lqHMdFQNJhZMFopcKN/+vb/+7c/+bT+dK73aGHrYt/v7+/gdmYPrpQpbN4/+zl06yDlK5u3MCX/tbE//fz//ry//Lo/uDP/tfA+syxu5OEyMjI0OTSbMR9y8ej//r1/+ze/+HUyLm/lqrB+O7m9OHZ/NbE/+HP/+zc8ci0r5+Y19fX////6e7n5trI//jx2tDPd6fJQKXgP6fiZqHJWZrGqbK9//bm//fs2rCdsaWg4+Pj/////OHZ8dnSlLjOXLfjVsX4Xsf4XMX2UsD3Tb/4Uarc1c3N///4y6GRurOx7e3t/////fbzhavFT7nnZcnxZMXtZcfwZMfxYcXxYcXyWsn5d7bY+OTbwqedzs7O9vb2////////6/L2abTYb8vre9r2c9Lxb83vbMzvasrvZ8jvV8Dtl6q70buz6+vr/f39////////////6fL3crfYedPtiOX4huP4hOL5geD4cM3sVabOpLjH7+/v/Pz8////////////////////6/P4drvZg9vtk+35i+X1b8Tib6HA1dvf+Pj4/v7+////////////////////////////6vL3erzYgNXna7PRnrjJ7Ozs/Pz8////////////////////////////////////////0ePujbnVxNfj9fX1/f39////////////////////BQAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////+fn54+PjxcXFr6+vpKSkpaWlsrKyv7+/u7u7qqqqoaGho6OjtLS02NjY9vb2/Pz84+PjwZiNv4VwyYVrx4xyso98knJpl29lu11ExmhNxnNZuGtWhnh1qamp4ODg9PLx14t19KB7+riS+8Ga/+O7+ty15H9b3Fg16HhU+6WA/aR+/Jp2wWtShYSEwsLC6MO57YFd8KJ9+ryW8qaA/dCq8beR4mtH6nVR+a6I8JFt4WdE9I5q+ZVxlmtfrKys57Gf6YBb65Zx97aQ7ZZx+8qj7a2H5GlG9JFs/cag6Yhj6HFO631a+p14vG5Yo6Oj5a6c53tW6o5q9a+J54Ne+MCZ6qJ9739b+6mE/NKs/ceh9aB764Rg8o5qx3ZcpaWl5Kua5XVQ6Ilk9KuF4GxJ87SO6Zt37o5p/cWe/d+4/dCq+LiS86yG7pdzxXBWsbGx5KiX5nZS43lV8Z143WM/6JJs5Y5q5oRf/uG6/uvE/d62/dCq8amE76WAuntmyMjI4aKR53ZS53dT75Zy9rqV9s6o77mU6Jdy/vHJ//3V/u/I/d63+MOd9KuGvJ2U5ubm4aOS8IVh/bGM+rWQ+biS+8ag/+C5+sym9LmT/daw//nR//rT/dy21ZmF4+Pj+vr65JmC+K6J5oBc425J6G5M8YFd9Ypm8Ypm9pp2z3JVxYh03aaR6MK08fHx+/v7////6KqP5X9b1kon31876HBP8YVh9Ytn5WpH7HxXsW1asLCw6+vr////////////////6qaM+JZy4GE+3l065GdF7XlV8IJe6n1Z+Z14vXVgwsLC8vLy////////////////7LWh/a6J+ZVx8Y1p741o8Zp1+LOM/baR+6WAw5KE4+Pj+/v7////////////////+/Px7LGY+aeD+qB7/76Y/9Ks/smi+K6K2ZaD5ePj+fn5////////////////////////////9NbL8ce07K6U5qSM5rel6c/H9vb2/f39////////////////////////BgAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////f395ubmuLi4nZ2do6OjtbW1yMjI2dnZ5eXl8PDw+Pj4/f39////////////////9PT04LSe7bSUzKCHspB9koV9jImGlZWVp6enu7u7zc3N3d3d6+vr+Pj4/v7+/v7+59HI9cKq/////vj1/ObZ+tbA5byiyJyCpoR1kIJ8jIqJmpqaubm54+Pj+/v7+vr6462Y/fPu//Pv/uff/////////u/q+7ed+q+S96eH3pl9wpF6oJuZ19fX+vr68enm7LGb//////fy/NLC/Mq4/NDB+7ih+7GX+7ii+7ig+7mj+8Cev7Sr5eXl/f395r+x9tDC//n1/dvN/vDq//r2//Dq/7ie/KaH+qWH+7qj+9XFyquX0dDP+Pj4////4qWR+uHX//rz/t7Q/M28/Mu59sOw3p6H+7ad/8Om/+jf676ks6yo5+fn/v7+////4JeA/vHo/uHR/dfG/ure//nx0b+2Qk5hdqbYgLnt8OHbyJd8u7u77+/v/////7X1y7rgkGvuiGTBn2Hf8MP/5866hXLNzc34+Pj3+PhSt+Ubyf9E0vlo5Pfl3cXz6NLUu6tOlc6EdXFVklOI04jlv66ZjovX19f8/PzR4+4wxvcnz/9X1vTCzr386d391cOqj4YngsIlSmEkZ6LUw7ShsLWPkpTU1NT6+vqo0eg61v401P9n2vLw2b/67eTvuaPym3rTmIGjcl16amz0zLePy9KAk57S0tL5+fmFyehQ5P9J3P6H4vLw07v/8+r449f70r3/yaz/xqr/vaDk08GP1eGDlqLU1NT6+vp4zO1n8v9c4fyi8fza3c763cv/6Nnl0L2+zsywwcfD09O519ma1uSJm6Xa2tr8/PyBz+907/tp6vxy3veB4Pig5vTK7e3D6+6y9f+19P+o6vyx4e6h0uOqs7jm5ub+/v7v9/vZ7PfH5vOt2vCg2u+Azexiye9w3fmD6/uI5vqQ4Pe+3e2bxd7c3t/19fX////////////////////////////1+v140O98//9z+v9X1PObs8PM2+X6+vr+/v7////////////////////////////////K5/aI1O902fGNx+Tt7e36+vr///////////8MAAAAbHQAADYDAABCTTYDAAAAAAAANgAAACgAAAAQAAAAEAAAAAEAGAAAAAAAAAMAAAAAAAAAAAAAAAAAAAAAAAD////////////////////////////////8/Pzy8vLn5+fm5ubx8fH8/Pz////////////////+/v77+/v6+vr9/f3////+/v7s7OzGxsapqamnp6fCwsLn5+f7+/v////////////29vbg4ODT09Pd3d3t7e3x8fGVlJVaUFNjTVFfW1yKioq4uLjj4+P6+vr////9/f3R2uCPqLeNkJKbm5u2trapp6cuKC2VgHLLspx5UFdbVFeIiIi+vr7v7+/////v8fNHruAawfsuqdpOi6hxgIlYZ3FfQzn/zKT/7sTYwqmWZmlyYWS7u7vu7u7///+01OcTuPcsy/wv1/8w0/410PUtbYpFKyTKkHT/2K7CrJR1UFNwX2HZ2dn4+Pj9/f1nvOUUxf8/zfhL4v9J4P9M7v80gpNFLCdHNzSAZlhMODpTUVadnZ3d3d38/Pzu8/U1vO8cyf5G0Pdd6PpZ7P9i/f87g5OcZFDfl3ZXOTMyRkxMnbyIjI7Nzc339/fE3OwvzPslzf9X0fG9uqeVvrl93dtHfoiicV//w5bFeFxOeHt19f5xjp/IyMj19fWa0eo/2f401P9p1vD/17v/xqj2yKuHcWl7XVbwt5Kxc1lWjpOR8vJ0kaLJycn19fWDyOdR5f9I3v+H3O3vv6fxy7r/2MCfgXtsS01tUE1KMy9ZhYyl7O10kaLKysr19fV0zu5q9v9Y4v2L3vXewKr21cXh1c+NaGvswKHgq4xNNTNcg5Kq5Ox2k6TMzMz39/eJ0e9u5fhr6/xt3vh+4feQoqepaWvZqpr/8cbksZNlSEicw83B6O+GorTa2tr6+vr5/P7e8Pi02/Ch3/J2zexTmbRzip2MhIqXfXhubHF2orfY8fe+3u2/zNXu7u7+/v7////////////////////3/P7k8/pmxOZ26u118/ln6f+Irsa30OHz9PX8/Pz////////////////////////////////M5/eV2/J41/CN0Ons7Oz6+vr///////////8=" /> + + PROCEDURE outlook2003bar1.Panes.Pane1.Olecontrol1.Init + With This + .Imagelist = .Parent.oleControl2 + With .Nodes + Local laNos[12,3] + Store Null To laNos + laNos[1,1] = "Datele contractului" + laNos[2,1] = "Caixa de entrada" + laNos[3,1] = "Caixa de saída" + laNos[4,1] = "Itens enviados" + laNos[5,1] = "Itens excluídos" + laNos[6,1] = "Rascunhos" + laNos[7,1] = "Obiectul si valoarea contractului" + laNos[8,1] = "Termene de facturare si achitare" + laNos[9,1] = "Jogos" + laNos[10,1] = "Músicas" + laNos[11,1] = "Fotos" + laNos[12,1] = "Vídeos" + *!* Store laNos[1,1] To laNos[2,2], laNos[3,2], laNos[4,2], laNos[5,2], laNos[6,2] + *!* Store 4 To laNos[2,3], laNos[3,3], laNos[4,3], laNos[5,3], laNos[6,3] + *!* Local lnNo + *!* For lnNo=1 To Alen(laNos,1) + *!* .Add(laNos[lnNo,2],laNos[lnNo,3],laNos[lnNo,1],laNos[lnNo,1],laNos[lnNo,1]) + *!* Endfor + ENDWITH + + *!* Local loNo + *!* loNo = .Nodes(0) + *!* loNo.Expanded = .T. + *!* .SelectedItem = loNo + *!* loNo = Null + Endwith + ENDPROC + + PROCEDURE outlook2003bar1.Panes.Pane1.Olecontrol1.NodeClick + *** ActiveX Control Event *** + LPARAMETERS node + LOCAL TX + TX = THIS.SelectedItem.TEXT + MESSAGEBOX(tx) + ENDPROC + +ENDDEFINE + +DEFINE CLASS ct_part_nr_data AS container + *< CLASSDATA: Baseclass="container" 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="cmdDenumire" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtClient" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtNumar" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Line1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_actAd" UniqueID="" Timestamp="" /> + + * + *m: blocheaza_campuri + *m: deblocheaza_campuri + *p: llock + * + + * + BackColor = 255,255,255 + Height = 116 + llock = .T. + Name = "ct_part_nr_data" + Width = 600 + * + + ADD OBJECT 'cmdDenumire' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + Height = 22, ; + Left = 378, ; + Name = "cmdDenumire", ; + Picture = ..\grafice\find.bmp, ; + TabIndex = 2, ; + Top = 59, ; + Width = 29 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Command2' AS commandbutton WITH ; + Anchor = 3, ; + Caption = "Modifica", ; + FontBold = .T., ; + ForeColor = 0,0,255, ; + Height = 47, ; + Left = 9, ; + Name = "Command2", ; + Picture = ..\comun\grafice\lock.bmp, ; + SpecialEffect = 2, ; + TabIndex = 1, ; + Top = 3, ; + Width = 131 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Label3' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Partener", ; + Height = 17, ; + Left = 16, ; + Name = "Label3", ; + TabIndex = 6, ; + Top = 62, ; + Width = 49 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nr. contract ", ; + Height = 17, ; + Left = 16, ; + Name = "Label4", ; + TabIndex = 7, ; + Top = 84, ; + Width = 67 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data contract ", ; + Height = 17, ; + Left = 209, ; + Name = "Label9", ; + TabIndex = 8, ; + Top = 84, ; + Width = 77 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'lb_actAd' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nr. act ad.", ; + FontBold = .T., ; + FontSize = 8, ; + Height = 16, ; + Left = 16, ; + Name = "lb_actAd", ; + TabIndex = 8, ; + Top = 99, ; + Width = 55 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Line1' AS line WITH ; + Anchor = 11, ; + Height = 0, ; + Left = 0, ; + Name = "Line1", ; + Top = 53, ; + Width = 601 + *< END OBJECT: BaseClass="line" /> + + ADD OBJECT 'Shape1' AS shape WITH ; + BackStyle = 0, ; + Height = 57, ; + Left = 7, ; + Name = "Shape1", ; + SpecialEffect = 0, ; + Top = 57, ; + Width = 409 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'txtClient' AS textbox WITH ; + ControlSource = "goContract.denumire", ; + Height = 21, ; + Left = 87, ; + Name = "txtClient", ; + ReadOnly = .T., ; + TabIndex = 5, ; + Top = 60, ; + Width = 289 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData_ctr' AS textbox WITH ; + ControlSource = "goContract.data", ; + Height = 21, ; + Left = 288, ; + Name = "txtData_ctr", ; + ReadOnly = .T., ; + TabIndex = 4, ; + Top = 82, ; + Width = 119 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtNumar' AS textbox WITH ; + ControlSource = "goContract.numar", ; + Format = "k", ; + Height = 21, ; + Left = 87, ; + Name = "txtNumar", ; + ReadOnly = .T., ; + TabIndex = 3, ; + Top = 82, ; + Width = 113 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE blocheaza_campuri + this.cmdDenumire.Enabled = .F. + this.txtNumar.ReadOnly = .T. + this.txtData_ctr.ReadOnly = .T. + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.cmdDenumire.Enabled = .T. + this.txtNumar.ReadOnly = .F. + this.txtData_ctr.ReadOnly = .F. + ENDPROC + + PROCEDURE cmdDenumire.Click + LOCAL lcIdTipPart, lcTitlu + STORE '' TO lcIdTipPart, lcTitlu + + * loCauta = caut_partener(lcIdTipPart, lcTitlu) + + DO CASE + CASE gnParametru_prog = 1 && contracte clienti + lcIdTipPart = [-1] + lcTitlu = 'Clienti' + lcLista = ['4111'] + lcContul = '4111' + CASE gnParametru_prog = 2 && contracte furnizori + lcIdTipPart = [-2] + lcTitlu = 'Furnizori' + lcLista = ['401','404'] + lcContul = '401' + ENDCASE + + lnIdTipPart = GetContIdTipPart(lcContul) + + + *!* IF !EMPTY(lcLista) + *!* lcSql = [select distinct c.cont as cont_part, c.explicatie as explic_cont, c.id_tip_part as tip ] + ; + *!* [from vcoresp_tip_cont c ] + ; + *!* [where c.cont in (] + lcLista + [) ] + *!* ENDIF + *!* lcCursor = 'xcont' + + *!* lnSucces = goExecutor.oExecute(lcSql,lcCursor) + *!* IF lnSucces < 0 + *!* aMessagebox('Eroare!',0+48, 'Atentie!') + *!* RETURN + *!* ENDIF + + + *!* SELECT xcont + *!* BROWSE + + *!* SELECT xcont + *!* LOCATE FOR VAL(cont_part) = VAL(lcContul) + *!* lcContul = cont_part + *!* lcTip = ALLTRIM(STR(tip)) + + locauta = CautPartenerContabilitate(GetHash([cTitlu=>] + lcTitlu + [??lAdaugCorespondente=>1??cTipuriParteneri=>] + ALLTRIM(STR(lnIdTipPart)))) + + IF buton = 2 + RETURN + ENDIF + + goContract.id_part = loCauta.id_part + goContract.denumire = loCauta.denumire + THIS.PARENT.txtClient.REFRESH + * THISFORM.pageframe1.page1.txtClient.REFRESH + + ENDPROC + + PROCEDURE Command2.Click + *!* If Alltrim(goContract.tip_istoric) <> 'C' && pentru istoric Acte aditionale, sa nu mai pot face modificari, doar vizualizari + *!* AMESSAGEBOX('Nu se poate modifica istoricul unui contract!',0+48,'Atentie!') + *!* Return + *!* Endif + + If This.Parent.lLock + AMESSAGEBOX('Toate modificarile au efect imediat! Nu puteti da renuntare!',0+48,'Atentie!') + + This.Picture = 'unlock.bmp' + This.Parent.lLock = .F. + This.Caption = 'Salveaza' + This.Parent.deblocheaza_campuri() + + ****** + If Type('podg_dg.but_termin1') <> 'U' + podg_dg.deblocheaza_campuri() + Endif + If Type('podg_ob.but_termin1') <> 'U' + podg_ob.deblocheaza_campuri() + Endif + If Type('podg_tf.but_termin1') <> 'U' + podg_tf.deblocheaza_campuri() + Endif + If Type('podg_link.but_termin1') <> 'U' + podg_link.deblocheaza_campuri() + Endif + If Type('podg_fact.but_termin1') <> 'U' + podg_fact.deblocheaza_campuri() + Endif + If Type('podg_tl.but_termin1') <> 'U' + podg_tl.deblocheaza_campuri() + Endif + *!* IF TYPE('podg_obs.but_termin1') <> 'U' + *!* podg_obs.but_termin1.CLICK() + *!* ENDIF + ****** + Else + If Type('podg_fact.but_termin1') <> 'U' + If (goContract.opt_facturare = 1 Or goContract.opt_facturare = 2) And (Empty(goContract.id_nota) Or Isnull(goContract.id_nota)) + AMESSAGEBOX('Alegeti nota contabila !',0+48) + Return + Endif + Endif + + + This.Picture = 'lock.bmp' + This.Parent.lLock = .T. + This.Caption = 'Modifica' + This.Parent.blocheaza_campuri() + + If Isnull(goContract.id_part) + AMESSAGEBOX('Alegeti partenerul!') + this.Parent.cmdDenumire.SetFocus() + RETURN + ENDIF + Do modifica_ctr_dg With goContract && In oproceduri_roacontracte.prg + + If Type('podg_dg.but_termin1') <> 'U' + podg_dg.blocheaza_campuri() + Endif + If Type('podg_ob.but_termin1') <> 'U' + podg_ob.blocheaza_campuri() + Endif + If Type('podg_tf.but_termin1') <> 'U' + podg_tf.blocheaza_campuri() + Endif + If Type('podg_link.but_termin1') <> 'U' + podg_link.blocheaza_campuri() + Endif + If Type('podg_fact.but_termin1') <> 'U' + podg_fact.blocheaza_campuri() + Endif + If Type('podg_tl.but_termin1') <> 'U' + podg_tl.blocheaza_campuri() + Endif + + Endif + + + + + + ENDPROC + + PROCEDURE Command2.Refresh + IF THIS.PARENT.lLock + THIS.PICTURE = 'lock.bmp' + THIS.CAPTION = 'Modifica' + ELSE + THIS.PICTURE = 'unlock.bmp' + THIS.CAPTION = 'Salveaza' + ENDIF + + + + + + ENDPROC + + PROCEDURE Label3.Init + DO CASE + CASE gnParametru_prog = 1 + THIS.CAPTION = 'Client' + CASE gnParametru_prog = 2 + THIS.CAPTION = 'Furnizor' + ENDCASE + + ENDPROC + +ENDDEFINE + +DEFINE CLASS ct_registratura AS _ctfrmbase OF "..\comun\clase\_ct_base.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="grid_registratura" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNume.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNume.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNr_ctr.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNr_ctr.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cData_ctr.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cData_ctr.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column12.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column12.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column14.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column14.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column15.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column15.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_data_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_listare1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_excel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_nume" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_nr_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_reset1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + + * + *p: nireg + * + + * + BackColor = 255,255,255 + cgridsortlist = grid_registratura + Height = 362 + Name = "ct_registratura" + nireg = 0 + Width = 800 + Gridsort1.Name = "Gridsort1" + _ct_controller_keypress1.Name = "_ct_controller_keypress1" + * + + ADD OBJECT 'But_excel1' AS but_excel WITH ; + Left = 391, ; + Name = "But_excel1", ; + TabIndex = 18, ; + Top = 2, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_listare1' AS but_listare WITH ; + Left = 363, ; + Name = "But_listare1", ; + TabIndex = 17, ; + Top = 2, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 3, ; + Left = 306, ; + Name = "But_nou1", ; + Picture = ..\comun\grafice\nou_sus.bmp, ; + TabIndex = 14, ; + ToolTipText = "Adaugare contract (CTRL+N)", ; + Top = 2 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 3, ; + Left = 335, ; + Name = "But_sterge1", ; + TabIndex = 15, ; + Top = 2, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Ck_data_ctr' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = data, ; + Caption = "Data ctr.", ; + FontName = "Arial Narrow", ; + Left = 113, ; + Name = "Ck_data_ctr", ; + TabIndex = 3, ; + tip = D, ; + Top = 10, ; + ZOrderSet = 32 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_nr_ctr' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = numar_aa, ; + Caption = "Nr. ctr.", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 63, ; + Name = "Ck_nr_ctr", ; + TabIndex = 2, ; + Top = 10, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_nume' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = denumire, ; + Caption = "Partener", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 8, ; + Name = "Ck_nume", ; + TabIndex = 1, ; + Top = 10, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Anchor = 12, ; + Height = 27, ; + Left = 632, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 16, ; + Top = 331, ; + Width = 153, ; + Text_simplu1.ControlSource = "this.parent.parent.nIreg", ; + Text_simplu1.Height = 21, ; + Text_simplu1.Left = 76, ; + Text_simplu1.Name = "Text_simplu1", ; + Text_simplu1.ReadOnly = .T., ; + Text_simplu1.Top = 3, ; + Text_simplu1.Width = 72, ; + LB_SIMPLU1.Caption = "Inregistrari", ; + LB_SIMPLU1.Name = "LB_SIMPLU1" + *< END OBJECT: ClassLib="..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Anchor = 3, ; + Comment = "*:OnResize=LT", ; + Height = 23, ; + Left = 693, ; + Name = "Cmd_cauta1", ; + TabIndex = 9, ; + Top = 4, ; + Width = 67, ; + ZOrderSet = 20 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_reset1' AS cmd_reset WITH ; + Anchor = 3, ; + Comment = "*:OnResize=LT", ; + Height = 23, ; + Left = 693, ; + Name = "Cmd_reset1", ; + TabIndex = 13, ; + Top = 28, ; + Width = 67, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_registratura' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 6, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + GridLineColor = 192,192,192, ; + HeaderHeight = 38, ; + Height = 270, ; + HighlightStyle = 2, ; + Left = 8, ; + Name = "grid_registratura", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "cRegistratura", ; + TabIndex = 10, ; + Top = 59, ; + Width = 777, ; + Column1.ColumnOrder = 1, ; + Column1.ControlSource = "denumire", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "cNume", ; + Column1.ReadOnly = .T., ; + Column1.Width = 193, ; + Column2.ColumnOrder = 2, ; + Column2.ControlSource = "numar", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cNr_ctr", ; + Column2.ReadOnly = .T., ; + Column2.Width = 48, ; + Column3.ColumnOrder = 3, ; + Column3.ControlSource = "data", ; + Column3.FontName = "Arial Narrow", ; + Column3.Format = "d", ; + Column3.Name = "cData_ctr", ; + Column3.ReadOnly = .T., ; + Column3.Width = 51, ; + Column4.ColumnOrder = 6, ; + Column4.ControlSource = "descriere", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "Column12", ; + Column4.ReadOnly = .T., ; + Column5.ColumnOrder = 4, ; + Column5.ControlSource = "numar_intern", ; + Column5.FontName = "Arial Narrow", ; + Column5.Name = "Column14", ; + Column5.ReadOnly = .T., ; + Column5.Width = 45, ; + Column6.ColumnOrder = 5, ; + Column6.ControlSource = "data_intern", ; + Column6.FontName = "Arial Narrow", ; + Column6.Name = "Column15", ; + Column6.ReadOnly = .T., ; + Column6.Width = 51 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_registratura.cData_ctr.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data contr.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cData_ctr.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNr_ctr.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. contr.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNr_ctr.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNume.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Partener", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNume.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column12.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Descriere", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column12.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column14.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. inreg.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column14.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column15.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data inreg.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column15.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + + LOCAL lcFiltru + lcFiltru = pcFiltru + IF EMPTY(lcFiltru) + lcFiltru = poReg.ca_baza1.cfiltru + ENDIF + + save_grid_tag(THIS.grid_registratura) + poReg.ca_baza1.cfiltru = lcFiltru + poReg.ca_baza1.afisare() + + SELECT cRegistratura + IF RECCOUNT()>0 + THIS.nireg = RECCOUNT() + ELSE + THIS.nireg = 0 + ENDIF + + restore_grid_tag(THIS.grid_registratura) + IF RECCOUNT('cRegistratura')>0 + SELECT cRegistratura + LOCATE FOR id_ctr = goRegistratura.id_reg + IF !FOUND() + GO TOP + ENDIF + + THIS.grid_registratura.SETFOCUS() + ENDIF + + THIS.clb_tx_simplu1.text_simplu1.REFRESH + + ENDPROC + + PROCEDURE do_adauga + LOCAL lcAlias, lnId_reg + lcAlias = THIS.grid_registratura.RECORDSOURCE + STORE 0 TO lnId_ctr + + lnId_reg = adauga_registratura(lcAlias) + + THIS.actualizeaza_grid1() + + + SELECT (lcAlias) + LOCATE FOR id_reg = lnId_reg + IF FOUND() + THIS.grid_registratura.SETFOCUS() + + oprinc.pagefr1.page3.enabled = .T. + oprinc.pagefr1.ACTIVEPAGE = 3 + oprinc.pagefr1.page3.CLICK() + ENDIF + + + ***-------------------------- + + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru = "" + + If This.ck_nume.Value = 1 + lcFiltru = lcFiltru + This.ck_nume.filtru + Endif + + If This.ck_nr_ctr.Value = 1 + lcFiltru = lcFiltru + This.ck_nr_ctr.filtru + Endif + + If This.ck_data_ctr.Value = 1 + lcFiltru = lcFiltru + This.ck_data_ctr.filtru + Endif + + If This.ck_nume_val.Value = 1 + lcFiltru = lcFiltru + This.ck_nume_val.filtru + Endif + + If This.ck_denumire_tip.Value = 1 + lcFiltru = lcFiltru + This.ck_denumire_tip.filtru + Endif + + If This.ck_tipc.Value = 1 + lcFiltru = lcFiltru + This.ck_tipc.filtru + Endif + + If This.ck_valftva.Value=1 + lcFiltru = lcFiltru + This.ck_valftva.filtru + Endif + + If This.ck_valctva.Value=1 + lcFiltru = lcFiltru + This.ck_valctva.filtru + Endif + + Do Case + Case This.optIncetat.Value = 1 + lcFiltru = lcFiltru + [ and incetat = 0] + Case This.optIncetat.Value = 2 + lcFiltru = lcFiltru + [ and incetat = 1] + Case This.optIncetat.Value = 3 + lcFiltru = lcFiltru + [ and (incetat = 0 or incetat = 1)] + Endcase + + Do Case + Case This.optInactiv.Value = 1 && active + lcFiltru = lcFiltru + [ and inactiv = 0] + Case This.optInactiv.Value = 2 && inactive + lcFiltru = lcFiltru + [ and inactiv = 1] + Case This.optInactiv.Value = 3 && toate + lcFiltru = lcFiltru + [ and (inactiv = 0 or inactiv = 1)] + Endcase + + If This.ck_istoric.Value = 1 AND This.ck_aa.Value = 0 + lcFiltru = lcFiltru + [ and (tip_istoric = 'C' or tip_istoric = 'I')] + Endif + + If This.ck_aa.Value = 1 AND This.ck_istoric.Value = 0 + lcFiltru = lcFiltru + [ and (tip_istoric = 'C' or tip_istoric = 'A')] + ENDIF + + IF This.ck_istoric.Value = 0 AND This.ck_aa.Value = 0 + lcFiltru = lcFiltru + [ and tip_istoric = 'C'] + ENDIF + + IF This.ck_istoric.Value = 1 AND This.ck_aa.Value = 1 + lcFiltru = lcFiltru + [ and (tip_istoric = 'C' or tip_istoric = 'A' or tip_istoric = 'I')] + ENDIF + + + If !Empty(lcFiltru) + lcFiltru = Substr(lcFiltru,6) + Else + lcFiltru = [] + Endif + + This.actualizeaza_grid1(lcFiltru) + If Reccount('cContracte')=0 + Messagebox("Cautarea nu a intors rezultate!",0+48,"Info cautare") + + Select cContracte + Scatter Name goContract Memo Blank + Endif + This.grid_contracte.SetFocus() + + ENDPROC + + PROCEDURE do_reset + With This + For i=1 To .Objects.Count + If Upper(.Objects(i).BaseClass)='CHECKBOX' + .Objects(i).Value=0 + Endif + Endfor + ENDWITH + + this.optIncetat.Value=1 + this.optInactiv.Value=1 + + this.ck_nume.SetFocus() + + ENDPROC + + PROCEDURE inainte_de_do_excel + DO export_excel_grid WITH this.grid_registratura + + + ENDPROC + + PROCEDURE inainte_de_do_listare + *Thisform.AlwaysOnTop = .F. + + lcmenu="\0 + This.nireg = Reccount() + ELSE + This.nireg = 0 + ENDIF + + this.clb_tx_simplu1.text_simplu1.Refresh + ENDPROC + + PROCEDURE grid_registratura.AfterRowColChange + LPARAMETERS nColIndex + + LOCAL lcTabel + lcTabel = this.RecordSource + + SELECT (lcTabel) + SCATTER NAME goRegistratura MEMO + ENDPROC + + PROCEDURE grid_registratura.cNume.Text1.RightClick + Local lcMenu, lnx + lcMenu = "Lista facturilor pentru contractul selectat" + lnx = xmenu(lcMenu) + + Do Case + Case lnx = 1 + llContract = .T. + Do Case + Case gnParametru_prog = 1 + Do lans_ireg_parteneri With .F., gcCont411, .T.,,,,,llContract + Case gnParametru_prog = 2 + Do lans_ireg_parteneri With .F.,'401', .F.,,,,,llContract + Endcase + Endcase + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_actaditional AS _cusodatabase OF "..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_actaditional" + * + + PROCEDURE make_sql + LPARAMETERS toRec,tnId + + lcActiune = ALLTRIM(THIS.cActiune) + lcId_util = ALLTRIM(STR(gnidutil)) + + IF INLIST(lcActiune, "UPDATE",'INSERT') AND TYPE('toRec') != "O" + RETURN .F. + ENDIF + + IF INLIST(lcActiune, "UPDATE",'DELETE') AND TYPE('tnId') != "N" + RETURN .F. + ENDIF + + IF INLIST(lcActiune, "UPDATE",'DELETE') + lcId = ALLTRIM(STR(tnId)) + ENDIF + + IF INLIST(lcActiune, "UPDATE",'INSERT') + lcId_ctr = NVL(ALLTRIM(STR(goContract.id_ctr)),"0") + lcId_part = NVL(ALLTRIM(STR(goContract.id_part)),"0") + lcId_tip_ctr = NVL(ALLTRIM(STR(goContract.id_tip_ctr)),"0") + lcNumar = NVL(ALLTRIM(toRec.numar),"0") + lcData = ALLTRIM(DTOS(toRec.data)) + lcDescriere = NVL(ALLTRIM(toRec.descriere),"") + ENDIF + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin pack_crm.adauga_act_aditional(]+lcId_ctr+ [,]+lcId_part+ [,] + lcId_tip_ctr+[,']+ lcNumar+[',]+; + [to_date(']+lcData+[','YYYYMMDD'),']+lcDescriere+ [',]+lcId_util+[); end;] + + Case lcActiune = "UPDATE" + lcSql = [begin pack_def.modifica_contract(]+lcId+[,']+lcNumar+[',]+; + [to_date(']+lcData+[','YYYYMMDD'),]+lcId_tip_ctr + [,]+lcInactiv+[,]+lcId_util+[); end;] + + Case lcActiune = "DELETE" + lcSql = [begin pack_def.sterge_contract(]+lcId+[,]+lcId_util+[); end;] + ENDCASE + + this.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_selectie AS _cusodatabase OF "..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_selectie" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcId_util = Alltrim(Str(gnIdUtil)) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcSelectie = Strtran(Alltrim(toRec.selectie),['],['']) + ENDIF + + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin PACK_CTR_FURNIZORI.adauga_selectie('] + lcSelectie + [',]+lcId_util+[); end;] + + Case lcActiune = "UPDATE" + lcSql = [begin PACK_CTR_FURNIZORI.modifica_selectie(]+lcId +[,']+lcSelectie+ [',]+ lcId_util+[); end;] + + Case lcActiune = "DELETE" + * lcSql = [begin pack_nomenclatoare.sterge_tip_ctr(]+lcId+[,]+lcId_util+[); end;] + lcSql = [begin PACK_CTR_FURNIZORI.sterge_selectie(]+lcId+ [,]+ lcId_util+[); end;] + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_ctr_link_nou AS _frmbase OF "..\comun\clase\_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="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtLink" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_renunt1" UniqueID="" Timestamp="" /> + + * + BorderStyle = 3 + DoCreate = .T. + Height = 124 + Name = "frm_ctr_link_nou" + Width = 375 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 314 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 61 + Lb_titlu_alb_b121.Caption = "Link" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 5 + BUT_TERMIN1.Left = 344 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 4 + BUT_TERMIN1.Top = 1 + Gridsort1.Name = "Gridsort1" + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Left = 314, ; + Name = "But_renunt1", ; + Top = 1 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Command3' AS commandbutton WITH ; + Caption = "...", ; + Height = 22, ; + Left = 336, ; + Name = "Command3", ; + TabIndex = 3, ; + Top = 84, ; + Width = 29 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Command4' AS commandbutton WITH ; + Caption = "", ; + Height = 22, ; + Left = 310, ; + Name = "Command4", ; + Picture = ..\grafice\open.bmp, ; + TabIndex = 8, ; + Top = 84, ; + Width = 27 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Label1' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Denumire", ; + Height = 17, ; + Left = 13, ; + Name = "Label1", ; + TabIndex = 6, ; + Top = 51, ; + Width = 57 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Link", ; + Height = 17, ; + Left = 13, ; + Name = "Label2", ; + TabIndex = 7, ; + Top = 87, ; + Width = 25 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Text1' AS textbox WITH ; + ControlSource = "poLink.denumire_link", ; + Height = 23, ; + Left = 77, ; + Name = "Text1", ; + TabIndex = 1, ; + Top = 48, ; + Width = 228 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtLink' AS textbox WITH ; + ControlSource = "poLink.link", ; + Height = 23, ; + Left = 77, ; + Name = "txtLink", ; + TabIndex = 2, ; + Top = 84, ; + Width = 228 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE Command3.Click + lcDoc = GETFILE("*","Alegeti fisierul") + thisform.txtLink.Value = lcDoc + thisform.txtLink.SetFocus + ENDPROC + + PROCEDURE Command4.Click + PRIVATE oWord + LOCAL lcDocument + + lcDocument = thisform.txtLink.Value + + IF !FILE(lcDocument) + MESSAGEBOX("Nu exista fisierul "+lcDocument,16,"Eroare") + RETURN + ENDIF + + oWord = CREATEOBJECT('word.application') + oDocument = oWord.Documents.OPEN(lcDocument) + oWord.CAPTION = "Contract Test" + + opuiu = CREATEOBJECT('shell.application') + opuiu.minimizeAll + RELEASE opuiu + oWord.VISIBLE =.T. + oword = .null. + RELEASE oword + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg AS _frmbase OF "..\comun\clase\_frm_base.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: blocheaza_campuri + *m: deblocheaza_campuri + * + + * + BorderStyle = 0 + DoCreate = .T. + Height = 282 + Name = "frm_dg" + Width = 417 + WindowType = 0 + _shape1.Name = "_shape1" + _shape1.Top = 1000 + _shape2.Name = "_shape2" + _shape2.Visible = .F. + Lb_titlu_alb_b121.FontBold = .T. + Lb_titlu_alb_b121.ForeColor = 0,0,0 + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.Top = 1000 + Gridsort1.Name = "Gridsort1" + * + + PROCEDURE Activate + DODEFAULT() + + this.Left = 202 + this.Width = _screen.Width - 206 + this.Top = oprinc.pagefr1.top + 28 + 120 + this.Height = _screen.Height - this.Top - 2 + + + + ENDPROC + + PROCEDURE blocheaza_campuri + ENDPROC + + PROCEDURE deblocheaza_campuri + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_date_generale AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Shape7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Shape5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Shape4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Shape3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdValuta" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_incetat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label10" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtDurata" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label17" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValuta" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_incetat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label12" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdTip_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtTip_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_inactiv" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_semnat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_inceput" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_sfarsit" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdResponsabil" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label14" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtResponsabil" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSectie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label20" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtSectie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label21" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtMotiv_incetat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSelectie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtSelectie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_intern" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtDescriere" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtNumar_intern" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtOfertanti" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + + * + *p: llock + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 379 + llock = .F. + Name = "frm_dg_date_generale" + Width = 559 + WindowType = 0 + _shape1.Height = 29 + _shape1.Left = -12 + _shape1.Name = "_shape1" + _shape1.Top = 800 + _shape1.Width = 561 + _shape1.ZOrderSet = 3 + _shape2.Left = 504 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Visible = .F. + _shape2.ZOrderSet = 4 + Lb_titlu_alb_b121.Caption = "Date generale" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 20 + Lb_titlu_alb_b121.ZOrderSet = 5 + BUT_TERMIN1.Left = 530 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 21 + BUT_TERMIN1.Top = 1000 + BUT_TERMIN1.ZOrderSet = 6 + Gridsort1.Left = 132 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 12 + * + + ADD OBJECT 'ck_inactiv' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Inactiv", ; + ControlSource = "goContract.inactiv", ; + Height = 17, ; + Left = 105, ; + Name = "ck_inactiv", ; + ReadOnly = .T., ; + TabIndex = 17, ; + Top = 358, ; + Width = 52, ; + ZOrderSet = 22 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'ck_incetat' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Incetat (nu mai este in desfasurare)", ; + ControlSource = "goContract.incetat", ; + Height = 17, ; + Left = 28, ; + Name = "ck_incetat", ; + ReadOnly = .T., ; + TabIndex = 11, ; + Top = 244, ; + Width = 213, ; + ZOrderSet = 12 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'ck_semnat' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Semnat", ; + ControlSource = "goContract.semnat", ; + Height = 17, ; + Left = 26, ; + Name = "ck_semnat", ; + ReadOnly = .T., ; + TabIndex = 16, ; + Top = 358, ; + Width = 61, ; + ZOrderSet = 23 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'cmdResponsabil' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 21, ; + Left = 281, ; + Name = "cmdResponsabil", ; + Picture = ..\grafice\find.bmp, ; + TabIndex = 14, ; + Top = 310, ; + Width = 28, ; + ZOrderSet = 28 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSectie' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 21, ; + Left = 281, ; + Name = "cmdSectie", ; + Picture = ..\grafice\find.bmp, ; + TabIndex = 15, ; + Top = 332, ; + Width = 28, ; + ZOrderSet = 31 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSelectie' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 21, ; + Left = 288, ; + Name = "cmdSelectie", ; + Picture = ..\..\roacontracte_furnizori\grafice\find.bmp, ; + TabIndex = 6, ; + Top = 130, ; + Width = 28, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdTip_ctr' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 21, ; + Left = 288, ; + Name = "cmdTip_ctr", ; + Picture = ..\..\roacontracte_furnizori\grafice\find.bmp, ; + TabIndex = 5, ; + Top = 108, ; + Width = 28, ; + ZOrderSet = 20 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdValuta' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 21, ; + Left = 281, ; + Name = "cmdValuta", ; + Picture = ..\grafice\find.bmp, ; + TabIndex = 13, ; + Top = 288, ; + Width = 28, ; + ZOrderSet = 11 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Label1' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data inceput", ; + Height = 17, ; + Left = 28, ; + Name = "Label1", ; + TabIndex = 38, ; + Top = 161, ; + Width = 71, ; + ZOrderSet = 24 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label10' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Durata (luni)", ; + Height = 17, ; + Left = 28, ; + Name = "Label10", ; + TabIndex = 30, ; + Top = 183, ; + Width = 70, ; + ZOrderSet = 13 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label12' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Tip contract", ; + Height = 17, ; + Left = 28, ; + Name = "Label12", ; + TabIndex = 34, ; + Top = 110, ; + Width = 65, ; + ZOrderSet = 19 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label14' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Responsabil", ; + Height = 17, ; + Left = 28, ; + Name = "Label14", ; + TabIndex = 33, ; + Top = 312, ; + Width = 73, ; + ZOrderSet = 29 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label17' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Valuta", ; + Height = 17, ; + Left = 28, ; + Name = "Label17", ; + TabIndex = 31, ; + Top = 290, ; + Width = 36, ; + ZOrderSet = 15 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data incetarii", ; + Height = 17, ; + Left = 28, ; + Name = "Label2", ; + TabIndex = 36, ; + Top = 227, ; + Width = 74, ; + ZOrderSet = 17 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label20' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Sectie", ; + Height = 17, ; + Left = 28, ; + Name = "Label20", ; + TabIndex = 32, ; + Top = 334, ; + Width = 36, ; + ZOrderSet = 32 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label21' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Motiv incetare", ; + Height = 17, ; + Left = 28, ; + Name = "Label21", ; + TabIndex = 22, ; + Top = 262, ; + Width = 76, ; + ZOrderSet = 34 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Modul de selectie", ; + Height = 17, ; + Left = 28, ; + Name = "Label3", ; + TabIndex = 35, ; + Top = 132, ; + Width = 98, ; + ZOrderSet = 37 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Descriere", ; + Height = 17, ; + Left = 28, ; + Name = "Label4", ; + TabIndex = 25, ; + Top = 82, ; + Width = 56, ; + ZOrderSet = 40 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label5' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data sfarsit", ; + Height = 17, ; + Left = 28, ; + Name = "Label5", ; + TabIndex = 37, ; + Top = 205, ; + Width = 65, ; + ZOrderSet = 26 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label6' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nr./data inreg. (intrare-iesire)", ; + Height = 17, ; + Left = 28, ; + Name = "Label6", ; + TabIndex = 18, ; + Top = 38, ; + Width = 160, ; + ZOrderSet = 42 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label7' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Ofertanti", ; + Height = 17, ; + Left = 28, ; + Name = "Label7", ; + TabIndex = 23, ; + Top = 60, ; + Width = 48, ; + ZOrderSet = 46 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "/", ; + Height = 17, ; + Left = 326, ; + Name = "Label9", ; + TabIndex = 19, ; + Top = 38, ; + Width = 5, ; + ZOrderSet = 44 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Shape3' AS shape WITH ; + BackStyle = 0, ; + Height = 128, ; + Left = 19, ; + Name = "Shape3", ; + SpecialEffect = 0, ; + Top = 156, ; + Width = 442, ; + ZOrderSet = 10 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'Shape4' AS shape WITH ; + BackStyle = 0, ; + Height = 50, ; + Left = 19, ; + Name = "Shape4", ; + SpecialEffect = 0, ; + Top = 105, ; + Width = 442, ; + ZOrderSet = 9 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'Shape5' AS shape WITH ; + BackStyle = 0, ; + Height = 72, ; + Left = 18, ; + Name = "Shape5", ; + SpecialEffect = 0, ; + Top = 285, ; + Width = 442, ; + ZOrderSet = 8 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'Shape7' AS shape WITH ; + BackStyle = 0, ; + Height = 72, ; + Left = 19, ; + Name = "Shape7", ; + SpecialEffect = 0, ; + Top = 32, ; + Width = 442, ; + ZOrderSet = 0 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'txtData_inceput' AS textbox WITH ; + ControlSource = "goContract.data_inceput", ; + Height = 21, ; + Left = 131, ; + Name = "txtData_inceput", ; + ReadOnly = .T., ; + TabIndex = 7, ; + Top = 159, ; + Width = 72, ; + ZOrderSet = 25 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData_incetat' AS textbox WITH ; + ControlSource = "goContract.data_incetat", ; + Height = 21, ; + Left = 131, ; + Name = "txtData_incetat", ; + ReadOnly = .T., ; + TabIndex = 10, ; + Top = 225, ; + Width = 72, ; + ZOrderSet = 18 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData_intern' AS textbox WITH ; + ControlSource = "goContract.data_intern", ; + Height = 21, ; + Left = 333, ; + Name = "txtData_intern", ; + ReadOnly = .T., ; + TabIndex = 2, ; + Top = 36, ; + Width = 119, ; + ZOrderSet = 45 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData_sfarsit' AS textbox WITH ; + ControlSource = "goContract.data_sfarsit", ; + Height = 21, ; + Left = 131, ; + Name = "txtData_sfarsit", ; + ReadOnly = .T., ; + TabIndex = 9, ; + Top = 203, ; + Width = 72, ; + ZOrderSet = 27 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtDescriere' AS textbox WITH ; + ControlSource = "goContract.descriere", ; + Height = 21, ; + Left = 131, ; + Name = "txtDescriere", ; + ReadOnly = .T., ; + TabIndex = 4, ; + Top = 80, ; + Width = 321, ; + ZOrderSet = 41 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtDurata' AS textbox WITH ; + ControlSource = "goContract.durata", ; + Height = 21, ; + Left = 131, ; + Name = "txtDurata", ; + ReadOnly = .T., ; + TabIndex = 8, ; + Top = 181, ; + Width = 73, ; + ZOrderSet = 14 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtMotiv_incetat' AS textbox WITH ; + ControlSource = "goContract.motiv_incetat", ; + Height = 21, ; + Left = 131, ; + Name = "txtMotiv_incetat", ; + ReadOnly = .T., ; + TabIndex = 12, ; + Top = 260, ; + Width = 321, ; + ZOrderSet = 35 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtNumar_intern' AS textbox WITH ; + ControlSource = "goContract.numar_intern", ; + Format = "k", ; + Height = 21, ; + Left = 209, ; + Name = "txtNumar_intern", ; + ReadOnly = .T., ; + TabIndex = 1, ; + Top = 36, ; + Width = 113, ; + ZOrderSet = 43 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtOfertanti' AS textbox WITH ; + ControlSource = "goContract.ofertanti", ; + Height = 21, ; + Left = 131, ; + Name = "txtOfertanti", ; + ReadOnly = .T., ; + TabIndex = 3, ; + Top = 58, ; + Width = 321, ; + ZOrderSet = 47 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtResponsabil' AS textbox WITH ; + ControlSource = "goContract.responsabil", ; + Height = 21, ; + Left = 131, ; + Name = "txtResponsabil", ; + ReadOnly = .T., ; + TabIndex = 24, ; + Top = 310, ; + Width = 144, ; + ZOrderSet = 30 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtSectie' AS textbox WITH ; + ControlSource = "goContract.sectie", ; + Height = 21, ; + Left = 131, ; + Name = "txtSectie", ; + ReadOnly = .T., ; + TabIndex = 27, ; + Top = 332, ; + Width = 144, ; + ZOrderSet = 33 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtSelectie' AS textbox WITH ; + ControlSource = "goContract.selectie", ; + Height = 21, ; + Left = 131, ; + Name = "txtSelectie", ; + ReadOnly = .T., ; + TabIndex = 29, ; + Top = 130, ; + Width = 144, ; + ZOrderSet = 39 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtTip_ctr' AS textbox WITH ; + ControlSource = "goContract.denumire_tip", ; + Height = 21, ; + Left = 131, ; + Name = "txtTip_ctr", ; + ReadOnly = .T., ; + TabIndex = 28, ; + Top = 108, ; + Width = 144, ; + ZOrderSet = 21 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValuta' AS textbox WITH ; + ControlSource = "goContract.nume_val", ; + Height = 21, ; + Left = 131, ; + Name = "txtValuta", ; + ReadOnly = .T., ; + TabIndex = 26, ; + Top = 288, ; + Width = 144, ; + ZOrderSet = 16 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE blocheaza_campuri + this.txtDescriere.ReadOnly = .T. + this.cmdTip_ctr.Enabled = .F. + this.CmdSelectie.Enabled = .F. + this.txtData_inceput.ReadOnly = .T. + this.txtDurata.ReadOnly = .T. + this.txtData_sfarsit.ReadOnly = .T. + this.txtData_incetat.ReadOnly = .T. + this.ck_incetat.ReadOnly = .T. + this.txtMotiv_incetat.ReadOnly = .T. + this.cmdValuta.Enabled = .F. + this.cmdResponsabil.Enabled = .F. + this.cmdSectie.Enabled = .F. + this.ck_semnat.ReadOnly = .T. + this.ck_inactiv.ReadOnly = .T. + this.txtnumar_intern.ReadOnly = .T. + this.txtData_intern.ReadOnly = .T. + this.txtOfertanti.ReadOnly = .T. + + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.txtDescriere.ReadOnly = .F. + this.cmdTip_ctr.Enabled = .T. + this.CmdSelectie.Enabled = .T. + this.txtData_inceput.ReadOnly = .F. + this.txtDurata.ReadOnly = .F. + this.txtData_sfarsit.ReadOnly = .F. + this.txtData_incetat.ReadOnly = .F. + this.ck_incetat.ReadOnly = .F. + this.txtMotiv_incetat.ReadOnly = .F. + this.cmdValuta.Enabled = .T. + this.cmdResponsabil.Enabled = .T. + this.cmdSectie.Enabled = .T. + this.ck_semnat.ReadOnly = .F. + this.ck_inactiv.ReadOnly = .F. + this.txtnumar_intern.ReadOnly = .f. + this.txtData_intern.ReadOnly = .f. + this.txtOfertanti.ReadOnly = .F. + + ENDPROC + + PROCEDURE cmdResponsabil.Click + *!* LOCAL lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcFiltruOriginal, lcNumeProc + *!* lcselect = [select v.id_valuta, v.nume_val FROM vnom_valute v where] + *!* lcfiltru = [1=2] + *!* lcschema = [] + *!* lcorder = [v.nume_val] + *!* lccoloane = [nume_val] + *!* lcTitlu = [Alegeti valuta] + *!* lcTitluColoane = [Nume] + *!* lcFiltruOriginal = [v.inactiv = 0] + *!* lcNumeProc = "" + *!* locauta = cauta_alfa(lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcNumeProc, .F., lcFiltruOriginal) + + locauta = caut_responsabil() + + IF buton=2 + RETURN + ENDIF + + goContract.id_responsabil = locauta.id_responsabil + goContract.responsabil = locauta.nume + *pcNrord = locauta.nrord + thisform.txtResponsabil.Refresh + + + ENDPROC + + PROCEDURE cmdSectie.Click + locauta = caut_sectie() + + IF buton=2 + RETURN + ENDIF + + goContract.id_sectie = locauta.id_sectie + goContract.sectie = locauta.sectie + thisform.txtSectie.Refresh + + + ENDPROC + + PROCEDURE cmdSelectie.Click + LOCAL lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcFiltruOriginal, lcNumeProc + lcselect = [select id_selectie, selectie FROM vctr_selectii] + lcfiltru = [1=2] + lcschema = [] + lcorder = [selectie] + lccoloane = [selectie] + lcTitlu = [Alegeti modul de selectie] + lcTitluColoane = [Mod selectie] + lcFiltruOriginal = [] + lcNumeProc = "" + locauta = cauta_alfa(lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcNumeProc, .F., lcFiltruOriginal) + + IF buton=2 + RETURN + ENDIF + + goContract.id_selectie = locauta.id_selectie + goContract.selectie = locauta.selectie + THISFORM.txtSelectie.REFRESH + + + ENDPROC + + PROCEDURE cmdTip_ctr.Click + LOCAL lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcFiltruOriginal, lcNumeProc + lcselect = [select id_tip_ctr, denumire_tip FROM vtipuri_contracte] + lcfiltru = [1=2] + lcschema = [] + lcorder = [denumire_tip] + lccoloane = [denumire_tip] + lcTitlu = [Alegeti tipul de contract] + lcTitluColoane = [Tip contract] + DO CASE + CASE gnParametru_prog=1 + lcFiltruOriginal = [substr(tata,2,6)='CLIENT'] + CASE gnParametru_prog=2 + lcFiltruOriginal = [substr(tata,2,6)='FURNIZ'] + OTHERWISE + lcFiltruOriginal = [] + ENDCASE + lcNumeProc = "" + locauta = cauta_alfa(lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcNumeProc, .F., lcFiltruOriginal) + + IF buton=2 + RETURN + ENDIF + + goContract.id_tip_ctr = locauta.id_tip_ctr + goContract.denumire_tip = locauta.denumire_tip + THISFORM.txtTip_ctr.REFRESH + + + ENDPROC + + PROCEDURE cmdValuta.Click + locauta = caut_valuta() + IF buton=2 + RETURN + ENDIF + + goContract.id_valuta = locauta.id_valuta + goContract.nume_val = locauta.nume_val + thisform.txtValuta.Refresh + + + ENDPROC + + PROCEDURE txtData_incetat.Valid + IF !EMPTY(goContract.data_inceput) AND goContract.data_incetat <= goContract.data_inceput + MESSAGEBOX('Introduceti data incetarii mai mare decat data de inceput a contractului !',0+48,_screen.Caption) + goContract.data_incetat = goContract.data_inceput + 1 + ENDIF + + thisform.txtData_inceput.Refresh + ENDPROC + + PROCEDURE txtData_sfarsit.Valid + IF !EMPTY(goContract.data_inceput) AND goContract.data_sfarsit <= goContract.data_inceput + MESSAGEBOX('Introduceti data de sfarsit mai mare decat data de inceput a contractului !',0+48,_screen.Caption) + goContract.data_sfarsit = goContract.data_inceput + 1 + ENDIF + + goContract.durata = INT((YEAR(goContract.data_sfarsit)*12 + MONTH(goContract.data_sfarsit)) - (YEAR(goContract.data_inceput)*12 + MONTH(goContract.data_inceput))) + thisform.txtDurata.Refresh + ENDPROC + + PROCEDURE txtDurata.Valid + goContract.data_sfarsit = GOMONTH(goContract.data_inceput, goContract.durata) + thisform.txtData_sfarsit.Refresh + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_fact AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="ShapeNota" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="opt_facturare" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_text_standard" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboNote" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lbNota" UniqueID="" Timestamp="" /> + + * + BorderStyle = 1 + DoCreate = .T. + Height = 252 + Name = "frm_dg_fact" + Width = 506 + _shape1.Name = "_shape1" + _shape1.ZOrderSet = 1 + _shape2.Name = "_shape2" + _shape2.ZOrderSet = 2 + Lb_titlu_alb_b121.Caption = "Facturare" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.ZOrderSet = 3 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.ZOrderSet = 4 + Gridsort1.Left = 120 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 4 + * + + ADD OBJECT 'cboNote' AS combobox WITH ; + BoundColumn = 2, ; + BoundTo = .T., ; + ColumnCount = 3, ; + ColumnLines = .F., ; + ColumnWidths = "300,20", ; + ControlSource = "gocontract.id_nota", ; + Height = 24, ; + Left = 122, ; + Name = "cboNote", ; + ReadOnly = .T., ; + RowSource = "crsNote.denumire,id_nota", ; + RowSourceType = 2, ; + Top = 188, ; + Visible = .F., ; + Width = 267, ; + ZOrderSet = 8 + *< END OBJECT: BaseClass="combobox" /> + + ADD OBJECT 'ck_text_standard' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = 'Text suplimentar standard: "Conform contractului nr ... / data..."', ; + ControlSource = "gocontract.text_standard", ; + Height = 17, ; + Left = 33, ; + Name = "ck_text_standard", ; + ReadOnly = .T., ; + Top = 147, ; + Width = 357, ; + ZOrderSet = 7 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'lbNota' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nota contabila", ; + Height = 17, ; + Left = 33, ; + Name = "lbNota", ; + Top = 192, ; + Visible = .F., ; + Width = 81, ; + ZOrderSet = 9 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'opt_facturare' AS optiongroup WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + ButtonCount = 4, ; + ControlSource = "gocontract.opt_facturare", ; + Enabled = .F., ; + Height = 84, ; + Left = 24, ; + Name = "opt_facturare", ; + Top = 46, ; + Value = 1, ; + Width = 473, ; + ZOrderSet = 6, ; + Option1.AutoSize = .T., ; + Option1.BackStyle = 0, ; + Option1.Caption = "Denumirea ratei, valoarea ratei urmatoare", ; + Option1.Height = 17, ; + Option1.Left = 5, ; + Option1.Name = "Option1", ; + Option1.Top = 5, ; + Option1.Value = 1, ; + Option1.Width = 247, ; + Option2.AutoSize = .T., ; + Option2.BackStyle = 0, ; + Option2.Caption = "Primul articol din lista de articole (obiectul contractului) + valoarea ratei urmatoare", ; + Option2.Height = 17, ; + Option2.Left = 5, ; + Option2.Name = "Option2", ; + Option2.Top = 24, ; + Option2.Width = 463, ; + Option3.AutoSize = .T., ; + Option3.BackStyle = 0, ; + Option3.Caption = "Articole la alegere din lista de articole, cu preturile din lista de articole ", ; + Option3.Height = 17, ; + Option3.Left = 5, ; + Option3.Name = "Option3", ; + Option3.Top = 43, ; + Option3.Width = 398, ; + Option4.AutoSize = .T., ; + Option4.BackStyle = 0, ; + Option4.Caption = "Articole din liste de preturi generale", ; + Option4.Height = 17, ; + Option4.Left = 5, ; + Option4.Name = "Option4", ; + Option4.Top = 62, ; + Option4.Width = 211 + *< END OBJECT: BaseClass="optiongroup" /> + + ADD OBJECT 'ShapeNota' AS shape WITH ; + BackStyle = 0, ; + BorderColor = 163,163,163, ; + Height = 37, ; + Left = 24, ; + Name = "ShapeNota", ; + Top = 181, ; + Visible = .F., ; + Width = 473, ; + ZOrderSet = 0 + *< END OBJECT: BaseClass="shape" /> + + PROCEDURE blocheaza_campuri + this.opT_FACTURARE.Enabled = .F. + this.ck_text_standard.ReadOnly = .T. + THIS.CBoNote.Enabled = .F. + this.cboNote.ReadOnly = .T. + + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.opT_FACTURARE.Enabled = .T. + this.ck_text_standard.ReadOnly = .F. + THIS.CBoNote.Enabled = .T. + this.cboNote.ReadOnly = .F. + ENDPROC + + PROCEDURE cboNote.InteractiveChange + gocontract.id_nota = crsNote.id_nota + ENDPROC + + PROCEDURE cboNote.Valid + gocontract.id_nota = crsNote.id_nota + ENDPROC + + PROCEDURE opt_facturare.Init + this.Value = gocontract.opt_facturare + + IF this.Value = 1 OR this.Value = 2 + thisform.lbNota.Visible = .T. + thisform.shapeNota.Visible = .T. + thisform.cboNote.Visible = .T. + ENDIF + + + ENDPROC + + PROCEDURE opt_facturare.Valid + IF this.Value = 1 OR this.Value = 2 + thisform.lbNota.Visible = .T. + thisform.shapeNota.Visible = .T. + thisform.cboNote.Visible = .T. + ELSE + thisform.lbNota.Visible = .F. + thisform.shapeNota.Visible = .F. + thisform.cboNote.Visible = .F. + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_link AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="grid_linkuri" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_linkuri.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_linkuri.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_linkuri.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_linkuri.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_linkuri.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_linkuri.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_edit1" UniqueID="" Timestamp="" /> + + * + BorderStyle = 1 + cgridsortlist = grid_linkuri + DoCreate = .T. + Height = 200 + Name = "frm_dg_link" + Width = 571 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 481 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 91 + Lb_titlu_alb_b121.Caption = "Documente atasate" + Lb_titlu_alb_b121.Left = 6 + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + Gridsort1.Left = 168 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 12 + * + + ADD OBJECT 'But_edit1' AS but_sterge WITH ; + caction = inainte_de_do_modifica, ; + cpicturedown = eye_jos.bmp, ; + cpictureup = eye_sus.bmp, ; + Left = 511, ; + Name = "But_edit1", ; + Picture = ..\grafice\eye_sus.bmp, ; + TabIndex = 2, ; + ToolTipText = "Vizualizare document", ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Enabled = .F., ; + Left = 482, ; + Name = "But_nou1", ; + TabIndex = 1, ; + Top = 1 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Enabled = .F., ; + Left = 541, ; + Name = "But_sterge1", ; + TabIndex = 2, ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_linkuri' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 3, ; + DeleteMark = .F., ; + GridLineColor = 192,192,192, ; + Height = 154, ; + HighlightStyle = 2, ; + Left = 6, ; + Name = "grid_linkuri", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "cCtrLink", ; + Top = 36, ; + Width = 555, ; + Column1.ControlSource = "recno()", ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 44, ; + Column2.ColumnOrder = 2, ; + Column2.ControlSource = "denumire_link", ; + Column2.Name = "Column2", ; + Column2.ReadOnly = .T., ; + Column2.Width = 246, ; + Column3.ColumnOrder = 3, ; + Column3.ControlSource = "link", ; + Column3.Name = "Column3", ; + Column3.ReadOnly = .T., ; + Column3.Width = 240 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_linkuri.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. crt.", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_linkuri.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_linkuri.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Denumire", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_linkuri.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_linkuri.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Link", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_linkuri.Column3.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE blocheaza_campuri + this.but_nou1.Enabled = .F. + this.but_sterge1.Enabled = .F. + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.but_nou1.Enabled = .T. + this.but_sterge1.Enabled = .T. + + ENDPROC + + PROCEDURE do_adauga + PRIVATE pnId_ctr, pcDenumire, pcLink, pcObservatii, pnId_link + STORE 0 TO pnId_ctr, pnId_link + STORE "" TO pcDenumire, pcLink, pcObservatii + + LOCAL lcTabelLinkuri + lcTabelLinkuri = THISFORM.grid_linkuri.RECORDSOURCE + SELECT (lcTabelLinkuri) + SCATTER NAME poLink BLANK MEMO + lodn = CREATEOBJECT("frm_ctr_link_nou") + lodn.SHOW(1) + + pcDenumire = ALLTRIM(poLink.denumire_link) + pcLink = ALLTRIM(poLink.LINK) + pcObservatii = ALLTRIM(poLink.observatii) + + pnId_ctr = goContract.id_ctr + + lcSql = [begin pack_crm.adauga_ctr_link(?pnId_ctr, ?pcDenumire, ?pcLink, ?pcObservatii, ?@pnId_link); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + poLink.id_link = pnId_link + + SELECT (lcTabelLinkuri) + APPEND BLANK + GATHER NAME poLink MEMO + REPLACE id_ctr WITH pnId_ctr + THISFORM.grid_linkuri.REFRESH + + + ENDPROC + + PROCEDURE inainte_de_do_modifica + Private oWord + Local lcDocument + + lcTabel = Thisform.grid_linkuri.RecordSource + Select (lcTabel) + If Reccount() >0 + + lcDocument = Link + + If !File(lcDocument) + Messagebox("Nu exista fisierul "+lcDocument,16,"Eroare") + Return + Endif + + *!* oWord = CREATEOBJECT('word.application') + *!* oDocument = oWord.Documents.OPEN(lcDocument) + *!* *oWord.CAPTION = "Contract Test" + + *!* opuiu = CREATEOBJECT('shell.application') + *!* opuiu.minimizeAll + *!* RELEASE opuiu + *!* oWord.VISIBLE =.T. + *!* oWord = .NULL. + *!* RELEASE oWord + open_default_app(lcDocument) + Endif + + ENDPROC + + PROCEDURE inainte_de_do_sterge + LOCAL lcTabelLinkuri, lnRaspuns, lnInreg + lcTabelLinkuri = THISFORM.grid_linkuri.RECORDSOURCE + STORE 0 TO lnRaspuns, lnInreg + + SELECT (lcTabelLinkuri) + lnRec = RECNO() + COUNT FOR !DELETED() TO lnInreg + + IF lnInreg > 0 + lnRaspuns = amessage('Doriti sa stergeti documentul?',4+32,_SCREEN.CAPTION) + IF lnRaspuns = 7 && 7 = No ; 6 = Yes + RETURN + ENDIF + + SELECT (lcTabelLinkuri) + GOTO lnRec + pcId_link = ALLTRIM(STR(id_link)) + lcSql = [begin pack_crm.sterge_ctr_link(] + pcId_link + [); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + SELECT (lcTabelLinkuri) + DELETE + + THISFORM.grid_linkuri.REFRESH + thisform.grid_linkuri.SetFocus() + ENDIF + + ENDPROC + + PROCEDURE grid_linkuri.Column2.Text1.DblClick + thisform.inainte_de_do_modifica() + ENDPROC + + PROCEDURE grid_linkuri.Column3.Text1.DblClick + thisform.inainte_de_do_modifica() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_obiectul AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="grid_articole" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cNume_art.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cNume_art.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cPret_unitar.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cPret_unitar.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cNume_val.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cNume_val.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cCant.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cCant.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cUM.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cUM.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cValoare.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cValoare.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cCoef_Discount.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cCoef_Discount.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cValcDiscount.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cValcDiscount.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cVal_discount.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.cVal_discount.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.Column11.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_articole.Column11.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtSumaArticole" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label21" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtDiscount" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValcdiscount" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValDiscount" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label15" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtProc_tva" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label16" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Line1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtCoef_discount" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValDiscountTotal" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Line2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label8" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValftva" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValctva" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label10" UniqueID="" Timestamp="" /> + + * + *m: afisactual + *m: do_modifica_ctr_art + *p: clistaidarticole + *p: cnewvalue + *p: coldvalue + *p: cxmlarticole + *p: ncoef_discount + *p: ndiscountmediu + *p: nsumaarticole + *p: nvalcdiscount + *p: nvaldiscount + * + + * + BorderStyle = 1 + cgridsortlist = grid_articole + clistaidarticole = + cnewvalue = + coldvalue = + cxmlarticole = + DoCreate = .T. + Height = 446 + Name = "frm_dg_obiectul" + ncoef_discount = 0 + ndiscountmediu = 0 + nsumaarticole = 0 + nvalcdiscount = 0 + nvaldiscount = 0 + Width = 633 + _shape1.Name = "_shape1" + _shape2.Anchor = 3 + _shape2.Height = 29 + _shape2.Left = 301 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 66 + Lb_titlu_alb_b121.Caption = "Obiectul si valoarea contractului" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + Gridsort1.Left = 60 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 0 + * + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 3, ; + Enabled = .F., ; + Left = 303, ; + Name = "But_nou1", ; + TabIndex = 6, ; + Top = 1 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 3, ; + Enabled = .F., ; + Left = 335, ; + Name = "But_sterge1", ; + TabIndex = 5, ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_articole' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 11, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + GridLineColor = 192,192,192, ; + HeaderHeight = 38, ; + Height = 201, ; + HighlightStyle = 2, ; + Left = 8, ; + Name = "grid_articole", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "cCtrArt", ; + RecordSourceType = 1, ; + TabIndex = 1, ; + Top = 36, ; + Width = 614, ; + Column1.ControlSource = "recno()", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 21, ; + Column2.ColumnOrder = 2, ; + Column2.ControlSource = "nume_articol", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cNume_art", ; + Column2.ReadOnly = .T., ; + Column2.Width = 166, ; + Column3.ColumnOrder = 5, ; + Column3.ControlSource = "pret_unitar", ; + Column3.FontName = "Arial Narrow", ; + Column3.Format = "rk", ; + Column3.InputMask = (get_mask(14,gnPA)), ; + Column3.Name = "cPret_unitar", ; + Column3.ReadOnly = .T., ; + Column3.Width = 37, ; + Column4.ColumnOrder = 11, ; + Column4.ControlSource = "nume_val", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "cNume_val", ; + Column4.ReadOnly = .T., ; + Column4.Width = 35, ; + Column5.ColumnOrder = 4, ; + Column5.ControlSource = "cant", ; + Column5.FontName = "Arial Narrow", ; + Column5.Format = "rk", ; + Column5.InputMask = (get_mask(10,gnPCant)), ; + Column5.Name = "cCant", ; + Column5.ReadOnly = .T., ; + Column5.Width = 49, ; + Column6.ColumnOrder = 3, ; + Column6.ControlSource = "um", ; + Column6.FontName = "Arial Narrow", ; + Column6.Name = "cUM", ; + Column6.ReadOnly = .T., ; + Column6.Width = 42, ; + Column7.ColumnOrder = 6, ; + Column7.ControlSource = "valoare", ; + Column7.FontName = "Arial Narrow", ; + Column7.Format = "rk", ; + Column7.InputMask = (get_mask(14,gnPA)), ; + Column7.Name = "cValoare", ; + Column7.ReadOnly = .T., ; + Column7.Width = 49, ; + Column8.ColumnOrder = 7, ; + Column8.ControlSource = "coef_discount", ; + Column8.FontName = "Arial Narrow", ; + Column8.Format = "rk", ; + Column8.InputMask = (get_mask(10,gnPA)), ; + Column8.Name = "cCoef_Discount", ; + Column8.ReadOnly = .T., ; + Column8.Width = 42, ; + Column9.ColumnOrder = 10, ; + Column9.ControlSource = "cant *(pret_unitar-(coef_discount*pret_unitar)/100)", ; + Column9.FontName = "Arial Narrow", ; + Column9.Format = "rk", ; + Column9.InputMask = (get_mask(20,gnPA)), ; + Column9.Name = "cValcDiscount", ; + Column9.ReadOnly = .T., ; + Column9.Width = 44, ; + Column10.ColumnOrder = 8, ; + Column10.ControlSource = "val_discount", ; + Column10.FontName = "Arial Narrow", ; + Column10.InputMask = (get_mask(10,gnPA)), ; + Column10.Name = "cVal_discount", ; + Column10.ReadOnly = .T., ; + Column10.Width = 41, ; + Column11.ColumnOrder = 9, ; + Column11.ControlSource = "pret_unitar-(coef_discount*pret_unitar)/100", ; + Column11.FontName = "Arial Narrow", ; + Column11.InputMask = (get_mask(10,gnPA)), ; + Column11.Name = "Column11", ; + Column11.ReadOnly = .T., ; + Column11.Width = 45 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_articole.cCant.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Cantitate", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cCant.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cCoef_Discount.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Discount (%)", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cCoef_Discount.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cNume_art.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Articol", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cNume_art.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cNume_val.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valuta", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cNume_val.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .T., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. crt.", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.Column11.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Pret unitar diminuat", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.Column11.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cPret_unitar.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Pret unitar", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cPret_unitar.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cUM.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Um", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cUM.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cVal_discount.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Discount unitar", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cVal_discount.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cValcDiscount.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare - Discount", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cValcDiscount.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_articole.cValoare.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_articole.cValoare.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Label1' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Procent mediu discount articole", ; + Height = 17, ; + Left = 15, ; + Name = "Label1", ; + TabIndex = 14, ; + Top = 281, ; + Width = 175 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label10' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "%", ; + Height = 17, ; + Left = 273, ; + Name = "Label10", ; + TabIndex = 22, ; + Top = 351, ; + Width = 13 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label15' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "TVA", ; + Height = 17, ; + Left = 339, ; + Name = "Label15", ; + TabIndex = 23, ; + Top = 398, ; + Width = 23 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label16' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "%", ; + Height = 17, ; + Left = 403, ; + Name = "Label16", ; + TabIndex = 22, ; + Top = 398, ; + Width = 13 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label21' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Total valoare articole", ; + Height = 17, ; + Left = 15, ; + Name = "Label21", ; + TabIndex = 19, ; + Top = 259, ; + Width = 115 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Total valoare articole cu discount", ; + Height = 17, ; + Left = 15, ; + Name = "Label3", ; + TabIndex = 21, ; + Top = 324, ; + Width = 181 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Procent discount general", ; + Height = 17, ; + Left = 15, ; + Name = "Label4", ; + TabIndex = 16, ; + Top = 351, ; + Width = 139 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label5' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Total valoare discount articole", ; + Height = 17, ; + Left = 15, ; + Name = "Label5", ; + TabIndex = 18, ; + Top = 302, ; + Width = 165 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label6' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Valoare discount general", ; + Height = 17, ; + Left = 15, ; + Name = "Label6", ; + TabIndex = 20, ; + Top = 372, ; + Width = 139 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label7' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Total general - fara TVA", ; + Height = 17, ; + Left = 16, ; + Name = "Label7", ; + TabIndex = 17, ; + Top = 398, ; + Width = 129 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label8' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Total general - cu TVA", ; + Height = 17, ; + Left = 16, ; + Name = "Label8", ; + TabIndex = 15, ; + Top = 420, ; + Width = 121 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "%", ; + Height = 17, ; + Left = 273, ; + Name = "Label9", ; + TabIndex = 22, ; + Top = 281, ; + Width = 13 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Line1' AS line WITH ; + Anchor = 6, ; + Height = 0, ; + Left = 8, ; + Name = "Line1", ; + Top = 345, ; + Width = 332 + *< END OBJECT: BaseClass="line" /> + + ADD OBJECT 'Line2' AS line WITH ; + Anchor = 6, ; + Height = 0, ; + Left = 8, ; + Name = "Line2", ; + Top = 393, ; + Width = 332 + *< END OBJECT: BaseClass="line" /> + + ADD OBJECT 'txtCoef_discount' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "thisform.nCoef_discount", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(6,gnPA)), ; + Left = 213, ; + Name = "txtCoef_discount", ; + ReadOnly = .T., ; + TabIndex = 2, ; + Top = 349, ; + Width = 58 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtDiscount' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "thisform.nDiscountMediu", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(6,gnPA)), ; + Left = 213, ; + Name = "txtDiscount", ; + ReadOnly = .T., ; + TabIndex = 8, ; + Top = 279, ; + Width = 58 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtProc_tva' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "goContract.proc_tva", ; + Format = "rk", ; + Height = 23, ; + InputMask = "99", ; + Left = 364, ; + Name = "txtProc_tva", ; + ReadOnly = .T., ; + TabIndex = 4, ; + Top = 395, ; + Width = 38 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtSumaArticole' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "thisform.nSumaArticole", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 213, ; + Name = "txtSumaArticole", ; + ReadOnly = .T., ; + TabIndex = 7, ; + Top = 257, ; + Width = 116 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValcdiscount' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "thisform.nValcdiscount", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 213, ; + Name = "txtValcdiscount", ; + ReadOnly = .T., ; + TabIndex = 10, ; + Top = 323, ; + Width = 116 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValctva' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "goContract.valctva", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 213, ; + Name = "txtValctva", ; + ReadOnly = .T., ; + TabIndex = 12, ; + Top = 418, ; + Width = 116 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValDiscount' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "thisform.nValDiscount", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 213, ; + Name = "txtValDiscount", ; + ReadOnly = .T., ; + TabIndex = 9, ; + Top = 301, ; + Width = 116 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValDiscountTotal' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "goContract.val_discount", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 213, ; + Name = "txtValDiscountTotal", ; + ReadOnly = .T., ; + TabIndex = 3, ; + Top = 371, ; + Width = 116 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValftva' AS textbox WITH ; + Anchor = 6, ; + ControlSource = "goContract.valftva", ; + Format = "rk", ; + Height = 21, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 213, ; + Name = "txtValftva", ; + ReadOnly = .T., ; + TabIndex = 11, ; + Top = 396, ; + Width = 116 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE afisactual + PARAMETERS tlDiscount_salvat + + LOCAL lcTabelArticole + lcTabelArticole = THISFORM.grid_articole.RECORDSOURCE + + SELECT (lcTabelArticole) + CALCULATE SUM(NVL(cant,0)*NVL(pret_unitar,0)) TO THISFORM.nSumaArticole + CALCULATE SUM(NVL(cant,0)*NVL(pret_unitar,0)*NVL(coef_discount,0)/100) TO THISFORM.nValDiscount + CALCULATE AVG(NVL(coef_discount,0)) TO THISFORM.nDiscountMediu + CALCULATE SUM(NVL(cant,0)*NVL(pret_unitar,0) - NVL(val_discount,0)) TO THISFORM.nValcdiscount + + THISFORM.nSumaArticole = ROUND(THISFORM.nSumaArticole, gnPC) + THISFORM.nValDiscount = ROUND(THISFORM.nValDiscount, gnPC) + THISFORM.nDiscountMediu = ROUND(THISFORM.nDiscountMediu, gnPC) + THISFORM.nValcdiscount = ROUND(THISFORM.nValcdiscount, gnPC) + + THISFORM.txtSumaArticole.REFRESH + THISFORM.txtDiscount.REFRESH + THISFORM.txtValdiscount.REFRESH + THISFORM.txtValcdiscount.REFRESH + + *** + IF tlDiscount_salvat + * cand arat obiectul si valoarea contractului, adica pe init, sa iau datele salvate + IF THISFORM.nSumaArticole <> 0 + *THISFORM.nCoef_discount = ROUND(NVL(goContract.val_discount,0) / THISFORM.nValcdiscount * 100, gnPC) + THISFORM.nCoef_discount = ROUND(NVL(goContract.val_discount,0) / THISFORM.nSumaArticole * 100, gnPC) + ENDIF + ELSE && cand calculez, trebuie sa arat cat imi da + THISFORM.nCoef_discount = THISFORM.nDiscountMediu + goContract.val_discount = THISFORM.nValDiscount + thisform.txtValDiscountTotal.Refresh + ENDIF + + * thisform.txtCoef_discount.Valid + + *goContract.valftva = THISFORM.nValcdiscount - NVL(goContract.val_discount,0) + goContract.valftva = THISFORM.nSumaArticole - NVL(goContract.val_discount,0) + goContract.valctva = goContract.valftva * (1+goContract.proc_tva/100) + + THISFORM.txtCoef_discount.REFRESH + THISFORM.txtValftva.REFRESH + THISFORM.txtValctva.REFRESH + + + + ENDPROC + + PROCEDURE blocheaza_campuri + this.but_nou1.Enabled = .F. + this.but_sterge1.Enabled = .F. + this.grid_articole.ReadOnly = .T. + this.grid_articole.cNume_art.Enabled = .F. + + this.txtCoef_discount.ReadOnly = .T. + this.txtValDiscountTotal.ReadOnly = .T. + this.txtProc_tva.ReadOnly = .T. + + + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.but_nou1.Enabled = .T. + this.but_sterge1.Enabled = .T. + this.grid_articole.ReadOnly = .F. + this.grid_articole.cNume_art.Enabled = .T. + + this.txtCoef_discount.ReadOnly = .F. + this.txtValDiscountTotal.ReadOnly = .F. + this.txtProc_tva.ReadOnly = .F. + ENDPROC + + PROCEDURE do_adauga + THISFORM.ALWAYSONTOP = .F. + + LOCAL lcCtrArt + lcCtrArt = THISFORM.grid_articole.RECORDSOURCE + + DO CASE + CASE gnParametru_prog = 1 && clienti + lcSel = [{call pack_crm.get_politici_grup(] + ALLTRIM(STR(gnIdUtil)) + [)}] + + lcCursor = 'crsPoliticiGrup1' + lnSucces = goExecutor.oExecute(lcSel, lcCursor) + IF lnSucces < 0 + amessagebox(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + SELECT id_politica, nume_lista_preturi, TTOD(datai) AS datai, TTOD(DATAS) AS DATAS ; + FROM crsPoliticiGrup1 ; + INTO CURSOR crsPoliticiGrup + + IF USED('crsPoliticiGrup1') + USE IN crsPoliticiGrup1 + ENDIF + + fpp = CREATEOBJECT("frm_politica_preturi") + fpp.SHOW(1) + + IF USED('crsPoliticiGrup') + USE IN crsPoliticiGrup + ENDIF + + IF USED("cPol_pret_art") + *!* modificare 08.05.2007 ( PRETFTVA in loc de PRET ) + SELECT *, PRETFTVA AS pret_unitar, 1 AS cant, PRET AS valoare, ; + 0 as coef_discount, 0 as val_discount ; + FROM cPol_pret_art WITH (BUFFERING = .T.) ; + WHERE ales = 1 ; + INTO CURSOR cAles + + SELECT cAles + SCAN + pcId_ctr = ALLTRIM(STR(goContract.id_ctr)) + pcId_pol_art = ALLTRIM(STR(id_pol_art)) + pcPret_unitar = NVL(ALLTRIM(STR(pret_unitar,20,gnPC)),"0") + pcCant = ALLTRIM(STR(cant,10,gnPCant)) + pcCoef_Discount = "0" && ALLTRIM(STR(coef_discount,10,gnPC)) + pcVal_discount = "0" && ALLTRIM(STR(val_discount,20,gnPC)) + pcId_valuta = ALLTRIM(STR(id_valuta)) + pcUm = NVL(ALLTRIM(um),'') + pcExplicatie = "" && ALLTRIM(explicatie) + + lcSql = [begin pack_crm.adauga_ctr_art(] + pcId_ctr + [,] + pcId_pol_art + [,] + pcPret_unitar + [,] + ; + pcCant + [,] + pcCoef_Discount + [,] + ; + pcVal_discount + [,] + pcId_valuta + [,'] + pcUm + [','] + pcExplicatie +['); end;] + + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + SELECT cAles + ENDSCAN + + SELECT (lcCtrArt) + APPEND FROM DBF('cAles') + + IF USED('cAles') + USE IN cAles + ENDIF + + IF USED('cPol_pret_art') + USE IN cPol_pret_art + ENDIF + ENDIF + CASE gnParametru_prog = 2 && firnizori + LOCAL lcArticole, lcXMLArticole + + lcXMLArticole = caut_articol(0, .F., .T., .T.) + + THIS.cXMLArticole = lcXMLArticole + IF !EMPTY(lcXMLArticole) + + XMLTOCURSOR(lcXMLArticole, "crsArticole") + lcArticole = cursor2lista("crsArticole", "denumire", ",") + THIS.cListaIdArticole = cursor2lista("crsArticole","id_articol",",") + + SELECT crsArticole + SCAN + + pcId_ctr = ALLTRIM(STR(goContract.id_ctr)) + pcId_articol = ALLTRIM(STR(id_articol)) + + lcSql = [begin pack_crm.adauga_ctr_art_furn(] + pcId_ctr + [,] + pcId_articol +[); end;] + lnSucces = goExecutor.oExecute(lcSql) + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + SELECT crsArticole + ENDSCAN + + SELECT crsArticole.*, denumire AS nume_articol FROM crsArticole INTO CURSOR crsArticole2 + + SELECT (lcCtrArt) + APPEND FROM DBF('crsArticole2') + + + USE IN crsArticole + USE IN crsArticole2 + ENDIF + ENDCASE + + THISFORM.afisactual() + THISFORM.grid_articole.SETFOCUS() + + THISFORM.ALWAYSONTOP = .T. + + + ENDPROC + + PROCEDURE do_modifica_ctr_art + LOCAL lcTabel + lcTabel = thisform.grid_articole.RecordSource + + PRIVATE pcParametru_prog, pcId_ctr, pcId_pol_art, pcId_articol, pcCant, pcPret_unitar, pcCoef_discount, pcVal_discount, pcId_valuta + STORE '' TO pcId_ctr, pcId_pol_art, pcId_articol, pcCant, pcPret_unitar, pcCoef_discount, pcVal_discount, pcId_valuta + + pcId_ctr = ALLTRIM(STR(goContract.id_ctr)) + + SELECT (lcTabel) + pcParametru_prog = ALLTRIM(STR(gnParametru_prog)) + pcId_pol_art = ALLTRIM(STR(id_pol_art)) + pcId_articol = NVL(ALLTRIM(STR(id_articol)),'NULL') + pcCant = NVL(ALLTRIM(STR(cant,10,gnPCant)),"") + pcPret_unitar = ALLTRIM(STR(pret_unitar,20,gnPC)) + pcCoef_discount = ALLTRIM(STR(coef_discount,10,gnPC)) + pcVal_discount = ALLTRIM(STR(val_discount,20,gnPC)) + pcId_valuta = ALLTRIM(STR(id_valuta)) + + lcSql = [begin pack_crm.modifica_ctr_art(] + pcParametru_prog + [,] + pcId_ctr + [,] + pcId_pol_art + [,] + pcId_articol + [,] + pcCant + [,] + ; + pcPret_unitar + [,] + pcCoef_discount + [,] + pcVal_discount + [,] + pcId_valuta + [); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + + ENDPROC + + PROCEDURE inainte_de_do_sterge + PRIVATE pcId_ctr, pcId_pol_art + STORE '' TO pcId_ctr, pcId_pol_art + + LOCAL lcTabelCtrArt, lnRaspuns + + lcTabelCtrArt = THISFORM.grid_articole.RECORDSOURCE + STORE 0 TO lnRaspuns + + SELECT (lcTabelCtrArt) + lnRaspuns = amessage('Doriti sa stergeti prestatia?',4+32,_SCREEN.CAPTION) + IF lnRaspuns = 7 && 7 = No ; 6 = Yes + RETURN + ENDIF + + pcId_ctr = ALLTRIM(STR(goContract.id_ctr)) + SELECT (lcTabelCtrArt) + + DO CASE + CASE gnParametru_prog = 1 + pcId_pol_art = ALLTRIM(STR(id_pol_art)) + CASE gnParametru_prog = 2 + pcId_pol_art = ALLTRIM(STR(id_articol)) + ENDCASE + + + lcSql = [begin pack_crm.sterge_ctr_art(] + ALLTRIM(STR(gnParametru_prog)) + [,] + pcId_ctr + [,] + pcId_pol_art + [); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + SELECT (lcTabelCtrArt) + DELETE + + THISFORM.afisactual() + THISFORM.grid_articole.REFRESH + THISFORM.grid_articole.SETFOCUS + + + ENDPROC + + PROCEDURE Init + DODEFAULT() + + LOCAL llDiscountSalvat + llDiscountSalvat = .T. + thisform.afisactual(llDiscountSalvat) + + ENDPROC + + PROCEDURE grid_articole.cCant.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewValue = thisform.cOldValue + ENDPROC + + PROCEDURE grid_articole.cCant.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_articole.cCant.Text1.LostFocus + LOCAL lcTabel + lcTabel = THIS.PARENT.PARENT.RECORDSOURCE + + IF THISFORM.cOldValue <> THISFORM.cNewValue + thisform.do_modifica_ctr_art() + + SELECT (lcTabel) + REPLACE valoare WITH cant * pret_unitar && , valcdiscount WITH (cant*pret_unitar)*(100-discount)/100 + THISFORM.afisactual + ENDIF + + ENDPROC + + PROCEDURE grid_articole.cCoef_Discount.Text1.GotFocus + thisform.cOldValue = this.Value + thisform.cNewValue = thisform.cOldValue + + ENDPROC + + PROCEDURE grid_articole.cCoef_Discount.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + + ENDPROC + + PROCEDURE grid_articole.cCoef_Discount.Text1.LostFocus + LOCAL lcTabel + lcTabel = THIS.PARENT.PARENT.RECORDSOURCE + + IF THISFORM.cOldValue <> THISFORM.cNewValue + + REPLACE val_discount WITH pret_unitar * cant * coef_discount / 100 + thisform.do_modifica_ctr_art() + + SELECT (lcTabel) + REPLACE valoare WITH cant * pret_unitar && , valcdiscount WITH (cant*pret_unitar)*(100-discount)/100 + THISFORM.afisactual + ENDIF + + ENDPROC + + PROCEDURE grid_articole.cNume_val.Text1.DblClick + LOCAL locauta + locauta = caut_valuta() + IF buton = 2 + RETURN + ENDIF + + LOCAL lcTabel + lcTabel = this.Parent.Parent.RecordSource + + SELECT (lcTabel) + REPLACE id_valuta WITH locauta.id_valuta, nume_val WITH locauta.nume_val + + *IF THISFORM.cOldValue <> THISFORM.cNewValue + thisform.do_modifica_ctr_art() + *ENDIF + + + + this.Parent.Parent.Refresh + ENDPROC + + PROCEDURE grid_articole.cPret_unitar.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewValue = thisform.cOldValue + + ENDPROC + + PROCEDURE grid_articole.cPret_unitar.Text1.InteractiveChange + thisform.cNewValue = this.Value + + ENDPROC + + PROCEDURE grid_articole.cPret_unitar.Text1.LostFocus + LOCAL lcTabel + lcTabel = THIS.PARENT.PARENT.RECORDSOURCE + + + IF THISFORM.cOldValue <> THISFORM.cNewValue + thisform.do_modifica_ctr_art() + SELECT (lcTabel) + REPLACE valoare WITH cant * pret_unitar && , valcdiscount WITH (cant*pret_unitar)*(100-discount)/100 + THISFORM.afisactual + ENDIF + + ENDPROC + + PROCEDURE grid_articole.cValcDiscount.Text1.LostFocus + lcTabel = this.Parent.Parent.RecordSource + SELECT (lcTabel) + *REPLACE val_discount WITH (valoare - valcdiscount)*100/valoare + thisform.afisactual + ENDPROC + + PROCEDURE grid_articole.cVal_discount.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.coldvalue + + ENDPROC + + PROCEDURE grid_articole.cVal_discount.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_articole.cVal_discount.Text1.LostFocus + LOCAL lcTabel + lcTabel = THIS.PARENT.PARENT.RECORDSOURCE + + IF THISFORM.cOldValue <> THISFORM.cNewValue + IF pret_unitar * cant <> 0 + REPLACE coef_discount WITH val_discount / (pret_unitar * cant) * 100 + ENDIF + + thisform.do_modifica_ctr_art() + + SELECT (lcTabel) + REPLACE valoare WITH cant * pret_unitar && , valcdiscount WITH (cant*pret_unitar)*(100-discount)/100 + THISFORM.afisactual + ENDIF + + ENDPROC + + PROCEDURE txtCoef_discount.Valid + * IF EMPTY(goContract.val_discount) + *goContract.val_discount = ROUND(THISFORM.nValcdiscount * THISFORM.nCoef_discount / 100,gnPC) + goContract.val_discount = ROUND(THISFORM.nSumaArticole * THISFORM.nCoef_discount / 100,gnPC) + *goContract.valftva = THISFORM.nValcdiscount - goContract.val_discount + goContract.valftva = THISFORM.nSumaArticole - goContract.val_discount + goContract.valctva = goContract.valftva * (1+goContract.proc_tva/100) + + THISFORM.txtValDiscountTotal.REFRESH + THISFORM.txtValftva.REFRESH + THISFORM.txtValctva.REFRESH + * ENDIF + + ENDPROC + + PROCEDURE txtProc_tva.Valid + goContract.valctva = goContract.valftva * (1+goContract.proc_tva/100) + THISFORM.txtValctva.REFRESH + ENDPROC + + PROCEDURE txtValDiscountTotal.Valid + *thisform.nCoef_discount = ROUND(goContract.val_discount / thisform.nValcdiscount * 100, gnPC) + thisform.nCoef_discount = ROUND(goContract.val_discount / thisform.nSumaArticole * 100, gnPC) + *goContract.valftva = thisform.nValcdiscount - goContract.val_discount + goContract.valftva = thisform.nSumaArticole - goContract.val_discount + goContract.valctva = goContract.valftva * (1+goContract.proc_tva/100) + + thisform.txtCoef_discount.Refresh + thisform.txtValftva.Refresh + thisform.txtValctva.Refresh + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_observatii AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Edit1" UniqueID="" Timestamp="" /> + + * + BorderStyle = 1 + DoCreate = .T. + Height = 330 + Name = "frm_dg_observatii" + Width = 452 + _shape1.Name = "_shape1" + _shape2.Name = "_shape2" + Lb_titlu_alb_b121.Caption = "Clauze speciale si observatii" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + Gridsort1.Left = 233 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 4 + * + + ADD OBJECT 'Edit1' AS editbox WITH ; + Anchor = 15, ; + ControlSource = "goContract.observatii", ; + Height = 276, ; + Left = 12, ; + Name = "Edit1", ; + Top = 36, ; + Width = 408 + *< END OBJECT: BaseClass="editbox" /> + +ENDDEFINE + +DEFINE CLASS frm_dg_tf AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="grid_scadentar" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cNr_rata.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cNr_rata.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cData_rata.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cData_rata.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cValrata.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cValrata.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cDen_rata.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cDen_rata.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cProcent.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cProcent.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cNume_val.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cNume_val.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cData_scadenta.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_scadentar.cData_scadenta.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtRate" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtProcente" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtScadenta_incasare" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label13" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtCoef_penalitati" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdMultiplicaRate" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdAplicaScadenta" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + + * + *m: afisactual + *m: do_modifica_scadentar + *p: cnewvalue + *p: coldvalue + *p: nprocente + *p: nrate + * + + * + BorderStyle = 1 + cgridsortlist = grid_scadentar + cnewvalue = + coldvalue = + DoCreate = .T. + Height = 364 + Name = "frm_dg_tf" + nprocente = 0 + nrate = 0 + Width = 551 + _shape1.Name = "_shape1" + _shape2.Anchor = 3 + _shape2.Height = 29 + _shape2.Left = 301 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 64 + Lb_titlu_alb_b121.Caption = "Termene de facturare si achitare" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 6 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 7 + Gridsort1.Left = 120 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 0 + * + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 3, ; + Enabled = .F., ; + Left = 302, ; + Name = "But_nou1", ; + TabIndex = 2, ; + Top = 1 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 3, ; + Enabled = .F., ; + Left = 334, ; + Name = "But_sterge1", ; + TabIndex = 3, ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdAplicaScadenta' AS commandbutton WITH ; + Anchor = 12, ; + Caption = "Aplica", ; + Enabled = .F., ; + Height = 22, ; + Left = 482, ; + Name = "cmdAplicaScadenta", ; + TabIndex = 5, ; + Top = 276, ; + Width = 54 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdMultiplicaRate' AS commandbutton WITH ; + Anchor = 6, ; + Caption = "Instrument de multiplicare rate", ; + Enabled = .F., ; + Height = 27, ; + Left = 8, ; + Name = "cmdMultiplicaRate", ; + TabIndex = 4, ; + Top = 333, ; + Width = 312 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Command2' AS commandbutton WITH ; + Anchor = 6, ; + Caption = "Instrument de stergere rate", ; + Height = 27, ; + Left = 8, ; + Name = "Command2", ; + TabIndex = 17, ; + Top = 362, ; + Visible = .F., ; + Width = 312 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'grid_scadentar' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 7, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + GridLineColor = 192,192,192, ; + HeaderHeight = 38, ; + Height = 236, ; + HighlightStyle = 2, ; + Left = 12, ; + Name = "grid_scadentar", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "cCtrScadentar", ; + RowHeight = 18, ; + TabIndex = 1, ; + Top = 36, ; + Width = 528, ; + Column1.ColumnOrder = 1, ; + Column1.ControlSource = "nr_rata", ; + Column1.Enabled = .T., ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "cNr_rata", ; + Column1.ReadOnly = .T., ; + Column1.Width = 29, ; + Column2.ColumnOrder = 3, ; + Column2.ControlSource = "data_rata", ; + Column2.Enabled = .T., ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cData_rata", ; + Column2.ReadOnly = .T., ; + Column2.Width = 55, ; + Column3.ColumnOrder = 6, ; + Column3.ControlSource = "valrata", ; + Column3.Enabled = .F., ; + Column3.FontName = "Arial Narrow", ; + Column3.Format = "rk", ; + Column3.InputMask = (get_mask(20,gnPA)), ; + Column3.Name = "cValrata", ; + Column3.ReadOnly = .T., ; + Column3.Width = 97, ; + Column4.ColumnOrder = 2, ; + Column4.ControlSource = "den_rata", ; + Column4.Enabled = .T., ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "cDen_rata", ; + Column4.ReadOnly = .T., ; + Column4.Width = 146, ; + Column5.ColumnOrder = 5, ; + Column5.ControlSource = "procent", ; + Column5.Enabled = .F., ; + Column5.FontName = "Arial Narrow", ; + Column5.Format = "rk", ; + Column5.InputMask = (get_mask(20,gnPA)), ; + Column5.Name = "cProcent", ; + Column5.ReadOnly = .T., ; + Column5.Width = 69, ; + Column6.ColumnOrder = 7, ; + Column6.ControlSource = "nume_val", ; + Column6.Enabled = .F., ; + Column6.FontName = "Arial Narrow", ; + Column6.Name = "cNume_val", ; + Column6.ReadOnly = .T., ; + Column6.Width = 45, ; + Column7.ColumnOrder = 4, ; + Column7.ControlSource = "data_scadenta", ; + Column7.Enabled = .T., ; + Column7.FontName = "Arial Narrow", ; + Column7.Name = "cData_scadenta", ; + Column7.ReadOnly = .T., ; + Column7.Width = 59 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_scadentar.cData_rata.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data facturarii", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cData_rata.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .T., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_scadentar.cData_scadenta.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data scadentei", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cData_scadenta.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .T., ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_scadentar.cDen_rata.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Denumire rata", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cDen_rata.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .T., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_scadentar.cNr_rata.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. rata", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cNr_rata.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .T., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_scadentar.cNume_val.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valuta", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cNume_val.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_scadentar.cProcent.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Procent (%)", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cProcent.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_scadentar.cValrata.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare rata valuta (fara TVA)", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_scadentar.cValrata.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Label1' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Suma rate:", ; + Height = 17, ; + Left = 12, ; + Name = "Label1", ; + TabIndex = 11, ; + Top = 305, ; + Width = 62 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label13' AS label WITH ; + Anchor = 12, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Coef.penalitati", ; + Height = 17, ; + Left = 281, ; + Name = "Label13", ; + TabIndex = 16, ; + Top = 305, ; + Width = 81 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Suma procentelor", ; + Height = 17, ; + Left = 12, ; + Name = "Label2", ; + TabIndex = 10, ; + Top = 279, ; + Width = 100 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "%", ; + Height = 17, ; + Left = 186, ; + Name = "Label3", ; + TabIndex = 12, ; + Top = 279, ; + Width = 13 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + Anchor = 12, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "zile", ; + Height = 17, ; + Left = 450, ; + Name = "Label4", ; + TabIndex = 15, ; + Top = 279, ; + Width = 20 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label6' AS label WITH ; + Anchor = 12, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Scadenta incasare", ; + Height = 17, ; + Left = 281, ; + Name = "Label6", ; + TabIndex = 15, ; + Top = 279, ; + Width = 105 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'txtCoef_penalitati' AS textbox WITH ; + Anchor = 12, ; + ControlSource = "goContract.coef_penalitati", ; + Height = 23, ; + Left = 388, ; + Name = "txtCoef_penalitati", ; + ReadOnly = .T., ; + TabIndex = 14, ; + Top = 302, ; + Width = 57 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtProcente' AS textbox WITH ; + Alignment = 3, ; + Anchor = 6, ; + ControlSource = "thisform.nProcente", ; + Format = "rk", ; + Height = 23, ; + InputMask = (get_mask(5,gnPA)), ; + Left = 117, ; + Name = "txtProcente", ; + ReadOnly = .T., ; + TabIndex = 9, ; + TabStop = .F., ; + Top = 276, ; + Value = 0, ; + Width = 61 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtRate' AS textbox WITH ; + Alignment = 3, ; + Anchor = 6, ; + ControlSource = "thisform.nRate", ; + Format = "rk", ; + Height = 23, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 117, ; + Name = "txtRate", ; + ReadOnly = .T., ; + TabIndex = 8, ; + TabStop = .F., ; + Top = 302, ; + Value = 0, ; + Width = 113 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtScadenta_incasare' AS textbox WITH ; + Anchor = 12, ; + ControlSource = "goContract.scadenta_incasare", ; + Format = "rk", ; + Height = 23, ; + InputMask = "99", ; + Left = 388, ; + Name = "txtScadenta_incasare", ; + ReadOnly = .T., ; + TabIndex = 13, ; + Top = 276, ; + Width = 58 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru = pcFiltru + IF EMPTY(lcFiltru) + lcFiltru = poCtrScadentar.ca_baza1.cfiltru + ENDIF + + save_grid_tag(thisform.grid_scadentar) + + poCtrScadentar.ca_baza1.cfiltru = lcFiltru + poCtrScadentar.ca_baza1.afisare() + restore_grid_tag(thisform.grid_scadentar) + IF RECCOUNT('cCtrScadentar')>0 + thisform.grid_scadentar.SetFocus() + ENDIF + ENDPROC + + PROCEDURE afisactual + Local lcTabelRate + lcTabelRate = Thisform.grid_scadentar.RecordSource + + *!* SELECT (lcTabelRate) + *!* CALCULATE SUM(NVL(valrata,0)), SUM(NVL(procent,0)) TO THISFORM.nRate, THISFORM.nProcente + + Select Sum(Nvl(valrata,0)) As valrata, Sum(Nvl(procent,0)) As procent ; + FROM (lcTabelRate) ; + INTO Cursor cTabelRate + Select cTabelRate + Thisform.nRate = valrata + Thisform.nProcente = procent + IF USED('cTabelRate') + USE IN cTabelRate + ENDIF + + *!* SELECT (lcTabelRate) + *!* GO TOP + + Thisform.txtRate.Refresh + Thisform.txtProcente.Refresh + + + + ENDPROC + + PROCEDURE blocheaza_campuri + this.but_nou1.Enabled = .F. + this.but_sterge1.Enabled = .F. + this.grid_scadentar.ReadOnly = .T. + *this.grid_scadentar.Enabled= .F. + this.grid_scadentar.cNume_val.Enabled= .F. + this.grid_scadentar.cProcent.Enabled= .F. + this.grid_scadentar.cValrata.Enabled= .F. + + this.txtScadenta_incasare.ReadOnly = .T. + this.txtCoef_penalitati.ReadOnly = .T. + this.cmdMultiplicaRate.Enabled = .F. + this.cmdAplicaScadenta.Enabled = .F. + + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.but_nou1.Enabled = .T. + this.but_sterge1.Enabled = .T. + this.grid_scadentar.ReadOnly = .F. + *this.grid_scadentar.Enabled= .T. + this.grid_scadentar.cNume_val.Enabled= .T. + this.grid_scadentar.cProcent.Enabled= .T. + this.grid_scadentar.cValrata.Enabled= .T. + + this.txtScadenta_incasare.ReadOnly = .F. + this.txtCoef_penalitati.ReadOnly = .F. + this.cmdMultiplicaRate.Enabled = .T. + this.cmdAplicaScadenta.Enabled = .T. + + ENDPROC + + PROCEDURE do_adauga + PRIVATE pnId_ctr, pnId_scadentar + STORE 0 TO pnId_scadentar + + Local lcTabel, lnRataMax + lcTabel = thisform.grid_scadentar.RecordSource + Store 0 To lnRataMax + + pnId_ctr = goContract.id_ctr + lcSql = [begin pack_crm.adauga_scadentar(?pnId_ctr, ?gnIdUtil, ?@pnId_scadentar); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + thisform.actualizeaza_grid1() + + SELECT (lcTabel) + GO BOTTOM + + + *!* Select (lcTabel) + *!* Calculate Max(nr_rata) To lnRataMax + *!* Append Blank + *!* Replace id_scadentar WITH pnId_scadentar, ; + *!* nr_rata With lnRataMax+1, ; + *!* nume_val With goContract.nume_val, ; + *!* id_valuta With goContract.id_valuta + + + thisform.grid_scadentar.Refresh + + + ENDPROC + + PROCEDURE do_modifica_scadentar + LOCAL lcTabel, lcId_scadentar, lcNr_rata, lcData_rata, lcData_scadenta, lcValrata, lcId_valuta, lcDen_rata, lcProcent + STORE '' TO lcId_scadentar, lcNr_rata, lcData_rata, lcValrata, lcId_valuta, lcDen_rata, lcProcent + + lcTabel = thisform.grid_scadentar.RecordSource + SELECT (lcTabel) + lcId_scadentar = ALLTRIM(STR(id_rata)) + lcNr_rata = NVL(ALLTRIM(STR(nr_rata)),'0') + lcData_rata = ALLTRIM(DTOS(data_rata)) + lcData_scadenta = ALLTRIM(DTOS(data_scadenta)) + lcValrata = NVL(ALLTRIM(STR(valrata,20,gnPC)),'0') + lcId_valuta = NVL(ALLTRIM(STR(id_valuta)),'0') + lcDen_rata = NVL(ALLTRIM(den_rata),'') + lcProcent = NVL(ALLTRIM(STR(procent,5,gnPC)),'0') + + lcSql = [begin pack_crm.modifica_scadentar(] + lcId_scadentar + [,] + lcNr_rata + ; + [,to_date(]+IIF(!EMPTY(lcData_rata) and !ISNULL(lcData_rata),[']+lcData_rata+['],[NULL])+[,'YYYYMMDD')] + ; + [,to_date(]+IIF(!EMPTY(lcData_scadenta) and !ISNULL(lcData_scadenta),[']+lcData_scadenta+['],[NULL])+[,'YYYYMMDD'),] + ; + lcValrata + [,] + lcId_valuta + [,'] + lcDen_rata + [',] + lcProcent + [); end;] + + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + + ENDPROC + + PROCEDURE inainte_de_do_sterge + LOCAL lcTabel, lcId_scadentar + lcTabel = THISFORM.grid_scadentar.RECORDSOURCE + STORE '' TO lcId_scadentar + + SELECT cCtrScadentar && (lcTabel) + lcId_scadentar = ALLTRIM(STR(id_rata)) + + lnRaspuns = AMESSAGEBOX('Doriti sa stergeti rata?',4+32,_SCREEN.CAPTION) + IF lnRaspuns = 7 && 7 = No ; 6 = Yes + RETURN + ENDIF + + lcSql = [begin pack_crm.sterge_scadentar(]+lcId_scadentar + [,] + ALLTRIM(STR(gnIdUtil)) +[); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + THISFORM.actualizeaza_grid1() + + THISFORM.grid_scadentar.REFRESH + THISFORM.afisactual + + + + + ENDPROC + + PROCEDURE Init + DODEFAULT() + thisform.afisactual + + ENDPROC + + PROCEDURE cmdAplicaScadenta.Click + PRIVATE pcId_ctr, pcZileScadenta + pcId_ctr = ALLTRIM(STR(goContract.id_ctr)) + lnZileScadenta = thisform.txtScadenta_incasare.Value + pcZileScadenta = ALLTRIM(STR(lnZileScadenta)) + + + lcSql = [begin pack_crm.update_scadenta(] + pcId_ctr + [,] + pcZileScadenta + [); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + lcTabelRate = thisform.grid_scadentar.RecordSource + + SELECT (lcTabelRate) + REPLACE ALL data_scadenta WITH data_rata + lnZileScadenta + thisform.grid_scadentar.Refresh + ENDPROC + + PROCEDURE cmdMultiplicaRate.Click + PRIVATE pnNrRate, pdDataI, pnValRata, pnId_valuta, pnFrecventa, pcDen_rata, pnPtLuna + STORE 1 TO pnNrRate, pnFrecventa, pnPtLuna + + SELECT cCtrScadentar + pdDataI = data_rata + pnId_valuta = id_valuta + pcNume_val = ALLTRIM(nume_val) + + pnValRata = goContract.valftva + + lomr = CREATEOBJECT("frm_multiplica_rate") + lomr.SHOW(1) + + IF buton = 2 + RETURN + ENDIF + + pcId_ctr = ALLTRIM(STR(goContract.id_ctr)) + + pcDataI = ALLTRIM(DTOS(pdDataI)) + + + lcSql = [begin pack_crm.multiplica_rate(] + pcId_ctr + [,] + ALLTRIM(STR(pnNrRate)) + [, TO_DATE('] + IIF(!EMPTY(pcDataI) and !ISNULL(pcDataI),pcDataI,[NULL]) + [','YYYYMMDD'), ] + ; + ALLTRIM(STR(pnValRata,20,gnPC)) + [,'] + SUBSTR(ALLTRIM(pcDen_rata),1,30) + [',] + NVL(ALLTRIM(STR(pnId_valuta)),[NULL]) + [,] ; + + ALLTRIM(STR(pnFrecventa)) + [,] + ALLTRIM(STR(pnPtLuna)) + [); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN + ENDIF + + thisform.actualizeaza_grid1() + thisform.afisactual + + + ENDPROC + + PROCEDURE grid_scadentar.cData_rata.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + + ENDPROC + + PROCEDURE grid_scadentar.cData_rata.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cData_rata.Text1.LostFocus + IF thisform.cOldvalue<> thisform.cNewvalue + thisform.do_modifica_scadentar() + ENDIF + ENDPROC + + PROCEDURE grid_scadentar.cData_scadenta.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + ENDPROC + + PROCEDURE grid_scadentar.cData_scadenta.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cData_scadenta.Text1.LostFocus + IF thisform.cOldvalue <> thisform.cNewvalue + thisform.do_modifica_scadentar() + ENDIF + ENDPROC + + PROCEDURE grid_scadentar.cDen_rata.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + + ENDPROC + + PROCEDURE grid_scadentar.cDen_rata.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cDen_rata.Text1.LostFocus + *IF thisform.cOldvalue <> thisform.cNewvalue + thisform.do_modifica_scadentar() + *ENDIF + ENDPROC + + PROCEDURE grid_scadentar.cNr_rata.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + + ENDPROC + + PROCEDURE grid_scadentar.cNr_rata.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cNr_rata.Text1.LostFocus + *IF thisform.cOldvalue<> thisform.cNewvalue + thisform.do_modifica_scadentar() + *ENDIF + ENDPROC + + PROCEDURE grid_scadentar.cNume_val.Text1.DblClick + locauta = caut_valuta() + IF buton=2 + RETURN + ENDIF + + lcTabel = this.Parent.Parent.RecordSource + SELECT (lcTabel) + REPLACE id_valuta WITH locauta.id_valuta, nume_val WITH locauta.nume_val + thisform.do_modifica_scadentar() + this.Parent.Parent.Refresh + ENDPROC + + PROCEDURE grid_scadentar.cNume_val.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + + ENDPROC + + PROCEDURE grid_scadentar.cNume_val.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cNume_val.Text1.LostFocus + IF thisform.cOldvalue <> thisform.cNewvalue + thisform.do_modifica_scadentar() + ENDIF + ENDPROC + + PROCEDURE grid_scadentar.cProcent.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + + ENDPROC + + PROCEDURE grid_scadentar.cProcent.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cProcent.Text1.LostFocus + *IF thisform.cOldvalue<> thisform.cNewvalue + thisform.do_modifica_scadentar() + *ENDIF + + LOCAL lnProc + lnProc = this.Value + IF lnProc*0 = 0 AND goContract.valftva*0 = 0&& <> ************* + REPLACE valrata WITH NVL(goContract.valftva,0) * lnProc/100 + ELSE + REPLACE valrata WITH 0 + ENDIF + + thisform.afisactual + + + ENDPROC + + PROCEDURE grid_scadentar.cValrata.Text1.GotFocus + thisform.cOldvalue = this.Value + thisform.cNewvalue = thisform.cOldvalue + + ENDPROC + + PROCEDURE grid_scadentar.cValrata.Text1.InteractiveChange + thisform.cNewvalue = this.Value + + ENDPROC + + PROCEDURE grid_scadentar.cValrata.Text1.LostFocus + * IF thisform.cOldvalue <> thisform.cNewvalue + thisform.do_modifica_scadentar() + * ENDIF + + IF goContract.valftva <> 0 AND goContract.valftva*0 = 0 && <> ************* + REPLACE procent WITH valrata/goContract.valftva * 100 + ELSE + REPLACE procent WITH 0 + ENDIF + THISFORM.afisactual + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_tl AS frm_dg OF "ferestre_contracte.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_pv_nr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_proc_ret" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_val_ret" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_alerta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_proc_alerta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_pv_data" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label8" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_Fact_garant.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label10" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label11" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtGrnt_pv_data_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="BUT_MODIFICA1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command1" UniqueID="" Timestamp="" /> + + * + *m: afisactual + *m: do_modifica_ctr_art + *p: clistaidarticole + *p: cnewvalue + *p: coldvalue + *p: cxmlarticole + *p: ncoef_discount + *p: ndiscountmediu + *p: nsumaarticole + *p: nvalcdiscount + *p: nvaldiscount + * + + * + BorderStyle = 1 + clistaidarticole = + cnewvalue = + coldvalue = + cxmlarticole = + DoCreate = .T. + Height = 287 + Name = "frm_dg_tl" + ncoef_discount = 0 + ndiscountmediu = 0 + nsumaarticole = 0 + nvalcdiscount = 0 + nvaldiscount = 0 + Width = 698 + _shape1.Name = "_shape1" + _shape2.Anchor = 3 + _shape2.Height = 29 + _shape2.Left = 301 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 66 + Lb_titlu_alb_b121.Caption = "Termene de livrare/receptie si Garantii" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 13 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 14 + Gridsort1.Left = 60 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 0 + * + + ADD OBJECT 'BUT_MODIFICA1' AS but_modifica WITH ; + Left = 588, ; + Name = "BUT_MODIFICA1", ; + TabIndex = 11, ; + Top = 41, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Left = 554, ; + Name = "But_nou1", ; + TabIndex = 10, ; + Top = 41 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Left = 621, ; + Name = "But_sterge1", ; + TabIndex = 12, ; + Top = 41, ; + Visible = .T. + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Command1' AS commandbutton WITH ; + AutoSize = .T., ; + Caption = "Atasare factura la contract", ; + Height = 27, ; + Left = 408, ; + Name = "Command1", ; + TabIndex = 8, ; + Top = 5, ; + Width = 159 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'grid_Fact_garant' AS _grdbase WITH ; + ColumnCount = 4, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + Height = 200, ; + Left = 339, ; + Name = "grid_Fact_garant", ; + Panel = 1, ; + RecordSource = "cCtrFactGarant", ; + TabIndex = 9, ; + Top = 73, ; + Width = 338, ; + Column1.ControlSource = "nract", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "Column1", ; + Column1.Width = 67, ; + Column2.ControlSource = "dataact", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "Column2", ; + Column2.Width = 65, ; + Column3.ControlSource = "valftva", ; + Column3.FontName = "Arial Narrow", ; + Column3.Format = "rk", ; + Column3.InputMask = (get_mask(12,gnPA)), ; + Column3.Name = "Column3", ; + Column3.Width = 98, ; + Column4.ControlSource = "garantie", ; + Column4.FontName = "Arial Narrow", ; + Column4.Format = "rk", ; + Column4.InputMask = (get_mask(12,gnPA)), ; + Column4.Name = "Column4", ; + Column4.Width = 70 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_Fact_garant.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_Fact_garant.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_Fact_garant.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_Fact_garant.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_Fact_garant.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare (fara TVA)", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_Fact_garant.Column3.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_Fact_garant.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Garantii retinute", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_Fact_garant.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Label1' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "PV predare-primire finala", ; + Height = 17, ; + Left = 16, ; + Name = "Label1", ; + TabIndex = 23, ; + Top = 177, ; + Width = 139 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label10' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Facturi - Garantii retinute", ; + Height = 17, ; + Left = 348, ; + Name = "Label10", ; + TabIndex = 16, ; + Top = 54, ; + Width = 136, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label11' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data contractuala de predare-primire", ; + Height = 17, ; + Left = 16, ; + Name = "Label11", ; + TabIndex = 24, ; + Top = 152, ; + Width = 204 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Valoare garantie retinuta", ; + Height = 17, ; + Left = 16, ; + Name = "Label2", ; + TabIndex = 22, ; + Top = 77, ; + Width = 136, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Returnare partiala", ; + Height = 17, ; + Left = 16, ; + Name = "Label3", ; + TabIndex = 19, ; + Top = 103, ; + Width = 101, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Procent garantie retinut", ; + Height = 17, ; + Left = 16, ; + Name = "Label4", ; + TabIndex = 15, ; + Top = 51, ; + Width = 129, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label5' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "(nr. zile)", ; + Height = 17, ; + Left = 199, ; + Name = "Label5", ; + TabIndex = 20, ; + Top = 103, ; + Width = 45, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label6' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Procent returnare", ; + Height = 17, ; + Left = 16, ; + Name = "Label6", ; + TabIndex = 21, ; + Top = 129, ; + Width = 97, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label7' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "/", ; + Height = 17, ; + Left = 230, ; + Name = "Label7", ; + TabIndex = 25, ; + Top = 177, ; + Width = 5 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label8' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "%", ; + Height = 17, ; + Left = 199, ; + Name = "Label8", ; + TabIndex = 18, ; + Top = 51, ; + Width = 13, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "%", ; + Height = 17, ; + Left = 199, ; + Name = "Label9", ; + TabIndex = 17, ; + Top = 129, ; + Width = 13, ; + ZOrderSet = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'txtGrnt_alerta1' AS textbox WITH ; + ControlSource = "goContract.grnt_alerta1", ; + Format = "rk", ; + Height = 23, ; + InputMask = "9999", ; + Left = 155, ; + Name = "txtGrnt_alerta1", ; + ReadOnly = .T., ; + TabIndex = 3, ; + Top = 100, ; + Width = 43, ; + ZOrderSet = 39 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtGrnt_proc_alerta1' AS textbox WITH ; + ControlSource = "goContract.grnt_proc_alerta1", ; + Format = "rk", ; + Height = 23, ; + InputMask = (get_mask(4,0)), ; + Left = 155, ; + Name = "txtGrnt_proc_alerta1", ; + ReadOnly = .T., ; + TabIndex = 4, ; + Top = 126, ; + Width = 43, ; + ZOrderSet = 39 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtGrnt_proc_ret' AS textbox WITH ; + ControlSource = "goContract.grnt_proc_ret", ; + Format = "rk", ; + Height = 23, ; + InputMask = (get_mask(4,0)), ; + Left = 155, ; + Name = "txtGrnt_proc_ret", ; + ReadOnly = .T., ; + TabIndex = 1, ; + Top = 48, ; + Width = 43, ; + ZOrderSet = 39 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtGrnt_pv_data' AS textbox WITH ; + ControlSource = "goContract.grnt_pv_data", ; + Format = "rk", ; + Height = 23, ; + Left = 239, ; + Name = "txtGrnt_pv_data", ; + ReadOnly = .T., ; + TabIndex = 7, ; + Top = 174, ; + Width = 72 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtGrnt_pv_data_ctr' AS textbox WITH ; + ControlSource = "goContract.grnt_pv_data_ctr", ; + Format = "rk", ; + Height = 23, ; + Left = 239, ; + Name = "txtGrnt_pv_data_ctr", ; + ReadOnly = .T., ; + TabIndex = 5, ; + Top = 149, ; + Width = 72 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtGrnt_pv_nr' AS textbox WITH ; + ControlSource = "goContract.grnt_pv_nr", ; + Format = "rk", ; + Height = 23, ; + InputMask = "9999999999", ; + Left = 155, ; + Name = "txtGrnt_pv_nr", ; + ReadOnly = .T., ; + TabIndex = 6, ; + Top = 174, ; + Width = 72 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtGrnt_val_ret' AS textbox WITH ; + ControlSource = "goContract.grnt_val_ret", ; + Format = "rk", ; + Height = 23, ; + InputMask = (get_mask(10,gnPA)), ; + Left = 155, ; + Name = "txtGrnt_val_ret", ; + ReadOnly = .T., ; + TabIndex = 2, ; + Top = 74, ; + Width = 156, ; + ZOrderSet = 39 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru = pcFiltru + IF EMPTY(lcFiltru) + lcFiltru = poCtrFactGarant.ca_baza1.cfiltru + ENDIF + + save_grid_tag(thisform.grid_Fact_garant) + + poCtrFactGarant.ca_baza1.cfiltru = lcFiltru + poCtrFactGarant.ca_baza1.afisare() + restore_grid_tag(thisform.grid_Fact_garant) + IF RECCOUNT('cCtrFactGarant')>0 + thisform.grid_Fact_garant.SetFocus() + ENDIF + ENDPROC + + PROCEDURE afisactual + ENDPROC + + PROCEDURE blocheaza_campuri + this.txtgrnt_proc_ret.ReadOnly = .T. + this.txtGrnt_val_ret.ReadOnly = .T. + this.txtGrnt_alerta1.ReadOnly = .T. + this.txtGrnt_proc_alerta1.ReadOnly = .T. + this.txtGrnt_pv_nr.ReadOnly = .T. + this.txtGrnt_pv_data.ReadOnly = .T. + this.txtGrnt_pv_data_ctr.ReadOnly = .T. + + + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.txtgrnt_proc_ret.ReadOnly = .F. + this.txtGrnt_val_ret.ReadOnly = .F. + this.txtGrnt_alerta1.ReadOnly = .F. + this.txtGrnt_proc_alerta1.ReadOnly = .F. + this.txtGrnt_pv_nr.ReadOnly = .F. + this.txtGrnt_pv_data.ReadOnly = .F. + this.txtGrnt_pv_data_ctr.ReadOnly = .F. + + ENDPROC + + PROCEDURE do_adauga + Private poFactGaran + Store '' To poFactGaran + + Local lnNrAct, ldDataAct, lnCod, lnId_fact + Store 0 To lnNrAct, ldDataAct, lnCod, lnId_fact + + Local lcSchema, lcSelect, lcOrder, lcFiltru, lcFiltruOriginal, llAfiseaza, llModParam, lcgroup, lcFiltruOriginal + lcOrder = [ dataact desc] + lcgroup = [] + lcFiltru = [ 1=1 ] + + Do Case + Case gnParametru_prog=1 + lcSchema = [id_fact N(20), nract n(14), dataact d, cod n(20), valctva n(20,2)] + lcSelect = [select id_fact, nract, dataact, cod, debit as valctva from ireg_parteneri ] + lcFiltruOriginal = [ extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna ]+; + [ and id_part = ] + Alltrim(Str(goContract.id_part))+; + [ and id_ctr = ] + Alltrim(Str(goContract.id_ctr))+; + [ and cont = '4111' ] + Case gnParametru_prog=2 + lcSchema = [id_fact N(20), nract n(14), dataact d, cod n(20), valctva n(20,2)] + lcSelect = [select id_fact, nract, dataact, cod, credit as valctva from ireg_parteneri ] + lcFiltruOriginal = [ extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna ]+; + [ and id_part = ] + Alltrim(Str(goContract.id_part))+; + [ and id_ctr = ] + Alltrim(Str(goContract.id_ctr))+; + [ and cont = '401' ] + Otherwise + lcFiltruOriginal = [] + Endcase + + llAfiseaza = .F. + llModParam = .T. + + gencursor('poFactGaran','cFactGaran', lcSelect, lcFiltru, lcSchema, lcOrder, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) + poFactGaran.ca_baza1.afisare() + + Select cFactGaran + lofc = Createobject('frm_facturi_ctr') + lofc.Show(1) + + If buton = 2 + Return + Endif + + ***-------------------- + Private pnFactValftva, pnGarantieRetinuta + Store 0 To pnFactValftva, pnGarantieRetinuta + + Select cFactGaran + lnNrAct = nract + ldDataAct = dataact + lnId_fact = id_fact + lnCod = cod + + Do Case + Case gnParametru_prog=2 + If Year(ldDataAct)>=2007 + lcSql = [select totctva -(ro19bct+ro19bvt+ro19bft+ro09bct+ro09bvt+ro09bft+fo19bct+fo19bvt+fo19bft+fo09bct+fo09bvt+fo09bft+cebct+cebvt+cebft+ti19bct+ti19bvt+ti19bft+ti09bvt+ti09bft) as valftva ] +; + [ from jc2007 ]+; + [ where cod = ]+Alltrim(Str(lnCod)) + ELSE + lcSql = [select totctva -(tvai+tvam) as valftva ] +; + [ from cump ]+; + [ where cod = ]+Alltrim(Str(lnCod)) + Endif + lcCursor = [cJC_fact] + lnSucces = goExecutor.oExecute(lcSql, lcCursor) + + If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + Select cJC_fact + pnFactValftva = valftva + + + If Used('cJC_fact') + Use In cJC_fact + Endif + Endcase + + pnGarantieRetinuta = Round(pnFactValftva * goContract.grnt_proc_ret / 100,gnPA) + + lofg = Createobject('frm_fact_garant') + lofg.Show(1) + + If buton = 2 + Return + Endif + + lcSql = [begin pack_crm.adauga_factura_garantie(]+Alltrim(Str(goContract.id_ctr))+[,] + Alltrim(Str(lnId_fact))+[,]+; + ALLTRIM(Str(pnFactValftva,20,gnPA))+[,]+Alltrim(Str(pnGarantieRetinuta,20,gnPA))+[); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + Thisform.actualizeaza_grid1() + Thisform.grid_Fact_garant.Refresh + + && Insert Into cCtrFactGarant (nract, dataact, valftva, garantie) Values (lnNrAct, ldDataAct, pnFactValftva, pnGarantieRetinuta) + + + + ENDPROC + + PROCEDURE do_modifica_ctr_art + ENDPROC + + PROCEDURE inainte_de_do_modifica + Private pnFactValftva, pnGarantieRetinuta + STORE 0 TO pnFactValftva, pnGarantieRetinuta + + LOCAL lnId_ctr_fact_garan + STORE 0 TO lnId_ctr_fact_garan + + SELECT cCtrFactGarant + lnId_ctr_fact_garan = id_ctr_fact_garan + pnFactValftva = valftva + pnGarantieRetinuta = garantie + + lofg = Createobject('frm_fact_garant') + lofg.Show(1) + + If buton = 2 + Return + Endif + + lcSql = [begin pack_crm.modifica_factura_garantie(]+ALLTRIM(STR(lnId_ctr_fact_garan))+[,]+; + ALLTRIM(Str(pnFactValftva,20,gnPA))+[,]+Alltrim(Str(pnGarantieRetinuta,20,gnPA))+[); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return + ENDIF + + thisform.actualizeaza_grid1() + thisform.grid_Fact_garant.Refresh + ENDPROC + + PROCEDURE inainte_de_do_sterge + LOCAL lnRaspuns, lnId_ctr_fact_garan, lcSql, lnSucces + + lnRaspuns = AMESSAGEBOX('Doriti sa stergeti inregistrarea?',4+32,_SCREEN.CAPTION) + IF lnRaspuns = 7 && 7 = No ; 6 = Yes + RETURN + ENDIF + + SELECT cCtrFactGarant + lnId_ctr_fact_garan = id_ctr_fact_garan + + lcSql = [begin pack_crm.sterge_factura_garantie(]+Alltrim(Str(lnId_ctr_fact_garan))+[); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return + ENDIF + + thisform.actualizeaza_grid1() + thisform.grid_Fact_garant.Refresh + + ENDPROC + + PROCEDURE Command1.Click + Private poFactGaran + Store '' To poFactGaran + + Local lcSchema, lcSelect, lcOrder, lcFiltru, lcFiltruOriginal, llAfiseaza, llModParam, lcgroup, lcFiltruOriginal + lcOrder = [dataact desc] + lcgroup = [] + lcFiltru = [ 1=1 ] + + Do Case + Case gnParametru_prog=1 + lcSchema = [] + lcSelect = [select distinct id_ctr, contract, fdoc, nract, dataact, dataireg, debit as suma, id_fact, cod, explicatia, 0 as atasata ]+; + [ from vireg_emise_in_perioada ] + lcFiltruOriginal = [ id_part = ]+ Alltrim(Str(goContract.id_part))+; + [ and (id_ctr is null or id_ctr = ]+ Alltrim(Str(goContract.id_ctr))+ [ or id_ctr = 0)] + Case gnParametru_prog=2 + lcSchema = [] + lcSelect = [select distinct id_ctr, contract, fdoc, nract, dataact, dataireg, credit as suma, id_fact, cod, explicatia, 0 as atasata ]+; + [ from vireg_emise_in_perioada ] + lcFiltruOriginal = [ id_part = ]+ Alltrim(Str(goContract.id_part))+; + [ and (id_ctr is null or id_ctr = ]+ Alltrim(Str(goContract.id_ctr))+ [ or id_ctr = 0)] + Otherwise + lcFiltruOriginal = [] + Endcase + + llAfiseaza = .F. + llModParam = .T. + + gencursor('poFactGaran','cFact_neatas', lcSelect, lcFiltru, lcSchema, lcOrder, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) + poFactGaran.ca_baza1.afisare() + + Select cFact_neatas + lofc = Createobject('frm_atas_fact_iregpart') + lofc.Show(1) + + Release poFactGaran + + ENDPROC + + PROCEDURE txtGrnt_proc_ret.Valid + IF !ISNULL(gocontract.valftva) + goContract.grnt_val_ret = gocontract.valftva * goContract.grnt_proc_ret / 100 + thisform.txtGrnt_val_ret.Refresh + ENDIF + ENDPROC + +ENDDEFINE diff --git a/Clase/Copy of ofundal_roaclienti.vc2 b/Clase/Copy of ofundal_roaclienti.vc2 new file mode 100644 index 0000000..0b6aac6 --- /dev/null +++ b/Clase/Copy of ofundal_roaclienti.vc2 @@ -0,0 +1,675 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="copy of ofundal_roaclienti.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS pagefr AS pg_meniu OF "..\comun\clase\ofundal.vcx" + *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Page2.Ct_registratura1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page3.Ct_date_generale1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page3.Ct_part_nr_data1" UniqueID="" Timestamp="" /> + + * + ActivePage = 2 + ErasePage = .T. + Height = 578 + Name = "pagefr" + PageCount = 3 + Width = 800 + Page1.Caption = "Definire" + Page1.Name = "Page1" + Page2.Caption = "Lista documentelor" + Page2.Name = "Page2" + Page3.BackColor = 255,255,255 + Page3.Caption = "Datele documentului" + Page3.Name = "Page3" + * + + ADD OBJECT 'Page2.Ct_registratura1' AS ct_registratura WITH ; + Left = -2, ; + Name = "Ct_registratura1", ; + Top = 0, ; + Gridsort1.Name = "Gridsort1", ; + _ct_controller_keypress1.Name = "_ct_controller_keypress1", ; + grid_registratura.cData_ctr.Header1.Name = "Header1", ; + grid_registratura.cData_ctr.Name = "cData_ctr", ; + grid_registratura.cData_ctr.Text1.Name = "Text1", ; + grid_registratura.cNr_ctr.Header1.Name = "Header1", ; + grid_registratura.cNr_ctr.Name = "cNr_ctr", ; + grid_registratura.cNr_ctr.Text1.Name = "Text1", ; + grid_registratura.cNume.Header1.Name = "Header1", ; + grid_registratura.cNume.Name = "cNume", ; + grid_registratura.cNume.Text1.Name = "Text1", ; + grid_registratura.Column12.Header1.Name = "Header1", ; + grid_registratura.Column12.Name = "Column12", ; + grid_registratura.Column12.Text1.Name = "Text1", ; + grid_registratura.Column14.Header1.Name = "Header1", ; + grid_registratura.Column14.Name = "Column14", ; + grid_registratura.Column14.Text1.Name = "Text1", ; + grid_registratura.Column15.Header1.Name = "Header1", ; + grid_registratura.Column15.Name = "Column15", ; + grid_registratura.Column15.Text1.Name = "Text1", ; + grid_registratura.Name = "grid_registratura", ; + But_nou1.Name = "But_nou1", ; + But_sterge1.Name = "But_sterge1", ; + Clb_tx_simplu1.Lb_simplu1.Name = "Lb_simplu1", ; + Clb_tx_simplu1.Name = "Clb_tx_simplu1", ; + Clb_tx_simplu1.Text_simplu1.Name = "Text_simplu1", ; + But_listare1.Name = "But_listare1", ; + But_excel1.Name = "But_excel1", ; + Ck_data_ctr.Alignment = 0, ; + Ck_data_ctr.Name = "Ck_data_ctr", ; + Ck_nume.Alignment = 0, ; + Ck_nume.Name = "Ck_nume", ; + Ck_nr_ctr.Alignment = 0, ; + Ck_nr_ctr.Name = "Ck_nr_ctr", ; + Cmd_reset1.Name = "Cmd_reset1", ; + Cmd_cauta1.Name = "Cmd_cauta1" + *< END OBJECT: ClassLib="ferestre_registratura.vcx" BaseClass="container" /> + + ADD OBJECT 'Page3.Ct_date_generale1' AS ct_date_generale WITH ; + Anchor = 15, ; + Left = 1, ; + Name = "Ct_date_generale1", ; + Top = 0, ; + outlook2003bar1.Left = 1, ; + outlook2003bar1.Name = "outlook2003bar1", ; + outlook2003bar1.overflowpanel.MenuButton.imgPicture.Height = 16, ; + outlook2003bar1.overflowpanel.MenuButton.imgPicture.Name = "imgPicture", ; + outlook2003bar1.overflowpanel.MenuButton.imgPicture.Width = 16, ; + outlook2003bar1.overflowpanel.MenuButton.Name = "MenuButton", ; + outlook2003bar1.overflowpanel.Name = "overflowpanel", ; + outlook2003bar1.Panel.Name = "Panel", ; + outlook2003bar1.Panes.ErasePage = .T., ; + outlook2003bar1.Panes.Height = 328, ; + outlook2003bar1.Panes.Name = "Panes", ; + outlook2003bar1.Panes.Pane1.Name = "Pane1", ; + outlook2003bar1.Panes.Pane1.Olecontrol1.Height = 328, ; + outlook2003bar1.Panes.Pane1.Olecontrol1.Left = 0, ; + outlook2003bar1.Panes.Pane1.Olecontrol1.Name = "Olecontrol1", ; + outlook2003bar1.Panes.Pane1.Olecontrol1.Top = 0, ; + outlook2003bar1.Panes.Pane1.Olecontrol1.Width = 198, ; + outlook2003bar1.Panes.Pane1.Olecontrol2.Height = 150, ; + outlook2003bar1.Panes.Pane1.Olecontrol2.Name = "Olecontrol2", ; + outlook2003bar1.Panes.Pane1.Olecontrol2.Width = 200, ; + outlook2003bar1.Panes.Pane2.Name = "Pane2", ; + outlook2003bar1.Panes.Pane3.Name = "Pane3", ; + outlook2003bar1.Panes.Pane4.Name = "Pane4", ; + outlook2003bar1.Panes.Pane5.Name = "Pane5", ; + outlook2003bar1.Panes.Pane6.Name = "Pane6", ; + outlook2003bar1.Panes.Pane7.Name = "Pane7", ; + outlook2003bar1.Panes.Top = 33, ; + outlook2003bar1.SplitBar.imgSplitter.Height = 3, ; + outlook2003bar1.SplitBar.imgSplitter.Name = "imgSplitter", ; + outlook2003bar1.SplitBar.imgSplitter.Width = 35, ; + outlook2003bar1.SplitBar.Name = "SplitBar", ; + outlook2003bar1.Splitter.Name = "Splitter", ; + outlook2003bar1.Title.lblCaption.Name = "lblCaption", ; + outlook2003bar1.Title.linBorder.Name = "linBorder", ; + outlook2003bar1.Title.Name = "Title", ; + outlook2003bar1.Top = 1 + *< END OBJECT: ClassLib="ferestre_registratura.vcx" BaseClass="container" /> + + ADD OBJECT 'Page3.Ct_part_nr_data1' AS ct_part_nr_data WITH ; + Anchor = 11, ; + Left = 201, ; + Name = "Ct_part_nr_data1", ; + Top = 0, ; + Shape1.Name = "Shape1", ; + CMDDENUMIRE.Name = "CMDDENUMIRE", ; + Label3.Name = "Label3", ; + txtClient.Name = "txtClient", ; + Label4.Name = "Label4", ; + txtNumar.Name = "txtNumar", ; + Label9.Name = "Label9", ; + txtData_ctr.Name = "txtData_ctr", ; + Command2.Name = "Command2", ; + Line1.Name = "Line1", ; + lb_actAd.Name = "lb_actAd" + *< END OBJECT: ClassLib="ferestre_registratura.vcx" BaseClass="container" /> + +ENDDEFINE + +DEFINE CLASS princ AS ffergen OF "..\comun\clase\_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="Image2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Pagefr1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Pagefr1.Page1.shape1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Pagefr1.Page1.Cw2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Pagefr1.Page1.Cw1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Pagefr1.Page1.Cw4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Image1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_utilizator" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_utilizator1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_nivel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_nivel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Imagine01" UniqueID="" Timestamp="" /> + + * + *p: cgridsortlist + * + + * + AlwaysOnTop = .F. + BackColor = 255,255,255 + BorderStyle = 0 + Caption = "" + cgridsortlist = grid_registratura + Closable = .F. + ControlBox = .F. + DoCreate = .T. + Height = 584 + Left = 0 + MaxButton = .F. + MinButton = .F. + Movable = .F. + Name = "princ" + ShowTips = .T. + Top = 0 + Width = 793 + WindowState = 2 + * + + ADD OBJECT 'Image1' AS image WITH ; + Anchor = 12, ; + Height = 220, ; + Left = 226, ; + Name = "Image1", ; + Picture = ..\grafice\roaclienti.bmp, ; + Top = 235, ; + Width = 556, ; + ZOrderSet = 2 + *< END OBJECT: BaseClass="image" /> + + ADD OBJECT 'Image2' AS image WITH ; + BackStyle = 1, ; + Height = 63, ; + Left = 0, ; + Name = "Image2", ; + Picture = ..\grafice\f1.jpg, ; + Stretch = 2, ; + Top = 0, ; + Width = 804, ; + ZOrderSet = 0 + *< END OBJECT: BaseClass="image" /> + + ADD OBJECT 'Imagine01' AS imagine WITH ; + ccod = A01, ; + Height = 55, ; + Left = 6, ; + Name = "Imagine01", ; + nid_img = 1, ; + ntip = 4, ; + picturedown = clie2.bmp, ; + pictureup = clie1.bmp, ; + ToolTipText = "Vizualizare parteneri", ; + Top = 0, ; + Width = 42 + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="image" /> + + ADD OBJECT 'lb_nivel' AS label WITH ; + Anchor = 6, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nivel de acces:", ; + FontItalic = .T., ; + ForeColor = 0,0,128, ; + Height = 17, ; + Left = 216, ; + Name = "lb_nivel", ; + Top = 443, ; + Visible = .F., ; + Width = 85 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'lb_nivel1' AS textbox WITH ; + Anchor = 6, ; + BackStyle = 0, ; + BorderStyle = 0, ; + ControlSource = "m.nivel", ; + FontBold = .T., ; + FontItalic = .T., ; + ForeColor = 0,0,128, ; + Height = 23, ; + Left = 307, ; + Name = "lb_nivel1", ; + ReadOnly = .T., ; + TabStop = .F., ; + Top = 442, ; + Visible = .F., ; + Width = 28 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'lb_utilizator' AS lb_simplu WITH ; + Anchor = 8, ; + Caption = "Operator:", ; + FontItalic = .T., ; + ForeColor = 255,255,255, ; + Left = 580, ; + Name = "lb_utilizator", ; + Top = 8, ; + ZOrderSet = 4 + *< END OBJECT: ClassLib="..\comun\clase\lb.vcx" BaseClass="label" /> + + ADD OBJECT 'lb_utilizator1' AS lb_simplu WITH ; + Anchor = 8, ; + Caption = "nume_utilizator", ; + FontBold = .T., ; + FontItalic = .T., ; + ForeColor = 255,255,255, ; + Left = 634, ; + Name = "lb_utilizator1", ; + Top = 8, ; + Visible = .F., ; + ZOrderSet = 5 + *< END OBJECT: ClassLib="..\comun\clase\lb.vcx" BaseClass="label" /> + + ADD OBJECT 'Pagefr1' AS pagefr WITH ; + ErasePage = .T., ; + Height = 475, ; + Left = -1, ; + Name = "Pagefr1", ; + Top = 59, ; + Width = 804, ; + Page1.Name = "Page1", ; + Page2.Ct_registratura1.But_excel1.Name = "But_excel1", ; + Page2.Ct_registratura1.But_listare1.Name = "But_listare1", ; + Page2.Ct_registratura1.But_nou1.Name = "But_nou1", ; + Page2.Ct_registratura1.But_sterge1.Name = "But_sterge1", ; + Page2.Ct_registratura1.Ck_data_ctr.Alignment = 0, ; + Page2.Ct_registratura1.Ck_data_ctr.Name = "Ck_data_ctr", ; + Page2.Ct_registratura1.Ck_nr_ctr.Alignment = 0, ; + Page2.Ct_registratura1.Ck_nr_ctr.Name = "Ck_nr_ctr", ; + Page2.Ct_registratura1.Ck_nume.Alignment = 0, ; + Page2.Ct_registratura1.Ck_nume.Name = "Ck_nume", ; + Page2.Ct_registratura1.Clb_tx_simplu1.Lb_simplu1.Name = "Lb_simplu1", ; + Page2.Ct_registratura1.Clb_tx_simplu1.Name = "Clb_tx_simplu1", ; + Page2.Ct_registratura1.Clb_tx_simplu1.Text_simplu1.Name = "Text_simplu1", ; + Page2.Ct_registratura1.Cmd_cauta1.Name = "Cmd_cauta1", ; + Page2.Ct_registratura1.Cmd_reset1.Name = "Cmd_reset1", ; + Page2.Ct_registratura1.Gridsort1.Name = "Gridsort1", ; + Page2.Ct_registratura1.grid_registratura.cData_ctr.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cData_ctr.Name = "cData_ctr", ; + Page2.Ct_registratura1.grid_registratura.cData_ctr.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNr_ctr.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNr_ctr.Name = "cNr_ctr", ; + Page2.Ct_registratura1.grid_registratura.cNr_ctr.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNume.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNume.Name = "cNume", ; + Page2.Ct_registratura1.grid_registratura.cNume.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.Column12.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.Column12.Name = "Column12", ; + Page2.Ct_registratura1.grid_registratura.Column12.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.Column14.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.Column14.Name = "Column14", ; + Page2.Ct_registratura1.grid_registratura.Column14.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.Column15.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.Column15.Name = "Column15", ; + Page2.Ct_registratura1.grid_registratura.Column15.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.Name = "grid_registratura", ; + Page2.Ct_registratura1.Name = "Ct_registratura1", ; + Page2.Ct_registratura1._ct_controller_keypress1.Name = "_ct_controller_keypress1", ; + Page2.Name = "Page2", ; + Page3.Ct_date_generale1.Left = 1, ; + Page3.Ct_date_generale1.Name = "Ct_date_generale1", ; + Page3.Ct_date_generale1.outlook2003bar1.Name = "outlook2003bar1", ; + Page3.Ct_date_generale1.outlook2003bar1.OVERFLOWPANEL.MENUBUTTON.IMGPICTURE.Height = 16, ; + Page3.Ct_date_generale1.outlook2003bar1.OVERFLOWPANEL.MENUBUTTON.IMGPICTURE.Name = "IMGPICTURE", ; + Page3.Ct_date_generale1.outlook2003bar1.OVERFLOWPANEL.MENUBUTTON.IMGPICTURE.Width = 16, ; + Page3.Ct_date_generale1.outlook2003bar1.OVERFLOWPANEL.MENUBUTTON.Name = "MENUBUTTON", ; + Page3.Ct_date_generale1.outlook2003bar1.OVERFLOWPANEL.Name = "OVERFLOWPANEL", ; + Page3.Ct_date_generale1.outlook2003bar1.Panel.Name = "Panel", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.ErasePage = .T., ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.Height = 328, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.Name = "PANES", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Name = "PANE1", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol1.Height = 328, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol1.Left = 0, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol1.Name = "Olecontrol1", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol1.Top = 0, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol1.Width = 198, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol2.Height = 150, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol2.Name = "Olecontrol2", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE1.Olecontrol2.Width = 200, ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE2.Name = "PANE2", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE3.Name = "PANE3", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE4.Name = "PANE4", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE5.Name = "PANE5", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE6.Name = "PANE6", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.PANE7.Name = "PANE7", ; + Page3.Ct_date_generale1.outlook2003bar1.PANES.Top = 33, ; + Page3.Ct_date_generale1.outlook2003bar1.SplitBar.IMGSPLITTER.Height = 3, ; + Page3.Ct_date_generale1.outlook2003bar1.SplitBar.IMGSPLITTER.Name = "IMGSPLITTER", ; + Page3.Ct_date_generale1.outlook2003bar1.SplitBar.IMGSPLITTER.Width = 35, ; + Page3.Ct_date_generale1.outlook2003bar1.SplitBar.Name = "SplitBar", ; + Page3.Ct_date_generale1.outlook2003bar1.SPLITTER.Name = "SPLITTER", ; + Page3.Ct_date_generale1.outlook2003bar1.TITLE.LBLCAPTION.Name = "LBLCAPTION", ; + Page3.Ct_date_generale1.outlook2003bar1.TITLE.LINBORDER.Name = "LINBORDER", ; + Page3.Ct_date_generale1.outlook2003bar1.TITLE.Name = "TITLE", ; + Page3.Ct_date_generale1.Top = 7, ; + Page3.Ct_date_generale1.Width = 800, ; + Page3.Ct_part_nr_data1.CMDDENUMIRE.Name = "CMDDENUMIRE", ; + Page3.Ct_part_nr_data1.Command2.Name = "Command2", ; + Page3.Ct_part_nr_data1.Label3.Name = "Label3", ; + Page3.Ct_part_nr_data1.Label4.Name = "Label4", ; + Page3.Ct_part_nr_data1.Label9.Name = "Label9", ; + Page3.Ct_part_nr_data1.lb_actAd.Name = "lb_actAd", ; + Page3.Ct_part_nr_data1.Left = 201, ; + Page3.Ct_part_nr_data1.Line1.Name = "Line1", ; + Page3.Ct_part_nr_data1.Name = "Ct_part_nr_data1", ; + Page3.Ct_part_nr_data1.Shape1.Name = "Shape1", ; + Page3.Ct_part_nr_data1.Top = 7, ; + Page3.Ct_part_nr_data1.txtClient.Name = "txtClient", ; + Page3.Ct_part_nr_data1.txtData_ctr.Name = "txtData_ctr", ; + Page3.Ct_part_nr_data1.txtNumar.Name = "txtNumar", ; + Page3.Enabled = .F., ; + Page3.Name = "Page3" + *< END OBJECT: ClassLib="ofundal_roaclienti.vcx" BaseClass="pageframe" /> + + ADD OBJECT 'Pagefr1.Page1.Cw1' AS cw WITH ; + Height = 20, ; + Left = 4, ; + Name = "Cw1", ; + nid_cw = 1, ; + ntip = 4, ; + Top = 21, ; + Width = 142, ; + LABEL_ITEM1.Caption = "Parteneri", ; + LABEL_ITEM1.Name = "LABEL_ITEM1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Pagefr1.Page1.Cw2' AS cw WITH ; + Height = 20, ; + Left = 4, ; + Name = "Cw2", ; + nid_cw = 5, ; + ntip = 4, ; + Top = 70, ; + Width = 142, ; + LABEL_ITEM1.Caption = "Optiuni", ; + LABEL_ITEM1.Name = "LABEL_ITEM1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Pagefr1.Page1.Cw4' AS cw WITH ; + Left = 4, ; + Name = "Cw4", ; + nid_cw = 2, ; + ntip = 2, ; + TabIndex = 2, ; + Top = 45, ; + Width = 142, ; + Label_item1.Caption = "Modele de COVER PAGE", ; + Label_item1.Name = "Label_item1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Pagefr1.Page1.shape1' AS pict_meniu WITH ; + Height = 362, ; + Left = 0, ; + Name = "shape1", ; + Picture = ..\grafice\f2.jpg, ; + Top = 7, ; + Width = 160 + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="image" /> + + PROCEDURE Init + thisform.imagine01.Init() + + + ENDPROC + + PROCEDURE Show + Lparameters nStyle + + LOCAL lnPornire + + verifica_drepturi('oprinc','pagefr1') + + Local w,h + w=_Screen.Width + h=_Screen.Height + + This.Width=w + This.Height=h + + This.image1.Left=w-This.image1.Width-25 + This.image1.Top=h-This.image1.Height-25 + *!* This.lb_utilizator.Top=h-This.lb_utilizator.Height + *!* This.lb_utilizator1.Top=h-This.lb_utilizator1.Height + This.image2.Width = w + 180 + + With This.pagefr1 + .Width=w + .Height=h + .page1.shape1.Height=h + ENDWITH + + SELECT cRegistratura + GO TOP + + this.pagefr1.page2.ct_registratura1.grid_registratura.SetFocus() + + + + ENDPROC + + PROCEDURE Image1.RightClick + Do start_firma In ostartfirma.prg + + ** Initializez gnRon corespunzator lunii in care am intrat + Local lcLunaRon, lcAnulRon, lnValue, lcExec, lnSucces, lcTextEroare + lcLunaRon = Substr(gcDataRon,1,2) + lcAnulRon = Substr(gcDataRon,4,4) + If gnAn * 12 + gnLuna < Val(lcAnulRon) * 12 + Val(lcLunaRon) + lnValue = 2 + Else + lnValue = 1 + Endif + + lcExec = [update optiuni set varvalue = ] + Alltrim(Str(lnValue)) + [ where varname = 'RON'] + + lnSucces = goExecutor.oExecute(lcExec) + If lnSucces < 0 + lcTextEroare = goExecutor.cEroare + Messagebox(lcTextEroare,48,"Eroare") + Return + Endif + + Do oinit_optiuni.prg + ** + + verifica_drepturi('oprinc','pagefr1') + + + + ENDPROC + + PROCEDURE Imagine01.do_actiune + thisform.pagefr1.pAGE1.cw1.do_actiune + + + + + ENDPROC + + PROCEDURE lb_utilizator.RightClick + thisform.rightclick + ENDPROC + + PROCEDURE lb_utilizator1.RightClick + thisform.rightclick + ENDPROC + + PROCEDURE Pagefr1.Page1.Click + IF TYPE('podg_dg.but_termin1') <> 'U' + podg_dg.but_termin1.CLICK() + ENDIF + IF TYPE('podg_ob.but_termin1') <> 'U' + podg_ob.but_termin1.CLICK() + ENDIF + IF TYPE('podg_tf.but_termin1') <> 'U' + podg_tf.but_termin1.CLICK() + ENDIF + IF TYPE('podg_tl.but_termin1') <> 'U' + podg_tl.but_termin1.CLICK() + ENDIF + IF TYPE('podg_obs.but_termin1') <> 'U' + podg_obs.but_termin1.CLICK() + ENDIF + IF TYPE('podg_link.but_termin1') <> 'U' + podg_link.but_termin1.CLICK() + ENDIF + IF TYPE('podg_fact.but_termin1') <> 'U' + podg_fact.but_termin1.CLICK() + ENDIF + ENDPROC + + PROCEDURE Pagefr1.Page1.Cw1.do_actiune + * DO viz_clienti IN onom_clienti.prg + DO viz_parteneri IN onomenclatoare.prg + ENDPROC + + PROCEDURE Pagefr1.Page1.Cw1.LABEL_ITEM1.Init + this.Caption = iif(gnParametru_prog=1,'Clienti',iif(gnParametru_prog=2,'Furnizori','Parteneri')) + ENDPROC + + PROCEDURE Pagefr1.Page1.Cw2.do_actiune + * + ENDPROC + + PROCEDURE Pagefr1.Page1.Cw4.do_actiune + Do vizualizare_agenti In onomenclatoare.prg + ENDPROC + + PROCEDURE Pagefr1.Page2.Activate + thisform.image1.Visible = .F. + + + + + + + ENDPROC + + PROCEDURE Pagefr1.Page2.Click + IF TYPE('podg_dg.but_termin1') <> 'U' + podg_dg.but_termin1.CLICK() + ENDIF + IF TYPE('podg_ob.but_termin1') <> 'U' + podg_ob.but_termin1.CLICK() + ENDIF + IF TYPE('podg_tf.but_termin1') <> 'U' + podg_tf.but_termin1.CLICK() + ENDIF + IF TYPE('podg_tl.but_termin1') <> 'U' + podg_tl.but_termin1.CLICK() + ENDIF + IF TYPE('podg_obs.but_termin1') <> 'U' + podg_obs.but_termin1.CLICK() + ENDIF + IF TYPE('podg_link.but_termin1') <> 'U' + podg_link.but_termin1.CLICK() + ENDIF + IF TYPE('podg_fact.but_termin1') <> 'U' + podg_fact.but_termin1.CLICK() + ENDIF + IF TYPE('podg_garantii.but_termin1') <> 'U' + podg_garantii.but_termin1.CLICK() + ENDIF + + this.ct_contracte1.do_cauta() + + + + + + ENDPROC + + PROCEDURE Pagefr1.Page2.Deactivate + thisform.image1.Visible = .T. + *!* thisform.lb_nivel.Visible = .T. + *!* thisform.lb_nivel1.Visible = .T. + *!* thisform.lb_utilizator.Visible = .T. + *!* thisform.lb_utilizator1.Visible = .T. + + IF EMPTY(goContract.id_ctr) + AMESSAGEBOX('Nu este selectat nici un contract!',0+48,_SCREEN.CAPTION) + this.Parent.paGE3.Enabled = .F. + _screen.LockScreen= .T. + ELSE + this.Parent.paGE3.Enabled = .T. + ENDIF + + + ENDPROC + + PROCEDURE Pagefr1.Page3.Activate + IF EMPTY(goContract.id_ctr) + this.Parent.ActivePage=2 + ENDIF + + IF ALLTRIM(gocontract.tip_istoric) = 'A' + this.ct_part_nr_data1.lb_actAd.Visible = .T. + this.ct_part_nr_data1.lb_actAd.Caption = ALLTRIM(gocontract.numar_aa) + ELSE + this.ct_part_nr_data1.lb_actAd.Visible = .F. + ENDIF + + + + thisform.image1.Visible = .F. + *!* thisform.lb_nivel.Visible = .F. + *!* thisform.lb_nivel1.Visible = .F. + *!* thisform.lb_utilizator.Visible = .F. + *!* thisform.lb_utilizator1.Visible = .F. + ENDPROC + + PROCEDURE Pagefr1.Page3.Click + DO make_cursoare_ctr IN oproceduri_roacontracte.prg && imi creeaza cursoarele + this.ct_part_nr_data1.Refresh + + this.ct_date_generale1.outlook2003bar1.panel.button1.Click + + + ENDPROC + + PROCEDURE Pagefr1.Page3.Deactivate + THISFORM.image1.VISIBLE = .T. + *!* THISFORM.lb_nivel.VISIBLE = .T. + *!* THISFORM.lb_nivel1.VISIBLE = .T. + *!* THISFORM.lb_utilizator.VISIBLE = .T. + *!* THISFORM.lb_utilizator1.VISIBLE = .T. + + LOCAL lnRaspuns + + IF !THIS.ct_part_nr_data1.llock + THIS.ct_part_nr_data1.llock = .T. + + lnRaspuns = AMESSAGEBOX('Doriti sa salvati modificari facute?',4+32,'Atentie') + THIS.ct_part_nr_data1.REFRESH() + IF lnRaspuns = 7 + RETURN + ELSE + DO modifica_ctr_dg WITH goContract IN oproceduri_roacontracte.prg + ENDIF + ENDIF + + IF USED('cCtrScadentar') + USE IN cCtrScadentar + ENDIF + IF USED('cCtrLink') + USE IN cCtrLink + ENDIF + IF USED('cCtrArt') + USE IN cCtrArt + ENDIF + If Used('cCtrFactGarant') + Use In cCtrFactGarant + Endif + ENDPROC + +ENDDEFINE diff --git a/Clase/Outlook2003BarArrow.png b/Clase/Outlook2003BarArrow.png new file mode 100644 index 0000000..4975444 Binary files /dev/null and b/Clase/Outlook2003BarArrow.png differ diff --git a/Clase/Outlook2003BarSplitter.png b/Clase/Outlook2003BarSplitter.png new file mode 100644 index 0000000..029925a Binary files /dev/null and b/Clase/Outlook2003BarSplitter.png differ diff --git a/Clase/_app.h b/Clase/_app.h new file mode 100644 index 0000000..2df608a --- /dev/null +++ b/Clase/_app.h @@ -0,0 +1,147 @@ +* _app.h + +*********************************************************** +localization strings and constants for _app.vcx +*********************************************************** + +* _datasession class +#DEFINE DATA_MESSAGEBOX_TITLE_LOC "Data Message" +#DEFINE DATA_OK_TO_SAVE_LOC "OK to save your edit?" +#DEFINE DATA_OK_TO_REVERT_LOC "OK to cancel your changes?" +#DEFINE DATA_UPDATE_CONFLICT_LOC "Records have been locked by another user. "+ ; + CHR(13)+CHR(13) +; + "You can't update these records until the other lock is cancelled." + +#DEFINE DATA_HAS_BEEN_EDITED_LOC "Other people may have edited the data since you started editing. "+CHR(13)+CHR(13) +; + "OK to overwrite others' changes, "+CHR(13)+; + "or cancel your edit for the records in this table?" +#DEFINE DATA_SAVE_BEFORE_CLOSE_LOC "You have work in progress here."+CHR(13)+CHR(13)+; + "Do you want to save your changes before closing?" +#DEFINE DATA_CANCEL_UNFINISHED_LOC "You have work in progress here that cannot be saved yet."+CHR(13)+CHR(13)+; + "Do you want still want to close, cancelling your changes?" + + +* _error class +* error logging +#DEFINE ERROR_MESSAGEBOX_TITLE_LOC "Error Message" +#DEFINE ERROR_IN_ERROR_METHOD_LOC "Error in error handler" +#DEFINE ERROR_SERIOUS_CLASS_LOC "Serious error of class" +#DEFINE ERROR_CANNOT_BE_LOGGED_LOC "The application will exit, and cannot add information about this error to the error log." +#DEFINE ERROR_LOCK_LOC "A file or record is unavailable" +#DEFINE ERROR_PRINT_LOC "The printer or printer driver you require is not available" +#DEFINE ERROR_USER_FIX_LOC "Please handle this problem, or wait and try again." +#DEFINE ERROR_USER_NOTE_LOC "Please note this error information." + +* error log display +#DEFINE ERROR_LOG_EMPTY_LOC "The error log has no records." +#DEFINE ERROR_LOG_UNAVAILABLE_LOC "The error log is not available." + +* error continuation choices +#DEFINE ERROR_USER_CHOICES_LOC "Continue Executing Program?" + +#DEFINE ERROR_DEVEND_LOC ERROR_USER_CHOICES_LOC+ ; + CHR(13)+CHR(13)+; + "Choose: "+CHR(13)+CHR(13)+ ; + "YES to Continue the program"+CHR(13)+; + "NO to Suspend "+CHR(13)+ ; + "CANCEL to Exit program completely." + +#DEFINE ERROR_USEREND_LOC ERROR_USER_CHOICES_LOC+ ; + CHR(13)+CHR(13)+; + "Choose: "+CHR(13)+CHR(13)+ ; + "OK to Continue the program"+CHR(13)+; + "CANCEL to Exit program completely." + +#DEFINE ERROR_OCCURRED_LOC "An error has occurred" +#DEFINE ERROR_LOG_LOC "Record details in error log files?" + + +*********************************************************** +* Messagebox subset from FOXPRO.H +*********************************************************** + +#DEFINE MB_OK 0 && OK button only +#DEFINE MB_OKCANCEL 1 && OK and Cancel buttons +#DEFINE MB_ABORTRETRYIGNORE 2 && Abort, Retry, and Ignore buttons +#DEFINE MB_YESNOCANCEL 3 && Yes, No, and Cancel buttons +#DEFINE MB_YESNO 4 && Yes and No buttons +#DEFINE MB_RETRYCANCEL 5 && Retry and Cancel buttons + +#DEFINE MB_ICONSTOP 16 && Critical message +#DEFINE MB_ICONQUESTION 32 && Warning query +#DEFINE MB_ICONEXCLAMATION 48 && Warning message +#DEFINE MB_ICONINFORMATION 64 && Information message + +#DEFINE MB_APPLMODAL 0 && Application modal message box +#DEFINE MB_DEFBUTTON1 0 && First button is default +#DEFINE MB_DEFBUTTON2 256 && Second button is default +#DEFINE MB_DEFBUTTON3 512 && Third button is default +#DEFINE MB_SYSTEMMODAL 4096 && System Modal + +*-- MsgBox return values +#DEFINE IDOK 1 && OK button pressed +#DEFINE IDCANCEL 2 && Cancel button pressed +#DEFINE IDABORT 3 && Abort button pressed +#DEFINE IDRETRY 4 && Retry button pressed +#DEFINE IDIGNORE 5 && Ignore button pressed +#DEFINE IDYES 6 && Yes button pressed +#DEFINE IDNO 7 && No button pressed + +*********************************************************** +* Data-handling subset from FOXPRO.H +*********************************************************** +*-- Cursor buffering modes +#DEFINE DB_BUFOFF 1 +#DEFINE DB_BUFLOCKRECORD 2 +#DEFINE DB_BUFOPTRECORD 3 +#DEFINE DB_BUFLOCKTABLE 4 +#DEFINE DB_BUFOPTTABLE 5 + +*-- Update types for views/cursors +#DEFINE DB_UPDATE 1 +#DEFINE DB_DELETEINSERT 2 + +*-- WHERE clause types for views/cursors +#DEFINE DB_KEY 1 +#DEFINE DB_KEYANDUPDATABLE 2 +#DEFINE DB_KEYANDMODIFIED 3 +#DEFINE DB_KEYANDTIMESTAMP 4 + +*-- Remote connection login prompt options +#DEFINE DB_PROMPTCOMPLETE 1 +#DEFINE DB_PROMPTALWAYS 2 +#DEFINE DB_PROMPTNEVER 3 + +*-- Remote transaction modes +#DEFINE DB_TRANSAUTO 1 +#DEFINE DB_TRANSMANUAL 2 + +*-- Source Types for CursorGetProp() +#DEFINE DB_SRCLOCALVIEW 1 +#DEFINE DB_SRCREMOTEVIEW 2 +#DEFINE DB_SRCTABLE 3 + + +*********************************************************** +* System Toolbar subset from FOXPRO.H, Tastrade STRINGS.H +*********************************************************** +*-- Toolbar Positions +#DEFINE TOOL_NOTDOCKED -1 +#DEFINE TOOL_TOP 0 +#DEFINE TOOL_LEFT 1 +#DEFINE TOOL_RIGHT 2 +#DEFINE TOOL_BOTTOM 3 + +*-- Toolbar names +#DEFINE TB_FORMDESIGNER_LOC "Form Designer" +#DEFINE TB_STANDARD_LOC "Standard" +#DEFINE TB_LAYOUT_LOC "Layout" +#DEFINE TB_QUERY_LOC "Query Designer" +#DEFINE TB_VIEWDESIGNER_LOC "View Designer" +#DEFINE TB_COLORPALETTE_LOC "Color Palette" +#DEFINE TB_FORMCONTROLS_LOC "Form Controls" +#DEFINE TB_DATADESIGNER_LOC "Database Designer" +#DEFINE TB_REPODESIGNER_LOC "Report Designer" +#DEFINE TB_REPOCONTROLS_LOC "Report Controls" +#DEFINE TB_PRINTPREVIEW_LOC "Print Preview" + diff --git a/Clase/_app.vc2 b/Clase/_app.vc2 new file mode 100644 index 0000000..bdefe02 --- /dev/null +++ b/Clase/_app.vc2 @@ -0,0 +1,1928 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="_app.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +*< LIBCOMMENT: Application Wizard framework class library. /> +* +DEFINE CLASS _datasession AS _custom OF "_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_app.h" + * + *m: datachanged && Checks if data has changed, according to the current system as specified in iDataChangedMode. + *m: dataflush && Ensures that the activecontrol will have its current contents "recognized" even if you choose to update from a toolbar button while a grid has focus. + *m: datavalid + *m: getactivecontrolref && Returns the real active control such as cases where the current active control is a Grid. + *m: getmessageboxtitle + *m: queryunload && Occurs before a Form is unloaded. + *m: restoresessionid && Restores the data session. + *m: revert && Reverts data. + *m: setsessionid && Sets the data session. + *m: update && Updates data. + *p: idatachangedmode && Detemines what constitutes data change. 0 - anything changed. 1 - ignore view fields not in Updatefields list. 2- ignore views not set to send updates. Subclasses can add more categories and augment DataChanged() method. + *p: isavedsessionid && Data session ID. + *p: lsuccess && Whether data operation (update) was successful. + *p: lusetransactions && Whether to wrap updating routine in transaction. Note: tables not in a DBC are unaffected in transaction. + * + + * + idatachangedmode = 0 + isavedsessionid = 1 + lsuccess = .T. + lusetransactions = .T. + Name = "_datasession" + Width = 24 + * + + PROCEDURE datachanged && Checks if data has changed, according to the current system as specified in iDataChangedMode. + LPARAMETERS toSession, tiChangeMode + + ASSERT TYPE("toSession.DataSessionID") = "N" OR ; + EMPTY(toSession) + + LOCAL liAction, liIndex, laTables[1], liBufferMode, liChangeMode, ; + liField, liCurrentRecord, ; + lcFieldStates, lcFieldList, lcAlias + + IF TYPE("toSession.DataSessionID") = "N" + THIS.SetSessionID(toSession.DataSessionID) + ENDIF + + STORE 0 TO liAction, liBufferMode, liField, ; + liCurrentRecord + + IF VARTYPE(tiChangeMode) # "N" + + liChangeMode = THIS.iDataChangedMode + + ELSE + + liChangeMode = tiChangeMode + + ENDIF + + ASSERT VARTYPE(liChangeMode) = "N" + + * take care of current control if necessary: + IF NOT THIS.DataFlush() && will only happen in a pessimistic + && buffering mode where we shouldn't + && actually be editing this table! + + RETURN .F. + + ENDIF + + + + FOR liIndex = 1 TO AUSED(laTables) + + lcAlias = laTables[liIndex,1] + liAction = 0 + liBuffermode = CURSORGETPROP("Buffering", lcAlias) + + ASSERT INLIST(liBufferMode,DB_BUFOFF,DB_BUFLOCKRECORD,DB_BUFLOCKTABLE,DB_BUFOPTRECORD,DB_BUFOPTTABLE) + + + DO CASE + + CASE ISREADONLY(lcAlias) + * don't bother... + + CASE INLIST(liBufferMode, DB_BUFLOCKRECORD, DB_BUFOPTRECORD) + * row buffering + + IF NOT EOF(lcAlias) + * problem with GETFLDSTATE returning .NULL. at EOF()!! + + DO CASE + + CASE liChangeMode = 1 + * This is one of two "nondefault cases" currently known; + * It indicates "ignore columns in views that + * are not in the UpdateFields list for that view + * when assessing data changes" + + lcFieldStates = GETFLDSTATE(-1,lcAlias) + + IF lcFieldStates = REPL("1",FCOUNT(lcAlias)+1) + liAction = 0 + ELSE + liAction = 1 + * now exempt the alias in specific circumstances + IF LEFT(lcFieldStates,1) = "1" AND ; + CURSORGETPROP("SourceType", lcAlias) # 3 + * we're in a local or remote view, not a table, + * and no deletion was carried out + liAction = 0 + lcFieldList =","+UPPER(CURSORGETPROP("UpdatableFieldList",lcAlias))+"," + lcFieldList = STRTRAN(lcFieldList,", ", ",") + FOR liField = 1 TO FCOUNT(lcAlias) + IF SUBSTR(lcFieldStates,liField+1,1) # "1" AND ; + (","+UPPER(FIELD(liField,lcAlias))+"," $ ; + lcFieldList) + + liAction = 1 + EXIT + + ENDIF + ENDFOR + ENDIF + ENDIF + + CASE liChangeMode = 2 + * the second currently-possible "nondefault" case; + * it indicates "ignore views that are not set + * to send updates back to their tables for the + * purposes of assessing data as changed" + + IF CURSORGETPROP("SourceType", lcAlias) = 3 OR ; + CURSORGETPROP("SendUpdates", lcAlias) + liAction = IIF(GETFLDSTATE(-1,lcAlias) = ; + REPL("1",FCOUNT(lcAlias)+1), ; + 0,1) + ENDIF + + OTHERWISE + + * original code applies + liAction = IIF(GETFLDSTATE(-1,lcAlias) = ; + REPL("1",FCOUNT(lcAlias)+1), ; + 0,1) + + ENDCASE + + ENDIF + + CASE INLIST(liBufferMode, DB_BUFLOCKTABLE, DB_BUFOPTTABLE) + * table buffering + + DO CASE + + CASE liChangeMode = 1 + * see notes above + + IF CURSORGETPROP("SourceType", lcAlias) = 3 + + liAction = GETNEXTMODIFIED(0,lcAlias) + + ELSE + + liCurrentRecord = IIF(EOF(lcAlias),0, ; + RECNO(lcAlias)) + liRecord = GETNEXTMODIFIED(0,lcAlias) + liAction = 0 + lcFieldList =","+UPPER(CURSORGETPROP("UpdatableFieldList",lcAlias))+"," + lcFieldList = STRTRAN(lcFieldList,", ", ",") + + DO WHILE liRecord # 0 AND liAction = 0 + GO liRecord IN (lcAlias) + lcFieldStates = GETFLDSTATE(-1,lcAlias) + IF lcFieldStates = REPL("1",FCOUNT(lcAlias)+1) + liAction = 0 + ELSE + liAction = 1 + IF LEFT(lcFieldStates,1) = "1" AND ; + CURSORGETPROP("SourceType", lcAlias) # 3 + liAction = 0 + FOR liField = 1 TO FCOUNT(lcAlias) + IF SUBSTR(lcFieldStates,liField+1,1) # "1" AND ; + (","+UPPER(FIELD(liField,lcAlias))+"," $ ; + lcFieldList) + + liAction = 1 + EXIT + ENDIF + ENDFOR + ENDIF + ENDIF + liRecord = GETNEXTMODIFIED(liRecord,lcAlias) + ENDDO + IF liCurrentRecord # RECNO(lcAlias) + IF liCurrentRecord = 0 + GO BOTTOM IN (lcAlias) + IF RECCOUNT(lcAlias) > 0 + SKIP IN (lcAlias) + ENDIF + ELSE + GO liCurrentRecord IN (lcAlias) + ENDIF + ENDIF + ENDIF + + CASE liChangeMode = 2 + * see notes above + IF CURSORGETPROP("SourceType", lcAlias) = 3 OR ; + CURSORGETPROP("SendUpdates", lcAlias) + liAction = GETNEXTMODIFIED(0,lcAlias) + ENDIF + + OTHERWISE + + * original code applies: + liAction = GETNEXTMODIFIED(0,lcAlias) + + ENDCASE + + + OTHERWISE + + * no buffering -- or (god forbid) + * an unknown return that hasn't been + * caught by assertion during testing + * do nothing + + ENDCASE + + IF liAction # 0 + * changes have occurred in at least one table in the system + EXIT + ENDIF + + ENDFOR + + IF TYPE("toSession.DataSessionID") = "N" + THIS.RestoreSessionID() + ENDIF + + + RETURN liAction # 0 + + ENDPROC + + PROCEDURE dataflush && Ensures that the activecontrol will have its current contents "recognized" even if you choose to update from a toolbar button while a grid has focus. + LOCAL loActiveControl, lcAlias + + IF TYPE("_SCREEN.ActiveForm.ActiveControl") # "O" + RETURN + ENDIF + + loActiveControl = THIS.GetActiveControlRef(_SCREEN.ActiveForm.ActiveControl) + + + IF TYPE("loActiveControl.Value") # "U" AND ; + TYPE("loActiveControl.ControlSource") # "U" AND ; + TYPE(loActiveControl.ControlSource) # "U" AND ; + (TYPE("loActiveControl.ReadOnly") = "U" OR ; + NOT loActiveControl.ReadOnly) AND ; + (NOT EVAL(loActiveControl.Controlsource) == loActiveControl.Value) + + IF "." $ loActiveControl.ControlSource + lcAlias = LEFT(loActiveControl.ControlSource,AT(".",loActiveControl.ControlSource) - 1) + ELSE + lcAlias = ALIAS() + ENDIF + IF INLIST(CURSORGETPROP("BUFFERING",lcAlias),DB_BUFLOCKRECORD,DB_BUFLOCKTABLE) ; + AND NOT ISRLOCKED(RECNO(lcAlias),lcAlias) + IF NOT RLOCK(RECNO(lcAlias),lcAlias) + * help ! pessimistic locking in effect + * and somebody else actually has this record + * locked! we shouldn't be editing this record... + * actually this should never happen! + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+PROPER(lcAlias)) + + RETURN .F. + ELSE + * this was a speculative lock only + * if it was a view it really isn't + * a problem to have taken this lock + * briefly, although it didn't help either + UNLOCK RECORD RECNO(lcAlias) IN (lcAlias) + ENDIF + + ENDIF + + loActiveControl.Value = loActiveControl.Value + + + ELSE + + * no flush required + + ENDIF + + + + ENDPROC + + PROCEDURE datavalid + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + + LOCAL laErrors[1] + =AERROR(laErrors) + + THIS.lSuccess = .F. + + IF UPPER(cMethod)=="UPDATE" + + IF (INLIST(nError,1580,1581,1582,1583,1531,1539,1590,; + 1546, 1547,111,1157,1579,1598, 1647, 1504, 1887) ; + OR ; + INLIST(nError, 2007, 2008, 2010,2011,2015,1491, 1996, 1589, ; + 1864,1865,1879,1884,1886, 1712,2014,1594, 1588 ) ; + OR ; + INLIST(nError,1548,1777,1495)) ; && leaving room for more... + AND NOT ISNULL(laErrors[1,4]) + + * rule failure,trigger, transaction failure, + * and some additional problems + * that the programmer + * should see and handle in the rule code or other + * work in the form itself, it is not something that + * should be resolved by the user at runtime! + + DODEFAULT(nError,cMethod,nLine) + ELSE + * otherwise we want to treat this as an error + * that Update handles internally. + * this may not be important + + ENDIF + + + ELSE + + DODEFAULT(nError, cMethod, nLine) + + ENDIF + + ENDPROC + + PROCEDURE getactivecontrolref && Returns the real active control such as cases where the current active control is a Grid. + LPARAMETERS toActiveControl + + LOCAL loRealActiveControl, liThisColumn, loColumn + + IF TYPE("toActiveControl.BaseClass")# "C" + * redundant in DataFlush() call, but could be called from elsewhere + RETURN .F. + ENDIF + + IF UPPER(toActiveControl.BaseClass) == "GRID" + + liThisColumn = toActivecontrol.ActiveColumn + FOR EACH loColumn IN toActiveControl.Columns + IF loColumn.ColumnOrder # liThisColumn + LOOP + ENDIF + IF NOT (loColumn.ReadOnly and loColumn.Bound) + loRealActiveControl = EVAL("loColumn."+loColumn.CurrentControl) + ENDIF + EXIT + ENDFOR + + ELSE + + loRealActiveControl = toActiveControl + + ENDIF + + RETURN loRealActiveControl + ENDPROC + + PROCEDURE getmessageboxtitle + RETURN DATA_MESSAGEBOX_TITLE_LOC + ENDPROC + + PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + THIS.iSavedSessionID = SET("DATASESSION") + + ENDPROC + + PROCEDURE queryunload && Occurs before a Form is unloaded. + LPARAMETERS tlDataChangeAlreadyConfirmed, toSession, tlNoShow + + ASSERT VARTYPE(tlDataChangeAlreadyConfirmed) = "L" + ASSERT TYPE("toSession.DataSessionID") = "N" OR ; + TYPE("_SCREEN.ActiveForm") = "O" + ASSERT VARTYPE(tlNoShow) = "L" + + LOCAL liResult, llChange, loSession + + IF TYPE("toSession.DataSessionID") = "N" + loSession = toSession + ELSE + loSession = _SCREEN.ActiveForm + ENDIF + + THIS.SetSessionID(loSession.DataSessionID) + + llChange = tlDataChangeAlreadyConfirmed OR THIS.DataChanged(loSession) + + IF llChange + + * changes have been detected somewhere... + + IF PEMSTATUS(loSession,"Show",5) AND NOT tlNoShow + loSession.Show() + ENDIF + + liResult = ; + MESSAGEBOX( DATA_SAVE_BEFORE_CLOSE_LOC ,; + MB_ICONEXCLAMATION + MB_YESNOCANCEL, ; + THIS.GetMessageBoxTitle()) + + ELSE + + liResult = IDNO + + ENDIF + + DO CASE + CASE liResult = IDYES + THIS.Update(.T.,.T.,loSession) + CASE liResult = IDNO AND llChange + THIS.Revert(.T.,.T.,loSession) + OTHERWISE + * there were data changes and they chose to cancel + ENDCASE + + THIS.RestoreSessionID() + + RETURN (liResult # IDCANCEL) + + ENDPROC + + PROCEDURE restoresessionid && Restores the data session. + IF SET("DATASESSION") # THIS.iSavedSessionID + + SET DATASESSION TO THIS.iSavedSessionID + + ENDIF + + ENDPROC + + PROCEDURE revert && Reverts data. + LPARAMETERS tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow + + ASSERT VARTYPE(tlUserChoiceAlreadyConfirmed) = "L" + ASSERT VARTYPE(tlDataChangeAlreadyConfirmed) = "L" + ASSERT TYPE("toSession.DataSessionID") = "N" OR ; + TYPE("_SCREEN.ActiveForm") = "O" + ASSERT VARTYPE(tlNoShow) = "L" + ASSERT SET("MULTILOCKS") = "ON" + + LOCAL liConfirmed, liIndex, laTables[1], llChange, loSession + + IF TYPE("toSession.DataSessionID") = "N" + loSession = toSession + ELSE + loSession = _SCREEN.ActiveForm + ENDIF + + THIS.SetSessionID(loSession.DataSessionID) + + IF tlUserChoiceAlreadyConfirmed + + liConfirmed = IDOK + + ELSE + + llChange = tlDataChangeAlreadyConfirmed OR THIS.DataChanged() + + IF llChange + + IF PEMSTATUS(loSession,"Show",5) AND NOT tlNoShow + loSession.Show() + ENDIF + + liConfirmed =MESSAGEBOX(DATA_OK_TO_REVERT_LOC,; + MB_ICONQUESTION+MB_OKCANCEL,THIS.GetMessageBoxTitle()) + ELSE + + liConfirmed = IDCANCEL + + ENDIF + ENDIF + + IF liConfirmed = IDOK + + FOR liIndex = 1 TO AUSED(laTables) + + IF CURSORGETPROP("Buffering",laTables[liIndex,1]) # DB_BUFOFF + =TABLEREVERT(.T.,laTables[liIndex,1]) + ENDIF + + ENDFOR + + ENDIF + + IF PEMSTATUS(loSession,"Refresh",5) AND NOT tlNoShow + loSession.Refresh() + ENDIF + + THIS.RestoreSessionID() + + RETURN (liConfirmed = IDOK) + ENDPROC + + PROCEDURE setsessionid && Sets the data session. + LPARAMETERS tiSession + + IF VARTYPE(tiSession) = "N" AND SET("DATASESSION") # tiSession + + THIS.iSavedSessionID = SET("DATASESSION") + SET DATASESSION TO tiSession + + ENDIF + ENDPROC + + PROCEDURE update && Updates data. + LPARAMETERS tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow + + ASSERT VARTYPE(tlUserChoiceAlreadyConfirmed) = "L" + ASSERT VARTYPE(tlDataChangeAlreadyConfirmed) = "L" + ASSERT TYPE("toSession.DataSessionID") = "N" OR ; + TYPE("_SCREEN.ActiveForm") = "O" + ASSERT VARTYPE(tlNoShow) = "L" + ASSERT SET("MULTILOCKS") = "ON" + + LOCAL llChange, liConfirmed, liIndexTables, loSession, lcRecs, ; + laTables[1], liBuffermode, liSelect, laErrors[1], liRecModified, ; + llUseTransactions, llView + + IF TYPE("toSession.DataSessionID") = "N" + loSession = toSession + ELSE + loSession = _SCREEN.ActiveForm + ENDIF + + THIS.SetSessionID(loSession.DataSessionID) + + THIS.lSuccess = .T. + + IF tlUserChoiceAlreadyConfirmed + + liConfirmed = IDOK + llChange = .T. + + ELSE + + llChange = tlDataChangeAlreadyConfirmed OR THIS.DataChanged() + + IF llChange + + IF PEMSTATUS(loSession,"Show",5) AND NOT tlNoShow + loSession.Show() + * otherwise it could be a session object + ENDIF + + liConfirmed =MESSAGEBOX(DATA_OK_TO_SAVE_LOC, ; + MB_ICONQUESTION+MB_OKCANCEL, ; + THIS.GetMessageBoxTitle()) + ENDIF + + ENDIF + + IF llChange AND liConfirmed = IDOK + + *&* transaction aspect of this system, + *&* suggested here, are really only + *&* going to work for tables in a DBC + *&* which is why we take the record locks as well.. + IF THIS.lUseTransactions AND TXNLEVEL() < 5 + llUseTransactions = .T. + BEGIN TRANSACTION + ENDIF + + liSelect = SELECT() + + FOR liIndexTables = 1 TO AUSED(laTables) + + SELECT (laTables[liIndexTables,1]) + liBuffermode = CURSORGETPROP("Buffering") + llView = (CURSORGETPROP("SourceType")# DB_SRCTABLE) + + ASSERT INLIST(liBuffermode,DB_BUFOFF,DB_BUFLOCKRECORD,DB_BUFLOCKTABLE,DB_BUFOPTRECORD,DB_BUFOPTTABLE) + + DO CASE + + + CASE liBufferMode = DB_BUFOFF + * do nothing for this table + LOOP + + CASE INLIST(liBufferMode,DB_BUFLOCKRECORD,DB_BUFLOCKTABLE) + + * no need to check whether any editing was actually done; + * if it wasn't, nothing will happen with the TABLEUPDATE()... + + IF TABLEUPDATE(.T.) + + * success + + ELSE + + + THIS.lSuccess = .F. + + * we already have the lock and control of the record(s), + * this is a real error + + =AERROR(laErrors) + * let the standard error handler deal with it, for now + * -- whether it's the ON ERROR routine or the Error + * method for this object is immaterial + + ERROR laErrors[1,1] + + ENDIF + + CASE liBuffermode = DB_BUFOPTTABLE + + liRecModified = GETNEXTMODIFIED(0) + lcRecs = "" + IF liRecModified = 0 + * no changes to this file + LOOP + ENDIF + + DO WHILE liRecModified # 0 + IF liRecModified > 0 + lcRecs = lcRecs+","+ALLTR(STR(liRecModified)) + ENDIF + liRecModified = GETNEXTMODIFIED(liRecModified) + ENDDO + + *&* We are only worrying about one table at a time; + *&* presumably there is additional data-specific code in the + *&* form itself that + *&* preserves referential integrity + *&* if the tables are *not* in a DBC and protected by the transaction. + + IF NOT EMPTY(lcRecs) + lcRecs = SUBSTR(lcRecs,2) + ELSE + *&* all changed records are newly added + ENDIF + + IF EMPTY(lcRecs) OR llView OR RLOCK(lcRecs,ALIAS()) + + DO CASE + CASE NOT THIS.lSuccess + * this may only be a problem with VFP3. + * it's possible for the RLOCK() to cause + * an error rather than a failed update + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) + + CASE TABLEUPDATE(.T.,.F.) + * success + IF llView + SELECT (laTables[liIndexTables,1]) + ENDIF + OTHERWISE + + IF llView + SELECT (laTables[liIndexTables,1]) + ENDIF + + + * could go through the delimited string here + * and ask record by record... + + IF MESSAGEBOX(DATA_HAS_BEEN_EDITED_LOC, ; + MB_OKCANCEL+MB_ICONEXCLAMATION,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) = IDOK + + IF TABLEUPDATE(.T.,.T.) + * success + IF llView + SELECT (laTables[liIndexTables,1]) + ENDIF + + ELSE + + * real error -- *UNLESS* it's a view, in which + * case taking the lock wouldn't help, could + * actually prevent SET REPROCESS from working + * normally! + + THIS.lSuccess = .F. + + IF llView + + SELECT (laTables[liIndexTables,1]) + + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) + ELSE + =AERROR(laErrors) + ERROR laErrors[1,1] + ENDIF + + ENDIF + + ELSE + THIS.lSuccess = .F. + ENDIF + ENDCASE + ELSE + THIS.lSuccess = .F. + + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) + + ENDIF + + CASE (EOF()) AND liBuffermode = DB_BUFOPTRECORD + * do nothing if we're at EOF() and optimistic record locking ... + * this is permissible if a relation is 1 to 0..n + * and may happen if you have chosen to use + * optimistic record buffering on child tables. + LOOP + + CASE liBuffermode = DB_BUFOPTRECORD + + IF llView OR RLOCK() + + DO CASE + CASE NOT THIS.lSuccess + * see comment above; this really shouldn't happen + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) + CASE TABLEUPDATE(.F.,.F.) + * success + IF llView + SELECT (laTables[liIndexTables,1]) + ENDIF + + OTHERWISE + + * were other people working on the record? + * you could do a more elaborate dialog here, + * using OLDVAL() and CURVAL() to show what has occurred + IF llView + SELECT (laTables[liIndexTables,1]) + ENDIF + + + IF MESSAGEBOX(DATA_HAS_BEEN_EDITED_LOC, ; + MB_OKCANCEL+MB_ICONEXCLAMATION,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) = IDOK + + IF TABLEUPDATE(.F.,.T.) + * success + IF llView + SELECT (laTables[liIndexTables,1]) + ENDIF + ELSE + + * real error -- *UNLESS* it's a view, in which + * case taking the lock wouldn't help, could + * actually prevent SET REPROCESS from working + * normally! + THIS.lSuccess = .F. + IF llView + SELECT (laTables[liIndexTables,1]) + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) + ELSE + + = AERROR(laErrors) + ERROR laErrors[1,1] + ENDIF + ENDIF + ELSE + THIS.lSuccess = .F. + ENDIF + ENDCASE + + ELSE + + THIS.lSuccess = .F. + = MESSAGEBOX(DATA_UPDATE_CONFLICT_LOC, ; + MB_OK+MB_ICONSTOP,; + THIS.GetMessageBoxTitle()+": "+ALIAS()) + + ENDIF + + OTHERWISE + * we're either at EOF() and + * opt record locking or + * in trouble -- the assertion uptop + * should be taking care of this! + THIS.lSuccess = .F. + + ENDCASE + + IF llView + *&* JIC! + SELECT (laTables[liIndexTables,1]) + ELSE + UNLOCK && this file + ENDIF + + IF NOT THIS.lSuccess + EXIT + ENDIF + + ENDFOR + + *&* outer transaction covering all tables + *&* Tablereverts of what is left un-Updated + *&* may still help if there are free tables. + *&* Again, this will not cover the + *&* problem of a partial update already + *&* having been committed if there are + *&* free tables, but RI code should have + *&* been in place to prevent something + *&* "really bad" happening in this case. + + IF llUseTransactions AND TXNLEVEL() > 0 + + IF THIS.lSuccess + END TRANSACTION + ELSE + ROLLBACK + ENDIF + + ENDIF + + IF NOT THIS.lSuccess + FOR liIndexTables = 1 TO ALEN(laTables,1) + =TABLEREVERT(.T.,laTables[liIndexTables,1]) + ENDFOR + ENDIF + *&* + + + SELECT (liSelect) + + IF llChange AND PEMSTATUS(loSession,"Refresh",5) + loSession.Refresh() + ENDIF + + + ENDIF + + THIS.RestoreSessionID() + + RETURN (NOT llChange) OR (liConfirmed = IDOK AND THIS.lSuccess) + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _error AS _custom OF "_base.vcx" && Error handler + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_app.h" + * + *m: displayerrorlog && Displays error log. + *m: doerrorlogui && Called by DisplayErrorLog for actual UI display after setup. The simple default behavior here (BROWSE NOWAIT) is meant to be overridden by application-specific behavior. + *m: fillarrays && Fills error classification array (aErrorClass) first time, and current error array (aErrors) for each error that occurs. Bails if conditions are so severe (memory errors) that further processing is undesirable. + *m: filllogrecord && Writes error information to the log. + *m: geterrorattribute && Returns appropriate information from aErrorClass array for a given error number. + *m: getmessageboxtitle && This is really meant for your subclass or instance to fill out with app-specific information, so that all user feedback (WAIT WINDOW NOWAITs and MESSAGEBOX()) by the error object matches your app properly. + *m: handle && Main routine to handle error. + *m: isdisallowedserveraction && Tells whether the error is caused by an attempt to execute UI or other disallowed action from a server + *m: isfatal && Whether error is a fatal type error. + *m: isgooderrorlog && Validates error log + *m: istrivial && Whether error is a trivial type error. + *m: logerrorreport && If lServer is .T. or user indicates logging is desired, opens error log and logs the error. + *m: oktocontinue && Abstract method to evaluate error whether to continue program execution. + *m: oktoreport && Abstract method to evaluate error whether to report error. + *m: recordservererror && Establishes a consistent method for logging feedback which would ordinarily go to UI, for use in servers + *m: setlog && Evaluates log table name and alias, attempts to open and validate the table, creates new alias and log table name on the fly if anything goes wrong. + *m: usercancelled && Returns whether user opted to cancel after the current error. + *m: userhandleserror && Gives user choices about whether to go on with the app after an error. + *p: ccurrentclass && The error classification that the error object gives this particular error number. + *p: ccurrenterrorparam && SYS(2018) of current error + *p: ccurrentmessage && MESSAGE() of current error + *p: ccurrentmethod && Method or procedure where error occurred, as passed to Handle(). + *p: clogalias && Alias under which the error log is opened. See SetLog(). + *p: clogdbf && Fully qualified name of current error table on disk. See SetLog(). + *p: icurrenterror && Error number for current error. + *p: icurrentline && Line where current error occurred. + *p: lserver && Checks _VFP.StartMode to see whether any sort of modal feedback should be avoided. + *p: lusercancelled && Allows the outside program to cleanup and do whatever is necessary before release. + *a: aerrorclass[1,3] && Error numbers by classification for evaluation of type and severity. + *a: aerrors[1,6] + * + + * + ccurrentclass = ("") + ccurrenterrorparam = ("") + ccurrentmessage = ("") + ccurrentmethod = ("") + clogalias = ("") + clogdbf = ("") + icurrenterror = 0 + icurrentline = 0 + lserver = (INLIST(_VFP.StartMode,1,2,3,5)) + Name = "_error" + * + + PROCEDURE Destroy + LOCAL liSession + liSession = SET("DATASESSION") + SET DATASESSION TO 1 + IF USED(THIS.cLogAlias) + USE IN (THIS.cLogAlias) + * this is actually only going to happen + * in the "default" datasession + * because any other USEs should have + * been closed when their forms and formsets + * died by this point. + * note that the errorlog may be opened + * many times in different sessions, and + * this session information will be reflected in the log + ENDIF + SET DATASESSION TO liSession + DODEFAULT() + ENDPROC + + PROCEDURE displayerrorlog && Displays error log. + LOCAL liSelect + liSelect = SELECT() + THIS.SetLog() + + DO CASE + + CASE (EMPTY(THIS.cLogAlias) OR NOT USED(THIS.cLogAlias)) + + IF NOT THIS.lServer + + MESSAGEBOX(ERROR_LOG_UNAVAILABLE_LOC,; + MB_ICONEXCLAMATION,; + THIS.GetMessageBoxTitle()) + ENDIF + + CASE RECCOUNT(THIS.cLogAlias) = 0 + + IF NOT THIS.lServer + + MESSAGEBOX(ERROR_LOG_EMPTY_LOC,; + MB_ICONEXCLAMATION,; + THIS.GetMessageBoxTitle()) + ENDIF + + OTHERWISE + + SELECT (THIS.cLogAlias) + THIS.DoErrorLogUI(THIS.cLogAlias) + SELECT (liSelect) + + ENDCASE + + + ENDPROC + + PROCEDURE doerrorlogui && Called by DisplayErrorLog for actual UI display after setup. The simple default behavior here (BROWSE NOWAIT) is meant to be overridden by application-specific behavior. + LPARAMETERS tcAlias + + * this code is really expecting to be overridden + IF NOT THIS.lServer + BROWSE NORMAL NOWAIT + ENDIF + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + * special case, must override + * any use of ON ERROR which + * might call this object recursively + IF "setlog" $ LOWER(cMethod) + THIS.cLogDBF = "" + ELSE + ERROR ERROR_IN_ERROR_METHOD_LOC+":"+CHR(13)+ ; + "#"+TRANSFORM(nError)+CHR(13)+ ; + THIS.Name+" "+cMethod+", "+TRANSFORM(nLine)+CHR(13)+ ; + THIS.cCurrentMessage + ENDIF + + ENDPROC + + PROCEDURE fillarrays && Fills error classification array (aErrorClass) first time, and current error array (aErrors) for each error that occurs. Bails if conditions are so severe (memory errors) that further processing is undesirable. + IF VARTYPE(THIS.aErrorClass[1]) ="L" + * first time through + THIS.aErrorClass[1,2] = "memory" + THIS.aErrorClass[1,1] = "/21/22/43/1012/1149/1150/1151/1201/1202/1507/1600/1809/1986/2000/" + ENDIF + + LOCAL lcErrString, llBail + + lcErrString = "/"+TRANSFORM(THIS.iCurrentError)+"/" + + IF lcErrString $ THIS.aErrorClass[1,1] + llBail = .T. + ELSE + =AERROR(THIS.aErrors) + ENDIF + + IF (NOT llBail) AND (TYPE("THIS.aErrorClass[2,1]") # "C") + + DIME THIS.aErrorClass[16,2] + * note: you can add more columns for more error attributes, + * for example a severity gauge for different classes + * or other error class groupings + + THIS.aErrorClass[2,2] = "index" + THIS.aErrorClass[2,1] = "/5/19/20/114/1103/1141/1707/" + THIS.aErrorClass[3,2] = "disk" + THIS.aErrorClass[3,1] = "/56/1410/1157/" + THIS.aErrorClass[4,2] = "file" + THIS.aErrorClass[4,1] = "/1/6/7/15/41/50/54/55/102/110/111/115/116/117/119/120"+; + "/121/127/202/255/266/297/356/392/1102/1104/1105/1108"+; + "/1111/1112/1113/1115/1126/1166/1131/1167/1168/1169"+; + "/1243/1245/1246/1294/1298/1509/1510/1637/1643"+; + "/1644/1705/1708/" + THIS.aErrorClass[5,2] = "command" + THIS.aErrorClass[5,1] = "/1405/1411/1412/" + THIS.aErrorClass[6,2] = "lock" + THIS.aErrorClass[6,1] = "/3/108/109/130/1502/1503/1106/1585/" + THIS.aErrorClass[7,2] = "output" + THIS.aErrorClass[7,1] = "/216/221/222/223/227/228/332/1002/1153/" + THIS.aErrorClass[8,2] = "program or resource file" + THIS.aErrorClass[8,1] = "/67/91/1161/1178/1193/1194/1195/1196/1296/1309/1338/" + THIS.aErrorClass[9,2] = "print" + THIS.aErrorClass[9,1] = "/124/125/1910/1524/1643/1644/1717/" + THIS.aErrorClass[10,2] = "activex" + THIS.aErrorClass[10,1] = "/1420/1421/1422/1423/1424/1426/1427/1428/1429/1431/1434/1436/1508"+; + "/1440/2003/1782/2021/" + THIS.aErrorClass[11,2] = "sql" + THIS.aErrorClass[11,1] = "/1465/1466/1471/1472/1474/1475/1476/1477/1864/1865/1802/1890/1845/" + THIS.aErrorClass[12,2] = "cursor" + THIS.aErrorClass[12,1] = "/1467/1468/1473/1478/1479/1489/1491/1492/1493/1494/1495/1498/1499/1542/1546/1547/1548/1568/" + THIS.aErrorClass[13,2] = "odbc" + THIS.aErrorClass[13,1] = "/1480/1481/1482/1483/1484/1485/1486/1487/1496/1497/1522/1523/1525/1526/1527/1528/1530/" + THIS.aErrorClass[14,2] = "relational integrity" + THIS.aErrorClass[14,1] = "/1539/1555/1567/1879/1881/1882/1883/1884/1886/1887/" + THIS.aErrorClass[15,2] = "datasession" + THIS.aErrorClass[15,1] = "/1540/1545/1549/" + THIS.aErrorClass[16,2] = "offline views" + THIS.aErrorClass[16,1] = "/2007/2008/2010/2011/2015/2018/" + * THIS.aErrorClass[17,2] = "database" + * THIS.aErrorClass[17,1] = "/1529/1531/1534/1535/1536/1537/1538/1541/1542/1550/1551/1552/1553/1557/1558/1561/1562/1563/1564/1565/1566/1569/1570/" + + ENDIF + + RETURN (NOT llBail) + ENDPROC + + PROCEDURE filllogrecord && Writes error information to the log. + INSERT INTO (THIS.cLogAlias) ("Errstamp") VALUES (DATETIME()) + + LOCAL lcErrData, liErrLevel, liSelect, liSession, liFormSession + + liSelect = SELECT() + liSession = SET("DATASESSION") + + SELECT (THIS.cLogAlias) + + * create listing memo field from chunks of data -- + * do a couple of REPLACEs so that less memory is + * used for each step of this process + + lcErrData = "Error # "+TRANSFORM(THIS.iCurrentError) + IF NOT EMPTY(THIS.cCurrentClass) + lcErrData = lcErrData+ " class: "+THIS.cCurrentClass + ENDIF + lcErrData = lcErrData+CHR(13)+"Program "+ THIS.cCurrentMethod + lcErrData = lcErrData+CHR(13)+"Message "+ THIS.cCurrentMessage + IF NOT EMPTY(THIS.cCurrentErrorParam) + lcErrData = lcErrData+ " (" +THIS.cCurrentErrorParam+")" + ENDIF + lcErrData = lcErrData+CHR(13)+"Line # "+TRANSFORM(THIS.iCurrentLine) + + liFormSession = liSession + + IF TYPE("_SCREEN.ActiveForm") = "O" + lcErrData = lcErrData+CHR(13)+"Active: "+_SCREEN.ActiveForm.Name + IF TYPE("_SCREEN.ActiveForm.ActiveControl") = "O" + lcErrData = lcErrData+ " ("+_SCREEN.ActiveForm.ActiveControl.Name+")" + ENDIF + DO CASE + CASE TYPE("_SCREEN.ActiveForm.DataSessionID") = "N" + liFormSession = _SCREEN.ActiveForm.DataSessionID + CASE TYPE("_SCREEN.ActiveForm.Parent.DataSessionID") = "N" + * formset + liFormSession = _SCREEN.ActiveForm.Parent.DataSessionID + OTHERWISE + * can be a defined window or modi memo or whatever + ENDCASE + ENDIF + + lcErrData = lcErrData+CHR(13)+"Session "+TRANSFORM(liFormSession) + REPLACE listing WITH lcErrData ADDITIVE + + lcErrData = CHR(13)+"DiskSpc "+TRANSFORM(DISKSPACE()) + lcErrData = lcErrData+CHR(13)+"Screen "+TRANSFORM(SYSMETRIC(2))+" by "+TRANSFORM(SYSMETRIC(1)) + lcErrData = lcErrData+CHR(13)+"OS "+OS() + lcErrData = lcErrData+CHR(13)+"Vers(1) "+VERSION(1) + lcErrData = lcErrData+CHR(13)+"Vers(2) "+TRANSFORM(VERSION(2)) + lcErrData = lcErrData+CHR(13)+"Vers(3) "+VERSION(3) + lcErrData = lcErrData+CHR(13)+"SMode "+TRANSFORM(_VFP.StartMode) + lcErrData = lcErrData+CHR(13)+"(1016) "+TRANSFORM(VAL(SYS(1016))/1024)+" user object memory used" + lcErrData = lcErrData+CHR(13)+"(1001) "+TRANSFORM(VAL(SYS(1001))/1024)+" pool available memory" + lcErrData = lcErrData+CHR(13)+"CPU "+ SYS(17) + lcErrData = lcErrData+CHR(13)+"Video "+SYS(2006) + lcErrData = lcErrData+CHR(13)+CHR(13)+REPLICATE("=",50) + lcErrData = lcErrData+CHR(13)+" Calling Chain:" + + REPLACE listing WITH lcErrData ADDITIVE + + liErrLevel = 1 + lcErrData = CHR(13) + DO WHILE NOT EMPTY(SYS(16,liErrLevel)) AND NOT SYS(16,liErrLevel) == PROGRAM() + lcErrData = lcErrData + CHR(13)+SYS(16,liErrLevel) + liErrLevel= liErrLevel+1 + ENDDO + + lcErrData = lcErrData+CHR(13)+REPLICATE("=",50) + lcErrData = lcErrData+CHR(13)+CHR(13)+REPLICATE("=",50) + lcErrData = lcErrData+CHR(13)+" CONFIG file: "+SYS(2019) + IF FILE(SYS(2019)) + lcErrData = lcErrData + CHR(13)+REPLICATE("=",50)+CHR(13) + REPLACE listing WITH lcErrData ADDITIVE + APPEND MEMO listing FROM (SYS(2019)) && ADDITIVE by default + ELSE + lcErrData = lcErrData + " NOT AVAILABLE"+CHR(13)+REPLICATE("=",50)+CHR(13) + REPLACE listing WITH lcErrData ADDITIVE + ENDIF + + lcErrData = CHR(13)+CHR(13)+REPLICATE("=",50) + lcErrData = lcErrData+CHR(13)+" Status listing of Current Data Session " + lcErrData = lcErrData+CHR(13)+REPLICATE("=",50)+CHR(13) + REPLACE listing WITH lcErrData ADDITIVE + + lcErrData = SYS(2023)+"\"+SYS(3)+".tmp" + + DO WHILE FILE(lcErrData) + lcErrData = SYS(2023)+"\"+SYS(3)+".tmp" + ENDDO + + IF liSession = liFormSession + SELECT (liSelect) + ELSE + SET DATASESSION TO (liFormSession) + ENDIF + LIST STATUS TO (lcErrData) NOCONSOLE + + IF liSession = liFormSession + SELECT (THIS.cLogAlias) + ELSE + SET DATASESSION TO (liSession) + ENDIF + + APPEND MEMO listing FROM (lcErrData) + + ERASE (lcErrData) + REPLACE listing WITH CHR(13)+REPLICATE("=",50)+CHR(13)+; + " Memory listing"+CHR(13)+; + REPLICATE("=",50)+CHR(13) ; + ADDITIVE + + LIST MEMORY TO (lcErrData) NOCONSOLE + APPEND MEMO listing FROM (lcErrData) + + ERASE (lcErrData) + SELECT (liSelect) + + + + ENDPROC + + PROCEDURE geterrorattribute && Returns appropriate information from aErrorClass array for a given error number. + LPARAMETER tiColumn, tvErrNo + + ASSERT EMPTY(tiColumn) OR ; + (VARTYPE(tiColumn) = "N" AND ; + BETWEEN(tiColumn,1,ALEN(THIS.aErrorClass,2))) + + ASSERT EMPTY(tvErrNo) OR INLIST(VARTYPE(tvErrNo),"N","C") + + LOCAL lcErrString, liColumn, liIndex, lvReturn, lcType + + DO CASE + CASE EMPTY(tvErrNo) + lcErrString = "/"+TRANSFORM(THIS.iCurrentError)+"/" + CASE VARTYPE(tvErrNo) = "N" + lcErrString = "/"+TRANSFORM(tvErrNo)+"/" + OTHERWISE + lcErrString = "/"+ALLTR(tvErrNo)+"/" + ENDCASE + + IF EMPTY(tiColumn) + * return the first column, error number string + liColumn = 1 + ELSE + liColumn = tiColumn + ENDIF + + lcType = VARTYPE(THIS.aErrorClass[1,liColumn]) + DO CASE + CASE lcType = "C" + lvReturn = "" + CASE INLIST(lcType,"N","I","Y") + lvReturn = NTOM(0) + CASE INLIST(lcType,"D","T") + lvReturn = {} + CASE lcType = "O" + lvReturn = .NULL. + OTHERWISE + * lvReturn = .F. + ENDCASE + + FOR liIndex = 1 TO ALEN(THIS.aErrorClass,1) + IF lcErrString $ THIS.aErrorClass[liIndex,1] + lvReturn = THIS.aErrorClass[liIndex,liColumn] + EXIT + ENDIF + ENDFOR + + RETURN lvReturn + + + + ENDPROC + + PROCEDURE getmessageboxtitle && This is really meant for your subclass or instance to fill out with app-specific information, so that all user feedback (WAIT WINDOW NOWAITs and MESSAGEBOX()) by the error object matches your app properly. + RETURN ERROR_MESSAGEBOX_TITLE_LOC + ENDPROC + + PROCEDURE handle && Main routine to handle error. + LPARAMETERS tiError, tcMethod, tiLine + + THIS.cCurrentMessage = MESSAGE() + THIS.cCurrentErrorParam = SYS(2018) + THIS.iCurrentError = IIF(VARTYPE(tiError) # "N",0,tiError) + THIS.cCurrentMethod = TRANSFORM(tcMethod) + THIS.iCurrentLine = IIF(VARTYPE(tiLine) # "N",0,tiLine) + THIS.cCurrentClass = "" + THIS.lUserCancelled = .F. && it's possible + && for an outside program to ignore a previous CANCEL instruction + + THIS.FillArrays() + + * note: FillArrays() does an early bail for memory + * errors,which will be messaged by THIS.IsFatal() below + + * see FillArrays() for structure + * of aErrorClass array -- + * GetErrorAttribute + * gets a particular element by looking + * up error numbers in the first array column and specifying + * what column of the array is needed. This column + * is passed as GetErrorAttribute's first parameter + * (you can also pass a second parameter containing + * a particular error number to look up -- this defaults + * to the iCurrentError contents) + THIS.cCurrentClass = THIS.GetErrorAttribute(2) + * for example, + * THIS.cCurrentLevel = THIS.GetErrorAttribute(3) + * for a property that used a third column of + * the array to store some error severity classification system + + IF NOT (THIS.IsDisallowedServerAction(.T.) OR ; + THIS.IsFatal(.T.) OR ; + THIS.IsTrivial(.T.)) + + IF THIS.OKToReport() + + THIS.LogErrorReport() + + ENDIF + + IF THIS.OKToContinue() + + THIS.UserHandlesError() + + ENDIF + + + ENDIF + + + + ENDPROC + + PROCEDURE isdisallowedserveraction && Tells whether the error is caused by an attempt to execute UI or other disallowed action from a server + LPARAMETERS tlWantRecord + LOCAL llDisallowedServerAction + IF THIS.lServer AND ; + (THIS.iCurrentError = 2031 OR ; + (THIS.iCurrentError = 1001 AND ; + _VFP.Startmode = 5) ) + llDisallowedServerAction = .T. + IF tlWantRecord + THIS.RecordServerError(; + THIS.cCurrentMessage+CHR(13)+; + THIS.cCurrentErrorParam+CHR(13)+; + TRANS(THIS.iCurrentError)+CHR(13)+; + THIS.cCurrentMethod+CHR(13)+; + TRANS(THIS.iCurrentLine)) + ENDIF + ENDIF + RETURN llDisallowedServerAction + ENDPROC + + PROCEDURE isfatal && Whether error is a fatal type error. + LPARAMETERS tlWantDialog + + LOCAL llIsFatal, lcMessage + lcMessage = "" + + llIsFatal = INLIST("/"+THIS.cCurrentClass+"/", ; + "/memory/", ; + "/disk/", ; + "/program or resource file/" ) + + + IF llIsFatal AND tlWantDialog + lcMessage = ERROR_SERIOUS_CLASS_LOC + ": " + UPPER(THIS.cCurrentClass) + CHR(13) +; + ERROR_CANNOT_BE_LOGGED_LOC + CHR(13)+ ; + CHR(13)+CHR(13)+; + SYS(16,0)+ ; + CHR(13)+ CHR(13)+ ; + "#"+TRANSFORM(THIS.iCurrentError)+" "+ ; + THIS.cCurrentMethod+", "+TRANSFORM(THIS.iCurrentLine) + ; + CHR(13)+CHR(13)+ ; + ["]+THIS.cCurrentMessage+["] + + IF THIS.lServer + + THIS.RecordServerError(lcMessage) + + ELSE + =MESSAGEBOX(lcMessage+CHR(13)+CHR(13)+ ; + ERROR_USER_NOTE_LOC, ; + MB_ICONSTOP, ; + THIS.GetMessageBoxTitle()) + ENDIF + + + ENDIF + + RETURN llIsFatal + ENDPROC + + PROCEDURE isgooderrorlog && Validates error log + LPARAMETERS tcAlias + ASSERT USED(tcAlias) + + LOCAL ARRAY aTemp[1] + + =AFIELDS(aTemp,tcAlias) + + RETURN UPPER(aTemp(1,1))== "ERRSTAMP" AND ; + UPPER(aTemp(2,1))== "LISTING" AND ; + UPPER(aTemp(3,1))== "USERNOTES" AND ; + aTemp(1,2)+aTemp(2,2)+aTemp(3,2)=="TMM" + + ENDPROC + + PROCEDURE istrivial && Whether error is a trivial type error. + LPARAMETERS tlWantDialog + + LOCAL llIsTrivial, lcMessage + lcMessage = "" + llIsTrivial = INLIST("/"+THIS.cCurrentClass+"/", ; + "/print/", ; + "/lock/") + + IF llIsTrivial AND tlWantDialog + * messageboxes + + DO CASE + CASE THIS.cCurrentClass == "print" + + lcMessage = ERROR_PRINT_LOC + ":"+ ; + CHR(13)+CHR(13)+; + ["]+THIS.cCurrentMessage+["] + + + CASE THIS.cCurrentClass == "lock" + * should not happen unless SET REPROCESS + * is not properly set + lcMessage = ERROR_LOCK_LOC + ":"+ ; + CHR(13)+CHR(13)+; + THIS.cCurrentMessage + + ENDCASE + + IF NOT THIS.lServer + + =MESSAGEBOX(lcMessage+CHR(13)+CHR(13)+ ; + ERROR_USER_FIX_LOC,; + MB_ICONEXCLAMATION, ; + THIS.GetMessageBoxTitle()) + ENDIF + + ENDIF + + RETURN llIsTrivial + ENDPROC + + PROCEDURE logerrorreport && If lServer is .T. or user indicates logging is desired, opens error log and logs the error. + LOCAL lcMessage + + lcMessage = ["]+THIS.cCurrentMessage +["] + CHR(13)+CHR(13)+ ; + "("+TRANSFORM(THIS.iCurrentError)+")"+ ; + IIF(EMPTY(THIS.cCurrentErrorParam),"",; + " ("+THIS.cCurrentErrorParam+")" )+CHR(13)+ ; + THIS.cCurrentMethod+", "+TRANSFORM(THIS.iCurrentLine)+ CHR(13)+; + SYS(16,0) + + IF THIS.lServer OR ; + MESSAGEBOX(ERROR_OCCURRED_LOC+":"+CHR(13)+CHR(13)+; + lcMessage+ CHR(13)+CHR(13)+ ; + ERROR_LOG_LOC, ; + MB_ICONSTOP+MB_YESNO, ; + THIS.GetMessageBoxTitle()) ; + = IDYES + + IF NOT THIS.lServer + WAIT WINDOW NOWAIT LEFTC(lcMessage,254) + ENDIF + THIS.SetLog() + THIS.FillLogRecord() + WAIT CLEAR + + ENDIF + + ENDPROC + + PROCEDURE oktocontinue && Abstract method to evaluate error whether to continue program execution. + * abstract in the base + ENDPROC + + PROCEDURE oktoreport && Abstract method to evaluate error whether to report error. + * abstract in the base + ENDPROC + + PROCEDURE recordservererror && Establishes a consistent method for logging feedback which would ordinarily go to UI, for use in servers + LPARAMETERS tcMessage + LOCAL lcMessage + lcMessage = TRANSFORM(tcMessage) + THIS.SetLog() + INSERT INTO (THIS.cLogAlias) ("Errstamp") VALUES (DATETIME()) + REPLACE Listing WITH lcMessage IN (THIS.cLogAlias) + + ENDPROC + + PROCEDURE setlog && Evaluates log table name and alias, attempts to open and validate the table, creates new alias and log table name on the fly if anything goes wrong. + LPARAMETERS tcTableName, tcAlias + + IF (NOT EMPTY(THIS.cLogAlias)) AND ; + USED(THIS.cLogAlias) AND ; + THIS.IsGoodErrorLog(THIS.cLogAlias) + RETURN .T. + ENDIF + + LOCAL lcAlias, lcTableName, liSelect + + + IF VARTYPE(tcAlias) = "C" AND NOT EMPTY(tcAlias) + lcAlias = ALLTR(tcAlias) + IF USED(lcAlias) AND THIS.IsGoodErrorLog(lcAlias) + THIS.cLogAlias = lcAlias + ENDIF + ENDIF + + IF EMPTY(THIS.cLogAlias) + lcAlias = "E"+SYS(2015) + DO WHILE USED(lcAlias) + lcAlias = "E"+SYS(2015) + ENDDO + THIS.cLogAlias = lcAlias + ENDIF + + * now for the table name: + IF USED(THIS.cLogAlias) + + lcTableName = DBF(lcAlias) + + ELSE + + DO CASE + CASE VARTYPE(tcTableName) = "C" AND NOT EMPTY(tcTableName) + lcTableName = ALLTR(tcTableName) + CASE NOT EMPTY(THIS.cLogDBF) + lcTableName = ALLTR(THIS.cLogDBF) + OTHERWISE + lcTableName = "errorlog.dbf" + ENDCASE + IF AT(".",lcTableName) = 0 + lcTableName = lcTableName+".dbf" + ENDIF + + ENDIF + + THIS.cLogDBF = LOWER(FULLPATH(lcTableName)) + + IF NOT USED(THIS.cLogAlias) + + IF NOT EMPTY(SYS(2000,THIS.cLogDBF)) + USE (THIS.cLogDBF) AGAIN SHARED ALIAS (THIS.cLogAlias) IN 0 + IF EMPTY(THIS.cLogDBF) ; + OR NOT THIS.IsGoodErrorLog(THIS.cLogAlias) + IF USED(THIS.cLogAlias) + USE IN (THIS.cLogAlias) + ENDIF + * recursive call with new, temporary filename: + THIS.SetLog(FULLPATH(THIS.cLogAlias), THIS.cLogAlias) + ENDIF + ELSE + liSelect = SELECT() + SELE 0 + * v-darylm + CREATE TABLE (THIS.cLogDBF) FREE ; + (errstamp t, ; + listing m,; + usernotes m) + *!* CREATE TABLE (THIS.cLogDBF) ; + *!* (errstamp t, ; + *!* listing m,; + *!* usernotes m) + USE (THIS.cLogDBF) AGAIN SHARED ALIAS (THIS.cLogAlias) + SELECT (liSelect) + ENDIF + ENDIF + + RETURN + ENDPROC + + PROCEDURE usercancelled && Returns whether user opted to cancel after the current error. + RETURN THIS.lUserCancelled + ENDPROC + + PROCEDURE userhandleserror && Gives user choices about whether to go on with the app after an error. + LOCAL liContinue + + DO CASE + + CASE THIS.lServer + liContinue = IDYES + CASE VERSION(2) = 0 + liContinue = MESSAGEBOX( ERROR_USEREND_LOC,; + MB_ICONEXCLAMATION+MB_OKCANCEL, ; + THIS.GetMessageBoxTitle()) + + OTHERWISE + liContinue = MESSAGEBOX(ERROR_DEVEND_LOC, ; + MB_ICONEXCLAMATION+MB_YESNOCANCEL, ; + THIS.GetMessageBoxTitle()) + ENDCASE + + + DO CASE + + CASE INLIST(liContinue,IDYES, IDOK) + RETURN + + CASE liContinue = IDNO + DEBUG + SUSPEND + + + OTHERWISE + + THIS.lUserCancelled = .T. + * at this point in an object method, a CANCEL may be + * the same as a RETURN. The owning object + * has to decide what to do. If you do a CANCEL + * here it will have the effect of making it + * difficult for the container to RELEASE properly. + * This is especially a problem if the error + * has been invoked by the ON ERROR handler, because + * the ON... interrupt can take you back to anywhere. + + ENDCASE + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _objectstate AS _custom OF "_base.vcx" && Saves and restores state for any object either automatically (on Init and Destroy of this object) or on demand. + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: restore && Restores value of a property for oObject. + *m: save && Saves current value of a property for oObject. + *m: set && Sets a property to a new value for oObject. + *p: lautomatic && Automatically saves/restores properties for oObject. + *p: oobject && Reference to target object whose state is being saved. + *a: aproperties[1,3] && Array for saving/restoring properties of oObject. + * + + * + Name = "_objectstate" + oobject = .NULL. + * + + PROCEDURE Destroy + DODEFAULT() + + IF THIS.lAutomatic + THIS.Restore() + ENDIF + THIS.oObject = .NULL. + ENDPROC + + PROCEDURE Init + LPARAMETERS toObject + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + IF TYPE("toObject.BaseClass") = "C" + + THIS.lAutomatic = .T. + + THIS.oObject = toObject + + ENDIF + + ENDPROC + + PROCEDURE restore && Restores value of a property for oObject. + LPARAMETERS tcWhichProperty + + IF ISNULL(THIS.oObject) + RETURN .F. + ENDIF + + LOCAL lcProperty, liPos, liRow, lvCurrentValue, lcCurrentProperty + + ASSERT EMPTY(tcWhichProperty) OR VARTYPE(tcWhichProperty) = "C" + + IF EMPTY(tcWhichProperty) + + * restore all + + FOR liRow = 1 TO ALEN(THIS.aProperties,1) + + IF EMPTY(THIS.aProperties[liRow,1]) + LOOP + ENDIF + + lcCurrentProperty = STRTRAN(THIS.aProperties[liRow,1],"#","") + + lvCurrentValue = EVAL("THIS.oObject."+lcCurrentProperty) + + * avoid re-setting properties to their current + * value because this may cause a "flash" + IF THIS.aProperties[liRow,2] = "C" + + IF lvCurrentValue == THIS.aProperties[liRow,3] + LOOP + ENDIF + + ELSE + + IF lvCurrentValue = THIS.aProperties[liRow,3] + LOOP + ENDIF + + ENDIF + + STORE THIS.aProperties[liRow,3] TO ; + ("THIS.oObject."+lcCurrentProperty) + + ENDFOR + + ELSE + + lcProperty = LOWER(tcWhichProperty) + + liPos = ASCAN(THIS.aProperties,"#"+lcProperty+"#") + + IF liPos = 0 + + RETURN .F. + + ELSE + + liRow = ASUBSCRIPT(THIS.aProperties, liPos, 1) + STORE THIS.aProperties[liRow,3] TO ("THIS.oObject."+lcProperty) + + ENDIF + + ENDIF + + + ENDPROC + + PROCEDURE save && Saves current value of a property for oObject. + LPARAMETERS tcProperty, tcTypeValue + + ASSERT VARTYPE(tcProperty) = "C" AND NOT EMPTY(tcProperty) + ASSERT PCOUNT() < 2 OR VARTYPE(tcTypeValue) = "C" + + IF ISNULL(THIS.oObject) + RETURN .F. + ENDIF + + LOCAL lcProperty, liPos, liRow, lcTypeValue + + lcProperty = LOWER(tcProperty) + + liPos = ASCAN(THIS.aProperties,"#"+lcProperty+"#") + + IF liPos = 0 + + IF PCOUNT() = 2 + lcTypeValue = tcTypeValue + ELSE + lcTypeValue = TYPE("THIS.oObject."+tcProperty) + ENDIF + + liRow = ALEN(THIS.aProperties,1) + IF TYPE("THIS.aProperties[liRow,1]") = "C" + liRow = liRow + 1 + DIME THIS.aProperties[liRow,3] + ENDIF + + THIS.aProperties[liRow,1] = "#"+lcProperty+"#" + THIS.aProperties[liRow,2] = lcTypeValue + + ELSE + + liRow = ASUBSCRIPT(THIS.aProperties, liPos, 1) + + ENDIF + + THIS.aProperties[liRow,3] = EVAL("THIS.oObject."+lcProperty) + + ENDPROC + + PROCEDURE set && Sets a property to a new value for oObject. + LPARAMETERS tcProperty, tvValue, tlSave + + IF ISNULL(THIS.oObject) + RETURN .F. + ENDIF + + ASSERT TYPE("THIS.oObject."+tcProperty) # "U" + + LOCAL lcTypeValue + + lcTypeValue = VARTYPE(tvValue) + + IF lcTypeValue # TYPE("THIS.oObject."+tcProperty) + RETURN .F. + ENDIF + + IF tlSave + THIS.Save(tcProperty, lcTypeValue) + ENDIF + + STORE tvValue TO ; + ("THIS.oObject."+tcProperty) + + + + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _systoolbars AS _custom OF "_base.vcx" && Hides and shows system toolbars, either automatically (at Init and Destroy of this object) or on demand. + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_app.h" + * + *m: hidesystemtoolbars && Manually hides system toolbars for your application. + *m: initializetoolbararray + *m: showsystemtoolbars && Manually shows system toolbars for your application. + *p: lautomatic && Automatically hides and restores system toolbars for application. + *a: asystemtoolbars[1,0] && Array of system toolbars. + * + + * + Name = "_systoolbars" + * + + PROCEDURE Destroy + DODEFAULT() + IF THIS.lAutomatic + THIS.ShowSystemToolbars() + ENDIF + ENDPROC + + PROCEDURE hidesystemtoolbars && Manually hides system toolbars for your application. + LOCAL iIndex + + FOR iIndex = 1 TO ALEN(THIS.aSystemToolbars,1) + * note: it is possible for them to have been RELEASEd + * and not exist at all + IF WEXIST(THIS.aSystemToolbars[iIndex,1]) AND ; + WVISIBLE(THIS.aSystemToolbars[iIndex,1]) + THIS.aSystemToolbars[iIndex,2] = .T. + HIDE WINDOW (THIS.aSystemToolbars[iIndex,1]) + ENDIF + ENDFOR + + ENDPROC + + PROCEDURE Init + LPARAMETERS tlAuto + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + THIS.InitializeToolbarArray() + + IF THIS.lAutomatic OR tlAuto + THIS.lAutomatic = .T. + THIS.HideSystemToolbars() + ENDIF + ENDPROC + + PROCEDURE initializetoolbararray + DIME THIS.aSystemToolbars[11,2] + + THIS.aSystemToolbars[1,1]= TB_STANDARD_LOC + THIS.aSystemToolbars[2,1]= TB_LAYOUT_LOC + THIS.aSystemToolbars[3,1]= TB_QUERY_LOC + THIS.aSystemToolbars[4,1]= TB_VIEWDESIGNER_LOC + THIS.aSystemToolbars[5,1]= TB_COLORPALETTE_LOC + THIS.aSystemToolbars[6,1]= TB_FORMCONTROLS_LOC + THIS.aSystemToolbars[7,1]= TB_DATADESIGNER_LOC + THIS.aSystemToolbars[8,1]= TB_REPODESIGNER_LOC + THIS.aSystemToolbars[9,1]= TB_REPOCONTROLS_LOC + THIS.aSystemToolbars[10,1]= TB_PRINTPREVIEW_LOC + THIS.aSystemToolbars[11,1]= TB_FORMDESIGNER_LOC + + ENDPROC + + PROCEDURE showsystemtoolbars && Manually shows system toolbars for your application. + LOCAL iIndex + + FOR iIndex = 1 TO ALEN(THIS.aSystemToolbars,1) + IF WEXIST(THIS.aSystemToolbars[iIndex,1]) AND ; + THIS.aSystemToolbars[iIndex,2] + SHOW WINDOW (THIS.aSystemToolbars[iIndex,1]) + ENDIF + ENDFOR + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _traceawaretimer AS _timer OF "_base.vcx" && Timer with a special (slower) interval for debugging, so that timer events still occur but don't interrupt other tracing. + *< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: iregularinterval && Standard interval period. + *p: itraceinterval && Slower interval period you wish to use while debugging. + * + + * + iregularinterval = 0 + itraceinterval = 10000 + Name = "_traceawaretimer" + * + + PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + THIS.iRegularInterval = THIS.Interval + ENDPROC + + PROCEDURE Timer + IF WVISIBLE("trace") OR ; + WVISIBLE("debugger") OR ; + WVISIBLE("call") OR ; + WVISIBLE("watch") OR ; + WVISIBLE("locals") + + IF THIS.Interval # THIS.iTraceInterval + THIS.iRegularInterval = THIS.Interval + THIS.Interval = THIS.iTraceInterval + ENDIF + + ELSE + + IF THIS.Interval = THIS.iTraceInterval + THIS.Interval = THIS.iRegularInterval + ENDIF + THIS.iRegularInterval = THIS.Interval + + ENDIF + ENDPROC + +ENDDEFINE diff --git a/Clase/_base.vc2 b/Clase/_base.vc2 new file mode 100644 index 0000000..f10d429 --- /dev/null +++ b/Clase/_base.vc2 @@ -0,0 +1,8214 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="_base.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS _activedoc AS activedoc && Foundation ActiveDoc class. + *< CLASSDATA: Baseclass="activedoc" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 68 + Name = "_activedoc" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 68 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _checkbox AS checkbox && Foundation CheckBox class. + *< CLASSDATA: Baseclass="checkbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Check1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 17 + Name = "_checkbox" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 60 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _collection AS collection && Foundation Collection class. + *< CLASSDATA: Baseclass="collection" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_collection" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _combobox AS combobox && Foundation ComboBox class. + *< CLASSDATA: Baseclass="combobox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 24 + Name = "_combobox" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 100 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _commandbutton AS commandbutton && Foundation CommandButton class. + *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Command1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 27 + Name = "_commandbutton" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 84 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _commandgroup AS commandgroup && Foundation CommandGroup class. + *< CLASSDATA: Baseclass="commandgroup" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + ButtonCount = 2 + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 66 + Name = "_commandgroup" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + Value = 1 + vresult = .T. + Width = 94 + Command1.Caption = "Command1" + Command1.Height = 27 + Command1.Left = 5 + Command1.Name = "Command1" + Command1.Top = 5 + Command1.Width = 84 + Command2.Caption = "Command2" + Command2.Height = 27 + Command2.Left = 5 + Command2.Name = "Command2" + Command2.Top = 34 + Command2.Width = 84 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _container AS container && Foundation Container class. + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 200 + Name = "_container" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 200 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _control AS control && Foundation Control class. + *< CLASSDATA: Baseclass="control" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 22 + Name = "_control" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 24 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _cursor2 AS cursor && Foundation Cursor class. + *< CLASSDATA: Baseclass="cursor" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_cursor2" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _cursoradapter AS cursoradapter && Foundation CursorAdapter class. + *< CLASSDATA: Baseclass="cursoradapter" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 22 + Name = "_cursoradapter" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _custom AS custom && Foundation Custom class. + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 22 + Name = "_custom" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 24 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _dataenvironment2 AS dataenvironment && Foundation DataEnvironment class. + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + DataSource = .NULL. + Height = 22 + Name = "_dataenvironment2" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 24 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _editbox AS editbox && Foundation EditBox class. + *< CLASSDATA: Baseclass="editbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 53 + Name = "_editbox" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 100 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _form AS form && Foundation Form class. + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Form1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + DoCreate = .T. + Name = "_form" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + ShowWindow = 1 + vresult = .T. + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _formset AS formset && Foundation FormSet class. + *< CLASSDATA: Baseclass="formset" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Form1" UniqueID="" Timestamp="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Name = "_formset" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + * + + ADD OBJECT 'Form1' AS _form WITH ; + builder = , ; + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm"), ; + Caption = "Form1", ; + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg"), ; + cversion = , ; + DoCreate = .T., ; + Name = "Form1", ; + ninstances = 0, ; + nobjectrefcount = 0, ; + ohost = .NULL., ; + vresult = .T. + *< END OBJECT: ClassLib="_base.vcx" BaseClass="form" /> + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + + PROCEDURE Form1.addtoproject + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Form1.Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Form1.Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Form1.Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE Form1.newinstance + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE Form1.ninstances_access + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE Form1.ninstances_assign + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE Form1.nobjectrefcount_access + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE Form1.nobjectrefcount_assign + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE Form1.release + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE Form1.releaseobjrefs + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE Form1.sethost + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE Form1.setobjectref + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE Form1.setobjectrefs + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _grid AS grid && Foundation Grid class. + *< CLASSDATA: Baseclass="grid" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 200 + Name = "_grid" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 320 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _hyperlink AS hyperlink && Foundation Hyperlink class. + *< CLASSDATA: Baseclass="hyperlink" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_hyperlink" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _image AS image && Foundation Image class. + *< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 68 + Name = "_image" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 68 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _label AS label && Foundation Label class. + *< CLASSDATA: Baseclass="label" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Label1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 16 + Name = "_label" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 40 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _line AS line && Foundation Line class. + *< CLASSDATA: Baseclass="line" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 68 + Name = "_line" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 68 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _listbox AS listbox && Foundation Listbox class. + *< CLASSDATA: Baseclass="listbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 170 + Name = "_listbox" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 100 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _optionbutton2 AS optionbutton && Foundation OptionButton class. + *< CLASSDATA: Baseclass="optionbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Option1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 17 + Name = "_optionbutton2" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 61 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _optiongroup AS optiongroup && Foundation OptionGroup class. + *< CLASSDATA: Baseclass="optiongroup" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + ButtonCount = 2 + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 46 + Name = "_optiongroup" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + Value = 1 + vresult = .T. + Width = 71 + Option1.Caption = "Option1" + Option1.Height = 17 + Option1.Left = 5 + Option1.Name = "Option1" + Option1.Top = 5 + Option1.Value = 1 + Option1.Width = 61 + Option2.Caption = "Option2" + Option2.Height = 17 + Option2.Left = 5 + Option2.Name = "Option2" + Option2.Top = 24 + Option2.Width = 61 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _page2 AS page && Foundation Page class. + *< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Page1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 16 + Name = "_page2" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 60 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _pageframe AS pageframe && Foundation PageFrame class. + *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + ErasePage = .T. + Height = 169 + Name = "_pageframe" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + PageCount = 2 + vresult = .T. + Width = 241 + Page1.Caption = "Page1" + Page1.Name = "Page1" + Page2.Caption = "Page2" + Page2.Name = "Page2" + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _projecthook AS projecthook && Foundation ProjectHook class. + *< CLASSDATA: Baseclass="projecthook" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 68 + Name = "_projecthook" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 68 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _relation2 AS relation && Foundation Relation class. + *< CLASSDATA: Baseclass="relation" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_relation2" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _separator AS separator && Foundation Separator class. + *< CLASSDATA: Baseclass="separator" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 0 + Name = "_separator" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 0 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _shape AS shape && Foundation Shape class. + *< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 68 + Name = "_shape" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 68 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _spinner AS spinner && Foundation Spinner class. + *< CLASSDATA: Baseclass="spinner" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 24 + Name = "_spinner" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 120 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _textbox AS textbox && Foundation TextBox class. + *< CLASSDATA: Baseclass="textbox" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_textbox" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 100 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _timer AS timer && Foundation Timer class. + *< CLASSDATA: Baseclass="timer" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_timer" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _toolbar AS toolbar && Foundation Toolbar class. + *< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + Caption = "Toolbar1" + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Name = "_toolbar" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + ShowWindow = 1 + vresult = .T. + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _xmladapter AS xmladapter && Foundation XMLAdapter class. + *< CLASSDATA: Baseclass="xmladapter" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Tables" UniqueID="" Timestamp="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 56 + Name = "_xmladapter" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 56 + * + + ADD OBJECT 'Tables' AS collection WITH ; + Height = 23, ; + Left = 23, ; + Name = "Tables", ; + Top = 23, ; + Width = 23 + *< END OBJECT: BaseClass="collection" /> + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _xmlfield AS xmlfield && Foundation XMLField class. + *< CLASSDATA: Baseclass="xmlfield" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 23 + Name = "_xmlfield" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 23 + * + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _xmltable AS xmltable && Foundation XMLTable class. + *< CLASSDATA: Baseclass="xmltable" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Fields" UniqueID="" Timestamp="" /> + + * + *m: addtoproject && Dummy code for adding files to project. + *m: newinstance && Returns new instance of object. + *m: ninstances_access && Access method for nInstances property. + *m: ninstances_assign && Assign method for nInstances property. + *m: nobjectrefcount_access && Access method for nObjectRefCount property. + *m: nobjectrefcount_assign && Assign method for nObjectRefCount property. + *m: release && Releases object from memory. + *m: releaseobjrefs && Releases all object references of aObjectRefs array. + *m: sethost && Set oHost property to form reference object. + *m: setobjectref && Set object reference to specific property. + *m: setobjectrefs && Place holder method for listing SetObjectRef method calls. + *p: builder && Bulder property. + *p: builderx && BuilderX property. + *p: csetobjrefprogram && Program to be called when when setting an object references via the SetObjectRef method. + *p: cversion && Version property. + *p: lautobuilder && Specifies if custom FFC builder is automatically launched when instance is added to a container in design mode, even if the control pallette Builder Lock button is off. + *p: lautosetobjectrefs && Specifiies if the SetObjectRefs method is automatically called from the Init method. + *p: lignoreerrors && Specifies if the default FFC error handler is executed when an error occurs. + *p: lrelease && Indicates the object's Release method has been executed and the object is in the process of being released from memory. + *p: lsethost && Specifies if the SetHost method is automatically called from the Init method to set the oHost property to THISFORM. + *p: ninstances && Number of instances. + *p: nobjectrefcount && Returns the number of items in the object reference array property aObjectRefs. + *p: ohost && Object reference to host object (generally THISFORM), which is automatically set on Init if lSetHost is .T. + *p: vresult && Variant result property for internal usage when calling programs in PRGs and a return file is required. + *a: aobjectrefs[1,3] && Array of object references properties. + * + + * + builder = + builderx = (HOME()+"Wizards\BuilderD,BuilderDForm") + csetobjrefprogram = (IIF(VERSION(2)=0,"",HOME()+"FFC\")+"SetObjRf.prg") + cversion = + Height = 56 + Name = "_xmltable" + ninstances = 0 + nobjectrefcount = 0 + ohost = .NULL. + vresult = .T. + Width = 56 + * + + ADD OBJECT 'Fields' AS collection WITH ; + Height = 23, ; + Left = 23, ; + Name = "Fields", ; + Top = 23, ; + Width = 23 + *< END OBJECT: BaseClass="collection" /> + + PROTECTED PROCEDURE addtoproject && Dummy code for adding files to project. + *-- Dummy code for adding files to project. + RETURN + + DO SetObjRf.prg + + ENDPROC + + PROCEDURE Destroy + IF this.lRelease + RETURN .F. + ENDIF + this.lRelease=.T. + this.ReleaseObjRefs + this.oHost=.NULL. + + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lcOnError,lcErrorMsg,lcCodeLineMsg + + IF this.lIgnoreErrors OR _vfp.StartMode>0 + RETURN .F. + ENDIF + lcOnError=UPPER(ALLTRIM(ON("ERROR"))) + IF NOT EMPTY(lcOnError) + lcOnError=STRTRAN(STRTRAN(STRTRAN(lcOnError,"ERROR()","nError"), ; + "PROGRAM()","cMethod"),"LINENO()","nLine") + &lcOnError + RETURN + ENDIF + lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)+this.Name+CHR(13)+ ; + "Error: "+ALLTRIM(STR(nError))+CHR(13)+ ; + "Method: "+LOWER(ALLTRIM(cMethod)) + lcCodeLineMsg=MESSAGE(1) + IF BETWEEN(nLine,1,100000) AND NOT lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine)) + IF NOT EMPTY(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+CHR(13)+CHR(13)+lcCodeLineMsg + ENDIF + ENDIF + WAIT CLEAR + MESSAGEBOX(lcErrorMsg,16,_screen.Caption) + ERROR nError + + ENDPROC + + PROCEDURE Init + IF this.lSetHost + this.SetHost + ENDIF + IF this.lAutoSetObjectRefs AND NOT this.SetObjectRefs(this) + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE newinstance && Returns new instance of object. + LPARAMETERS tnDataSessionID + LOCAL oNewObject,lnLastDataSessionID + + lnLastDataSessionID=SET("DATASESSION") + IF TYPE("tnDataSessionID")=="N" AND tnDataSessionID>=1 + SET DATASESSION TO tnDataSessionID + ENDIF + oNewObject=NEWOBJECT(this.Class,this.ClassLibrary) + SET DATASESSION TO (lnLastDataSessionID) + RETURN oNewObject + + ENDPROC + + PROCEDURE ninstances_access && Access method for nInstances property. + LOCAL laInstances[1] + + RETURN AINSTANCE(laInstances,this.Class) + + ENDPROC + + PROCEDURE ninstances_assign && Assign method for nInstances property. + LPARAMETERS vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE nobjectrefcount_access && Access method for nObjectRefCount property. + LOCAL lnObjectRefCount + + lnObjectRefCount=ALEN(this.aObjectRefs,1) + IF lnObjectRefCount=1 AND EMPTY(this.aObjectRefs[1]) + lnObjectRefCount=0 + ENDIF + RETURN lnObjectRefCount + + ENDPROC + + PROCEDURE nobjectrefcount_assign && Assign method for nObjectRefCount property. + LPARAMETERS m.vNewVal + + ERROR 1743 + + ENDPROC + + PROCEDURE release && Releases object from memory. + LOCAL lcBaseClass + + IF this.lRelease + NODEFAULT + RETURN .F. + ENDIF + this.lRelease=.T. + lcBaseClass=LOWER(this.BaseClass) + this.oHost=.NULL. + this.ReleaseObjRefs + IF NOT INLIST(lcBaseClass+" ","form ","formset ","toolbar ") + RELEASE this + ENDIF + + ENDPROC + + PROCEDURE releaseobjrefs && Releases all object references of aObjectRefs array. + LOCAL lcName,oObject,lnCount + + IF this.nObjectRefCount=0 + RETURN + ENDIF + FOR lnCount = this.nObjectRefCount TO 1 STEP -1 + lcName=this.aObjectRefs[lnCount,1] + IF EMPTY(lcName) OR NOT PEMSTATUS(this,lcName,5) OR TYPE("this."+lcName)#"O" + LOOP + ENDIF + oObject=this.&lcName + IF ISNULL(oObject) + LOOP + ENDIF + IF TYPE("oObject")=="O" AND NOT ISNULL(oObject) AND PEMSTATUS(oObject,"Release",5) + oObject.Release + ENDIF + IF NOT ISNULL(oObject) AND PEMSTATUS(oObject,"oHost",5) + oObject.oHost=.NULL. + ENDIF + this.&lcName=.NULL. + oObject=.NULL. + ENDFOR + DIMENSION this.aObjectRefs[1,3] + this.aObjectRefs="" + + ENDPROC + + PROCEDURE sethost && Set oHost property to form reference object. + this.oHost=IIF(TYPE("thisform")=="O",thisform,.NULL.) + + ENDPROC + + PROCEDURE setobjectref && Set object reference to specific property. + LPARAMETERS tcName,tvClass,tvClassLibrary + LOCAL lvResult + + this.vResult=.T. + DO (this.cSetObjRefProgram) WITH (this),(tcName),(tvClass),(tvClassLibrary) + lvResult=this.vResult + this.vResult=.T. + RETURN lvResult + + ENDPROC + + PROCEDURE setobjectrefs && Place holder method for listing SetObjectRef method calls. + LPARAMETERS toObject + + RETURN + + ENDPROC + +ENDDEFINE diff --git a/Clase/_framewk.h b/Clase/_framewk.h new file mode 100644 index 0000000..2f9fdef --- /dev/null +++ b/Clase/_framewk.h @@ -0,0 +1,176 @@ +* _framewk.h + +*********************************************************** +* localization strings, constants, +* and tunable expressions for _framewk.vcx, +* framework-enabling header file for global template classes + +*********************************************************** + +* _application class + +#DEFINE APP_MEDIATOR_SUPERCLASS "_formmediator" +* note: don't use TRANSFORM() or trim below, need the padding spaces: +#DEFINE APP_META_FAVE_ID STR(RECNO()) +#DEFINE APP_META_UNAVAILABLE_LOC "Metatable in use or unavailable:" +#DEFINE APP_META_WRONGFORMAT_LOC "Metatable has incorrect structure:" +#DEFINE APP_META_MISSINGINDEX_LOC "One or more of required indexes"+CHR(13)+ ; + "is missing from your metatable:" + +#DEFINE PJX_META_DOC_FORM_TYPE "F" +#DEFINE PJX_META_DOC_REPORT_TYPE "R" +#DEFINE PJX_META_DOC_HEADER_TYPE "A" + +#DEFINE APP_FEATURE_NOT_AVAILABLE_LOC "Feature not available." +#DEFINE APP_FILE_NOT_FOUND_LOC "File not found, or unavailable."+CHR(13)+; + "It may be in use." +#DEFINE APP_READY_TO_SHUTDOWN_LOC "Are you sure you want to quit?" +#DEFINE APP_LOADING_LOC "Loading..." + +#DEFINE APP_PM_WIN_TITLE_LOC "Project Manager - " +#DEFINE APP_ALREADY_EXISTS_LOC "already exists" +#DEFINE APP_GO_PAD_LOC "\ (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS _aboutbox AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default about box + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="imgApplication" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblApplicationName" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblCredits" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: applyattributestodialogelements && Called in ApplyAppAttributes(), after this method has transferred app "credits" information to dialog property values, so you can apply these attributes to the visual elements of the dialog. + *p: cauthor + *p: ccaption + *p: ccompany + *p: ccopyright + *p: cimage + *p: ctrademark + * + + * + Caption = "About Application" + cauthor = + ccaption = + ccompany = + ccopyright = + cimage = + ctrademark = + cversion = + DoCreate = .T. + Height = 218 + Name = "_aboutbox" + Width = 367 + * + + ADD OBJECT 'cmdOK' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'imgApplication' AS _image WITH ; + BackStyle = 0, ; + Height = 72, ; + Left = 14, ; + Name = "imgApplication", ; + Stretch = 1, ; + Top = 12, ; + Width = 90 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="image" /> + + ADD OBJECT 'lblApplicationName' AS _label WITH ; + Alignment = 2, ; + AutoSize = .F., ; + Caption = "Application Name", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 31, ; + Left = 116, ; + Name = "lblApplicationName", ; + Top = 12, ; + Width = 237 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblCredits' AS _label WITH ; + Alignment = 2, ; + AutoSize = .F., ; + Caption = "Credits", ; + FontName = "MS Sans Serif", ; + Height = 127, ; + Left = 116, ; + Name = "lblCredits", ; + Top = 48, ; + Width = 237 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + PROCEDURE applyappattributes + LPARAMETERS toApp + IF DODEFAULT(toApp) + + * parent dialog class is already setting Icon + THIS.Caption = ABOUT_LOC+" "+TRANS(toApp.cCaption) + THIS.cCaption = TRANS(toApp.cCaption) + THIS.cVersion = TRANS(toApp.cVersion) + THIS.cCopyright = TRANS(toApp.cCopyright) + THIS.cCompany = TRANS(toApp.cCompany) + THIS.cAuthor = TRANS(toApp.cAuthor) + THIS.cTrademark = TRANS(toApp.cTrademark) + THIS.cImage = TRANS(toApp.cImage) + + + ENDIF + + THIS.ApplyAttributesToDialogElements() + + + ENDPROC + + PROCEDURE applyattributestodialogelements && Called in ApplyAppAttributes(), after this method has transferred app "credits" information to dialog property values, so you can apply these attributes to the visual elements of the dialog. + IF PEMSTATUS(THIS,"imgApplication",5) + IF (NOT EMPTY(THIS.cImage)) AND ; + (FILE(THIS.cImage)) + THIS.imgApplication.Visible = .T. + THIS.imgApplication.Picture = THIS.cImage + ELSE + THIS.imgApplication.Visible = .F. + ENDIF + ENDIF + + IF PEMSTATUS(THIS,"lblApplicationName",5) + THIS.lblApplicationName.Caption = THIS.cCaption + ENDIF + + IF PEMSTATUS(THIS,"lblCredits",5) + + THIS.lblCredits.Caption = THIS.cAuthor + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + THIS.cCompany + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + THIS.cCopyright + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + THIS.cTrademark + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + THIS.cVersion + + ENDIF + + + ENDPROC + + PROCEDURE cmdOK.Click + THISFORM.Release() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _application AS _container OF "..\ffc\_base.vcx" && application object superclass + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cusError" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusDataSession" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusWindowHandler" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusTableSort" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusTableNav" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="tmrRefresh" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: activate && Makes the application active + *m: activateforminframe && Takes a form or toolbar reference and fixes it to appear in top form "frame" even if its ShowWindow property was 0 + *m: activatesystemwindow && Activates a system window whose name has been passed, in _SCREEN, even if _SCREEN wasn't previously visible (for debugging, does nothing in runtime) + *m: addcollaborator && Instantiate objects that can't be part of application container and add a reference to collaborators collection for maintenance. See SetScreenAttributes() for examples. + *m: addmediatedsession && Creates a data session with a mediator object attached, referenced in the aCollaborators collection, returns a reference to this framework-enabled session. + *m: applyglobaluseroptions && Applies global (non-datasession-specific) options to the _application object and environment. Where user login and preferences are not used, applies a single set at startup -- with user login and preferences, applies to each user login. + *m: applyuseroptsforsession && Applies datasession-specific options a form object and its session environment. + *m: beforedoform && Hook in DoForm method, allowing last-minute manipulation of environment before the form class or object is instantiated. + *m: beforereadevents && Method executed before READ EVENTS is executed when ReadEvents is called. + *m: caboutboxclass_access && Synchronizes classname value with lAboutBox value + *m: cappfolder_access && Determines the application folder, usually the folder containing the running APP or EXE. However where a temporary wrapper program or ON... command has been used to instantiate the application, this value may be the location of the VCX + *m: cascadeall && Wraps cusWindowHandler's CascadeFormInstances() method, passing no argument. + *m: cascadeform && For backwards compatibility, not used + *m: ccaption_access + *m: ccaption_assign + *m: cdatafolder_assign + *m: cerrorlogtablename_access && adds cAppFolder information to the error log table name, so the default error DBF is always in one place. + *m: checkpassword && Sends a passed value and a stored value from the current user information to CheckValueAgainstStoredPassword for verification. + *m: checkvalueagainststoredpassword && Compares a current password entry against an encrypted stored entry. Separated from CheckPassword so its simple algorithm can be replaced as necessary. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match. + *m: cicon_assign + *m: cimage_assign && Verifies the availability of an image file for use as the application logo + *m: clearevents && Clears any pending read events. + *m: clearfavorites && Called by Favorites menu item, to confirm "zap" of user favorites and invoke SetCurrentUserFavoriteIDs mechanism. + *m: clearlasterror && Sets _application.iLastError to NULL, called before operations which may require an error to be tested on conclusion. Abstracted for easy overriding in subclasses. + *m: createcollaborators && A startup hook to allow you to call the AddCollaborators() method during initialization procedures + *m: createformmediator && Adds a app mediator object to a form + *m: createframe && Creates the MDI frame for top form applications. + *m: createstoredpassword && Creates an encrypted value of a password. Separated from StorePassword() for easy replacement of its simple algorithm. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match. + *m: createusertable && Creates and indexs user table when it does not exist. Abstracted for easy editing. The app expects this table to have 1 c-type field, with its name in the cUserTableIDField property, and 1 i-type field, its name in cUserTableLevelField. + *m: creference_assign + *m: cstartupformclass_access && Synchronizes classname value with lStartupForm value + *m: cstartuptoolbarclass_access && Synchronizes classname value with lStartupToolbar value + *m: ctextdisplayfont_assign + *m: cusertablealias_assign + *m: cusertablename_access + *m: datarevert && Wraps cusDataSession's Revert() method. + *m: dataupdate && Wraps cusDataSession's Update() method. + *m: displayerrorlog && Instantiates cErrorViewerClass dialog + *m: doaboutbox && Invokes cAboutBoxClass dialog class + *m: dochangepassword && Invokes cChangePasswordClass dialog class + *m: docontextmenu && Manages context menus and context menu collection + *m: dodocumentpickerdialog && Invokes all the dialogs descending from the _documentpicker dialog superclass + *m: dofile && Executes files, channelling known FoxPro-type files to appropriate application Do... methods, and files of unknown types through Windows API + *m: doform && Executes an SCX form or instantiates a VCX-based form/formset class. + *m: doformnoshow && Executes an SCX form or instantiates a VCX-based form/formset class, without Showing it, and returning a reference to the form or formset instantiated. + *m: dohelp && Executes help of types .hlp, .dbf, .htm, or .chm + *m: dolabel && Executes an LBX label + *m: domenu && Executes an MPR/MPX menu. + *m: domenuiteminframe && Not currently used, wraps cusWindowHandler method + *m: domodaldialogclass && Instantiates a modal dialog, applying application attributes as appropriate. RETURNs a form reference, if NOSHOW. + *m: donewopen && Invokes cNewOpenClass + *m: dooptionsdialog && Invokes cOptionsDialogClass + *m: doprogram && Executes a PRG, APP, FXP, or EXE program. + *m: doreport && Executes an FRX or LBX report form. + *m: doreportdialog && Invokes cReportDialogClass + *m: dosort && Wraps cusTableSort's DoSort() method. + *m: dostartupform && Instantiates cStartupFormClass dialog + *m: dotableoutput && Looks at the current form/alias and invokes the _outputdialog class appropriately for a table. Scope 1 or all. Hooks mediator's PrepareOutputAlias() and CleanupOutputAlias(), for framework-enabled forms, and app.SetHTMLClass/SetHTMLStyleID for GENHTML. + *m: dotoolbar && Parallel to DoForm. Maintains toolbars collection. Pass a toolbar class library & class name. Uses THIS.iInitialToolbarPosition to set position. + *m: douserlogin && Invokes cUserLoginClass dialog. Returns (NOT EOF(THIS.cUserTableAlias)) to indicate success at locating a user. + *m: exporterrorlog && Invokes _outputdialog class to allow output of error log information. + *m: filenotfoundmsgbox && Displays a File Not Found messagebox. + *m: filluseroptionsarray && Moves the user table's UserOpts contents to aCurrentUserOpts. Array has 4 columns: property name, value, toggle property or SET, datasession or global attribute + *m: formisframeworkenabled && Reports the existance of a mediator object on a form. Uses THIS.cFormMediatorName to determine the naming convention for this object on the form. + *m: getcurrentalias && Wraps the cusTableNav member's GetCurrentAlias() method. + *m: getcurrenttopformref && Wraps cusWindowHandler's GetCurrentTopFormRef() method. + *m: getformmediatorref && Returns a reference to a form's mediator object, or NULL if the form is not framework-enabled with a mediator object. + *m: getresourcefilename && Pass: tcSource, tcExtList, tlSuppressMsg, looks for file with any of extensions in list, in order, to RETURN the appropriate pathed name ("" if none, with File Not Found msg unless tlSuppressMsg). Ignores tcExtlList if explicit ext passed in tcSource. + *m: getuseroptionsetting && Takes option name and array (usually aCurrentUserOpts) and returns current value for that option, NULL if not found. + *m: gobottom && Wraps cusTableNav member's GoBottom() method. + *m: gonext && Wraps cusTableNav member's GoNext() method. + *m: goprevious && Wraps cusTableNav member's GoPrevious() method. + *m: gotop && Wraps cusTableNav member's GoTop() method. + *m: gotorecord && Wraps cusTableNav member's GoToRecord() method. + *m: handleprojectwindow && Hides a project with the name stored in THIS.cProjectName on startup, if it is showing, and restores it when the app object Destroys. + *m: iinitialtoolbarposition_assign + *m: ilasterror_access + *m: instantiate && RETURNs object reference -- pass classname, classlib, APP/EXE if library is external, string of delimited parameters to be macro-executed. If being added as a member, also pass container ref plus membername if it's not OK to use unique/generated name. + *m: iserrorfree && RETURNs ISNULL(THIS.iLastError) -- See THIS.ClearLastError(). + *m: lgomenu_assign + *m: lnavtoolbar_assign + *m: lnointerrupt_assign + *m: lusercanchangepassword_access + *m: lusercanchangepassword_assign + *m: onshutdown && Occurs when the user attempts to exit Visual FoxPro by pressing _SCREEN close button or the close button on a framework top form MDI frame. + *m: purgeerrorlog && Zaps current error log with appropriate confirmation and checks. + *m: querydatachanged && Wraps cusDataSession member's DataChanged() method. + *m: querydatasessionunload && Wraps cusDataSession member's Queryunload() method. + *m: readevents && Starts read events mode. + *m: refreshfavoritepopup && DEFINEs BARs for Favorites menu popup using THIS.cCurrentUserFavoriteIDs. + *m: refreshformscollection && Refresh forms collection arrays and counters. + *m: refreshtoolbars && Called by member timer and at any other time you need to synch toolbars to current environment. Iterates through toolbar collection calling Refresh methods so that it doesn't assume any tbr class. + *m: releasecollaborators && Manages release of collaborative objects + *m: releasecontextmenu && Manages release of a single context menu and the context menu collection. + *m: releasecontextmenus && Releases all context menus. + *m: releaseform && Release specific or active form and manages forms collection. + *m: releaseforms && Release all application forms from memory and the forms collection. + *m: releaseframe && Releases top form/MDI frame. + *m: releasesessions && Releases all mediated datasession collaborator objects + *m: releasetoolbar && Parallel to ReleaseForm. Maintains toolbars collection. + *m: releasetoolbars && Parallel to ReleaseForms. Iterates through toolbar collection + *m: resetformscollection && Reset arrays and counters of forms collection. + *m: restoreenvironment && Restores environment settings. + *m: saveenvironment && Saves environment settings. + *m: seekcurrentuser && This method finds the current user using an exact match (case sensitivity depends on THIS.lUserNameIsCaseSensitive). + *m: seekdefaultuser && This method finds a record with a blank user name where default options and favorites are stores, for use when defining a new user or when user logins and separate user profiles are not required. + *m: seekmetatablefavoriteid && Finds a record in the meta table using an identification specified in #DEFINE APP_META_FAVE_ID in _FRAMEWK.H. Override this method if you decide to use a more sophisticated method of identifying records in the metatable! + *m: setappfilenames && Get top-level filename, and also get the name of the module (app or exe) that owns this particular object, for SET CLASSLIB ... IN... default usage, which may be different, especially in modular and non-ReadEvents apps. + *m: setcurrentuser && Finds the current user and sets up the app to deal with the current user (permissions, options, favorites, and macros may all change per user). + *m: setcurrentuserfavoriteids && Saves and restores THIS.cCurrentUserFavoriteIDs information to UserFave memo field in user table. This memo field also contains date information, so user can opt to clear favorites list if metatable has changed since user has identified favorites. + *m: setdatasessionenvironment && Sets a specified data session to a default set of SETs, which you place in the SetDataSessionSets for use by any form or session you want. + *m: setdatasessionsets && Contains a default list of data-session-related SETs so you can easily invoke this list within any form or datasesion. + *m: setenvironment && Sets up certain global attributes, such as screen or frame characteristics, ON SHUTDOWN, ON ERROR, and macros for use during the life of the app. Does *nothing* if not a ReadEvents app. + *m: setframeattributes && Applies application cCaption and cIcon to the MDI frame, as well as the appropriate backcolor for an MDI frame window. + *m: sethtmlclass && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes. + *m: sethtmlstyleid && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes. + *m: setmacros && Saves and restores a set of macros using the user table. Synchronizes enabling of bars on the macro-handling popup, using THIS.cMacroPopupName, depending on current set of user macros. + *m: setscreenattributes && Sets up screen attributes, including visibility, caption and icon, and system toolbars, for a read events app that does not take place in its own topform MDI frame. + *m: setuserpermissions && Abstract in the base. Called when a new user logs on. Designed to use iCurrentUserLevel property, derived from user table, to maintain groups. Menu items would be added/substracted/enabled/disabled based on group level at this time. + *m: show && Sets up visible aspects of the application and, if successful, Activate()s the application, at startup. + *m: showstartupelements && Sets up top form MDI frame, startup menu, startup toolbar, screen attributes, and startup form. + *m: showtablefinddialog && Instantiates _FindDialog class, in advanced or standard mode, depending on THIS.lFindOnMultipleTables value. (Advanced mode allows the user to choose between all open aliases in a data session.) + *m: showtablegotodialog && Instantiates _GoToDialog class. + *m: showtablesetfilterdialog && Instantiates _FilterExpr class, in advanced or standard depending on THIS.lUseGetExpr value. (Standard mode uses _FilterDialog as a subsidiary dialog, Advanced uses _GETEXPR.) + *m: storepassword && Stores the encrypted value of a new password to the current record in the user table. + *m: validatemetatable && Ensures that a table contains a valid and available table for documents registry. Validates THIS.cMetatable, if used, on startup. + *p: caboutboxclass && Name of dialog class instantiated by DoAboutBox() + *p: caboutboxclasslib && Class library for dialog class instantiated by DoAboutBox(). If empty defaults to same class library as application object. + *p: cappfilename && Top level filename + *p: cappfolder && Location of application, usually top level file, but sometimes the location of the module that owns the VCX of this application object. Indicates default location of generated system files such as error and user tables. + *p: cauthor && "Credits" information. + *p: ccaption && Friendly name of the application object. + *p: cchangepasswordclass && Dialog class instantiated by DoChangePassword(). + *p: cchangepasswordclasslib && Class library for dialog class instantiated by DoChangePassword(). If empty defaults to same class library as application object. + *p: cclasscontainerfilename && APP,EXE, or DLL containing the VCX from which this app object was instantiated. + *p: ccompany && "Credits" information. + *p: ccopyright && "Credits" information. + *p: ccurrentuser && Name of current user as logged on. + *p: ccurrentuserfavoriteids && A delimited string containing IDs of metatable entries that should be included in Favorites list as well as filenames picked by user for inclusions in Favorites list. + *p: cdatafolder && Not used internally, allows you to maintain a current location for your data or for user-generated files. + *p: cerrorlogtablename && Default table name for error log. + *p: cerrorviewerclass && Dialog class instantiated by DisplayErrorLog(). + *p: cerrorviewerclasslib && Class library for dialog class instantiated by DisplayErrorLog(). If empty defaults to same class library as application object. + *p: cfavoritepopupname && Name of popup displaying favorites. Required so the app object can refresh this popup between users or when a user selects new Favorites. + *p: cformmediatorname && Member name the app object looks for when contacting a mediator object on framework-enabled forms. + *p: cframeclass && Dialog class instantiated by CreateFrame(). + *p: cframeclasslib && Class library for dialog class instantiated by CreateFrame(). If empty defaults to same class library as application object. + *p: cgomenufile && Name of menu to be used when a form entry in the meta table indicates that it should have a navigation menu. + *p: chelpfile && Name of help file for this application. + *p: cicon && Icon of the application object. + *p: cimage && Image to be used in logos, on the splash screen, etc. + *p: clastdirectory && Stores default directory when a readevents-type application starts up, for later restoration. + *p: clastmackey && Stores SET MACKEY when a readevents-type application starts up, for later restoration. + *p: clastonerror && Stores ON ERROR when a readevents-type application starts up, for later restoration. + *p: clastonshutdown && Stores ON SHUTDOWN when a readevents-type application starts up, for later restoration. + *p: clastpath && Stores SET("PATH") when a readevents-type application starts up, for later restoration. + *p: cmackey && Supplies the SET MACKEY for the application. Only used in ReadEvents apps. + *p: cmacropopupname && Name of popup handling macro sets. Required so the app object can refresh this popup between users, when the user stores a macro set, etc. + *p: cmacrosavefile && Stores the (generated) name of an FKY file created on startup of a ReadEvents app, for later restoration. + *p: cmediatedsessionclass && Name of class used to instance a framework-enabled datasession object, defaults to "_MediatedSession" + *p: cmediatedsessionclasslib && Classlib containing cMediatedSession class, defaults to "_FRAMEWK.VCX" + *p: cmediatorclass && Class used for dynamic form enabling at runtime (see lEnableFormsAtRuntime.) Should always contain a class descended from _formmediator in _FRAMEWK.VCX. + *p: cmediatorclasslib && Classlibrary used for dynamic form enabling at runtime (see lEnableFormsAtRuntime). Should always be the name of the library containing the class specified in _application.cMediatorClass. + *p: cmetatable && Stores the name of the application's metatable. + *p: cnavtoolbarclass && Toolbar class when a metatable entry calls for a navigation toolbar. + *p: cnavtoolbarclasslib && Class library for toolbar class when a metatable entry calls for a navigation toolbar. If empty defaults to same class library as application object. + *p: cnewopenclass && Dialog class instantiated by DoNewOpen(). + *p: cnewopenclasslib && Class library for dialog class instantiated by DoNewOpen(). If empty defaults to same class library as application object. + *p: coptionsdialogclass && Dialog class instantiated by DoOptionsDialog(). + *p: coptionsdialogclasslib && Class library for dialog class instantiated by DoOptionsDialog(). If empty defaults to same class library as application object. + *p: cprojectname && Name of a project that should be hidden on startup, for display at the end of the application. For convenience (so you don't inadvertently try to work on an app component while it's running, especially in non-ReadEvents or top form apps). + *p: creference && The var name that the app should declare as its PUBLIC reference and release when it ends. + *p: creportdialogclass && Dialog class instantiated by DoReportDialog(). + *p: creportdialogclasslib && Class library for dialog class instantiated by DoReportDialog(). If empty defaults to same class library as application object. + *p: csessionclass && Default class definition name to pass to any _MediatedSession collaborator. If empty will be filled by member's cSessionClass property after successful instantiation. + *p: csessionclasslib && Default programmatic class definition filename to pass to any _MediatedSession collaborator. If empty will be filled by member's cSessionClassLib property after successful instantiation. + *p: cstartupformclass && Form (SCX) which is executed when the application object is shown. + *p: cstartupformclasslib && Class library for dialog class instantiated by DoStartupForm(). If empty defaults to same class library as application object. + *p: cstartupmenu && Menu (MPR) which is executed when the application object is shown. + *p: cstartupmenupad && For non-ReadEvents/Append style app menus, allows the application to remove this menu pad when the app ends. + *p: cstartupmenupopup && For non-ReadEvents/Append style app menus, allows the application to release this popup when the app ends. + *p: cstartuptoolbarclass && Standard toolbar instantiated by ShowStartupElements(). + *p: cstartuptoolbarclasslib && Class library for standard toolbar instantiated by ShowStartupElements(). If empty defaults to same class library as application object. + *p: ctextdisplayfont && A sample "global user pref", allows users to store a font for display of text such as editboxes. To see it used, see the error log dialog.ApplyAppAttributes. The app gives this value to _outputdialog, applying it to the dialog's cDisplayFontName. + *p: ctrademark && "Credits" information. + *p: cuserloginclass && Dialog class instantiated by DoUserLogin(). + *p: cuserloginclasslib && Class library for dialog class instantiated by DoUserLogin(). If empty defaults to same class library as application object. + *p: cusertablealias && Alias for user table. + *p: cusertableidfield && Name of c-type field storing user name. + *p: cusertablelevelfield && Name of i-type field storing user level. + *p: cusertablename && Name of user table. + *p: icurrentuserlevel && Current user's level. + *p: iinitialtoolbarposition && Indicates how a toolbar should be Docked() when instantiated. + *p: ilasterror && Stores error number of last number, or NULL when cleared. + *p: iqueryunloadresultfornonvisualsessions && Used by ReleaseSessions method -- if 0, reverts, if 1, updates, otherwise asks user for confirm just like forms. Defaults to 0. + *p: laboutbox && Indicates whether app should display an about box. + *p: laddingnewdocument && Application flag a form can check to see whether it should start a new document rather than edit an existing one. + *p: lcascadeforms && Specifies whether multiple forms of the same type are cascaded when a new form is instanced. + *p: lenableformsatruntime && Indicates whether DoForm() will dynamically adds base mediator objects to forms at runtime if they don't already have them. + *p: lfavorites && Specifies whether Favorites should be used/shown on a menu in this application. + *p: lfindonmultipletables && Specifies whether the ShowTableFindDialog will allow the user to switch to different tables in use in the data session. + *p: lgomenu && Specifies whether a navigation menu is currently required. + *p: lnavtoolbar && Specifies whether a navigation toolbar is currently required. + *p: lnointerrupt && Flag to alert application object that current activity, such as data-session-changing or modal dialogs, should not be interrupted by toolbar-refreshing or other timer-related activity. + *p: lnoscreenduringapp && Specifies whether screen should not be made visible during the app. + *p: lreadevents && Enable READ EVENTS within ReadEvents method. + *p: lreleaseunusedmenuitems && Indicates whether some menu items specific to application state should be released rather than disabled, when the MPR executes, if they are inappropriate. Used by framework's template menus. + *p: lrestoredenvironment + *p: lsavedenvironment + *p: lskiperrorhandling && Flag to allow an error number to be stored with no further error handling, for certain brief activities within the app. + *p: lstartupform && Specifies whether the app should begin with a "quick start" form. + *p: lstartuptoolbar && Specifies whether the app should invoke a toolbar at startup. + *p: lusercanchangepassword && Determines whether DoChangePassword() will allow the user to change his or her password. A placeholder -- you affect this behavior by using the attached access and assign methods however you decide, for example by user level. + *p: lusernameiscasesensitive && Determines how the user table is searched for a match when a user logs in. + *p: luserpreferences && Determines whether the user logon and options system is in place, or whether one set of options is set up for the full application. + *p: luse_getexpr && Determines whether the application -- or the current user -- should use _GETEXPR or the simpler _FilterDialog to enter expressions. + *p: nformcount && Forms collection count for application object. + *p: npixeloffset && Number of pixels which offset multiple instances of the same form. Not used in this version, but can provide a useful value for default "margins" for form and object placement. + *p: oframe && Reference to MDI frame window in top form applications. + *p: onavtoolbar && Reference to navigation toolbar shared by various forms as indicated in their metatable entries. + *a: acollaborators[1,0] && Collection of object references for members that cannot be contained by custom application object, such as forms + *a: acontextmenus[1,4] && Manages context menus invoked by the application object. + *a: acurrentuseropts[1,4] && Holds user preferences for use globally (by the app object and global SETs) or in a data session (by a form or formset object and data-session-specific SETs). + *a: aformnames[1,0] && Collection of strings (for SCXs, file names, for VCXs, file and class names), enabling the application object to uniquely identify form and formset classes currently instantiated and referenced in its aForms() collection. + *a: aforms[1,0] + *a: atoolbars[1,2] && Parallel to aForms[] + * + + PROTECTED Destroy,Init,lrestoredenvironment,lsavedenvironment + * + BorderWidth = 0 + caboutboxclass = + caboutboxclasslib = + cappfilename = + cappfolder = + cauthor = + ccaption = + cchangepasswordclass = + cchangepasswordclasslib = + cclasscontainerfilename = ("") + ccompany = + ccopyright = + ccurrentuser = + ccurrentuserfavoriteids = .NULL. + cdatafolder = + cerrorlogtablename = ("AppError") + cerrorviewerclass = + cerrorviewerclasslib = + cfavoritepopupname = + cformmediatorname = ("app_mediator") + cframeclass = + cframeclasslib = + cgomenufile = ("GO_APP") + chelpfile = + cicon = + cimage = + clastdirectory = + clastmackey = + clastonerror = + clastonshutdown = + clastpath = + cmackey = ("ALT-F10") + cmacropopupname = + cmacrosavefile = + cmediatedsessionclass = ("_MediatedSession") + cmediatedsessionclasslib = ("_FRAMEWK.VCX") + cmediatorclass = ("_FormMediator") + cmediatorclasslib = ("_FRAMEWK.VCX") + cmetatable = + cnavtoolbarclass = + cnavtoolbarclasslib = + cnewopenclass = + cnewopenclasslib = + coptionsdialogclass = + coptionsdialogclasslib = + cprojectname = + creference = + creportdialogclass = + creportdialogclasslib = + csessionclass = + csessionclasslib = + cstartupformclass = + cstartupformclasslib = + cstartupmenu = + cstartupmenupad = + cstartupmenupopup = + cstartuptoolbarclass = + cstartuptoolbarclasslib = + ctextdisplayfont = ("Courier New") + ctrademark = + cuserloginclass = + cuserloginclasslib = + cusertablealias = + cusertableidfield = ("UserName") + cusertablelevelfield = ("UserLevel") + cusertablename = ("AppUser") + cversion = + Height = 28 + icurrentuserlevel = 0 + iinitialtoolbarposition = 0 + ilasterror = .NULL. + iqueryunloadresultfornonvisualsessions = 0 + laboutbox = .T. + lenableformsatruntime = .T. + lfavorites = .T. + lreadevents = .T. + lstartupform = .T. + lstartuptoolbar = .T. + lusercanchangepassword = .T. + Name = "_application" + nformcount = 0 + npixeloffset = 22 + oframe = .NULL. + onavtoolbar = .NULL. + Visible = .F. + Width = 154 + * + + ADD OBJECT 'cusDataSession' AS _datasession WITH ; + Height = 19, ; + Left = 25, ; + Name = "cusDataSession", ; + Top = 0, ; + Width = 23 + *< END OBJECT: ClassLib="..\ffc\_app.vcx" BaseClass="custom" /> + + ADD OBJECT 'cusError' AS _error WITH ; + Height = 19, ; + Left = 0, ; + Name = "cusError", ; + Top = 0, ; + Width = 23 + *< END OBJECT: ClassLib="..\ffc\_app.vcx" BaseClass="custom" /> + + ADD OBJECT 'cusTableNav' AS _tablenav WITH ; + Height = 19, ; + Left = 96, ; + Name = "cusTableNav", ; + Top = 0, ; + Width = 23 + *< END OBJECT: ClassLib="..\ffc\_table.vcx" BaseClass="custom" /> + + ADD OBJECT 'cusTableSort' AS _tablesort WITH ; + Height = 19, ; + Left = 72, ; + Name = "cusTableSort", ; + Top = 0, ; + Width = 23 + *< END OBJECT: ClassLib="..\ffc\_table.vcx" BaseClass="custom" /> + + ADD OBJECT 'cusWindowHandler' AS _windowhandler WITH ; + Height = 19, ; + Left = 48, ; + Name = "cusWindowHandler", ; + Top = 0, ; + Width = 23 + *< END OBJECT: ClassLib="..\ffc\_ui.vcx" BaseClass="custom" /> + + ADD OBJECT 'tmrRefresh' AS _traceawaretimer WITH ; + Interval = 500, ; + Left = 120, ; + Name = "tmrRefresh", ; + Top = 0 + *< END OBJECT: ClassLib="..\ffc\_app.vcx" BaseClass="timer" /> + + PROCEDURE activate && Makes the application active + THIS.ClearLastError() + THIS.BeforeReadEvents() + THIS.ReadEvents() + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE activateforminframe && Takes a form or toolbar reference and fixes it to appear in top form "frame" even if its ShowWindow property was 0 + LPARAMETERS toFormRef + + LOCAL lcFormID, llToolbar + + IF UPPER(toFormRef.BaseClass) == "TOOLBAR" + llToolbar = .T. + ENDIF + + + IF VARTYPE(THIS.oFrame) = "O" AND ; + toFormRef.ShowWindow = 0 + + IF llToolBar + lcFormID = toFormRef.Caption + toFormRef.Caption = "." + ELSE + lcFormID = toFormRef.Name + toFormRef.Name = "W"+SYS(2015) + ENDIF + + ENDIF + + IF EMPTY(lcFormID) + + * ShowWindow is appropriate, no problem + + IF (NOT llToolBar) AND ; + (toFormRef.WindowType = WINDOWTYPE_MODAL) + toFormRef.Show(1) + ELSE + toFormRef.Show() + ENDIF + + ELSE + + * fix the problem: + + IF llToolbar + + ACTIVATE WINDOW (toFormRef.Caption) ; + IN WINDOW (THIS.oFrame.Name) + toFormRef.Caption = lcFormID + + ELSE + + ACTIVATE WINDOW (toFormRef.Name) ; + IN WINDOW (THIS.oFrame.Name) + toFormRef.Name = lcFormID + + IF toFormRef.WindowType = WINDOWTYPE_MODAL + toFormRef.Show(1) + ENDIF + + ENDIF + + ENDIF + + + + + ENDPROC + + PROCEDURE activatesystemwindow && Activates a system window whose name has been passed, in _SCREEN, even if _SCREEN wasn't previously visible (for debugging, does nothing in runtime) + LPARAMETERs tcWindow + + IF EMPTY(tcWindow) OR _VFP.StartMode > 0 + RETURN + ENDIF + + LOCAL llAutoCenter + + llAutoCenter = _Screen.AutoCenter + _SCREEN.AutoCenter = .T. + _SCREEN.AutoCenter = llAutoCenter + + IF ! _SCREEN.Visible + _SCREEN.Show() + ENDIF + + IF WMIN("") + ZOOM WINDOW SCREEN NORM + ENDIF + + ACTIVATE WINDOW (tcWindow) IN SCREEN + + + + + ENDPROC + + PROCEDURE addcollaborator && Instantiate objects that can't be part of application container and add a reference to collaborators collection for maintenance. See SetScreenAttributes() for examples. + LPARAMETERS tcClass, tcClassLib,tcClassContainer, tcParamString, toParent, tcMemberName + * should match Instantiate + * Instantiate params: + * LPARAMETERS tcClass, tcClassLib, tcClassContainer, tcParamString, toParent, tcMemberName + * wrap Instantiate and puts the reference in the aCollaborators collection + * so it can be properly managed + + * it's not really necessary to look out for usable empty array elements + * in the middle of the array here -- objects may be released + * during the life of the application, but the empty array elements will + * not do any harm, so we + * just re-DIME as necessary if the last element is in use... + LOCAL liElement, lcClassLib + + liElement = ALEN(THIS.aCollaborators) + + IF VARTYPE(THIS.aCollaborators[liElement]) = "O" + liElement = liElement + 1 + DIME THIS.aCollaborators[liElement] + ENDIF + + IF NOT EMPTY(tcClassLib) + lcClassLib = tcClassLib + * want to avoid passing a null string + ENDIF + + THIS.aCollaborators[liElement] = ; + THIS.Instantiate(tcClass, lcClassLib,tcClassContainer,tcParamString, toParent, tcMemberName) + + * Instantiate() will know to do a NEWOBJECT() or .NewObject() as required + + RETURN THIS.aCollaborators[liElement] + ENDPROC + + PROCEDURE addmediatedsession && Creates a data session with a mediator object attached, referenced in the aCollaborators collection, returns a reference to this framework-enabled session. + * Creates a data session with a mediator object attached, + * referenced in the aCollaborators collection, + * returns a reference to this framework-enabled session. + LOCAL loSession, lcPass + + THIS.cSessionClassLib = THIS.GetResourceFileName(THIS.cSessionClassLib,".fxp .prg") + + IF EMPTY(THIS.cSessionClass) OR EMPTY(THIS.cSessionClassLib) + lcPass = ".T." + ELSE + lcPass = ".T.,["+THIS.cSessionClass+"],["+THIS.cSessionClassLib+"]" + ENDIF + + loSession = THIS.AddCollaborator(THIS.cMediatedSessionClass, THIS.cMediatedSessionClassLib,,lcPass) + + IF NOT ISNULL(loSession) + loSession.LoadApp(THIS.cReference) + + * save class def information, which + * may in some instances be generated, + * for other members, so it doesn't need to be + * re-generated each time + + IF EMPTY(THIS.cSessionClass) AND NOT EMPTY(loSession.cSessionClass) + THIS.cSessionClass = loSession.cSessionClass + ENDIF + + IF EMPTY(THIS.cSessionClassLib) AND NOT EMPTY(loSession.cSessionClassLib) + THIS.cSessionClassLib = loSession.cSessionClassLib + ENDIF + + ENDIF + + RETURN loSession + + + ENDPROC + + PROCEDURE applyglobaluseroptions && Applies global (non-datasession-specific) options to the _application object and environment. Where user login and preferences are not used, applies a single set at startup -- with user login and preferences, applies to each user login. + LOCAL liRow, lcItem, lvValue, liPos + + FOR liRow = 1 TO ALEN(THIS.aCurrentUserOpts,1) + + IF NOT THIS.aCurrentUserOpts[liRow,4] && datasession preference, not global + LOOP + ENDIF + + lcItem = THIS.aCurrentUserOpts[liRow,1] + lvValue = THIS.aCurrentUserOpts[liRow,2] + IF VARTYPE(lcItem) # "C" + LOOP + ENDIF + IF NOT THIS.aCurrentUserOpts[liRow,3] && property of app or app member + liPos = AT(".",lcItem) + IF (liPos = 0 AND PEMSTATUS(THIS,lcItem,5)) OR ; + (liPos > 1 AND PEMSTATUS(EVAL("THIS."+SUBSTR(lcItem,1,liPos-1)),SUBSTR(lcItem,liPos+1),5)) + THIS.&lcItem. = lvValue + ENDIF + ELSE && SET value + IF VARTYPE(lvValue) # "C" + LOOP + ENDIF + SET &lcItem &lvValue + ENDIF + + ENDFOR + + RETURN + + ENDPROC + + PROCEDURE applyuseroptsforsession && Applies datasession-specific options a form object and its session environment. + LPARAMETERS toSession + IF VARTYPE(toSession) # "O" + RETURN + ENDIF + LOCAL liSession, liRow, lcItem, lvValue, liPos, llInterrupted + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + liSession = SET("DATASESSION") + SET DATASESSION TO (toSession.DataSessionID) + + FOR liRow = 1 TO ALEN(THIS.aCurrentUserOpts,1) + + IF THIS.aCurrentUserOpts[liRow,4] && global preference, not private to session + LOOP + ENDIF + + lcItem = THIS.aCurrentUserOpts[liRow,1] + lvValue = THIS.aCurrentUserOpts[liRow,2] + IF VARTYPE(lcItem) # "C" + LOOP + ENDIF + IF NOT THIS.aCurrentUserOpts[liRow,3] && property of form or form member + + liPos = AT(".",lcItem) + IF (liPos = 0 AND PEMSTATUS(toSession,lcItem,5)) OR ; + (liPos > 1 AND PEMSTATUS(EVAL("toSession."+SUBSTR(lcItem,1,liPos-1)),SUBSTR(lcItem,liPos+1),5)) + toSession.&lcItem. = lvValue + ENDIF + ELSE && SET value + IF VARTYPE(lvValue) # "C" + LOOP + ENDIF + SET &lcItem &lvValue + ENDIF + + ENDFOR + SET DATASESSION TO (liSession) + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN + + ENDPROC + + PROCEDURE beforedoform && Hook in DoForm method, allowing last-minute manipulation of environment before the form class or object is instantiated. + LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar + * abstract hook from DoForm + + + ENDPROC + + PROTECTED PROCEDURE beforereadevents && Method executed before READ EVENTS is executed when ReadEvents is called. + ENDPROC + + PROCEDURE caboutboxclass_access && Synchronizes classname value with lAboutBox value + IF NOT THIS.lAboutBox + + RETURN "" + + ELSE + + RETURN THIS.cAboutBoxClass + + ENDIF + + ENDPROC + + PROCEDURE cappfolder_access && Determines the application folder, usually the folder containing the running APP or EXE. However where a temporary wrapper program or ON... command has been used to instantiate the application, this value may be the location of the VCX + * note: this is an access method because + * conceivably directories could get renamed + * while an app is running! + IF EMPTY(THIS.cAppFolder) OR (NOT DIRECTORY(THIS.cAppFolder)) + + LOCAL lcAppFolder + + IF (NOT EMPTY(THIS.cClassContainerFileName)) + lcAppFolder = ; + LEFT(THIS.cClassContainerFileName,RAT("\",THIS.cClassContainerFileName)) + ENDIF + + * The cClassContainerFileName could be empty... it's possible + * that this CREATEOBJECT was not done in an APP or EXE... + * (see comments in SetAppFileNames() for how these properties are + * used and what they represent) + + IF ( EMPTY(lcAppFolder) OR (NOT DIRECTORY(lcAppFolder)) ) ; + AND ; + (NOT EMPTY(THIS.cAppFileName)) + + lcAppFolder = LEFT(THIS.cAppFileName,RAT("\",THIS.cAppFileName)) + * this will be a wrapper program -- may or may not + * be the same for every user or every login, + * especially if temp programs are involved, + * so it is not as good as cClassContainerFileName + ENDIF + + * finally, both the properties may be empty, especially if + * an ON... was involved in the initial call, + * We still need an appfolder **on disk** to give us + * a default location for some system files + + IF ( EMPTY(lcAppFolder) OR (NOT DIRECTORY(lcAppFolder)) ) + lcAppFolder = SET("DIRECTORY") + ENDIF + + THIS.cAppFolder = lcAppFolder + + ENDIF + + IF RIGHT(THIS.cAppFolder,1) # "\" && for example, SET("DIRE") doesn't provide a final backslash! + THIS.cAppFolder = THIS.cAppFolder + "\" + ENDIF + + RETURN THIS.cAppFolder + + ENDPROC + + PROCEDURE cascadeall && Wraps cusWindowHandler's CascadeFormInstances() method, passing no argument. + LPARAMETERS tcForm + + THIS.cusWindowHandler.CascadeFormInstances(tcForm) + + + ENDPROC + + PROCEDURE cascadeform && For backwards compatibility, not used + LPARAMETERS tcFormName + LOCAL lcFormName + DO CASE + CASE (NOT EMPTY(tcFormName)) AND WEXIST(tcFormName) + lcFormName = tcFormName + CASE TYPE("_SCREEN.ActiveForm")= "O" + lcFormName = _SCREEN.ActiveForm.Name + OTHERWISE + RETURN .F. + ENDCASE + + + ENDPROC + + PROCEDURE ccaption_access + IF VARTYPE(THIS.cCaption) # "C" + RETURN "" + ELSE + RETURN THIS.cCaption + ENDIF + + + ENDPROC + + PROCEDURE ccaption_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) # "C" + THIS.cCaption = "" + ELSE + THIS.cCaption = tvNewVal + ENDIF + + + ENDPROC + + PROCEDURE cdatafolder_assign + LPARAMETERS tcDataFolder + + LOCAL lcDataFolder + + lcDataFolder = IIF(VARTYPE(tcDataFolder) = "C" AND ; + DIRECTORY(tcDataFolder), ; + tcDataFolder,"") + + THIS.cDataFolder = lcDataFolder + + + ENDPROC + + PROCEDURE cerrorlogtablename_access && adds cAppFolder information to the error log table name, so the default error DBF is always in one place. + LOCAL lcTable + lcTable = THIS.cErrorLogTableName + IF AT("\",lcTable) = 0 + lcTable = THIS.cAppFolder+lcTable + ENDIF + IF AT(".",lcTable) = 0 + lcTable = lcTable+".DBF" + ENDIF + RETURN lcTable + + ENDPROC + + PROCEDURE checkpassword && Sends a passed value and a stored value from the current user information to CheckValueAgainstStoredPassword for verification. + LPARAMETERS tcValueToCheck + + ASSERT VARTYPE(tcValueToCheck) = "C" AND USED(THIS.cUserTableAlias) + + LOCAL lcValueToCheck, lcStoredPassword, llSuccess + + IF (NOT THIS.lUserPreferences) OR ; + VARTYPE(tcValueToCheck) # "C" + + RETURN .F. + + ENDIF + + lcValueToCheck = ALLTRIM(tcValueToCheck) + lcStoredPassword = EVAL("ALLTRIM("+THIS.cUserTableAlias+".UserPass)") + llSuccess = THIS.CheckValueAgainstStoredPassword(lcValueToCheck, lcStoredPassword) + + RETURN llSuccess + + ENDPROC + + PROCEDURE checkvalueagainststoredpassword && Compares a current password entry against an encrypted stored entry. Separated from CheckPassword so its simple algorithm can be replaced as necessary. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match. + LPARAMETERS tcValueToCheck, tcStoredValue + IF VARTYPE(tcValueToCheck) # "C" + RETURN .F. + ENDIF + * see notes in _application.CreateStoredPassword()... + * this method is separated out to make the method + * of encryption more easily edited... + + RETURN (tcStoredValue == SYS(2007,tcValueToCheck)) + ENDPROC + + PROCEDURE cicon_assign + LPARAMETERS m.vNewVal + IF NOT EMPTY(m.vNewVal) + THIS.cIcon = THIS.GetResourceFileName(m.vNewVal,".ico") + ELSE + THIS.cIcon = "" + ENDIF + + ENDPROC + + PROCEDURE cimage_assign && Verifies the availability of an image file for use as the application logo + LPARAMETERS m.vNewVal + *To do: Modify this routine for the Assign method + IF NOT EMPTY(m.vNewVal) + THIS.cimage = THIS.GetResourceFileName(m.vNewVal,".bmp .ico .gif") + ELSE + THIS.cImage = "" + ENDIF + + + + ENDPROC + + PROCEDURE clearevents && Clears any pending read events. + THIS.ClearLastError() + IF THIS.lReadEvents + CLEAR EVENTS + ENDIF + RETURN (THIS.IsErrorFree()) + + + + + ENDPROC + + PROCEDURE clearfavorites && Called by Favorites menu item, to confirm "zap" of user favorites and invoke SetCurrentUserFavoriteIDs mechanism. + * this is meant for interactive confirmation/menu use + IF (MESSAGEBOX(APP_USER_FAVES_CLEAR_LOC, ; + MB_ICONQUESTION + MB_YESNO, ; + THIS.cCaption)) ; + = IDYES + THIS.SetCurrentUserFavoriteIDs("") + ENDIF + ENDPROC + + PROCEDURE clearlasterror && Sets _application.iLastError to NULL, called before operations which may require an error to be tested on conclusion. Abstracted for easy overriding in subclasses. + THIS.iLastError = .NULL. + + ENDPROC + + PROCEDURE createcollaborators && A startup hook to allow you to call the AddCollaborators() method during initialization procedures + *&* The collaborators mechanism allows for things that can't be + *&* a member of the app container to disappear on cue, + *&* like a background image on screen. + *&* This abstract method gives you a hook to create collaborators + *&* at startup (during the .Show() method), using AddCollaborator(), + *&* but you can scope objects to the application + *&* at any time during the life of the app. + *&* AddCollaborator()'s params match Instantiate()'s. + + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE createformmediator && Adds a app mediator object to a form + LPARAMETERS toForm + + IF VARTYPE(toForm) # "O" OR ; + NOT (UPPER(toForm.BaseClass) == "FORM") + RETURN NULL + ENDIF + + LOCAL lcMediatorName, loMediator + + IF TYPE("toForm."+THIS.cFormMediatorName+".Name") # "C" + lcMediatorName = THIS.cFormMediatorName + ELSE + lcMediatorName = "Mediator_"+SYS(2015) + * a mediator with a generated name + * is less useful and will cause slower + * behavior but it will do in a pinch + ENDIF + + THIS.ClearLastError() + + loMediator = THIS.Instantiate(THIS.cMediatorClass,THIS.cMediatorClassLib,,,; + toForm,lcMediatorName) + + IF (NOT THIS.IsErrorFree()) OR (NOT THIS.FormIsFrameworkEnabled(toForm)) + THIS.ClearLastError() + * required default classes + THIS.cMediatorClass = "_FormMediator" + THIS.cMediatorClassLib = "_FRAMEWK.VCX" + loMediator = THIS.Instantiate(THIS.cMediatorClass,THIS.cMediatorClassLib,,,; + toForm,lcMediatorName) + ENDIF + + IF THIS.IsErrorFree() + loMediator.cAppRef = THIS.cReference + RETURN loMediator + ELSE + RETURN NULL + ENDIF + + ENDPROC + + PROCEDURE createframe && Creates the MDI frame for top form applications. + LOCAL lcClassLib + + THIS.ClearLastError() + + IF NOT EMPTY(THIS.cFrameClassLib) + lcClassLib = THIS.cFrameClassLib + ENDIF + + IF NOT EMPTY(THIS.cFrameClass) + THIS.oFrame = THIS.Instantiate(THIS.cFrameClass,lcClassLib) + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.oApp = THIS + ENDIF + ELSE + THIS.oFrame = .NULL. + ENDIF + + RETURN (THIS.IsErrorFree()) + ENDPROC + + PROCEDURE createstoredpassword && Creates an encrypted value of a password. Separated from StorePassword() for easy replacement of its simple algorithm. Algorithms in CreateStoredPassword and CheckValueAgainstStoredPassword should match. + * separated out for easier editing, + * created for Q&D checksum method of storing information, + * but this is not really encryption... + + LPARAMETERS tcValueToStore + ASSERT VARTYPE(tcValueToStore) = "C" + + RETURN SYS(2007,ALLTRIM(tcValueToStore)) + + + ENDPROC + + PROCEDURE createusertable && Creates and indexs user table when it does not exist. Abstracted for easy editing. The app expects this table to have 1 c-type field, with its name in the cUserTableIDField property, and 1 i-type field, its name in cUserTableLevelField. + LPARAMETERS tcTable + * is passed exact table name and location + + * is separated out so that you can + * use different table structures more easily + + * The application object expects that whatever table + * you use, you will have created one c-type field and placed + * its name in THIS.cUserTableIDField, and one i-type field and + * placed its name in THIS.cUserTableLevelField. + + + THIS.ClearLastError() + LOCAL liSelect, lcIDField, lcLevelField + lcIDField = THIS.cUserTableIDField + lcLevelField = THIS.cUserTableLevelField + liSelect = SELECT() + SELECT 0 + CREATE TABLE (tcTable) ; + ((lcIDField) C(60), ; + (lcLevelField) I, ; + UserPass M NOCPTRANS, ; + UserOpts M NOCPTRANS, ; + UserFave M NOCPTRANS, ; + UserMacro M NOCPTRANS, ; + UserNotes M ) + INDEX ON PADR(ALLTR(&lcIDField.),60) TAG ID + * create a case-sensitive, exact word match + INDEX ON PADR(UPPER(ALLTR(&lcIDField.)),60) TAG ID_Upper + * create a case-insensitive, exact word match + INDEX ON DELETED() TAG IfDeleted + USE + SELECT (liSelect) + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE creference_assign + LPARAMETERS tcReference + + IF VARTYPE(tcReference) = "C" + + IF (TYPE(THIS.cReference+".Name") = "C" AND ; + EVAL(THIS.cReference) = THIS) + RELEASE (THIS.cReference) + ENDIF + + THIS.cReference = tcReference + + ENDIF + + IF (NOT EMPTY(THIS.cReference)) AND ; + (TYPE(THIS.cReference+".Name") # "C" OR ; + EVAL(THIS.cReference) # THIS) + + RELEASE (THIS.cReference) + PUBLIC (THIS.cReference) + STORE THIS TO (THIS.cReference) + + ENDIF + + ENDPROC + + PROCEDURE cstartupformclass_access && Synchronizes classname value with lStartupForm value + RETURN THIS.cStartupFormClass + + ENDPROC + + PROCEDURE cstartuptoolbarclass_access && Synchronizes classname value with lStartupToolbar value + IF NOT THIS.lStartupToolbar + + RETURN "" + + ELSE + + RETURN THIS.cStartupToolbarClass + + ENDIF + + ENDPROC + + PROCEDURE ctextdisplayfont_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal) + RETURN + ENDIF + + LOCAL laTemp[1], lcVal, lcFont + lcVal = ALLTR(tcNewVal) + + IF NOT EMPTY(AFONT(laTemp)) + + FOR EACH lcFont IN laTemp + IF UPPER(lcVal) == UPPER(lcFont) + THIS.cTextDisplayFont = lcVal + EXIT + ENDIF + ENDFOR + + ENDIF + + ENDPROC + + PROCEDURE cusertablealias_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" OR ; + (USED(tcNewVal) AND ; + (NOT DBF(tcNewVal) == THIS.cUserTableName) ) + THIS.cUserTableAlias = "U"+SYS(2015) + ELSE + THIS.cUserTableAlias = tcNewVal + + ENDIF + + ENDPROC + + PROCEDURE cusertablename_access + LOCAL lcTable + lcTable = UPPER(THIS.cUserTableName) + IF AT("\",lcTable) = 0 + lcTable = THIS.cAppFolder+lcTable + ENDIF + IF AT(".",lcTable) = 0 + lcTable = lcTable+".DBF" + ENDIF + IF EMPTY(SYS(2000,lcTable)) OR ; + EMPTY(SYS(2000,STRTRAN(lcTable,".DBF",".FPT"))) + THIS.CreateUserTable(lcTable) + ENDIF + + RETURN lcTable + + ENDPROC + + PROCEDURE datarevert && Wraps cusDataSession's Revert() method. + LPARAMETERS tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow + + LOCAL llInterrupted, llReturn + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + llReturn = THIS.cusDataSession.Revert(tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow) + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN llReturn + + ENDPROC + + PROCEDURE dataupdate && Wraps cusDataSession's Update() method. + LPARAMETERS tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow + + LOCAL llReturn, llInterrupted + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + llReturn = THIS.cusDataSession.Update(tlUserChoiceAlreadyConfirmed, tlDataChangeAlreadyConfirmed, toSession, tlNoShow) + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN llReturn + + ENDPROC + + PROTECTED PROCEDURE Destroy + DODEFAULT() + + THIS.lNoInterrupt = .T. + * one last disable the timer so we can avoid it + * interfering while we're closing up shop. + + IF EMPTY(THIS.cFrameClass) AND (NOT EMPTY(THIS.cGoMenuFile)) + RELEASE PAD _msm_Go OF _MSYSMENU + RELEASE POPUP _mGo EXTENDED + ENDIF + + * some of this is double-handling but + * will not hurt -- it's possible + * that a CLEAR ALL or other mechanism + * has ended the app without a Release() + * method having been issued -- such + * as a failed Show method: + THIS.ReleaseContextMenus(.T.) + THIS.ReleaseSessions(.T.) + THIS.ReleaseForms(.T.) + THIS.ReleaseToolbars(.T.) + THIS.ReleaseCollaborators() + THIS.ReleaseFrame() + THIS.ClearEvents() + + IF USED(THIS.cUserTableAlias) + USE IN (THIS.cUserTableAlias) + ENDIF + + IF NOT THIS.lRestoredEnvironment + * must restore environment + * at all times, because + * failure may have occurred + * during Show, but + * have to make sure *not* + * to restore environment + * if it's already been done + * because there are things + * in here than cannot or + * should not be done twice: + THIS.RestoreEnvironment() + ENDIF + + IF NOT EMPTY(THIS.cReference) + RELEASE (THIS.cReference) + ENDIF + + THIS.HandleProjectWindow(.T.) + + ENDPROC + + PROCEDURE displayerrorlog && Instantiates cErrorViewerClass dialog + LOCAL loTemp, liIndex, llOK + + IF NOT EMPTY(THIS.cErrorViewerClass) + + + loTemp = THIS.AddCollaborator(THIS.cErrorViewerClass,; + THIS.cErrorViewerClassLib) + + IF VARTYPE(loTemp) = "O" + + llOK = loTemp.ApplyAppAttributes(THIS) + + IF llOK + * maybe no error records, or even no table + + THIS.ActivateFormInFrame(loTemp) && modeless + + ELSE + + loTemp.Release() + + ENDIF + + ENDIF + + + RETURN llOK + + ELSE + THIS.cusError.DisplayErrorLog() + ENDIF + + + ENDPROC + + PROCEDURE doaboutbox && Invokes cAboutBoxClass dialog class + LOCAL llReturn + llReturn = THIS.DoModalDialogClass(THIS.cAboutBoxClass, THIS.cAboutBoxClassLib) + RETURN llReturn + ENDPROC + + PROCEDURE dochangepassword && Invokes cChangePasswordClass dialog class + IF (NOT THIS.lUserPreferences) + * shouldn't even be in here + RETURN .F. + ENDIF + + IF NOT THIS.lUserCanChangePassword + * this item may be on the menu + * but not applicable to this user, + * for various reasons + MESSAGEBOX(USER_PERMISSION_DENIED_LOC,MB_ICONEXCLAMATION,THIS.cCaption) + RETURN .F. + ENDIF + + LOCAL llOpenedTable, llReturn + + IF NOT USED(THIS.cUserTableAlias) + USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias) + llOpenedTable = .T. + ENDIF + + THIS.SeekCurrentUser() + + llReturn = THIS.DoModalDialogClass(THIS.cChangePasswordClass, THIS.cChangePasswordClassLib) + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + RETURN llReturn + + + + + + + + ENDPROC + + PROCEDURE docontextmenu && Manages context menus and context menu collection + LPARAMETERS tcMenuFileName, tcPadName, tcPopupName + + LOCAL lcMenuFileName, ; + liElement, liIndex, liMenus, lcMenu + + IF EMPTY(tcMenuFileName) OR EMPTY(tcPadName) OR EMPTY(tcPopupName) + RETURN 0 + ENDIF + + ASSERT VARTYPE(tcPadName) = "C" + ASSERT VARTYPE(tcPopupName) = "C" + ASSERT VARTYPE(tcMenuFileName) = "C" + + + lcMenuFileName = THIS.GetResourceFileName(tcMenuFileName,".mpx .mpr") + IF EMPTY(lcMenuFileName) + RETURN 0 + ENDIF + + liElement = 0 + liMenus = ALEN(THIS.aContextMenus,1) + FOR liIndex = 1 TO liMenus + lcMenu = THIS.aContextMenus[liIndex,1] + IF VARTYPE(lcMenu) # "C" OR ; + VARTYPE(THIS.aContextMenus[liIndex,2]) # "N" ; + OR THIS.aContextMenus[liIndex,2] = 0 + + liElement = liIndex + LOOP + ENDIF + * is this menu already up? + IF lcMenu == lcMenuFileName + * increment its counter + THIS.aContextMenus[liIndex,2] = THIS.aContextMenus[liIndex,2]+1 + RETURN liIndex + ENDIF + ENDFOR + + IF liElement = 0 + IF VARTYPE(THIS.aContextMenus[1,1]) = "C" + liElement = liMenus+1 + ELSE + liElement = 1 + ENDIF + DIMENSION THIS.aContextMenus[liElement,4] + ENDIF + + THIS.aContextMenus[liElement,1]=lcMenuFileName + THIS.aContextMenus[liElement,2] = 1 + THIS.aContextMenus[liElement,3] = ALLTRIM(tcPadName) + THIS.aContextMenus[liElement,4] = ALLTRIM(tcPopupName) + + THIS.DoMenu(lcMenuFileName) && we don't want unique popup names for a context menu + + RETURN liElement + + ENDPROC + + PROCEDURE dodocumentpickerdialog && Invokes all the dialogs descending from the _documentpicker dialog superclass + LPARAMETERS tcClass,tcClassLib,tlAlternateMode + + IF EMPTY(tcClass) + RETURN .F. + ENDIF + + LOCAL loTemp, lcClassLib + + IF NOT EMPTY(tcClassLib) + lcClassLib = tcClassLib + ENDIF + + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.Show() + ENDIF + + loTemp = THIS.Instantiate(tcClass,; + lcClassLib, ,; + "THIS,"+IIF(tlAlternateMode,".T.",".F.")) + + IF VARTYPE(loTemp) = "O" + + IF PEMSTATUS(loTemp,"ApplyAppAttributes",5) + loTemp.ApplyAppAttributes(THIS) + ELSE + IF EMPTY(loTemp.Icon) + loTemp.Icon = THIS.cIcon + ENDIF + ENDIF + + loTemp.Show(1) + + ELSE + RETURN .F. + ENDIF + + + + + ENDPROC + + PROCEDURE dofile && Executes files, channelling known FoxPro-type files to appropriate application Do... methods, and files of unknown types through Windows API + LPARAMETERS tcFile + + LOCAL lcFileName, liReturnValue, lcExt, lcStem, llReturn, llDevProduct + + THIS.ClearLastError() + + IF VARTYPE(tcFile) = "C" AND FILE(ALLTRIM(tcFile)) + lcFileName = ALLTRIM(tcFile) + ENDIF + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcFileName= THIS.GetResourceFileName(lcFileName) + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcExt = " "+UPPER(JUSTEXT(lcFileName))+" " + IF NOT EMPTY(lcExt) AND LEN(lcExt) = 5 + lcStem = FORCEEXT(lcFileName,"") + ENDIF + + llReturn = NULL + llDevProduct = (VERS(2) # 0) + + DO CASE + CASE EMPTY(lcStem) + * we didn't get anything we can use, + * don't bother checking the CASEs + + CASE INLIST(lcExt," SCX ", " SCT ") + llReturn = THIS.DoForm(lcStem) + + CASE INLIST(lcExt," LBX ", " LBT ") + llReturn = THIS.DoLabel(lcStem) + + CASE INLIST(lcExt, " FRX ", " FRT ") + llReturn = THIS.DoReport(lcStem) + + CASE lcExt == " MPX " + llReturn = THIS.DoMenu(lcFileName) + + CASE INLIST(lcExt," MPR ", " MNX ", " MNT ") AND ; + ( (llDevProduct AND FILE(FORCEEXT(lcFileName,"MPR"))) OR ; + FILE(FORCEEXT(lcFileName,"MPX")) ) + llReturn = THIS.DoMenu(lcStem) + + CASE INLIST(lcExt, " APP ", " FXP ") + llReturn = THIS.DoProgram(lcFileName) + + CASE lcExt == " PRG " AND ; + ( llDevProduct OR ; + FILE(FORCEEXT(lcFileName,"FXP")) ) + llReturn = THIS.DoProgram(lcStem) + + CASE INLIST(lcExt, " QPX ", " SPX ") + + * must use full filename for queries and sprs, + * maintaining exact same behavior as the base product + llReturn = THIS.DoProgram(lcFileName) + + CASE lcExt == " QPR " AND ; + ( llDevProduct OR ; + FILE(FORCEEXT(lcFileName,"QPX")) ) + llReturn = THIS.DoProgram(FORCEEXT(lcFileName, "QPX")) + + CASE lcExt == " SPR " AND ; + ( llDevProduct OR ; + FILE(FORCEEXT(lcFileName,"SPX")) ) + llReturn = THIS.DoProgram(FORCEEXT(lcFileName, "SPX")) + + OTHERWISE + * fall through to below, unknown type file + ENDCASE + + IF ISNULL(llReturn) + + DECLARE long ShellExecuteA IN SHELL32 ; + long, string, string, string, string, long + + liReturnValue = ShellExecuteA( 0, "open", ; + lcFilename, "","", 1 ) + + llReturn = (liReturnValue >= 32) + + ENDIF + + RETURN llReturn + + + ENDPROC + + PROCEDURE doform && Executes an SCX form or instantiates a VCX-based form/formset class. + LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar + + ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C" + ASSERT EMPTY(tcClass) OR VARTYPE(tcClass) = "C" + + LOCAL lcFileName,lcClass,lnCount, lcFormName,lnFormCount, loMediator, ; + loForm, loFormMember, lNeedReActivateFormset, ; + llFormSet,llEnabledFormFound + *&* VFP 5 framework cascade code also used: + *&* LOCAL lnTop,lnLeft,loForm2,lcName + + THIS.ClearLastError() + + lcFileName=ALLTRIM(tcFileName) + + lcClass=IIF(VARTYPE(tcClass)="C",LOWER(ALLTRIM(tcClass)),"") + + IF EMPTY(lcClass) + lcFileName = THIS.GetResourceFileName(lcFileName,".scx") + ELSE + lcFileName = THIS.GetResourceFileName(lcFileName,".vcx") + ENDIF + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcFormName=IIF(EMPTY(lcClass),lcFileName,lcFileName+","+lcClass) + IF tlNoMultipleInstances + FOR lnCount = 1 TO THIS.nFormCount + IF THIS.aFormNames[lnCount]==lcFormName AND ; + VARTYPE(THIS.aForms[lnCount])="O" + IF UPPER(THIS.aForms[lnCount].BaseClass)== "FORM" AND ; + THIS.aForms[lnCount].WindowState = 1 && minimized + THIS.aForms[lnCount].WindowState = 0 + ENDIF + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.Show() + ENDIF + THIS.aForms[lnCount].Show + RETURN .F. + ENDIF + ENDFOR + ENDIF + + * this is a hook, nothing in it + IF NOT THIS.BeforeDoForm(tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar) + RETURN .F + ENDIF + + THIS.RefreshFormsCollection + THIS.nFormCount=THIS.nFormCount+1 + DIMENSION THIS.aForms[THIS.nFormCount],THIS.aFormNames[THIS.nFormCount] + THIS.aFormNames[THIS.nFormCount]=lcFormName + + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.Show() + ENDIF + + IF NOT EMPTY(lcClass) + THIS.aForms[THIS.nFormCount] = ; + THIS.Instantiate(lcClass, lcFileName) + ELSE + DO FORM (lcFileName) NAME THIS.aForms[THIS.nFormCount] LINKED NOSHOW + ENDIF + + lnFormCount=THIS.nFormCount + THIS.RefreshFormsCollection + + IF THIS.nFormCount>=lnFormCount + * success so far, + * let's enable and position the new object(s) + * and then show it/them if we're supposed to: + + loForm = THIS.aForms[THIS.nFormCount] + llFormSet = (UPPER(loForm.BaseClass) == "FORMSET") + + IF llFormSet + + FOR EACH loFormMember IN loForm.Forms + IF UPPER(loFormMember.BaseClass) == "FORM" + * skip toolbars + loMediator = THIS.GetFormMediatorRef(loFormMember) + * don't force until we know about all forms + * in set; see note below + IF VARTYPE(loMediator) = "O" + loMediator.LoadApp(THIS.cReference) + loMediator.lGoMenu = tlGoMenu + loMediator.lNavToolbar = tlNavToolbar + llEnabledFormFound = .T. + ENDIF + + ENDIF + ENDFOR + + ELSE + + loMediator = THIS.GetFormMediatorRef(THIS.aForms[THIS.nFormCount], ; + THIS.lEnableFormsAtRunTime) + * second param will force creation + * if lEnableFormsAtRuntime is on + IF VARTYPE(loMediator) = "O" + loMediator.LoadApp(THIS.cReference) + loMediator.lGoMenu = tlGoMenu + loMediator.lNavToolbar = tlNavToolbar + ENDIF + ENDIF + + * if any forms in the formset are enabled, + * some may have been left un-enabled by + * intent, so that they don't get icon or whatever. + * So if even one form in the formset is enabled + * we won't dynamically enable the rest. That's + * why the below FOR/ENDFOR has to be done separately + * from the above attempt to load mediators in a formset: + + IF llFormSet AND ; + (NOT llEnabledFormFound) AND ; + THIS.lEnableFormsAtRunTime + + THIS.ClearLastError() + + FOR EACH loFormMember IN loForm.Forms + IF UPPER(loFormMember.BaseClass) == "FORM" + loMediator = THIS.CreateFormMediator(loFormMember) + IF VARTYPE(loMediator) = "O" + loMediator.LoadApp(THIS.cReference) + loMediator.lGoMenu = tlGoMenu + loMediator.lNavToolbar = tlNavToolbar + ENDIF + ENDIF + ENDFOR + + ENDIF + + IF NOT tlNoShow + IF VARTYPE(THIS.oFrame) # "O" + IF llFormSet + * there is something screwy about + * formsets when some forms may be showwindow 0 + * and others 1, even in _SCREEN, so it's + * best to show each form separately: + FOR EACH loFormMember IN loForm.Forms + loFormMember.Show() + ENDFOR + ELSE + loForm.Show() + ENDIF + ELSE + * seems as though if even one form in + * the formset is ShowWindow = 0, + * then all forms must be brought into the top form + IF llFormSet + FOR EACH loFormMember IN loForm.Forms + IF loFormMember.ShowWindow = 0 + lNeedReActivateFormset = .T. + EXIT + ENDIF + ENDFOR + FOR EACH loFormMember IN loForm.Forms + IF lNeedReActivateFormset + THIS.ActivateFormInFrame(loFormMember) + ELSE + loFormMember.Show() + ENDIF + ENDFOR + ELSE + IF loForm.ShowWindow = 0 + THIS.ActivateFormInFrame(loForm) + ELSE + loForm.Show() + ENDIF + ENDIF + ENDIF + ENDIF + + IF THIS.lCascadeForms AND NOT llFormSet + THIS.CascadeAll(loForm.Name) + *&* this is where VFP framework used THIS.nPixelOffset, + *&* all that code removed but the property might still + *&* be useful somewhere + ENDIF + + ENDIF + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE doformnoshow && Executes an SCX form or instantiates a VCX-based form/formset class, without Showing it, and returning a reference to the form or formset instantiated. + LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlGoMenu, tlNavToolbar + + LOCAL loForm, liCount + THIS.RefreshFormsCollection() + liCount = THIS.nFormCount + loForm = .NULL. + THIS.DoForm(tcFileName,tcClass,tlNoMultipleInstances,.T.,tlGoMenu, tlNavToolbar) + IF THIS.nFormCount > liCount + loForm = THIS.aForms(THIS.nFormCount) + ENDIF + RETURN loForm + ENDPROC + + PROCEDURE dohelp && Executes help of types .hlp, .dbf, .htm, or .chm + LPARAMETERS tcFile + LOCAL lcFileName, lcExt, llReturn + + llReturn = .T. + + THIS.ClearLastError() + + IF VARTYPE(tcFile) = "C" AND FILE(ALLTRIM(tcFile)) + lcFileName = ALLTRIM(tcFile) + ELSE + lcFileName=ALLTRIM(THIS.cHelpFile) + ENDIF + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcFileName= THIS.GetResourceFileName(lcFileName,".hlp .dbf .htm .chm") + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcExt = UPPER(JUSTEXT(lcFileName)) + + DO CASE + CASE lcExt = "DBF" + + IF UPPER(lcFileName) # UPPER(SET("HELP",1)) + LOCAL lcOldHelpFile, lcOldHelp + lcOldHelp = SET("HELP") + lcOldHelpFile = SET("HELP",1) + SET HELP TO (lcFileName) + SET HELP ON + HELP + IF NOT EMPTY(lcOldHelpFile) AND FILE(lcOldHelpFile) + SET HELP TO (lcOldHelpFile) + ENDIF + SET HELP &lcOldHelp + ELSE + HELP + ENDIF + + CASE INLIST(lcExt,"HLP","HTM","CHM") + + llReturn = THIS.DoFile(lcFilename) + + OTHERWISE + + * ?? + ENDCASE + + + RETURN llReturn AND (THIS.IsErrorFree()) + + + + ENDPROC + + PROCEDURE dolabel && Executes an LBX label + LPARAMETERS tcFileName, tcDescription + ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C" + ASSERT EMPTY(tcDescription) OR VARTYPE(tcDescription) = "C" + + LOCAL lcFileName, lcDescription + THIS.ClearLastError() + lcFileName=ALLTRIM(tcFileName) + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcFileName= THIS.GetResourceFileName(lcFileName,".lbx") + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + IF EMPTY(tcDescription) + lcDescription = PROPER(JUSTSTEM(lcFileName)) + ELSE + lcDescription = tcDescription + ENDIF + + THIS.DoReport(lcFileName, lcDescription) + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE domenu && Executes an MPR/MPX menu. + LPARAMETERS tcFileName, tlUniquePopupNames + ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C" + + LOCAL lcFileName + THIS.ClearLastError() + lcFileName=ALLTRIM(tcFileName) + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + lcFileName= THIS.GetResourceFileName(lcFileName,".mpx .mpr") + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + IF VARTYPE(THIS.oFrame) # "O" + DO (lcFileName) + ELSE + DO (lcFileName) WITH THIS.oFrame, THIS.oFrame.cMenuName, tlUniquePopupNames + ENDIF + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE domenuiteminframe && Not currently used, wraps cusWindowHandler method + LPARAMETERS tcToken + IF EMPTY(tcToken) + RETURN + ENDIF + THIS.cusWindowHandler.InvokeMenuItemInFrame(tcToken) + + + ENDPROC + + PROCEDURE domodaldialogclass && Instantiates a modal dialog, applying application attributes as appropriate. RETURNs a form reference, if NOSHOW. + LPARAMETERS tcWhichDialogClass, tcWhichDialogClassLib, tlNoShow + + LOCAL loFormRef, lcWhichDialogClassLib + + IF EMPTY(tcWhichDialogClass) + RETURN .F. + ENDIF + + IF NOT EMPTY(tcWhichDialogClassLib) + lcWhichDialogClassLib = tcWhichDialogClassLib + ENDIF + + IF VARTYPE(THIS.oFrame) = "O" and THIS.oFrame.ShowWindow < 2 + THIS.oFrame.Show() + ENDIF + + + loFormRef = THIS.Instantiate(tcWhichDialogClass,lcWhichDialogClassLib) + + IF VARTYPE(loFormRef) # "O" + RETURN .F. + ENDIF + + + IF PEMSTATUS(loFormRef,"ApplyAppAttributes",5) + loFormRef.ApplyAppAttributes(THIS) + ELSE + IF EMPTY(loFormRef.Icon) + loFormRef.Icon = THIS.cIcon + ENDIF + ENDIF + + IF tlNoShow + + RETURN loFormRef + + ELSE + + + loFormRef.WindowType = 1 + THIS.ActivateFormInFrame(loFormRef) + + RETURN .T. + + ENDIF + + + ENDPROC + + PROCEDURE donewopen && Invokes cNewOpenClass + LPARAMETERS tlNew + LOCAL llReturn + THIS.lAddingNewDocument = tlNew + llReturn = THIS.DoDocumentPickerDialog(THIS.cNewOpenClass,; + THIS.cNewOpenClassLib, ; + tlNew) + THIS.ResetToDefault("lAddingNewDocument") + RETURN llReturn + + ENDPROC + + PROCEDURE dooptionsdialog && Invokes cOptionsDialogClass + LOCAL llOpenedTable, llReturn + + IF NOT USED(THIS.cUserTableAlias) + USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias) + llOpenedTable = .T. + ENDIF + + IF THIS.lUserPreferences + THIS.SeekCurrentUser() + ELSE + THIS.SeekDefaultUser() + ENDIF + + llReturn = THIS.DoModalDialogClass(THIS.cOptionsDialogClass, THIS.cOptionsDialogClassLib) + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + RETURN llReturn + + + + + + + + ENDPROC + + PROCEDURE doprogram && Executes a PRG, APP, FXP, or EXE program. + LPARAMETERS tcFileName + + ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C" + + LOCAL lcFileName + THIS.ClearLastError() + lcFileName=ALLTRIM(tcFileName) + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + * the following uses the order of precedence + * to determine the appropriate extension: + * .EXE (executable version) + * .APP (an application) + * .FXP (compiled version) + * .PRG (program) + + * this program will run an SPR/SPX or QPR/QPX + * as well as the explicit list that + * VFP will run if you don't supply an extension, + * if you pass the name with an extension. + * This is consistent with the native behavior. + + lcFileName= THIS.GetResourceFileName(lcFileName,".exe .app .fxp .prg") + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + IF VERSION(2) = 0 AND ; + UPPER(JUSTEXT(lcFileName)) == "PRG" + IF NOT EMPTY(SYS(2000,lcFileName)) + * FXP was not found and PRG is on disk, + * not built in to a file + COMPILE (lcFileName) + lcFileName = FORCEEXT(lcFileName,"FXP") + ELSE + RETURN .F. + ENDIF + ENDIF + + DO (lcFileName) + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE doreport && Executes an FRX or LBX report form. + LPARAMETERS tcFileName, tcDescription, tlModify + + ASSERT EMPTY(tcFileName) OR VARTYPE(tcFileName) = "C" + ASSERT EMPTY(tcDescription) OR VARTYPE(tcDescription) = "C" + + LOCAL lcFileName + THIS.ClearLastError() + + IF (EMPTY(tcFileName) AND NOT tlModify) + RETURN .F. + ENDIF + + lcFileName=ALLTRIM(tcFileName) + + lcFileName= THIS.GetResourceFileName(lcFileName,".frx .lbx", tlModify) + + IF tlModify + + * if EMPTY(lcFileName) + * confirm creation, use template? + * else MODIFY + + * not yet implemented + MESSAGEBOX(APP_FEATURE_NOT_AVAILABLE_LOC, ; + MB_ICONINFORMATION,THIS.cCaption) + + ELSE + + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + + * we can provide output *without* going through the + * user's choices in the dialog at all, simply + * by instantiating an _output object and setting + * its properties rather than going through this dialog + * This is not implemented here, because it + * would definitely require that you set properties, + * as below. Would make sense for a subclass app object + * to have a lWantOutputDialog property which defaults .T. + * If the dialog is not desired, augment the + * standard behavior by looking for developer's + * information -- whether in the metatable or elsewhere + * about destination and options settings. + + LOCAL loDialog + + loDialog = THIS.DoModalDialogClass("_outputdialog","_reports", .T.) + + * note: could add a metatable check here to fill out loDialog.cAlias + * or loDialog.cFieldList, or loDialog.cAddedParams... + * could prefill the destination... + * also note that this dialog doesn't, strictly speaking, have to + * be modal, but we're calling it from a modal dialog (the picker) so + * it seems reasonable to keep it modal here. We could subclass it + * to know how to be a singleton, like the error dialog, instead... + * and automatically know about app attributes, rather than + * using the generic gallery version and adjusting it. + + + IF VARTYPE(loDialog) = "O" + + LOCAL laRecNos[1], laWorkAreas[1], ; + liUsed, liRow, lcAlias + + liUsed = AUSED(laWorkAreas) + + * Unlike DoTableOutput(), we really + * have no clue in this method what + * workareas might be affected by + * the named report or label form, so + * should take care of all current + * record pointers, + * assuming that any workareas at all + * are affected in the current data + * session. + + * Because it has a custom property + * allowing a new alias to be selected + * before output is generated, the + * _output object saves and + * restore current workarea, + * after output is generated -- so + * that (at least) is not an issue here. + + * Note also that the report either has its + * own datasession, which has been + * disposed of separately, + * or it takes place in this + * datasession, so no save/restore + * of data sessions should be necessary. + + * We will stipulate that any custom + * datasession objects that a report + * might open, and even create a public + * reference to, should not affect the + * environment of the application + * at the time this method was called. + * Any additional aliases open in + * this datasession by the running + * report which are not closed by + * the report will not be affected + * by this code. + + * However, see remarks about VUE + * file below. + + IF liUsed > 0 + DIMENSION laRecNos[liUsed] + FOR liRow = 1 TO liUsed + lcAlias = laWorkAreas[liRow,1] + IF EOF(lcAlias) + laRecNos[liRow] = 0 + ELSE + laRecNos[liRow] = RECNO(lcAlias) + ENDIF + ENDFOR + ENDIF + + * We must allow for the fact that + * reports can cause errors -- either + * because being invoked in this generic + * way they don't have access to the data + * they need or a UDF causes an error. + + THIS.lSkipErrorHandling = .T. + + loDialog.Icon = THIS.cIcon + IF EMPTY(tcDescription) + loDialog.Caption = loDialog.Caption+" "+ ; + PROPER(JUSTFNAME(lcFileName)) + ELSE + loDialog.Caption = loDialog.Caption + " "+tcDescription + ENDIF + loDialog.cHTMLClass = THIS.SetHTMLClass(tcFileName) + loDialog.cHTMLStyleID = THIS.SetHTMLStyleID(tcFileName) + loDialog.lAddSourceNameToDropDown = .F. + loDialog.cReport = lcFileName + loDialog.lPreventSourceChanges = .T. + loDialog.Show(1) + loDialog = .NULL. + + * This "restore" code does *not* + * handle any dropped or changed + * relations that might occur in the the + * FRX or LBX data environment. + * Neither does it handle the possibility + * that a UDF attached to the report + * or label might actually close a table, + * except in the most basic way, and + * there could be many other + * unforeseen changes + * to the current data session that could + * take place in a UDF. + + * If complete save and restore behavior + * is desirable, a VUE file + * should be CREATEd earlier to a + * generated tempfile name, SET here + * and then ERASEd, followed by + * record-pointer-restoring code similar + * to the following. + + IF liUsed > 0 + FOR liRow = 1 TO liUsed + lcAlias = laWorkAreas[liRow,1] + IF NOT USED(lcAlias) + LOOP + ENDIF + IF laRecNos[liRow] = 0 + GO BOTTOM IN (lcAlias) + SKIP IN (lcAlias) + ELSE + GO (laRecNos[liRow]) IN (lcAlias) + ENDIF + ENDFOR + ENDIF + + IF (NOT THIS.IsErrorFree()) + MESSAGEBOX(REPORT_RUN_ERROR_LOC,MB_ICONSTOP,THIS.cCaption) + ENDIF + THIS.lSkipErrorHandling = .F. + + ELSE + RETURN .F. + ENDIF + ENDIF + + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE doreportdialog && Invokes cReportDialogClass + LPARAMETERS tlModify + + LOCAL llReturn + llReturn = THIS.DoDocumentPickerDialog(THIS.cReportDialogClass,; + THIS.cReportDialogClassLib, ; + tlModify) + RETURN llReturn + + + + + ENDPROC + + PROCEDURE dosort && Wraps cusTableSort's DoSort() method. + LPARAMETERS tcField, tcAlias, tcTag, tlDescending + THIS.cusTableSort.DoSort(tcField,tcAlias,tcTag,tlDescending) + ENDPROC + + PROCEDURE dostartupform && Instantiates cStartupFormClass dialog + LPARAMETERS tlAdd + LOCAL llReturn, lcFavoriteIDs + + lcFavoriteIDs = THIS.cCurrentUserFavoriteIDs + + llReturn = THIS.DoDocumentPickerDialog(THIS.cStartupFormClass,; + THIS.cStartupFormClassLib, ; + tlAdd) + IF tlAdd AND NOT (lcFavoriteIDs == THIS.cCurrentUserFavoriteIDs) + * re-refresh the popup and save to disk + * note: + * modal form doesn't seem to be able to + * affect the popup permanently -- the new bars "leave" + * when the modal dialog's Destroy() fires! + * That's why we don't do this earlier... + THIS.SetCurrentUserFavoriteIDs(THIS.cCurrentUserFavoriteIDs) + ENDIF + + RETURN llReturn + + ENDPROC + + PROCEDURE dotableoutput && Looks at the current form/alias and invokes the _outputdialog class appropriately for a table. Scope 1 or all. Hooks mediator's PrepareOutputAlias() and CleanupOutputAlias(), for framework-enabled forms, and app.SetHTMLClass/SetHTMLStyleID for GENHTML. + * this option looks at the current + * form/alias for any form + * if the form is enabled for + * framework use, it can derive the + * alias information with help of the + * app mediator object + + LPARAMETERS tlOutputOneRecord + + LOCAL loDialog, loMediator, loActiveForm, liSession, lcAlias, ; + lcCaption, lcScope, liRecno, llReturn, llInterrupted + + IF TYPE("_SCREEN.ActiveForm") = "O" + loActiveForm = _SCREEN.ActiveForm + loMediator = THIS.GetFormMediatorRef(loActiveForm) + ENDIF + liSession = SET("DATASESSION") + + DO CASE + CASE TYPE("loActiveForm.Parent") = "O" + SET DATASESSION TO (loActiveForm.Parent.DataSessionID) + CASE VARTYPE(loActiveForm) = "O" + SET DATASESSION TO (loActiveForm.DataSessionID) + ENDCASE + + IF VARTYPE(loMediator) = "O" + loMediator.PrepareOutputAlias() + lcAlias = loMediator.cOutputAlias + lcCaption = loMediator.cOutputCaption + ENDIF + + IF EMPTY(lcAlias) + lcAlias = ALIAS() + ENDIF + + IF EMPTY(lcCaption) + lcCaption = PROPER(lcAlias) + ENDIF + + + IF NOT ( EMPTY(lcAlias) OR EMPTY(RECCOUNT(lcAlias)) ) + + IF (NOT tlOutputOneRecord) + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + * we only have to worry about + * this if we are + * going to be using the + * navigation features, which + * may bring up a messagebox() + ENDIF + + IF THIS.cusTableNav.CurrentTableAllowsNavigation(lcAlias) + lcScope = "" + ELSE + lcScope = NULL + ENDIF + + ELSE + lcScope = "NEXT 1" + ENDIF + + IF NOT ISNULL(lcScope) + + IF EOF(lcAlias) + liRecno = 0 + ELSE + liRecno = RECNO(lcAlias) + ENDIF + + ENDIF + + ENDIF + + IF (NOT ISNULL(lcScope)) AND ; + VARTYPE(liRecno) = "N" AND ; + (EMPTY(lcScope) OR liRecno # 0) + + IF NOT EMPTY(lcScope) + lcCaption = lcCaption+"("+APP_OUTPUT_ONE_REC_LOC+")" + ENDIF + + loDialog = THIS.DoModalDialogClass("_outputdialog","_reports", .T.) + + IF VARTYPE(loDialog) = "O" + loDialog.cScope = lcScope + loDialog.cAlias = lcAlias + loDialog.Caption = loDialog.Caption + " " + lcCaption + loDialog.lAddSourceNameToDropDown = .F. + loDialog.cHTMLClass = THIS.SetHTMLClass(lcAlias,.T.) + loDialog.cHTMLStyleID = THIS.SetHTMLStyleID(lcAlias, .T.) + loDialog.Icon = THIS.cIcon + loDialog.lPreventSourceChanges = .T. + loDialog.cDisplayFontName = THIS.cTextDisplayFont + loDialog.Show(1) + loDialog = .NULL. + llReturn = .T. + + ENDIF + + IF liRecno = 0 + GO BOTTOM IN (lcAlias) + SKIP IN (lcAlias) + ELSE + GO liRecno IN (lcAlias) + ENDIF + + ENDIF + + IF VARTYPE(loMediator) = "O" + loMediator.CleanupOutputAlias() + ENDIF + + SET DATASESSION TO (liSession) + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN llReturn + ENDPROC + + PROCEDURE dotoolbar && Parallel to DoForm. Maintains toolbars collection. Pass a toolbar class library & class name. Uses THIS.iInitialToolbarPosition to set position. + LPARAMETERS tcClassLib, tcClass + + ASSERT EMPTY(tcClassLib) OR VARTYPE(tcClassLib) = "C" + ASSERT EMPTY(tcClass) OR VARTYPE(tcClass) = "C" + + LOCAL lcClass, loToolbar, lcClassLib, ; + liElement, liIndex, liToolbars, lcToolbarName + + IF EMPTY(tcClass) + RETURN 0 + ENDIF + + IF NOT EMPTY(tcClassLib) + lcClassLib = tcClassLib + ENDIF + + + lcClass = UPPER(ALLTRIM(tcClass)) + + liElement = 0 + liToolbars = ALEN(THIS.aToolbars,1) + FOR liIndex = 1 TO liToolbars + loToolbar = THIS.aToolbars[liIndex,1] + * do we have a free element to fill? + IF VARTYPE(loToolbar) # "O" OR ; + VARTYPE(THIS.aToolbars[liIndex,2]) # "N" ; + OR THIS.aToolbars[liIndex,2] = 0 + + liElement = liIndex + LOOP + ENDIF + * is this toolbar already instantiated? + IF UPPER(loToolbar.Class) == lcClass + * increment its counter + THIS.aToolbars[liIndex,2] = THIS.aToolbars[liIndex,2]+1 + loToolbar.Show && position or dock here? + RETURN liIndex + ENDIF + ENDFOR + + IF liElement = 0 + IF VARTYPE(THIS.aToolbars[1,1]) = "O" + liElement = liToolbars+1 + ELSE + liElement = 1 + ENDIF + DIMENSION THIS.aToolbars[liElement,2] + ENDIF + + THIS.aToolbars[liElement,2] = 0 + + IF VARTYPE(THIS.oFrame) = "O" AND (NOT WONTOP(THIS.oFrame.Name)) + THIS.oFrame.Show() + ENDIF + + THIS.aToolbars[liElement,1]=THIS.Instantiate(lcClass,lcClassLib) + + IF VARTYPE(THIS.aToolbars[liElement,1]) = "O" + IF PEMSTATUS(THIS.aToolbars[liElement,1], "oApp",5) + THIS.aToolbars[liElement,1].oApp = THIS + ENDIF + THIS.aToolbars[liElement,2] = 1 + THIS.aToolbars(liElement,1).Dock(THIS.iInitialToolbarPosition) + * THIS.aToolbars[liElement,1].Show() replaced by: + THIS.ActivateFormInFrame(THIS.aToolbars[liElement,1]) + ENDIF + + + RETURN liElement + + + ENDPROC + + PROCEDURE douserlogin && Invokes cUserLoginClass dialog. Returns (NOT EOF(THIS.cUserTableAlias)) to indicate success at locating a user. + ASSERT USED(THIS.cUserTableAlias) + * we're supposed to be setting a record pointer + * in an open table here... + + IF (NOT THIS.lUserPreferences) + RETURN .F. + ENDIF + LOCAL loForm + + loForm = THIS.DoModalDialogClass(THIS.cUserLogInClass, THIS.cUserLogInClassLib, .T.) + IF VARTYPE(loForm) = "O" + loForm.Show(1) + RETURN (NOT EOF(THIS.cUserTableAlias)) + ELSE + RETURN .F. + ENDIF + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + THIS.iLastError = nError + + IF THIS.lSkipErrorHandling + * special cases -- right + * now this is done when + * trying to USE the error log EXCLUSIVEly + * for purging + RETURN + ENDIF + + THIS.cusError.Handle(nError,cMethod,nLine) + + LOCAL llFatal, llUserCancelled, lcCaller, lcProg, ; + llNoCodeExecuting, liLevel, lcTemp + + llFatal = THIS.cusError.IsFatal() + llUserCancelled = THIS.cusError.UserCancelled() + + IF NOT (llFatal OR llUserCancelled) + liLevel = 0 + lcCaller = "" + lcProg = PROGRAM(0) + DO WHILE .T. + lcCaller = PROGRAM(liLevel) + liLevel = liLevel + 1 + lcProg = PROGRAM(liLevel) + IF EMPTY(lcProg) OR (UPPER(lcProg) == UPPER(THIS.Name+".ERROR")) + EXIT + ENDIF + ENDDO + llNoCodeExecuting = (UPPER(lcCaller) == UPPER(THIS.Name+".READEVENTS")) + ENDIF + + DO CASE + CASE THIS.iLastError # nError + * an error in the error handler! + * this will have been taken care of + * and we don't want to get + * into a recursive situation + CASE llFatal OR llUserCancelled + + IF THIS.lReadEvents + lcTemp = THIS.cLastOnError + ON ERROR &lcTemp + * remove reference to App Object + * in error handler *now* before + * it can start messing about with + * destroying itself + ENDIF + THIS.Release() + CASE llNoCodeExecuting + RETRY + OTHERWISE + RETURN + ENDCASE + + + ENDPROC + + PROCEDURE exporterrorlog && Invokes _outputdialog class to allow output of error log information. + LOCAL lcTable, liSelect, lcAlias, loDialog, lcTableAlias, llReturn + + lcTable = THIS.cErrorLogTableName + IF EMPTY(lcTable) OR NOT FILE(lcTable) + MESSAGEBOX(ERRORVIEWER_UNAVAILABLE_LOC,MB_ICONINFORMATION,THIS.cCaption) + RETURN + ENDIF + + THIS.ClearLastError() + liSelect = SELECT() + lcAlias = "ExportErrors" + IF USED(lcAlias) + lcAlias = "E"+SYS(2015) + ENDIF + SELE 0 + USE (lcTable) AGAIN SHARED + lcTableAlias = ALIAS() + + IF (NOT THIS.IsErrorFree()) + THIS.ClearLastError() + SELECT (liSelect) + RETURN + ENDIF + + SELECT errstamp, ; + MLINE (listing,1)+" "+MLINE(listing,3) AS listing, ; + MLINE(usernotes,1) AS usernotes ; + FROM (lcTable) ; + INTO CURSOR (lcAlias) + SELECT (lcAlias) + USE IN (lcTableAlias) + + IF _TALLY > 0 + + loDialog = THIS.DoModalDialogClass("_outputdialog","_reports", .T.) + + IF VARTYPE(loDialog) = "O" + loDialog.Icon = THIS.cIcon + loDialog.cAlias = lcAlias + loDialog.lPreventSourceChanges = .T. + loDialog.cDisplayFontName = THIS.cTextDisplayFont + loDialog.cHTMLClass = THIS.SetHTMLClass(lcAlias,.T.) + loDialog.cHTMLStyleID = THIS.SetHTMLStyleID(lcAlias,.T.) + loDialog.Show(1) + loDialog = .NULL. + llReturn = .T. + ENDIF + + ELSE + + MESSAGEBOX(ERRORVIEWER_EMPTY_LOC,MB_ICONINFORMATION,THIS.cCaption) + + ENDIF + + IF USED(lcAlias) + USE IN (lcAlias) + ENDIF + + SELECT (liSelect) + + RETURN llReturn + + ENDPROC + + PROCEDURE filenotfoundmsgbox && Displays a File Not Found messagebox. + LPARAMETERS tcFileName + + IF INLIST(_VFP.Startmode, 0, 4) + MESSAGEBOX(APP_FILE_NOT_FOUND_LOC+":"+; + CHR(13) + CHR(13)+ ; + tcFileName,MB_ICONEXCLAMATION,THIS.cCaption) + ELSE + THIS.cusError.RecordServerError(; + THIS.cCaption+ ": "+APP_FILE_NOT_FOUND_LOC) + + ENDIF + + ENDPROC + + PROCEDURE filluseroptionsarray && Moves the user table's UserOpts contents to aCurrentUserOpts. Array has 4 columns: property name, value, toggle property or SET, datasession or global attribute + ASSERT USED(THIS.cUserTableAlias) + IF TYPE(THIS.cUserTableAlias+".UserOpts") = "M" AND ; + NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserOpts")) + RESTORE FROM MEMO (THIS.cUserTableAlias+".UserOpts") ADDITIVE + * adds a local array, laOptions + DIME THIS.aCurrentUserOpts[ALEN(laOptions,1),4] + * array columns: property name, value, property or SET, datasession or global + ACOPY(laOptions,THIS.aCurrentUserOpts) + ENDIF + ENDPROC + + PROCEDURE formisframeworkenabled && Reports the existance of a mediator object on a form. Uses THIS.cFormMediatorName to determine the naming convention for this object on the form. + LPARAMETERS toForm + RETURN (NOT ISNULL(THIS.GetFormMediatorRef(toForm))) + + + + ENDPROC + + PROCEDURE getcurrentalias && Wraps the cusTableNav member's GetCurrentAlias() method. + RETURN THIS.cusTableNav.GetCurrentAlias() + ENDPROC + + PROCEDURE getcurrenttopformref && Wraps cusWindowHandler's GetCurrentTopFormRef() method. + + RETURN THIS.cusWindowHandler.GetCurrentTopFormRef() + + + ENDPROC + + PROCEDURE getformmediatorref && Returns a reference to a form's mediator object, or NULL if the form is not framework-enabled with a mediator object. + LPARAMETERS toForm, tlForce + + IF VARTYPE(toForm) # "O" OR ; + NOT (UPPER(toForm.BaseClass) == "FORM") + RETURN NULL + ENDIF + + LOCAL loMember, laCheck[1], loMediator, llExactSet + + loMediator = NULL + + llExactSet =(SET("EXACT") = "OFF") + IF llExactSet + SET EXACT ON + ENDIF + + IF TYPE("toForm."+THIS.cFormMediatorName+".Name") = "C" + loMediator = EVAL("toForm."+THIS.cFormMediatorName) + IF ACLASS(laCheck,loMediator) = 0 OR ; + ASCAN(laCheck,UPPER(APP_MEDIATOR_SUPERCLASS)) = 0 + loMediator = NULL + ENDIF + ENDIF + + IF ISNULL(loMediator) AND toForm.ControlCount > 0 + * try to find a member of the appropriate + * class; slower than the above but still worthwhile + * for generic dialogs that might not use the + * appropriate mediator name for this app. + FOR EACH loMember in toForm.Controls + IF VARTYPE(loMember) = "O" ; + AND ACLASS(laCheck,loMember) > 0 AND ; + ASCAN(laCheck,UPPER(APP_MEDIATOR_SUPERCLASS)) > 0 + loMediator = loMember + EXIT + ENDIF + ENDFOR + ENDIF + + IF ISNULL(loMediator) AND tlForce + * create one + loMediator = THIS.CreateFormMediator(toForm) + + ENDIF + + IF llExactSet + SET EXACT OFF + ENDIF + + RETURN loMediator + + + ENDPROC + + PROCEDURE getresourcefilename && Pass: tcSource, tcExtList, tlSuppressMsg, looks for file with any of extensions in list, in order, to RETURN the appropriate pathed name ("" if none, with File Not Found msg unless tlSuppressMsg). Ignores tcExtlList if explicit ext passed in tcSource. + LPARAMETERS tcSourceFileName, tcExtensionList, tlSuppressMessage + ASSERT VARTYPE(tcSourceFileName) = "C" AND NOT EMPTY(tcSourceFileName) + ASSERT EMPTY(tcExtensionList) OR VARTYPE(tcExtensionList) = "C" + + + * Try out any one of a number of extensions in a delimited + * list if the filename-as-delivered is not found. + * The "." characer is considered the delimiter for this + * list, as it forms an integral part of the definition of a + * file extension. + + * If *no* "." characters are found in the list but the list + * is passed with a string containing spaces, then the + * list will be assumed to be a list of space-delimited + * extensions. + + * Filenames passed in a list will be tried in the order passed; + * see THIS.DoProgram() for a potential list by precedence. + * It's up to the calling program to figure out + * what extensions are appropriate. + + LOCAL lcSourceFileName, lcTargetFileName, lcExtList, ; + lcExt, liExts, liTryExt, liThisExtStarts,liNextExtStarts + + IF VARTYPE(tcSourceFileName) # "C" OR EMPTY(tcSourceFileName) + RETURN "" + ENDIF + + lcSourceFileName = ALLTR(tcSourceFileName) + + IF EMPTY(tcExtensionList) OR ("." $ tcSourceFileName) + lcTargetFileName = LOWER(FULLPATH(lcSourceFileName)) + IF NOT FILE(lcTargetFileName) + lcTargetFileName = "" + ENDIF + ELSE + lcExtList = ALLTRIM(tcExtensionList) + liExts = OCCURS(".",lcExtList) + IF liExts = 0 + lcExtList = STRTRAN(tcExtensionList," ",".") + ELSE + lcExtList = STRTRAN(tcExtensionList," ","") + ENDIF + IF LEFT(lcExtList,1) # "." + lcExtList = "."+lcExtList + ENDIF + liExts = OCCURS(".",lcExtList) + FOR liTryExt = 1 TO liExts + liThisExtStarts = AT(".",lcExtList,liTryExt) + IF liTryExt # liExts + liNextExtStarts = AT(".",lcExtList,liTryExt + 1) + lcExt = SUBSTR(lcExtList,liThisExtStarts,liNextExtStarts-liThisExtStarts) + ELSE + lcExt = SUBSTR(lcExtList,liThisExtStarts) + ENDIF + lcTargetFileName = LOWER(FULLPATH(lcSourceFileName+lcExt)) + IF FILE(lcTargetFileName) + EXIT + ELSE + lcTargetFileName = "" + ENDIF + ENDFOR + + ENDIF + + IF EMPTY(lcTargetFileName) AND NOT tlSuppressMessage + THIS.FileNotFoundMsgBox(tcSourceFileName) + ENDIF + + RETURN lcTargetFileName + + ENDPROC + + PROCEDURE getuseroptionsetting && Takes option name and array (usually aCurrentUserOpts) and returns current value for that option, NULL if not found. + LPARAMETERS tcOption,taOptionArray + + IF VARTYPE(tcOption) # "C" + RETURN .NULL. + ENDIF + + IF PCOUNT() = 2 AND TYPE("taOptionArray[1,1]") # "C" + RETURN .NULL. + ENDIF + + LOCAL liElement, liRow, llExactSet + LOCAL ARRAY laTemp[1] + + IF PCOUNT() = 2 + ACOPY(taOptionArray,laTemp) + ELSE + ACOPY(THIS.aCurrentUserOpts,laTemp) + ENDIF + + llExactSet = (SET("EXACT") = "OFF") + IF llExactSet + SET EXACT ON + ENDIF + + liELEMENT = ASCAN(laTemp,tcOption) + + IF llExactSet + SET EXACT OFF + ENDIF + + IF NOT EMPTY(liElement) + liRow = ASUBSCRIPT(laTemp,liElement,1) + RETURN laTemp[liRow,2] + ELSE + RETURN .NULL. + ENDIF + + ENDPROC + + PROCEDURE gobottom && Wraps cusTableNav member's GoBottom() method. + THIS.lNoInterrupt = .T. + THIS.cusTableNav.GoBottom() + THIS.lNoInterrupt = .F. + + + ENDPROC + + PROCEDURE gonext && Wraps cusTableNav member's GoNext() method. + THIS.lNoInterrupt = .T. + THIS.cusTableNav.GoNext() + THIS.lNoInterrupt = .F. + + + ENDPROC + + PROCEDURE goprevious && Wraps cusTableNav member's GoPrevious() method. + THIS.lNoInterrupt = .T. + THIS.cusTableNav.GoPrevious() + THIS.lNoInterrupt = .F. + + + ENDPROC + + PROCEDURE gotop && Wraps cusTableNav member's GoTop() method. + THIS.lNoInterrupt = .T. + THIS.cusTableNav.GoTop() + THIS.lNoInterrupt = .F. + + + ENDPROC + + PROCEDURE gotorecord && Wraps cusTableNav member's GoToRecord() method. + LPARAMETERS tiRecord + THIS.lNoInterrupt = .T. + THIS.cusTableNav.GoToRecord(tiRecord) + THIS.lNoInterrupt = .F. + + + ENDPROC + + PROCEDURE handleprojectwindow && Hides a project with the name stored in THIS.cProjectName on startup, if it is showing, and restores it when the app object Destroys. + LPARAMETERS tlShow + + IF VARTYPE(THIS.cProjectName) = "C" AND ; + NOT EMPTY(THIS.cProjectName) AND ; + WEXIST( APP_PM_WIN_TITLE_LOC +THIS.cProjectName) + + DO CASE + + CASE tlShow AND (NOT WVISIBLE( APP_PM_WIN_TITLE_LOC +THIS.cProjectName)) + + SHOW WINDOW ( APP_PM_WIN_TITLE_LOC +THIS.cProjectName) + + CASE tlShow + + * no problem + + OTHERWISE + + HIDE WINDOW ( APP_PM_WIN_TITLE_LOC +THIS.cProjectName) + + ENDCASE + + ELSE + + THIS.cProjectName = "" + * prevent SHOWing it later + * if we aren't responsible for HIDEing it + * at this point, even if it does exist + + ENDIF + + ENDPROC + + PROCEDURE iinitialtoolbarposition_assign + LPARAMETERS tiNewVal + IF VARTYPE(tiNewVal) # "N" OR NOT INLIST(tiNewVal,-1,0,1,2,3) + THIS.iInitialToolbarPosition = 0 + ELSE + THIS.iInitialToolbarPosition = tiNewVal + ENDIF + + + + ENDPROC + + PROCEDURE ilasterror_access + RETURN THIS.ilasterror + + ENDPROC + + PROTECTED PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + THIS.cIcon = THIS.GetResourceFileName(THIS.cIcon, ".ico", .T.) + THIS.cImage = THIS.GetResourceFileName(THIS.cImage, ".bmp .ico .gif", .T.) + + IF VARTYPE(THIS.cReference) = "C" AND (NOT EMPTY(THIS.cReference)) + THIS.cReference = THIS.cReference + ENDIF + + IF NOT THIS.SetAppFileNames() + RETURN .F. + ENDIF + + IF VERSION(2) = 0 AND _VFP.StartMode = 4 AND ; + UPPER(THIS.cClassContainerFileName) == UPPER(THIS.cAppFileName) + * if the running EXE is this file, and this file + * is not set up to be Read Events, make it Read Events anyway. + THIS.lReadEvents = .T. + ENDIF + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE instantiate && RETURNs object reference -- pass classname, classlib, APP/EXE if library is external, string of delimited parameters to be macro-executed. If being added as a member, also pass container ref plus membername if it's not OK to use unique/generated name. + LPARAMETERS tcClass, tcClassLib, tcClassContainerFileName, ; + tcParamString, toParent, tcMemberName + + *&* new third param for IN support + *&* will default to "" for ReadEvents, THIS.cClassContainerFileName + *&* for non-ReadEvents... + + LOCAL loReturn, lcMemberName, lcClass, lcClassLib, lcContainer + + ASSERT VARTYPE(tcClass) = "C" AND (NOT EMPTY(tcClass)) + ASSERT EMPTY(tcClassLib) OR VARTYPE(tcClassLib) = "C" + ASSERT EMPTY(tcClassContainerFileName) OR ; + (VARTYPE(tcClassContainerFileName) = "C" AND ; + NOT EMPTY(SYS(2000,FULLPATH(tcClassContainerFileName)))) + ASSERT EMPTY(tcParamString) OR VARTYPE(tcParamString) = "C" + ASSERT VARTYPE(toParent) = "O" OR EMPTY(toParent) + ASSERT EMPTY(tcMemberName) OR VARTYPE(tcMemberName) = "C" + + lcClass = ALLTRIM(tcClass) + + DO CASE + + CASE VARTYPE(tcClassLib) # "C" + * default library is the app object's + lcClassLib = THIS.ClassLibrary + lcContainer = THIS.cClassContainerFileName + CASE EMPTY(tcClassLib) + * somebody has already SET CLASSLIB + * and passed a null string to indicate this + lcClassLib = "" + lcContainer = "" + OTHERWISE + lcClassLib = ALLTRIM(tcClassLib) + IF VARTYPE(tcClassContainerFileName) = "C" + lcContainer = ALLTRIM(tcClassContainerFileName) + ELSE + IF EMPTY(SYS(2000,lcClassLib)) AND ; + EMPTY(SYS(2000,lcClassLib+".VCX")) + * not on disk, gotta find it somewhere... + * like the product, we are assuming + * that if the extension isn't used + * it's a VCX, not a PRG/FXP + lcContainer = THIS.cClassContainerFileName + ELSE + * found it! + lcContainer = "" + ENDIF + ENDIF + + ENDCASE + + loReturn = .NULL. + + lcClassLib = THIS.GetResourceFileName(lcClassLib,".vcx .fxp .prg") + + IF NOT EMPTY(lcContainer) + lcContainer = THIS.GetResourceFileName(lcContainer,".app .exe") + ENDIF + + IF (EMPTY(lcClassLib) AND NOT EMPTY(tcClassLib)) OR ; + (EMPTY(lcContainer) AND NOT EMPTY(tcClassContainerFileName)) + RETURN .F. + ENDIF + + IF VERSION(2) = 0 AND ; + UPPER(JUSTEXT(lcClassLib)) == "PRG" + IF NOT EMPTY(SYS(2000,lcClassLib)) + * file is on disk for sure, and + * we can't use it if it is built into + * another file like this... + lcContainer = "" + COMPILE (lcClassLib) + lcClassLib = FORCEEXT(lcClassLib,"FXP") + ELSE + RETURN .F. + ENDIF + ENDIF + + IF VARTYPE(toParent) = "O" + IF VARTYPE(tcMemberName)= "C" + lcMemberName = tcMemberName + ELSE + lcMemberName = "C"+SYS(2015) + ENDIF + ASSERT TYPE("toParent."+lcMemberName) # "O" ; + MESSAGE toParent.&lcMemberName..Name + " "+APP_ALREADY_EXISTS_LOC+"." + THIS.ClearLastError() + IF EMPTY(tcParamString) + toParent.NewObject(lcMemberName,lcClass,lcClassLib,lcContainer) + ELSE + toParent.NewObject(lcMemberName,lcClass,lcClassLib,lcContainer,&tcParamString.) + ENDIF + IF THIS.IsErrorFree() + loReturn = EVAL("toParent."+lcMemberName) + ENDIF + ELSE + IF EMPTY(tcParamString) + loReturn = NEWOBJECT(lcClass,lcClassLib,lcContainer) + ELSE + loReturn = NEWOBJECT(lcClass,lcClassLib, lcContainer,&tcParamString.) + ENDIF + ENDIF + + RETURN loReturn + + + ENDPROC + + PROCEDURE iserrorfree && RETURNs ISNULL(THIS.iLastError) -- See THIS.ClearLastError(). + RETURN (ISNULL(THIS.iLastError)) + + ENDPROC + + PROTECTED PROCEDURE lgomenu_assign + LPARAMETERS tlGoMenuNeeded + + IF EMPTY(THIS.cGoMenuFile) + RETURN .F. + ENDIF + + DO CASE + CASE tlGoMenuNeeded = THIS.lGoMenu + * nothing to worry about + + CASE tlGoMenuNeeded + THIS.lGoMenu = .T. + IF TYPE([CNTBAR("_mGo")]) = "U" + DO CASE + CASE VARTYPE(THIS.oFrame) # "O" + THIS.DoMenu(THIS.cGoMenuFile) + CASE NOT EMPTY(THIS.oFrame.cMenuName) + THIS.DoMenu(THIS.cGoMenuFile, .F.) + OTHERWISE + ENDCASE + ELSE + * already defined, just show the pad + DO CASE + CASE VARTYPE(THIS.oFrame) # "O" + DEFINE PAD _msm_Go OF _MSYSMENU ; + PROMPT APP_GO_PAD_LOC COLOR SCHEME 3 ; + BEFORE _msm_windo ; + KEY APP_GO_PAD_HOTKEY_LOC, [APP_GO_PAD_HOTKEY_LOC] ; + MESSAGE APP_GO_MESSAGE_LOC + ON PAD _msm_Go OF _MSYSMENU ACTIVATE POPUP _mgo + + + CASE NOT EMPTY(THIS.oFrame.cMenuName) + + DEFINE PAD _msm_Go OF (THIS.oFrame.cMenuName); + PROMPT APP_GO_PAD_LOC COLOR SCHEME 3 ; + BEFORE _msm_windo ; + KEY APP_GO_PAD_HOTKEY_LOC, [APP_GO_PAD_HOTKEY_LOC] + + ON PAD _msm_Go OF (THIS.oFrame.cMenuName) ACTIVATE POPUP _mgo + + OTHERWISE + + ENDCASE + ENDIF + + OTHERWISE + THIS.lGoMenu = .F. + * for now, I am not putting menu shortcut keys on the + * popup and I am just leaving it DEFINEd and inaccessible + * for speed reasons -- so am not releasing it once defined + DO CASE + CASE VARTYPE(THIS.oFrame) # "O" + RELEASE PAD _msm_Go OF _MSYSMENU + * RELEASE POPUP _mGo EXTENDED + CASE NOT EMPTY(THIS.oFrame.cMenuName) + RELEASE PAD _msm_Go OF (THIS.oFrame.cMenuName) + * RELEASE POPUP _mGo EXTENDED + OTHERWISE + ENDCASE + + ENDCASE + RETURN + + ENDPROC + + PROCEDURE lnavtoolbar_assign + LPARAMETERS tlNavToolbarNeeded + + IF EMPTY(THIS.cNavToolbarClass) + RETURN .F. + ENDIF + + DO CASE + CASE tlNavToolbarNeeded = THIS.lNavToolbar + THIS.lNavToolbar = tlNavToolbarNeeded + * nothing to worry about + CASE tlNavToolbarNeeded + THIS.lNavToolbar = .T. + IF VARTYPE(THIS.oNavToolbar) # "O" + LOCAL liIndex + liIndex = THIS.DoToolbar(THIS.cNavToolbarClassLib,THIS.cNavToolbarClass) + THIS.oNavToolbar = THIS.aToolbars[liIndex,1] + ELSE + IF NOT THIS.oNavToolBar.Visible + THIS.oNavToolbar.Show() + ENDIF + ENDIF + OTHERWISE + THIS.lNavToolbar = .F. + IF (VARTYPE(THIS.oNavToolbar)= "O") AND THIS.oNavToolbar.Visible + THIS.oNavToolbar.Hide() + ENDIF + ENDCASE + RETURN + + ENDPROC + + PROCEDURE lnointerrupt_assign + LPARAMETERS tvNewVal + + IF VARTYPE(tvNewVal) = "L" AND ; + tvNewVal # THIS.lNoInterrupt + + WITH THIS.tmrRefresh + IF tvNewVal + .Interval = 0 + ELSE + .Interval = .iRegularInterval + ENDIF + ENDWITH + THIS.lNoInterrupt = tvNewVal + + ENDIF + + + ENDPROC + + PROCEDURE lusercanchangepassword_access + *To do: Modify this routine for the Access method + RETURN THIS.lusercanchangepassword + + ENDPROC + + PROCEDURE lusercanchangepassword_assign + LPARAMETERS m.vNewVal + *To do: Modify this routine for the Assign method + THIS.lusercanchangepassword = m.vNewVal + + ENDPROC + + PROCEDURE onshutdown && Occurs when the user attempts to exit Visual FoxPro by pressing _SCREEN close button or the close button on a framework top form MDI frame. + LPARAMETERS tlCalledFromTopForm + + LOCAL llReturn, llInterrupted + + DO CASE + CASE INLIST(_VFP.StartMode,1,2,3,5) + * we really shouldn't be here at all + llReturn = .T. + CASE TYPE("_SCREEN.ActiveForm.Parent") = "O" AND ; + _SCREEN.ActiveForm.Parent.WindowType = 1 && modal + * formset overrides form on this one + ?? CHR(7) + CASE TYPE("_SCREEN.ActiveForm") = "O" AND ; + _SCREEN.ActiveForm.WindowType = 1 + ?? CHR(7) + OTHERWISE + llReturn = .T. + ENDCASE + + IF llReturn + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + llReturn = (INLIST(_VFP.StartMode,1,2,3,5) OR ; + (MESSAGEBOX(APP_READY_TO_SHUTDOWN_LOC, ; + MB_YESNO+MB_ICONQUESTION, ; + THIS.cCaption)= IDYES)) + IF llReturn + llReturn = THIS.ReleaseForms() + ENDIF + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + ENDIF + + IF llReturn + IF NOT tlCalledFromTopForm + THIS.Release() + QUIT + ENDIF + ENDIF + + RETURN llReturn + + ENDPROC + + PROCEDURE purgeerrorlog && Zaps current error log with appropriate confirmation and checks. + LOCAL lcTable, liSelect, lcAlias, llSafety + + + + lcTable = THIS.cErrorLogTableName + IF EMPTY(lcTable) OR NOT FILE(lcTable) + MESSAGEBOX(ERRORVIEWER_UNAVAILABLE_LOC,MB_ICONINFORMATION,THIS.cCaption) + RETURN + ENDIF + THIS.ClearLastError() + THIS.lSkipErrorHandling = .T. + liSelect = SELECT() + lcAlias = "E"+SYS(2015) + USE (lcTable) ALIAS (lcAlias) EXCLUSIVE IN 0 + THIS.lSkipErrorHandling = .F. + + IF (NOT THIS.IsErrorFree()) OR (NOT USED(lcAlias)) + THIS.ClearLastError() + MESSAGEBOX(ERRORVIEWER_IN_USE_LOC,MB_ICONSTOP,THIS.cCaption) + IF USED(lcAlias) + USE IN (lcAlias) + ENDIF + RETURN + ENDIF + + IF NOT (RECCOUNT(lcAlias) = 0) + + llSafety = SET("SAFETY") = "OFF" + IF llSafety + SET SAFETY ON + ENDIF + + SELECT (lcAlias) + ZAP + SELECT (liSelect) + + IF llSafety + SET SAFETY OFF + ENDIF + + ENDIF + + IF (RECCOUNT(lcAlias) = 0) + MESSAGEBOX(ERRORVIEWER_EMPTY_LOC,MB_ICONINFORMATION,THIS.cCaption) + ENDIF + + USE IN (lcAlias) + + RETURN + + ENDPROC + + PROCEDURE querydatachanged && Wraps cusDataSession member's DataChanged() method. + LPARAMETERS toSession, tiChangeMode + LOCAL llReturn, llInterrupted + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + llReturn = THIS.cusDataSession.DataChanged(toSession,tiChangeMode) + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN llReturn + + + ENDPROC + + PROCEDURE querydatasessionunload && Wraps cusDataSession member's Queryunload() method. + LPARAMETERS tlDataChangeAlreadyConfirmed, toSession + + ASSERT VARTYPE(tlDataChangeAlreadyConfirmed) = "L" + ASSERT TYPE("toSession.DataSessionID") = "N" OR ; + TYPE("_SCREEN.ActiveForm") = "O" + + LOCAL llDataHandled, loSession, llInterrupted + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + IF TYPE("toSession.DataSessionID") = "N" + loSession = toSession + ELSE + loSession = _SCREEN.ActiveForm + ENDIF + + IF tlDataChangeAlreadyConfirmed OR ; + THIS.cusDataSession.DataChanged(loSession) + + llDataHandled = ; + THIS.cusDataSession.QueryUnload(.t., loSession) + + ELSE + + llDataHandled = .T. + + ENDIF + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN llDataHandled + + ENDPROC + + PROCEDURE readevents && Starts read events mode. + THIS.ClearLastError() + IF THIS.lReadEvents + READ EVENTS + ENDIF + + + + + + ENDPROC + + PROCEDURE refreshfavoritepopup && DEFINEs BARs for Favorites menu popup using THIS.cCurrentUserFavoriteIDs. + IF (NOT THIS.lFavorites) OR ; + TYPE("CNTBAR(THIS.cFavoritePopupName)") # "N" + RETURN .F. + ENDIF + + LOCAL lcThisRef, lcStatement, lcFavoriteID, ; + liBarNo, lcAlias, liSelect, laFavorites[1] + + lcThisRef = THIS.cReference + + * release all but top bars: + FOR liBarNo = 4 TO CNTBAR(THIS.cFavoritePopupName) + RELEASE BAR liBarNo OF (THIS.cFavoritePopupName) + ENDFOR + + liBarNo = 3 + + * open metatable + THIS.ClearLastError() + + IF NOT EMPTY(THIS.cMetaTable) + lcAlias = "M"+SYS(2015) + USE (THIS.cMetaTable) ALIAS (lcAlias) AGAIN SHARED IN 0 + ENDIF + + IF NOT (THIS.IsErrorFree()) + SET SKIP OF BAR 1 OF (THIS.cFavoritePopupName) .T. + SET SKIP OF BAR 2 OF (THIS.cFavoritePopupName) .T. + RETURN + ENDIF + + liSelect = SELECT() + IF NOT EMPTY(lcAlias) + SELECT (lcAlias) + ENDIF + + * now add rest of bars: + IF NOT EMPTY(THIS.cCurrentUserFavoriteIDs) + + ALINES(laFavorites,THIS.cCurrentUserFavoriteIDs,.T.) + STORE "" TO lcFavoriteID, lcStatement + FOR EACH lcFavoriteID IN laFavorites + IF NOT EMPTY(lcFavoriteID) + lcFavoriteID = UPPER(ALLTR(lcFavoriteID)) + lcStatement = "" + IF FILE(lcFavoriteID) + liBarNo = liBarNo + 1 + DEFINE BAR liBarNo OF (THIS.cFavoritePopupName) ; + PROMPT lcFavoriteID + lcStatement = lcThisRef+"." + lcStatement = lcStatement+"DoFile" + lcStatement = lcStatement + "(["+lcFavoriteID+"])" + ELSE + IF NOT EMPTY(lcAlias) AND ; + THIS.SeekMetaTableFavoriteID(lcFavoriteID,lcAlias) + liBarNo = liBarNo + 1 + DEFINE BAR liBarNo OF (THIS.cFavoritePopupName) ; + PROMPT ALLTR(Doc_Descr) + + DO CASE + CASE NOT EMPTY(Alt_Exec) + lcStatement = ALLTRIM(Alt_Exec) + CASE Doc_Wrap + lcStatement = "DO (["+ ALLTRIM(Doc_Exec)+"])" + CASE Doc_Type = PJX_META_DOC_REPORT_TYPE + lcStatement = lcThisRef+".DoReport(["+; + ALLTRIM(Doc_Exec)+"],["+ ; + ALLTRIM(Doc_Descr)+"])" + CASE Doc_Type = PJX_META_DOC_FORM_TYPE + lcStatement = lcThisRef+".DoForm(["+ ; + ALLTRIM(Doc_Exec)+"],["+ ; + ALLTRIM(Doc_Class)+"],"+; + IIF(Doc_Single,".T.,",".F.,")+; + IIF(Doc_NoShow,".T.,",".F.,")+; + IIF(Doc_Go,".T.,",".F.,")+; + IIF(Doc_Nav,".T.",".F.")+")" + OTHERWISE + * ... ? + ENDCASE + ENDIF + ENDIF + IF NOT EMPTY(lcStatement) + ON SELECTION BAR liBarNo OF ; + (THIS.cFavoritePopupName) &lcStatement + ENDIF + ENDIF + ENDFOR + ENDIF + + * no possible docs? got all possible docs as favorites? didn't get any favorites? + * the first two possibilities are no longer possible , since + * we allow GETFILE() picking of favorites... + * however it's still possible not to be able to clear any favorites + * because there are none saved + SET SKIP OF BAR 2 OF (THIS.cFavoritePopupName) (liBarNo = 3) + + IF NOT EMPTY(lcAlias) + USE IN (lcAlias) + ENDIF + SELECT (liSelect) + + + + ENDPROC + + PROCEDURE refreshformscollection && Refresh forms collection arrays and counters. + LOCAL lnCount,lnCount2 + THIS.ClearLastError() + lnCount=1 + DO WHILE lnCount<=THIS.nFormCount + IF VARTYPE(THIS.aForms[lnCount])="O" + lnCount=lnCount+1 + LOOP + ENDIF + FOR lnCount2 = lnCount TO (THIS.nFormCount-1) + THIS.aForms[lnCount2]=THIS.aForms[lnCount2+1] + THIS.aForms[lnCount2+1]=.NULL. + THIS.aFormNames[lnCount2]=THIS.aFormNames[lnCount2+1] + THIS.aFormNames[lnCount2+1]="" + ENDFOR + THIS.nFormCount=THIS.nFormCount-1 + IF THIS.nFormCount=0 + EXIT + ENDIF + DIMENSION THIS.aForms[THIS.nFormCount],THIS.aFormNames[THIS.nFormCount] + ENDDO + IF THIS.nFormCount=0 + THIS.ResetFormsCollection + ENDIF + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE refreshtoolbars && Called by member timer and at any other time you need to synch toolbars to current environment. Iterates through toolbar collection calling Refresh methods so that it doesn't assume any tbr class. + IF THIS.lNoInterrupt + * shouldn't happen + RETURN + ENDIF + + LOCAL loToolbar + FOR EACH loToolbar IN THIS.aToolbars + IF VARTYPE(loToolbar) = "O" + loToolbar.Refresh + ENDIF + ENDFOR + + ENDPROC + + PROCEDURE release + LPARAMETERS tlForce + + + IF NOT THIS.ReleaseSessions(tlForce) + RETURN .F. + ENDIF + + IF NOT THIS.ReleaseForms(tlForce) + RETURN .F. + ENDIF + + THIS.lNoInterrupt = .T. + THIS.ReleaseContextMenus(tlForce) + THIS.ReleaseToolbars(tlForce) + THIS.ReleaseCollaborators() + THIS.ReleaseFrame() + THIS.ClearEvents() + + + RELEASE THIS + + + ENDPROC + + PROCEDURE releasecollaborators && Manages release of collaborative objects + THIS.ClearLastError() + + LOCAL liMemberIndex, loMember + FOR liMemberIndex = 1 TO ALEN(THIS.aCollaborators) + loMember = THIS.aCollaborators[liMemberIndex] + IF VARTYPE(loMember) = "O" + IF TYPE("loMember.Parent") = "O" + loMember.Parent.RemoveObject(loMember.Name) + ELSE + * otherwise it was just done with a CREATEOBJECT, + IF PEMSTATUS(loMember,"Release",5) + loMember.Release() + ENDIF + ENDIF + ENDIF + * the following should get rid of the object, if any: + loMember = NULL + THIS.aCollaborators[liMemberIndex] = NULL + ENDFOR + + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE releasecontextmenu && Manages release of a single context menu and the context menu collection. + LPARAMETERS tiMenuIndex, tlForce + + ASSERT VARTYPE(tiMenuIndex) = "N" AND ; + BETWEEN(tiMenuIndex,1,ALEN(THIS.aContextMenus,1)) + + ASSERT VARTYPE(tlForce) = "L" + + * this function expects an index from the context menu array. + * see comments in the ReleaseToolbar method. + + THIS.ClearLastError() + + IF PCOUNT()=0 OR EMPTY(tiMenuIndex) + RETURN .F. + ENDIF + + LOCAL liCurrentMenuRefCount + + IF VARTYPE(THIS.aContextMenus[tiMenuIndex,2]) # "N" + liCurrentMenuRefCount = 0 + ELSE + liCurrentMenuRefCount = THIS.aContextMenus[tiMenuIndex,2] + ENDIF + + IF tlForce OR liCurrentMenuRefCount <= 1 + IF VARTYPE(THIS.oFrame) # "O" + RELEASE PAD (THIS.aContextMenus[tiMenuIndex,3]) OF _MSYSMENU + ELSE + RELEASE PAD (THIS.aContextMenus[tiMenuIndex,3]) OF (THIS.oFrame.cMenuName) + ENDIF + RELEASE POPUP (THIS.aContextMenus[tiMenuIndex,4]) EXTENDED + STORE .F. TO THIS.aContextMenus[tiMenuIndex,1], ; + THIS.aContextMenus[tiMenuIndex,2], ; + THIS.aContextMenus[tiMenuIndex,3], ; + THIS.aContextMenus[tiMenuIndex,4] + ELSE + THIS.aContextMenus[tiMenuIndex,2] = liCurrentMenuRefCount - 1 + ENDIF + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE releasecontextmenus && Releases all context menus. + LPARAMETERS tlForce + LOCAL liMenu, liMenuCount + + THIS.ClearLastError() + + liMenuCount = ALEN(THIS.aContextMenus,1) + + FOR liMenu = 1 TO liMenuCount + IF VARTYPE(THIS.aContextMenus[liMenu,1]) = "C" AND ; + NOT THIS.ReleaseContextMenu(liMenu, .T.) + IF NOT tlForce + RETURN .F. + ENDIF + ENDIF + ENDFOR + RELEASE POPUP _mGo EXTENDED + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE releaseform && Release specific or active form and manages forms collection. + LPARAMETERS toForm + + THIS.ClearLastError() + + IF PCOUNT()=0 + IF TYPE("_SCREEN.ActiveForm")= "O" + _SCREEN.ActiveForm.Release() + ENDIF + ELSE + IF VARTYPE(toForm)="O" + toForm.Release() + ENDIF + ENDIF + THIS.RefreshFormsCollection + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE releaseforms && Release all application forms from memory and the forms collection. + LPARAMETERS tlForce + + LOCAL lnFormCount + + THIS.RefreshFormsCollection + + IF THIS.nFormCount = 0 + RETURN + ENDIF + + LOCAL loForm, loMemberForm, liResult, llInterrupted + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + FOR EACH loForm IN THIS.aForms + + IF VARTYPE(loForm) # "O" OR ; + NOT INLIST("#"+UPPER(loForm.BaseClass)+"#","#FORMSET#","#FORM#") + LOOP + ENDIF + + IF tlForce + THIS.DataRevert(.T.,.F.,loForm,.T.) + ELSE + IF NOT THIS.QueryDataSessionUnload(.F.,loForm) + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + RETURN .F. + ENDIF + ENDIF + + ENDFOR + + + * only once they have confirmed all possible dataupdating/cancelling + * out of the process can we begin to actually close forms. + + DO WHILE THIS.nFormCount>0 + + lnFormCount=THIS.nFormCount + THIS.ReleaseForm(THIS.aForms[lnFormCount]) + IF THIS.nFormCount=lnFormCount + IF NOT tlForce + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + RETURN .F. + ENDIF + ENDIF + + ENDDO + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + ENDPROC + + PROCEDURE releaseframe && Releases top form/MDI frame. + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.oApp = .NULL. + THIS.oFrame.Release() + THIS.oFrame = .NULL. + ENDIF + ENDPROC + + PROCEDURE releasesessions && Releases all mediated datasession collaborator objects + LPARAMETERS tlForce + + LOCAL loCollaborator, liMemberIndex, llInterrupted + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + FOR EACH loCollaborator IN THIS.aCollaborators + + IF VARTYPE(loCollaborator) # "O" ; + OR NOT PEMSTATUS(loCollaborator,"DataSessionID",5) + LOOP + ENDIF + + IF tlForce + THIS.DataRevert(.T.,.F.,loCollaborator) + ELSE + DO CASE + CASE THIS.iQueryUnloadResultForNonVisualSessions = 0 + THIS.DataRevert(.T.,.F.,loCollaborator) + CASE THIS.iQueryUnloadResultForNonVisualSessions = 1 + THIS.DataUpdate(.T.,.F.,loCollaborator) + OTHERWISE + IF NOT THIS.QueryDataSessionUnload(.F.,loCollaborator) + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + RETURN .F. + ENDIF + ENDCASE + ENDIF + + ENDFOR + + + * only once they have confirmed all possible dataupdating/cancelling + * out of the process do we begin to actually close sessions, just as with forms + + FOR liMemberIndex = 1 TO ALEN(THIS.aCollaborators) + + loCollaborator = THIS.aCollaborators[liMemberIndex] + + IF VARTYPE(loCollaborator) # "O" ; + OR NOT PEMSTATUS(loCollaborator,"DataSessionID",5) + LOOP + ENDIF + + IF TYPE("loCollaborator.Parent") = "O" + loCollaborator.Parent.RemoveObject(loCollaborator.Name) + ELSE + IF PEMSTATUS(loCollaborator,"Release",5) + loCollaborator.Release() + ENDIF + ENDIF + loCollaborator = NULL + THIS.aCollaborators[liMemberIndex] = NULL + + ENDFOR + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN (THIS.IsErrorFree()) + + ENDPROC + + PROCEDURE releasetoolbar && Parallel to ReleaseForm. Maintains toolbars collection. + LPARAMETERS tiToolbarIndex, tlForce + + ASSERT VARTYPE(tiToolbarIndex) = "N" AND ; + BETWEEN(tiToolbarIndex,1,ALEN(THIS.aToolbars,1)) + + ASSERT VARTYPE(tlForce) = "L" + + * this function expects an index from the toolbar array. + + * The second parameter normally comes from the + * application releasing all toolbars by ReleaseToolbars() + * or from some other manager releasing all forms of some + * particular type, which represent all the "clients" of + * this toolbar. In either case they would normally + * use the tlForce parameter. + + * OTOH you pass can pass the index of the toolbar from + * a single client of the toolbar, such as a form, + * which would have kept a record of this reference when it + * issued an app.dotoolbar() on its load. (DoToolbar returns + * this index). WHen the form releases it wants + * to notify the application that it doesn't need the toolbar + * any more. The client form has no way of knowing + * how many other clients may be using this toolbar, so tlForce + * is not used. + + THIS.ClearLastError() + + IF PCOUNT()=0 OR EMPTY(tiToolbarIndex) + RETURN .F. + ENDIF + + LOCAL liCurrentToolbarRefCount + + IF VARTYPE(THIS.aToolbars[tiToolbarIndex,2]) # "N" + liCurrentToobarRefCount = 0 + ELSE + liCurrentToolbarRefCount = THIS.aToolbars[tiToolbarIndex,2] + ENDIF + + * toolbars don't have a RELEASE method by default, + * and I don't want to assume any particular baseclass, + * which is why I'm using the toolbar collection index + * instead + + * release if this is the last reference to this + * toolbar or if we are releasing all toolbars + IF tlForce OR liCurrentToolbarRefCount <= 1 + IF VARTYPE(THIS.aToolbars[tiToolbarIndex,1]) = "O" + THIS.aToolbars[tiToolbarIndex,1].Release() + ENDIF + THIS.aToolbars[tiToolbarIndex,1] = .NULL. + THIS.aToolbars[tiToolbarIndex,2] = 0 + ELSE + THIS.aToolbars[tiToolbarIndex,2] = liCurrentToolbarRefCount - 1 + ENDIF + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE releasetoolbars && Parallel to ReleaseForms. Iterates through toolbar collection + LPARAMETERS tlForce + LOCAL liToolbar, liToolbarCount, llInterrupted + + THIS.ClearLastError() + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + liToolbarCount = ALEN(THIS.aToolbars,1) + + FOR liToolbar = 1 TO liToolbarCount + IF VARTYPE(THIS.aToolbars[liToolbar,1]) = "O" AND ; + NOT THIS.ReleaseToolbar(liToolbar, .T.) + IF NOT tlForce + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + RETURN .F. + ENDIF + ENDIF + ENDFOR + + THIS.oNavToolbar = .NULL. && can't hurt + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROTECTED PROCEDURE resetformscollection && Reset arrays and counters of forms collection. + THIS.nFormCount=0 + DIMENSION THIS.aForms[1],THIS.aFormNames[1] + THIS.aForms=.NULL. + THIS.aFormNames="" + + ENDPROC + + PROTECTED PROCEDURE restoreenvironment && Restores environment settings. + IF THIS.lRestoredEnvironment OR ; + (NOT THIS.lSavedEnvironment) + RETURN .T. + ENDIF + + THIS.ClearLastError() + + LOCAL lcTemp + + IF THIS.lReadEvents + + lcTemp = THIS.cLastOnShutDown + ON SHUTDOWN &lcTemp + + lcTemp = THIS.cLastOnError + ON ERROR &lcTemp + + lcTemp = THIS.cLastMacKey + SET MACKEY TO &lcTemp + + SET PATH TO (THIS.cLastPath) + + CD (THIS.cLastDirectory) + + IF FILE(THIS.cMacroSaveFile) + CLEAR MACROS && restore macros is additive + RESTORE MACROS FROM (THIS.cMacroSaveFile) + ERASE (THIS.cMacroSaveFile) NORECYCLE + ENDIF + + IF EMPTY(THIS.cFrameClass) AND (NOT EMPTY(THIS.cStartUpMenu)) + RELEASE MENU _MSYSMENU EXTENDED + POP MENU _MSYSMENU + ENDIF + + ENDIF + + THIS.lRestoredEnvironment = .T. + + RETURN THIS.IsErrorFree() + + ENDPROC + + PROTECTED PROCEDURE saveenvironment && Saves environment settings. + IF THIS.lReadEvents + + THIS.cLastOnShutDown = ON("SHUTDOWN") + THIS.cLastPath = SET("PATH") + THIS.cLastOnError = ON("ERROR") + THIS.cLastDirectory = SET("DIRECTORY") + THIS.cLastMacKey = SET("MACKEY") + THIS.cMacroSaveFile = THIS.cAppFolder+"M"+SYS(2015)+".FKY" + THIS.lSkipErrorHandling = .T. + SAVE MACROS TO (THIS.cMacroSaveFile) + THIS.lSkipErrorHandling = .F. + + IF EMPTY(THIS.cFrameClass) AND ; + (NOT EMPTY(THIS.cStartupMenu)) + + PUSH MENU _MSYSMENU + + ENDIF + + ENDIF + + THIS.lSavedEnvironment = .T. + + + ENDPROC + + PROCEDURE seekcurrentuser && This method finds the current user using an exact match (case sensitivity depends on THIS.lUserNameIsCaseSensitive). + LPARAMETERS tcName + + * This method is separated out so you can use different + * user-location strategies (move the record pointer + * differently) if you like. You will want to + * change CreateUserTable() to match any changes you make here. + * The application object expects that whatever table + * you use, you will have created one c-type field and placed + * its name in THIS.cUserTableIDField, and one i-type field and + * placed its name in THIS.iUserTableLevelField. + + LOCAL llOpenedTable, llSuccess, lcName, llDeletedOff + + IF VARTYPE(tcName) = "C" + lcName = tcName + ELSE + lcName = THIS.cCurrentUser + ENDIF + + IF NOT USED(THIS.cUserTableAlias) + * Note that ordinarily this method will be called with the + * user table already opened but it might some time + * be useful just to validate the current user + + USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias) + IF NOT (THIS.IsErrorFree()) + RETURN .F. + ENDIF + llOpenedTable = .T. + ENDIF + + * this is an exact but case-insensitive match + + IF SET("DELETED") = "OFF" + llDeletedOff = .F. + SET DELETED ON + ENDIF + + IF THIS.lUserNameIsCaseSensitive + llSuccess = SEEK(PADR(ALLTR((lcName)), ; + LEN(EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableIDField))), ; + THIS.cUserTableAlias,"ID") + ELSE + llSuccess = SEEK(PADR(UPPER(ALLTR((lcName))), ; + LEN(EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableIDField))), ; + THIS.cUserTableAlias,"ID_Upper") + ENDIF + + IF llDeletedOff + SET DELETED OFF + ENDIF + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + RETURN llSuccess + + ENDPROC + + PROCEDURE seekdefaultuser && This method finds a record with a blank user name where default options and favorites are stores, for use when defining a new user or when user logins and separate user profiles are not required. + * this is broken out in case + * you want a different way of + * assigning a "default user record" + * than this one (blank user id field) + + LOCAL llOpenedTable + + IF NOT USED(THIS.cUserTableAlias) + * see notes in SeekCurrentUser() + USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias) + IF NOT (THIS.IsErrorFree()) + RETURN .F. + ENDIF + llOpenedTable = .T. + ENDIF + + IF RECCOUNT(THIS.cUserTableAlias) > 0 + IF NOT THIS.SeekCurrentUser("") + GO TOP IN (THIS.cUserTableAlias) + ENDIF + ELSE + APPEND BLANK IN (THIS.cUserTableAlias) + ENDIF + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + + ENDPROC + + PROCEDURE seekmetatablefavoriteid && Finds a record in the meta table using an identification specified in #DEFINE APP_META_FAVE_ID in _FRAMEWK.H. Override this method if you decide to use a more sophisticated method of identifying records in the metatable! + LPARAMETERS tcFavoriteID,tcAlias + ASSERT USED(tcAlias) + ASSERT TYPE("VAL(tcFavoriteID)") = "N" + + LOCAL liRecID + + * this is meant to be overridden if you have a better idea! + * see the #DEFINE APP_META_FAVE_ID for what I'm using + * here... + + liRecID = VAL(tcFavoriteID) + + IF liRecID > 0 AND liRecID <= RECCOUNT(tcAlias) + GO liRecID IN (tcAlias) + RETURN (NOT DELETED(tcAlias)) + ELSE + RETURN .F. + ENDIF + + + + ENDPROC + + PROCEDURE setappfilenames && Get top-level filename, and also get the name of the module (app or exe) that owns this particular object, for SET CLASSLIB ... IN... default usage, which may be different, especially in modular and non-ReadEvents apps. + LOCAL lcSys16, liLevel + lcSys16 = UPPER(SYS(16,0)) + * get top-level filename, and also + * get the name of the module (app or exe) that + * owns this particular object, for SET CLASSLIB ... IN... + * default usage, which may be different. + * The latter is important to non-READ EVENTS apps. + IF EMPTY(lcSys16) + THIS.cAppFileName = "" + ELSE + THIS.cAppFileName = lcSys16 + IF "PROCEDURE" $ THIS.cAppFileName + THIS.cAppFileName = SUBSTR(THIS.cAppFileName,11) + THIS.cAppFileName = SUBSTR(THIS.cAppFileName,1,AT(" ",THIS.cAppFileName)-1) + ENDIF + IF NOT FILE(THIS.cAppFileName) + * this can happen if an "ON..." was involved... + THIS.cAppFileName = "" + ENDIF + IF INLIST(RIGHT(THIS.cAppFileName,3),"VCT","DCT") + * createobject from the command window, + * or a stored procedure -- + * a top-level SCX/FRX/LBX/MPR/QPR/SPR actually has a + * chance at being used properly later, + * but I don't think these two do! + THIS.cAppFileName = "" + ENDIF + ENDIF + + * FOR liLevel = 256 TO 1 STEP -1 && 256 = twice the nested programs currently allowed! + FOR liLevel = PROGRAM(-1) TO 1 STEP -1 + lcSys16 = UPPER(SYS(16,liLevel)) + IF INLIST(RIGHT(lcSys16,3),"APP","EXE","DLL") + THIS.cClassContainerFileName = lcSys16 + EXIT + ENDIF + ENDFOR + + RETURN (THIS.IsErrorFree()) + + + ENDPROC + + PROCEDURE setcurrentuser && Finds the current user and sets up the app to deal with the current user (permissions, options, favorites, and macros may all change per user). + LPARAMETERS tlChangeUser + ASSERT VARTYPE(tlChangeUser) = "L" + LOCAL llOpenedTable, llSuccess + + THIS.ClearLastError() + + IF NOT USED(THIS.cUserTableAlias) + USE (THIS.cUserTableName) IN 0 AGAIN SHARED ALIAS (THIS.cUserTableAlias) + IF NOT (THIS.IsErrorFree()) + RETURN .F. + ENDIF + llOpenedTable = .T. + ENDIF + + IF THIS.lUserPreferences + + IF EMPTY(THIS.cCurrentUser) OR tlChangeUser + llSuccess = THIS.DoUserLogIn() + ELSE + llSuccess = THIS.SeekCurrentUser() + ENDIF + ELSE + * we are using a global set of preferences + * to cover all users + THIS.SeekDefaultUser() + llSuccess = .T. + ENDIF + + IF llSuccess + THIS.cCurrentUser = ; + EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableIDField) + THIS.iCurrentUserLevel = ; + EVAL(THIS.cUserTableAlias+"."+THIS.cUserTableLevelField) + + THIS.SetUserPermissions() && abstract in the base + + THIS.FillUserOptionsArray() + THIS.ApplyGlobalUserOptions() + THIS.SetCurrentUserFavoriteIDs(.NULL.) + IF THIS.lReadEvents + THIS.SetMacros() + ENDIF + ENDIF + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + RETURN llSuccess + + ENDPROC + + PROCEDURE setcurrentuserfavoriteids && Saves and restores THIS.cCurrentUserFavoriteIDs information to UserFave memo field in user table. This memo field also contains date information, so user can opt to clear favorites list if metatable has changed since user has identified favorites. + LPARAMETERS tcNewVal + + LOCAL llOpenedTable, lcMetaTableLastUpdated, lcNewVal, ; + laFavorites[1], liVal + + lcNewVal = "" + + THIS.ClearLastError() + IF NOT USED(THIS.cUserTableAlias) + USE (THIS.cUserTableName) ALIAS (THIS.cUserTableAlias) SHARED AGAIN IN 0 + llOpenedTable = .T. + ENDIF + + IF THIS.IsErrorFree() + IF THIS.lUserPreferences + THIS.SeekCurrentUser() + ELSE + THIS.SeekDefaultUser() + ENDIF + ENDIF + + IF THIS.IsErrorFree() + IF VARTYPE(tcNewVal) # "C" + * assignment to NULL while setting up a new user, + * or for some other reason improperly initialized, so + * refresh from the current or default record, + * checking lupdate and lastrefresh first + * set to "" if no good, with message + IF TYPE(THIS.cUserTableAlias+".UserFave") = "M" AND ; + NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserFave")) + + IF (ALINES(laFavorites,EVAL(THIS.cUserTableAlias+".UserFave"),.T.) > 1) AND ; + (TYPE(laFavorites[1])= "N") + + IF DTOS(LUPDATE(THIS.cUserTableAlias)) # laFavorites[1] + * the meta table has been edited + IF (MESSAGEBOX(APP_META_TABLE_CHANGED_LOC, ; + MB_YESNO+MB_ICONEXCLAMATION, ; + THIS.cCaption) = IDYES) + REPLACE (THIS.cUserTableAlias+".UserFave") WITH "" ; + IN (THIS.cUserTableAlias) + ELSE + * change the datestamp so they don't get asked again + lcNewVal = EVAL(THIS.cUserTableAlias+".UserFave") + lcNewVal = DTOS(LUPDATE(THIS.cUserTableAlias))+ ; + SUBSTR(lcNewVal,AT(CHR(13),lcNewVal)) + REPLACE (THIS.cUserTableAlias+".UserFave") WITH lcNewVal ; + IN (THIS.cUserTableAlias) + lcNewVal = "" + ENDIF + ENDIF + IF NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserFave")) + FOR liVal = 2 TO ALEN(laFavorites) + IF NOT EMPTY(laFavorites[liVal]) + lcNewVal = lcNewVal + CHR(13)+laFavorites[liVal] + ENDIF + ENDFOR + ENDIF + ELSE + MESSAGEBOX(APP_USER_FAVES_CORRUPT_LOC, ; + MB_ICONSTOP, ; + THIS.cCaption) + REPLACE (THIS.cUserTableAlias+".UserFave") ; + WITH "" IN (THIS.cUserTableAlias) + ENDIF + + ENDIF + ELSE + * store the new string and the meta table lupdate, + * back to the current user in the table, or clear the entry + IF THIS.IsErrorFree() + IF NOT EMPTY(tcNewVal) + REPLACE (THIS.cUserTableAlias+".UserFave") ; + WITH DTOS(LUPDATE(THIS.cUserTableAlias))+ ; + tcNewVal ; + IN (THIS.cUserTableAlias) + lcNewVal = tcNewVal + ELSE + REPLACE (THIS.cUserTableAlias+".UserFave") ; + WITH "" IN (THIS.cUserTableAlias) + ENDIF + ENDIF + ENDIF + + ENDIF + + THIS.cCurrentUserFavoriteIDs = lcNewVal + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + THIS.RefreshFavoritePopup() + + + ENDPROC + + PROCEDURE setdatasessionenvironment && Sets a specified data session to a default set of SETs, which you place in the SetDataSessionSets for use by any form or session you want. + LPARAMETERS tiSessionID + LOCAL liSessionID + liThisSessionID = SET("DATASESSION") + IF VARTYPE(tiSessionID) = "N" + SET DATASESSION TO (tiSessionID) + ENDIF + + THIS.SetDataSessionSets() + + SET DATASESSION TO (liThisSessionID) + + + ENDPROC + + PROCEDURE setdatasessionsets && Contains a default list of data-session-related SETs so you can easily invoke this list within any form or datasesion. + SET MULTILOCKS ON + SET TALK OFF + * .... + + + ENDPROC + + PROCEDURE setenvironment && Sets up certain global attributes, such as screen or frame characteristics, ON SHUTDOWN, ON ERROR, and macros for use during the life of the app. Does *nothing* if not a ReadEvents app. + THIS.ClearLastError() + + IF THIS.lReadEvents + + lcTemp = THIS.cReference+".OnShutdown()" + ON SHUTDOWN &lcTemp + lcTemp = THIS.cReference+".Error(ERROR(),PROGRAM(),LINENO())" + ON ERROR &lcTemp + + IF VARTYPE(THIS.cMacKey) = "C" + lcTemp = THIS.cMacKey + SET MACKEY TO &lcTemp + ELSE + SET MACKEY TO + ENDIF + + CLEAR MACROS + + ENDIF + + IF THIS.lNoScreenDuringApp + + THIS.SetScreenAttributes(.F.) + + * you always have the option to turn off _SCREEN, + * in any type of app, although you should use + * this ability sparingly if you are non-ReadEvents! + * This ability is placed outside the CASE statement + * below because the various permutations -- + * readevents top form in a development environment, + * ActiveDoc from which environment, even a special + * type of server that you instantiate and "takes over" + * temporary -- can't really be predicted. + * Since original state will be restored at cleanup, + * this isn't a risk, but the option is still .F. by + * default because you should think before implementing + * it . + + ENDIF + + DO CASE + + CASE VARTYPE(THIS.oFrame) = "O" + + THIS.SetFrameAttributes() + + CASE THIS.lReadEvents AND (NOT THIS.lNoScreenDuringApp) + + THIS.SetScreenAttributes(.T.) + + OTHERWISE + + * hands off! + + ENDCASE + + RETURN THIS.IsErrorFree() + + + ENDPROC + + PROCEDURE setframeattributes && Applies application cCaption and cIcon to the MDI frame, as well as the appropriate backcolor for an MDI frame window. + IF VARTYPE(THIS.oFrame) # "O" + ** shouldn't happen + RETURN + ENDIF + + THIS.oFrame.BackColor = THIS.cusWindowHandler.iMDIWorkSpaceColor + THIS.oFrame.Icon = THIS.cIcon + THIS.oFrame.Caption = THIS.cCaption + + + ENDPROC + + PROCEDURE sethtmlclass && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes. + LPARAMETERS tcSource, tlTable + + ENDPROC + + PROCEDURE sethtmlstyleid && Abstract. Takes parameters tcSource (report form or alias/table), tlTable, so you can decide what HTMLClass is appropriate. Passed to GENHTML via _outputdialog attributes. + LPARAMETERS tcSource, tlTable + + ENDPROC + + PROCEDURE setmacros && Saves and restores a set of macros using the user table. Synchronizes enabling of bars on the macro-handling popup, using THIS.cMacroPopupName, depending on current set of user macros. + LPARAMETERS tlSave + + IF VARTYPE(tlSave) # "L" OR (NOT THIS.lReadEvents) + RETURN + ENDIF + + LOCAL llOpenedTable, liBar, llSuccess + + THIS.ClearLastError() + + IF NOT USED(THIS.cUserTableAlias) + USE (THIS.cUserTableName) ALIAS (THIS.cUserTableAlias) SHARED AGAIN IN 0 + llOpenedTable = .T. + ENDIF + + IF THIS.lUserPreferences + THIS.SeekCurrentUser() + ELSE + THIS.SeekDefaultUser() + ENDIF + + IF THIS.IsErrorFree() + + IF TYPE(THIS.cUserTableAlias+".UserMacro") = "M" + DO CASE + CASE tlSave + SAVE MACROS TO MEMO (THIS.cUserTableAlias+".UserMacro") + llSuccess = .T. + CASE NOT EMPTY(EVAL(THIS.cUserTableAlias+".UserMacro")) + llSuccess = .T. + CLEAR MACROS + RESTORE MACROS FROM MEMO (THIS.cUserTableAlias+".UserMacro") + OTHERWISE + CLEAR MACROS + * can't restore from empty field + ENDCASE + ENDIF + + ENDIF + + IF llOpenedTable + USE IN (THIS.cUserTableAlias) + ENDIF + + IF TYPE("CNTBAR(THIS.cMacroPopupName)") = "N" + FOR liBar = 1 TO CNTBAR(THIS.cMacroPopupName) + IF UPPER(APP_MACRO_RESTORE_LOC) $ UPPER(BARPROMPT(liBar,THIS.cMacroPopupName)) + SET SKIP OF BAR liBar OF (THIS.cMacroPopupName) (NOT llSuccess) + EXIT + ENDIF + ENDFOR + ENDIF + + ENDPROC + + PROCEDURE setscreenattributes && Sets up screen attributes, including visibility, caption and icon, and system toolbars, for a read events app that does not take place in its own topform MDI frame. + LPARAMETERS tlOn + + LOCAL loTemp + + loTemp = THIS.AddCollaborator("_SysToolbars","_app",,".T.") + + loTemp = THIS.AddCollaborator("_ObjectState","_app",,"_SCREEN") + + IF VARTYPE(loTemp) = "O" + + IF tlOn + + IF NOT EMPTY(THIS.cCaption) + + loTemp.Set("Caption", THIS.cCaption, .T.) + + ENDIF + + loTemp.Set("Icon",THIS.cIcon, .T.) + + ENDIF + + loTemp.Set("Visible",tlOn,.T.) + + + ELSE + * this should never happen, but JIC, we'd + * have a hard time debugging if we didn't do this! + + IF tlOn AND NOT _SCREEN.Visible + _SCREEN.Visible = .T. + ENDIF + + * notice I don't bother turning it off in the ! tlOn case. + + ENDIF + + + + + + ENDPROC + + PROCEDURE setuserpermissions && Abstract in the base. Called when a new user logs on. Designed to use iCurrentUserLevel property, derived from user table, to maintain groups. Menu items would be added/substracted/enabled/disabled based on group level at this time. + * This method is abstract in the base, + * meant to utilize iCurrentUserLevel property to maintain groups + ENDPROC + + PROCEDURE show && Sets up visible aspects of the application and, if successful, Activate()s the application, at startup. + LOCAL llSuccess + + llSuccess = THIS.SaveEnvironment() + + IF llSuccess + + llSuccess = THIS.ValidateMetaTable() + + ENDIF + + IF llSuccess + + llSuccess = THIS.CreateFrame() + + ENDIF + + IF llSuccess AND NOT EMPTY(APP_LOADING_LOC) + + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.Show() + ENDIF + + WAIT WINDOW NOWAIT ; + LEFT(APP_LOADING_LOC,254) + + ENDIF + + IF llSuccess + + llSuccess = THIS.ResetFormsCollection() + + ENDIF + + IF llSuccess + + llSuccess = THIS.CreateCollaborators() + + ENDIF + + IF llSuccess + + llSuccess = THIS.HandleProjectWindow() + + ENDIF + + IF llSuccess + + llSuccess = THIS.SetEnvironment() + + ENDIF + + IF llSuccess + + THIS.cUserTableAlias = JUSTSTEM(THIS.cUserTableName) + llSuccess = NOT EMPTY(THIS.cUserTableAlias) + + ENDIF + + IF llSuccess + + llSuccess = THIS.SetCurrentUser() + + ENDIF + + IF llSuccess + + llSuccess = THIS.ShowStartupElements() + + ENDIF + + WAIT CLEAR + + IF llSuccess + + llSuccess = THIS.Activate() + + ENDIF + + THIS.RestoreEnvironment() + + RETURN llSuccess + + ENDPROC + + PROCEDURE showstartupelements && Sets up top form MDI frame, startup menu, startup toolbar, screen attributes, and startup form. + LOCAL llSuccess + + THIS.lNoInterrupt = .T. + + IF VARTYPE(THIS.oFrame) = "O" + THIS.oFrame.Show() + ENDIF + + llSuccess = ; + (EMPTY(THIS.cStartupToolbarClass) OR ; + (NOT EMPTY(THIS.DoToolbar( THIS.cStartupToolbarClassLib,THIS.cStartupToolbarClass))) ) + + IF llSuccess AND (NOT EMPTY(THIS.cStartupMenu)) + + DO CASE + + CASE VARTYPE(THIS.oFrame) = "O" + + llSuccess = THIS.DoMenu(THIS.cStartupMenu, .T.) + + CASE THIS.lReadEvents + + llSuccess = THIS.DoMenu(THIS.cStartupMenu) + + OTHERWISE + + * append type + IF EMPTY(THIS.cStartupMenuPad) + llSuccess = THIS.DoMenu(THIS.cStartupMenu) + * it's hard to believe that anybody is going to take over the + * menu for a non-read-events app, but it could happen + ELSE + llSuccess = (NOT EMPTY(THIS.DoContextMenu(THIS.cStartupMenu, ; + THIS.cStartupMenuPad, ; + THIS.cStartupMenuPopup))) + * this one returns a # so we can't do the exact same llSuccess check + ENDIF + + ENDCASE + + ENDIF + + + IF llSuccess + + IF (VARTYPE(THIS.oFrame) = "O") + * if we closed screen during a topform-in-development-version + * app, the frame is likely behind another Windows app at this point... + + THIS.oFrame.Show() + + ELSE + + SET MESSAGE TO && for neatness' sake + + ENDIF + + THIS.lNoInterrupt = .F. + IF THIS.lStartupForm + THIS.DoStartupForm() + ENDIF + + ENDIF + + + + RETURN llSuccess + + ENDPROC + + PROCEDURE showtablefinddialog && Instantiates _FindDialog class, in advanced or standard mode, depending on THIS.lFindOnMultipleTables value. (Advanced mode allows the user to choose between all open aliases in a data session.) + + LOCAL loForm, llInterrupted + loForm = THIS.DoModalDialogClass("_FindDialog", "_table.vcx", .T.) + IF VARTYPE(loForm) = "O" + loForm.lAdvanced = THIS.lFindOnMultipleTables + + llInterrupted = (NOT THIS.lNoInterrupt) + IF llInterrupted + THIS.lNoInterrupt = .T. + ENDIF + + loForm.Show(1) + + IF llInterrupted + THIS.lNoInterrupt = .F. + ENDIF + + ELSE + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE showtablegotodialog && Instantiates _GoToDialog class. + LOCAL llReturn + + llReturn = THIS.DoModalDialogClass("_GoTodialog", "_table.vcx") + + RETURN llReturn + + + ENDPROC + + PROCEDURE showtablesetfilterdialog && Instantiates _FilterExpr class, in advanced or standard depending on THIS.lUseGetExpr value. (Standard mode uses _FilterDialog as a subsidiary dialog, Advanced uses _GETEXPR.) + LOCAL loForm + + THIS.cusTableNav.SetToActiveSession() + loForm = THIS.DoModalDialogClass("_FilterExpr", "_table.vcx", .T.) + IF VARTYPE(loForm) = "O" + loForm.lAdvanced = THIS.lUse_GETEXPR + loForm.Show(1) + + ELSE + RETURN .F. + ENDIF + + + ENDPROC + + PROCEDURE storepassword && Stores the encrypted value of a new password to the current record in the user table. + LPARAMETERS tcValueToStore + + IF (NOT THIS.lUserPreferences) OR ; + NOT USED(THIS.cUserTableAlias) OR ; + VARTYPE(tcValueToStore) # "C" + + RETURN .F. + + ENDIF + + REPLACE UserPass WITH ; + (THIS.CreateStoredPassword(tcValueToStore)) IN ; + (THIS.cUserTableAlias) + + ENDPROC + + PROCEDURE validatemetatable && Ensures that a table contains a valid and available table for documents registry. Validates THIS.cMetatable, if used, on startup. + LPARAMETERS tcTable, tlOmitFeedback + + IF EMPTY(tcTable) AND EMPTY(THIS.cMetaTable) + RETURN .T. + ENDIF + + LOCAL lcTable, lcMessage, lcAlias, liSelect, ; + llReturn, liTagCount ,laRequired[1], laKeys[1], ; + liFound, llExactOff + + lcAlias = "M"+SYS(2015) + + THIS.ClearLastError() + + IF EMPTY(tcTable) + USE (THIS.cMetaTable) ALIAS (lcAlias) EXCLU IN 0 + lcTable = THIS.cMetaTable + ELSE + USE (tcTable) ALIAS (lcAlias) EXCLU IN 0 + lcTable = tcTable + ENDIF + + llReturn = THIS.IsErrorFree() AND USED(lcAlias) + + IF NOT llReturn + lcMessage = APP_META_UNAVAILABLE_LOC+; + CHR(13) + CHR(13)+ ; + lcTable + ENDIF + + IF llReturn + llReturn = ; + TYPE(lcAlias+".DOC_TYPE") = "C" AND ; + TYPE(lcAlias+".DOC_DESCR") = "C" AND ; + TYPE(lcAlias+".DOC_EXEC") = "M" AND ; + TYPE(lcAlias+".DOC_CLASS") = "M" AND ; + TYPE(lcAlias+".DOC_NEW") = "L" AND ; + TYPE(lcAlias+".DOC_OPEN") = "L" AND ; + TYPE(lcAlias+".DOC_SINGLE") = "L" AND ; + TYPE(lcAlias+".DOC_NOSHOW") = "L" AND ; + TYPE(lcAlias+".DOC_WRAP") = "L" AND ; + TYPE(lcAlias+".DOC_GO") = "L" AND ; + TYPE(lcAlias+".DOC_NAV") = "L" AND ; + TYPE(lcAlias+".ALT_EXEC") = "M" + * the last two fields in the delivered metatable + * are non-required fields + IF NOT llReturn + + lcMessage = APP_META_WRONGFORMAT_LOC + ; + CHR(13)+CHR(13)+ ; + lcTable + ENDIF + ENDIF + + IF llReturn + + IF (SET("EXACT") = "OFF") + SET EXACT ON + llExactOff = .T. + ENDIF + + liSelect = SELECT() + SELECT (lcAlias) + + * check for required tags... + + DIME laRequired[5] + laRequired[1] = "DOC_OPEN" + laRequired[2] = "DOC_NEW" + laRequired[3] = "DOC_DESCR" + laRequired[4] = "DOC_TYPE" + laRequired[5] = "DELETED()" + + DIME laKeys[TAGCOUNT()] + + FOR liTagCount = 1 TO TAGCOUNT() + laKeys[liTagCount] = UPPER(KEY(liTagCount)) + ENDFOR + + FOR liTagCount = 1 TO ALEN(laRequired) + liFound = ASCAN(laKeys,UPPER(laRequired[liTagCount])) + IF liFound = 0 + llReturn = .F. + EXIT + ENDIF + ENDFOR + + IF NOT llReturn + lcMessage = APP_META_MISSINGINDEX_LOC + CHR(13) + ; + laRequired[1]+ CHR(13)+ ; + laRequired[2]+ CHR(13)+ ; + laRequired[3]+ CHR(13) + ; + laRequired[4]+ CHR(13) + ; + laRequired[5] + ENDIF + + IF llExactOff + SET EXACT OFF + ENDIF + SELECT (liSelect) + + ENDIF + + IF NOT (llReturn OR tlOmitFeedback) + IF INLIST(_VFP.Startmode, 0, 4) + MESSAGEBOX(lcMessage,MB_ICONSTOP,THIS.cCaption) + ELSE + THIS.cusError.RecordServerError(; + THIS.cCaption+": "+lcMessage) + ENDIF + ENDIF + + IF USED(lcAlias) + USE IN (lcAlias) + ENDIF + + RETURN llReturn + + + ENDPROC + + PROCEDURE cusError.Error + LPARAMETERS nError, cMethod, nLine + THIS.Parent.iLastError = nError + DODEFAULT(nError, cMethod, nLine) + + + ENDPROC + + PROCEDURE cusError.getmessageboxtitle + LOCAL lcTitle, lcCaption + lcCaption = THIS.Parent.cCaption + lcTitle = DODEFAULT() + IF NOT EMPTY(lcCaption) + lcTitle = ALLTR(lcCaption+" "+lcTitle) + ENDIF + RETURN lcTitle + + + ENDPROC + + PROCEDURE cusError.setlog + LPARAMETERS tcTableName, tcAlias + + DODEFAULT(THIS.Parent.cErrorLogTableName,tcAlias) + + + + ENDPROC + + PROCEDURE tmrRefresh.Timer + IF THIS.Parent.lNoInterrupt + * shouldn't happen + RETURN + ENDIF + DODEFAULT() + + THIS.Parent.RefreshToolbars() + + LOCAL loMediator, loForm, llBusy + IF TYPE("_SCREEN.ActiveForm") = "O" + loForm = _SCREEN.ActiveForm + ELSE + STORE .F. TO THIS.Parent.lGoMenu, THIS.Parent.lNavToolbar + RETURN + ENDIF + IF TYPE("loForm.Parent") = "O" AND ; + INLIST(loForm.Parent.WindowType,WINDOWTYPE_MODAL, WINDOWTYPE_READMODAL) + RETURN + ENDIF + IF loForm.WindowType = WINDOWTYPE_MODAL + RETURN + ENDIF + + loMediator = THIS.Parent.GetFormMediatorRef(_SCREEN.ActiveForm) + IF VARTYPE(loMediator) = "O" + THIS.Parent.lGoMenu = loMediator.lGoMenu + THIS.Parent.lNavToolbar = loMediator.lNavToolbar + ELSE + STORE .F. TO THIS.Parent.lGoMenu, THIS.Parent.lNavToolbar + ENDIF + + + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _changepassword AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default password-changing dialog + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="txtPassword" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblPassword" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtConfirmPassword" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblConfirmPassword" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: savepassword && Confirms and stores new password for the user. + *p: oapp + * + + * + DoCreate = .T. + Height = 80 + Name = "_changepassword" + oapp = .NULL. + Width = 390 + * + + ADD OBJECT 'cmdCancel' AS _commandbutton WITH ; + Cancel = .T., ; + Caption = "\ + + ADD OBJECT 'cmdOK' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'lblConfirmPassword' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Confirm Password:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 15, ; + Left = 12, ; + Name = "lblConfirmPassword", ; + TabIndex = 16, ; + Top = 47, ; + Width = 89 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblPassword' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "New Password:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 15, ; + Left = 12, ; + Name = "lblPassword", ; + TabIndex = 15, ; + Top = 15, ; + Width = 76 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'txtConfirmPassword' AS _textbox WITH ; + FontBold = .T., ; + FontName = "Courier New", ; + FontSize = 9, ; + Height = 24, ; + Left = 118, ; + Name = "txtConfirmPassword", ; + PasswordChar = "*", ; + SelectOnEntry = .T., ; + TabIndex = 6, ; + Top = 43, ; + Value = (""), ; + Width = 174 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" /> + + ADD OBJECT 'txtPassword' AS _textbox WITH ; + FontBold = .T., ; + FontName = "Courier New", ; + FontSize = 9, ; + Height = 24, ; + Left = 118, ; + Name = "txtPassword", ; + PasswordChar = "*", ; + SelectOnEntry = .T., ; + TabIndex = 5, ; + Top = 11, ; + Value = (""), ; + Width = 174 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" /> + + PROCEDURE applyappattributes + LPARAMETERS toApp + LOCAL llSuccess + llSuccess = DODEFAULT(toApp) + IF llSuccess + IF USED(toApp.cUserTableAlias) + THIS.Caption = toApp.cCaption + " " + CHANGEPASSWORD_LOC + THIS.oApp = toApp + ELSE + llSuccess = .F. + ENDIF + ENDIF + IF NOT (llSuccess AND THIS.oApp.IsErrorFree()) + THIS.Release() + ENDIF + + ENDPROC + + PROCEDURE Destroy + DODEFAULT() + THIS.oApp = .NULL. + ENDPROC + + PROCEDURE KeyPress + LPARAMETERS nKeyCode, nShiftAltCtrl + IF nKeyCode = 27 + THIS.Release() + ENDIF + + + ENDPROC + + PROCEDURE savepassword && Confirms and stores new password for the user. + IF ALLTRIM(THIS.txtConfirmPassword.Value) == ALLTRIM(THIS.txtPassword.Value) + THIS.oApp.StorePassword(ALLTRIM(THIS.txtPassword.Value)) + MESSAGEBOX(OPTIONS_PASSWORD_CONFIRMED_LOC,0,THIS.Caption) + STORE SPACE(30) TO THIS.txtConfirmPassword.Value, THIS.txtPassword.Value + ENDIF + + + ENDPROC + + PROCEDURE cmdCancel.Click + THISFORM.Release() + + ENDPROC + + PROCEDURE cmdOK.Click + THISFORM.SavePassword() + THISFORM.Release() + ENDPROC + + PROCEDURE txtConfirmPassword.InteractiveChange + THISFORM.cmdOK.Enabled = (ALLTRIM(THISFORM.txtPassword.Value) == ALLTRIM(THIS.Value)) + ENDPROC + + PROCEDURE txtPassword.InteractiveChange + THISFORM.cmdOK.Enabled = (ALLTRIM(THISFORM.txtConfirmPassword.Value) == ALLTRIM(THIS.Value)) + ENDPROC + +ENDDEFINE + +DEFINE CLASS _dialog AS _form OF "..\ffc\_base.vcx" && superclass for framework-supplied default dialogs + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_framewk.h" + * + *m: adjustforsystemfontsize && Handles large font use for any dialogs that are supplied with the framework. Since the framework visual elements default to MS San Serif, these dialogs switch to Arial if the user is in large font mode. + *m: applyappattributes && Takes a reference to the application object and applies app session-specific attributes, caption, and icon to this dialog. + *p: lsingleton && Indicates that this dialog should re-show rather re-instantiate, if invoked when it already exists. + * + + * + AutoCenter = .T. + BorderStyle = 0 + Caption = ("") + DoCreate = .T. + Height = 250 + Icon = ..\model\ + MaxButton = .F. + MinButton = .F. + Name = "_dialog" + Width = 375 + * + + PROCEDURE adjustforsystemfontsize && Handles large font use for any dialogs that are supplied with the framework. Since the framework visual elements default to MS San Serif, these dialogs switch to Arial if the user is in large font mode. + LOCAL lcStandardFont, loControl + + IF FONTMETRIC(1, 'MS Sans Serif', 8, '') # 13 OR ; + FONTMETRIC(4, 'MS Sans Serif', 8, '') # 2 OR ; + FONTMETRIC(6, 'MS Sans Serif', 8, '') # 5 OR ; + FONTMETRIC(7, 'MS Sans Serif', 8, '') # 11 + + lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME) + + + FOR EACH loControl IN THIS.Controls + + DO CASE + CASE PEMSTATUS(loControl,"FontName",5) AND ; + UPPER(loControl.FontName) == lcStandardFont + + loControl.FontName = DIALOG_LARGEFONT_NAME + + CASE TYPE("loControl.Buttons(1)") = "O" + + loControl.SetAll("FontName",DIALOG_LARGEFONT_NAME) + + OTHERWISE + + * note: I am *not* going to do this recursively, + * although I would in other instances. + * none of the _framewk dialogs based on + * _dialog class use containers extensively, + * and if some were added it would be unwise + * for me to assume that these containers should + * be unilaterally altered by this code. + * The best thing to do would be to add a + * FontName property to such containers, with + * an assign method so that the change could + * be applied appropriately to the members of + * said container. + + ENDCASE + + ENDFOR + + ENDIF + + + ENDPROC + + PROCEDURE applyappattributes && Takes a reference to the application object and applies app session-specific attributes, caption, and icon to this dialog. + LPARAMETERS toApp + + IF VARTYPE(toApp) = "O" + IF EMPTY(THIS.Caption) + THIS.Caption = toApp.cCaption + " " + THIS.Caption + ENDIF + IF EMPTY(THIS.Icon) + THIS.Icon = toApp.cIcon + ENDIF + THIS.AdjustForSystemFontSize() + toApp.ApplyUserOptsForSession(THIS.DataSessionID) + ELSE + RETURN .F. + ENDIF + + + ENDPROC + + PROCEDURE Load + DODEFAULT() + SET TALK OFF + IF THIS.lSingleton + LOCAL loForm, llFound + FOR EACH loForm IN _SCREEN.Forms + IF (loForm.ClassLibrary == THIS.ClassLibrary AND ; + loForm.Class == THIS.Class ) AND ; + loForm.Visible + llFound = .T. + loForm.Show() + loForm.Autocenter = loForm.AutoCenter + EXIT + ENDIF + ENDFOR + IF llFound + RETURN .F. + ENDIF + ENDIF + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _documentpicker AS _dialog OF "_framewk.vcx" && superclass for framework-supplied dialogs manipulating the metatable of documents + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lstDocuments" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: execdocument && Abstract, called when the user presses OK or makes a selection from the document list. + *m: filldocumentsarray && Abstract, called on startup to dimension and fill the array that supplies the listbox with values and provides potential action parameters when the user chooses from the listbox. + *m: setdialogsizeparameters && Sets initial, minimum, and maximum dialog size based on number of items in the listbox. + *p: lnew && Toggles the dialog between two states. + *p: lsorted && Determines whether items in list will be sorted by visible field when descendent classes' FillDocumentsArray method prepares contents + *p: oapp + *a: adocuments[1,7] + * + + * + BorderStyle = 3 + Caption = "Choose a document" + DataSession = 2 + DoCreate = .T. + Height = 229 + KeyPreview = .T. + lsorted = .T. + Name = "_documentpicker" + oapp = .NULL. + Width = 328 + * + + ADD OBJECT 'cmdCancel' AS _commandbutton WITH ; + Cancel = .T., ; + Caption = "\ + + ADD OBJECT 'cmdOK' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'lstDocuments' AS _listbox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 204, ; + IntegralHeight = .T., ; + ItemTips = .T., ; + Left = 12, ; + Name = "lstDocuments", ; + RowSourceType = 5, ; + Top = 12, ; + Value = 1, ; + Width = 230 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="listbox" /> + + PROCEDURE applyappattributes + LPARAMETERS toapp + + IF DODEFAULT(toApp) + THIS.SetDialogSizeParameters() + THIS.Resize() + ENDIF + + + + ENDPROC + + PROCEDURE Destroy + DODEFAULT() + THIS.oApp = .NULL. + ENDPROC + + PROCEDURE execdocument && Abstract, called when the user presses OK or makes a selection from the document list. + ENDPROC + + PROCEDURE filldocumentsarray && Abstract, called on startup to dimension and fill the array that supplies the listbox with values and provides potential action parameters when the user chooses from the listbox. + ENDPROC + + PROCEDURE Init + LPARAMETERS toApp, tlNew + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + LOCAL laTemp[1], llReturn + + ASSERT VARTYPE(tlNew) = "L" + ASSERT TYPE("toApp.cMetaTable") = "C" AND ; + ACLASS(laTemp,toApp) > 0 AND ; + ASCAN(laTemp,"_APPLICATION") > 0 ; + MESSAGE DOCUMENTPICKER_NO_APP_LOC + + THIS.lNew = tlNew + + THIS.oApp = toApp + + DO CASE + + CASE EMPTY(toApp.cMetaTable) OR ; + (NOT THIS.FillDocumentsArray(toApp.GetResourceFileName(toApp.cMetaTable,".dbf"))) OR ; + VARTYPE(THIS.aDocuments[1,1]) # "C" + + MESSAGEBOX(DOCUMENTPICKER_NO_DOCUMENTS_LOC, ; + MB_ICONEXCLAMATION, ; + toApp.cCaption) + + CASE ALEN(THIS.aDocuments,1) = 1 + THIS.lstDocuments.RowSource = "THISFORM.aDocuments" + THIS.lstDocuments.Value = 1 + THIS.ExecDocument() + + OTHERWISE + llReturn = .T. + THIS.lstDocuments.RowSource = "THISFORM.aDocuments" + ENDCASE + + IF NOT llReturn + THIS.oApp = .NULL. + ENDIF + + RETURN llReturn + + ENDPROC + + PROCEDURE KeyPress + LPARAMETERS nKeyCode, nShiftAltCtrl + DO CASE + CASE nKeyCode = 27 + THIS.cmdCancel.Click() + NODEFAULT + CASE nKeyCode = 23 + THIS.cmdOK.Click() + NODEFAULT + OTHERWISE + ENDCASE + + ENDPROC + + PROCEDURE Load + DODEFAULT() + SET DELETED ON + ENDPROC + + PROCEDURE Resize + LOCAL lnMargin + + lnMargin = THIS.lstDocuments.Left + + STORE THIS.Width - (THIS.cmdCancel.Width + lnMargin ) TO ; + THIS.cmdCancel.Left, ; + THIS.cmdOK.Left + + STORE THIS.cmdCancel.Left - (lnMargin * 2) TO THIS.lstDocuments.Width + + lnMargin = THIS.lstDocuments.Top + + STORE THIS.Height - (lnMargin * 2) TO THIS.lstDocuments.Height + + + ENDPROC + + PROCEDURE setdialogsizeparameters && Sets initial, minimum, and maximum dialog size based on number of items in the listbox. + LOCAL liMaxRows, lnListRowHeight, lnListMaxHeight, lnListMinHeight, lnMargin + + liMaxRows = ALEN(THIS.aDocuments,1) + + lnMargin = THIS.lstDocuments.Top + + WITH THIS.lstDocuments + lnListRowHeight = FONTM(1,.FontName,.FontSize) + ; + FONTM(5,.FontName,.FontSize) + ; + FONTM(4,.FontName,.FontSize) + + lnListMaxHeight = MIN(lnListRowHeight * liMaxRows, ; + (SYSMETRIC(2) - lnMargin * 2)) + lnListMinHeight = lnListRowHeight * 2 + + IF NOT BETWEEN(.Height, lnListMinHeight, lnListMaxHeight) + .Height = MIN(lnListMaxHeight, .Height) + ENDIF + + ENDWITH + + + + THIS.MinWidth = THIS.Width + THIS.MinHeight = MAX(lnListMinHeight + (lnMargin * 2), ; + (THIS.cmdCancel.Top + THIS.cmdCancel.Height + lnMargin)) + THIS.MaxHeight = MAX(THIS.MinHeight, lnListMaxHeight + (lnMargin * 2)) + + THIS.Height = MAX(THIS.MinHeight,THIS.lstDocuments.Height + (lnMargin * 2)) + + lnMargin = THIS.lstDocuments.Left + + THIS.Width = THIS.lstDocuments.Width+THIS.cmdCancel.Width+ lnMargin * 3 + + + ENDPROC + + PROCEDURE cmdCancel.Click + THISFORM.Release() + ENDPROC + + PROCEDURE cmdOK.Click + IF NOT EMPTY(THISFORM.lstDocuments.Value) + THISFORM.ExecDocument() + ENDIF + THISFORM.Release() + + + ENDPROC + + PROCEDURE lstDocuments.DblClick + THISFORM.cmdOK.Click() + ENDPROC + + PROCEDURE lstDocuments.KeyPress + LPARAMETERS nKeyCode, nShiftAltCtrl + IF INLIST(nKeyCode,13,32) + THIS.DblClick() + NODEFAULT + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS _errorlogviewer AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default dialog to browse error log and add user notes to the log + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="pgfErrorLog" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfErrorLog.Page1.edtListing" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="pgfErrorLog.Page2.edtUserNotes" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtErrStamp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="spnNav" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdBrowseErrorLog" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="app_mediator" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: ctextdisplayfont_assign + *m: donologmessage + *p: calias + *p: ctextdisplayfont + *p: imargin + * + + * + BorderStyle = 3 + calias = ("ErrorLog") + DataSession = 2 + DoCreate = .T. + Height = 250 + imargin = 0 + lsingleton = .T. + Name = "_errorlogviewer" + ShowTips = .T. + TabIndex = 1 + Width = 375 + WindowState = 0 + * + + ADD OBJECT 'app_mediator' AS _formmediator WITH ; + Left = 48, ; + Name = "app_mediator", ; + Top = 36 + *< END OBJECT: ClassLib="_framewk.vcx" BaseClass="custom" /> + + ADD OBJECT 'cmdBrowseErrorLog' AS _commandbutton WITH ; + Caption = (""), ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 10, ; + Name = "cmdBrowseErrorLog", ; + Picture = graphics\browse.bmp, ; + TabIndex = 4, ; + ToolTipText = ("Browse the Error Log records"), ; + Top = 35, ; + Width = 24 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'pgfErrorLog' AS _pageframe WITH ; + ActivePage = 1, ; + ErasePage = .T., ; + Height = 252, ; + Left = 0, ; + Name = "pgfErrorLog", ; + PageCount = 2, ; + TabIndex = 1, ; + Top = 0, ; + Width = 377, ; + Page1.Caption = "\+ + ADD OBJECT 'pgfErrorLog.Page1.edtListing' AS _editbox WITH ; + DefLeft = , ; + FontCondense = .T., ; + FontName = "Courier New", ; + FontSize = 9, ; + Height = 180, ; + Left = (THISFORM.iMargin), ; + Name = "edtListing", ; + ToolTipText = ("Technical details of the error for you to tell the programmer"), ; + Top = 39, ; + Width = 367 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="editbox" /> + + ADD OBJECT 'pgfErrorLog.Page2.edtUserNotes' AS _editbox WITH ; + DefLeft = , ; + FontName = "Courier New", ; + Height = 180, ; + Left = (THISFORM.iMargin), ; + Name = "edtUserNotes", ; + ToolTipText = ("A place for you to write whatever might help the programmer fix the error"), ; + Top = 39, ; + Width = 367 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="editbox" /> + + ADD OBJECT 'spnNav' AS _spinner WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 352, ; + Name = "spnNav", ; + TabIndex = 3, ; + TabStop = .F., ; + ToolTipText = ("Move to a different Error Log record"), ; + Top = 36, ; + Width = 16 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="spinner" /> + + ADD OBJECT 'txtErrStamp' AS _textbox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 120, ; + Name = "txtErrStamp", ; + ReadOnly = .T., ; + TabIndex = 2, ; + TabStop = .F., ; + ToolTipText = ("Date and Time of this error"), ; + Top = 36, ; + Width = 228 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" /> + + PROCEDURE Activate + IF RECCOUNT(THIS.cAlias) < 2 + THIS.spnNav.Enabled = .F. + ELSE + STORE RECCOUNT(THIS.cAlias) TO ; + THIS.spnNav.SpinnerHighValue, THIS.spnNav.KeyboardHighValue + STORE 1 TO THIS.spnNav.SpinnerLowValue, THIS.spnNav.KeyboardLowValue + STORE RECNO(THIS.cAlias) TO THIS.spnNav.Value + ENDIF + THIS.Refresh() + + ENDPROC + + PROCEDURE applyappattributes + LPARAMETERS toApp + + LOCAL lcTable + + IF DODEFAULT(toApp) + + lcTable = toApp.cErrorLogTableName + IF EMPTY(lcTable) OR NOT FILE(lcTable) + THIS.DoNoLogMessage(ERRORVIEWER_UNAVAILABLE_LOC ) + RETURN .F. + ENDIF + + USE (lcTable) SHARED ALIAS (THIS.cAlias) IN 0 + + IF NOT USED(THIS.cAlias) + THIS.DoNoLogMessage(ERRORVIEWER_UNAVAILABLE_LOC ) + RETURN .F. + ENDIF + + IF EMPTY(RECCOUNT(THIS.cAlias)) + THIS.DoNoLogMessage(ERRORVIEWER_EMPTY_LOC ) + RETURN .F. + ENDIF + + GO BOTTOM + THIS.txtErrStamp.ControlSource=THIS.cAlias+".ErrStamp" + THIS.pgfErrorLog.Page1.edtListing.ControlSource = THIS.cAlias+".Listing" + THIS.pgfErrorLog.Page2.edtUserNotes.ControlSource = THIS.cAlias+".UserNotes" + THIS.app_mediator.LoadApp(toApp.cReference) + * the error log viewer is different from other + * _dialog descendents in that it's not modal, + * so it deserves a mediator for later use. + + ELSE + + RETURN .F. + + ENDIF + + + + + ENDPROC + + PROCEDURE ctextdisplayfont_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) = "C" + THIS.cTextDisplayFont = tvNewVal + STORE tvNewVal TO THIS.pgfErrorLog.Page1.edtListing.FontName, ; + THIS.pgfErrorLog.Page2.edtUserNotes.FontName + ENDIF + + ENDPROC + + PROCEDURE Destroy + IF (NOT EMPTY(THIS.cAlias)) AND USED(THIS.cAlias) + USE IN (THIS.cAlias) + ENDIF + + + + ENDPROC + + PROCEDURE donologmessage + LPARAMETERS tcMessage + ?? CHR(7) + MESSAGEBOX(tcMessage,MB_ICONINFORMATION,THIS.Caption) + RETURN + ENDPROC + + PROCEDURE Init + IF DODEFAULT() + THIS.MinHeight = THIS.Height + THIS.MinWidth = THIS.Width + THIS.iMargin = SYSMETRIC(12) + STORE THIS.iMargin TO ; + THIS.pgfErrorLog.Page1.edtListing.Left, ; + THIS.pgfErrorLog.Page2.edtUserNotes.Left + THIS.Resize() + ELSE + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE Resize + WITH THIS.pgfErrorLog + + .Height = THIS.Height + .Width = THIS.Width + THIS.txtErrStamp.Left = (THIS.Width - THIS.txtErrStamp.Width)/2 + THIS.spnNav.Left = THIS.txtErrStamp.Left+THIS.txtErrStamp.Width + + STORE .PageHeight - ; + (THIS.pgfErrorLog.Page1.edtListing.Top+ ; + THIS.iMargin) TO ; + THIS.pgfErrorLog.Page1.edtListing.Height, ; + THIS.pgfErrorLog.Page2.edtUserNotes.Height + + STORE THIS.Width - (THIS.iMargin*2) TO ; + .Page1.edtListing.Width, ; + .Page2.edtUserNotes.Width + + ENDWITH + + + + ENDPROC + + PROCEDURE app_mediator.dosessionsets + LPARAMETERS toApp + + LOCAL loApp + + IF VARTYPE(toApp) = "O" + loApp = toApp + ELSE + loApp = THIS.GetAppRef() + ENDIF + + IF VARTYPE(loApp) = "O" + DODEFAULT(loApp) + THISFORM.cTextDisplayFont = loApp.cTextDisplayFont + ENDIF + loApp = NULL + + + ENDPROC + + PROCEDURE cmdBrowseErrorLog.Click + LOCAL lcFrame, loApp, iSelect && jic + iSelect = SELECT() + SELECT (THISFORM.cAlias) + loApp = THISFORM.app_mediator.GetAppRef() + IF TYPE("loApp.oFrame.Name") = "C" + lcFrame = " IN WINDOW (loApp.oFrame.Name) " + ELSE + lcFrame = " IN SCREEN " + ENDIF + BROWSE FIELDS ; + errstamp :H= "Error Date and Time", ; + field2 = LEFT(Listing, 20) :H="Tech Listing", ; + field3 = LEFT(UserNotes,10) :H= "Your Notes Go Here" ; + WINDOW (THISFORM.Name) ; + FONT (THISFORM.cTextDisplayFont) ; + &lcFrame + THISFORM.Refresh() + THISFORM.spnNav.Value = RECNO() + SELECT (iSelect) + loApp = NULL + ENDPROC + + PROCEDURE spnNav.DownClick + IF THIS.Value = THIS.SpinnerLowValue + ?? CHR(7) + ENDIF + THISFORM.cmdBrowseErrorLog.SetFocus() + ENDPROC + + PROCEDURE spnNav.InteractiveChange + GO THIS.Value IN (THISFORM.cAlias) + THISFORM.Refresh() + ENDPROC + + PROCEDURE spnNav.UpClick + IF THIS.Value = THIS.SpinnerHighValue + ?? CHR(7) + ENDIF + THISFORM.cmdBrowseErrorLog.SetFocus() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _favoritepicker AS _documentpicker OF "_framewk.vcx" && superclass for framework-supplied default dialog to add items to the Favorites menu (in New mode) or execute a document at startup ("quick start") + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdBrowse" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdRemove" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: refreshbuttons + *m: refreshfavoriteids && Adds to the app cCurrentUserFavoriteIDs list when the user makes a new choice. + *m: removedocument + *p: lallowfilebrowsing && Determines whether the user is allowed to pick files from disk for QuickStart or Favorites use. + * + + * + DoCreate = .T. + lallowfilebrowsing = .T. + Name = "_favoritepicker" + lstDocuments.Name = "lstDocuments" + lstDocuments.TabIndex = 1 + lstDocuments.Top = 12 + cmdOK.Left = 254 + cmdOK.Name = "cmdOK" + cmdOK.TabIndex = 2 + cmdOK.Top = 14 + cmdOK.Width = 63 + cmdCancel.Height = 27 + cmdCancel.Left = 254 + cmdCancel.Name = "cmdCancel" + cmdCancel.TabIndex = 4 + cmdCancel.Top = 82 + cmdCancel.Width = 63 + * + + ADD OBJECT 'cmdBrowse' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'cmdRemove' AS _commandbutton WITH ; + Caption = "\ + + PROCEDURE execdocument + LPARAMETERS tcFile + + * if a filename has been sent here, + * we're browsing/picking directly + * otherwise, we're working off the documents array + + LOCAL liRow, lcExt, lcFile, lcStatement, ; + laFavorites[1], ; + llDocumentFromDisk, llExactSet + + liRow = THIS.lstDocuments.Value + + IF VARTYPE(tcFile) # "C" AND ; + (EMPTY(THIS.aDocuments[liRow,1]) OR ; + NOT BETWEEN(liRow,1,ALEN(THIS.aDocuments,1))) + + RETURN + ENDIF + + IF VARTYPE(tcFile) = "C" + + lcFile = UPPER(ALLTRIM(tcFile)) + lcExt = JUSTEXT(lcFile) + + IF INLIST(lcExt,"SCT","LBT","FRT") + lcFile = LEFT(lcFile,LEN(lcFile)-1)+"X" + lcExt = LEFT(lcExt,LEN(lcExt)-1)+"X" + ENDIF + + IF NOT FILE(lcFile) + THIS.oApp.FileNotFoundMsgBox(lcFile) + RETURN + ENDIF + + llDocumentFromDisk = .T. + + ELSE + + IF LEFT(THIS.aDocuments[liRow,1],FAVORITEPICKER_PICKED_LEN ) = ; + FAVORITEPICKER_PICKED_LOC + * we're removing a document + * we've been called from + * doubleclick on list or something, + * so let's toggle: + THIS.RemoveDocument() + RETURN + ENDIF + + IF THIS.lNew + lcFile = THIS.aDocuments[liRow,11] + THIS.aDocuments[liRow,1] = ; + FAVORITEPICKER_PICKED_LOC +THIS.aDocuments[liRow,1] + + ELSE + * is this a document from disk instead + * of a metatable entry? + * documents from disk use only + * the first column of the array + IF EMPTY(THIS.aDocuments[liRow,11]) + lcFile = THIS.aDocuments[liRow,1] + llDocumentFromDisk = .T. + lcExt = JUSTEXT(lcFile) + ENDIF + + ENDIF + + ENDIF + + IF THIS.lNew + + * we have a document to add to the + * list. Is it from the metatable or disk? + * and is it already there? + + IF (NOT EMPTY(lcFile)) + + ALINES(laFavorites,THIS.oApp.cCurrentUserFavoriteIDs,.T.) + llExactSet = (SET("EXACT") = "OFF") + IF llExactSet + SET EXACT ON + ENDIF + + IF (ASCAN(laFavorites,lcFile) = 0) + + IF llDocumentFromDisk + liRow = ALEN(THIS.aDocuments,1) + IF VARTYPE(THIS.aDocuments[liRow,1]) = "C" AND ; + (NOT EMPTY(THIS.aDocuments[liRow,1])) + liRow = liRow + 1 + DIME THIS.aDocuments[liRow,11] + ENDIF + THIS.aDocuments[liRow,1] = FAVORITEPICKER_PICKED_LOC +lcFile + + ENDIF + THIS.lstDocuments.Requery() + THIS.lstDocuments.Value = liRow + THIS.RefreshFavoriteIDs(lcFile) + ELSE + + MESSAGEBOX(lcFile+; + CHR(13)+CHR(13)+ ; + FAVORITEPICKER_DOC_ALREADY_LOC, ; + 48,THISFORM.oApp.cCaption) + + ENDIF + + IF llExactSet + SET EXACT OFF + ENDIF + + + ENDIF + + ELSE + + IF llDocumentFromDisk + + THIS.oApp.DoFile(lcFile) + + ELSE + + DO CASE + + CASE NOT EMPTY(THIS.aDocuments[liRow,9]) && alt-exec + + lcStatement = ALLTR(THIS.aDocuments[liRow,9]) + &lcStatement + + CASE THIS.aDocuments[liRow,8] && wrapped + + DO (ALLTRIM(THIS.aDocuments[liRow,2])) + + OTHERWISE && report or form?? + + IF ALLTR(THIS.aDocuments[liRow,10]) = PJX_META_DOC_REPORT_TYPE + + THIS.oApp.DoReport(ALLTRIM(THIS.aDocuments[liRow,2]), ; + ALLTRIM(THIS.aDocuments[liRow,1])) + ELSE + + THIS.oApp.DoForm(ALLTRIM(THIS.aDocuments[liRow,2]), ; + ALLTRIM(THIS.aDocuments[liRow,3]), ; + THIS.aDocuments[liRow,4], ; + THIS.aDocuments[liRow,5], ; + THIS.aDocuments[liRow,6], ; + THIS.aDocuments[liRow,7]) + ENDIF + + ENDCASE + ENDIF + + ENDIF + + + ENDPROC + + PROCEDURE filldocumentsarray + LPARAMETERS tcMetaTableName + + DIME THIS.aDocuments[1,11] + + LOCAL liTally, liDocument, lcConditions, laFavorites[1], ; + liFaves, lcDocument, llExactSet, lcTable, liDocs + + + llExactSet = (SET("EXACT") = "OFF") + IF llExactSet + SET EXACT ON + ENDIF + + liTally = 0 + liDocs = 0 + + IF NOT EMPTY(tcMetaTableName) + lcTable = THIS.oApp.GetResourceFileName(tcMetaTableName,".dbf") + IF NOT EMPTY(lcTable) + lcConditions = " DOC_OPEN AND NOT DELETED() " + SELECT DOC_DESCR, DOC_EXEC, DOC_CLASS, ; + DOC_SINGLE, DOC_NOSHOW, ; + DOC_GO, DOC_NAV, ; + DOC_WRAP, ALT_EXEC, DOC_TYPE, APP_META_FAVE_ID AS DOC_ID ; + FROM (lcTable) ; + WHERE &lcConditions ; + INTO ARRAY THIS.aDocuments + + * this is for a startup form, and picking favorites, using + * all metatable's document items, both reports and forms, + * so array fits both types of documents' usage + + * above is form's use of metatable fields + one (doc_type) + ID field or expression + * below is report's use of fields (favorites/startup has to use both) + * report's use of fields: + * SELECT DOC_DESCR, DOC_EXEC, ; + * DOC_WRAP, ALT_EXEC ; + * FROM (tcMetaTableName) ; + * WHERE DOC_TYPE = PJX_META_DOC_REPORT_TYPE ; + * &lcConditions ; + * AND NOT DELETED() ; + * INTO ARRAY THIS.aDocuments + + + STORE _TALLY TO liTally, liDocs + ENDIF + + ENDIF + + liFaves = ALINES(laFavorites,THIS.oApp.cCurrentUserFavoriteIDs,.T.) + + IF (liTally # 0) + + FOR liDocument = 1 TO liTally + THIS.aDocuments[liDocument,11] = ALLTR(THIS.aDocuments[liDocument,11]) + IF ASCAN(laFavorites,; + THIS.aDocuments[liDocument,11]) > 0 + IF THIS.lNew + THIS.aDocuments[liDocument,1] = ; + FAVORITEPICKER_PICKED_LOC + ; + THIS.aDocuments[liDocument,1] + liTally = liTally - 1 + * show as disabled items already + * in the user table as favorites + ENDIF + ENDIF + ENDFOR + + ENDIF + + IF (liFaves # 0) + * if a favorite is a document on disk, + * rather than something from the metatable, + * add it to the list, + * disabled if we are in New, + * enabled otherwise + FOR EACH lcDocument IN laFavorites + IF NOT EMPTY(lcDocument) AND ; + ASCAN(THIS.aDocuments,lcDocument) = 0 AND ; + FILE(lcDocument) + liTally = liTally + 1 + liDocs = liDocs + 1 + DIME THIS.aDocuments[liDocs,11] + THIS.aDocuments[liDocs,1] = ALLTR(UPPER(lcDocument)) + IF THIS.lNew + THIS.aDocuments[liDocs,1] = FAVORITEPICKER_PICKED_LOC + THIS.aDocuments[liDocs,1] + ENDIF + ENDIF + + ENDFOR + + ENDIF + + If llExactSet + SET EXACT OFF + ENDIF + + IF THIS.lSorted + ASORT(THIS.aDocuments) + ENDIF + + IF liDocs = 0 AND (THIS.lNew AND THIS.lAllowFileBrowsing) + * make sure list doesn't look stupid + THIS.aDocuments[1,1]="" + ENDIF + + RETURN (liTally # 0) OR ; + (THIS.lNew AND (THIS.lAllowFileBrowsing OR liDocs # 0)) + + + ENDPROC + + PROCEDURE Init + LPARAMETERS toApp, tlAdd + + LOCAL laTemp[1], llReturn + + THIS.lNew = tlAdd + + THIS.oApp = toApp + + ASSERT TYPE("toApp.cMetaTable") = "C" AND ; + ACLASS(laTemp,toApp) > 0 AND ; + ASCAN(laTemp,"_APPLICATION") > 0 ; + MESSAGE DOCUMENTPICKER_NO_APP_LOC + + + * override of some document picker stuff... + * favorites can work without a + * registered document table or a list at all... + + DO CASE + CASE NOT THIS.FillDocumentsArray(toApp.cMetaTable) + + IF THIS.lAllowFileBrowsing + LOCAL lcFile, lcWaitMessage + THIS.lNew = tlAdd + IF tlAdd + lcWaitMessage = FAVORITEPICKER_CAPTION_ADD_LOC + ELSE + lcWaitMessage = FAVORITEPICKER_CAPTION_START_LOC + ENDIF + WAIT WINDOW NOWAIT ; + LEFT(lcWaitMessage, 250)+"..." + lcFile = GETFILE() + WAIT CLEAR + IF (NOT EMPTY(lcFile)) AND FILE(lcFile) + THIS.ExecDocument(lcFile) + ENDIF + ELSE + MESSAGEBOX(DOCUMENTPICKER_NO_DOCUMENTS_LOC, ; + MB_ICONEXCLAMATION, ; + toApp.cCaption) + + ENDIF + THIS.oApp = .NULL. + RETURN .F. + + CASE ALEN(THIS.aDocuments,1) = 1 AND ; + NOT (tlAdd OR THIS.lAllowFileBrowsing) + + THIS.lstDocuments.RowSource = "THISFORM.aDocuments" + THIS.lstDocuments.Value = 1 + + THIS.ExecDocument() + THIS.oApp = .NULL. + RETURN .F. + + OTHERWISE + + THIS.lstDocuments.RowSource = "THISFORM.aDocuments" + THIS.lstDocuments.Value = 1 + + IF tlAdd + THIS.Caption = FAVORITEPICKER_CAPTION_ADD_LOC + THIS.cmdOK.Caption = FAVORITEPICKER_ADDBUTTON_LOC + THIS.cmdCancel.Caption = FAVORITEPICKER_CLOSEBUTTON_LOC + THIS.cmdOK.Default = .F. + ELSE + THIS.Caption = FAVORITEPICKER_CAPTION_START_LOC + THIS.cmdCancel.Top = THIS.cmdRemove.Top + STORE .F. TO THIS.cmdRemove.Visible, ; + THIS.cmdRemove.Enabled + + ENDIF + + IF NOT THIS.lAllowFileBrowsing + STORE .F. TO THIS.cmdBrowse.Visible, ; + THIS.cmdBrowse.Enabled + ENDIF + + ENDCASE + + + + ENDPROC + + PROCEDURE refreshbuttons + IF THIS.lNew + + IF THIS.lstDocuments.Value = 0 OR ; + EMPTY(THIS.aDocuments[THIS.lstDocuments.Value,1]) + + STORE .F. TO THIS.cmdOK.Enabled, THIS.cmdRemove.Enabled + + + ELSE + + STORE (LEFT(THIS.aDocuments[THIS.lstDocuments.Value,1], ; + FAVORITEPICKER_PICKED_LEN ) # ; + FAVORITEPICKER_PICKED_LOC ) TO ; + THIS.cmdOK.Enabled + + STORE ! THIS.cmdOK.Enabled TO ; + THIS.cmdRemove.Enabled + ENDIF + + ENDIF + ENDPROC + + PROCEDURE refreshfavoriteids && Adds to the app cCurrentUserFavoriteIDs list when the user makes a new choice. + LPARAMETERS tcFavoriteIDToAdd + + ASSERT THIS.lNew + + LOCAL lcCurrentIDs, lcID, liID + + IF VARTYPE(tcFavoriteIDToAdd) = "C" AND ; + NOT EMPTY(tcFavoriteIDToAdd) + + lcID = ALLTRIM(tcFavoriteIDToAdd) + + lcCurrentIDs = ALLTRIM(THIS.oApp.cCurrentUserFavoriteIDs) + + IF INLIST(RIGHT(lcCurrentIDs,1), ; + CHR(13), CHR(10)) + + THIS.oApp.cCurrentUserFavoriteIDs = ; + lcCurrentIDs + lcID + + ELSE + THIS.oApp.cCurrentUserFavoriteIDs = ; + lcCurrentIDs +CHR(13)+lcID + ENDIF + + ELSE + * removing or otherwise doing a general refresh + + lcCurrentIDs = "" + FOR liID = 1 TO ALEN(THIS.aDocuments,1) + IF LEFT(THIS.aDocuments[liID,1],FAVORITEPICKER_PICKED_LEN) = FAVORITEPICKER_PICKED_LOC + lcCurrentIDs = lcCurrentIDs + CHR(13) + IF EMPTY(THIS.aDocuments[liID,11]) + lcCurrentIDs = lcCurrentIDs + SUBSTR(THIS.aDocuments[liID,1],FAVORITEPICKER_PICKED_LEN+1) + ELSE + lcCurrentIDs = lcCurrentIDs + THIS.aDocuments[liID,11] + ENDIF + ENDIF + ENDFOR + + THIS.oApp.cCurrentUserFavoriteIDs = lcCurrentIDs + + ENDIF + + ENDPROC + + PROCEDURE removedocument + ASSERT THIS.lNew + + LOCAL liRow, liCount + liRow = THIS.lstDocuments.Value + liCount = ALEN(THIS.aDocuments,1) + + + IF (NOT BETWEEN(liRow,1,liCount)) OR ; + (LEFT(THIS.aDocuments[liRow,1], ; + FAVORITEPICKER_PICKED_LEN) # ; + FAVORITEPICKER_PICKED_LOC ) + * shouldn't happen + RETURN + ENDIF + + DO CASE + CASE EMPTY(THIS.aDocuments[liRow,1]) + * empty first row, nothing to do + RETURN + CASE EMPTY(THIS.aDocuments[liRow,11]) + * document on disk, remove from listbox + ADEL(THIS.aDocuments,liRow) + IF liCount > 1 + liCount = liCount - 1 + DIME THIS.aDocuments[liCount,11] + ELSE + THIS.aDocuments[1,1] = "" + ENDIF + OTHERWISE + * metatable entry, un-mark in listbox + THIS.aDocuments[liRow,1] = SUBSTR(THIS.aDocuments[liRow,1],; + FAVORITEPICKER_PICKED_LEN+1) + ENDCASE + + THIS.lstDocuments.Requery() + IF liRow > liCount + THIS.lstDocuments.Value = liCount + ELSE + THIS.lstDocuments.Value = liRow + ENDIF + + THIS.RefreshFavoriteIDs() + + + ENDPROC + + PROCEDURE Resize + DODEFAULT() + LOCAL lnMargin + lnMargin = THIS.Height - (THIS.lstDocuments.Top+THIS.lstDocuments.Height) + THIS.cmdBrowse.Top = THIS.Height - (THIS.cmdBrowse.Height + lnMargin) + STORE THIS.cmdCancel.Left TO THIS.cmdBrowse.Left, THIS.cmdRemove.Left + + + + + + ENDPROC + + PROCEDURE setdialogsizeparameters + DODEFAULT() + THIS.MinHeight = MAX(THIS.MinHeight, ; + THIS.cmdCancel.Top + THIS.cmdCancel.Height + ; + THIS.cmdBrowse.Height + ; + THIS.lstDocuments.Top * 2) + THIS.Height = MAX(THIS.Height, THIS.MinHeight) + THIS.MaxHeight = MAX(THIS.Height, THIS.MaxHeight) + + + + ENDPROC + + PROCEDURE cmdBrowse.Click + LOCAL lcFile + + lcFile = GETFILE() + IF EMPTY(lcFile) + RETURN + ENDIF + IF FILE(lcFile) + THISFORM.ExecDocument(lcFile) + ENDIF + + IF NOT THISFORM.lNew + THISFORM.Release() + ENDIF + ENDPROC + + PROCEDURE cmdOK.Click + IF THISFORM.lNew + + THISFORM.ExecDocument() + + ELSE + + DODEFAULT() + + ENDIF + + + ENDPROC + + PROCEDURE cmdRemove.Click + THISFORM.RemoveDocument() + ENDPROC + + PROCEDURE lstDocuments.DblClick + THISFORM.ExecDocument() + IF NOT THISFORM.lNew + THISFORM.Release() + ENDIF + + + ENDPROC + + PROCEDURE lstDocuments.InteractiveChange + THISFORM.RefreshButtons() + + ENDPROC + + PROCEDURE lstDocuments.ProgrammaticChange + THIS.InteractiveChange() + ENDPROC + + PROCEDURE lstDocuments.When + THIS.InteractiveChange() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _formmediator AS _mediatedsession OF "_framewk.vcx" && member object to framework-enable any form + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_framewk.h" + * + *p: ccontextmenufile && Holds the name of a context menu you wish to attach to this mediator's host document. + *p: ccontextmenupad && Holds the pad name of the context menu so it can be removed when the host document destroys. + *p: ccontextmenupopup && Holds the pad name of the context menu popup so it can be released when the host document destroys. + *p: ctoolbarclass && Holds the name of a context toolbar class you wish to attach to this mediator's host document. + *p: ctoolbarclasslib && Holds the name of a class library containing the context toolbar class you wish to attach to this mediator's host document. + *p: icontextmenuindex && Provided to the mediator by the app when it invokes a context menu for the mediator's host document, passed back to the app by the mediator so the app can refresh its context menu collection when this host document destroys. + *p: itoolbarindex && Provided to the mediator by the app when it invokes a context toolbar for the mediator's host document, passed back to the app by the mediator so the app can refresh its context toolbar collection when this host document destroys. + *p: laddappicon && Specifies that the mediator should apply the application's standard Icon to the form's Icon property, if this property has been left empty. Defaults to .T.; turn it off if you want a borderless form! + *p: lgomenu && Specifies whether or not the host document has been assigned a navigation menu by the application and its metatable entry. + *p: lnavtoolbar && Specifies whether or not the host document has been assigned a navigation toolbar by the application and its metatable entry. + * + + * + ccontextmenufile = ("") + ccontextmenupad = ("") + ccontextmenupopup = ("") + ctoolbarclass = ("") + ctoolbarclasslib = ("") + icontextmenuindex = 0 + itoolbarindex = 0 + laddappicon = .T. + lsetdocumenttonewonappload = .T. + Name = "_formmediator" + * + + PROCEDURE Destroy + DODEFAULT() + + LOCAL loApp + + loApp = THIS.GetAppRef() + + IF ISNULL(loApp) + RETURN + ENDIF + + + IF NOT EMPTY(THIS.iContextMenuIndex) + + loApp.ReleaseContextMenu(THIS.iContextMenuIndex) + + ENDIF + + IF NOT EMPTY(THIS.iToolbarIndex) + + loApp.ReleaseToolbar(THIS.iToolbarIndex) + + ENDIF + + loApp = .NULL. + + + + ENDPROC + + PROCEDURE loadapp + LPARAMETERS tcAppRef + IF DODEFAULT(tcAppRef) + LOCAL loApp + loApp = THIS.GetAppRef() + IF NOT (EMPTY(THIS.cContextMenuFile) OR ; + EMPTY(THIS.cContextMenuPad) OR ; + EMPTY(THIS.cContextMenuPopup)) + + THIS.iContextMenuIndex = ; + loApp.DoContextMenu(THIS.cContextMenuFile, THIS.cContextMenuPad, THIS.cContextMenuPopup) + + ENDIF + + IF NOT EMPTY(THIS.cToolbarClass) + + THIS.iToolbarIndex = ; + loApp.DoToolbar(THIS.cToolbarClassLib, THIS.cToolbarClass) + + ENDIF + + IF THIS.lAddAppIcon AND ; + EMPTY(THISFORM.Icon) AND ; + NOT THISFORM.TitleBar = 0 + THISFORM.Icon = loApp.cIcon + ENDIF + + loApp = NULL + + ELSE + RETURN .F. + + ENDIF + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _mediatedsession AS _custom OF "..\ffc\_base.vcx" + * + *Mediator object to framework-enable a datasession. Drop on form to handle the datasession of the form/formset, or pass Init(tlCreateSession,tcSessionClass, tcSessionClassLib) to create and wrap a non-visual session. + * + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: cleanupoutputalias && Abstract, see PrepareOutputAlias(). If you have created a temporary cursor for the purposes of DoTableOutput(), here's your chance to destroy it. + *m: coutputalias_assign + *m: coutputcaption_access + *m: createsession && Creates the session object if .T. passed to the class upon instantiation + *m: csessionclasslib_access + *m: csessionclass_access + *m: datachanged && Wraps application QueryDataChanged method, using iChangeMode specific to this object. + *m: datasessionid_access + *m: datasessionid_assign + *m: datasessionname_access + *m: datasessionname_assign + *m: datasession_access + *m: datasession_assign + *m: dosessionsets && If lSessionSettings is .T., invokes app SetDataSessionEnvironment() method for this session If lUserSessionSettings is .T., invokes app ApplyUserOptsForSession() method for this session. + *m: getappref && RETURNs an object reference to the app. + *m: loadapp && Applies app attributes, including session settings. Sets new or open status if lSetDocumentToNewOnAppLoad is .T.. + *m: output && Wraps the app DoTableOutput() method. + *m: outputonerecord && Wraps the app DoTableOutput() method with a scope of one record. + *m: pickrecordtoworkon && Abstract, available to evaluate whether form has been invoked in "new" or "open" mode, and for you to add record browsing/navigation/APPEND BLANK/whatever based on this information. + *m: prepareoutputalias && Abstract, will be invoked by app's DoTableOutput() so you can SELECT a focus table, or put together a cursor, filter data, or otherwise prepare appropriate "focussed" table information when the user chooses to get quick output from any form. + *m: queryunload && Invokes the app's QueryDataSessionUnload for this Session. If used with a form, should be called in the form's QueryUnload() to handle any data changes, updates, or reverts before the form is closed. + *m: setdocumenttonew && Stores the app's lAddingNewDocument flag at the time the app attributes are loaded, so the form can evaluate what record to work on. + *m: writesessionclassdefinition && Not currently used; designed to provide a model for generation of a class definition file if desired. Would be called by the cSessionClassLib access method. + *p: cappref && Holds the name of the reference variable for the running app so the mediator can evaluate it to an object reference when necessary. The mediator does not store any object references, for safety. + *p: coutputalias && Allows you to indicate the right alias to "focus on" when the app DoTableOutput method runs, without any additional work in PrepareOutputAlias() and CleanupOutputAlias(). + *p: coutputcaption && Will be passed by the app's DoTableOutput() to the _outputdialog, if used. + *p: csessionclass && The programmatic class definition to instance if .T. is passed to the class. By default, an instance of the session baseclass is created. + *p: csessionclasslib && The programmatic classlibrary holding the cSessionClass class definition you wish to instantiate. By default, an instance of the session baseclass is created. + *p: datasession && Wraps the Datasession property of the session object, if this mediator created one + *p: datasessionid && Wraps the DatasessionID property of the session object, if this mediator created one + *p: datasessionname && Wraps the Name property of the session object, if this mediator created one + *p: ichangemode && Sent on to the app's cusDataSession object to detemine what constitutes data change. 0 - anything changed. 1 - ignore view fields not in Updatefields list. 2- ignore views not set to send updates. + *p: ladding && Stores information about whether the framework invoked a session for "new" or "open" editing. + *p: lsessionsettings && Specifies whether the mediator should load session settings using the application's defaults. + *p: lsetdocumenttonewonappload && If .T., specifies that mediator should invoke SetDocumentToNew() in LoadApp. + *p: lusersessionsettings && Specifies whether the mediator should load data-session-specific user settings using the application's defaults. + *p: osession && If .T. is passed to the _mediator class when it's instanced, holds the session object for this mediator. Otherwise the mediator looks for its parent form's session. + * + + * + cappref = ("") + coutputalias = + coutputcaption = + csessionclass = + csessionclasslib = + datasession = 1 + datasessionname = + ichangemode = 0 + lusersessionsettings = .T. + Name = "_mediatedsession" + osession = .NULL. + * + + PROCEDURE cleanupoutputalias && Abstract, see PrepareOutputAlias(). If you have created a temporary cursor for the purposes of DoTableOutput(), here's your chance to destroy it. + ENDPROC + + PROCEDURE coutputalias_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) = "C" AND USED(tvNewVal) + THIS.cOutputAlias = tvNewVal + ENDIF + + ENDPROC + + PROCEDURE coutputcaption_access + IF EMPTY(THIS.cOutputCaption) AND (NOT EMPTY(THIS.cOutputAlias)) + RETURN PROPER(THIS.cOutputAlias) + ELSE + RETURN THIS.cOutputCaption + ENDIF + + + ENDPROC + + PROCEDURE createsession && Creates the session object if .T. passed to the class upon instantiation + lcClass = THIS.cSessionClass + lcClassLib = THIS.cSessionClassLib + IF EMPTY(lcClassLib) + RETURN CREATEOBJECT("Session") + ELSE + RETURN NEWOBJECT(lcClass, lcClassLib) + ENDIF + + ENDPROC + + PROCEDURE csessionclasslib_access + LOCAL lcVal + + IF VARTYPE(THIS.cSessionClassLib) # "C" OR EMPTY(THIS.cSessionClassLib) + *!* * to generate: + *!* lcVal = ADDBS(GETENV("TEMP"))+"C"+SYS(2015)+".PRG" + lcVal = "" + ELSE + lcVal = FORCEEXT(THIS.cSessionClassLib,"FXP") + IF NOT FILE(lcVal) && either on disk or bound + + *!* * to generate: + *!* IF NOT DIRECTORY(JUSTPATH(lcVal)) + *!* lcVal = FORCEPATH(lcVal,ADDBS(GETENV("TEMP"))) + *!* ENDIF + + *!* lcVal = FORCEEXT(lcVal,"PRG") + + *!* IF EMPTY(SYS(2000,lcVal)) + *!* THIS.WriteSessionClassDefinition(lcVal) + *!* ENDIF + + *!* lcVal = FORCEEXT(lcVal,"FXP") + + lcVal = FORCEEXT(lcVal,"PRG") + IF EMPTY(SYS(2000,lcVal)) && on disk + lcVal = "" + ELSE + COMPILE (lcVal) + lcVal = FORCEEXT(lcVal,"FXP") + ENDIF + ENDIF + ENDIF + + THIS.cSessionClassLib = lcVal + + RETURN THIS.cSessionClassLib + + ENDPROC + + PROCEDURE csessionclass_access + IF VARTYPE(THIS.cSessionClass) # "C" ; + OR EMPTY(THIS.cSessionClass) ; + OR VARTYPE(THIS.cSessionClassLib) # "C" ; + OR EMPTY(THIS.cSessionClassLib) + * THIS.cSessionClass = "Session"+SYS(2015) + THIS.cSessionClass = "Session" + ENDIF + RETURN THIS.cSessionClass + + ENDPROC + + PROCEDURE datachanged && Wraps application QueryDataChanged method, using iChangeMode specific to this object. + LOCAL loApp, llReturn, loSession + + loApp = THIS.GetAppRef() + + IF ISNULL(loApp) + RETURN + ENDIF + + IF ISNULL(THIS.oSession) + IF TYPE("THISFORM") # "O" + RETURN + ELSE + loSession = THISFORM + ENDIF + ELSE + loSession = THIS.oSession + ENDIF + + llReturn = NOT ISNULL(loSession) + + IF llReturn + llReturn = loApp.QueryDataChanged(loSession,THIS.iChangeMode) + ENDIF + + STORE .NULL. TO loApp, loSession + + RETURN llReturn + + ENDPROC + + PROCEDURE datasessionid_access + IF ISNULL(THIS.oSession) + RETURN SET("DATASESSION") + ELSE + RETURN THIS.oSession.DataSessionID + ENDIF + + ENDPROC + + PROCEDURE datasessionid_assign + LPARAMETERS tvNewVal + * don't allow assignment + + ENDPROC + + PROCEDURE datasessionname_access + IF ISNULL(THIS.oSession) + RETURN "" + ELSE + RETURN THIS.oSession.Name + ENDIF + + + + ENDPROC + + PROCEDURE datasessionname_assign + LPARAMETERS vNewVal + * readonly, don't allow assignment + ENDPROC + + PROCEDURE datasession_access + IF ISNULL(THIS.oSession) + IF TYPE("THISFORMSET.BaseClass") = "C" + RETURN THISFORMSET.DataSession + ELSE + RETURN THISFORM.DataSession + ENDIF + ELSE + RETURN THIS.oSession.DataSession + ENDIF + + ENDPROC + + PROCEDURE datasession_assign + LPARAMETERS vNewVal + * don't allow assignment + ENDPROC + + PROCEDURE Destroy + DODEFAULT() + THIS.oSession = NULL + + ENDPROC + + PROCEDURE dosessionsets && If lSessionSettings is .T., invokes app SetDataSessionEnvironment() method for this session If lUserSessionSettings is .T., invokes app ApplyUserOptsForSession() method for this session. + LPARAMETERS toApp + + LOCAL loApp + + loApp = NULL + + IF VARTYPE(toApp) = "O" + * called from LoadApp + * or something else that knows + * the app already + loApp = toApp + ELSE + loApp = THIS.GetAppRef() + ENDIF + + IF ISNULL(loApp) + RETURN + ENDIF + + + IF THIS.lSessionSettings + + DO CASE + + CASE NOT ISNULL(THIS.oSession) + + loApp.SetDataSessionEnvironment(THIS.oSession.DataSessionID) + + CASE TYPE("THISFORMSET.DataSession") = "N" AND ; + THISFORMSET.DataSession # 1 + + loApp.SetDataSessionEnvironment(THISFORMSET.DataSessionID) + + CASE THISFORM.DataSession # 1 + + loApp.SetDataSessionEnvironment(THISFORM.DataSessionID) + + OTHERWISE + + * a form or formset in the default session, don't touch + + ENDCASE + + ENDIF + + + IF THIS.lUserSessionSettings + + IF NOT ISNULL(THIS.oSession) + loApp.ApplyUserOptsForSession(THIS.oSession) + ELSE + loApp.ApplyUserOptsForSession(THISFORM) + ENDIF + + ENDIF + + loApp = NULL + + + ENDPROC + + PROCEDURE getappref && RETURNs an object reference to the app. + IF EMPTY(THIS.cAppRef) + RETURN .NULL. + ENDIF + + LOCAL ARRAY laCheck[1] + + IF TYPE(THIS.cAppRef+".BaseClass") = "C" ; + AND ACLASS(laCheck,EVAL(THIS.cAppRef)) > 0 AND ; + ASCAN(laCheck,"_APPLICATION") > 0 + + RETURN EVAL(THIS.cAppRef) + ELSE + RETURN .NULL. + ENDIF + + + + ENDPROC + + PROCEDURE Init + LPARAMETERS tlCreateSession, tcSessionClass, tcSessionClassLib + IF DODEFAULT() + IF tlCreateSession + IF NOT (EMPTY(tcSessionClass) OR EMPTY(tcSessionClassLib)) + THIS.cSessionClass = tcSessionClass + THIS.cSessionClassLib = tcSessionClassLib + ENDIF + THIS.oSession = THIS.CreateSession() + IF VARTYPE(THIS.oSession) # "O" + RETURN .F. + ENDIF + ELSE + IF TYPE("THISFORM") # "O" + RETURN .F. + ENDIF + ENDIF + ELSE + RETURN .F. + ENDIF + ENDPROC + + PROCEDURE loadapp && Applies app attributes, including session settings. Sets new or open status if lSetDocumentToNewOnAppLoad is .T.. + LPARAMETERS tcAppRef + + THIS.cAppRef = tcAppRef + + LOCAL loApp + + loApp = THIS.GetAppRef() + + IF ISNULL(loApp) + RETURN .F. + ENDIF + + THIS.DoSessionSets(loApp) + + IF THIS.lSetDocumentToNewOnAppLoad + THIS.SetDocumentToNew(loApp) + ENDIF + + loApp = .NULL. + + + + ENDPROC + + PROCEDURE output && Wraps the app DoTableOutput() method. + LOCAL loApp, llReturn + + loApp = THIS.GetAppRef() + + IF ISNULL(loApp) + RETURN + ENDIF + + llReturn = loApp.DoTableOutput() + + loApp = .NULL. + + RETURN llReturn + + ENDPROC + + PROCEDURE outputonerecord && Wraps the app DoTableOutput() method with a scope of one record. + LOCAL loApp, llReturn + + loApp = THIS.GetAppRef() + + IF ISNULL(loApp) + RETURN + ENDIF + + llReturn = loApp.DoTableOutput(.T.) + + loApp = .NULL. + + RETURN llReturn + + + ENDPROC + + PROCEDURE pickrecordtoworkon && Abstract, available to evaluate whether form has been invoked in "new" or "open" mode, and for you to add record browsing/navigation/APPEND BLANK/whatever based on this information. + ENDPROC + + PROCEDURE prepareoutputalias && Abstract, will be invoked by app's DoTableOutput() so you can SELECT a focus table, or put together a cursor, filter data, or otherwise prepare appropriate "focussed" table information when the user chooses to get quick output from any form. + ENDPROC + + PROCEDURE queryunload && Invokes the app's QueryDataSessionUnload for this Session. If used with a form, should be called in the form's QueryUnload() to handle any data changes, updates, or reverts before the form is closed. + LPARAMETERS tlDataChangeAlreadyConfirmed + + LOCAL loApp, llReturn, loSession + + loApp = THIS.GetAppRef() + + IF ISNULL(loApp) + RETURN + ENDIF + + IF ISNULL(THIS.oSession) + IF TYPE("THISFORM") # "O" + RETURN + ELSE + loSession = THISFORM + ENDIF + ELSE + loSession = THIS.oSession + ENDIF + + llReturn = NOT ISNULL(loSession) + + IF llReturn + llReturn = loApp.QueryDataSessionUnload(tlDataChangeAlreadyConfirmed,loSession) + ENDIF + + STORE .NULL. TO loApp, loSession + + RETURN llReturn + + ENDPROC + + PROCEDURE setdocumenttonew && Stores the app's lAddingNewDocument flag at the time the app attributes are loaded, so the form can evaluate what record to work on. + LPARAMETERS toApp + LOCAL loApp + loApp = NULL + IF VARTYPE(toApp) = "O" + * called from LoadApp + * or something else that knows + * the app already + loApp = toApp + ELSE + loApp = THIS.GetAppRef() + ENDIF + + IF ISNULL(loApp) + RETURN + ENDIF + + THIS.lAdding = loApp.lAddingNewDocument + + loApp = .NULL. + + ENDPROC + + PROCEDURE writesessionclassdefinition && Not currently used; designed to provide a model for generation of a class definition file if desired. Would be called by the cSessionClassLib access method. + LPARAMETERS tcFileName + * not currently used, + * for generation purposes + LOCAL lcFileName, llSafety + IF EMPTY(tcFileName) + RETURN + ELSE + lcFileName = tcFileName + ENDIF + llSafety = (SET("SAFETY") == "ON") + IF llSafety + SET SAFETY OFF + ENDIF + lcFileName = FORCEEXT(lcFileName,"PRG") + STRTOFILE("DEFINE CLASS "+THIS.cSessionClass+" AS Session"+CHR(13)+CHR(10),lcFileName) + STRTOFILE("DataSession = 2"+CHR(13)+CHR(10),lcFileName,.T.) + STRTOFILE("ENDDEFINE"+CHR(13)+CHR(10),lcFileName,.T.) + COMPILE (lcFileName) + ERASE (lcFileName) + THIS.cSessionClassLib = FORCEEXT(lcFileName,"FXP") + IF llSafety + SET SAFETY ON + ENDIF + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _navtoolbar AS _modalawaretoolbar OF "..\ffc\_ui.vcx" && superclass for framework-supplied default navigation toolbar (application object makes a nav toolbar class available to any form designated as using a nav toolbar in the metatable) + *< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="_separator1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdTop" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdPrev" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdNext" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdBottom" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="spnGo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSortUp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSortDown" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_separator2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdFilter" UniqueID="" Timestamp="" /> + + * + *p: oapp + * + + * + Caption = "Navigate" + ControlBox = .F. + Height = 30 + Left = 0 + Name = "_navtoolbar" + oapp = .NULL. + Top = 0 + Width = 234 + * + + ADD OBJECT '_separator1' AS _separator WITH ; + Height = 30, ; + Left = 5, ; + Name = "_separator1", ; + Top = 3, ; + Width = 103 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" /> + + ADD OBJECT '_separator2' AS _separator WITH ; + Height = 29, ; + Left = 205, ; + Name = "_separator2", ; + Top = 3, ; + Width = 58 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" /> + + ADD OBJECT 'cmdBottom' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 74, ; + Name = "cmdBottom", ; + Picture = graphics\bottom.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 4 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdFilter' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 205, ; + Name = "cmdFilter", ; + Picture = graphics\filter.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdNext' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 51, ; + Name = "cmdNext", ; + Picture = graphics\next.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 3 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdPrev' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 28, ; + Name = "cmdPrev", ; + Picture = graphics\previous.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 2 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSortDown' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 174, ; + Name = "cmdSortDown", ; + Picture = graphics\sortdes.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSortUp' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 151, ; + Name = "cmdSortUp", ; + Picture = graphics\sortasc.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 6 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdTop' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 5, ; + Name = "cmdTop", ; + Picture = graphics\top.bmp, ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'spnGo' AS _spinner WITH ; + Height = 24, ; + Left = 97, ; + Name = "spnGo", ; + SpecialEffect = 2, ; + Top = 3, ; + Width = 55, ; + ZOrderSet = 5 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="spinner" /> + + PROCEDURE Destroy + DODEFAULT() + THIS.oApp = .NULL. + ENDPROC + + PROCEDURE Refresh + LOCAL llEnable + + IF NOT THIS.lDisabledForModal + NODEFAULT + DO CASE + CASE TYPE("_SCREEN.ActiveForm.Parent") = "O" + SET DATASESSION TO _SCREEN.ActiveForm.Parent.DataSessionID + CASE TYPE("_SCREEN.ActiveForm") = "O" + SET DATASESSION TO _SCREEN.ActiveForm.DataSessionID + OTHERWISE + * we're wherever we should be... + ENDCASE + llEnable = (RECCOUNT() > 1) + IF llEnable + * everything has been enabled + WITH THIS.spnGo + STORE 1 TO .SpinnerLowValue, .KeyBoardLowValue + STORE RECCOUNT() TO ; + .SpinnerHighValue, .KeyBoardHighValue + .Value = RECNO() + .Value = MIN(.Value,.SpinnerHighValue) && EOF() + ENDWITH + ELSE + THIS.SetAll("Enabled", .F.) + ENDIF + ENDIF + + RETURN llEnable + + ENDPROC + + PROCEDURE cmdBottom.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.GoBottom() + ENDIF + ENDPROC + + PROCEDURE cmdFilter.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.ShowTableSetFilterDialog() + ENDIF + ENDPROC + + PROCEDURE cmdNext.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.GoNext() + ENDIF + ENDPROC + + PROCEDURE cmdPrev.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.GoPrevious() + ENDIF + ENDPROC + + PROCEDURE cmdSortDown.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.DoSort(,,,.T.) + ENDIF + ENDPROC + + PROCEDURE cmdSortUp.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.DoSort(,,,.F.) + ENDIF + ENDPROC + + PROCEDURE cmdTop.Click + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.GoTop() + ENDIF + ENDPROC + + PROCEDURE spnGo.InteractiveChange + IF NOT ISNULL(THIS.Parent.oApp) + THIS.Parent.oApp.GoToRecord(THIS.Value) + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS _newopen AS _documentpicker OF "_framewk.vcx" && superclass for framework-supplied default dialog to add or edit a document + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_framewk.h" + * + DoCreate = .T. + Name = "_newopen" + lstDocuments.Name = "lstDocuments" + cmdOK.Name = "cmdOK" + cmdCancel.Name = "cmdCancel" + * + + PROCEDURE execdocument + LOCAL liRow + + liRow = THISFORM.lstDocuments.Value + + IF EMPTY(liRow) + RETURN + ENDIF + + DO CASE + + CASE NOT EMPTY(THIS.aDocuments[liRow,9]) && alt-exec + LOCAL lcStatement + lcStatement = ALLTR(THIS.aDocuments[liRow,9]) + + &lcStatement + + CASE THIS.aDocuments[liRow,8] && wrapped + DO (ALLTRIM(THIS.aDocuments[liRow,2])) + + OTHERWISE && form or form class + + THIS.oApp.DoForm(ALLTRIM(THIS.aDocuments[liRow,2]), ; + ALLTRIM(THIS.aDocuments[liRow,3]), ; + THIS.aDocuments[liRow,4], ; + THIS.aDocuments[liRow,5], ; + THIS.aDocuments[liRow,6], ; + THIS.aDocuments[liRow,7]) + ENDCASE + + + + ENDPROC + + PROCEDURE filldocumentsarray + LPARAMETERS tcMetaTableName + + DIME THIS.aDocuments[1,9] + * array has 9 columns to match meta data info + * First is visible description, plus 6 columns of DoForm params, + * and then "wrapped" column meaning "this is a program not a class" + * followed by "alt-exec" column, which gets macro-evaluated if used + + + * LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow, tlGoMenu, tlNavToolbar + * are the doform params... + + IF EMPTY(tcMetaTableName) + + RETURN .F. + + ENDIF + + LOCAL lcConditions + + IF THIS.lNew + lcConditions = " AND DOC_NEW " + ELSE + lcConditions = " AND DOC_OPEN " + ENDIF + + lcConditions = lcConditions + " AND NOT DELETED() " + + IF THIS.lSorted + lcConditions = lcConditions + " ORDER BY 1 " + ENDIF + + + SELECT DOC_DESCR, DOC_EXEC, DOC_CLASS, ; + DOC_SINGLE, DOC_NOSHOW, ; + DOC_GO, DOC_NAV, ; + DOC_WRAP, ALT_EXEC ; + FROM (tcMetaTableName) ; + WHERE DOC_TYPE = PJX_META_DOC_FORM_TYPE ; + &lcConditions ; + INTO ARRAY THIS.aDocuments + + RETURN ( _TALLY # 0) + + + + + ENDPROC + + PROCEDURE Init + LPARAMETERS toApp, tlNew + + IF NOT DODEFAULT(toApp,tlNew) + RETURN .F. + ENDIF + + IF tlNew + THIS.Caption = NEWOPEN_CAPTION_NEW_LOC + ELSE + THIS.Caption = NEWOPEN_CAPTION_OPEN_LOC + ENDIF + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _options AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default dialog to edit, apply, or save user options + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="shpGlobalItems" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="shpDocumentItems" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdApply" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSetDefault" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdResetToDefault" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkConfirm" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkShowTips" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblTextDisplay" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboTextDisplayFont" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblBell" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblDocumentOptions" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblGlobalOptions" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblHours" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="opgBell" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="opgHours" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtBell" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdPickWav" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: displaycurrentuseroptions + *m: displayoptions + *m: displayuserdefaultoptions + *m: saveuseroptionsfromdisplay + *m: setfromdisplay + *m: setuseroptionsfromdisplay + *p: oapp + * + + * + BufferMode = 2 + Caption = "Options" + DoCreate = .T. + Height = 190 + KeyPreview = .T. + Name = "_options" + oapp = .NULL. + Width = 345 + * + + ADD OBJECT 'cboTextDisplayFont' AS _combobox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 21, ; + Left = 101, ; + Name = "cboTextDisplayFont", ; + Style = 2, ; + TabIndex = 8, ; + Top = 114, ; + Value = (""), ; + Width = 229, ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'chkConfirm' AS _checkbox WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Confirm entry when leaving text fields", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 16, ; + Name = "chkConfirm", ; + TabIndex = 2, ; + Top = 24, ; + ZOrderSet = 5 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'chkShowTips' AS _checkbox WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Show tool tips in forms", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 15, ; + Left = 16, ; + Name = "chkShowTips", ; + TabIndex = 3, ; + Top = 41, ; + Width = 123, ; + ZOrderSet = 6 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cmdApply' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'cmdPickWav' AS _commandbutton WITH ; + AutoSize = .T., ; + Caption = "...", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 303, ; + Name = "cmdPickWav", ; + TabIndex = 12, ; + Top = 147 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdResetToDefault' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdSetDefault' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'lblBell' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Warning sound:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 15, ; + Name = "lblBell", ; + TabIndex = 9, ; + Top = 137, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblDocumentOptions' AS _label WITH ; + AutoSize = .T., ; + Caption = "Document options", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 13, ; + Name = "lblDocumentOptions", ; + TabIndex = 1, ; + Top = 8, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblGlobalOptions' AS _label WITH ; + AutoSize = .T., ; + Caption = "Global options", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 13, ; + Name = "lblGlobalOptions", ; + TabIndex = 6, ; + Top = 100, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblHours' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Hours display:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 15, ; + Name = "lblHours", ; + TabIndex = 4, ; + Top = 62, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblTextDisplay' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Text display font:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 15, ; + Name = "lblTextDisplay", ; + TabIndex = 7, ; + Top = 117, ; + ZOrderSet = 7 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'opgBell' AS _optiongroup WITH ; + BackStyle = 0, ; + BorderStyle = 0, ; + ButtonCount = 3, ; + Height = 21, ; + Left = 9, ; + Name = "opgBell", ; + TabIndex = 10, ; + Top = 149, ; + Width = 145, ; + OPTION1.AutoSize = .T., ; + OPTION1.BackStyle = 0, ; + OPTION1.Caption = "Off", ; + OPTION1.FontName = "MS Sans Serif", ; + OPTION1.FontSize = 8, ; + OPTION1.Left = 5, ; + OPTION1.Name = "OPTION1", ; + OPTION1.Top = 3, ; + OPTION2.AutoSize = .T., ; + OPTION2.BackStyle = 0, ; + OPTION2.Caption = "Default", ; + OPTION2.FontName = "MS Sans Serif", ; + OPTION2.FontSize = 8, ; + OPTION2.Left = 42, ; + OPTION2.Name = "OPTION2", ; + OPTION2.Top = 3, ; + Option3.AutoSize = .T., ; + Option3.BackStyle = 0, ; + Option3.Caption = "Play:", ; + Option3.FontName = "MS Sans Serif", ; + Option3.FontSize = 8, ; + Option3.Height = 15, ; + Option3.Left = 99, ; + Option3.Name = "Option3", ; + Option3.Top = 3, ; + Option3.Width = 41 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="optiongroup" /> + + ADD OBJECT 'opgHours' AS _optiongroup WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Height = 25, ; + Left = 96, ; + Name = "opgHours", ; + TabIndex = 5, ; + Top = 57, ; + Width = 74, ; + OPTION1.AutoSize = .T., ; + OPTION1.BackStyle = 0, ; + OPTION1.Caption = "12", ; + OPTION1.FontName = "MS Sans Serif", ; + OPTION1.FontSize = 8, ; + OPTION1.Left = 5, ; + OPTION1.Name = "OPTION1", ; + OPTION1.Top = 5, ; + OPTION2.AutoSize = .T., ; + OPTION2.BackStyle = 0, ; + OPTION2.Caption = "24", ; + OPTION2.FontName = "MS Sans Serif", ; + OPTION2.FontSize = 8, ; + OPTION2.Height = 15, ; + OPTION2.Left = 39, ; + OPTION2.Name = "OPTION2", ; + OPTION2.Top = 5, ; + OPTION2.Width = 30 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="optiongroup" /> + + ADD OBJECT 'shpDocumentItems' AS _shape WITH ; + BackStyle = 0, ; + Height = 74, ; + Left = 6, ; + Name = "shpDocumentItems", ; + SpecialEffect = 0, ; + Top = 14, ; + Width = 220, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="shape" /> + + ADD OBJECT 'shpGlobalItems' AS _shape WITH ; + BackStyle = 0, ; + Height = 74, ; + Left = 6, ; + Name = "shpGlobalItems", ; + SpecialEffect = 0, ; + Top = 106, ; + Width = 332, ; + ZOrderSet = 0 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="shape" /> + + ADD OBJECT 'txtBell' AS _textbox WITH ; + Alignment = 1, ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 22, ; + Left = 154, ; + Name = "txtBell", ; + ReadOnly = .T., ; + TabIndex = 11, ; + Top = 148, ; + Width = 144 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" /> + + PROCEDURE applyappattributes + LPARAMETERS toApp + LOCAL llSuccess + llSuccess = DODEFAULT(toApp) + IF llSuccess + IF USED(toApp.cUserTableAlias) + + THIS.Caption = toApp.cCaption + " " + OPTIONS_LOC + THIS.oApp = toApp + THIS.DisplayCurrentUserOptions() + IF EMPTY(EVAL(toApp.cUserTableAlias+".UserOpts")) + WAIT WINDOW NOWAIT LEFT(OPTIONS_NOT_STORED_LOC,254) + THIS.cmdResetToDefault.Enabled = .F. + ENDIF + ELSE + llSuccess = .F. + ENDIF + + ENDIF + IF NOT (llSuccess AND THIS.oApp.IsErrorFree()) + THIS.Release() + ENDIF + + ENDPROC + + PROCEDURE Destroy + DODEFAULT() + THIS.oApp = .NULL. + ENDPROC + + PROCEDURE displaycurrentuseroptions + * show values from user options array in the dialog + THIS.DisplayOptions("CURRENT") + + + ENDPROC + + PROCEDURE displayoptions + LPARAMETERS tcWhichSet + + IF VARTYPE(tcWhichSet) # "C" OR ; + (NOT INLIST(tcWhichSet,"CURRENT","SAVED")) + RETURN .F. + ENDIF + + LOCAL llCurrent, lvValue + llCurrent = (tcWhichSet = "CURRENT") + + IF NOT llCurrent + RESTORE FROM MEMO (THIS.oApp.cUserTableAlias+".UserOpts") ADDITIVE + * local array laOptions now exists + ENDIF + + IF llCurrent + lvValue = THIS.oApp.GetUserOptionSetting("BELL") + ELSE + lvValue = THIS.oApp.GetUserOptionSetting("BELL", @laOptions) + ENDIF + IF VARTYPE(lvValue) # "C" + lvValue = SET("BELL") + ENDIF + IF lvValue = "OFF" + THIS.opgBell.Value = 1 + ELSE + THIS.opgBell.Value = 2 + ENDIF + + IF llCurrent + lvValue = THIS.oApp.GetUserOptionSetting("BELL TO") + ELSE + lvValue = THIS.oApp.GetUserOptionSetting("BELL TO", @laOptions) + ENDIF + IF VARTYPE(lvValue) = "C" + lvValue = STRTRAN(UPPER(lvValue),",0","") + lvValue = STRTRAN(lvValue,"[","") + lvValue = ALLTRIM(STRTRAN(lvValue,"]","")) + IF (NOT EMPTY(lvValue)) AND FILE(lvValue) + THIS.opgBell.Value = 3 + THIS.txtBell.Value = lvValue + ELSE + THIS.txtBell.Value = SET("BELL",1) + ENDIF + ELSE + THIS.txtBell.Value = SET("BELL",1) + ENDIF + + + IF llCurrent + lvValue = THIS.oApp.GetUserOptionSetting("CONFIRM") + ELSE + lvValue = THIS.oApp.GetUserOptionSetting("CONFIRM", @laOptions) + ENDIF + IF VARTYPE(lvValue) # "C" + THIS.chkConfirm.Value = (SET("CONFIRM") = "ON") + ELSE + THIS.chkConfirm.Value = (lvValue = "ON") + ENDIF + + IF llCurrent + lvValue = THIS.oApp.GetUserOptionSetting("SHOWTIPS") + ELSE + lvValue = THIS.oApp.GetUserOptionSetting("SHOWTIPS", @laOptions) + ENDIF + IF VARTYPE(lvValue) # "L" + THIS.chkShowTips.Value = THIS.ShowTips + ELSE + THIS.chkShowTips.Value = lvValue + ENDIF + + IF llCurrent + lvValue = THIS.oApp.GetUserOptionSetting("cTextDisplayFont") + ELSE + lvValue = THIS.oApp.GetUserOptionSetting("cTextDisplayFont", @laOptions) + ENDIF + IF VARTYPE(lvValue) # "C" + THIS.cboTextDisplayFont.Value = THIS.oApp.cTextDisplayFont + ELSE + THIS.cboTextDisplayFont.Value = lvValue + ENDIF + + IF llCurrent + lvValue = THIS.oApp.GetUserOptionSetting("HOURS") + ELSE + lvValue = THIS.oApp.GetUserOptionSetting("HOURS", @laOptions) + ENDIF + IF VARTYPE(lvValue) # "C" + lvValue = TRANSFORM(SET("HOURS")) + ENDIF + IF THIS.opgHours.Buttons(1).Caption $ lvValue + THIS.opgHours.Value = 1 + ELSE + THIS.opgHours.Value = 2 + ENDIF + + ENDPROC + + PROCEDURE displayuserdefaultoptions + * show values from default record in the dialog + THIS.DisplayOptions("SAVED") + + + ENDPROC + + PROCEDURE KeyPress + LPARAMETERS nKeyCode, nShiftAltCtrl + IF nKeyCode = 27 + THIS.Release() + ENDIF + ENDPROC + + PROCEDURE saveuseroptionsfromdisplay + THIS.SetFromDisplay("SAVE") + + + + ENDPROC + + PROCEDURE setfromdisplay + LPARAMETERS tcWhichSet + IF VARTYPE(tcWhichSet) # "C" OR ; + (NOT INLIST(tcWhichSet,"CURRENT","SAVE")) + RETURN .F. + ENDIF + + LOCAL llCurrent, lcArray, loForm, loMediator + llCurrent = (tcWhichSet = "CURRENT") + + IF llCurrent + lcArray = "THIS.oApp.aCurrentUserOpts" + ELSE + LOCAL ARRAY laOptions[1,4] + lcArray = "laOptions" + ENDIF + + DIME &lcArray.[6,4] + * change depending on how many options you have... + * and fill the array any way you want, just + * so long as your usage matches + * what you put in the array! + + &lcArray.[1,1] = "SHOWTIPS" + &lcArray.[1,2] = THIS.chkShowTips.Value + &lcArray.[1,3] = .F. && form or form member property + &lcArray.[1,4] = .F. && private to datasessions/enabled forms, ; + && and applied only on that level as requested + && by form mediator object + + &lcArray.[2,1] = "CONFIRM" + &lcArray.[2,2] = IIF(THIS.chkConfirm.Value,"ON","OFF") + &lcArray.[2,3] = .T. && SET, not form or form member property + &lcArray.[2,4] = .F. + + &lcArray.[3,1] = "HOURS" + &lcArray.[3,2] = "TO "+THIS.opgHours.Buttons(THIS.opgHours.Value).Caption + &lcArray.[3,3] = .T. && SET, not form or form member property + &lcArray.[3,4] = .F. + + + &lcArray.[4,1] = "cTextDisplayFont" + &lcArray.[4,2] = IIF(EMPTY(THIS.cboTextDisplayFont.Value), ; + THIS.oApp.cTextDisplayFont, ; + THIS.cboTextDisplayFont.Value) + &lcArray.[4,3] = .F. && application or application member property + &lcArray.[4,4] = .T. && set on a global level, not form/session private + + &lcArray.[5,1] = "BELL" + &lcArray.[5,2] = IIF(THIS.opgBell.Value = 1, "OFF","ON") + &lcArray.[5,3] = .T. && SET, not app or app member property + &lcArray.[5,4] = .T. + + &lcArray.[6,1] = "BELL TO" + * I could have placed the word either in the first or + * second part of the 'SET phrase', as you + * can see from the SET HOURS entry, but in this case + * putting it in the first one allows me to identify the + * two SET BELL items uniquely later, when I use the + * application.GetUserOptionSetting() method to find them. + &lcArray.[6,2] = " " + IF THIS.opgBell.Value = 3 AND (NOT EMPTY(ALLTRIM(THIS.txtBell.Value))) + &lcArray.[6,2] = &lcArray.[6,2]+"["+ALLTR(THIS.txtBell.Value)+"],0" + ENDIF + &lcArray.[6,3] = .T. + &lcArray.[6,4] = .T. + + IF llCurrent + + THIS.oApp.ApplyGlobalUserOptions() + IF _SCREEN.FormCount > 0 + * I am deliberately using + * _SCREEN rather than THIS.oApp.aForms + * here to account for collaborators or + * a modal dialog under this one -- + * anything that has a mediator, + * not just anything in the aForms modeless + * collection, should have properties applied. + * It's faster, too, and I don't have to + * distinguish between forms and formsets in + * the _SCREEN collection + + FOR EACH loForm IN _SCREEN.Forms + loMediator = THIS.oApp.GetFormMediatorRef(loForm) + IF VARTYPE(loMediator) = "O" + loMediator.DoSessionSets() + loForm.Refresh() + ENDIF + ENDFOR + ENDIF + + ELSE + + REPLACE (THIS.oApp.cUserTableAlias+".UserOpts") WITH "" && this may avoid some bloat + SAVE ALL LIKE laOptions TO MEMO (THIS.oApp.cUserTableAlias+".UserOpts") + THIS.cmdResetToDefault.Enabled = .T. + + ENDIF + + + + ENDPROC + + PROCEDURE setuseroptionsfromdisplay + THIS.SetFromDisplay("CURRENT") + + ENDPROC + + PROCEDURE cboTextDisplayFont.Init + LOCAL ARRAY laFonts[1] + LOCAL lcFont + + IF NOT EMPTY(AFONT(laFonts)) + FOR EACH lcFont IN laFonts + THIS.AddItem(lcFont) + ENDFOR + ENDIF + + ENDPROC + + PROCEDURE cmdApply.Click + THISFORM.SetUserOptionsFromDisplay() + WAIT WINDOW NOWAIT LEFT(OPTIONS_APPLIED_LOC,254) + + + + + + ENDPROC + + PROCEDURE cmdPickWav.Click + LOCAL lcFile + lcFile = UPPER(ALLTRIM(GETFILE("wav"))) + IF EMPTY(lcFile) OR (NOT FILE(lcFile)) + THISFORM.txtBell.Value = "" + IF THISFORM.opgBell.Value = 3 + THISFORM.opgBell.Value = 2 + ENDIF + ELSE + THISFORM.txtBell.Value = lcFile + THISFORM.opgBell.Value = 3 + ENDIF + ENDPROC + + PROCEDURE cmdResetToDefault.Click + * get values from current record + THISFORM.DisplayUserDefaultOptions() + WAIT WINDOW NOWAIT LEFT(OPTIONS_DEFAULTS_SHOWN_LOC,254) + + ENDPROC + + PROCEDURE cmdSetDefault.Click + * save values from this dialog to + * to current record -- not to current values + THISFORM.SaveUserOptionsFromDisplay() + + WAIT WINDOW NOWAIT LEFT(OPTIONS_DEFAULTS_SAVED_LOC,254) + + + + ENDPROC + + PROCEDURE opgBell.InteractiveChange + IF THIS.Value = 3 AND EMPTY(THISFORM.txtBell.Value) + THISFORM.cmdPickWav.Click() + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS _reportpicker AS _documentpicker OF "_framewk.vcx" && superclass for framework-supplied dialog to execute or modify (in New mode -- not yet implemented) a report document + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_framewk.h" + * + Caption = "Choose a report to run" + DoCreate = .T. + Name = "_reportpicker" + lstDocuments.Name = "lstDocuments" + cmdOK.Name = "cmdOK" + cmdCancel.Name = "cmdCancel" + * + + PROCEDURE execdocument + LOCAL liRow + + liRow = THISFORM.lstDocuments.Value + + IF EMPTY(liRow) + RETURN + ENDIF + + DO CASE + + CASE NOT EMPTY(THIS.aDocuments[liRow,4]) && alt-exec + LOCAL lcStatement + lcStatement = ALLTR(THIS.aDocuments[liRow,4]) + + &lcStatement + + CASE THIS.aDocuments[liRow,3] && wrapped + DO (ALLTRIM(THIS.aDocuments[liRow,2])) + + OTHERWISE && report + + THIS.oApp.DoReport(ALLTRIM(THIS.aDocuments[liRow,2]), ; + ALLTRIM(THIS.aDocuments[liRow,1])) + + ENDCASE + + + + ENDPROC + + PROCEDURE filldocumentsarray + LPARAMETERS tcMetaTableName + + DIME THIS.aDocuments[1,4] + + IF EMPTY(tcMetaTableName) + + RETURN .F. + + ENDIF + + + LOCAL lcConditions + + IF THIS.lNew + lcConditions = " AND DOC_NEW " + ELSE + lcConditions = " AND DOC_OPEN " + ENDIF + + lcConditions = lcConditions + " AND NOT DELETED() " + + IF THIS.lSorted + lcConditions = lcConditions + " ORDER BY 1 " + ENDIF + + + SELECT DOC_DESCR, DOC_EXEC, ; + DOC_WRAP, ALT_EXEC ; + FROM (tcMetaTableName) ; + WHERE DOC_TYPE = PJX_META_DOC_REPORT_TYPE ; + &lcConditions ; + INTO ARRAY THIS.aDocuments + + RETURN ( _TALLY # 0) + + + + + ENDPROC + + PROCEDURE Init + LPARAMETERS toApp, tlAdd + + IF NOT DODEFAULT(toApp,tlAdd) + RETURN .F. + ENDIF + + * note: the editing capability isn't implemented yet. + + IF tlAdd + THIS.Caption = REPORTPICKER_CAPTION_MODIFY_LOC + ELSE + THIS.Caption = REPORTPICKER_CAPTION_RUN_LOC + ENDIF + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _splash AS _form OF "..\ffc\_base.vcx" && superclass for framework-supplied default splash screen + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="imgApplication" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblApplicationName" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblCredits" UniqueID="" Timestamp="" /> + + * + *p: cauthor + *p: ccaption + *p: ccompany + *p: ccopyright + *p: cimage + *p: ctrademark + * + + * + AlwaysOnTop = .T. + AutoCenter = .T. + BorderStyle = 2 + Caption = ("") + cauthor = + ccaption = + ccompany = + ccopyright = + cimage = + Closable = .F. + ControlBox = .F. + ctrademark = + cversion = + Desktop = .T. + DoCreate = .T. + Height = 285 + KeyPreview = .T. + MaxButton = .F. + MinButton = .F. + Name = "_splash" + ShowWindow = 2 + TitleBar = 0 + Width = 305 + * + + ADD OBJECT 'imgApplication' AS _image WITH ; + BackStyle = 0, ; + Height = 120, ; + Left = 80, ; + Name = "imgApplication", ; + Stretch = 1, ; + Top = 12, ; + Width = 144 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="image" /> + + ADD OBJECT 'lblApplicationName' AS _label WITH ; + Alignment = 2, ; + AutoSize = .F., ; + Caption = "Application Name", ; + FontName = "MS Sans Serif", ; + Height = 17, ; + Left = 14, ; + Name = "lblApplicationName", ; + Top = 156, ; + Width = 276 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblCredits' AS _label WITH ; + Alignment = 2, ; + AutoSize = .F., ; + Caption = "Credits", ; + FontName = "MS Sans Serif", ; + Height = 84, ; + Left = 14, ; + Name = "lblCredits", ; + Top = 180, ; + Width = 274 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + PROCEDURE Init + LPARAMETERS tcCaption, tcVersion, tcAuthor, tcCompany, tcCopyright, tcTrademark, tcImage + + LOCAL liPCount + liPCount = PCOUNT() + + IF DODEFAULT() + + IF liPCount > 0 AND VARTYPE(tcCaption) = "C" + THIS.cCaption = tcCaption + ENDIF + IF liPCount > 1 AND VARTYPE(tcVersion) = "C" + THIS.cVersion = tcVersion + ENDIF + IF liPCount > 2 AND VARTYPE(tcAuthor) = "C" + THIS.cAuthor = tcAuthor + ENDIF + IF liPCount > 3 AND VARTYPE(tcCompany) = "C" + THIS.cCompany = tcCompany + ENDIF + IF liPCount > 4 AND VARTYPE(tcCopyright) = "C" + THIS.cCopyright = tcCopyright + ENDIF + IF liPCount > 5 AND VARTYPE(tcTrademark) = "C" + THIS.cTrademark = tcTrademark + ENDIF + IF liPcount > 6 AND VARTYPE(tcImage) = "C" + THIS.cImage = tcImage + ENDIF + + THIS.cImage = ALLTR(THIS.cImage) + IF AT(".",THIS.cImage) = 0 + THIS.cImage = THIS.cImage+".bmp" + ENDIF + THIS.cImage = FULLPATH(THIS.cImage) + + IF (FILE(THIS.cImage)) + THIS.imgApplication.Visible = .T. + THIS.imgApplication.Picture = THIS.cImage + ELSE + THIS.imgApplication.Visible = .F. + ENDIF + + IF NOT EMPTY(THIS.cCaption) + THIS.lblApplicationName.Caption = TRANS(THIS.cCaption) + ENDIF. + + THIS.lblCredits.Caption = TRANS(THIS.cAuthor) + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + TRANS(THIS.cCompany) + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + TRANS(THIS.cCopyright) + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + TRANS(THIS.cTrademark) + + THIS.lblCredits.Caption = THIS.lblCredits.Caption + ; + CHR(13)+ ; + TRANS(THIS.cVersion) + + THIS.Titlebar = 0 + + ELSE + + RETURN .F. + + ENDIF + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _standardtoolbar AS _modalawaretoolbar OF "..\ffc\_ui.vcx" && superclass for framework-supplied default startup toolbar (exists throughout the life of the application, if used) + *< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="_separator3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdNew" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOpen" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSave" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdRevert" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_separator2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdPrint" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_separator1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCut" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCopy" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdPaste" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_separator4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdHelp" UniqueID="" Timestamp="" /> + + * + *p: lprintonerecord + *p: oapp + * + + * + Caption = "Standard" + ControlBox = .F. + Height = 30 + Left = 0 + Name = "_standardtoolbar" + oapp = .NULL. + Top = 0 + Width = 242 + * + + ADD OBJECT '_separator1' AS _separator WITH ; + Height = 24, ; + Left = 136, ; + Name = "_separator1", ; + Style = 1, ; + Top = 3, ; + Width = 3 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" /> + + ADD OBJECT '_separator2' AS _separator WITH ; + Height = 35, ; + Left = 105, ; + Name = "_separator2", ; + Style = 1, ; + Top = 3, ; + Width = 5 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" /> + + ADD OBJECT '_separator3' AS _separator WITH ; + Height = 0, ; + Left = 5, ; + Name = "_separator3", ; + Top = 3, ; + Width = 0 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" /> + + ADD OBJECT '_separator4' AS _separator WITH ; + Height = 31, ; + Left = 213, ; + Name = "_separator4", ; + Style = 1, ; + Top = 3, ; + Width = 3 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="separator" /> + + ADD OBJECT 'cmdCopy' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 159, ; + Name = "cmdCopy", ; + Picture = graphics\copy.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Copy", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 9 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdCut' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 136, ; + Name = "cmdCut", ; + Picture = graphics\cut.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Cut", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdHelp' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 213, ; + Name = "cmdHelp", ; + Picture = graphics\help.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Help", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 12 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdNew' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 5, ; + Name = "cmdNew", ; + Picture = graphics\new.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "New", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdOpen' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 28, ; + Name = "cmdOpen", ; + Picture = graphics\open.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Open", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 2 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdPaste' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 182, ; + Name = "cmdPaste", ; + Picture = graphics\paste.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Paste", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 10 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdPrint' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 105, ; + Name = "cmdPrint", ; + Picture = graphics\print.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Print", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 6 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdRevert' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 74, ; + Name = "cmdRevert", ; + Picture = graphics\revert.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Revert", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 4 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSave' AS _commandbutton WITH ; + Caption = "", ; + Height = 24, ; + Left = 51, ; + Name = "cmdSave", ; + Picture = graphics\save.bmp, ; + SpecialEffect = 2, ; + ToolTipText = "Save", ; + Top = 3, ; + Width = 24, ; + ZOrderSet = 3 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="commandbutton" /> + + PROCEDURE Destroy + DODEFAULT() + THIS.oApp = .NULL. + ENDPROC + + PROCEDURE Refresh + LOCAL llActiveEditingControl + + IF THIS.lDisabledForModal + RETURN + ENDIF + + + + * .T. TO THIS.cmdNew.Enabled, ; + * THIS.cmdOpen.Enabled, ; + * THIS.cmdHelp.Enabled is already handled + * automatically, now for specific button behavior: + + LOCAL ARRAY laTempx[1] + + LOCAL liSession + + IF TYPE("_SCREEN.ActiveForm") = "O" + + WITH _SCREEN.ActiveForm + + llActiveEditingControl = (TYPE(".ActiveControl.SelText") = "C") + + STORE llActiveEditingControl AND ; + (NOT EMPTY(.ActiveControl.SelLength)) TO ; + THIS.cmdCut.Enabled, THIS.cmdCopy.Enabled + + STORE llActiveEditingControl AND ; + (NOT EMPTY(_CLIPTEXT)) TO ; + THIS.cmdPaste.Enabled + + ENDWITH + + IF VARTYPE(THIS.oApp) # "O" + STORE .F. TO THIS.cmdSave.Enabled, ; + THIS.cmdRevert.Enabled, ; + THIS.cmdPrint.Enabled, ; + THIS.cmdHelp.Enabled + ELSE + liSession = IIF(UPPER(TYPE("_SCREEN.ActiveForm.Parent.BaseClass")) == ; + "FORMSET", _SCREEN.ActiveForm.Parent.DataSessionID, ; + _SCREEN.ActiveForm.DataSessionID) + IF EMPTY(AUSED(laTempx, liSession)) + STORE .F. TO THIS.cmdSave.Enabled, ; + THIS.cmdRevert.Enabled, ; + THIS.cmdPrint.Enabled + ENDIF + + IF EMPTY(THIS.oApp.cHelpFile) + STORE .F. TO THIS.cmdHelp.Enabled + ENDIF + ENDIF + + ELSE + * no active form but may be system window ready for editing + * etc... + STORE .F. TO THIS.cmdSave.Enabled, ; + THIS.cmdRevert.Enabled, ; + THIS.cmdPrint.Enabled + + IF VARTYPE(THIS.oApp) # "O" OR EMPTY(THIS.oApp.cHelpFile) + STORE .F. TO THIS.cmdHelp.Enabled + ENDIF + + IF NOT EMPTY(WONTOP()) + STORE .T. TO THIS.cmdCut.Enabled, ; + THIS.cmdCopy.Enabled + STORE (NOT EMPTY(_CLIPTEXT)) TO ; + THIS.cmdPaste.Enabled + ELSE + STORE .F. TO THIS.cmdCut.Enabled, ; + THIS.cmdCopy.Enabled, ; + THIS.cmdPaste.Enabled + ENDIF + + ENDIF + + ENDPROC + + PROCEDURE cmdCopy.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoMenuItemInFrame("COPY") + ENDIF + + ENDPROC + + PROCEDURE cmdCut.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoMenuItemInFrame("CUT") + ENDIF + + ENDPROC + + PROCEDURE cmdHelp.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoHelp() + ENDIF + + ENDPROC + + PROCEDURE cmdNew.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoNewOpen(.T.) + ENDIF + + ENDPROC + + PROCEDURE cmdOpen.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoNewOpen() + ENDIF + + ENDPROC + + PROCEDURE cmdPaste.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoMenuItemInFrame("PASTE") + ENDIF + + ENDPROC + + PROCEDURE cmdPrint.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DoTableOutPut(THIS.Parent.lPrintOneRecord) + ENDIF + + ENDPROC + + PROCEDURE cmdRevert.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DataRevert() + ENDIF + + ENDPROC + + PROCEDURE cmdSave.Click + IF VARTYPE(THIS.Parent.oApp) = "O" + THIS.Parent.oApp.DataUpdate() + ENDIF + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _topform AS _form OF "..\ffc\_base.vcx" && superclass for "frame" or "parent window", for MDI applications existing outside _screen + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_framewk.h" + * + *p: cmenuname && Holds a unique menu name for association with this form so that it can be RELEASEd EXTENDED when the form is destroyed. + *p: oapp + * + + * + AutoCenter = .T. + Caption = "Top Form Frame window" + cmenuname = ("") + DoCreate = .T. + Height = 454 + Name = "_topform" + oapp = .NULL. + ShowWindow = 2 + Width = 631 + * + + PROCEDURE Destroy + DODEFAULT() + THIS.oApp = .NULL. + IF NOT EMPTY(THIS.cMenuName) + RELEASE MENU (THIS.cMenuName) EXTENDED + ENDIF + + + + + ENDPROC + + PROCEDURE Load + IF DODEFAULT() + THIS.cMenuName = "M"+SYS(2015) + ELSE + RETURN .F. + ENDIF + + + ENDPROC + + PROCEDURE QueryUnload + LOCAL loTemp, llReturn + + + IF VARTYPE(THIS.oApp) = "O" + + llReturn = THIS.oApp.OnShutDown(.T.) + + IF llReturn + + loTemp = THIS.oApp + THIS.oApp = .NULL. + loTemp.oFrame = .NULL. + loTemp.Release() + + ENDIF + + ELSE + + llReturn = .T. + + ENDIF + + IF NOT llReturn + + NODEFAULT + + ENDIF + + + RETURN llReturn + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _userlogin AS _dialog OF "_framewk.vcx" && superclass for framework-supplied default dialog for user login + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="txtName" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtPassword" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_label2" UniqueID="" Timestamp="" /> + + #INCLUDE "_framewk.h" + * + *m: addusernow + *m: checkpasswordinfo + *m: faillogin + *m: incrementfailedattempts + *m: oktoadduser && Abstract in the base, allows you to indicate what conditions are required to add a new user rather than simply validating existing users. + *m: storenewpasswordinfo + *p: itries && Number of tries before the user login fails. + *p: itriesallowed + *p: laddinguser + *p: lvalidpassword + *p: lvaliduser + *p: oapp + * + + PROTECTED itriesallowed + * + AlwaysOnTop = .T. + BufferMode = 1 + Caption = "User Login" + DoCreate = .T. + Height = 100 + itries = 0 + itriesallowed = 3 + KeyPreview = .T. + Name = "_userlogin" + Width = 375 + * + + ADD OBJECT '_label1' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Name:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 15, ; + Left = 8, ; + Name = "_label1", ; + Top = 24, ; + Width = 33 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT '_label2' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Password:", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 15, ; + Left = 8, ; + Name = "_label2", ; + Top = 60, ; + Width = 51 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="label" /> + + ADD OBJECT 'txtName' AS _textbox WITH ; + FontBold = .T., ; + FontName = "Courier New", ; + Height = 24, ; + Left = 68, ; + Name = "txtName", ; + SelectOnEntry = .T., ; + Top = 19, ; + Width = 294 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" /> + + ADD OBJECT 'txtPassword' AS _textbox WITH ; + FontBold = .T., ; + FontName = "Courier New", ; + Height = 24, ; + Left = 68, ; + Name = "txtPassword", ; + PasswordChar = "*", ; + SelectOnEntry = .T., ; + Top = 55, ; + Width = 294 + *< END OBJECT: ClassLib="..\ffc\_base.vcx" BaseClass="textbox" /> + + PROCEDURE addusernow + + LOCAL lcName + THIS.lAddingUser = .F. + IF THIS.OKToAdduser() + IF (MESSAGEBOX(LOGIN_ADD_USER_LOC , ; + MB_ICONEXCLAMATION+MB_YESNO, ; + LOGIN_USER_NOT_FOUND_LOC) = IDYES) + lcName = ALLTRIM(THIS.txtName.Value) + INSERT INTO (THIS.oApp.cUserTableAlias) ; + ((THIS.oApp.cUserTableIDField)) ; + VALUES (lcName) + + THIS.lAddingUser = .T. + + MESSAGEBOX(LOGIN_NEW_USER_INFO_LOC,0,THIS.Caption) + + ENDIF + ENDIF + + RETURN THIS.lAddingUser + + + + + ENDPROC + + PROCEDURE applyappattributes + LPARAMETERS toApp + LOCAL llSuccess + llSuccess = DODEFAULT(toApp) + IF llSuccess + IF VARTYPE(toApp.cUserTableAlias) # "C" OR NOT USED(toApp.cUserTableAlias) + llSuccess = .F. + ELSE + THIS.Caption = toApp.cCaption + " " + LOGIN_CAPTION_LOC + IF NOT EMPTY(toApp.cCurrentUser) + IF toApp.SeekCurrentUser() + THIS.txtName.Value = toApp.cCurrentUser + THIS.lValidUser = .T. + ELSE + THIS.lValidUser = .F. + ENDIF + ELSE + THIS.lValidUser = .F. + ENDIF + THIS.lValidPassword = .F. + THIS.oApp = toApp + ENDIF + ENDIF + IF NOT llSuccess + THIS.Release() + ENDIF + ENDPROC + + PROCEDURE checkpasswordinfo + LPARAMETERS tcValueToCheck + + RETURN (THIS.oApp.CheckPassword(tcValueToCheck)) + + ENDPROC + + PROCEDURE Destroy + THIS.oApp = .NULL. + ENDPROC + + PROCEDURE faillogin + * this is the equivalent of a failed + * SEEK in the table + IF RECCOUNT(THIS.oApp.cUserTableAlias) > 0 + GO BOTTOM IN (THIS.oApp.cUserTableAlias) + SKIP IN (THIS.oApp.cUserTableAlias) + ENDIF + + + ENDPROC + + PROCEDURE incrementfailedattempts + THIS.iTries = THIS.iTries + 1 + IF THIS.iTries >= THIS.iTriesAllowed + MESSAGEBOX(LOGIN_TRIES_EXCEEDED_LOC,MB_ICONSTOP,THIS.Caption) + THIS.FailLogIn() + THIS.Release() + ENDIF + ENDPROC + + PROCEDURE KeyPress + LPARAMETERS nKeyCode, nShiftAltCtrl + IF nKeyCode = 27 + THIS.FailLogIn() + THIS.Release() + ENDIF + + ENDPROC + + PROCEDURE oktoadduser && Abstract in the base, allows you to indicate what conditions are required to add a new user rather than simply validating existing users. + * abstract in the base, would be done + * according to any conditions you like. + * certainly there has to be some way of adding + * new users at startup, + * if no currently-valid user exists. + RETURN .T. + ENDPROC + + PROCEDURE QueryUnload + IF THIS.ReleaseType = 1 && box hit + IF THIS.lValidUser AND THIS.lValidPassword + IF THIS.lAddingUser + THIS.StoreNewPasswordInfo(ALLTR(THIS.txtPassword.Value)) + ELSE + IF NOT THIS.CheckPasswordInfo(ALLTR(THIS.txtPassword.Value)) + WAIT WINDOW LEFT(LOGIN_WRONG_PASSWORD_LOC,254) TIMEOUT 2 + THIS.txtPassword.SetFocus() + NODEFAULT + ENDIF + ENDIF + ELSE + THIS.FailLogIn() + ENDIF + ENDIF + ENDPROC + + PROCEDURE storenewpasswordinfo + LPARAMETERS tcValueToStore + ASSERT VARTYPE(tcValueToStore) = "C" + + THIS.oApp.StorePassword(tcValueToStore) + + + ENDPROC + + PROCEDURE txtName.Valid + LOCAL llSuccess + THISFORM.lValidPassword = .F. + IF EMPTY(THIS.Value) + THISFORM.lValidUser = .F. + RETURN + ENDIF + llSuccess = THISFORM.oApp.SeekCurrentUser(THIS.Value) + IF NOT llSuccess + * do they want a new user? + llSuccess = THISFORM.AddUserNow() + + ENDIF + + THISFORM.lValidUser = llSuccess + + IF NOT llSuccess + IF SET("BELL") = "ON" + ?? CHR(7) + ENDIF + WAIT WINDOW LEFT(LOGIN_USER_NOT_FOUND_LOC,254) TIMEOUT 2 + THISFORM.IncrementFailedAttempts() + ENDIF + + IF llSuccess AND (NOT THISFORM.lAddingUser) AND (NOT EMPTY(THISFORM.txtPassword.Value)) + IF THISFORM.CheckPasswordInfo(ALLTR(THISFORM.txtPassword.Value)) + THISFORM.Release() + ENDIF + ENDIF + + RETURN llSuccess + ENDPROC + + PROCEDURE txtPassword.Valid + ASSERT (NOT EOF(THISFORM.oApp.cUserTableAlias)) + LOCAL llSuccess, lcPassword + + lcPassword = ALLTRIM(THIS.Value) + + IF THISFORM.lAddingUser && (AND NOT EMPTY(lcPassword)) + THISFORM.StoreNewPasswordInfo(lcPassword) + THISFORM.lAddingUser = .F. + THISFORM.lValidUser = .T. + llSuccess = .T. + ENDIF + + DO CASE + * CASE EMPTY(lcPassword) + * THISFORM.lValidPassword = .F. + CASE THISFORM.lValidUser + llSuccess = THISFORM.CheckPasswordInfo(lcPassword) + THISFORM.lValidPassword = llSuccess + OTHERWISE + THISFORM.lValidPassword = .F. + ENDCASE + + IF llSuccess + THISFORM.Release() + ELSE + IF SET("BELL") = "ON" + ?? CHR(7) + ENDIF + IF THISFORM.lValidUser + * WAIT WINDOW TIMEOUT 2 ; + * LEFT(IIF(EMPTY(lcPassword),; + * LOGIN_EMPTY_PASSWORD_LOC,; + * LOGIN_WRONG_PASSWORD_LOC ),254) + WAIT WINDOW TIMEOUT 2 ; + LEFT(LOGIN_WRONG_PASSWORD_LOC,254) + THISFORM.IncrementFailedAttempts() + IF EMPTY(lcPassword) + RETURN 0 + ENDIF + ENDIF + ENDIF + + + + ENDPROC + +ENDDEFINE diff --git a/Clase/_reports.h b/Clase/_reports.h new file mode 100644 index 0000000..2cb19b4 --- /dev/null +++ b/Clase/_reports.h @@ -0,0 +1,87 @@ +* _REPORTS.H + +* Header file for _REPORTS.VCX classes + +* common dialog flag constants and results for ShowFont: +#DEFINE cdlCFScreenFonts 0x1 +#DEFINE cdlCFANSIOnly 0x400 +#DEFINE cdlCFForceFontExist 0x10000 +#DEFINE cdlCFNoStyleSel 0x100000 +#DEFINE cdlCFFixedPitchOnly 0x4000 + +* common dialog constants for ShowOpen/ShowSave: +#DEFINE cdlOFNPathMustExist 0x800 +#DEFINE cdlOFNNoChangeDir 0x8 +#DEFINE cdlOFNHideReadOnly 0x4 +#DEFINE cdlOFNExplorer 0x80000 +#DEFINE cdlOFNFileMustExist 0x1000 +#DEFINE cdlOFNOverwritePrompt 0x2 +#DEFINE cdlOFNNoReadOnlyReturn 0x8000 + +#DEFINE VERTICAL_SCROLLBAR_WIDTH 5 + +#DEFINE SHOWTEXT_TEXT_EDITOR_LOC "Text Viewer" + +#DEFINE WINDOWSTATE_MAXIMIZED 2 +#DEFINE WINDOWSTATE_NORM 0 + +* _dialog fonts +#DEFINE SYSTEM_LARGEFONTS FONTMETRIC(1, 'MS Sans Serif', 8, '') # 13 OR ; + FONTMETRIC(4, 'MS Sans Serif', 8, '') # 2 OR ; + FONTMETRIC(6, 'MS Sans Serif', 8, '') # 5 OR ; + FONTMETRIC(7, 'MS Sans Serif', 8, '') # 11 + +#DEFINE DIALOG_SMALLFONT_NAME "MS Sans Serif" +#DEFINE DIALOG_LARGEFONT_NAME "Arial" + +* destinations: +#DEFINE OUTPUT_PRINT_REPORT_LOC "Print report" +#DEFINE OUTPUT_PRINT_LIST_LOC "Print list from table" +#DEFINE OUTPUT_SCREEN_LOC "Preview" +#DEFINE OUTPUT_TEXTFILE_LOC "Text file" +#DEFINE OUTPUT_HTMLFILE_LOC "HTML file" +#DEFINE OUTPUT_PRINTFILE_LOC "Print-image file" +#DEFINE OUTPUT_EXPORT_LOC "Export table" + +* screen options: +#DEFINE OUTPUT_SCREEN_PREVIEW_LOC "Report Preview" +#DEFINE OUTPUT_SCREEN_GRAPHICAL_LOC "Graphical report preview" +#DEFINE OUTPUT_SCREEN_ASCII_LOC "Text report preview" +#DEFINE OUTPUT_SCREEN_BROWSE_LOC "Browse view of table" +#DEFINE OUTPUT_SCREEN_LIST_LOC "Simple list view of table" + +* HTML options: +#DEFINE OUTPUT_HTML_FILEONLY_LOC "Generate only, no display" +#DEFINE OUTPUT_HTML_VIEWSOURCE_LOC "View generated source" +#DEFINE OUTPUT_HTML_WEBVIEW_LOC "View output in web browser" + +#DEFINE OUTPUT_KEY_FOR_TOOLBAR_LOC "Press Ctrl-R to retrieve Report Preview Toolbar if necessary..." + +* print options: +#DEFINE OUTPUT_PRINT_OPTIONS_WINDEFAULT_LOC "Windows default printer" +#DEFINE OUTPUT_PRINT_OPTIONS_VFPDEFAULT_LOC "VFP default printer" +#DEFINE OUTPUT_PRINT_OPTIONS_SETVFPDEFAULT_LOC "Select and use new VFP default" + +#DEFINE OUTPUT_DESTINATION_TEXTFILE_LOC "Pick a destination text filename" +#DEFINE OUTPUT_SOURCE_REPORT_LOC "Pick a report" + +#DEFINE OUTPUT_REPORT_NOT_FOUND_LOC "Report not found!" + +#DEFINE OUTPUT_REPORT_OR_DATASOURCE_REQUIRED_LOC "This dialog needs report or table datasource information." +#DEFINE MB_ICONEXCLAMATION 48 + +* export options + +#DEFINE OUTPUT_EXPORT_EXCEL97 "Excel 97" +#DEFINE OUTPUT_EXPORT_EXCEL5 "Excel 5.0" +#DEFINE OUTPUT_EXPORT_EXCEL2 "Excel 2.0" +#DEFINE OUTPUT_EXPORT_FOX2X "Fox 2.X" +#DEFINE OUTPUT_EXPORT_FOXPLUS "Xbase" +#DEFINE OUTPUT_EXPORT_FIXEDLEN "Fixed Length" +#DEFINE OUTPUT_EXPORT_DELIMITED "Delimited" +#DEFINE OUTPUT_EXPORT_LOTUS2 "Lotus 2.x" +#DEFINE OUTPUT_EXPORT_DIF "Data Interchange Format" +#DEFINE OUTPUT_EXPORT_SYMPHONY "Symphony 1.10" +#DEFINE OUTPUT_EXPORT_CSV "Separated Values" + + diff --git a/Clase/_reports.vc2 b/Clase/_reports.vc2 new file mode 100644 index 0000000..9980396 --- /dev/null +++ b/Clase/_reports.vc2 @@ -0,0 +1,2495 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="_reports.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS _output AS _container OF "_base.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cusWindows" UniqueID="" Timestamp="" /> + + #INCLUDE "_reports.h" + * + *m: calias_assign + *m: cdestination_assign + *m: cdisplayfontname_assign + *m: coption_assign + *m: copytable && Exports a table. + *m: creport_assign + *m: cscope_assign + *m: ctextfile_assign + *m: cvfpprintername_access + *m: genhtml && Generates HTML output. + *m: lpreventsourcechanges_assign + *m: output && This is main method that is called to generate output based on settings. + *m: outputtoscreen && Outputs to screen. + *m: printlist + *m: printreport + *m: setdestinations && Controls available output destinations. + *m: setoptions && Drives options for output destinations. + *m: setoutputprinter + *m: setvfpprinter + *p: calias && This is the data source that will be used for non-report/label output formats. This property will default to the current alias, if any. + *p: cdestination && This is list of available destinations which changes dynamically depending on whether cReport, cAlias, or both, are filled out. The list of available destinations is stored in aDestinations[] array. + *p: cdisplayfontname && This is used for on-screen display of output, for example in a BROWSE or when the _Showtext class is instantiated for text display. + *p: cfieldlist && A comma-delimited list of fields or expressions. It affects only direct data sources (BROWSEs and LISTs). + *p: chtmlclass && Optional HTML class and classlib passed to _GENHTML. + *p: chtmlstyleid && Optional HTML style passed to _GENHTML. + *p: coption && The list of available options which changes dynamically to fit the current cDestination. + *p: creport && This is a label or report form suitable for VFP-formatted output. + *p: cscope && This can be used to specify a macro-expanded string to be added to the command that executes the actual output. It must be a legal scope such as "FOR ". + *p: ctextfile && This is the file name for all output destinations that go to disk, which include text files, printer-image files, and export formats. + *p: cvfpprintername && This is the name of the current VFP default printer as distinct from the Windows default printer. + *p: laddsourcenametodropdown && Affects how some destinations show in the aDestinations array. + *p: lpreventsourcechanges && Prevents source changes for cAlias or cReport. + *a: adestinations[1,2] && Array of destinations. + *a: aoptions[1,2] && Array of destination output options. + * + + * + BackStyle = 0 + BorderWidth = 0 + calias = ("") + cdestination = ("PRINTREPORT") + cdisplayfontname = ("Courier New") + cfieldlist = ("") + chtmlclass = + chtmlstyleid = ("") + coption = ("WINDEFAULT") + creport = ("") + cscope = ("") + ctextfile = ("") + cvfpprintername = ("") + Height = 27 + laddsourcenametodropdown = .T. + Name = "_output" + Width = 33 + * + + ADD OBJECT 'cusWindows' AS _windowhandler WITH ; + Left = 0, ; + Name = "cusWindows", ; + Top = 0 + *< END OBJECT: ClassLib="_ui.vcx" BaseClass="custom" /> + + PROCEDURE calias_assign + LPARAMETERS tcNewVal + LOCAL lcNewVal, llSame + + IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal) OR NOT USED(tcNewVal) + lcNewVal = "" + ELSE + lcNewVal = ALLTR(PROPER(tcNewVal)) + ENDIF + + llSame = (THIS.cAlias == lcNewVal) + THIS.cAlias = lcNewVal + + IF NOT llSame + THIS.SetDestinations() + ENDIF + + + + ENDPROC + + PROCEDURE cdestination_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" + THIS.cDestination = THIS.aDestinations[1,2] + ELSE + THIS.cDestination = UPPER(ALLTRIM(tcNewVal)) + ENDIF + + THIS.SetDestinations() + + ENDPROC + + PROCEDURE cdisplayfontname_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal) + RETURN + ENDIF + + LOCAL laTemp[1], lcVal, lcFont + lcVal = ALLTR(tcNewVal) + + IF NOT EMPTY(AFONT(laTemp)) + + FOR EACH lcFont IN laTemp + IF UPPER(lcVal) == UPPER(lcFont) + THIS.cDisplayFontName = lcVal + EXIT + ENDIF + ENDFOR + + ENDIF + + ENDPROC + + PROCEDURE coption_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" + THIS.cOption = THIS.aOptions[1,2] + ELSE + THIS.cOption = UPPER(ALLTRIM(tcNewVal)) + ENDIF + + + ENDPROC + + PROCEDURE copytable && Exports a table. + LOCAL lcClauses, lcFile + + IF .F. && NOT EMPTY(THIS.cFieldList) + * the fields list cannot be trusted for COPY TO, + * because expressions in the fields list are + * not likely to work. + * We could make it the developer's responsibility to + * set the FIELDS list properly before + * calling this option/"EXPORT" as destination, + * but it is just as easy for the developer + * to use an alias with the fields already formatted + * and chosen, either with a SELECT or a SET FIELDS + * so it's better not to leave this in place. + + lcClauses = STRTRAN(THIS.cFieldList,CHR(13),",") + lcClauses = " FIELDS "+lcClauses + + ELSE + + lcClauses = "" + + ENDIF + + IF NOT EMPTY(THIS.cScope) + lcClauses = lcClauses + " " + THIS.cScope + ENDIF + + lcClauses = lcClauses + " TYPE "+THIS.cOption + + lcFile = ALLTRIM(THIS.cTextFile) + + DO CASE + CASE EMPTY(lcFile) + lcFile = "R"+SYS(2015) + CASE RIGHT(lcFile,1) = "\" + lcFile = lcFile + "R"+SYS(2015) + OTHERWISE + * we're okay + ENDCASE + + IF AT(".",lcFile) = 0 + + *&* change in VFP 7 -- extension for delimited files + *&* explicitly set + + DO CASE + CASE THIS.cOption = "DELIMITED" + lcFile = lcFile + ".ASC" + CASE LEN(THIS.cOption) > 3 + lcFile = lcFile + ".DBF" + OTHERWISE + lcFile = lcFile + "."+THIS.cOption + ENDCASE + + ENDIF + + lcFile = FULLPATH(lcFile) + THIS.cTextFile = lcFile + + COPY TO (lcFile) &lcClauses + + ENDPROC + + PROCEDURE creport_assign + LPARAMETERS tcNewVal + LOCAL lcNewVal, llSame + + IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal) + lcNewVal = "" + ELSE + lcNewVal = ALLTR(tcNewVal) + IF AT(".",lcNewVal) = 0 + lcNewVal = lcNewVal + ".FRX" + ENDIF + IF NOT FILE(lcNewVal) + lcNewVal = FULLPATH(lcNewVal) + IF NOT FILE(lcNewVal) + IF INLIST(_VFP.Startmode,0,4) + ?? CHR(7) + WAIT WINDOW NOWAIT LEFTC(OUTPUT_REPORT_NOT_FOUND_LOC,254) + ENDIF + lcNewVal = "" + ENDIF + ENDIF + ENDIF + + llSame = (THIS.cReport == lcNewVal) + THIS.cReport = lcNewVal + + IF NOT llSame + THIS.SetDestinations() + ENDIF + + ENDPROC + + PROCEDURE cscope_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) = "C" + THIS.cScope = tvNewVal + ENDIF + + ENDPROC + + PROCEDURE ctextfile_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) = "C" + LOCAL liPos, lcVal + liPos = RAT("\",tvNewVal) + IF liPos > 0 + IF NOT DIRECTORY(LEFT(tvNewVal,liPos)) + lcVal = SUBSTR(tvNewVal,liPos+1) + ELSE + lcVal = tvNewVal + ENDIF + ELSE + liPos = AT(":",tvNewVal) + IF liPos > 0 AND ; + (liPos = LEN(tvNewVal) OR ; + SUBSTR(tvNewVal,liPos+1,1) # "\" ) + lcVal = STUFF(tvNewVal,liPos+1,0,"\") + ELSE + lcVal = tvNewVal + ENDIF + liPos = RAT("\",lcVal) + IF NOT DIRECTORY(LEFT(lcVal,liPos)) + lcVal = SUBSTR(lcVal, liPos+1) + ENDIF + ENDIF + + THIS.cTextfile = lcVal + + ENDIF + + ENDPROC + + PROCEDURE cvfpprintername_access + *!* this is the VF 5 code replaced by the new RETURN line! + *!* IF EMPTY(THIS.cVFPPrinterName) + *!* LOCAL lcAlias, liSelect, liLine, lcLine, liMemoWidth, lcContents, lcFieldsList + *!* + *!* IF SET("FIELDS") = "ON" + *!* lcFieldsList = SET("FIELDS",1) + *!* SET FIELDS OFF + *!* ENDIF + *!* + *!* liMemoWidth = SET("MEMOWIDTH") + *!* liSelect = SELECT() + *!* lcAlias = "C"+SYS(2015) + *!* SELECT 0 + *!* SET MEMOWIDTH TO 1024 + *!* CREATE CURSOR (lcAlias) (onefield l) + *!* CREATE REPORT (lcAlias) FROM (lcAlias) + *!* USE IN (lcAlias) + *!* USE (lcAlias+".FRX") ALIAS (lcAlias) + *!* lcContents = Expr + *!* USE IN (lcAlias) + *!* ERASE (lcAlias+".FRX") NORECYCLE + *!* ERASE (lcAlias+".FRT") NORECYCLE + *!* liLine = ATCLINE("DEVICE=",lcContents) + *!* IF EMPTY(liLine) + *!* liLine = ATCLINE("DEVICE =",lcContents) + *!* ENDIF + *!* lcLine = MLINE(lcContents,liLine) + *!* SELECT (liSelect) + *!* SET MEMOWIDTH TO liMemoWidth + *!* THIS.cVFPPrinterName = ALLTR(SUBSTRC(lcLine,AT("=",lcLine)+1)) + *!* + *!* IF NOT EMPTY(lcFieldsList) + *!* SET FIELDS ON + *!* SET FIELDS TO + *!* SET FIELDS TO &lcFieldsList + *!* ENDIF + + *!* ENDIF + + *!* RETURN THIS.cVFPPrinterName + RETURN SET("PRINTER",3) + ENDPROC + + PROCEDURE genhtml && Generates HTML output. + ASSERT (NOT EMPTY(THIS.cReport+THIS.cAlias)) + ASSERT IIF(NOT EMPTY(THIS.cReport), FILE(THIS.cReport), .T.) + ASSERT IIF(NOT EMPTY(THIS.cAlias), USED(THIS.cAlias), .T.) + + LOCAL lcFile, lvClass,liShow, lvDummy, lcScope, lvStyle, lcSource + + IF (EMPTY(_GENHTML) OR ; + (NOT (FILE(_GENHTML) OR FILE(_GENHTML+".FXP"))) ) + _GENHTML = "" + RETURN + ENDIF + + IF VARTYPE(THIS.cHTMLClass) = "C" AND (NOT EMPTY(THIS.cHTMLClass)) + lvClass = THIS.cHTMLClass + ENDIF + + IF VARTYPE(THIS.cHTMLStyleID) = "C" AND (NOT EMPTY(THIS.cHTMLStyleID)) + lvStyle = THIS.cHTMLStyleID + ENDIF + + IF VARTYPE(THIS.cScope) = "C" AND (NOT EMPTY(THIS.cScope)) + lcScope = THIS.cScope + ELSE + lcScope = "ALL" + ENDIF + + DO CASE + CASE THIS.cOption = "VIEWSOURCE" + liShow = 1 + CASE THIS.cOption = "WEBVIEW" + liShow = 2 + OTHERWISE + liShow = 0 + ENDCASE + + + lcFile = ALLTRIM(THIS.cTextFile) + + DO CASE + CASE EMPTY(lcFile) + lcFile = "R"+SYS(2015) + CASE RIGHT(lcFile,1) = "\" + lcFile = lcFile + "R"+SYS(2015) + OTHERWISE + * we're okay + ENDCASE + + IF AT(".",lcFile) = 0 + lcFile = lcFile + ".HTM" + lcFile = FULLPATH(lcFile) + ENDIF + + THIS.cTextFile = lcFile + + IF EMPTY(THIS.cReport) + DO CASE + CASE EMPTY(THIS.cFieldList) + lcSource = THIS.cAlias + CASE CHR(13) $ THIS.cFieldList + lcSource = THIS.cAlias+CHR(13)+THIS.cFieldList + OTHERWISE + lcSource = THIS.cAlias+","+THIS.cFieldList + ENDCASE + DO (_GENHTML) WITH lcFile, lcSource, liShow, lvDummy, lvStyle, lcScope, lvClass + ELSE + DO (_GENHTML) WITH lcFile, THIS.cReport, liShow, lvDummy, lvStyle, lcScope, lvClass + ENDIF + + * GENHTML Parameter list: + * tcOutFile: Output file name (defaults to .HTM extension). + * tvSource: Source file name, alias, or object. + * tvSource can contain alias delimited by either CR's or commas + * from a delimited list of fields to be generated (field list + * using same delimiter as separator from alias) + * tnShow: 0/Empty = Generate output file only. + * 1 = Create output file and view generated source file. + * 2 = Create output file and show generated file in internet browser. + * 3 = Create _oHTML object. + * 4 = Create _oHTML object only, no prompt for output file, no prompt for + * source file. + * tvIELink: Create link to InternetExplorer.Application using automation. + * tcHTMLStyleID Style from style table + * tcHTMLScope scope clause + * tcHTMLClass: delimited string holding Class, Classlib, IN EXE/APP for instantiated for HTML object. + + + + ENDPROC + + PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + THIS.SetDestinations() + IF EMPTY(THIS.cAlias) + THIS.cAlias = ALIAS() + ENDIF + + + + ENDPROC + + PROCEDURE lpreventsourcechanges_assign + LPARAMETERS m.vNewVal + THIS.lpreventsourcechanges = m.vNewVal + THIS.SetDestinations() + + ENDPROC + + PROCEDURE output && This is main method that is called to generate output based on settings. + LOCAL liSelect + + IF NOT EMPTY(THIS.cAlias) + liSelect = SELECT() + SELECT (THIS.cAlias) + ENDIF + + DO CASE + CASE INLIST("#"+THIS.cDestination+"#","#PRINTREPORT#","#PRINTFILE#","#TEXTFILE#") + THIS.PrintReport() + CASE THIS.cDestination = "HTMLFILE" + THIS.GenHTML() + CASE THIS.cDestination = "PRINTLIST" + THIS.PrintList() + CASE THIS.cDestination = "SCREEN" + THIS.OutputToScreen() + CASE THIS.cDestination = "EXPORT" + THIS.CopyTable() + ENDCASE + + IF NOT EMPTY(liSelect) + SELECT (liSelect) + ENDIF + + ENDPROC + + PROCEDURE outputtoscreen && Outputs to screen. + ASSERT EMPTY(THIS.cReport) OR ; + (VARTYPE(THIS.cReport) = "C" AND ; + (FILE(THIS.cReport) OR FILE(THIS.cReport+".FRX"))) + + ASSERT EMPTY(THIS.cAlias) OR ; + (VARTYPE(THIS.cAlias) = "C" AND ; + USED(THIS.cAlias)) + + ASSERT EMPTY(THIS.cFieldList) OR ; + VARTYPE(THIS.cFieldList) = "C" + + IF EMPTY(THIS.cReport) AND ; + INLIST("#"+THIS.cOption+"#","#ASCII#","#GRAPHICAL#") + RETURN .F. + ENDIF + + IF EMPTY(THIS.cAlias) AND ; + INLIST("#"+THIS.cOption+"#","#BROWSE#","#LIST#") AND ; + EMPTY(ALIAS()) + RETURN .F. + ENDIF + + LOCAL lcWindow, lcName, loWindow, lcClauses, ; + lcFileName, loTopForm, llInFoxFrame, ; + liPos, lcChar, liFieldNo, lcExpr + + + * the saving and restoring of calling windows + * is important to deal with modal calling windows: + lcWindow = WONTOP() + + loTopForm = THIS.cusWindows.GetCurrentTopFormRef() + + llInFoxFrame = (UPPER(loTopForm.Name) == "SCREEN") + + IF INLIST("#"+THIS.cOption+"#","#BROWSE#","#GRAPHICAL#") + + lcName = "W"+SYS(2015) + + *!* DEFINE WINDOW (lcName) ; + *!* FROM 0,0 TO SROWS(), SCOLS() ; + *!* SYSTEM FLOAT GROW ZOOM CLOSE FONT (THIS.cDisplayFontName) ; + *!* TITLE OUTPUT_SCREEN_PREVIEW_LOC ; + *!* NAME (lcName) + + DEFINE WINDOW (lcName) ; + AT 0,0 SIZE 20,20 ; + SYSTEM FLOAT GROW ZOOM CLOSE FONT (THIS.cDisplayFontName) ; + TITLE OUTPUT_SCREEN_PREVIEW_LOC ; + NAME (lcName) IN WINDOW (loTopForm.Name) + + loWindow = EVAL(lcName) + loWindow.FontName = THIS.cDisplayFontName + loWindow.Height = (loTopForm.Height * 2)/3 + loWindow.Width = (loTopForm.Width * 2)/3 + + ELSE + + LOCAL lcFile + lcFile = FULLPATH(THIS.ClassLibrary) + loWindow = NEWOBJECT("_ShowText", lcFile) + + IF TYPE("loWindow.Name") = "C" + lcName = loWindow.Name + loWindow.lSuppressCaptionChange = .T. + loWindow.cFixedFontName = THIS.cDisplayFontName + loWindow.SetFonts() + + ELSE + RETURN .F. + ENDIF + + ENDIF + + loWindow.Icon = loTopForm.Icon + + IF INLIST("#"+THIS.cOption+"#","#BROWSE#","#LIST#") AND ; + NOT EMPTY(THIS.cFieldList) + + + IF THIS.cOption == "BROWSE" + * take care of the fact that calculated fields + * will need fieldaliases in a browse: + liFieldNo = 1 + lcExpr = "" + + IF CHR(13) $ THIS.cFieldList + + LOCAL ARRAY laFields[1] + + lcClauses = "" + + FOR liFieldNo = 2 TO ALINES(laFields,THIS.cFieldList, .T.) + lcClauses = lcClauses + ; + ",Field"+ALLTR(STR(liFieldNo))+"=" + ; + laFields[liFieldNo] + ENDFOR + + lcClauses = "Field1="+laFields[1]+lcClauses + + ELSE + + lcClauses = "Field1=" + + FOR liPos = 1 TO LEN(THIS.cFieldList) + lcChar = SUBSTR(THIS.cFieldList,liPos,1) + IF lcChar = "," + IF TYPE(lcExpr) # "U" + lcExpr = "" + liFieldNo = liFieldNo + 1 + lcClauses = lcClauses + ",Field"+ALLTR(STR(liFieldNo))+"=" + ELSE + lcExpr = lcExpr + "," + lcClauses = lcClauses + "," + ENDIF + ELSE + lcExpr = lcExpr + lcChar + lcClauses = lcClauses + lcChar + ENDIF + ENDFOR + ENDIF + + ELSE + + lcClauses = STRTRAN(THIS.cFieldList,CHR(13),",") + + ENDIF + + lcClauses = " FIELDS "+lcClauses + + ELSE + + lcClauses = "" + + ENDIF + + IF INLIST("#"+THIS.cOption+"#","#LIST#","#ASCII#") + + + lcFileName = "R"+SYS(2015)+".TXT" + + + ENDIF + + IF THIS.cOption == "BROWSE" + + lcClauses = lcClauses + " NOEDIT NODELETE NOAPPEND NOMENU " + ENDIF + + IF THIS.cOption == "BROWSE" OR ; + THIS.cOption == "GRAPHICAL" + + lcClauses = lcClauses+ " WINDOW (lcName) IN WINDOW (loTopForm.Name)" + + ENDIF + + IF NOT EMPTY(THIS.cScope) + lcClauses = lcClauses + " " + THIS.cScope + ENDIF + + + DO CASE + + CASE THIS.cOption == "ASCII" + + _ASCIICOLS = 80 + _ASCIIROWS = 63 + + REPORT FORM (THIS.cReport) ASCII ; + TO FILE (lcFileName) NOCONSOLE &lcClauses + + loWindow.cSourceFile = lcFileName + loWindow.Show(1) + ERASE (lcFileName) NORECYCLE + + + CASE THIS.cOption == "GRAPHICAL" + + ZOOM WINDOW (lcName) MAX + + IF SET("REPORTB") = 90 AND ATC("NOWAIT",lcClauses) = 0 + lcClauses = lcClauses + " NOWAIT " + ENDIF + + REPORT FORM (THIS.cReport) PREVIEW &lcClauses + + IF ATC(" NOWAIT ",lcClauses) > 0 AND ; + TYPE("THISFORM") = "O" AND ; + THISFORM.WindowType = 1 && modal + RELEASE THISFORM + ENDIF + + CASE THIS.cOption == "LIST" + + LIST OFF TO FILE (lcFileName) &lcClauses NOCONSOLE + loWindow.cSourceFile = lcFileName + loWindow.Show(1) + ERASE (lcFileName) NORECYCLE + + + CASE THIS.cOption == "BROWSE" + + BROWSE &lcClauses + + OTHERWISE + + * ? + + ENDCASE + + + *!* IF THIS.cOption # "GRAPHICAL" + *!* * report graphical preview takes special + *!* * sequence of window handling, in the CASE above + IF NOT EMPTY(lcWindow) + ACTIVATE WINDOW (lcWindow) SAME + ENDIF + *!* ENDIF + + RELEASE WINDOW (lcName) + + RETURN + + ENDPROC + + PROCEDURE printlist + LOCAL lcClauses + + THIS.SetOutputPrinter() + + IF NOT EMPTY(THIS.cFieldList) + + lcClauses = STRTRAN(THIS.cFieldList,CHR(13),",") + lcClauses = " FIELDS "+lcClauses + + ELSE + + lcClauses = "" + + ENDIF + + IF NOT EMPTY(THIS.cScope) + lcClauses = lcClauses + " " + THIS.cScope + ENDIF + + LIST OFF &lcClauses TO PRINT NOCONSOLE + + + + + + + ENDPROC + + PROCEDURE printreport + ASSERT (NOT EMPTY(THIS.cReport)) AND FILE(THIS.cReport) + + * note: the HTML portion of this method is not currently + * in use, we're going through _GENHTML on HTML output + * for either alias or report. However, REPORT FORM ... TO HTML + * might be added to the language at some point + + LOCAL lcClauses, lcDestination,lcFile + + IF NOT INLIST(THIS.cDestination,"TEXTFILE","HTMLFILE") + THIS.SetOutputPrinter() + ENDIF + + IF NOT EMPTY(THIS.cScope) + lcClauses = THIS.cScope + ELSE + lcClauses = "" + ENDIF + + IF THIS.cDestination # "PRINTREPORT" + + lcFile = ALLTRIM(THIS.cTextFile) + DO CASE + CASE EMPTY(lcFile) + lcFile = "R"+SYS(2015) + CASE RIGHT(lcFile,1) = "\" + lcFile = lcFile+ "R"+SYS(2015) + OTHERWISE + * we're okay + ENDCASE + IF AT(".",lcFile) = 0 + DO CASE + CASE THIS.cDestination = "PRINTFILE" + lcFile = lcFile + ".PRN" + CASE THIS.cDestination = "HTMLFILE" + lcFile = lcFile + ".HTM" + OTHERWISE + lcFile = lcFile + ".TXT" + ENDCASE + ENDIF + lcFile = FULLPATH(lcFile) + + ENDIF + + DO CASE + + CASE THIS.cDestination = "TEXTFILE" + + lcDestination = " TO FILE '"+ lcFile +"' ASCII " + + CASE THIS.cDestination = "PRINTFILE" + + lcDestination = " TO FILE "+ lcFile +" " + + CASE THIS.cDestination = "HTMLFILE" + + lcDestination = " TO FILE '"+ lcFile +"' HTML " + + OTHERWISE + + lcDestination = " TO PRINT " + + ENDCASE + + THIS.cTextFile = lcFile + + IF ".LBX" $ UPPER(THIS.cReport) + * not that I think it makes any difference!! + LABEL FORM (THIS.cReport) &lcClauses &lcDestination NOCONSOLE + ELSE + REPORT FORM (THIS.cReport) &lcClauses &lcDestination NOCONSOLE + ENDIF + + + ENDPROC + + PROCEDURE setdestinations && Controls available output destinations. + LOCAL liPrintReport, liPrintList, liScreen, liTextFile, ; + liHTMLFile, liPrintFile, liExport, ; + lcSourceReport, lcSourceAlias, lcSourceBoth + STORE 0 TO liPrintReport, liPrintList, liScreen, liTextFile, ; + liHTMLFile, liPrintFile, liExport + + IF (EMPTY(_GENHTML) OR ; + (NOT (FILE(_GENHTML) OR FILE(FORCEEXT(_GENHTML,".FXP")))) ) + _GENHTML = "" + ENDIF + + IF THIS.lAddSourceNameToDropDown + lcSourceReport = " ("+PROPER(JUSTFNAME(THIS.cReport))+")" + lcSourceAlias = " ("+THIS.cAlias+")" + lcSourceBoth = " ("+PROPER(JUSTFNAME(THIS.cReport))+","+THIS.cAlias+")" + ELSE + STORE "" TO lcSourceReport, lcSourceAlias, lcSourceBoth + ENDIF + + DO CASE + CASE (NOT THIS.lPreventSourceChanges) OR ; + (NOT EMPTY(THIS.cAlias)) AND (NOT EMPTY(THIS.cReport)) + IF EMPTY(_GENHTML) + DIME THIS.aDestinations[6,2] + ELSE + DIME THIS.aDestinations[7,2] + THIS.aDestinations[7,2] = "HTMLFILE" + liHTMLFile = 7 + ENDIF + THIS.aDestinations[1,2] = "PRINTREPORT" + liPrintReport = 1 + THIS.aDestinations[2,2] = "PRINTLIST" + liPrintList = 2 + THIS.aDestinations[3,2] = "SCREEN" + liScreen = 3 + THIS.aDestinations[4,2] = "TEXTFILE" + liTextFile = 4 + THIS.aDestinations[5,2] = "PRINTFILE" + liPrintFile = 5 + THIS.aDestinations[6,2] = "EXPORT" + liExport = 6 + + CASE (NOT EMPTY(THIS.cAlias)) + IF EMPTY(_GENHTML) + DIME THIS.aDestinations[3,2] + ELSE + DIME THIS.aDestinations[4,2] + THIS.aDestinations[4,2] = "HTMLFILE" + liHTMLFile = 4 + ENDIF + THIS.aDestinations[1,2] = "PRINTLIST" + liPrintList = 1 + THIS.aDestinations[2,2] = "SCREEN" + liScreen = 2 + THIS.aDestinations[3,2] = "EXPORT" + liExport = 3 + + CASE (NOT EMPTY(THIS.cReport)) + IF EMPTY(_GENHTML) + DIME THIS.aDestinations[4,2] + ELSE + DIME THIS.aDestinations[5,2] + THIS.aDestinations[5,2] = "HTMLFILE" + liHTMLFile = 5 + ENDIF + THIS.aDestinations[1,2] = "PRINTREPORT" + liPrintReport = 1 + THIS.aDestinations[2,2] = "SCREEN" + liScreen = 2 + THIS.aDestinations[3,2] = "TEXTFILE" + liTextFile = 3 + THIS.aDestinations[4,2] = "PRINTFILE" + liPrintFile = 4 + + OTHERWISE + * preventing source changes and both are empty -- + * don't bother, but have to show something in the dialog! + liScreen = 1 + IF NOT EMPTY(_GENHTML) + liHTMLFile = 2 + ENDIF + + ENDCASE + + IF EMPTY(THIS.cReport) + IF liPrintReport > 0 + THIS.aDestinations[liPrintReport,1] = "\"+OUTPUT_PRINT_REPORT_LOC + THIS.aDestinations[liTextFile,1] = "\"+OUTPUT_TEXTFILE_LOC + THIS.aDestinations[liPrintFile,1] = "\"+OUTPUT_PRINTFILE_LOC + ENDIF + ELSE + THIS.aDestinations[liPrintReport,1] = OUTPUT_PRINT_REPORT_LOC + lcSourceReport + THIS.aDestinations[liTextFile,1] = OUTPUT_TEXTFILE_LOC + lcSourceReport + THIS.aDestinations[liPrintFile,1] = OUTPUT_PRINTFILE_LOC + lcSourceReport + ENDIF + + IF EMPTY(THIS.cAlias) + IF liPrintList > 0 + THIS.aDestinations[liPrintList,1] = "\"+OUTPUT_PRINT_LIST_LOC + THIS.aDestinations[liExport,1] = "\"+OUTPUT_EXPORT_LOC + ENDIF + ELSE + THIS.aDestinations[liPrintList,1] = OUTPUT_PRINT_LIST_LOC + lcSourceAlias + THIS.aDestinations[liExport,1] = OUTPUT_EXPORT_LOC + lcSourceAlias + ENDIF + + DO CASE + CASE EMPTY(THIS.cAlias) AND EMPTY(THIS.cReport) + THIS.aDestinations[liScreen,1] = "\"+OUTPUT_SCREEN_LOC + IF NOT EMPTY(_GENHTML) + THIS.aDestinations[liHTMLFile,1] = "\"+OUTPUT_HTMLFILE_LOC + ENDIF + CASE EMPTY(THIS.cAlias) + THIS.aDestinations[liScreen,1] = OUTPUT_SCREEN_LOC + lcSourceReport + IF NOT EMPTY(_GENHTML) + THIS.aDestinations[liHTMLFile,1] = OUTPUT_HTMLFILE_LOC + lcSourceReport + ENDIF + CASE EMPTY(THIS.cReport) + THIS.aDestinations[liScreen,1] = OUTPUT_SCREEN_LOC + lcSourceAlias + IF NOT EMPTY(_GENHTML) + THIS.aDestinations[liHTMLFile,1] = OUTPUT_HTMLFILE_LOC + lcSourceAlias + ENDIF + OTHERWISE + THIS.aDestinations[liScreen,1] = OUTPUT_SCREEN_LOC + lcSourceBoth + IF NOT EMPTY(_GENHTML) + THIS.aDestinations[liHTMLFile,1] = OUTPUT_HTMLFILE_LOC + lcSourceBoth + ENDIF + ENDCASE + + + ENDPROC + + PROCEDURE setoptions && Drives options for output destinations. + DO CASE + + CASE INLIST("#"+THIS.cDestination+"#","#PRINTREPORT#", "#PRINTLIST#", "#PRINTFILE#") + + DIME THIS.aOptions[3,2] + + THIS.aOptions[1,1] = OUTPUT_PRINT_OPTIONS_WINDEFAULT_LOC + ; + " ("+PROPER(SET("PRINT",2))+")" + THIS.aOptions[2,1] = OUTPUT_PRINT_OPTIONS_VFPDEFAULT_LOC + ; + " ("+THIS.cVFPPrinterName+")" + THIS.aOptions[3,1] = OUTPUT_PRINT_OPTIONS_SETVFPDEFAULT_LOC + + THIS.aOptions[1,2] = "WINDEFAULT" + THIS.aOptions[2,2] = "VFPDEFAULT" + THIS.aOptions[3,2] = "SETVFPDEFAULT" + + CASE THIS.cDestination == "SCREEN" + + LOCAL liGraphical, liAscii, liBrowse, liList + STORE 0 TO liGraphical, liAscii, liBrowse, liList + + IF (NOT THIS.lPreventSourceChanges) OR ; + (NOT EMPTY(THIS.cAlias)) AND (NOT EMPTY(THIS.cReport)) + DIME THIS.aOptions[4,2] + THIS.aOptions[1,2] = "GRAPHICAL" + liGraphical = 1 + THIS.aOptions[2,2] = "ASCII" + liAscii = 2 + THIS.aOptions[3,2] = "BROWSE" + liBrowse = 3 + THIS.aOptions[4,2] = "LIST" + liList = 4 + ELSE + DIME THIS.aOptions[2,2] + IF EMPTY(THIS.cAlias) + THIS.aOptions[1,2] = "GRAPHICAL" + liGraphical = 1 + THIS.aOptions[2,2] = "ASCII" + liAscii = 2 + ELSE + THIS.aOptions[1,2] = "BROWSE" + liBrowse = 1 + THIS.aOptions[2,2] = "LIST" + liList = 2 + ENDIF + ENDIF + + IF EMPTY(THIS.cReport) + IF NOT THIS.lPreventSourceChanges + THIS.aOptions[liGraphical,1] = "\"+OUTPUT_SCREEN_GRAPHICAL_LOC + THIS.aOptions[liAscii,1] = "\"+OUTPUT_SCREEN_ASCII_LOC + ENDIF + ELSE + THIS.aOptions[liGraphical,1] = OUTPUT_SCREEN_GRAPHICAL_LOC + THIS.aOptions[liAscii,1] = OUTPUT_SCREEN_ASCII_LOC + ENDIF + + IF EMPTY(THIS.cAlias) + IF NOT THIS.lPreventSourceChanges + THIS.aOptions[liBrowse,1] = "\"+ OUTPUT_SCREEN_BROWSE_LOC + THIS.aOptions[liList,1] = "\"+OUTPUT_SCREEN_LIST_LOC + ENDIF + ELSE + THIS.aOptions[liBrowse,1] = OUTPUT_SCREEN_BROWSE_LOC + THIS.aOptions[liList,1] = OUTPUT_SCREEN_LIST_LOC + ENDIF + + + CASE THIS.cDestination == "TEXTFILE" + + * we don't use any items from the options array + + CASE THIS.cDestination == "HTMLFILE" + + DIME THIS.aOptions[3,2] + + IF EMPTY(THIS.cAlias) AND EMPTY(THIS.cReport) + THIS.aOptions[1,1] = "\"+OUTPUT_HTML_FILEONLY_LOC + THIS.aOptions[2,1] = "\"+OUTPUT_HTML_VIEWSOURCE_LOC + THIS.aOptions[3,1] = "\"+OUTPUT_HTML_WEBVIEW_LOC + ELSE + THIS.aOptions[1,1] = OUTPUT_HTML_FILEONLY_LOC + THIS.aOptions[2,1] = OUTPUT_HTML_VIEWSOURCE_LOC + THIS.aOptions[3,1] = OUTPUT_HTML_WEBVIEW_LOC + ENDIF + + THIS.aOptions[1,2] = "FILEONLY" + THIS.aOptions[2,2] = "VIEWSOURCE" + THIS.aOptions[3,2] = "WEBVIEW" + + CASE THIS.cDestination == "EXPORT" + + DIME THIS.aOptions[10,2] + + * THIS.aOptions[1,1] = OUTPUT_EXPORT_EXCEL97 + * THIS.aOptions[1,2] = "XL8" + THIS.aOptions[1,1] = OUTPUT_EXPORT_EXCEL5 + THIS.aOptions[1,2] = "XL5" + THIS.aOptions[2,1] = OUTPUT_EXPORT_EXCEL2 + THIS.aOptions[2,2] = "XLS" + THIS.aOptions[3,1] = OUTPUT_EXPORT_FOX2X + THIS.aOptions[3,2] = "FOX2X" + THIS.aOptions[4,1] = OUTPUT_EXPORT_FOXPLUS + THIS.aOptions[4,2] = "FOXPLUS" + THIS.aOptions[5,1] = OUTPUT_EXPORT_FIXEDLEN + THIS.aOptions[5,2] = "SDF" + THIS.aOptions[6,1] = OUTPUT_EXPORT_DELIMITED + THIS.aOptions[6,2] = "DELIMITED" + THIS.aOptions[7,1] = OUTPUT_EXPORT_LOTUS2 + THIS.aOptions[7,2] = "WK1" + THIS.aOptions[8,1] = OUTPUT_EXPORT_DIF + THIS.aOptions[8,2] = "DIF" + THIS.aOptions[9,1] = OUTPUT_EXPORT_SYMPHONY + THIS.aOptions[9,2] = "WRK" + THIS.aOptions[10,1] = OUTPUT_EXPORT_CSV + THIS.aOptions[10,2] = "CSV" + + ENDCASE + + + ENDPROC + + PROCEDURE setoutputprinter + + DO CASE + CASE THIS.cOption = "WINDEFAULT" + SET PRINTER TO DEFAULT + * could also be: SET PRINTER TO NAME (SET(PRINTER,2)) + CASE THIS.cOption = "VFPDEFAULT" + SET PRINTER TO NAME (THIS.cVFPPrinterName) + OTHERWISE + THIS.SetVFPPrinter() + ENDCASE + + ENDPROC + + PROCEDURE setvfpprinter + LOCAL lcName + lcName = GETPRINTER() + SET PRINTER TO NAME (lcName) + IF INLIST("#"+THIS.cDestination+"#","#PRINTFILE#","#PRINTREPORT#","#PRINTLIST#") + THIS.aOptions[2,1] = OUTPUT_PRINT_OPTIONS_VFPDEFAULT_LOC + ; + " ("+THIS.cVFPPrinterName+")" + ENDIF + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _outputchoices AS _output OF "_reports.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="txtFileName" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboDestinations" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboOptions" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdPutFile" UniqueID="" Timestamp="" /> + + #INCLUDE "_reports.h" + * + Height = 49 + Name = "_outputchoices" + Width = 338 + cusWindows.Name = "cusWindows" + * + + ADD OBJECT 'cboDestinations' AS _combobox WITH ; + BoundColumn = 2, ; + BoundTo = .T., ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + ItemTips = .T., ; + Left = 0, ; + Name = "cboDestinations", ; + RowSourceType = 5, ; + Style = 2, ; + TabIndex = 1, ; + Top = 0, ; + Value = (""), ; + Width = 130, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cboOptions' AS _combobox WITH ; + BoundColumn = 2, ; + BoundTo = .T., ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + ItemTips = .T., ; + Left = 129, ; + Name = "cboOptions", ; + RowSourceType = 5, ; + Style = 2, ; + TabIndex = 2, ; + Top = 0, ; + Width = 212, ; + ZOrderSet = 2 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cmdPutFile' AS _commandbutton WITH ; + Caption = "...", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 23, ; + Left = 315, ; + Name = "cmdPutFile", ; + TabIndex = 4, ; + TabStop = .F., ; + Top = 25, ; + Width = 23, ; + ZOrderSet = 3 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'txtFileName' AS _textbox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 23, ; + Left = 0, ; + Name = "txtFileName", ; + TabIndex = 3, ; + Top = 24, ; + Value = (SPACE(200)), ; + Width = 315, ; + ZOrderSet = 0 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="textbox" /> + + PROCEDURE Init + LOCAL loControl + + THIS.cboDestinations.RowSource = "THIS.Parent.aDestinations" + THIS.cboDestinations.ControlSource = "THIS.Parent.cDestination" + THIS.cboOptions.RowSource = "THIS.Parent.aOptions" + THIS.cboOptions.ControlSource = "THIS.Parent.cOption" + THIS.txtFileName.ControlSource = "THIS.Parent.cTextFile" + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + IF SYSTEM_LARGEFONTS + LOCAL lcStandardFont + lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME) + + FOR EACH loControl IN THIS.Controls + IF PEMSTATUS(loControl,"FontName",5) AND ; + UPPER(loControl.FontName) == lcStandardFont + + loControl.FontName = DIALOG_LARGEFONT_NAME + ENDIF + * Note: no recursion here. + ENDFOR + + ENDIF + + + + + + ENDPROC + + PROCEDURE output && This is main method that is called to generate output based on settings. + DODEFAULT() + THIS.txtFileName.Refresh() + ENDPROC + + PROCEDURE setdestinations && Controls available output destinations. + LOCAL liDestination, llFoundGoodRow + + DODEFAULT() + + THIS.cboDestinations.Requery() + + IF EMPTY(THIS.cAlias+THIS.cReport) + THIS.Setall("Enabled",.F.) + ELSE + THIS.cboDestinations.Enabled = .T. + THIS.SetOptions() + ENDIF + + liDestination = ASCAN(THIS.aDestinations,THIS.cDestination) + IF liDestination = 0 && can happen if we've just changed + THIS.cboDestinations.Value = THIS.aDestinations[1,2] + liDestination = 1 + ELSE + liDestination = ASUBSCRIPT(THIS.aDestinations,liDestination,1) + * THIS.cboDestinations.Value = THIS.aDestinations[liDestination,2] + * not needed, since this control is bound to THIS.cDestination + ENDIF + + * is this row disabled? look for a good one: + IF LEFT(THIS.aDestinations[liDestination,1],1) = "\" + FOR liDestination = 1 TO ALEN(THIS.aDestinations,1) + IF LEFT(THIS.aDestinations[liDestination,1],1) # "\" + THIS.cboDestinations.Value = THIS.aDestinations[liDestination,2] + llFoundGoodRow = .T. + EXIT + ENDIF + ENDFOR + IF NOT llFoundGoodRow + THIS.cboDestinations.Value = THIS.aDestinations[1,2] + * best we can do + ENDIF + ENDIF + + + + ENDPROC + + PROCEDURE setoptions && Drives options for output destinations. + DODEFAULT() + + DO CASE + + CASE INLIST("#"+THIS.cDestination+"#","#PRINTREPORT#", "#PRINTLIST#", "#PRINTFILE#") + + THIS.cboOptions.Requery() + THIS.cboOptions.Value = "WINDEFAULT" + + IF INLIST("#"+THIS.cDestination+"#","#PRINTFILE#","#PRINTREPORT#") + STORE (NOT EMPTY(THIS.cReport)) TO ; + THIS.cboOptions.Enabled + ELSE + + STORE (NOT EMPTY(THIS.cAlias)) TO ; + THIS.cboOptions.Enabled + + ENDIF + + + THIS.cboOptions.Value = "WINDEFAULT" + + CASE THIS.cDestination == "SCREEN" + + THIS.cboOptions.Requery() + + THIS.cboOptions.Value = IIF(EMPTY(THIS.cReport) AND ; + (NOT EMPTY(THIS.cAlias)), ; + "BROWSE", ; + "GRAPHICAL") + + STORE .T. TO THIS.cboOptions.Enabled + + CASE THIS.cDestination == "TEXTFILE" + + THIS.cboOptions.Enabled = .F. + THIS.cboOptions.Value = THIS.aOptions[1,2] + + CASE THIS.cDestination == "HTMLFILE" + + STORE (NOT EMPTY(THIS.cAlias+THIS.cReport)) TO ; + THIS.cboOptions.Enabled, ; + THIS.txtFileName.Enabled, ; + THIS.cmdPutFile.Enabled + THIS.cboOptions.Requery() + THIS.cboOptions.Value = THIS.aOptions[1,2] + + CASE THIS.cDestination == "EXPORT" + + STORE (NOT EMPTY(THIS.cAlias)) TO ; + THIS.cboOptions.Enabled, ; + THIS.txtFileName.Enabled, ; + THIS.cmdPutFile.Enabled + + THIS.cboOptions.Requery() + THIS.cboOptions.Value = THIS.aOptions[1,2] + + ENDCASE + + IF INLIST("#"+THIS.cDestination+"#","#PRINTFILE#","#TEXTFILE#","#EXPORT#","#HTMLFILE#") + + STORE .T. TO ; + THIS.txtFileName.Enabled, ; + THIS.cmdPutFile.Enabled + IF EMPTY(THIS.cTextFile) + THIS.txtFileName.SetFocus() + ENDIF + + ELSE + + STORE .F. TO ; + THIS.txtFileName.Enabled, ; + THIS.cmdPutFile.Enabled + ENDIF + + IF ASCAN(THIS.aOptions,THIS.cOption) = 0 + THIS.cboOptions.Value = THIS.aOptions[1,2] + ENDIF + + + ENDPROC + + PROCEDURE cmdPutFile.Click + WAIT WINDOW NOWAIT LEFTC(OUTPUT_DESTINATION_TEXTFILE_LOC,254) + + LOCAL lcExt + + WITH THIS.Parent + DO CASE + CASE .cDestination == "EXPORT" + *&* change for VFP 7 - + *&* extension for Delimited + *&* files explicitly set + DO CASE + CASE .cboOptions.Value == "DELIMITED" + lcExt = "ASC" + CASE LEN(.cboOptions.Value) > 3 + lcExt = "DBF" + OTHERWISE + lcExt = .cboOptions.Value + ENDCASE + CASE .cDestination == "PRINTFILE" + lcExt = "PRN" + CASE .cDestination == "HTMLFILE" + lcExt = "HTM" + OTHERWISE + lcExt = "TXT" + ENDCASE + .cTextFile = PUTFILE("",ALLTR(.cTextFile),lcExt) + IF EMPTY(.cTextFile) + .ResetToDefault("cTextFile") && otherwise it's a null string and the cursor won't stay + ENDIF + + ENDWITH + + THIS.Parent.txtFileName.Refresh() + + WAIT CLEAR + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _outputdialog AS _form OF "_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="opgScope" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="shpFrameDestinations" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusOutput" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="shpFrameSources" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblDestinations" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblSources" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboTables" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtReportFile" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdGetReport" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblReports" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblData" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblScope" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblOptions" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblOutputFilename" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblOutputType" UniqueID="" Timestamp="" /> + + #INCLUDE "_reports.h" + * + *m: calias_access + *m: calias_assign + *m: cdestination_access + *m: cdestination_assign + *m: cdisplayfontname_access + *m: cdisplayfontname_assign + *m: cfieldlist_access + *m: cfieldlist_assign + *m: checkokbutton + *m: chtmlclass_access + *m: chtmlclass_assign + *m: chtmlstyleid_access + *m: chtmlstyleid_assign + *m: creport_access + *m: creport_assign + *m: cscope_access + *m: cscope_assign + *m: laddsourcenametodropdown_access + *m: laddsourcenametodropdown_assign + *m: lpreventscopechanges_assign + *m: lpreventsourcechanges_access + *m: lpreventsourcechanges_assign + *m: output && Wrap the cusOutput.Output method for external use + *m: respondtopermissionforscopechanges + *m: respondtopermissionforsourcechanges + *m: setkeys + *p: calias && Name of data source to output. + *p: cdestination && This is list of available destinations which changes dynamically depending on whether cReport, cAlias, or both, are filled out. + *p: cdisplayfontname && This is used for on-screen display of output, for example in a BROWSE or when the _Showtext class is instantiated for text display. + *p: cfieldlist && A comma-delimited list of fields or expressions. It affects only direct data sources (BROWSEs and LISTs). + *p: chtmlclass && Optional HTML class and classlib passed to _GENHTML. + *p: chtmlstyleid && Optional HTML style passed to _GENHTML. + *p: creport && Name of report or label to output. + *p: cscope && Legal scope expression for output. + *p: laddsourcenametodropdown && Affects how some destinations show in the aDestinations array. + *p: lpreventscopechanges && Disables ability to change output scope. + *p: lpreventsourcechanges && Prevents source changes for cAlias or cReport. + * + + * + AutoCenter = .T. + BorderStyle = 2 + calias = ("") + Caption = "Output" + cdestination = ("") + cdisplayfontname = ("") + cfieldlist = ("") + chtmlclass = + chtmlstyleid = ("") + creport = ("") + cscope = ("") + DoCreate = .T. + Height = 274 + MaxButton = .F. + MinButton = .F. + Name = "_outputdialog" + ShowWindow = 1 + Width = 385 + * + + ADD OBJECT 'cboTables' AS _combobox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 100, ; + Name = "cboTables", ; + RowSourceType = 1, ; + TabIndex = 13, ; + Top = 234, ; + Width = 190, ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cmdCancel' AS _commandbutton WITH ; + Cancel = .T., ; + Caption = "Cancel", ; + FontBold = .F., ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 23, ; + Left = 306, ; + Name = "cmdCancel", ; + TabIndex = 15, ; + Top = 49, ; + Width = 72, ; + ZOrderSet = 4 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdGetReport' AS _commandbutton WITH ; + Caption = "...", ; + FontSize = 8, ; + Height = 24, ; + Left = 267, ; + Name = "cmdGetReport", ; + TabIndex = 11, ; + TabStop = .F., ; + Top = 202, ; + Width = 23, ; + ZOrderSet = 10 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdOK' AS _commandbutton WITH ; + Caption = "OK", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 23, ; + Left = 306, ; + Name = "cmdOK", ; + TabIndex = 14, ; + Top = 18, ; + Width = 72, ; + ZOrderSet = 3 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cusOutput' AS _outputchoices WITH ; + BorderWidth = 0, ; + Height = 109, ; + Left = 8, ; + Name = "cusOutput", ; + TabIndex = 3, ; + Top = 18, ; + Width = 290, ; + ZOrderSet = 2, ; + txtFileName.Height = 23, ; + txtFileName.Left = 92, ; + txtFileName.Name = "txtFileName", ; + txtFileName.TabIndex = 3, ; + txtFileName.Top = 78, ; + txtFileName.Width = 161, ; + cboDestinations.Height = 24, ; + cboDestinations.Left = 92, ; + cboDestinations.Name = "cboDestinations", ; + cboDestinations.TabIndex = 1, ; + cboDestinations.Top = 14, ; + cboDestinations.Width = 190, ; + cboOptions.Height = 24, ; + cboOptions.Left = 92, ; + cboOptions.Name = "cboOptions", ; + cboOptions.TabIndex = 2, ; + cboOptions.Top = 46, ; + cboOptions.Width = 190, ; + cmdPutFile.Left = 259, ; + cmdPutFile.Name = "cmdPutFile", ; + cmdPutFile.TabIndex = 4, ; + cmdPutFile.Top = 78, ; + cusWindows.Name = "cusWindows" + *< END OBJECT: ClassLib="_reports.vcx" BaseClass="container" /> + + ADD OBJECT 'lblData' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Caption = "Da\ + + ADD OBJECT 'lblDestinations' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 1, ; + BorderStyle = 0, ; + Caption = "\ + + ADD OBJECT 'lblOptions' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Caption = "O\ + + ADD OBJECT 'lblOutputFilename' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Caption = "\ + + ADD OBJECT 'lblOutputType' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Output t\ + + ADD OBJECT 'lblReports' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Caption = "\ + + ADD OBJECT 'lblScope' AS _label WITH ; + AutoSize = .T., ; + Caption = "\ + + ADD OBJECT 'lblSources' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 1, ; + BorderStyle = 0, ; + Caption = "\ + + ADD OBJECT 'opgScope' AS _optiongroup WITH ; + BackStyle = 0, ; + BorderStyle = 1, ; + ButtonCount = 3, ; + Height = 35, ; + Left = 8, ; + Name = "opgScope", ; + TabIndex = 7, ; + Top = 140, ; + Width = 290, ; + ZOrderSet = 0, ; + Option1.AutoSize = .T., ; + Option1.BackStyle = 0, ; + Option1.Caption = "\ + + ADD OBJECT 'shpFrameDestinations' AS _shape WITH ; + BackStyle = 0, ; + Height = 109, ; + Left = 8, ; + Name = "shpFrameDestinations", ; + SpecialEffect = 0, ; + Top = 18, ; + Width = 290, ; + ZOrderSet = 1 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="shape" /> + + ADD OBJECT 'shpFrameSources' AS _shape WITH ; + BackStyle = 0, ; + Height = 78, ; + Left = 8, ; + Name = "shpFrameSources", ; + SpecialEffect = 0, ; + Top = 188, ; + Width = 290, ; + ZOrderSet = 5 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="shape" /> + + ADD OBJECT 'txtReportFile' AS _textbox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 100, ; + Name = "txtReportFile", ; + TabIndex = 10, ; + Top = 202, ; + Width = 161, ; + ZOrderSet = 9 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="textbox" /> + + PROCEDURE Activate + IF NOT THIS.lPreventSourceChanges + WITH THIS.cboTables + LOCAL ARRAY laTables[1,2] + LOCAL liCount, liIndex, lcRowSource, lcAlias + liCount = AUSED(laTables) + lcRowSource = "" + FOR liIndex = 1 TO liCount + lcAlias = PROPER(laTables[liIndex,1]) + lcRowSource = lcRowSource + lcAlias + "," + ENDFOR + IF RIGHTC(lcRowSource,1) = "," + lcRowSource = LEFTC(lcRowSource, LEN(lcRowSource) - 1) + ENDIF + .RowSource = lcRowSource + .Requery() + .ControlSource = "THISFORM.cusOutput.cAlias" + ENDWITH + THIS.txtReportFile.ControlSource = "THISFORM.cusOutput.cReport" + THISFORM.Refresh() + ENDIF + THIS.CheckOKButton() + THIS.SetKeys(.T.) + ENDPROC + + PROCEDURE calias_access + + RETURN THIS.cusOutput.cAlias + + ENDPROC + + PROCEDURE calias_assign + LPARAMETERS m.vNewVal + IF VARTYPE(m.vNewVal) = "C" + STORE m.vNewVal TO THIS.cusOutput.cAlias, THIS.cAlias + IF NOT THIS.lPreventSourceChanges + THIS.cboTables.Refresh() + ENDIF + THIS.CheckOKButton() + ENDIF + + + ENDPROC + + PROCEDURE cdestination_access + RETURN THIS.cusOutput.cDestination + + ENDPROC + + PROCEDURE cdestination_assign + LPARAMETERS m.vNewVal + STORE m.vNewVal TO THIS.cDestination, THIS.cusOutput.cDestination + + + ENDPROC + + PROCEDURE cdisplayfontname_access + RETURN THIS.cusOutput.cDisplayFontName + + ENDPROC + + PROCEDURE cdisplayfontname_assign + LPARAMETERS m.vNewVal + THIS.cusOutput.cDisplayFontName = m.vNewVal + + ENDPROC + + PROCEDURE cfieldlist_access + RETURN THIS.cusOutput.cFieldList + + ENDPROC + + PROCEDURE cfieldlist_assign + LPARAMETERS m.vNewVal + STORE m.vNewVal TO THIS.cFieldList, THIS.cusOutput.cFieldList + + ENDPROC + + PROCEDURE checkokbutton + IF NOT THIS.Visible + RETURN + ENDIF + THIS.cmdOK.Enabled = (NOT EMPTY(THIS.cAlias+THIS.cReport)) + + IF THIS.cmdOK.Enabled + IF INLIST("#"+THIS.cusOutput.cDestination+"#","#PRINTFILE#","#TEXTFILE#","#EXPORT#", "#HTMLFILE#") AND ; + EMPTY(THIS.cusOutput.txtFileName.Value) + THIS.cmdOK.Enabled = .F. + ENDIF + ENDIF + + IF THIS.cmdOK.Enabled + IF INLIST("#"+THIS.cusOutput.cDestination+"#","#PRINTREPORT#","#TEXTFILE#","#PRINTFILE#") AND ; + EMPTY(THIS.cReport) + THIS.cmdOK.Enabled = .F. + ENDIF + ENDIF + + IF THIS.cmdOK.Enabled + IF INLIST("#"+THIS.cusOutput.cDestination+"#","#EXPORT#","#PRINTLIST#") AND ; + EMPTY(THIS.cAlias) + THIS.cmdOK.Enabled = .F. + ENDIF + ENDIF + + + + + ENDPROC + + PROCEDURE chtmlclass_access + RETURN THIS.cusOutput.cHTMLClass + + + ENDPROC + + PROCEDURE chtmlclass_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) = "C" + STORE tvNewVal TO THIS.cHTMLClass, THIS.cusOutput.cHTMLClass + ENDIF + + + + ENDPROC + + PROCEDURE chtmlstyleid_access + RETURN THIS.cusOutput.cHTMLStyleID + + ENDPROC + + PROCEDURE chtmlstyleid_assign + LPARAMETERS tvNewVal + IF VARTYPE(tvNewVal) = "C" + STORE tvNewVal TO THIS.cHTMLStyleID, THIS.cusOutput.cHTMLStyleID + ENDIF + + + ENDPROC + + PROCEDURE creport_access + RETURN THIS.cusOutput.cReport + + ENDPROC + + PROCEDURE creport_assign + LPARAMETERS m.vNewVal + IF VARTYPE(m.vNewVal) = "C" + STORE m.vNewVal TO THIS.cReport, THIS.cusOutput.cReport + IF NOT THIS.lPreventSourceChanges + THIS.txtReportFile.Refresh() + ENDIF + THIS.CheckOKButton() + ENDIF + + ENDPROC + + PROCEDURE cscope_access + RETURN UPPER(ALLTRIM(THIS.cusOutput.cScope)) + + ENDPROC + + PROCEDURE cscope_assign + LPARAMETERS tvNewVal + + LOCAL lcNewVal + + IF VARTYPE(tvNewVal) = "C" + lcNewVal = ALLTRIM(UPPER(tvNewVal)) + STORE lcNewVal TO THIS.cScope, THIS.cusOutput.cScope + ELSE + lcNewVal = ALLTRIM(UPPER(THIS.cScope)) + ENDIF + + DO CASE + CASE lcNewVal == "ALL" OR EMPTY(lcNewVal) + THIS.opgScope.Value = 1 + CASE lcNewVal == "NEXT 1" + THIS.opgScope.Value = 2 + CASE lcNewVal == "REST" + THIS.opgScope.Value = 3 + OTHERWISE + THIS.opgScope.Value = 0 + ENDCASE + + + + ENDPROC + + PROCEDURE Deactivate + THIS.SetKeys() + ENDPROC + + PROCEDURE Init + LPARAMETERS tcReport, tcAlias, tlPreventSourceChanges, tlPreventScopeChanges + + LOCAL loControl + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + THIS.MaxHeight = THIS.Height + + THIS.cReport = tcReport + THIS.cAlias = tcAlias + + IF PCOUNT() >= 3 AND VARTYPE(tlPreventSourceChanges) = "L" + THIS.lPreventSourceChanges = tlPreventSourceChanges + ENDIF + + IF PCOUNT() = 4 AND VARTYPE(tlPreventScopeChanges) = "L" + THIS.lPreventScopeChanges = tlPreventScopeChanges + ENDIF + + IF SYSTEM_LARGEFONTS + LOCAL lcStandardFont + lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME) + + FOR EACH loControl IN THIS.Controls + DO CASE + CASE PEMSTATUS(loControl,"FontName",5) AND ; + UPPER(loControl.FontName) == lcStandardFont + + loControl.FontName = DIALOG_LARGEFONT_NAME + CASE TYPE("loControl.Buttons(1)") = "O" + loControl.SetAll("FontName",DIALOG_LARGEFONT_NAME) + OTHERWISE + * Note: no recursion here. + ENDCASE + ENDFOR + + ENDIF + + + + + ENDPROC + + PROCEDURE laddsourcenametodropdown_access + RETURN THIS.cusOutput.lAddSourceNameToDropDown + + ENDPROC + + PROCEDURE laddsourcenametodropdown_assign + LPARAMETERS tlNewVal + IF VARTYPE(tlNewVal) = "L" + STORE tlNewVal TO ; + THIS.cusOutPut.lAddSourceNameToDropDown, ; + THIS.lAddSourceNameToDropDown + ENDIF + + ENDPROC + + PROCEDURE lpreventscopechanges_assign + LPARAMETERS tlNewVal + IF VARTYPE(tlNewVal) = "L" + STORE tlNewVal TO THIS.lPreventScopeChanges + ENDIF + THIS.RespondToPermissionForScopeChanges() + + + + ENDPROC + + PROCEDURE lpreventsourcechanges_access + + RETURN THIS.cusOutput.lPreventSourceChanges + + ENDPROC + + PROCEDURE lpreventsourcechanges_assign + LPARAMETERS tlNewVal + + LOCAL llChange + + IF VARTYPE(tlNewVal) = "L" AND tlNewVal # THIS.lPreventSourceChanges + STORE tlNewVal TO THIS.lPreventSourceChanges, THIS.cusOutput.lPreventSourceChanges + llChange = .T. + ENDIF + + THIS.RespondToPermissionForSourceChanges(llChange) + ENDPROC + + PROCEDURE output && Wrap the cusOutput.Output method for external use + THIS.cusOutput.Output() + ENDPROC + + PROCEDURE respondtopermissionforscopechanges + LOCAL llScopeEnabled + + llScopeEnabled = (NOT THIS.lPreventScopeChanges) + + STORE llScopeEnabled TO ; + THIS.opgScope.Enabled, THIS.lblScope.Enabled + THIS.opgScope.Setall("Enabled", llScopeEnabled) + + + + + + ENDPROC + + PROCEDURE respondtopermissionforsourcechanges + LPARAMETERS tlExplicitChange + + LOCAL lnBottomMargin + + lnBottomMargin = INT(THIS.lblDestinations.Top * .66) + + IF (THIS.lPreventSourceChanges) + + IF EMPTY(THIS.cusOutput.cReport+THIS.cusOutput.cAlias) AND tlExplicitChange + + MESSAGEBOX(OUTPUT_REPORT_OR_DATASOURCE_REQUIRED_LOC, MB_ICONEXCLAMATION) + + ENDIF + + THIS.Height = lnBottomMargin + ; + THIS.opgScope.Height + ; + THIS.opgScope.Top + + ELSE + THIS.Height = THIS.MaxHeight + ENDIF + + STORE (NOT THIS.lPreventSourceChanges) TO ; + THIS.lblSources.Visible, THIS.lblSources.Enabled, ; + THIS.shpFrameSources.Visible, THIS.shpFrameSources.Enabled, ; + THIS.lblReports.Visible, THIS.lblReports.Enabled, ; + THIS.lblData.Visible, THIS.lblData.Enabled, ; + THIS.txtReportFile.Visible, THIS.txtReportFile.Enabled, ; + THIS.cmdGetReport.Visible, THIS.cmdGetReport.Enabled, ; + THIS.cboTables.Visible, THIS.cboTables.Enabled + + + ENDPROC + + PROTECTED PROCEDURE setkeys + LPARAMETERS tlOn + IF tlOn + PUSH KEY + ON KEY LABEL Alt-Y IIF(TYPE("_SCREEN.ActiveForm.cusOutput.cboDestinations") = "O" AND ; + _SCREEN.ActiveForm.cusOutput.cboDestinations.Enabled, ; + _SCREEN.ActiveForm.cusOutput.cboDestinations.SetFocus(),; + .T.) + ON KEY LABEL Alt-P IIF(TYPE("_SCREEN.ActiveForm.cusOutput.cboOptions") = "O" AND ; + _SCREEN.ActiveForm.cusOutput.cboOptions.Enabled, ; + _SCREEN.ActiveForm.cusOutput.cboOptions.SetFocus(),; + .T.) + ON KEY LABEL Alt-F IIF(TYPE("_SCREEN.ActiveForm.cusOutput.txtFileName") = "O" AND ; + _SCREEN.ActiveForm.cusOutput.txtFileName.Enabled, ; + _SCREEN.ActiveForm.cusOutput.txtFileName.SetFocus(),; + .T.) + ELSE + POP KEY + ENDIF + ENDPROC + + PROCEDURE Show + LPARAMETERS nStyle + + IF NOT EMPTY(THIS.cScope) + THIS.lPreventScopeChanges = .T. + ENDIF + + THIS.cScope = THIS.cScope && fix opgScope value + + THIS.RespondToPermissionForSourceChanges() + + ENDPROC + + PROCEDURE cmdCancel.Click + THISFORM.Release() + ENDPROC + + PROCEDURE cmdGetReport.Click + WAIT WINDOW NOWAIT LEFTC(OUTPUT_SOURCE_REPORT_LOC,254) + + LOCAL lcName + + lcName = UPPER(GETFILE("FRX,LBX","","Open")) + IF LASTKEY() = 13 + CLEAR TYPEAHEAD + ENDIF + + + IF NOT EMPTY(lcName) + + THISFORM.txtReportFile.Value = lcName + + ENDIF + + + WAIT CLEAR + + ENDPROC + + PROCEDURE cmdOK.Click + THISFORM.Output() + + ENDPROC + + PROCEDURE cusOutput.calias_assign + LPARAMETERS tcVal + DODEFAULT(tcVal) + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.cboDestinations.InteractiveChange + THISFORM.CheckOKButton() + ENDPROC + + PROCEDURE cusOutput.cboDestinations.ProgrammaticChange + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.cboOptions.InteractiveChange + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.cboOptions.ProgrammaticChange + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.cmdPutFile.Click + DODEFAULT() + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.creport_assign + LPARAMETERS tcVal + DODEFAULT(tcVal) + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.txtFileName.InteractiveChange + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE cusOutput.txtFileName.ProgrammaticChange + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE opgScope.InteractiveChange + DO CASE + CASE THIS.Value = 2 + THISFORM.cScope = "NEXT 1" + CASE THIS.Value = 3 + THISFORM.cScope = "REST" + OTHERWISE + THISFORM.cScope = "" + ENDCASE + ENDPROC + + PROCEDURE txtReportFile.InteractiveChange + THISFORM.CheckOKButton() + + ENDPROC + + PROCEDURE txtReportFile.ProgrammaticChange + THISFORM.CheckOKButton() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _showtext AS _form OF "_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="edtText" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="OleCommonDialog" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdSave" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdClose" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdFonts" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkReadOnly" UniqueID="" Timestamp="" /> + + #INCLUDE "_reports.h" + * + *m: csourcefile_assign + *m: ctargetfile_access + *m: getfixedfont && Uses common dialog to display font dialog, restricted to fixed font items. + *m: setfonts && Applies the current font property characteristics to the editbox displaying the file. + *p: cfixedfontname && Font name for display editbox. + *p: csourcefile && Name of source file to view/edit. + *p: ctargetfile && Name of file to which you would like to save the (possibly edited) contents of the editbox. + *p: ifixedfontsize && Font size for display editbox. + *p: lfixedfontbold && Font bold for display editbox. + *p: lfixedfontitalic && Font italic for display editbox. + *p: lsuppresscaptionchange && Suppresses the dialog caption from changing as the source file changes. This is useful for displaying the contents of a temporary file. + * + + * + Caption = "Text Editor" + cfixedfontname = ("Courier New") + csourcefile = ("") + ctargetfile = ("") + DoCreate = .T. + Height = 237 + ifixedfontsize = 9 + Left = 0 + Name = "_showtext" + ShowWindow = 1 + Top = 0 + Width = 419 + * + + ADD OBJECT 'chkReadOnly' AS _checkbox WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Read only", ; + ControlSource = "THISFORM.edtText.Readonly", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Left = 336, ; + Name = "chkReadOnly", ; + Top = 112 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'cmdClose' AS _commandbutton WITH ; + Cancel = .T., ; + Caption = "\ + + ADD OBJECT 'cmdFonts' AS _commandbutton WITH ; + Caption = "Fonts...", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 25, ; + Left = 337, ; + Name = "cmdFonts", ; + Top = 134, ; + Width = 74 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdSave' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'edtText' AS _editbox WITH ; + ColorSource = 3, ; + FontName = "Courier New", ; + FontSize = 8, ; + Height = 229, ; + Left = 0, ; + Name = "edtText", ; + ReadOnly = .T., ; + ScrollBars = 2, ; + Top = 3, ; + Width = 324 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="editbox" /> + + ADD OBJECT 'OleCommonDialog' AS olecontrol WITH ; + Height = 100, ; + Left = 336, ; + Name = "OleCommonDialog", ; + Top = 72, ; + Width = 100, ; + ZOrderSet = 1 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\winnt\system32\comdlg32.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJCjXj3KP8ABAwAAAEABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXAAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAAQAAAAAAAAABAAAAAIAAAD+/////v////7///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+FPAT58vYaEKPJCAArL0n7IUM0EggAAABPAwAATwMAAIY8BPkAAAYAAAAAACAAAAAAAAAAAAAAAAEAAAAEAQAAXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAyOEM0QzgyMC00MDFBLTEwMUItQTNDOS0wODAwMkIyRjQ5RkIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABAACAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==" /> + + PROCEDURE csourcefile_assign + LPARAMETERS tvNewVal + + LOCAL lcVal + + IF VARTYPE(tvNewVal) # "C" + THIS.cSourceFile = "" + ELSE + lcVal = ALLTR(tvNewVal) + DO CASE + CASE FILE(lcVal) OR (NOT EMPTY(SYS(2000,lcVal))) + THIS.cSourceFile = lcVal + CASE FILE(lcVal+".txt") OR (NOT EMPTY(SYS(2000,lcVal+".txt"))) + THIS.cSourceFile = lcVal+".txt" + OTHERWISE + THIS.cSourceFile = "" + ENDCASE + ENDIF + + IF EMPTY(THIS.cSourceFile) + THIS.edtText.Value = "" + ELSE + THIS.edtText.Value = FileToStr(THIS.cSourceFile) + IF NOT THIS.lSuppressCaptionChange + THIS.Caption = THIS.cSourceFile + ENDIF + ENDIF + + + ENDPROC + + PROCEDURE ctargetfile_access + IF EMPTY(THIS.cTargetFile) + + WITH THIS.oleCommonDialog + + .Flags = cdlOFNPathMustExist + ; + cdlOFNNoChangeDir + ; + cdlOFNHideReadOnly + ; + cdlOFNExplorer + ; + cdlOFNOverwritePrompt+ ; + cdlOFNNoReadOnlyReturn + .ShowSave() + THIS.cTargetFile = .FileName + + ENDWITH + + ENDIF + + RETURN THIS.cTargetFile + + ENDPROC + + PROCEDURE getfixedfont && Uses common dialog to display font dialog, restricted to fixed font items. + LOCAL lcName, liSize + + lcName = THIS.cFixedFontName + liSize = THIS.iFixedFontSize + + WITH THIS.oleCommonDialog + + .Flags = cdlCFScreenFonts + ; + cdlCFForceFontExist + ; + cdlCFFixedPitchOnly + + .FontName = THIS.cFixedFontName + .FontSize = THIS.iFixedFontSize + .FontItalic = IIF(THIS.lFixedFontItalic,1,0) + .FontBold = IIF(THIS.lFixedFontBold,1,0) + .ShowFont() + + IF NOT EMPTY(.FontName) + THIS.cFixedFontName = .FontName + THIS.lFixedFontBold = NOT EMPTY(.FontBold) + THIS.lFixedFontItalic = NOT EMPTY(.FontItalic) + ELSE + THIS.cFixedFontName = lcName + ENDIF + + IF NOT EMPTY(.FontSize) + THIS.iFixedFontSize = .FontSize + ELSE + THIS.iFixedFontSize = liSize + ENDIF + + ENDWITH + + ENDPROC + + PROCEDURE Init + LPARAMETERS tcSourceFile + + LOCAL loControl + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + IF SYSTEM_LARGEFONTS + LOCAL lcStandardFont + lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME) + + FOR EACH loControl IN THIS.Controls + IF PEMSTATUS(loControl,"FontName",5) AND ; + UPPER(loControl.FontName) == lcStandardFont + + loControl.FontName = DIALOG_LARGEFONT_NAME + ENDIF + ENDFOR + * Note: no recursion here. + + ENDIF + + THIS.cSourceFile = tcSourceFile + THIS.Caption = SHOWTEXT_TEXT_EDITOR_LOC + THIS.MinHeight = THIS.Height + THIS.MinWidth = THIS.Width + THIS.SetFonts() + THIS.Resize() + ENDPROC + + PROCEDURE Resize + LOCAL lnMargin + + lnMargin = SYSMETRIC(VERTICAL_SCROLLBAR_WIDTH) + + WITH THIS.edtText + + .Width = THIS.Width - (THIS.cmdClose.Width + ; + (lnMargin * 2) + ; + .Left) + + STORE (.Width + .Left + lnMargin) TO ; + THIS.cmdSave.Left, ; + THIS.cmdClose.Left, ; + THIS.chkReadonly.Left, ; + THIS.cmdFonts.Left + + lnMargin = .Top + + .Height = THIS.Height - lnMargin * 2 + + ENDWITH + + + ENDPROC + + PROCEDURE setfonts && Applies the current font property characteristics to the editbox displaying the file. + THIS.edtText.FontName = THIS.cFixedFontName + THIS.edtText.FontSize = THIS.iFixedFontSize + THIS.edtText.FontItalic = THIS.lFixedFontItalic + THIS.edtText.FontBold = THIS.lFixedFontBold + ENDPROC + + PROCEDURE cmdClose.Click + THISFORM.Release() + + ENDPROC + + PROCEDURE cmdFonts.Click + THISFORM.GetFixedFont() + THISFORM.SetFonts() + + ENDPROC + + PROCEDURE cmdSave.Click + + LOCAL lcFile + lcFile = THISFORM.cTargetFile + + IF AT(".",lcFile) = 0 + lcFile = lcFile + ".TXT" + ENDIF + + StrToFile(THISFORM.edtText.Value,lcFile) + + + ENDPROC + +ENDDEFINE diff --git a/Clase/_table.h b/Clase/_table.h new file mode 100644 index 0000000..5d6652e --- /dev/null +++ b/Clase/_table.h @@ -0,0 +1,82 @@ +* _TABLE.H + +*********************************** +* constants for _Table* classes + +#DEFINE DB_BUFLOCKRECORD 2 +#DEFINE DB_BUFOPTRECORD 3 + +#DEFINE FILTER_MAX_FILTER 255 + +#DEFINE MB_ICONEXCLAMATION 48 +#DEFINE MB_YESNOCANCEL 3 +#DEFINE IDYES 6 +#DEFINE IDNO 7 + +*********************************** +* localization for _Table* classes + +* _TableFind* buttons and dialog class strings + +#DEFINE FIND_LOOKFOR_LOC "\ (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS _filterdialog AS _form OF "_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="shpExpressionFrame" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="shpFilterFrame" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblOrder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblTables" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblCriteria" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboOperator" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="edtSought" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdAdd" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lstQueryParts" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboOrder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboTables" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdReset" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdDelete" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdUp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdDown" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboFieldname" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusTable" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + *m: brackets + *m: cleanparens + *m: editquery + *m: fset + *m: nobrack + *m: notag + *m: ontag + *m: qreset + *m: qset + *m: setaction + *m: setinitialqueryparts + *m: setrowsources + *m: settags + *m: setupfilter && This takes the conditions listed in the dialog and rationalizes them into a filter expression (it also applies the NORMALIZE() function to the expression). + *p: cfilter && This is the filter expression. + *p: coldexact + *p: ibact + *p: iqptr + *p: iquerymax + *p: iselect + *p: ocaller + *a: adbfs[1,0] + *a: aflds[1,0] + *a: aquery[1,0] + *a: atags[1,0] + * + + * + AutoCenter = .T. + BorderStyle = 0 + Caption = ("Filter Conditions ") + cfilter = ("") + ClipControls = .F. + Closable = .T. + coldexact = ("OFF") + DoCreate = .T. + FontName = "MS Sans Serif" + FontSize = 8 + HalfHeightCaption = .F. + Height = 326 + ibact = 0 + iqptr = 0 + iquerymax = 50 + iselect = 0 + MaxButton = .F. + MinButton = .T. + Movable = .T. + Name = "_filterdialog" + ocaller = .NULL. + Width = 389 + ZoomBox = .F. + * + + ADD OBJECT 'cboFieldname' AS _combobox WITH ; + BorderStyle = 1, ; + Enabled = .T., ; + FontBold = .F., ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 20, ; + Left = 12, ; + Name = "cboFieldname", ; + ReleaseErase = .F., ; + RowSource = "", ; + RowSourceType = 5, ; + Sorted = .F., ; + SpecialEffect = 0, ; + Style = 2, ; + TabIndex = 5, ; + Top = 46, ; + Value = 1, ; + Width = 108 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cboOperator' AS _combobox WITH ; + Enabled = .T., ; + FirstElement = 1, ; + FontBold = .F., ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 20, ; + Left = 127, ; + Name = "cboOperator", ; + ReleaseErase = .F., ; + RowSource = "=,<>,<,>,<=,>=,==,IN", ; + RowSourceType = 1, ; + Sorted = .T., ; + SpecialEffect = 0, ; + Style = 2, ; + TabIndex = 6, ; + Top = 46, ; + Value = ("="), ; + Width = 32 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cboOrder' AS _combobox WITH ; + BorderStyle = 1, ; + Enabled = .T., ; + FontBold = .F., ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 20, ; + Left = 271, ; + Name = "cboOrder", ; + ReleaseErase = .F., ; + RowSourceType = 5, ; + Sorted = .F., ; + SpecialEffect = 0, ; + Style = 2, ; + TabIndex = 4, ; + Top = 5, ; + Value = 1, ; + Width = 112 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cboTables' AS _combobox WITH ; + BorderStyle = 1, ; + Enabled = .T., ; + FontBold = .F., ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 20, ; + Left = 50, ; + Name = "cboTables", ; + ReleaseErase = .F., ; + RowSourceType = 5, ; + Sorted = .F., ; + SpecialEffect = 0, ; + Style = 2, ; + TabIndex = 2, ; + Top = 5, ; + Value = 1, ; + Width = 155 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cmdAdd' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdCancel' AS _commandbutton WITH ; + AutoSize = .F., ; + Cancel = .T., ; + Caption = "Cancel", ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 25, ; + Left = 204, ; + Name = "cmdCancel", ; + ReleaseErase = .F., ; + TabIndex = 17, ; + Top = 288, ; + Width = 51 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdDelete' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdDown' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "Do\ + + ADD OBJECT 'cmdOK' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "OK", ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 25, ; + Left = 128, ; + Name = "cmdOK", ; + ReleaseErase = .F., ; + TabIndex = 16, ; + Top = 288, ; + Width = 51 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdOr' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdReset' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdUp' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cusTable' AS _table WITH ; + Left = 211, ; + Name = "cusTable", ; + Top = 4 + *< END OBJECT: ClassLib="_table.vcx" BaseClass="custom" /> + + ADD OBJECT 'edtSought' AS _editbox WITH ; + AllowTabs = .F., ; + BorderStyle = 1, ; + DisabledBackColor = 223,223,223, ; + Enabled = .T., ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Format = "3K", ; + Height = 20, ; + Left = 164, ; + Margin = 0, ; + Name = "edtSought", ; + ReleaseErase = .F., ; + ScrollBars = 0, ; + SpecialEffect = 0, ; + TabIndex = 7, ; + Top = 46, ; + Width = 212 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="editbox" /> + + ADD OBJECT 'lblCriteria' AS _label WITH ; + AutoSize = .T., ; + Caption = (" Criteria "), ; + DisabledBackColor = 225,225,225, ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 15, ; + Left = 13, ; + Name = "lblCriteria", ; + ReleaseErase = .F., ; + TabIndex = 8, ; + Top = 90, ; + Width = 40 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="label" /> + + ADD OBJECT 'lblOrder' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = ("Ord\ + + ADD OBJECT 'lblTables' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = ("\ + + ADD OBJECT 'lstQueryParts' AS _listbox WITH ; + Enabled = .F., ; + FontName = "MS Sans Serif", ; + FontSize = 9, ; + Height = 126, ; + IntegralHeight = .T., ; + Left = 14, ; + Name = "lstQueryParts", ; + ReleaseErase = .F., ; + RowSourceType = 5, ; + SpecialEffect = 0, ; + TabIndex = 9, ; + Top = 107, ; + Value = 1, ; + Width = 359 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="listbox" /> + + ADD OBJECT 'shpExpressionFrame' AS _shape WITH ; + BackStyle = 0, ; + FillStyle = 1, ; + Height = 46, ; + Left = 5, ; + Name = "shpExpressionFrame", ; + ReleaseErase = .F., ; + SpecialEffect = 0, ; + Top = 34, ; + Width = 379 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="shape" /> + + ADD OBJECT 'shpFilterFrame' AS _shape WITH ; + BackStyle = 0, ; + FillStyle = 1, ; + Height = 179, ; + Left = 4, ; + Name = "shpFilterFrame", ; + ReleaseErase = .F., ; + SpecialEffect = 0, ; + Top = 98, ; + Width = 379 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="shape" /> + + PROCEDURE Activate + LOCAL lidbc, liIndex + LOCAL ARRAY laTemp[1,2] + lidbc=AUSED(laTemp) + + THIS.iSelect = SELECT() + THIS.cOldExact = SET("EXACT") + SET EXACT OFF + + IF lidbc # ALEN(THIS.aDbfs) OR ; + EMPTY(THIS.aDbfs[1]) && empty array will happen only the first time + + WAIT WINDOW NOWAIT LEFT(FILTER_CHECKING_OPEN_TABLES_LOC,254) + + IF lidbc = 0 + USE ? + IF EMPTY(ALIAS()) + WAIT WINDOW LEFT(FILTER_CANCELLED_LOC,254) NOWAIT + NODEFAULT + RETURN .F. + ELSE + lidbc = 1 + THIS.aDbfs[1] = PROPER(ALIAS()) + THIS.cboTables.Requery() + THIS.cboTables.Value = 1 + ENDIF + ELSE + DIME THIS.aDbfs[lidbc] + FOR liIndex = 1 TO lidbc + THIS.aDbfs[liIndex] = PROPER(laTemp[liIndex,1]) + ENDFOR + THIS.cboTables.Requery() + ENDIF + + WAIT CLEAR + + ENDIF + + IF EMPTY(ALIAS()) + SELECT (THIS.aDbfs[1]) + THIS.cboTables.Value = 1 + ELSE + THIS.cboTables.Value = ASCAN(THIS.aDbfs,PROPER(ALIAS())) + ENDIF + + LOCAL lcFilter + lcFilter = SET("FILTER") + + DO CASE + CASE TYPE("THIS.oCaller.Name") = "C" + THIS.SetInitialQueryParts(THIS.oCaller.cFilter) + CASE THIS.SetupFilter() AND ; + (THIS.cFilter == lcFilter) + * don't touch + CASE EMPTY(lcFilter) + THIS.SetInitialQueryParts("") + OTHERWISE + THIS.SetInitialQueryParts(lcFilter) + ENDCASE + + THIS.SetAction() + + + ENDPROC + + PROCEDURE brackets + LPARAMETERS tcx, tcb1, tcb2 + LOCAL lcout, lii, lcv, lcx + IF SUBSTR(tcx,1,1)=tcb1 AND SUBSTR(tcx,LEN(tcx),1)=tcb2 + RETURN tcx + ENDIF + IF THIS.cboOperator.Value = "IN" + RETURN tcb1 + tcx + tcb2 + ENDIF + lcout = "" + lcx = tcx + DO WHILE LEN(lcx) > 0 + lii = AT(",", lcx) + IF lii = 0 + lcv = lcx + lcx = "" + ELSE + lcv = SUBSTR(lcx,1,lii-1) + lcx = IIF(lii=LEN(lcx),"",SUBSTR(lcx,lii+1)) + ENDIF + IF LEN(lcout) > 0 + lcout = lcout + "," + ENDIF + lcout = lcout + tcb1 + lcv + tcb2 + ENDDO + RETURN lcout + + + ENDPROC + + PROCEDURE cleanparens + LPARAMETERS piItem + + *- + *- remove parens from filter + *- Called from cmdDelete:Click and THISFORM:Init + *- + + LOCAL i, lcItem + + lcItem = THISFORM.aQuery[piItem] + + DO WHILE .T. + *- there may be multiple sets of parentheses, so loop through + *- till we get rid of all of them + DO CASE + CASE OCCURS("(", lcItem) == OCCURS(")",lcItem) + *- ignore, since same number of left and right parens are on this item + EXIT + CASE LEFT(lcItem,1) == "(" + *- scan forward, looking for matching ")" + FOR i = piItem TO ALEN(THISFORM.aquery,1) + IF RIGHT(THISFORM.aQuery[i],1) == ")" + THISFORM.aQuery[i] = LEFT(THISFORM.aquery[i],LEN(THISFORM.aquery[i]) - 1) + lcItem = IIF(i == piItem, THISFORM.aQuery[i], lcItem) + EXIT + ENDIF + NEXT + lcItem = SUBSTR(lcItem,2) && strip left paren + CASE RIGHT(lcItem,1) == ")" + *- scan backward, looking for matching "(" + FOR i = piItem TO 1 STEP -1 + IF LEFT(THISFORM.aQuery[i],1) == "(" + THISFORM.aQuery[i] = SUBSTR(THISFORM.aquery[i],2) + lcItem = IIF(i == piItem, THISFORM.aQuery[i], lcItem) + EXIT + ENDIF + NEXT + lcItem = LEFT(lcItem, LEN(lcItem) - 1) && strip right paren + OTHERWISE + *- nothing to do + EXIT + ENDCASE + ENDDO + RETURN + ENDPROC + + PROCEDURE Deactivate + LOCAL lcExact + lcExact = THIS.cOldExact + SET EXACT &lcExact + SELECT (THIS.iSelect) + + ENDPROC + + PROCEDURE editquery + LPARAMETERS tcx + LOCAL lcvar, lii, lcorig, lcout, lcv, lcx + lcorig = tcx + lii = AT(" ", tcx) + IF lii = 0 + RETURN lcorig + ENDIF + lcvar = SUBSTR(tcx,1,lii-1) + lcx = SUBSTR(tcx,lii+1) + lii = AT(" ", lcx) + THIS.cboOperator.Value = SUBSTR(lcx,1,lii-1) + lcx = SUBSTR(lcx,lii+1) + IF THIS.cboOperator.Value # "IN" + RETURN lcorig + ENDIF + lcout = "(" + DO WHILE LEN(lcx) > 0 + lii = AT(",", lcx) + IF lii = 0 + lcv = lcx + lcx = "" + ELSE + lcv = SUBSTR(lcx,1,lii-1) + lcx = IIF(lii=LEN(lcx),"",SUBSTR(lcx,lii+1)) + ENDIF + IF RIGHT(lcout,1) # "(" + lcout = lcout + " OR " + ENDIF + lcout = lcout + lcvar + "=" + lcv + ENDDO + lcout = lcout + ")" + RETURN lcout + + ENDPROC + + PROCEDURE fset + LOCAL lcx, lctyp + IF THIS.aQuery(THIS.lstQueryParts.Value) = "*OR*" + STORE .F. TO THIS.cboFieldName.Enabled, ; + THIS.edtSought.Enabled, ; + THIS.cboOperator.Enabled + ELSE + THIS.cbofieldname.Enabled = .T. + IF THIS.cboFieldname.Value = 0 + THIS.cboFieldname.Value = 1 + THIS.cboOperator.Value = "=" + THIS.edtSought.Value = "" + ENDIF + lcx = THIS.NoTag(THIS.aFlds[THIS.cbofieldname.Value]) + lctyp = TYPE(lcx) + STORE (lcTyp # "L") TO ; + THIS.cboOperator.Enabled, ; + THIS.edtSought.Enabled + ENDIF + ENDPROC + + PROCEDURE Init + LPARAMETERS toCaller + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + IF TYPE("toCaller.Name") = "C" AND ; + PEMSTATUS(toCaller,"SetFilter",5) && this dialog is really only supposed + && to be called by a parent dialog, but + && what the heck, if you don't call it this way + && we will set the filter directly... + + THIS.oCaller = toCaller + + ENDIF + + DIME THIS.aQuery[THIS.iQueryMax] + THIS.aQuery = " " + THIS.iqptr = 0 + THIS.edtSought.Value = "" + THIS.cboOperator.Value = "=" + THIS.SetRowSources() + + IF SYSTEM_LARGEFONTS + THIS.SetAll("FontName",DIALOG_LARGEFONT_NAME) + ENDIF + + RETURN + + ENDPROC + + PROCEDURE nobrack + LPARAMETERS tcx + LOCAL lii,lcy,lcC + lcy = "" + FOR lii = 1 TO LEN(tcx) + lcC = SUBSTR(tcx,lii,1) + IF NOT lcC$"'{}" + lcy = lcy + lcC + ENDIF + ENDFOR + RETURN lcy + ENDPROC + + PROCEDURE notag + LPARAMETERS tcX + LOCAL lcX + lcX = SUBSTR(tcx,2) + RETURN lcX + + ENDPROC + + PROCEDURE ontag + LPARAMETERS tcx + LOCAL lcX + lcx = IIF(ASCAN(THIS.aTags,tcx)#0,"*"," ") + tcx + RETURN lcx + + ENDPROC + + PROCEDURE qreset + THIS.aQuery = " " + THIS.iQptr = 0 + THIS.lstQueryParts.Value = 1 + THIS.cboOperator.Value = "=" + THIS.edtSought.Value = "" + THIS.edtSought.Refresh() + THIS.SetAction() + + ENDPROC + + PROCEDURE qset + LOCAL lcx, lii, lcFieldname, liDot + + IF BETWEEN(1,THIS.lstQueryParts.Value,THIS.iQptr) + lcx = THIS.aQuery(THIS.lstQueryParts.Value) + IF lcx = CHR(205) && "Í" -- should it be "=" ?? + RETURN + ENDIF + lii = AT(" ",lcx) + liDot = AT(".",lcx) + IF lii <= 1 + THIS.cboOperator.Value = "=" + THIS.edtSought.Value = "" + IF TYPE(lcx) = "U" OR liDot = 0 OR ; + UPPER(SUBSTR(lcx,1,liDot)) # UPPER(ALIAS())+"." + THIS.cboFieldname.Value = 1 + ELSE + THIS.cboFieldname.Value = ASCAN(THIS.aFlds,THIS.OnTag(SUBSTR(lcx,liDot+1))) + ENDIF + ELSE + lcFieldName = SUBSTR(lcx,1,lii-1) + IF TYPE(lcFieldName) = "U" OR liDot = 0 OR ; + UPPER(SUBSTR(lcFieldName,1,liDot)) # UPPER(ALIAS())+"." + THIS.cboFieldName.Value = 1 + ELSE + THIS.cboFieldName.Value = ASCAN(THIS.aFlds,THIS.OnTag(SUBSTR(lcFieldName,liDot+1))) + ENDIF + lcx = SUBSTR(lcx,lii+1) + lii = AT(" ",lcx) + THIS.cboOperator.Value = SUBSTR(lcx,1,lii-1) + THIS.edtSought.Value = THIS.Nobrack(SUBSTR(lcx,lii+1)) + ENDIF + THIS.cboFieldName.Refresh + THIS.cboOperator.Refresh + THIS.edtSought.Refresh + ENDIF + + ENDPROC + + PROCEDURE setaction + DO CASE + + CASE THIS.iQptr = 0 + STORE .F. TO THIS.cmdReset.Enabled, ; + THIS.cmdOr.Enabled, ; + THIS.cmdOK.Enabled, ; + THIS.lstQueryParts.Enabled, ; + THIS.cmdDelete.Enabled, ; + THIS.cmdUp.Enabled, ; + THIS.cmdDown.Enabled + + CASE THIS.lstQueryParts.Value > THIS.iQptr + + THIS.cmdOr.Enabled = ; + (THIS.lstQueryParts.Value = THIS.iQptr + 1) + + STORE .F. TO THIS.cmdDelete.Enabled, ; + THIS.cmdUp.Enabled, ; + THIS.cmdDown.Enabled + + STORE .T. TO THIS.cmdReset.Enabled, ; + THIS.cmdOK.Enabled, ; + THIS.lstQueryParts.Enabled + + OTHERWISE + + STORE .T. TO THIS.cmdReset.Enabled, ; + THIS.cmdOK.Enabled, ; + THIS.cmdOr.Enabled, ; + THIS.lstQueryParts.Enabled, ; + THIS.cmdDelete.Enabled + + THIS.cmdUp.Enabled = ; + (THIS.iQptr # 1 AND THIS.lstQueryParts.Value # 1) + THIS.cmdDown.Enabled = ; + (THIS.iQptr # 1 AND THIS.iQptr # THIS.lstQueryParts.Value) + + ENDCASE + + ENDPROC + + PROCEDURE setinitialqueryparts + LPARAMETERS tcQueryString + + ASSERT EMPTY(tcQueryString) OR VARTYPE(tcQueryString) = "C" + + DIME THIS.aQuery[THIS.iQueryMax] + THIS.cFilter = "" + THIS.aQuery = " " + THIS.iqptr = 0 + + IF EMPTY(tcQueryString) + THIS.lstQueryParts.Value = 1 + THIS.lstQueryParts.Enabled = .F. + RETURN + ENDIF + + LOCAL lcQueryString, lcThisPart, liThisChar, ; + lcStringLength, lcThisChar, lcDelimiters + + lcQueryString = NORMALIZE(tcQueryString) + + liThisChar = 0 + liStringLength = LEN(lcQueryString) + STORE "" TO lcThisPart, lcThisChar, lcDelimiters + + + DO WHILE .T. + + liThisChar = liThisChar + 1 + lcThisChar = SUBSTR(lcQueryString,liThisChar,1) + lcThisPart = lcThisPart + lcThisChar + + IF INLIST(lcThisChar,["], ['],"[", "]" ) + + IF (INLIST(lcThisChar,["],[']) AND ; + RIGHT(lcDelimiters,1) = lcThisChar) OR ; + (lcThisChar = "]" AND ; + RIGHT(lcDelimiters,1) = "[") + * finishing an expression + lcDelimiters = LEFT(lcDelimiters, LEN(lcDelimiters)-1) + ELSE + IF lcThisChar # "]" + lcDelimiters = lcDelimiters + lcThisChar + ENDIF + ENDIF + + ENDIF + + DO CASE + CASE LEN(lcDelimiters) > 0 + * we're in an expression + CASE RIGHT(lcThisPart,4) = ".OR." + lcThisPart = LEFT(lcThisPart,LEN(lcThisPart)-4) + THIS.iQptr = THIS.iQptr + 1 + THIS.aQuery(THIS.iQptr) = lcThisPart + THIS.iQptr = THIS.iQptr + 1 + THIS.aQuery(THIS.iQptr) = "*OR*" + lcThisPart = "" + + CASE RIGHT(lcThisPart,5) = ".AND." + + lcThisPart = LEFT(lcThisPart,LEN(lcThisPart)-5) + THIS.iQptr = THIS.iQptr + 1 + THIS.aQuery(THIS.iQptr) = lcThisPart + lcThisPart = "" + + OTHERWISE + * continue + ENDCASE + + IF liThisChar = liStringLength OR ; + THIS.iQptr = THIS.iQueryMax + EXIT + ENDIF + + + ENDDO + + * final "part" + THIS.iQptr = THIS.iQptr + 1 + THIS.aQuery(THIS.iQptr) = lcThisPart + THIS.lstQueryParts.Value = THIS.iQptr+1 + THIS.lstQueryParts.Enabled = .T. + + ENDPROC + + PROCEDURE setrowsources + + THIS.cboFieldName.RowSource = "THISFORM.aFlds" + THIS.cboOrder.RowSource = "THISFORM.aTags" + THIS.cboTables.RowSource = "THISFORM.aDbfs" + THIS.lstQueryParts.RowSource = "THISFORM.aQuery" + ENDPROC + + PROCEDURE settags + THIS.aTags[1] = "Record#" + LOCAL iFl + DIME THIS.aTags[TAGCOUNT()+1] + FOR iFl = 2 TO (ALEN(THIS.aTags)) + THIS.aTags(iFl) = TAG(iFl-1) + ENDFOR + + DIME THIS.aFlds[FCOUNT()] + FOR ifl = 1 TO ALEN(THIS.aFlds) + IF TYPE(FIELD(ifl)) = "G" + THIS.aFlds[ifl] = "\"+FIELD(ifl) + ELSE + THIS.aFlds[ifl] = ; + THIS.OnTag(FIELD(ifl)) + ENDIF + ENDFOR + + + + ENDPROC + + PROCEDURE setupfilter && This takes the conditions listed in the dialog and rationalizes them into a filter expression (it also applies the NORMALIZE() function to the expression). + LOCAL lcx, lii, lnstime, lnetime, lcy, lik, liempty, liSelect, lcAlias + + lcx = "" + + IF THISFORM.iQptr # 0 + + FOR lik = 1 TO THISFORM.iQptr + IF THISFORM.aQuery(lik)#"*OR*" + lcx = "("+THISFORM.EditQuery(TRIM(THISFORM.aQuery(lik))) + EXIT + ENDIF + ENDFOR + FOR lii = lik+1 TO THISFORM.iQptr + IF THISFORM.aQuery(lii) = "*OR*" + IF THISFORM.aQuery(lii-1) = "*OR*" + LOOP + ENDIF + lcx = lcx + ") OR (" + ELSE + IF THISFORM.aQuery(lii-1) # "*OR*" + lcx = lcx + " AND " + ENDIF + lcx = lcx + THISFORM.EditQuery(TRIM(THISFORM.aQuery(lii))) + ENDIF + ENDFOR + lcx = lcx + ")" + liempty = RAT(' OR ()',lcx) + IF liempty#0 + lcx = SUBSTR(lcx,1,liempty-1) + ENDIF + IF LEN(lcx) > FILTER_MAX_FILTER + WAIT WINDOW LEFT(FILTER_TOO_LONG_LOC,254) NOWAIT + RETURN 0 + ENDIF + liSelect = SELECT() + lcAlias = "C"+SYS(2015) + lnstime = SECONDS() + SELECT COUNT(*) AS myTally, .T. ; + FROM (ALIAS()) WHERE &lcx ; + INTO CURSOR (lcAlias) + lnetime = SECONDS() + lcy = ALLTRIM(TRANS(myTally,"9,999,999"))+" "+ FILTER_RECORDS_LOC+", " + lcy = lcy + ALLTRIM(TRANS(lnetime-lnstime,"999.99")) + " "+FILTER_SECONDS_LOC+"." + USE IN (lcAlias) + SELECT (liSelect) + WAIT WINDOW LEFT(lcy,254) NOWAIT TIMEOUT 2 + ENDIF + + IF EMPTY(lcx) + STORE "" TO THISFORM.cfilter + ELSE + STORE NORMALIZE(lcx) TO THISFORM.cFilter + ENDIF + + ENDPROC + + PROCEDURE cboOrder.Valid + LOCAL lcx + lcx = ALLTRIM(THISFORM.aTags[THISFORM.cboOrder.Value]) + IF UPPER(lcx) = "RECORD#" + SET ORDER TO + ELSE + SET ORDER TO (lcx) + ENDIF + GO TOP + ENDPROC + + PROCEDURE cboTables.InteractiveChange + SELECT (THISFORM.aDbfs[THIS.Value]) + THISFORM.SetTags() + THISFORM.cboOrder.Requery() + THISFORM.cboFieldname.Requery() + THISFORM.cboOrder.Value = IIF(LEN(ORDER())=0,1,ASCAN(THISFORM.aTags,ORDER())) + THISFORM.cboFieldname.Value = 1 + THISFORM.FSet() + + + ENDPROC + + PROCEDURE cboTables.ProgrammaticChange + THIS.InteractiveChange() + ENDPROC + + PROCEDURE cmdAdd.Click + LOCAL lcx, lcy, lcz, lctyp, lctyp2 + IF THISFORM.iQptr = THISFORM.iQueryMax + ?? CHR(7) + WAIT WINDOW LEFT(FILTER_QUERY_LIST_FULL_LOC,254) NOWAIT + RETURN 0 + ENDIF + lcx = ALIAS()+"."+THISFORM.NoTag(TRIM(THISFORM.aFlds[THISFORM.cboFieldname.Value])) + lcy = ALLTRIM(THISFORM.edtSought.Value) + lctyp = TYPE(lcx) + IF EMPTY(lcy) AND NOT lctyp = "L" + ?? CHR(7) + WAIT WINDOW LEFT(FILTER_MISSING_VALUE_LOC,254) NOWAIT + THISFORM.edtSought.SetFocus() + * this shouldn't happen anymore + * because of the programmatic/interactive change stuff + * on edtSought, but JIC. + RETURN 0 + ENDIF + DO CASE + CASE INLIST(lctyp,"C","M") + lcy = THISFORM.Brackets(lcy,"'","'") + CASE INLIST(lctyp,"D","T") + lcy = THISFORM.Brackets(lcy,"{","}") + CASE INLIST(lctyp,"N","Y","I") + IF AT('"',lcy)#0 + WAIT WINDOW LEFT(FILTER_NUMERIC_NO_QUOTES_LOC,254) NOWAIT + RETURN 0 + ENDIF + lctyp2 = TYPE(lcy) + IF NOT INLIST(lctyp2,"N","Y","I") + WAIT WINDOW LEFT(FILTER_NUMERIC_REQUIRED_LOC,254) NOWAIT + RETURN 0 + ENDIF + ENDCASE + IF lctyp = "L" + lcz = lcx + ELSE + lcz = lcx + " " + THISFORM.cboOperator.Value + " " + lcy + ENDIF + IF BETWEEN(1,THISFORM.lstQueryParts.Value,THISFORM.iQptr) + THISFORM.aQuery(THISFORM.lstQueryParts.Value) = lcz + ELSE + THISFORM.iQptr = THISFORM.iQptr + 1 + THISFORM.aQuery(THISFORM.iQptr) = lcz + ENDIF + THISFORM.lstQueryParts.Value = THISFORM.iQptr+1 + + THISFORM.lstQueryParts.Enabled = .T. + THISFORM.SetAction() + + + + ENDPROC + + PROCEDURE cmdCancel.Click + THISFORM.Release() + ENDPROC + + PROCEDURE cmdDelete.Click + THISFORM.ibact = 1 + + *- clean up parens + THISFORM.cleanparens(THISFORM.lstQueryParts.Value) + = ADEL(THISFORM.aQuery,THISFORM.lstQueryParts.Value) + THISFORM.aQuery(THISFORM.iQueryMax) = " " + THISFORM.iQptr = THISFORM.iQptr - 1 + THISFORM.lstQueryParts.Value = ; + MIN(THISFORM.lstQueryParts.Value,THISFORM.iQptr+1) + THISFORM.Qset() + THISFORM.SetAction() + THISFORM.lstQueryParts.Refresh + + ENDPROC + + PROCEDURE cmdDown.Click + LOCAL lcx + THISFORM.ibact = 3 + IF THISFORM.lstQueryParts.Value < THISFORM.iQptr + lcx = THISFORM.aQuery(THISFORM.lstQueryParts.Value+1) + THISFORM.aQuery(THISFORM.lstQueryParts.Value+1) = ; + THISFORM.aQuery(THISFORM.lstQueryParts.Value) + THISFORM.aQuery(THISFORM.lstQueryParts.Value) = lcx + THISFORM.lstQueryParts.Value = THISFORM.lstQueryParts.Value + 1 + ENDIF + THISFORM.Setaction() + THISFORM.lstQueryParts.Refresh + + ENDPROC + + PROCEDURE cmdOK.Click + THISFORM.SetUpFilter() + + IF TYPE("THISFORM.oCaller.Name") = "C" AND ; + PEMSTATUS(THISFORM.oCaller,"setfilter",5) + THISFORM.oCaller.SetFilter(THISFORM.cFilter) + ELSE + * set it directly after deciding that it is okay to do it + * using the _table object + + IF THISFORM.cusTable.CurrentTableAllowsNavigation(ALIAS()) + LOCAL lcFilter + lcFilter = THISFORM.cFilter + SET FILTER TO &lcFilter + LOCATE + THISFORM.cusTable.RefreshLastWindowAfterChange() + ENDIF + + ENDIF + THISFORM.Release() + ENDPROC + + PROCEDURE cmdOr.Click + LOCAL lii + THISFORM.ibact = 4 + IF THISFORM.lstQueryParts.Value < THISFORM.iQptr + FOR lii = THISFORM.iQptr TO THISFORM.lstQueryParts.Value+1 STEP -1 + THISFORM.aQuery(lii+1) = THISFORM.aQuery(lii) + ENDFOR + THISFORM.aQuery(THISFORM.lstQueryParts.Value + 1) = "*OR*" + THISFORM.lstQueryParts.Value = THISFORM.lstQueryParts.Value + 2 + ELSE + THISFORM.aQuery(THISFORM.iQptr+1) = "*OR*" + THISFORM.lstQueryParts.Value = THISFORM.iQptr + 2 + ENDIF + THISFORM.iQptr = THISFORM.iQptr + 1 + THISFORM.SetAction() + THISFORM.lstQueryParts.Refresh + ENDPROC + + PROCEDURE cmdReset.Click + THISFORM.aQuery = " " + THISFORM.iQptr = 0 + THISFORM.lstQueryParts.Value = 1 + THISFORM.cboOperator.Value = "=" + THISFORM.edtSought.Value = "" + THISFORM.SetAction() + *THISFORM.edtSought.Refresh + ENDPROC + + PROCEDURE cmdUp.Click + LOCAL lcx + THISFORM.iBact= 2 + IF THISFORM.lstQueryParts.Value > 1 AND ; + THISFORM.lstQueryParts.Value <= THISFORM.iQptr + lcx = THISFORM.aQuery(THISFORM.lstQueryParts.Value-1) + THISFORM.aQuery(THISFORM.lstQueryParts.Value-1) = ; + THISFORM.aQuery(THISFORM.lstQueryParts.Value) + THISFORM.aQuery(THISFORM.lstQueryParts.Value) = lcx + THISFORM.lstQueryParts.Value = THISFORM.lstQueryParts.Value - 1 + ENDIF + THISFORM.SetAction() + THISFORM.lstQueryParts.Enabled = .T. + ENDPROC + + PROCEDURE edtSought.InteractiveChange + THISFORM.cmdAdd.Enabled = (NOT EMPTY(THIS.Value)) + ENDPROC + + PROCEDURE edtSought.ProgrammaticChange + THIS.InteractiveChange() + + ENDPROC + + PROCEDURE edtSought.Valid + IF "'"$THIS.Value + WAIT WINDOW LEFT(FILTER_NO_SINGLE_QUOTES_LOC,254) NOWAIT + RETURN 0 + ENDIF + THIS.InteractiveChange() + ENDPROC + + PROCEDURE lstQueryParts.InteractiveChange + THIS.Valid() + ENDPROC + + PROCEDURE lstQueryParts.ProgrammaticChange + THIS.Valid() + + ENDPROC + + PROCEDURE lstQueryParts.Valid + THISFORM.SetAction() + THISFORM.QSet() + THISFORM.FSet() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _filterexpr AS _form OF "_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="cusTable" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="edtFilterExpression" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdBuild" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdApply" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblEdit" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + *m: cfilter_access + *m: setfilter && Sets the value of the cFilter property. This method is primarily useful when _FilterDialog is called modally to do further work on the expression to be built. + *m: setfilterontable && If the current table allows navigation according to the dialog's _table member, this method applies the current filter to the current alias, issues a LOCATE to refresh the filter. + *p: cfilter && The filter expression. + *p: ioldselect && Old work area. + *p: ioldsession && Old data session. + *p: ladvanced && This is used to toggle _FilterExpr between two modes (_FilterDialog and GETEXPR). + * + + * + AutoCenter = .T. + BorderStyle = 0 + Caption = "Set Filter" + cfilter = (SPACE(254)) + DoCreate = .T. + Height = 155 + ioldselect = 0 + ioldsession = 0 + Name = "_filterexpr" + Width = 328 + WindowType = 1 + * + + ADD OBJECT 'cmdApply' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'cmdBuild' AS _commandbutton WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'cmdCancel' AS _commandbutton WITH ; + Cancel = .T., ; + Caption = "\ + + ADD OBJECT 'cusTable' AS _table WITH ; + Height = 15, ; + Left = 298, ; + Name = "cusTable", ; + Top = 5, ; + Width = 24 + *< END OBJECT: ClassLib="_table.vcx" BaseClass="custom" /> + + ADD OBJECT 'edtFilterExpression' AS _editbox WITH ; + ControlSource = "THISFORM.cFilter", ; + FontName = "MS Sans Serif", ; + Height = 99, ; + IntegralHeight = .T., ; + Left = 8, ; + MaxLength = 254, ; + Name = "edtFilterExpression", ; + TabIndex = 2, ; + Top = 19, ; + Value = (""), ; + Width = 312, ; + ZOrderSet = 2 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="editbox" /> + + ADD OBJECT 'lblEdit' AS _label WITH ; + AutoSize = .T., ; + Caption = "\ + + PROCEDURE cfilter_access + LOCAL lcValue + IF EMPTY(THIS.cFilter) + lcValue = SPACE(254) + ELSE + lcValue = STRTRAN(ALLTRIM(THIS.cFilter),CHR(13),SPACE(1)) + lcValue = STRTRAN(lcValue,CHR(9),SPACE(1)) + lcValue = STRTRAN(lcValue,CHR(10),SPACE(1)) + ENDIF + + RETURN lcValue + + ENDPROC + + PROCEDURE Init + LOCAL loControl + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + LOCAL ARRAY laCheck[1] + IF EMPTY(ALIAS()) + THIS.iOldSession = SET("DATASESSION") + IF EMPTY(AUSED(laCheck)) + DO CASE + CASE TYPE("_SCREEN.ActiveForm.Parent") = "O" + SET DATASESSION TO _SCREEN.ActiveForm.Parent.DataSessionID + CASE TYPE("_SCREEN.ActiveForm") = "O" + SET DATASESSION TO _SCREEN.ActiveForm.DataSessionID + OTHERWISE + * no other real choices + ENDCASE + IF NOT EMPTY(AUSED(laCheck)) + THIS.iOldSelect = SELECT() + SELECT (laCheck[1,1]) + ELSE + SET DATASESSION TO THIS.iOldSession + RETURN .F. + ENDIF + ELSE + THIS.iOldSelect = SELECT() + SELECT (laCheck[1,1]) + ENDIF + ENDIF + + + THIS.Caption = STRTRAN(SETFILTER_CAPTION_LOC,"\<","") + THIS.cmdBuild.Caption = SETFILTER_BUILDEXPR_LOC + THIS.cmdApply.Caption = SETFILTER_APPLY_LOC + THIS.cmdCancel.Caption = SETFILTER_CANCEL_LOC + THIS.lblEdit.Caption = SETFILTER_EDIT_LOC + + IF SYSTEM_LARGEFONTS + LOCAL lcStandardFont + lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME) + + FOR EACH loControl IN THIS.Controls + IF PEMSTATUS(loControl,"FontName",5) AND ; + UPPER(loControl.FontName) == lcStandardFont + + loControl.FontName = DIALOG_LARGEFONT_NAME + ENDIF + ENDFOR + * Note: no recursion here. + + ENDIF + + THIS.SetFilter(SET("FILTER")) + + ENDPROC + + PROCEDURE setfilter && Sets the value of the cFilter property. This method is primarily useful when _FilterDialog is called modally to do further work on the expression to be built. + LPARAMETERS tcValue + LOCAL lcFilter + IF VARTYPE(tcValue) = "C" AND TYPE(tcValue) = "L" + lcFilter = tcValue + ELSE + lcFilter = SPACE(THIS.edtFilterExpression.MaxLength) + ENDIF + STORE lcFilter TO THIS.cFilter, ; + THIS.edtFilterExpression.Value + ENDPROC + + PROCEDURE setfilterontable && If the current table allows navigation according to the dialog's _table member, this method applies the current filter to the current alias, issues a LOCATE to refresh the filter. + IF THIS.cusTable.CurrentTableAllowsNavigation(ALIAS()) + LOCAL lcFilter + lcFilter = THISFORM.cFilter + SET FILTER TO &lcFilter + LOCATE + THIS.cusTable.RefreshLastWindowAfterChange() + ENDIF + + + ENDPROC + + PROCEDURE Unload + IF NOT EMPTY(THIS.iOldSession) + SET DATASESSION TO THIS.iOldSession + ENDIF + IF NOT EMPTY(THIS.iOldSelect) + SELECT (THIS.iOldSelect) + ENDIF + ENDPROC + + PROCEDURE cmdApply.Click + THISFORM.SetFilterOnTable() + THISFORM.Release() + ENDPROC + + PROCEDURE cmdBuild.Click + IF THISFORM.lAdvanced + + LOCAL lcFilter + + GETEXPR THISFORM.Caption ; + TO lcFilter ; + TYPE [L; SETFILTER_INVALID_LOC] ; + DEFAULT THISFORM.cFilter + + IF TYPE(lcFilter) = "L" + THISFORM.cFilter = lcFilter + THISFORM.edtFilterExpression.Refresh + ENDIF + + ELSE + + LOCAL lcfile, loForm + lcfile = FULLPATH(THISFORM.ClassLibrary) + loForm = NEWOBJECT("_FilterDialog",lcFile,"",THISFORM) + IF TYPE("loForm.Name") = "C" + loForm.Show(1) + THISFORM.edtFilterExpression.Refresh() + ENDIF + + ENDIF + ENDPROC + + PROCEDURE cmdCancel.Click + + THISFORM.Release() + ENDPROC + + PROCEDURE edtFilterExpression.Valid + LOCAL llReturn, lcValue + + lcValue = STRTRAN(ALLTRIM(THIS.Value),CHR(13),SPACE(1)) + lcValue = STRTRAN(lcValue,CHR(9),SPACE(1)) + lcValue = STRTRAN(lcValue,CHR(10),SPACE(1)) + + DO CASE + CASE EMPTY(lcValue) + llReturn = .T. + CASE LEN(lcValue) > THIS.MaxLength + WAIT WINDOW LEFT(SETFILTER_MAXLENGTH_LOC,254) NOWAIT + CASE TYPE(lcValue) # "L" + WAIT WINDOW LEFT(SETFILTER_INVALID_LOC,254) NOWAIT + OTHERWISE + llReturn = .T. + THISFORM.cFilter = lcValue + ENDCASE + + RETURN IIF(llReturn,.T.,0) + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _findbutton AS _container OF "_base.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdTableFind" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusTableFind" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + *m: calias_access + *m: calias_assign + *m: cfindstring_access + *m: cfindstring_assign + *m: dofind && This is ordinarily the only method you need to call to do search. + *m: lfindagain_access + *m: lfindagain_assign + *m: lmatchcase_access + *m: lmatchcase_assign + *m: lskipmemos_access + *m: lskipmemos_assign + *m: lwraparound_access + *m: lwraparound_assign + *m: setbuttonui + *m: skipfield && This method allows you to eliminate any particular field or fields from the search. + *p: calias && The data source to search in. + *p: cfindstring && The string to search for. Defaults to a null string. + *p: lfindagain && This determines whether the class will perform a SKIP before its next check, allowing you to move through a file finding successive instances of a string. + *p: lmatchcase && Case-sensitivity. + *p: lskipmemos && Whether to skip searching in memo fields. + *p: lwraparound && Whether to continue searching from beginning if end of file reached. + * + + * + BackStyle = 0 + BorderWidth = 0 + calias = ("") + cfindstring = ("") + Height = 28 + Name = "_findbutton" + Width = 69 + * + + ADD OBJECT 'cmdTableFind' AS _commandbutton WITH ; + AutoSize = .T., ; + Caption = "\ + + ADD OBJECT 'cusTableFind' AS _tablefind WITH ; + Left = 48, ; + Name = "cusTableFind", ; + Top = 0 + *< END OBJECT: ClassLib="_table.vcx" BaseClass="custom" /> + + PROCEDURE calias_access + RETURN THIS.cusTableFind.calias + + ENDPROC + + PROCEDURE calias_assign + LPARAMETERS tcNewVal + STORE tcNewVal TO THIS.cusTableFind.cAlias, THIS.cAlias + THIS.SetButtonUI() + + ENDPROC + + PROCEDURE cfindstring_access + RETURN THIS.cusTableFind.cfindstring + + ENDPROC + + PROCEDURE cfindstring_assign + LPARAMETERS tcNewVal + STORE tcNewVal TO THIS.cusTableFind.cFindString, THIS.cFindString + THIS.SetButtonUI() + + + ENDPROC + + PROCEDURE dofind && This is ordinarily the only method you need to call to do search. + LPARAMETERS tcString, tcAlias + THIS.cusTableFind.DoFind(tcString,tcAlias) + THIS.SetButtonUI() + ENDPROC + + PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + * autosize the button for the larger caption, + * then turn off the autosize + THIS.cmdTableFind.AutoSize = .T. + THIS.cmdTableFind.Caption = FIND_FINDNEXT_LOC + THIS.cmdTableFind.AutoSize = .F. + THIS.SetButtonUI() + ENDPROC + + PROCEDURE lfindagain_access + RETURN THIS.cusTableFind.lfindagain + + ENDPROC + + PROCEDURE lfindagain_assign + LPARAMETERS tlNewVal + STORE tlNewVal TO THIS.cusTableFind.lFindAgain, THIS.lFindAgain + THIS.SetButtonUI() + ENDPROC + + PROCEDURE lmatchcase_access + RETURN THIS.cusTableFind.lmatchcase + + ENDPROC + + PROCEDURE lmatchcase_assign + LPARAMETERS tlNewVal + STORE tlNewVal TO THIS.cusTableFind.lMatchCase, THIS.lMatchCase + THIS.SetButtonUI() + ENDPROC + + PROCEDURE lskipmemos_access + RETURN THIS.cusTableFind.lskipmemos + + ENDPROC + + PROCEDURE lskipmemos_assign + LPARAMETERS tlNewVal + STORE tlNewVal TO THIS.cusTableFind.lSkipMemos, THIS.lSkipMemos + THIS.SetButtonUI() + ENDPROC + + PROCEDURE lwraparound_access + RETURN THIS.cusTableFind.lwraparound + + ENDPROC + + PROCEDURE lwraparound_assign + LPARAMETERS tlNewVal + STORE tlNewVal TO THIS.cusTableFind.lWrapAround, THIS.lWrapAround + THIS.SetButtonUI() + ENDPROC + + PROCEDURE setbuttonui + THIS.cmdTableFind.Enabled = (NOT EMPTY(THIS.cAlias)) AND ; + (NOT EMPTY(THIS.cFindString)) + IF THIS.lFindAgain + THIS.cmdTableFind.Caption = FIND_FINDNEXT_LOC + ELSE + THIS.cmdTableFind.Caption = FIND_FIND_LOC + ENDIF + ENDPROC + + PROCEDURE skipfield && This method allows you to eliminate any particular field or fields from the search. + LPARAMETERS tcField + THIS.cusTableFind.SkipField(tcField) + THIS.SetButtonUI() + ENDPROC + + PROCEDURE cmdTableFind.Click + THIS.Parent.DoFind() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _finddialog AS _form OF "_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="lblFind" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="shpOptionFrame" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblOptions" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkMatchCase" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkWrapAround" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdFind" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdCancel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboFindString" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="chkSkipMemos" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lblLookIn" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cboTables" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusTableFind" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + *m: calias_access + *m: calias_assign + *m: cfindstring_access + *m: cfindstring_assign + *m: clearfindstrings + *m: dofind + *m: ladvanced_assign + *m: lfindagain_access + *m: lfindagain_assign + *m: lmatchcase_access + *m: lmatchcase_assign + *m: lskipmemos_access + *m: lskipmemos_assign + *m: lwraparound_access + *m: lwraparound_assign + *m: refreshtablechoices + *m: setfindbuttoncaption + *m: setfindbuttonenable + *m: skipfield + *p: calias && The data source to search in. + *p: cfindstring && The search string. + *p: ladvanced && Whether to display advanced options in dialog. + *p: lfindagain && This determines whether the class will perform a SKIP before its next check, allowing you to move through a file finding successive instances of a string. + *p: lmatchcase && Case-sensitivity. + *p: lskipmemos && Whether to skip searching in memo fields. + *p: lwraparound && Whether to continue searching from beginning if end of file reached. + * + + * + AlwaysOnTop = .T. + AutoCenter = .T. + BorderStyle = 0 + calias = ("") + Caption = "Find" + cfindstring = ("") + DoCreate = .T. + Height = 131 + MaxButton = .F. + MinButton = .F. + Name = "_finddialog" + ShowWindow = 1 + Visible = .F. + Width = 378 + * + + ADD OBJECT 'cboFindString' AS _combobox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 78, ; + Name = "cboFindString", ; + TabIndex = 2, ; + Top = 11, ; + Width = 216 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'cboTables' AS _combobox WITH ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 24, ; + Left = 78, ; + Name = "cboTables", ; + Style = 2, ; + TabIndex = 4, ; + Top = 48, ; + Value = (THISFORM.cAlias), ; + Width = 216 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="combobox" /> + + ADD OBJECT 'chkMatchCase' AS _checkbox WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "\ + + ADD OBJECT 'chkSkipMemos' AS _checkbox WITH ; + AutoSize = .T., ; + Caption = "\ + + ADD OBJECT 'chkWrapAround' AS _checkbox WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "\ + + ADD OBJECT 'cmdCancel' AS _commandbutton WITH ; + Cancel = .T., ; + Caption = "\ + + ADD OBJECT 'cmdFind' AS _commandbutton WITH ; + Caption = "\ + + ADD OBJECT 'cusTableFind' AS _tablefind WITH ; + Left = 324, ; + Name = "cusTableFind", ; + Top = 84 + *< END OBJECT: ClassLib="_table.vcx" BaseClass="custom" /> + + ADD OBJECT 'lblFind' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Caption = "\ + + ADD OBJECT 'lblLookIn' AS _label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + BorderStyle = 0, ; + Caption = "Look \ + + ADD OBJECT 'lblOptions' AS _label WITH ; + AutoSize = .T., ; + BorderStyle = 0, ; + Caption = "Options", ; + FontName = "MS Sans Serif", ; + FontSize = 8, ; + Height = 15, ; + Left = 15, ; + Name = "lblOptions", ; + TabIndex = 5, ; + Top = 79, ; + Width = 38 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="label" /> + + ADD OBJECT 'shpOptionFrame' AS _shape WITH ; + BackStyle = 0, ; + BorderStyle = 1, ; + BorderWidth = 1, ; + Height = 36, ; + Left = 10, ; + Name = "shpOptionFrame", ; + SpecialEffect = 0, ; + Top = 85, ; + Width = 284 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="shape" /> + + PROCEDURE Activate + IF NOT EMPTY(ALIAS()) + THIS.RefreshTableChoices() + STORE PROPER(ALIAS()) TO THIS.cboTables.Value, THIS.cboTables.DisplayValue + + ENDIF + + ENDPROC + + PROCEDURE calias_access + RETURN THIS.cusTableFind.cAlias + + ENDPROC + + PROCEDURE calias_assign + LPARAMETERS m.vNewVal + THIS.cusTableFind.cAlias = m.vNewVal + + ENDPROC + + PROCEDURE cfindstring_access + RETURN THIS.cusTableFind.cFindString + + ENDPROC + + PROCEDURE cfindstring_assign + LPARAMETERS m.vNewVal + STORE m.vNewVal TO THIS.cusTableFind.cFindString + ENDPROC + + PROCEDURE clearfindstrings + THIS.cboFindString.Clear() + STORE "" TO THIS.cboFindString.Value, ; + THIS.cboFindString.DisplayValue, ; + THIS.cusTableFind.cFindString + THIS.SetFindButtonCaption() + THIS.SetFindButtonEnable() + + ENDPROC + + PROCEDURE dofind + ENDPROC + + PROCEDURE Init + LPARAMETERS tlAdvanced + + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + IF PCOUNT() > 0 + THIS.lAdvanced = tlAdvanced + ELSE + THIS.lAdvanced = THIS.lAdvanced + * default to the value of the property, + * but still synch up the positioning + * of the objects on the form to the current state + ENDIF + + * localize strings + THIS.Caption = FIND_CAPTION_LOC + THIS.lblFind.Caption = FIND_LOOKFOR_LOC + THIS.lblOptions.Caption = FIND_OPTIONS_LOC + THIS.chkWrapAround.Caption = FIND_WRAPAROUND_LOC + THIS.chkMatchCase.Caption = FIND_MATCHCASE_LOC + THIS.chkSkipMemos.Caption = FIND_SKIPMEMOS_LOC + THIS.cmdFind.Caption = FIND_FIND_LOC + THIS.cmdCancel.Caption = FIND_CANCEL_LOC + THIS.lblLookIn.Caption = FIND_LOOKIN_LOC + + * bindings to member properties occurs + * here rather than properties window + * because of possible order conflicts (the + * custom object may be created after some + * of the members we wish to bind to its properties): + + THIS.cboFindString.ControlSource = "THISFORM.cusTableFind.cFindString" + THIS.cboTables.ControlSource = "THISFORM.cusTableFind.cAlias" + THIS.chkWrapAround.ControlSource = "THISFORM.cusTableFind.lWrapAround" + THIS.chkSkipMemos.ControlSource = "THISFORM.cusTableFind.lSkipMemos" + THIS.chkMatchCase.ControlSource = "THISFORM.cusTableFind.lMatchCase" + + IF SYSTEM_LARGEFONTS + THIS.SetAll("FontName",DIALOG_LARGEFONT_NAME) + ENDIF + + + + ENDPROC + + PROCEDURE ladvanced_assign + LPARAMETERS m.vNewVal + + LOCAL lnMargin + lnMargin = THIS.cmdFind.Top + + THIS.lAdvanced = m.vNewVal + + + STORE THIS.lAdvanced TO ; + THIS.cboTables.Visible, THIS.cboTables.Enabled, ; + THIS.lblLookIn.Visible, THIS.lblLookIn.Enabled + + IF THIS.lAdvanced + + THIS.lblOptions.Top = THIS.cboTables.Top + THIS.cboTables.Height + lnMargin + + ELSE + + THIS.lblOptions.Top = THIS.cboTables.Top + + ENDIF + + THIS.shpOptionFrame.Top = THIS.lblOptions.Top + THIS.lblOptions.Height/2 + + THIS.SetAll("Top", ; + THIS.shpOptionFrame.Top + ; + ((THIS.shpOptionFrame.Height/2)-(THIS.chkMatchCase.Height/2)), ; + "_checkbox") + + THIS.Height=THIS.shpOptionFrame.Top+THIS.shpOptionFrame.Height+lnMargin + + + ENDPROC + + PROCEDURE lfindagain_access + RETURN THIS.cusTableFind.lFindAgain + + ENDPROC + + PROCEDURE lfindagain_assign + LPARAMETERS m.vNewVal + THIS.cusTableFind.lFindAgain = m.vNewVal + + ENDPROC + + PROCEDURE lmatchcase_access + RETURN THIS.cusTableFind.lMatchCase + + ENDPROC + + PROCEDURE lmatchcase_assign + LPARAMETERS m.vNewVal + THIS.cusTableFind.lMatchCase = m.vNewVal + + ENDPROC + + PROCEDURE lskipmemos_access + RETURN THIS.cusTableFind.lSkipMemos + + ENDPROC + + PROCEDURE lskipmemos_assign + LPARAMETERS m.vNewVal + THIS.cusTableFind.lSkipMemos = m.vNewVal + + ENDPROC + + PROCEDURE lwraparound_access + RETURN THIS.cusTableFind.lWrapAround + + ENDPROC + + PROCEDURE lwraparound_assign + LPARAMETERS m.vNewVal + THIS.cusTableFind.lWrapAround = m.vNewVal + + ENDPROC + + PROCEDURE refreshtablechoices + IF THIS.lAdvanced + THIS.cboTables.Refresh(.T.) + ENDIF + ENDPROC + + PROCEDURE setfindbuttoncaption + IF THIS.cusTableFind.lFindAgain + THIS.cmdFind.Caption = FIND_FINDNEXT_LOC + ELSE + THIS.cmdFind.Caption = FIND_FIND_LOC + ENDIF + ENDPROC + + PROCEDURE setfindbuttonenable + THIS.cmdFind.Enabled = (NOT EMPTY(THIS.cusTableFind.cAlias)) AND ; + (NOT EMPTY(THIS.cboFindString.DisplayValue)) + + + ENDPROC + + PROCEDURE Show + LPARAMETERS nStyle + THIS.RefreshTableChoices() + DO CASE + CASE EMPTY(THIS.cusTableFind.cAlias) + THIS.cusTableFind.cAlias = THIS.cusTableFind.GetCurrentAlias() + CASE NOT USED(THIS.cusTableFind.cAlias) + THIS.cusTableFind.cAlias = "" + OTHERWISE + * leave it alone + ENDCASE + THIS.SetFindButtonCaption() + THIS.SetFindButtonEnable() + IF NOT THIS.cmdFind.Enabled + IF EMPTY(THIS.cFindString) + KEYBOARD SPACE(1)+"{HOME}" + ELSE + KEYBOARD THIS.cFindString + ENDIF + ENDIF + + + + ENDPROC + + PROCEDURE skipfield + LPARAMETERS tcField + THIS.cusTableFind.SkipField(tcField) + ENDPROC + + PROCEDURE cboFindString.InteractiveChange + THISFORM.SetFindButtonEnable() + + + ENDPROC + + PROCEDURE cboFindString.Valid + WITH THIS + IF NOT EMPTY(.DisplayValue) + LOCAL liItem, llFound + FOR liItem = 1 TO .ListCount + IF .List(liItem) == .DisplayValue + llFound = .T. + EXIT + ENDIF + ENDFOR + IF NOT llFound + .AddItem(.DisplayValue,1) + ENDIF + ENDIF + .Value = .DisplayValue + ENDWITH + + + ENDPROC + + PROCEDURE cboTables.Refresh + LPARAMETERS tlForceRefresh + IF THISFORM.lAdvanced + IF tlForceRefresh + THIS.Clear + LOCAL aAliases[1,2], liAlias, liAliasCount + liAliasCount = AUSED(aAliases) + FOR liAlias = 1 TO liAliasCount + THIS.AddItem(PROPER(aAliases[liAlias,1])) + ENDFOR + THIS.AddItem(SPACE(8)) + ENDIF + ENDIF + + ENDPROC + + PROCEDURE cmdCancel.Click + THISFORM.Release() + + ENDPROC + + PROCEDURE cmdFind.Click + THISFORM.cusTableFind.DoFind() + + ENDPROC + + PROCEDURE cusTableFind.calias_assign + LPARAMETERS tcAlias + DODEFAULT(tcAlias) + + LOCAL liAlias, llFound, llEmpty + + IF EMPTY(THIS.cAlias) + THISFORM.Caption = FIND_CAPTION_LOC + llEmpty = .T. + ELSE + THISFORM.Caption = FIND_FINDIN_LOC+" "+ PROPER(THIS.cAlias) + ENDIF + + THISFORM.SetFindButtonEnable() + THISFORM.SetFindButtonCaption() + + IF THISFORM.lAdvanced + IF NOT llEmpty + FOR liAlias = 1 TO THISFORM.cboTables.ListCount + llFound = (THIS.cAlias == THISFORM.cboTables.List(liAlias)) + IF llFound + EXIT + ENDIF + ENDFOR + ENDIF + IF NOT (llFound OR llEmpty) + THISFORM.cboTables.AddItem(THIS.cAlias) + ENDIF + + STORE THIS.cAlias TO THISFORM.cboTables.Value, ; + THISFORM.cboTables.DisplayValue + THISFORM.cboTables.Refresh() + + ENDIF + ENDPROC + + PROCEDURE cusTableFind.cfindstring_assign + LPARAMETERS tcString + DODEFAULT(tcString) + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + + PROCEDURE cusTableFind.dofind + LPARAMETERS tcString, tcAlias + + IF DODEFAULT(tcString, tcAlias) + THISFORM.cusTableFind.RefreshLastWindowAfterChange() + ENDIF + + THISFORM.SetFindButtonEnable() + THISFORM.SetFindButtonCaption() + + RETURN + + *!* * the commented version below can + *!* * replace the above if "multiple find" + *!* * is inadvisable on a modal dialog, + *!* * for any reason, + *!* * but it seems to be okay + + *!* IF DODEFAULT(tcString, tcAlias) + *!* THISFORM.cusTableFind.RefreshLastWindowAfterChange() + *!* IF THISFORM.WindowType = 1 + *!* THISFORM.Release() + *!* ENDIF + *!* ELSE + *!* IF THISFORM.WindowType = 1 + *!* THISFORM.Release() + *!* ELSE + *!* THISFORM.SetFindButtonEnable() + *!* THISFORM.SetFindButtonCaption() + *!* ENDIF + *!* ENDIF + + ENDPROC + + PROCEDURE cusTableFind.lfindagain_assign + LPARAMETERS tlVal + DODEFAULT(tlVal) + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + + PROCEDURE cusTableFind.lmatchcase_assign + LPARAMETERS tlVal + DODEFAULT(tlVal) + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + + PROCEDURE cusTableFind.lskipmemos_assign + LPARAMETERS tlVal + DODEFAULT(tlVal) + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + + PROCEDURE cusTableFind.lwraparound_assign + LPARAMETERS tlVal + DODEFAULT(tlVal) + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + + PROCEDURE cusTableFind.setfields + DODEFAULT() + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + + PROCEDURE cusTableFind.skipfield + LPARAMETERS tcField + DODEFAULT(tcField) + THISFORM.SetFindButtonCaption() + THISFORM.SetFindButtonEnable() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _findnextbuttons AS _findbutton OF "_table.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdTableFindNext" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + calias = ("") + Height = 30 + Name = "_findnextbuttons" + Width = 134 + cmdTableFind.AutoSize = .F. + cmdTableFind.Name = "cmdTableFind" + cusTableFind.Left = 48 + cusTableFind.Name = "cusTableFind" + cusTableFind.Top = 0 + * + + ADD OBJECT 'cmdTableFindNext' AS _commandbutton WITH ; + AutoSize = .T., ; + Caption = "Find \ + + PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + THIS.cmdTableFind.Caption = FIND_FIND_LOC + THIS.cmdTableFindNext.Caption = FIND_FINDNEXT_LOC + THIS.cmdTableFind.Width = THIS.cmdTableFindNext.Width + THIS.cmdTableFindNext.Left = THIS.cmdTableFind.Width+2 + THIS.Width = THIS.cmdTableFind.Width*2+2 + + ENDPROC + + PROCEDURE setbuttonui + * override, so that the captions won't be re-set + THIS.cmdTableFind.Enabled = (NOT EMPTY(THIS.cAlias)) AND ; + (NOT EMPTY(THIS.cFindString)) + + THIS.cmdTableFindNext.Enabled = THIS.cmdTableFind.Enabled AND ; + THIS.lFindAgain + + ENDPROC + + PROCEDURE cmdTableFind.Click + THIS.Parent.lFindAgain = .F. + DODEFAULT() + ENDPROC + + PROCEDURE cmdTableFindNext.Click + THIS.Parent.DoFind() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _gotodialog AS _form OF "_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="cusTableNav" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="spnGoTo" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdOK" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + *m: refreshuiafterchange + * + + * + AutoCenter = .T. + BorderStyle = 0 + Caption = "Go To Record" + DoCreate = .T. + Height = 81 + KeyPreview = .T. + MaxButton = .F. + MinButton = .F. + Name = "_gotodialog" + ShowWindow = 1 + Width = 164 + WindowType = 1 + * + + ADD OBJECT 'cmdOK' AS _commandbutton WITH ; + AutoSize = .T., ; + Caption = "\ + + ADD OBJECT 'cusTableNav' AS _tablenav WITH ; + Left = 12, ; + Name = "cusTableNav", ; + Top = 0 + *< END OBJECT: ClassLib="_table.vcx" BaseClass="custom" /> + + ADD OBJECT 'spnGoTo' AS _spinner WITH ; + FontName = "MS Sans Serif", ; + Format = "", ; + Increment = 1.00, ; + InputMask = "9999999999999999999", ; + Left = 22, ; + Name = "spnGoTo", ; + Top = 12 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="spinner" /> + + PROCEDURE Init + LOCAL llReturn, loControl + + llReturn = DODEFAULT() + IF llReturn + IF EMPTY(THIS.cusTableNav.cAlias) OR RECCOUNT(THIS.cusTableNav.cAlias) < 2 + llReturn = .F. + ELSE + WITH THIS.spnGoTo + STORE 1 TO .SpinnerLowValue, .KeyBoardLowValue + STORE RECCOUNT(THIS.cusTableNav.cAlias) TO ; + .SpinnerHighValue, .KeyBoardHighValue + .Value = RECNO(THIS.cusTableNav.cAlias) + .Value = MIN(.Value,.SpinnerHighValue) && EOF() + ENDWITH + ENDIF + + IF SYSTEM_LARGEFONTS + LOCAL lcStandardFont + lcStandardFont = UPPER(DIALOG_SMALLFONT_NAME) + + FOR EACH loControl IN THIS.Controls + IF PEMSTATUS(loControl,"FontName",5) AND ; + UPPER(loControl.FontName) == lcStandardFont + + loControl.FontName = DIALOG_LARGEFONT_NAME + ENDIF + ENDFOR + * Note: no recursion here. + + ENDIF + + ENDIF + + RETURN llReturn + + ENDPROC + + PROCEDURE KeyPress + LPARAMETERS nKeyCode, nShiftAltCtrl + IF nKeyCode = 27 + THIS.Release() + ENDIF + ENDPROC + + PROCEDURE refreshuiafterchange + ENDPROC + + PROCEDURE cmdOK.Click + + THISFORM.cusTableNav.GoToRecord(THISFORM.spnGoTo.Value) + * we may not have moved but we may have reverted data + * so we have to refresh whether the pointer has + * moved or not + + THISFORM.cusTableNav.RefreshLastWindowAfterChange() + + THISFORM.Release() + + ENDPROC + + PROCEDURE cusTableNav.Init + LOCAL llReturn + llReturn = DODEFAULT() + IF llReturn + THIS.cAlias = THIS.GetCurrentAlias() + ENDIF + RETURN llReturn + ENDPROC + +ENDDEFINE + +DEFINE CLASS _nav2buttons AS _container OF "_base.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmgNav" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cusTableNav" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + *m: lcycle_access + *m: lcycle_assign + *m: tablenav && Handles record navigation. + *p: lcycle && Controls movement when record pointer hits end or beginning of file. + * + + * + BackStyle = 0 + BorderWidth = 0 + Height = 38 + Name = "_nav2buttons" + Width = 78 + * + + ADD OBJECT 'cmgNav' AS _commandgroup WITH ; + BorderStyle = 1, ; + Height = 37, ; + Left = 8, ; + Name = "cmgNav", ; + Top = 1, ; + Width = 64, ; + ZOrderSet = 0, ; + Command1.AutoSize = .T., ; + Command1.Caption = "<", ; + Command1.FontBold = .T., ; + Command1.Left = 5, ; + Command1.Name = "Command1", ; + Command1.Top = 5, ; + Command2.AutoSize = .T., ; + Command2.Caption = ">", ; + Command2.FontBold = .T., ; + Command2.Height = 27, ; + Command2.Left = 32, ; + Command2.Name = "Command2", ; + Command2.Top = 5, ; + Command2.Width = 27 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandgroup" /> + + ADD OBJECT 'cusTableNav' AS _tablenav WITH ; + Left = 0, ; + Name = "cusTableNav", ; + Top = 0 + *< END OBJECT: ClassLib="_table.vcx" BaseClass="custom" /> + + PROCEDURE lcycle_access + RETURN THIS.cusTableNav.lCycle + + ENDPROC + + PROCEDURE lcycle_assign + LPARAMETERS m.vNewVal + THIS.cusTableNav.lCycle= m.vNewVal + + ENDPROC + + PROCEDURE tablenav && Handles record navigation. + LPARAMETERS tcAction + IF EMPTY(tcAction) OR VARTYPE(tcAction) # "C" + RETURN + ENDIF + + DO CASE + CASE UPPER(tcAction) = "NEXT" + THIS.cusTableNav.GoNext() + CASE UPPER(tcAction) = "PREVIOUS" + THIS.cusTableNav.GoPrevious() + OTHERWISE + *whoops! + ENDCASE + ENDPROC + + PROCEDURE cmgNav.Command1.Click + THIS.Parent.Parent.TableNav("PREVIOUS") + ENDPROC + + PROCEDURE cmgNav.Command2.Click + THIS.Parent.Parent.TableNav("NEXT") + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _nav4buttons AS _nav2buttons OF "_table.vcx" + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdTop" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdBottom" UniqueID="" Timestamp="" /> + + #INCLUDE "_table.h" + * + Height = 37 + Name = "_nav4buttons" + Width = 133 + cmgNav.Command1.Left = 33 + cmgNav.Command1.Name = "Command1" + cmgNav.Command1.TabIndex = 1 + cmgNav.Command1.Top = 5 + cmgNav.Command2.Left = 60 + cmgNav.Command2.Name = "Command2" + cmgNav.Command2.TabIndex = 2 + cmgNav.Command2.Top = 5 + cmgNav.Height = 36 + cmgNav.Left = 8 + cmgNav.Name = "cmgNav" + cmgNav.TabIndex = 2 + cmgNav.Width = 122 + cusTableNav.Name = "cusTableNav" + * + + ADD OBJECT 'cmdBottom' AS _commandbutton WITH ; + AutoSize = .T., ; + Caption = ">|", ; + FontBold = .T., ; + Height = 27, ; + Left = 96, ; + Name = "cmdBottom", ; + TabIndex = 3, ; + Top = 6, ; + Width = 30 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'cmdTop' AS _commandbutton WITH ; + AutoSize = .T., ; + Caption = "|<", ; + FontBold = .T., ; + Height = 27, ; + Left = 11, ; + Name = "cmdTop", ; + TabIndex = 1, ; + Top = 6, ; + Width = 30 + *< END OBJECT: ClassLib="_base.vcx" BaseClass="commandbutton" /> + + PROCEDURE tablenav && Handles record navigation. + LPARAMETERS tcAction + IF EMPTY(tcAction) OR VARTYPE(tcAction) # "C" + RETURN + ENDIF + DODEFAULT(tcAction) + DO CASE + CASE UPPER(tcAction) = "TOP" + THIS.cusTableNav.GoTop() + CASE UPPER(tcAction) = "BOTTOM" + THIS.cusTableNav.GoBottom() + OTHERWISE + * ?? + ENDCASE + ENDPROC + + PROCEDURE cmdBottom.Click + THIS.Parent.TableNav("BOTTOM") + ENDPROC + + PROCEDURE cmdTop.Click + THIS.Parent.TableNav("TOP") + ENDPROC + +ENDDEFINE + +DEFINE CLASS _table AS _custom OF "_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_table.h" + * + *m: currentrowbufferedandchanged && Determines whether there is a change in the current control without actually doing a flush. + *m: currenttableallowsnavigation && Evaluates whether the user needs to be presented with choices before leaving the current row. + *m: currenttableallowsordering && Returns .F. if the current alias is a child of a relationship or if the current control is a grid that uses the Linkmaster/ChildOrder/RelationalExpr properties. + *m: dotargetofrelationmessage && Abstract method. + *m: flushcurrentcontrol && Flushes data when the user confirms a desire to do an update. + *m: getcurrentalias && If the current value of the cAlias property is a currently-USED() table, this method RETURNs THIS.cAlias. + *m: getcurrentboundfield && Returns an aliased field in an existing table or, if there is no current bound field, it returns an empty string. + *m: getcurrentcontrol && Returns current control or NULL if there is no ActiveControl at the moment. + *m: refreshlastwindowafterchange && This is similar to RefreshUIAfterChange method, but it is designed especially for use by modal dialogs that may be affecting tables bound to them. + *m: refreshuiafterchange && Looks for an _SCREEN.ActiveForm.Parent (formset) or, failing that, simply a _SCREEN.ActiveForm to refresh. + *m: settoactivesession && Looks for a _SCREEN.ActiveForm or _SCREEN.ActiveForm.Parent (formset) from which to derive an active DataSessionID, and SETs DATASESSION TO that session. + *p: calias && Alias of data source. + * + + * + calias = ("") + Name = "_table" + * + + PROCEDURE currentrowbufferedandchanged && Determines whether there is a change in the current control without actually doing a flush. + LPARAMETERS tcAlias + ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) + + LOCAL lcAlias, llReturn, loCurrentControl, lcCurrentField + IF EMPTY(tcAlias) + lcAlias = THIS.GetCurrentAlias() + ELSE + lcAlias = tcAlias + ENDIF + + IF (NOT EMPTY(lcAlias)) AND ; + (EMPTY(RECCOUNT(lcAlias))) + lcAlias = "" + ENDIF + + + IF (NOT EMPTY(lcAlias)) AND ; + INLIST(CURSORGETPROP("BUFFERING",lcAlias), ; + DB_BUFLOCKRECORD, ; + DB_BUFOPTRECORD) + + lcCurrentField = THIS.GetCurrentBoundField() + * return of GetCurrentBoundField() will always be aliased + + IF NOT EMPTY(lcCurrentField) + IF UPPER(LEFT(lcCurrentField,LEN(lcAlias)+1)) == ; + UPPER(lcAlias)+"." + * check to see if we would need to flush the current control + * to actually see a change: + loCurrentControl = THIS.GetCurrentControl() + IF (NOT ISNULL(loCurrentControl)) AND ; + PEMSTATUS(loCurrentControl,"Value",5) AND ; + (NOT EVAL(lcCurrentField) == loCurrentControl.Value) + * we definitely have a change + llReturn = .T. + ENDIF + ENDIF + ENDIF + + IF NOT llReturn && yet + + llReturn = (GETFLDSTATE(-1,lcAlias) # ; + REPL("1",FCOUNT(lcAlias)+1)) + ENDIF + + ENDIF + + RETURN llReturn + + + ENDPROC + + PROCEDURE currenttableallowsnavigation && Evaluates whether the user needs to be presented with choices before leaving the current row. + LPARAMETERS tcAlias + + ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) + + LOCAL lcAlias, liReturn + + IF (NOT EMPTY(tcAlias)) AND USED(tcAlias) + lcAlias = tcAlias + ELSE + lcAlias = THIS.GetCurrentAlias() + ENDIF + + IF (NOT EMPTY(lcAlias)) AND ; + (EMPTY(RECCOUNT(lcAlias))) + lcAlias = "" + ENDIF + + IF (NOT EMPTY(lcAlias)) AND ; + THIS.CurrentRowBufferedAndChanged(lcAlias) + + IF INLIST(_VFP.Startmode,0,4) + + liReturn = MESSAGEBOX(TABLE_MESSAGE_ROW_CHANGED_LOC,; + MB_ICONEXCLAMATION+MB_YESNOCANCEL, ; + TABLE_MESSAGE_TITLE_ROW_CHANGED_LOC) + ELSE + lcAlias = "" + ENDIF + + DO CASE + CASE EMPTY(lcAlias) + * we're in a server + * and we shouldn't be moving + * the record pointer here; + * should make the determination + * to revert or update somewhere else! + CASE liReturn = IDYES + THIS.FlushCurrentControl() + IF NOT TABLEUPDATE(0,.T.,lcAlias) + lcAlias = "" + ENDIF + CASE liReturn = IDNO + =TABLEREVERT(.F.,lcAlias) + OTHERWISE && cancel + lcAlias = "" + ENDCASE + + ENDIF + + RETURN (NOT EMPTY(lcAlias)) + + ENDPROC + + PROCEDURE currenttableallowsordering && Returns .F. if the current alias is a child of a relationship or if the current control is a grid that uses the Linkmaster/ChildOrder/RelationalExpr properties. + LPARAMETERS tcAlias + + ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) + + LOCAL lcAlias, llReturn, loCurrentControl, ; + loCurrentGrid, liIndex, liTables, liTarget, lcTarget + + LOCAL ARRAY laTables[1,2] + + IF (NOT EMPTY(tcAlias)) AND USED(tcAlias) + lcAlias = tcAlias + ELSE + lcAlias = THIS.GetCurrentAlias() + ENDIF + + + IF (NOT EMPTY(lcAlias)) + + lcAlias = UPPER(lcAlias) + + llReturn = .T. + + * check for grid in a child relation + + loCurrentControl = THIS.GetCurrentControl() + + DO WHILE TYPE("loCurrentControl.Parent.Baseclass") = "C" + + loCurrentControl = loCurrentControl.Parent + + IF UPPER(loCurrentControl.Baseclass) == "GRID" + loCurrentGrid = loCurrentControl + EXIT + ENDIF + + ENDDO + + IF TYPE("loCurrentGrid.Name") = "C" AND ; + (NOT EMPTY(loCurrentGrid.LinkMaster+; + loCurrentGrid.ChildOrder+; + loCurrentGrid.RelationalExpr)) + + llReturn = .F. + + ENDIF + + ENDIF + + IF llReturn + + * check for a relational expression even though + * this isn't a grid + + liTables = AUSED(laTables) + + FOR liIndex = 1 TO liTables + + liTarget = 1 + lcTarget = UPPER(TARGET(1,laTables[liIndex,1])) + DO WHILE NOT EMPTY(lcTarget) + IF lcAlias == lcTarget + llReturn = .F. + EXIT + ELSE + liTarget = liTarget + 1 + lcTarget = UPPER(TARGET(liTarget,laTables[liIndex,1])) + ENDIF + ENDDO + IF NOT llReturn + EXIT + ENDIF + + ENDFOR + + ENDIF + + IF NOT llReturn + THIS.DoTargetOfRelationMessage(lcAlias) + ENDIF + + RETURN llReturn + + + ENDPROC + + PROCEDURE dotargetofrelationmessage && Abstract method. + LPARAMETERS tcAlias + IF EMPTY(tcAlias) + RETURN + ENDIF + ENDPROC + + PROCEDURE flushcurrentcontrol && Flushes data when the user confirms a desire to do an update. + LPARAMETERS tcAlias + ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" AND USED(tcAlias) + + LOCAL lcAlias, llReturn, loCurrentControl, lcCurrentField + IF EMPTY(tcAlias) + lcAlias = THIS.GetCurrentAlias() + ELSE + lcAlias = tcAlias + ENDIF + + IF (NOT EMPTY(lcAlias)) AND ; + (EMPTY(RECCOUNT(lcAlias))) + lcAlias = "" + ENDIF + + + IF (NOT EMPTY(lcAlias)) AND ; + INLIST(CURSORGETPROP("BUFFERING",lcAlias), ; + DB_BUFLOCKRECORD, ; + DB_BUFOPTRECORD) + + lcCurrentField = THIS.GetCurrentBoundField() + * return of GetCurrentBoundField() will always be aliased + + IF NOT EMPTY(lcCurrentField) + IF UPPER(LEFT(lcCurrentField,LEN(lcAlias)+1)) == ; + UPPER(lcAlias)+"." + loCurrentControl = THIS.GetCurrentControl() + IF (NOT ISNULL(loCurrentControl)) AND ; + PEMSTATUS(loCurrentControl,"Value",5) + loCurrentControl.Value = loCurrentControl.Value + llReturn = .T. + ENDIF + ENDIF + ENDIF + + ENDIF + + RETURN llReturn + + + ENDPROC + + PROCEDURE getcurrentalias && If the current value of the cAlias property is a currently-USED() table, this method RETURNs THIS.cAlias. + LOCAL lcAlias + + IF EMPTY(THIS.cAlias) OR NOT USED(THIS.cAlias) + + THIS.SetToActiveSession() + + lcAlias = ALIAS() + + ELSE + + lcAlias = THIS.cAlias + + ENDIF + + RETURN lcAlias + + ENDPROC + + PROCEDURE getcurrentboundfield && Returns an aliased field in an existing table or, if there is no current bound field, it returns an empty string. + * this will always return an aliased field in an existing + * table or it will return an empty string. + + LOCAL lcFieldName, loCurrentControl, iPos, lcAlias + + loCurrentControl = THIS.GetCurrentControl() + + IF ISNULL(loCurrentControl) OR (TYPE("loCurrentControl.ControlSource") # "C") + IF NOT EMPTY(VARREAD()) + * could be a browse... + RETURN UPPER(ALIAS()+"."+VARREAD()) + ELSE + RETURN "" + ENDIF + ELSE + lcFieldName = UPPER(loCurrentControl.ControlSource) + ENDIF + + * is this a bound field we can find in the current list of tables? + + + THIS.SetToActiveSession() + + iPos = AT(".",lcFieldName) + lcAlias = ALIAS() + + DO CASE + + CASE OCCURS(".",lcFieldName) > 1 AND ; + VARTYPE(lcFieldName) = "O" + + * we can't use a member object, + * we're looking for a table attribute/column + lcFieldName = "" + + CASE iPos <= 1 AND EMPTY(lcAlias) + lcFieldName = "" + + CASE iPos = 0 + iPos = LEN(lcAlias)+ 1 + lcFieldName = lcAlias+"."+lcFieldName + + CASE iPos = 1 + iPos = LEN(lcAlias)+ 1 + lcFieldName = lcAlias+lcFieldName + + CASE iPos = 2 AND LEFT(lcFieldName,1) = "M" + * we can't use a memvar + lcFieldName = "" + + OTHERWISE + * we may have an aliased field + * or we may have a property -- + * which is it?? + + IF NOT USED(SUBSTR(lcAlias,1,iPos-1)) + lcFieldName = "" + ENDIF + + ENDCASE + + * okay, now do we have something usable? + IF NOT EMPTY(lcFieldName) + IF TYPE(lcFieldName) = "U" + lcFieldName = "" + ENDIF + ENDIF + + RETURN lcFieldName + + + + + ENDPROC + + PROCEDURE getcurrentcontrol && Returns current control or NULL if there is no ActiveControl at the moment. + LOCAL loRealActiveControl, liThisColumn, loActiveControl, loColumn + + loRealActiveControl = NULL + + IF TYPE("_SCREEN.ActiveForm.ActiveControl.BaseClass")= "C" + + loActiveControl = _SCREEN.ActiveForm.ActiveControl + + IF UPPER(loActiveControl.BaseClass) == "GRID" + + liThisColumn = loActivecontrol.ActiveColumn + + FOR EACH loColumn IN loActiveControl.Columns + + IF loColumn.ColumnOrder = liThisColumn + + IF TYPE("loColumn.CurrentControl") = "C" + + loRealActiveControl = ; + EVAL("loColumn."+loColumn.CurrentControl) + + ELSE + + loRealActiveControl = loColumn + + ENDIF + + EXIT + + ENDIF + + ENDFOR + + ELSE + + loRealActiveControl = loActiveControl + + ENDIF + + ENDIF + + RETURN loRealActiveControl + + ENDPROC + + PROCEDURE refreshlastwindowafterchange && This is similar to RefreshUIAfterChange method, but it is designed especially for use by modal dialogs that may be affecting tables bound to them. + LOCAL loForm, liForms, liThisForm, loThisForm + liForms = _SCREEN.FormCount + IF TYPE("THISFORM") = "O" + loThisForm = THISFORM + ELSE + loThisForm = .NULL. + ENDIF + + DO CASE + CASE liForms > 1 + * find the next one down in the stack, not counting toobars + FOR liThisForm = 2 TO liForms + loForm = _SCREEN.Forms(liThisForm) + IF (NOT ISNULL(loThisForm)) AND loForm = loThisForm + LOOP + ENDIF + IF UPPER(loForm.BaseClass) == "FORM" + IF TYPE("loForm.Parent") = "O" + loForm.Parent.Refresh() + ELSE + loForm.Refresh() + ENDIF + EXIT + ENDIF + ENDFOR + CASE _SCREEN.Visible + _SCREEN.Refresh() + OTHERWISE + * Not much we can do... + ENDCASE + + + ENDPROC + + PROCEDURE refreshuiafterchange && Looks for an _SCREEN.ActiveForm.Parent (formset) or, failing that, simply a _SCREEN.ActiveForm to refresh. + DO CASE + CASE TYPE("_SCREEN.ActiveForm.Parent") = "O" + _SCREEN.ActiveForm.Parent.Refresh() + CASE TYPE("_SCREEN.ActiveForm") = "O" + _SCREEN.ActiveForm.Refresh() + OTHERWISE + IF NOT EMPTY(WONTOP()) + SHOW WINDOW (WONTOP()) REFRESH + ENDIF + ENDCASE + ENDPROC + + PROCEDURE settoactivesession && Looks for a _SCREEN.ActiveForm or _SCREEN.ActiveForm.Parent (formset) from which to derive an active DataSessionID, and SETs DATASESSION TO that session. + LOCAL liSession + liSession = SET("DATASESSION") + + * we may be calling from the menu or a toolbar: + DO CASE + + CASE TYPE("_SCREEN.ActiveForm.DatasessionID") = "N" AND ; + liSession # _SCREEN.ActiveForm.DatasessionID + + SET DATASESSION TO (_SCREEN.ActiveForm.DatasessionID) + + CASE TYPE("_SCREEN.ActiveForm.Parent.DatasessionID") = "N" AND ; + liSession # _SCREEN.ActiveForm.Parent.DatasessionID + + SET DATASESSION TO (_SCREEN.ActiveForm.Parent.DatasessionID) + + OTHERWISE + + * we're in the right datasession already + + ENDCASE + ENDPROC + +ENDDEFINE + +DEFINE CLASS _tablefind AS _table OF "_table.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_table.h" + * + *m: calias_assign + *m: ccontrolcharacter_assign + *m: cfindstring_assign + *m: dofind && This is ordinarily the only method you need to call to do search. + *m: lfindagain_assign + *m: lmatchcase_assign + *m: lskipmemos_assign + *m: lwraparound_assign + *m: setfields + *m: showmessagenotfound + *m: skipfield && This method allows you to eliminate any particular field or fields from the search. + *p: ccontrolcharacter + *p: cfields && List of fields to search. + *p: cfindstring && The string to search for. Defaults to a null string. + *p: imemos + *p: lfindagain && This determines whether the class will perform a SKIP before its next check, allowing you to move through a file finding successive instances of a string. + *p: lmatchcase && Case-sensitivity. + *p: lskipmemos && Whether to skip searching of memos. + *p: lwraparound && Whether to continue searching from beginning if end of file reached. + *a: amemos[1,0] + * + + * + calias = ("") + ccontrolcharacter = ("~") + cfields = ("") + cfindstring = ("") + imemos = 0 + Name = "_tablefind" + * + + PROCEDURE calias_assign + LPARAMETERS tcNewVal + DO CASE + CASE VARTYPE(tcNewVal) # "C" OR NOT USED(tcNewVal) + THIS.cAlias = "" + THIS.cFields = "" + THIS.lFindAgain = .F. + CASE THIS.cAlias == PROPER(tcNewVal) + * do nothing + OTHERWISE + THIS.cAlias = PROPER(tcNewVal) + THIS.SetFields() + THIS.lFindAgain = .F. + ENDCASE + + + ENDPROC + + PROCEDURE ccontrolcharacter_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" OR EMPTY(tcNewVal) + THIS.cControlCharacter = "~" + ELSE + + IF LEFTC(tcNewVal,1) == THIS.cControlCharacter + * do nothing + ELSE + * one character only + THIS.cControlCharacter = LEFTC(tcNewVal,1) + THIS.SetFields() + ENDIF + ENDIF + + ENDPROC + + PROCEDURE cfindstring_assign + LPARAMETERS tcNewVal + IF VARTYPE(tcNewVal) # "C" + RETURN .F. + ENDIF + IF RTRIM(tcNewVal) == THIS.cFindString + * do nothing + ELSE + STORE RTRIM(tcNewVal) TO THIS.cFindString + THIS.lFindAgain = .F. + ENDIF + + ENDPROC + + PROCEDURE dofind && This is ordinarily the only method you need to call to do search. + LPARAMETERS tcFindString, tcAlias + + ASSERT EMPTY(tcFindString) OR VARTYPE(tcFindString) = "C" + ASSERT EMPTY(tcAlias) OR VARTYPE(tcAlias) = "C" + + LOCAL llSuccess + + llSuccess = .T. + + IF NOT EMPTY(tcFindString) + THIS.cFindString = tcFindString + ENDIF + + IF EMPTY(THIS.cFindString) + llSuccess = .F. + ENDIF + + IF NOT EMPTY(tcAlias) + THIS.cAlias = tcAlias + ENDIF + IF EMPTY(THIS.cAlias) + THIS.cAlias = THIS.GetCurrentAlias() + ENDIF + IF NOT USED(THIS.cAlias) + THIS.cAlias = "" + ENDIF + IF EMPTY(THIS.cAlias) + llSuccess = .F. + ENDIF + + IF llSuccess + llSuccess = THIS.CurrentTableAllowsNavigation(THIS.cAlias) + ENDIF + + IF llSuccess + + * now do the real work + + LOCAL liRecno, liSelect + liSelect = SELECT() + SELECT (THIS.cAlias) + liRecno = RECNO() + + IF THIS.lFindAgain + IF NOT EOF() + SKIP + ELSE + LOCATE + ENDIF + ENDIF + + IF THIS.lMatchCase + LOCATE REST FOR AT_C(THIS.cFindString,EVAL(THIS.cFields)) > 0 + ELSE + LOCATE REST FOR ATCC(THIS.cFindString,EVAL(THIS.cfields)) > 0 + ENDIF + IF EOF() AND THIS.lWrapAround + IF THIS.lMatchCase + LOCATE FOR AT_C(THIS.cFindString,EVAL(THIS.cFields)) > 0 + ELSE + LOCATE FOR ATCC(THIS.cFindString,EVAL(THIS.cFields)) > 0 + ENDIF + ENDIF + IF EOF() + THIS.ShowMessageNotFound() + GO liRecno + llSuccess = .F. + ENDIF + SELECT (liSelect) + + ENDIF + + THIS.lFindAgain = llSuccess + + RETURN llSuccess + + + ENDPROC + + PROCEDURE lfindagain_assign + LPARAMETERS tlNewVal + THIS.lFindAgain = tlNewVal + ENDPROC + + PROCEDURE lmatchcase_assign + LPARAMETERS tlNewVal + IF THIS.lMatchCase = tlNewVal + * do nothing + ELSE + THIS.lMatchCase = tlNewVal + THIS.lFindAgain = .F. + ENDIF + ENDPROC + + PROCEDURE lskipmemos_assign + LPARAMETERS tlNewVal + IF tlNewVal = THIS.lSkipMemos + * do nothing + ELSE + THIS.lFindAgain = .F. + THIS.lSkipMemos = tlNewVal + THIS.SetFields() + ENDIF + ENDPROC + + PROCEDURE lwraparound_assign + LPARAMETERS m.vNewVal + THIS.lWrapAround = m.vNewVal + + ENDPROC + + PROCEDURE setfields + IF VARTYPE(THIS.cAlias) # "C" OR NOT USED(THIS.cAlias) + THIS.cFields = "" + RETURN + ENDIF + + LOCAL liIndex, lcThisField, lcThisFieldType + + THIS.iMemos = 0 + THIS.cFields = "["+THIS.cControlCharacter+"]" + DIME THIS.aMemos[1] + THIS.aMemos[1] = .F. + + FOR liIndex = 1 TO FCOUNT(THIS.cAlias) + lcThisField = FIELD(liIndex,THIS.cAlias) + lcThisFieldType = TYPE(THIS.cAlias+"."+lcThisField) + DO CASE + CASE lcThisFieldType = "M" AND NOT THIS.lSkipMemos + THIS.iMemos = THIS.iMemos + 1 + DIME THIS.aMemos(THIS.iMemos) + THIS.aMemos(THIS.iMemos) = lcThisField + THIS.cFields = THIS.cFields+"+"+lcThisField+"+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "C" + THIS.cFields = THIS.cFields+"+"+lcThisField+"+["+THIS.cControlCharacter+"]" + CASE INLIST(lcThisFieldType,"N","I","Y") + THIS.cfields = ; + THIS.cfields+"+ ALLTRIM(STR("+lcThisField+",12,4))+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "D" + THIS.cfields = ; + THIS.cfields+"+ DTOC("+lcThisField+")+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "T" + THIS.cfields = ; + THIS.cfields+"+ TTOC("+lcThisField+")+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "L" + THIS.cfields = ; + THIS.cfields+"+ IIF("+lcThisField+",'.T.','.F.')+["+THIS.cControlCharacter+"]" + OTHERWISE + * a type we can't yet handle + ENDCASE + ENDFOR + + THIS.cFields = UPPER(STRTRAN(THIS.cFields,SPACE(1),"")) + + IF THIS.cFields == "["+THIS.cControlCharacter+"]" + THIS.cAlias = "" + ENDIF + + ENDPROC + + PROCEDURE showmessagenotfound + IF INLIST(_VFP.StartMode,0,4) + ?? CHR(7) + WAIT WINDOW NOWAIT LEFT(FIND_NOFIND_LOC,254) + ENDIF + ENDPROC + + PROCEDURE skipfield && This method allows you to eliminate any particular field or fields from the search. + LPARAMETERS tcField + LOCAL llSkipped, lcThisField, lcThisFieldType + lcThisField = "" + IF VARTYPE(tcField) = "C" AND NOT(EMPTY(tcField)) + lcThisFieldType = TYPE(THIS.cAlias+"."+tcField) + DO CASE + CASE INLIST(lcThisFieldType,"N","Y","I") + lcThisField = "["+THIS.cControlCharacter+"]" + ; + "+ ALLTRIM(STR("+ ; + tcField + ; + ",12,4))+["+THIS.cControlCharacter+"]" + CASE INLIST(lcThisFieldType,"C","M") + lcThisField = "["+THIS.cControlCharacter+"]+" + ; + tcField + ; + "+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "D" + lcThisField = "["+THIS.cControlCharacter+"]" + ; + "+DTOC("+tcField+")" + ; + "+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "T" + lcThisField = "["+THIS.cControlCharacter+"]" + ; + "+TTOC("+tcField+")" + ; + "+["+THIS.cControlCharacter+"]" + CASE lcThisFieldType = "L" + lcThisField = "["+THIS.cControlCharacter+"]" + ; + "+ IIF("+tcField+",'.T.','.F.')"+ ; + "+["+THIS.cControlCharacter+"]" + ENDCASE + lcThisField = UPPER(STRTRAN(lcThisField,SPACE(1),"")) + IF NOT EMPTY(lcThisField) + IF ATCC(lcThisField, THIS.cFields) > 0 + THIS.cFields = STRTRAN(THIS.cFields,lcThisField,"["+THIS.cControlCharacter+"]") + llSkipped = .T. + IF LEFTC(THIS.cFields,1) = "+" + THIS.cFields = SUBSTRC(THIS.cFields,2) + ENDIF + IF RIGHTC(THIS.cFields,1) = "+" + THIS.cFields = SUBSTRC(THIS.cFields,1,LENC(THIS.cFields)-1) + ENDIF + IF EMPTY(THIS.cFields) OR ; + THIS.cFields == "["+THIS.cControlCharacter+"]" + THIS.cAlias = "" + ENDIF + THIS.lFindAgain = .F. + ENDIF + ENDIF + ENDIF + RETURN llSkipped + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _tablenav AS _table OF "_table.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_table.h" + * + *m: dobottommessage + *m: docyclebottommessage + *m: docycletopmessage + *m: dotopmessage + *m: gobottom && Moves record pointer to last record. + *m: gonext && Moves record pointer to next record. + *m: goprevious && Moves record pointer to previous record. + *m: gotop && Moves record pointer to first record. + *m: gotorecord && Moves record pointer to a specified record. + *p: lcycle && Controls movement when record pointer hits end or beginning of file. + * + + * + Name = "_tablenav" + * + + PROCEDURE dobottommessage + ENDPROC + + PROCEDURE docyclebottommessage + ENDPROC + + PROCEDURE docycletopmessage + ENDPROC + + PROCEDURE dotopmessage + ENDPROC + + PROCEDURE gobottom && Moves record pointer to last record. + LOCAL lcAlias + + lcAlias = THIS.GetCurrentAlias() + + IF THIS.CurrentTableAllowsNavigation(lcAlias) + + GO BOTTOM IN (lcAlias) + THIS.RefreshUIAfterChange() + + ENDIF + + ENDPROC + + PROCEDURE gonext && Moves record pointer to next record. + LOCAL lcAlias + + lcAlias = THIS.GetCurrentAlias() + + IF THIS.CurrentTableAllowsNavigation(lcAlias) + + SKIP IN (lcAlias) + + IF EOF(lcAlias) + SKIP -1 IN (lcAlias) + IF THIS.lCycle + THIS.DoCycleTopMessage() + THIS.GoTop() + THIS.RefreshUIAfterChange() + ELSE + THIS.DoBottomMessage() + ENDIF + ELSE + THIS.RefreshUIAfterChange() + ENDIF + + ENDIF + + + ENDPROC + + PROCEDURE goprevious && Moves record pointer to previous record. + LOCAL lcAlias + + lcAlias = THIS.GetCurrentAlias() + + IF EMPTY(lcAlias) OR ; + NOT THIS.CurrentTableAllowsNavigation(lcAlias) + RETURN + ENDIF + + DO CASE + CASE (NOT BOF(lcAlias)) + + SKIP -1 IN (lcAlias) + IF BOF(lcAlias) + IF THIS.lCycle + THIS.DoCycleBottomMessage() + THIS.GoBottom() + ELSE + THIS.DoTopMessage() + ENDIF + ENDIF + THIS.RefreshUIAfterChange() + + CASE BOF(lcAlias) + + IF THIS.lCycle + THIS.DoCycleBottomMessage() + THIS.GoBottom() + THIS.RefreshUIAfterChange() + ELSE + THIS.DoTopMessage() + ENDIF + + OTHERWISE + + ENDCASE + + ENDPROC + + PROCEDURE gotop && Moves record pointer to first record. + LOCAL lcAlias + + lcAlias = THIS.GetCurrentAlias() + + IF THIS.CurrentTableAllowsNavigation(lcAlias) + + GO TOP IN (lcAlias) + THIS.RefreshUIAfterChange() + + ENDIF + + ENDPROC + + PROCEDURE gotorecord && Moves record pointer to a specified record. + LPARAMETERS tiRecord + + ASSERT PCOUNT() = 1 AND VARTYPE(tiRecord) = "N" + + LOCAL lcAlias + + lcAlias = THIS.GetCurrentAlias() + + IF THIS.CurrentTableAllowsNavigation(lcAlias) AND ; + (RECCOUNT(lcAlias) >= tiRecord) + + GO tiRecord IN (lcAlias) + THIS.RefreshUIAfterChange() + + ENDIF + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _tablesort AS _table OF "_table.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: dosort && DoSort([tcField] [,tcAlias] [,tcTag] [,tlDescending]) allows you to specify exactly what order in what table you would like to set -- or, if you prefer, which field in a given alias you would like to set order to. + *m: getsorttag && Looks for an appropriate tagname by looking at key expressions in this table relevant to this fieldname. + *m: removesort && Removes the current order (index tag). + *p: ldescending && Whether order is ascending or descending. + * + + * + Name = "_tablesort" + * + + PROCEDURE dosort && DoSort([tcField] [,tcAlias] [,tcTag] [,tlDescending]) allows you to specify exactly what order in what table you would like to set -- or, if you prefer, which field in a given alias you would like to set order to. + LPARAMETERS tcField, tcAlias, tcTag, tlDescending + + THIS.SetToActiveSession() + + ASSERT EMPTY(tcField) OR ; + (VARTYPE(tcField) = "C" AND ; + TYPE(IIF(EMPTY(tcAlias),"",tcAlias+".")+tcField) # "U") + + ASSERT EMPTY(tcAlias) OR (VARTYPE(tcAlias) = "C" AND USED(tcAlias)) + + ASSERT EMPTY(tcAlias) OR (NOT EMPTY(tcField)) + + ASSERT EMPTY(tcTag) OR VARTYPE(tcTag) = "C" + + ASSERT VARTYPE(tlDescending) = "L" + + LOCAL lcField, lcAlias, liPos, lcTag, liSelect, llDescending + + IF PCOUNT() > 3 + llDescending = tlDescending + ELSE + llDescending = THIS.lDescending + ENDIF + + DO CASE + + CASE EMPTY(tcAlias) AND EMPTY(tcField) + lcField = THIS.GetCurrentBoundField() + * will be properly aliased if one can be found + IF NOT EMPTY(lcField) + liPos = AT(".",lcField) + lcAlias = LEFT(lcField,liPos-1) + lcField = SUBSTR(lcField,liPos+1) + ELSE + lcField = "" + lcAlias = THIS.GetCurrentAlias() + ENDIF + CASE (NOT EMPTY(tcAlias)) AND USED(tcAlias) + lcField = tcField + lcAlias = tcAlias + OTHERWISE + lcField = tcField + lcAlias = THIS.GetCurrentAlias() + ENDCASE + + IF NOT THIS.CurrentTableAllowsOrdering(lcAlias) + RETURN .F. + ENDIF + + IF VARTYPE(tcTag) = "C" + * the SELECTs are necessary + * because TAGNO() doesn't work + * on the non-selected area properly, + * although it is doc'd to work... + IF NOT EMPTY(lcAlias) + liSelect = SELECT() + SELECT (lcAlias) + ENDIF + + IF NOT EMPTY(TAGNO(tcTag)) + lcTag = tcTag + ENDIF + + IF NOT EMPTY(lcAlias) + SELECT (liSelect) + ENDIF + + ENDIF + + IF EMPTY(lcTag) AND (TYPE(lcAlias+"."+lcField) = "U") + RETURN .F. + ENDIF + + IF EMPTY(lcTag) + lcTag = THIS.GetSortTag(lcField,lcAlias) + ENDIF + + IF NOT EMPTY(lcTag) + + IF EMPTY(lcAlias) + lcAlias = "" + ELSE + lcAlias = "IN "+lcAlias + ENDIF + + IF llDescending + SET ORDER TO (lcTag) &lcAlias DESCENDING + ELSE + SET ORDER TO (lcTag) &lcAlias ASCENDING + ENDIF + + THIS.RefreshUIAfterChange() + + ENDIF + + RETURN (NOT EMPTY(lcTag)) + + ENDPROC + + PROCEDURE getsorttag && Looks for an appropriate tagname by looking at key expressions in this table relevant to this fieldname. + LPARAMETERS tcField, tcAlias + + ASSERT VARTYPE(tcAlias) = "C" AND USED(tcAlias) + ASSERT TYPE(tcAlias+"."+tcField) # "U" + + LOCAL lcAlias, lcField, liTags, liSelect, lcKey, lcExact, lcTag, lcAliasedField, ; + lnIndex + + lcAlias = UPPER(tcAlias) && must be passed! + lcField = UPPER(tcField) && ditto! + lcTag = "" + liSelect = SELECT() + lcExact = SET("EXACT") + SELECT (lcAlias) + SET EXACT OFF + liTags = TAGCOUNT() + lcAliasedField = UPPER(lcAlias)+"."+lcField + + IF liTags > 0 + + FOR lnIndex = 1 to liTags + lcKey = UPPER(KEY(lnIndex)) + IF TYPE(lcKey) # "U" + * this test makes sure that the index expression + * can be evaluated in the current environment + + * now test to see if we can use it for + * the current purpose, with an inexact + * comparison since that's all we need + * for an adequate sort + + lcKey = NORMALIZE(lcKey) + + IF lcKey = lcField OR ; + lcKey = lcAliasedField OR ; + lcKey = "UPPER("+lcField+")" OR ; + lcKey = "UPPER("+lcAliasedField+")" OR ; + lcKey = "UPPER("+lcField+"+" OR ; + lcKey = "UPPER("+lcAliasedField+"+" OR ; + lcKey = "LOWER("+lcField+")" OR ; + lcKey = "LOWER("+lcAliasedField+")" OR ; + lcKey = "LOWER("+lcField+"+" OR ; + lcKey = "LOWER("+lcAliasedField+"+" OR ; + lcKey = "PROPER("+lcField+")" OR ; + lcKey = "PROPER("+lcAliasedField+")" OR ; + lcKey = "PROPER("+lcField+"+" OR ; + lcKey = "PROPER("+lcAliasedField+"+" OR ; + lcKey = "SUBSTR("+lcField+"," OR ; + lcKey = "SUBSTR("+lcAliasedField+"," OR ; + lcKey = "LEFT("+lcField+"," OR ; + lcKey = "LEFT("+lcAliasedField+"," OR ; + lcKey = "SUBSTRC("+lcField+"," OR ; + lcKey = "SUBSTRC("+lcAliasedField+"," OR ; + lcKey = "LEFTC("+lcField+"," OR ; + lcKey = "LEFTC("+lcAliasedField+"," + + lcTag = UPPER(TAG(lnIndex)) + EXIT + + ENDIF + + ENDIF + + ENDFOR + + ENDIF + + + SET EXACT &lcExact + SELECT (liSelect) + + RETURN lcTag + ENDPROC + + PROCEDURE removesort && Removes the current order (index tag). + LPARAMETERS tcAlias + + THIS.SetToActiveSession() + + ASSERT EMPTY(tcAlias) OR (VARTYPE(tcAlias) = "C" AND USED(tcAlias)) + + LOCAL lcAlias + + IF EMPTY(tcAlias) + lcAlias = THIS.GetCurrentAlias() + ELSE + lcAlias = tcAlias + ENDIF + + IF NOT USED(lcAlias) + RETURN .F. + ENDIF + + SET ORDER TO 0 IN (lcAlias) + THIS.RefreshUIAfterChange() + + ENDPROC + +ENDDEFINE diff --git a/Clase/_ui.h b/Clase/_ui.h new file mode 100644 index 0000000..7fecbfa --- /dev/null +++ b/Clase/_ui.h @@ -0,0 +1,49 @@ +* _ui.h + +*********************************************************** +localization strings and constants for _ui.vcx +*********************************************************** + +* this one may be removed: +* _WindowHandler: +#DEFINE MENUPROMPT_MED_UNDO "\ (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS _modalawaretoolbar AS _toolbar OF "_base.vcx" + *< CLASSDATA: Baseclass="toolbar" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_ui.h" + * + *m: checkformodalwindow && Checks for modal window and disables toolbar. + *m: ldisabledformodal_access + *p: ldisabledformodal && Whether to disable toolbar if modal window is present. Has corresponding access method. + * + + * + Height = 22 + Left = 0 + Name = "_modalawaretoolbar" + ShowWindow = 1 + Top = 0 + Width = 33 + * + + PROCEDURE checkformodalwindow && Checks for modal window and disables toolbar. + RETURN THIS.lDisabledForModal + ENDPROC + + PROCEDURE ldisabledformodal_access + LOCAL llDisableAll + + DO CASE + + CASE WONTOP() # WOUTPUT() + * browse or something... + llDisableAll = .F. + + CASE TYPE("_SCREEN.ActiveForm") = "U" + llDisableAll = .F. + + OTHERWISE + + IF TYPE("_SCREEN.ActiveForm.Parent") = "O" + * formset + llDisableAll = (_SCREEN.ActiveForm.Parent.WindowType = WINDOWTYPE_MODAL) + ELSE + llDisableAll = (_SCREEN.ActiveForm.WindowType = WINDOWTYPE_MODAL) + ENDIF + + ENDCASE + + THIS.SetAll("Enabled", ; + NOT llDisableAll) + + THIS.lDisabledForModal = llDisableAll + + RETURN llDisableAll + + ENDPROC + + PROCEDURE Refresh + THIS.CheckForModalWindow() + ENDPROC + +ENDDEFINE + +DEFINE CLASS _mouseoverfx AS _custom OF "_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: cancelhighlight && Cancels highlighting of object. + *m: highlightme && Called in mousemove event of object desiring coolbar highlighting. + *p: ihighlightcolor && Color code for highlight. + *p: ishadowcolor && Color code for shadow. + *p: lmouseoverhost && Whether mouse is over mousefx host. + *p: nhighlightwidth && Width of highlight. + *p: nmargin && Extra border between control and highlight. + *p: ocurrentcoolcontrol + * + + PROTECTED ocurrentcoolcontrol,ohost + * + ihighlightcolor = 0 + ishadowcolor = 0 + lmouseoverhost = .T. + Name = "_mouseoverfx" + nhighlightwidth = 2 + nmargin = 2 + ocurrentcoolcontrol = (NULL) + * + + PROCEDURE cancelhighlight && Cancels highlighting of object. + IF NOT THIS.lMouseOverHost + THIS.lMouseOverHost = .T. + THIS.oCurrentCoolControl = .NULL. + IF TYPE("THIS.oHost.Name") = "C" + * the form could be in the process of releasing... + THIS.oHost.Cls + ENDIF + RETURN .T. + ELSE + RETURN .F. + ENDIF + + ENDPROC + + PROCEDURE Destroy + DODEFAULT() + STORE .NULL. TO THIS.oCurrentCoolControl, THIS.oHost + ENDPROC + + PROCEDURE highlightme && Called in mousemove event of object desiring coolbar highlighting. + LPARAMETERS toObject + + ASSERT VARTYPE(toObject) = "O" AND UPPER(toObject.BaseClass) # "FORM" + * it won't actually hurt anything if it's called from the form, + * I guess + * but it doesn't make any sense either + + IF TYPE("toObject.Name") # "C" + RETURN .F. + ENDIF + + LOCAL llNewObject + + THIS.lMouseOverHost = .F. + + llNewObject = ISNULL(THIS.oCurrentCoolControl) OR ; + ((NOT(ISNULL(THIS.oCurrentCoolControl))) AND ; + THIS.oCurrentCoolControl # toObject ) + * we'd have to do this comparison differently in VFP5... + + IF NOT llNewObject + RETURN .F. + ENDIF + + LOCAL liDrawWidth, liDrawStyle, liDrawMode, liForeColor, liScaleMode, ; + lnOTCTop, lnOTCLeft, lnOTCWidth, lnOTCHeight + + IF NOT ISNULL(THIS.oCurrentCoolControl) + THIS.oHost.Cls && get rid of old highlight + ENDIF + THIS.oCurrentCoolControl = toObject + + WITH THIS.oHost + + * save host properties: + liDrawWidth = .DrawWidth + liDrawStyle = .DrawStyle + liDrawMode = .DrawMode + liForeColor = .ForeColor + liScaleMode = .ScaleMode + + * set host properties: + .DrawWidth = THIS.nHighlightWidth + .DrawStyle = 0 && solid + .DrawMode = 13 && copy + .ScaleMode = 3 && pixels + + * get object positioning relative to host and + * leave some room for the highlight: + lnOTCTop = OBJTOCLIENT(toObject,1) - THIS.nMargin + lnOTCLeft = OBJTOCLIENT(toObject,2) - THIS.nMargin + lnOTCWidth = OBJTOCLIENT(toObject,3) + THIS.nMargin * 2 + lnOTCHeight = OBJTOCLIENT(toObject,4) + THIS.nMargin * 2 + + * border the current control with four lines + * in the appropriate colors + .ForeColor = THIS.iHighlightColor + * left control border + .Line(lnOTCLeft,lnOTCTop,lnOTCLeft,lnOTCTop+lnOTCHeight) + * top control border + .Line(lnOTCLeft,lnOTCTop,lnOTCLeft+lnOTCWidth,lnOTCTop) + + .ForeColor = THIS.iShadowColor + * bottom control border + .Line(lnOTCLeft,lnOTCTop+lnOTCHeight,lnOTCLeft+lnOTCWidth,lnOTCTop+lnOTCHeight) + * right control border + .Line(lnOTCLeft+lnOTCWidth,lnOTCTop,lnOTCLeft+lnOTCWidth,lnOTCTop+lnOTCHeight) + + * restore host properties: + .DrawWidth = liDrawWidth + .DrawStyle = liDrawStyle + .DrawMode = liDrawMode + .ForeColor = liForeColor + .ScaleMode = liScaleMode + + ENDWITH + + + + + ENDPROC + + PROCEDURE Init + IF NOT DODEFAULT() + RETURN .F. + ENDIF + + IF TYPE("THISFORM") = "O" + THIS.oHost = THISFORM + ELSE + THIS.oHost = _SCREEN + ENDIF + + * get appropriate color information + DECLARE INTEGER GetSysColor in win32api integer + THIS.iHighlightColor = GetSysColor(20) && button highlight + THIS.iShadowColor = GetSysColor(16) && button shadow + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS _windowhandler AS _custom OF "_base.vcx" && Grab bag of window-handling features. + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "_ui.h" + * + *m: cascadeforminstances && Cascades current set of active forms. + *m: getcurrenttopformref && Returns current frame window -- primarily for top-level form applications, but will work in other cases, returning a reference to _SCREEN if appropriate. + *m: imdiworkspacecolor_access + *m: invokemenuiteminframe && Use to invoke menu item in top-level form applications. + *m: showcurrenttopform && not currently implemented + *m: showwindowinframe && not currently implemented + *p: imdiworkspacecolor && Returns appropriate Windows color for top-level frame window background. + * + + * + imdiworkspacecolor = 0 + Name = "_windowhandler" + * + + PROCEDURE cascadeforminstances && Cascades current set of active forms. + * to stagger existing forms with current frame. + * Returns number of forms arranged. + + LPARAMETERS tcFormName,tlOmitAutoCenteredForms,tnStartTop, tnStartLeft, tnStartColumn + + #DEFINE WINDOW_STAGGER_FACTOR SYSMETRIC(9) + * window title height + + ASSERT EMPTY(tcFormName) OR (VARTYPE(tcFormName) = "C" AND WEXIST(tcFormName)) + + LOCAL lnArranged, lnColumn, lnTop, lnLeft, loFormRef, ; + lnParentHeight, lnScaleMode, lnIndex, llAllForms, loFrame, llInScreen, ; + llRightFrame + + loFrame = THIS.GetCurrentTopFormRef() + llInScreen = (loFrame.ShowWindow = 0) + + lnScaleMode = loFrame.ScaleMode + loFrame.ScaleMode = 3 + + lnArranged = 0 + + lnTop = IIF(VARTYPE(tnStartTop) = "N", tnStartTop, 0) + lnLeft = IIF(VARTYPE(tnStartLeft) = "N", tnStartLeft,0) + lnColumn = IIF(VARTYPE(tnStartColumn) = "N" AND tnStartColumn > 0, ; + tnStartColumn, 1) + lnParentHeight = loFrame.Height + llAllForms = EMPTY(tcFormName) + + FOR lnIndex = _SCREEN.FormCount TO 1 STEP -1 + loFormRef = _SCREEN.Forms(lnIndex) + IF UPPER(loFormRef.BaseClass) == "TOOLBAR" + LOOP + ENDIF + DO CASE + CASE llInScreen AND ; + lnIndex = _SCREEN.FormCount AND ; + INLIST(loFormRef.ShowWindow,0,1) + llRightFrame = .T. + * go right ahead and process these windows + CASE llInScreen AND ; + loFormRef.ShowWindow = 0 + llRightFrame = .T. + CASE llInScreen AND ; + loFormRef.ShowWindow = 2 + LOOP + * the real problem is ShowWindow = 1 + * where you are mixing them some in Screen + * and some in top forms. This has to be + * taken care of separately in 5, but in 6 + * apparently these windows show up with ShowWindow = 0!! + CASE INLIST(loFormRef.ShowWindow,0,1) AND ; + NOT llRightFrame + * we haven't gotten to the right group of windows yet + LOOP + CASE llRightFrame AND loFormRef.ShowWindow = 2 + * we've reached another frame + EXIT + CASE loFormRef.ShowWindow = 2 AND loFormRef # loFrame + * still wrong group + LOOP + CASE loFormRef.ShowWindow = 2 + llRightFrame = .T. + LOOP + * now we can work on the window group + * we'll see next in the stack... + OTHERWISE + * we're in an appropriate window, cascade it + ENDCASE + + IF (llAllForms OR UPPER(loFormRef.Name) == UPPER(tcFormName)) AND ; + loFormRef.WindowState = 0 AND loFormRef.Visible AND ; + (NOT (tlOmitAutoCenteredForms AND loFormRef.AutoCenter)) + + lnArranged = lnArranged + 1 + loFormRef.Top = lnTop + loFormRef.Left = (lnLeft * lnColumn) + loFormRef.AutoCenter = .F. + IF lnTop > lnParentHeight - WINDOW_STAGGER_FACTOR + STORE WINDOW_STAGGER_FACTOR TO lnTop, lnLeft + lnColumn = lnColumn + 1 + ENDIF + lnTop = lnTop + WINDOW_STAGGER_FACTOR + lnLeft = lnLeft + WINDOW_STAGGER_FACTOR + ELSE + * do nothing + ENDIF + ENDFOR + loFrame.ScaleMode = lnScaleMode + + RETURN lnArranged + + + ENDPROC + + PROCEDURE getcurrenttopformref && Returns current frame window -- primarily for top-level form applications, but will work in other cases, returning a reference to _SCREEN if appropriate. + LOCAL loForm, loTopForm + + * first top form in the list + * will be the current top form. + * DON"T USE THIS METHOD in VFP 5 IF YOU MIX + * _SCREEN-owned forms with topform-Owned + * forms unless you use ShowWindow = 0 for + * all _screen-owned forms! In 6 it appears okay + + ASSERT TYPE("_SCREEN.ActiveForm") # "O" OR ; + INLIST(_SCREEN.ActiveForm.ShowWindow, 0,1,2) + + DO CASE + CASE _SCREEN.FormCount = 0 OR ; + (TYPE("_SCREEN.ActiveForm") = "O" AND ; + _SCREEN.ActiveForm.ShowWindow = 0 ) && ShowWindow In Screen + + loTopForm = _SCREEN + + CASE (TYPE("_SCREEN.ActiveForm") = "O" AND ; + _SCREEN.ActiveForm.ShowWindow = 2 ) && ShowWindow As Top Form + + loTopForm = _SCREEN.ActiveForm + + OTHERWISE + + FOR EACH loForm IN _SCREEN.Forms && note: these may be toolbars + && if undocked, but that's okay -- + && they are only ShowWIndow 0 or 1. + + IF loForm.ShowWindow = 2 && the first one in the collection will + && be "active top form" + loTopForm = loForm + EXIT + ENDIF + ENDFOR + + IF VARTYPE(loTopForm) # "O" + loTopForm = _SCREEN + ENDIF + + ENDCASE + + RETURN loTopForm + + ENDPROC + + PROCEDURE imdiworkspacecolor_access + DECLARE INTEGER GetSysColor IN Win32API INTEGER nColorAspect + + RETURN GetSysColor(12) + + ENDPROC + + PROCEDURE invokemenuiteminframe && Use to invoke menu item in top-level form applications. + LPARAMETERS tcAction + ASSERT VARTYPE(tcAction) = "C" AND (NOT EMPTY(tcAction)) + + * this method allows us to properly call the items whether the system menu + * exists or not, and whether we're calling from a top form or not, including + * from a context menu. + + + #DEFINE KNOWN_ACTIONS "UNDO","REDO","CUT","COPY", "PASTE", ; + "CLEAR","SELECTALL", "FIND","FINDAGAIN","REPLACE", ; + "GOTOLINE","INSERTOBJECT","OBJECT","LINKS" + + #DEFINE ACTIONS_NEEDING_WINDOW "FIND","REPLACE", ; + "GOTOLINE", "PASTESPECIAL", ; + "INSERTOBJECT","OBJECT","LINKS" && , ; + && "PROPERTIES" + + LOCAL loTopWindow, lcWindowName, ; + lcAction, lnBarno, lcBarNo, lcPrompt, lcKey + + * remove spaces and dots, in case somebody is passing + * the actual prompts as tokens... + lcAction = STRTRAN(UPPER(tcAction)," ","") + lcAction = STRTRAN(lcAction,".","") + + STORE "" TO lcBarNo, lcPrompt, lcWindowName, lcKey + STORE 0 TO lnBarno + STORE NULL TO loTopWindow + + ASSERT INLIST(lcAction,KNOWN_ACTIONS ) + + IF INLIST(lcAction,ACTIONS_NEEDING_WINDOW ) + + loTopWindow = THIS.GetCurrentTopFormRef() + lcWindowName = WONTOP() + + ENDIF + + + IF CNTBAR("_MEDIT") = 0 + DEFINE POPUP _MEDIT + ENDIF + + DO CASE + + CASE lcAction == "UNDO" + lcBarno = ["_med_undo"] + lcPrompt = MENUPROMPT_MED_UNDO + lcKey = MENUKEY_MED_UNDO + + CASE lcAction == "REDO" + lcBarno = ["_med_redo"] + lcPrompt = MENUPROMPT_MED_REDO + lcKey = MENUKEY_MED_REDO + + CASE lcAction == "CUT" + lcBarno = ["_med_cut"] + lcPrompt = MENUPROMPT_MED_CUT + lcKey = MENUKEY_MED_CUT + + CASE lcAction == "COPY" + lcBarno = ["_med_copy"] + lcPrompt = MENUPROMPT_MED_COPY + lcKey = MENUKEY_MED_COPY + + CASE lcAction == "PASTE" + lcBarno = ["_med_paste"] + lcPrompt = MENUPROMPT_MED_PASTE + lcKey = MENUKEY_MED_PASTE + + CASE lcAction == "CLEAR" + lcBarno = ["_med_clear"] + lcPrompt = MENUPROMPT_MED_CLEAR + lcKey = MENUKEY_MED_CLEAR + + CASE lcAction == "SELECTALL" + lcBarno = ["_med_slcta"] + lcPrompt = MENUPROMPT_MED_SLCTA + lcKey = MENUKEY_MED_SLCTA + + CASE lcAction == "FIND" + lcBarno = ["_med_find"] + lcPrompt = MENUPROMPT_MED_FIND + lcKey = MENUKEY_MED_FIND + + CASE lcAction == "FINDAGAIN" + lcBarno = ["_med_finda"] + lcPrompt = MENUPROMPT_MED_FINDA + lcKey = MENUKEY_MED_FINDA + + CASE lcAction == "REPLACE" + lcBarno = ["_med_repl"] + lcPrompt = MENUPROMPT_MED_REPL + lcKey = MENUKEY_MED_REPL + + CASE lcAction == "PASTESPECIAL" + lcBarno = ["_med_pstlk"] + lcPrompt = MENUPROMPT_MED_PSTLK + lcKey = MENUKEY_MED_PSTLK + + CASE lcAction = "GOTOLINE" + lcBarno = ["_med_goto"] + lcPrompt = MENUPROMPT_MED_GOTO + lcKey = MENUKEY_MED_GOTO + + CASE lcAction == "INSERTOBJECT" + lcBarno = ["_med_insob"] + lcPrompt = MENUPROMPT_MED_INSOB + lcKey = MENUKEY_MED_INSOB + + CASE lcAction == "OBJECT" + lcBarno = ["_med_obj"] + lcPrompt = MENUPROMPT_MED_OBJ + lcKey = MENUKEY_MED_OBJ + + CASE lcAction == "LINKS" + lcBarno = ["_med_link"] + lcPrompt = MENUPROMPT_MED_LINK + lcKey = MENUKEY_MED_LINK + + *&* CASE lcAction == + *&* lcBarno = [""] + *&* lcPrompt = + *&* lcKey = [] + + OTHERWISE + * we shouldn't have gotten through ASSERT! + RETURN .F. + + ENDCASE + + lnBarNo = STRTRAN(lcBarNo,["],[]) + lnBarNo = INT(&lnBarNo) + + IF TYPE("BARPROMPT(lnBarNo,[_MEDIT])") # "C" + + DEFINE BAR lnBarNo OF _MEDIT PROMPT lcPrompt &lcKey + + ENDIF + + IF NOT ISNULL(loTopWindow) + ACTI WINDOW (loTopWindow.Name) SAME + IF NOT EMPTY(lcWindowName) + ACTI WINDOW (lcWindowName) + ENDIF + ENDIF + + =SYS(1500,&lcBarNo,"_medit") + + IF NOT EMPTY(lcWindowName) + * there's a faint possibility + * of problems if we have invoked + * a system dialog, otherwise -- + * especially if the system dialog + * was modal or the previous window was modal + ACTI WINDOW (lcWindowName) && again + ENDIF + + RETURN + ENDPROC + + PROCEDURE showcurrenttopform && not currently implemented + ENDPROC + + PROCEDURE showwindowinframe && not currently implemented + ENDPROC + +ENDDEFINE diff --git a/Clase/ferestre_registratura.vc2 b/Clase/ferestre_registratura.vc2 new file mode 100644 index 0000000..6e561a8 --- /dev/null +++ b/Clase/ferestre_registratura.vc2 @@ -0,0 +1,2166 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="ferestre_registratura.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +*< LIBCOMMENT: Application Wizard framework class library. /> +* +DEFINE CLASS ct_date_generale AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="outlook2003bar1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="outlook2003bar1.Panes.Pane1.Olecontrol1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="outlook2003bar1.Panes.Pane1.Olecontrol2" UniqueID="" Timestamp="" /> + + * + BackColor = 255,255,255 + Height = 401 + Name = "ct_date_generale" + Width = 800 + * + + ADD OBJECT 'outlook2003bar1' AS outlook2003bar WITH ; + Anchor = 7, ; + Left = 5, ; + Name = "outlook2003bar1", ; + Top = 1, ; + Panes.ErasePage = .T., ; + Panes.Height = 328, ; + Panes.Name = "Panes", ; + Panes.PageCount = 4, ; + Panes.Pane1.Caption = "Date generale", ; + Panes.Pane1.Name = "Pane1", ; + Panes.Pane1.picture16 = Email Envelope 16.png, ; + Panes.Pane1.picture24 = Email Envelope 24.png, ; + Panes.Pane2.Caption = "Referinte", ; + Panes.Pane2.Name = "Pane2", ; + Panes.Pane2.picture16 = Contacts 16.png, ; + Panes.Pane2.picture24 = Contacts 24.png, ; + Panes.Pane3.Caption = "Observatii", ; + Panes.Pane3.Name = "Pane3", ; + Panes.Pane3.picture16 = Favourites 16.png, ; + Panes.Pane3.picture24 = Favourites 24.png, ; + Panes.Pane4.Caption = "Documente atasate", ; + Panes.Pane4.Enabled = .F., ; + Panes.Pane4.Name = "Pane4", ; + Panes.Pane4.picture16 = Calendar Multiweek 16.png, ; + Panes.Pane4.picture24 = Calendar Multiweek 24.png, ; + Panes.Top = 33, ; + overflowpanel.MenuButton.imgPicture.Height = 16, ; + overflowpanel.MenuButton.imgPicture.Name = "imgPicture", ; + overflowpanel.MenuButton.imgPicture.Width = 16, ; + overflowpanel.MenuButton.Name = "MenuButton", ; + overflowpanel.Name = "overflowpanel", ; + SplitBar.imgSplitter.Height = 3, ; + SplitBar.imgSplitter.Name = "imgSplitter", ; + SplitBar.imgSplitter.Width = 35, ; + SplitBar.Name = "SplitBar", ; + Panel.Name = "Panel", ; + Splitter.Name = "Splitter", ; + Title.lblCaption.Name = "lblCaption", ; + Title.linBorder.Name = "linBorder", ; + Title.Name = "Title" + *< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" /> + + ADD OBJECT 'outlook2003bar1.Panes.Pane1.Olecontrol1' AS olecontrol WITH ; + Anchor = 15, ; + Height = 328, ; + Left = 0, ; + Name = "Olecontrol1", ; + Top = 0, ; + Width = 198 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7///8EAAAA/v///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMBx4fRDIcgBAwAAAIACAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAigAAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwAAAA8BAAAAAAAABwAAAAIAAAD+////BAAAAAUAAAAGAAAACQAAAAgAAAD+/////v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////+2kEHHiYXREbFqAMDwKDYoIUM0EggAAAB3FAAA5iEAALE8wWoBAAYAIgAAAD0AMgCNAQAACAAAAMFtIgAB782rXAAAAAAAAAABAAAAAAAAAAAAAAAAAAAAAAAAACQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RS04NUZFLTExZDEtOEJFMy0wMDAwRjg3NTREQTEBAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAaNYaADwAAAABAACADgAAAEhpZGVTZWxlY3Rpb24ABQAAAEwAAAAADAAAAEluZGVudGF0aW9uABEAAABODQAAAAcAAAAAAAAAAAAuQAoAAABMYWJlbEVkaXQACQAAAEkKAAAAAQAAAAoAAABMaW5lU3R5bGUACQAAAEkKAAAAAQAAAA0AAABNb3VzZVBvaW50ZXIACQAAAEkKAAAAAAAAAA4AAABQYXRoU2VwYXJhdG9yAAoAAABIAAAAAAEAAABcDAAAAE9MRURyYWdNb2RlAAkAAABJCgAAAAAAAAAMAAAAT0xFRHJvcE1vZGUACQAAAEkKAAAAAAAAAAwAAABCb3JkZXJTdHlsAAAFAJBvIgAGAAAAAAAAAAUAAIBk5xIAAQAAAFwAH97svQEABQCp5xIAA1LjC5GPzhGd4wCqAEu4UQEAAACQAURCAQAFQXJpYWxCAV0gWwB4AxUASMIaADUAbAB7AD0AYwBkAFIAJgBhAEYAIQBaAFoAdQBbAEwAfQAtADkAKwBlAAkAAABJCgAAAAAAAAAAJQB5AEkAeAA5AGoAXQB5AFUANgBgAHsAPQB0ADYAQQBzADIAWgB4AEoAMwBFAFUAKgA0AEMAXQB9AFcAdgBQAHQALABeAD8AVQBbACgAQwAoAHMAcABaAHUAYgBtAC4ANAAlAGIALgBDAHoAMgA9AHgAQwBYAFEAQABBACUAagBQAFAARQBlAC0AKwBtACgAXgBdAE8APQBxAEEAawBBAHMAYQB7AHEALgAhAE8ARABzAEMATgBYAFEAXgB9AEAAMgBbADQAPQBhAEUAMQBTAHYAawBCACgAVAAsAHMAaABtAFgAQwA/ACgAMwBYAFEAYABZAHcAQAA2AF8AQwB0AGUAJQBrAHoAWABeAG4AOABAAGoALQB6AGEAWABdAEgAdwBOAFMAVABxAE0AeABFAD0AQABZAD0AKQApAFcAJQBvACYAcwBpADIAZQA0AHsAJABhAD0ASQBNACUANgA/AGUAdgBhAGwANgB4AHUAcgB3AGMAQgBiAHUAdwAuACUAcgBwAFYAOQArAFQAbgBTAC0AbgAsAGUATABDAFYARgBvAGwAJgAhAGwAMABWAD8A" /> + + ADD OBJECT 'outlook2003bar1.Panes.Pane1.Olecontrol2' AS olecontrol WITH ; + Height = 150, ; + Name = "Olecontrol2", ; + Visible = .F., ; + Width = 200 + *< END OBJECT: BaseClass="olecontrol" OLEObject="c:\windows\system32\mscomctl.ocx" Value="0M8R4KGxGuEAAAAAAAAAAAAAAAAAAAAAPgADAP7/CQAGAAAAAAAAAAAAAAABAAAAAQAAAAAAAAAAEAAAAgAAAAEAAAD+////AAAAAAAAAAD////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9/////v////7////+////BQAAAAYAAAAHAAAACAAAAAkAAAAKAAAACwAAABYAAAANAAAADgAAAA8AAAAQAAAAEQAAABIAAAATAAAAFAAAABUAAAAEAAAAFwAAABgAAAD+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////1IAbwBvAHQAIABFAG4AdAByAHkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAWAAUA//////////8BAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMBx4fRDIcgBAwAAAAABAAAAAAAAAwBPAGwAZQBPAGIAagBlAGMAdABEAGEAdABhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB4AAgEDAAAAAgAAAP////8AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMAAAADikAAAAAAAADAEEAYwBjAGUAcwBzAE8AYgBqAFMAaQB0AGUARABhAHQAYQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJgACAP///////////////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABcAAAAAAAAAAMAQwBoAGEAbgBnAGUAZABQAHIAbwBwAHMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAcAAIA////////////////AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAFcAAAAAAAAAAQAAAP7///8DAAAA/v////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////9cAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAJAAAADgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADkzNjgyNjVFLTg1RkUtMTFkMS04QkUzLTAwMDBGODc1NERBMSQAAAA4AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA5MzY4MjY1RQEAAIAMAAAASW1hZ2VIZWlnaHQACQAAAEkKAAAAEAAAAAsAAABJbWFnZVdpZHRoAAkAAABJCgAAABAAAAANAAAAVXNlTWFza0NvbG9yAAUAAABMAQAAAABJCgAAABgAAAALAAAASW1hZ2V3aWR0aAAJAAAASQoAAAAYAAAADQAAI38kLJGF0RGxagDA8Cg2KCFDNBIIAAAA7QMAAO0DAACAfuHmAAAGAAgAAAAQABAAwMDAAP//AAAB782rAAAFAJgQIgAGAAAA/////wUAAIAAAAAADAAAAAETAAAARABhAHQAZQBsAGUAIABjAG8AbgB0AHIAYQBjAHQAdQBsAHUAaQABEAAAAEMAYQBpAHgAYQAgAGQAZQAgAGUAbgB0AHIAYQBkAGEAAQ4AAABDAGEAaQB4AGEAIABkAGUAIABzAGEA7QBkAGEAAQ4AAABJAHQAZQBuAHMAIABlAG4AdgBpAGEAZABvAHMAAQ8AAABJAHQAZQBuAHMAIABlAHgAY///5I50/+3h/+bU/tjE/cy2/sSr67+yT6rnA7P/D5H+XpTShn98qKio4ODg+/v7////55N4/MWq+7ma+8au/+LR/+jW8trTMdL1AMf/B7P+H474PHmsg4ODtra25eXl+/v79+Tf/fDj+97P8KOH85Ry/MCl/cCniMbMBNz+AMH/DK79I4/5SXighoaGubm56enp/////O3d//bs++nh8aB+/9/G/9vC+c65bNjkAtv/AL//JanwXozCcXN5jIyMxsbG/////////OjX/u/i+7uY/9S0/97D/+XL793ORt3xJdTzi6DITl7aID3ZX2B/qamp//////////38+eXa97OT/93G/+XK/+HE/+DB2eDYfrPMe4fvRGv/EUT/Hj3UtLS0/////////////v797rKg4o555peC8bik+9vI/9vGt3N2gJTwVXr/OGD+Xnbe3Nzc/////////////////////v39+enl7Lqs5J6K435e2aqhubvfg5btoazr3d/p+Pj4BwAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////f398/Pz6Ojo5+fn6+vr8fHx+Pj4/f39/////////////////////////v7+/Pz89PT01tbWsrKyqKiosrKyvb29y8vL2tra5eXl7+/v+fn5/v7+////////9/f34uLi2Lmt4LGhx56QsYBxn3ZqkHt1i4aFlZWVpaWlvr6+4ODg+fn5/////f39zdnhmqu2k46R/9/O//fs/u/i+9/O88Sx3aOQv4FvpnFjkoaCwsLC8fHx////9PT0VazcDrz+U6HC+tfH//Dl/dfI/tW9/9zA/+XL//Df+93Mp3tvuLi47u7u/v7+stHlFbLzHcv/dcTS/+bX//Pr/eTc/dG9/s+0/+LJ//jt/eTTr4R4u7u78PDw+/v7b7viEcT+Mcj2tc7I//Pp/uba/dC9/c22/cy1/cmy/smq/drFpH1wubm57+/v5+7zNrnrGMv/S8To693N//38/eDV/dfH/c+7/c+5/Myz/9a689HAf3yCsLCw6+vrvtrrL8n6INH/e8LV//Lm//z7/+ff/+jh/ePa/dfG/ciu/9zF39DCVpe1qqqq6Ojols3oO9j/Ndb+p8PF+e3p9erm89jO+NbK/drO/dnM/dfG/+PSzdvNZKrCqqqq5+fngcfoTeT/Rt3+qry75byo17OmyZyQxLa0/f///////////OznwdrOba7Gra2t6Ojods3tZvP/U9/7l+P2+f32//Hh9MKvzquh////////////8eHbuNfWdq3FsbGx6urqgs3ubOr8aer8atz3huX6z+7x+trJ2L60////////////9ePax9rae6rEwsLC8PDw9fr90Of2sNvwktLscsnrZdLypNfhybes8ufc8+PW4drS3MjA3uDdkrvV4uLi+Pj4/////////////////v7++Pz+4fD5gsTlhPT1gvT2cebxaafIq8bY1uTt+vr6/v7+////////////////////////////1en2h9Dud9jxcs3sz93m9fX1/v7+////////CAAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////////////////////////////////+vr67u7u6Ojo8fHx/Pz8/////////////////////v7++fn59/f3+vr6/v7+////7e3twsLCrKyswcHB4uLi8vLy+Pj4/f39////////9vb23d3dy8vL1dXV5+fn8vLy3J2K3KSIm3Bjh4eHqampwsLC2NjY8/Pz/////v7+y9rkfqnBg4ySk5OTrKyswL296IRj//jR+d+5qXFekW1jmXtzr6+v5+fn////9/f3Wa7dGr74JrHmQZC4YoCRjXl1+Jhw/ujB//DI/ezF/O3G2a+Qo6Oj5OTk////y97pFrX1KcX5Mdj/Kdn/SbHSw4p7/8Sb/du0/d63/uS9//PMyZp/p6en5ubm/v7+gcDjEsL9NMj3Ref/dcHM7LCL/7+W/Mqk/Mym/dGr/dav/+W+uoZwo6Oj5eXl+Pn5TrvpHMr/Pcz3Wuv6gM3S5sWj/8We/LuV+76Y+8Se/Mmj/9avx410o6Oj5OTk3OnxNcT1KNL/SdH2s8zBn8O8hL6+srSh+saf/LKM+7eS/riQ/bqU15J1ra2t6enpttfrPtX8NdX/VtX04+bU/8ur9cSns6yd1sCi/7aO/6B43KOGqsi9mYB6t7e37u7un9TrT+D+Rdv+cNr04tC89cq4/9bB08i6s7+z/6yB1YVuitDemPf3f5uovLy87+/vjs/tafL/Wub+ft35ydvT7NvQ//Ho3NjPmtTgn6uzjsjch9v0o9/tfaS1xMTE8vLyodXwadr0Z+b6Zdv2ct/6h+P2neLztubvvvb+vfn/vvX/seHwv+TsiKe61dXV+Pj4/f7+8Pj8zub1rNvwk9XubsjsYNHxXNj2bNz3f973lOH4td3uw+DusMfW7u7u/f39////////////////////////9fv9i9HuePj/dfr/XuL5iLDJvNLh8PP1/f39////////////////////////////////4fD5n9jwhdLtjMrn7e3t+vr6////////////CQAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////////v7+/Pz89/f37e3t5ubm5eXl5eXl6+vr9fX1+/v7/v7+////////////////////+Pj44+PjzMzMtbW1pqampKSkpaWlsLCwyMjI39/f9fX1////////////////////5N3ss6XFlnHApWvojmLBoGjgkWPHfW+Ni4CXsrKy6Ojo/////v7+9fX16Ojo6Ojot4Txs3H/tXb9vIP/vIH/vIL/t3r+s3H/mmLcmpqa4ODg////9/f31tbWr6+vqampqnXowIr/v4j/v4n/wIr/wIn/v4f/v4n/pW3nmpqa4ODg////ytznPq3gQKLLWYOcmmrYxZT/xJP/xpT/xpX/xZT/xJH/xJD/p3Dmmpqa4ODg/Pz8crvhGr74LtP/Ls/9i3rwzKD/y5//zaL/0qX/zqL/ypz/zZ7/rHjmmpqa4ODg6+/zLrXsHsD4Rt3+RuH/k4r40ar/0an/zqj6tpXexJ7w0ab/t5LkmmzOmpqa4ODguNboIcf8J8f7YtrwX+HympD51rP/2LL/oI63LC4tbGN3wKTgUVJSUTlto6Oj5OTkfMTmM9j/MdD+r9XQ0ryjq4jh3Lz/2rv+sqfBrrGtop2puaPSub20oYPDvb297+/vacXqROL/QNH6wOLd/8qt353A0an/6NL/49L0xbXXybHn2rn+xabqqYjP4eHh+/v7YdTzWu7/V9j7ydnS/9nI/+DNrYri1rP/7+D/79z/4sb/0ar/roHh4eDj+fn5////cczuZ+H3Z+H5iuXzoNvoueTwuebsqL/4s6P5uJn3oYblqI/F4N/h/Pz8////////+fz+4O/4tt3xlNXuasvuWtLzY9z4f9/3k9/2wuPxqMjb39/f9/f3/////////////////////////////f7+4/H6btjyev3/Wtr1l7bJytrl+vr6/v7+////////////////////////////////////wuP1kNXvmM3o8fHx+/v7////////////////////CgAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////////////////////+vr67Ozs4uLi6enp+Pj4/////////v7+/v7+/////////////////f39+vr6+/v76+vrv7+/oKCgs7Oz4ODg+Pj48vLy4uLi4ODg8PDw/Pz8/////v7+8fHx2tra1dXVfHR1STs/QUBCgYGBwsLC6urqzMzMn5+foKCgyMjI8fHx////+fn5tcnXkKOtkpKSp3Bz2IyRbkxRVlZXs7Ozvbu8W0lNPzY5WltcoaGh4+Pj////2uXrLKzmHrnyN5TAdX+V9KSmrGZqUlFToKCgrJWX2I6Vr3N5QTk7m5ub3d3d/f39hcHgFrj2LdD+LNb/Ksr5U63JY3aHXG6Ce31+kJGUxIiE5JaaYUVKr6+v4uLi8vT2PLbqGMD7QtX7R+D/RuD/Pun/TLDJYpOpQrjfUnuPaHR/iXuAeWJktra25eXlyd7sIsL5IMb7Udr6V+v/W+7/XfP/YbTDbJ+rVvb/Xff/VOD0VoihcGJop6en4+PjlMvnLNH/J87/cdHlqca6gMzPbOXsd8TOq4GJjJiheKiybsLGU6rAZ1lelpaW3d3ddMPnPNz/NNH9jNzm/9q8+cCh2r6mjp+cz3eB0G92ql5khFNYWENIOzM2nJyc4ODgZsjsTub/QtT8od7j8c67/865/82ysMG6nauzo4+XkG15f1ZgY0JGNy4xvLy87+/vY9b0Y/L/V9f4quvy4cu4/ujd/+rgvdfVhOX7gNnvhtXsgrzRgqKuc3Fz2dnZ+/v7ac7wbev7ZuT5c973h+T4nOHyvuTpwOvxv/T9v/X9p+T4suLwotbnsbKy5+fn////7/f7yuP0qtrwjc/sbcvtXdDyWdT1a9v4ft33leH3ruX34fL1nsjg19na9PT0/////////////////////f7+8fj8yOP0Zdv1d/z/bfT+WsLlmrjNwdfm+Pj4/f39////////////////////////////////rtzyhtPud9fvos3k8PDw+/v7////////////CwAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////////v7+9vb26+vr6Ojo6+vr8vLy+/v7////////////////////////////////////+vr639/fuLi4qqqqsLCwwcHB3d3d9PT0/v7+////////////////+/v77+/v6Ojo5dfS4rqpw5mIwJmHpIN2hIKBoqKiysrK5+fn9/f3/f39/////v7+7Ozsw8PDrKysuaii//To/+bU/+zd/uXS0Z+Jh3Vujo6OsLCw1tbW9fX1////+vr6iLzbPKraTYuqhZyn0+S4993J+eLS//Pj/+/c67idrXtolH11tbW16+vr////3ufuKLDsJtL/KND/jtDLgNZ258m344Fd7bmX/+vW/+zY/+TGzZJ6t7e37u7u/v7+mMfhFb/7OM/7Str8rta6v+ojfyQskYXREbFqAMDwKDYoIUM0EggAAADtAwAA7QMAAIB+4eYAAAYAugEAABAAEADAwMAA//8AAAHvzasAAAUAmBAiAAYAAAD/////BQAAgAAAAAAMAAAAARMAAABEAGEAdABlAGwAZQAgAGMAbwBuAHQAcgBhAGMAdAB1AGwAdQBpAAEQAAAAQwBhAGkAeABhACAAZABlACAAZQBuAHQAcgBhAGQAYQABDgAAAEMAYQBpAHgAYQAgAGQAZQAgAHMAYQDtAGQAYQABDgAAAEkAdABlAG4AcwAgAGUAbgB2AGkAYQBkAG8AcwABDwAAAEkAdABlAG4AcwAgAGUAeABjAGwAdQDtAGQAbwBzAAEJAAAAUgBhAHMAYwB1AG4AaABvAHMAASEAAABPAGIAaQBlAGMAdAB1AGwAIABzAGkAIAB2AGEAbABvAGEAcgBlAGEAIABjAG8AbgB0AHIAYQBjAHQAdQBsAHUAaQABIAAAAFQAZQByAG0AZQBuAGUAIABkAGUAIABmAGEAYwB0AHUAcgBhAHIAZQAgAHMAaQAgAGEAYwBoAGkAdABhAHIAZQABBQAAAEoAbwBnAG8AcwABBwAAAE0A+gBzAGkAYwBhAHMAAQUAAABGAG8AdABvAHMAAQYAAABWAO0AZABlAG8AcwAMAAAAAQAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////////+/v77u7u5ubm7Ozs9/f3/f39////////////////////////////////////////7e3twsLCp6ensrKyzMzM4+Pj8vLy+/v7////////////////////////////+/v715iH13NVrGtYi3JrjIyMpqamwMDA2NjY6+vr9/f3/f39////////////////8Ojm1WNE7ohj8Y9r4XpZuWhQlGldh399mJiYsrKyzMzM4+Pj8vLy+/v7/v7+////4bOo3GNA6YRf9aJ+9Jx385dy74pm0nJVpmVTi3JrjIyMpaWlw8PD4uLi+fn5/f392Ypz4G9L6IZi96+K9KaB9KJ99KB79J158pVw4X9dumlRlm1ij4aEu7u77e3t9e/t3XlZ5HxY6Ytm+LWN+rGI/LGJ+K2H9KeC9KWA9KN99J5575FssG5apqam5ubm683F5oJf6Ydh6ZFtsbmzqKmf0aiO66yI97WO9bGL9a2I9KmE9qyHx39kp6en5ubm5bSn7JRv7I9p6pdyr93egub5e8ncia6236+P+8Ka97yW9reS97aRxIxzq6ur6Ojo4aKP8aR+7pZw66WBt+Dfi9v0ddL1hd/1xKqU9q2F8rKM9bqU88CcwpR9ra2t6Ojo45yE9bKM8qB69biQjdbfjtHqs+f7oODzyLKc9raN8LON7qeC6bOQwZmDsLCw6enp6Z2B/MWe97SO9LKK3tG0xdjR3OfixeHk5dKy98ig8LWQ8bWP5rSRw52Hs7Oz6enp7bWl66WH7qWD75969qqC9a2E8bOM7cOg9s+o+dy1/Oa/+Nex59WzyqiSw8PD7u7u/////fn49d3X8dHH6bOh55+H6p1+7Jhz8aiD8KmD8K2I7bSO5NCx17Og4+Pj9/f3/////////////////////////fj27Lao+b+Y/caf+r+Z14Rnyayk6NTO+vr6/v7+/////////////////////////////PXz66mT66aI76aD37Gl7+/v/Pz8////////AgAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////////////////////v7++Pj46+vr5ubm7+/v+/v7/////////////////f399fX18vLy+Pj4/v7+/v7+8vLy1tbWs7OzpqamwMDA6enp/f39////////////8fHx0dHRwcHBz8/P4+Pj5eXltsC2WKZmVMx1T4ZXjY2NxcXF8fHx/v7+////+/v72rWrvH9ujn15jo6OpKSkjqKPN6pKR+lxVPSDUed+WnZdm5ub1tbW+Pj4////8Ovq1WZJ7odj5X1bwWZRaGxLEJcnMtdTO9xfRONsVPOCRr5jdn52uLi47u7u/v7+4LOn3GM/7Itn9p9795h1kIdEIooXDaggL9JOO9teReRtU/OCTZRZs7Oz7Ozs+/v72YVt4XFN6o1o+K+I9aaB/6GEqZZWB6gXIsk+MNNQO9xfQeFoQKBWxMTE9PT08+nm33lX5HxY6ZNu6bOS9a2F/7KOuKloELckGcEwJcpBK9pTW6ZGhYF3yMjI9vb26Ma96Ilk6YZh5Jl4kcTNmbi5wKmen6ZuI8g+DbgiFr0rGc4+cKtSoHlyxcXF9PT05K6e75x27ZNs6aaFrOnxeNz7dNPza7GiPshTLNJQJdVNFM09c65aqYF3xcXF8vLy46KN9KyF8p946LaVetHpldXwmuT9pMjMza+Bsbt8is1+jbNr0LKPr4t/ysrK9PT06J+G+8Kc9KuE9cCZttbMyeDgyuz0vNHP9sOd/bmW8qiF66eF4b6hrYl+0tLS9/f37bSj7KSE76WB76B796Z+77GM7LuZ8sij+tu0+du1+dmy6cyp3sOlvKGZ4eHh+/v7/////fr5+u3o78q/7b2t56GJ6JZ38aB78aeB8KmD8LGL37eY4bKW4NPQ9PT0/v7+/////////////////////////vv66qeP/MSe/MSe6pRxzLWv6NnV+vr6/v7+////////////////////////////////+Ofj8MOz7LWg5bir8/Pz/Pz8////////////AwAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////////////////f398fHx2dnZycnJy8vLyMjItra2t7e32NjY9fX1/v7+////////////+fn57Ozs4ODgtL60bY5tb4Jveoh8RYlLQpBNeYF6pKSk2NjY+Pj4/////////Pz85eXlu7u7gpmMGJkaKchEMcBMKqtALLhGVO2CR65gc3pzqqqq39/f+vr6////8fLyZbDXPaLYL4ViGsQqKM1EMtZTPN9iQuBoS+l3WvmLPo1KgICAsLCw4uLi/v7+rc/jFbn2JcD/IJ+RMNNJIcY7Isc9Lc9LNthZP95lSul0Ue19Q4NLh4eHv7+/+vr6W7jkFML8NcH8KKWTT+5zH8Q3E7onIcU6Ks5HM9VUPNxhSOhyTux6S4hSvr6+4OrwJr3zGcL7P8f8K6SqSdttOttVGsMsFr4rHcI1KMtDMdRQONtYOs1QUZhW2dnZr9ToJcv9IsX7WNj4S7DUJ5uiLLKaIrJcE7AmE70nF8AqHsAyNMVmR5GMqKio5ubmhMXlM9f/J8r9e9vo17qhuLawgam8S5i/JqtjLdFEIrBEUM+lffT1X6DDo6Oj4+PjaMHoROL/NM/9gdrn+d3G/8mr/8ilvJaLPKeYY9qzh+71lP//mfv7cbnNnqCg4ODgVc/zU+j/RNf+nNjf8r2j98++/97L1burftDtgN/+iOT5heL2ouzwh8zcoqWm4+PjXdn2aPT/Wtr5oez64NO/+dvN/+jd4sKyjdPkjN/1j9/0itjxsubshb3Sq62t6OjocdPxaeb5aOf7ceP6ddj1m9fku+Lnwd/mzvz+xvj+s+v4ruT0xeXsfarDv7+/7u7u7PT7yeX0tOHxhM3rcNXwYtT0XNb2beP8eNz3it32sOv6x+v24vT6jrnT39/f9/f3////////////////////8vj8z+b1c9Duefz/cfX/Zen8aazQscna1OHq+Pj4/v7+////////////////////////////xuP1e8/uct7zcdXuxNbi9PT0/f39////////BAAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA+/v77Ozs2dnZy8vLyMjIwsLCsLCwsrKy19fX9vb2/v7+////////////////////6enps7u0dY12aIFoan9rOn89K5U1d313o6Oj1tbW9fX1/v7+////////////////gbKGRctmPtViNM1SKL5BHbk0G8UyJI0uc3lzoKCgy8vL4+Pj7+/v+Pj4/f39////S89uW/yOTvF9PedqLtVOIsg8GL4tDrggHIUgenhyjIyMo6Ojubm5zc3N4ODg8fHxZuiNdveiYNd6a9F2QtBiLdFMFcAsF8k4HL88u7aI0J6Mq4x+koN9i4uLpaWl0dHRmO+2HaItcpZC/62Xl6lqHMdFQNJhZMFopcKN/+vb/+7c/+bT+dK73aGHrYt/v7+/gdmYPrpQpbN4/+zl06yDlK5u3MCX/tbE//fz//ry//Lo/uDP/tfA+syxu5OEyMjI0OTSbMR9y8ej//r1/+ze/+HUyLm/lqrB+O7m9OHZ/NbE/+HP/+zc8ci0r5+Y19fX////6e7n5trI//jx2tDPd6fJQKXgP6fiZqHJWZrGqbK9//bm//fs2rCdsaWg4+Pj/////OHZ8dnSlLjOXLfjVsX4Xsf4XMX2UsD3Tb/4Uarc1c3N///4y6GRurOx7e3t/////fbzhavFT7nnZcnxZMXtZcfwZMfxYcXxYcXyWsn5d7bY+OTbwqedzs7O9vb2////////6/L2abTYb8vre9r2c9Lxb83vbMzvasrvZ8jvV8Dtl6q70buz6+vr/f39////////////6fL3crfYedPtiOX4huP4hOL5geD4cM3sVabOpLjH7+/v/Pz8////////////////////6/P4drvZg9vtk+35i+X1b8Tib6HA1dvf+Pj4/v7+////////////////////////////6vL3erzYgNXna7PRnrjJ7Ozs/Pz8////////////////////////////////////////0ePujbnVxNfj9fX1/f39////////////////////BQAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA////+fn54+PjxcXFr6+vpKSkpaWlsrKyv7+/u7u7qqqqoaGho6OjtLS02NjY9vb2/Pz84+PjwZiNv4VwyYVrx4xyso98knJpl29lu11ExmhNxnNZuGtWhnh1qamp4ODg9PLx14t19KB7+riS+8Ga/+O7+ty15H9b3Fg16HhU+6WA/aR+/Jp2wWtShYSEwsLC6MO57YFd8KJ9+ryW8qaA/dCq8beR4mtH6nVR+a6I8JFt4WdE9I5q+ZVxlmtfrKys57Gf6YBb65Zx97aQ7ZZx+8qj7a2H5GlG9JFs/cag6Yhj6HFO631a+p14vG5Yo6Oj5a6c53tW6o5q9a+J54Ne+MCZ6qJ9739b+6mE/NKs/ceh9aB764Rg8o5qx3ZcpaWl5Kua5XVQ6Ilk9KuF4GxJ87SO6Zt37o5p/cWe/d+4/dCq+LiS86yG7pdzxXBWsbGx5KiX5nZS43lV8Z143WM/6JJs5Y5q5oRf/uG6/uvE/d62/dCq8amE76WAuntmyMjI4aKR53ZS53dT75Zy9rqV9s6o77mU6Jdy/vHJ//3V/u/I/d63+MOd9KuGvJ2U5ubm4aOS8IVh/bGM+rWQ+biS+8ag/+C5+sym9LmT/daw//nR//rT/dy21ZmF4+Pj+vr65JmC+K6J5oBc425J6G5M8YFd9Ypm8Ypm9pp2z3JVxYh03aaR6MK08fHx+/v7////6KqP5X9b1kon31876HBP8YVh9Ytn5WpH7HxXsW1asLCw6+vr////////////////6qaM+JZy4GE+3l065GdF7XlV8IJe6n1Z+Z14vXVgwsLC8vLy////////////////7LWh/a6J+ZVx8Y1p741o8Zp1+LOM/baR+6WAw5KE4+Pj+/v7////////////////+/Px7LGY+aeD+qB7/76Y/9Ks/smi+K6K2ZaD5ePj+fn5////////////////////////////9NbL8ce07K6U5qSM5rel6c/H9vb2/f39////////////////////////BgAAAGx0AAA2AwAAQk02AwAAAAAAADYAAAAoAAAAEAAAABAAAAABABgAAAAAAAADAAAAAAAAAAAAAAAAAAAAAAAA/////f395ubmuLi4nZ2do6OjtbW1yMjI2dnZ5eXl8PDw+Pj4/f39////////////////9PT04LSe7bSUzKCHspB9koV9jImGlZWVp6enu7u7zc3N3d3d6+vr+Pj4/v7+/v7+59HI9cKq/////vj1/ObZ+tbA5byiyJyCpoR1kIJ8jIqJmpqaubm54+Pj+/v7+vr6462Y/fPu//Pv/uff/////////u/q+7ed+q+S96eH3pl9wpF6oJuZ19fX+vr68enm7LGb//////fy/NLC/Mq4/NDB+7ih+7GX+7ii+7ig+7mj+8Cev7Sr5eXl/f395r+x9tDC//n1/dvN/vDq//r2//Dq/7ie/KaH+qWH+7qj+9XFyquX0dDP+Pj4////4qWR+uHX//rz/t7Q/M28/Mu59sOw3p6H+7ad/8Om/+jf676ks6yo5+fn/v7+////4JeA/vHo/uHR/dfG/ure//nx0b+2Qk5hdqbYgLnt8OHbyJd8u7u77+/v/////7X1y7rgkGvuiGTBn2Hf8MP/5866hXLNzc34+Pj3+PhSt+Ubyf9E0vlo5Pfl3cXz6NLUu6tOlc6EdXFVklOI04jlv66ZjovX19f8/PzR4+4wxvcnz/9X1vTCzr386d391cOqj4YngsIlSmEkZ6LUw7ShsLWPkpTU1NT6+vqo0eg61v401P9n2vLw2b/67eTvuaPym3rTmIGjcl16amz0zLePy9KAk57S0tL5+fmFyehQ5P9J3P6H4vLw07v/8+r449f70r3/yaz/xqr/vaDk08GP1eGDlqLU1NT6+vp4zO1n8v9c4fyi8fza3c763cv/6Nnl0L2+zsywwcfD09O519ma1uSJm6Xa2tr8/PyBz+907/tp6vxy3veB4Pig5vTK7e3D6+6y9f+19P+o6vyx4e6h0uOqs7jm5ub+/v7v9/vZ7PfH5vOt2vCg2u+Azexiye9w3fmD6/uI5vqQ4Pe+3e2bxd7c3t/19fX////////////////////////////1+v140O98//9z+v9X1PObs8PM2+X6+vr+/v7////////////////////////////////K5/aI1O902fGNx+Tt7e36+vr///////////8MAAAAbHQAADYDAABCTTYDAAAAAAAANgAAACgAAAAQAAAAEAAAAAEAGAAAAAAAAAMAAAAAAAAAAAAAAAAAAAAAAAD////////////////////////////////8/Pzy8vLn5+fm5ubx8fH8/Pz////////////////+/v77+/v6+vr9/f3////+/v7s7OzGxsapqamnp6fCwsLn5+f7+/v////////////29vbg4ODT09Pd3d3t7e3x8fGVlJVaUFNjTVFfW1yKioq4uLjj4+P6+vr////9/f3R2uCPqLeNkJKbm5u2trapp6cuKC2VgHLLspx5UFdbVFeIiIi+vr7v7+/////v8fNHruAawfsuqdpOi6hxgIlYZ3FfQzn/zKT/7sTYwqmWZmlyYWS7u7vu7u7///+01OcTuPcsy/wv1/8w0/410PUtbYpFKyTKkHT/2K7CrJR1UFNwX2HZ2dn4+Pj9/f1nvOUUxf8/zfhL4v9J4P9M7v80gpNFLCdHNzSAZlhMODpTUVadnZ3d3d38/Pzu8/U1vO8cyf5G0Pdd6PpZ7P9i/f87g5OcZFDfl3ZXOTMyRkxMnbyIjI7Nzc339/fE3OwvzPslzf9X0fG9uqeVvrl93dtHfoiicV//w5bFeFxOeHt19f5xjp/IyMj19fWa0eo/2f401P9p1vD/17v/xqj2yKuHcWl7XVbwt5Kxc1lWjpOR8vJ0kaLJycn19fWDyOdR5f9I3v+H3O3vv6fxy7r/2MCfgXtsS01tUE1KMy9ZhYyl7O10kaLKysr19fV0zu5q9v9Y4v2L3vXewKr21cXh1c+NaGvswKHgq4xNNTNcg5Kq5Ox2k6TMzMz39/eJ0e9u5fhr6/xt3vh+4feQoqepaWvZqpr/8cbksZNlSEicw83B6O+GorTa2tr6+vr5/P7e8Pi02/Ch3/J2zexTmbRzip2MhIqXfXhubHF2orfY8fe+3u2/zNXu7u7+/v7////////////////////3/P7k8/pmxOZ26u118/ln6f+Irsa30OHz9PX8/Pz////////////////////////////////M5/eV2/J41/CN0Ons7Oz6+vr///////////8=" /> + + PROCEDURE outlook2003bar1.Panes.Pane1.Olecontrol1.Init + With This + .Imagelist = .Parent.oleControl2 + With .Nodes + Local laNos[12,3] + Store Null To laNos + laNos[1,1] = "Datele contractului" + laNos[2,1] = "Caixa de entrada" + laNos[3,1] = "Caixa de saída" + laNos[4,1] = "Itens enviados" + laNos[5,1] = "Itens excluídos" + laNos[6,1] = "Rascunhos" + laNos[7,1] = "Obiectul si valoarea contractului" + laNos[8,1] = "Termene de facturare si achitare" + laNos[9,1] = "Jogos" + laNos[10,1] = "Músicas" + laNos[11,1] = "Fotos" + laNos[12,1] = "Vídeos" + *!* Store laNos[1,1] To laNos[2,2], laNos[3,2], laNos[4,2], laNos[5,2], laNos[6,2] + *!* Store 4 To laNos[2,3], laNos[3,3], laNos[4,3], laNos[5,3], laNos[6,3] + *!* Local lnNo + *!* For lnNo=1 To Alen(laNos,1) + *!* .Add(laNos[lnNo,2],laNos[lnNo,3],laNos[lnNo,1],laNos[lnNo,1],laNos[lnNo,1]) + *!* Endfor + ENDWITH + + *!* Local loNo + *!* loNo = .Nodes(0) + *!* loNo.Expanded = .T. + *!* .SelectedItem = loNo + *!* loNo = Null + Endwith + ENDPROC + + PROCEDURE outlook2003bar1.Panes.Pane1.Olecontrol1.NodeClick + *** ActiveX Control Event *** + LPARAMETERS node + LOCAL TX + TX = THIS.SelectedItem.TEXT + aMESSAGEBOX(tx) + ENDPROC + +ENDDEFINE + +DEFINE CLASS ct_part_nr_data AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="cmdDenumire" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtClient" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtNumar" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_ctr" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command2" UniqueID="" Timestamp="" /> + + * + *m: blocheaza_campuri + *m: deblocheaza_campuri + *p: llock + * + + * + BackColor = 197,214,254 + Height = 55 + llock = .T. + Name = "ct_part_nr_data" + Width = 614 + * + + ADD OBJECT 'cmdDenumire' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + Height = 22, ; + Left = 532, ; + Name = "cmdDenumire", ; + Picture = ..\grafice\find.bmp, ; + TabIndex = 2, ; + Top = 5, ; + Width = 29 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Command2' AS commandbutton WITH ; + Anchor = 3, ; + Caption = "Modifica", ; + FontBold = .T., ; + ForeColor = 0,0,255, ; + Height = 47, ; + Left = 9, ; + Name = "Command2", ; + Picture = ..\comun\grafice\lock.bmp, ; + TabIndex = 1, ; + Top = 3, ; + Width = 131 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Label3' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Partener", ; + FontBold = .T., ; + Height = 17, ; + Left = 170, ; + Name = "Label3", ; + TabIndex = 6, ; + Top = 8, ; + Width = 52 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nr. doc.", ; + FontBold = .T., ; + Height = 17, ; + Left = 170, ; + Name = "Label4", ; + TabIndex = 7, ; + Top = 31, ; + Width = 45 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data doc.", ; + FontBold = .T., ; + Height = 17, ; + Left = 380, ; + Name = "Label9", ; + TabIndex = 8, ; + Top = 31, ; + Width = 55 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'txtClient' AS textbox WITH ; + ControlSource = "goRegistratura.denumire", ; + Height = 21, ; + Left = 241, ; + Name = "txtClient", ; + ReadOnly = .T., ; + TabIndex = 5, ; + TabStop = .F., ; + Top = 6, ; + Width = 289 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData_ctr' AS textbox WITH ; + ControlSource = "goRegistratura.data", ; + Height = 21, ; + Left = 442, ; + Name = "txtData_ctr", ; + ReadOnly = .T., ; + TabIndex = 4, ; + Top = 29, ; + Width = 119 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtNumar' AS textbox WITH ; + ControlSource = "goRegistratura.numar", ; + Format = "k", ; + Height = 21, ; + Left = 241, ; + Name = "txtNumar", ; + ReadOnly = .T., ; + TabIndex = 3, ; + Top = 29, ; + Width = 113 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE blocheaza_campuri + this.cmdDenumire.Enabled = .F. + this.txtNumar.ReadOnly = .T. + this.txtData_ctr.ReadOnly = .T. + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.cmdDenumire.Enabled = .T. + this.txtNumar.ReadOnly = .F. + this.txtData_ctr.ReadOnly = .F. + ENDPROC + + PROCEDURE cmdDenumire.Click + LOCAL lcIdTipPart, lcTitlu + STORE '' TO lcIdTipPart, lcTitlu + + *!* DO CASE + *!* CASE gnParametru_prog = 1 && contracte clienti + *!* lcIdTipPart = [-1] + *!* lcTitlu = 'Clienti' + *!* lcLista = ['4111'] + *!* lcContul = '4111' + *!* CASE gnParametru_prog = 2 && contracte furnizori + *!* lcIdTipPart = [-2] + *!* lcTitlu = 'Furnizori' + *!* lcLista = ['401','404'] + *!* lcContul = '401' + *!* ENDCASE + + lcTitlu = 'Parteneri' + lnIdTipPart = 0 && GetContIdTipPart(lcContul) + + * locauta = CautPartenerContabilitate(GetHash([cTitlu=>] + lcTitlu + [??lAdaugCorespondente=>1??cTipuriParteneri=>] + ALLTRIM(STR(lnIdTipPart)))) + locauta = CautPartenerContabilitate(GetHash([cTitlu=>] + lcTitlu )) + + IF buton = 2 + RETURN + ENDIF + + goRegistratura.id_part = loCauta.id_part + goRegistratura.denumire = loCauta.denumire + THIS.PARENT.txtClient.REFRESH + + + ENDPROC + + PROCEDURE Command2.Click + If This.Parent.lLock + AMESSAGEBOX('Toate modificarile au efect imediat! Nu puteti da renuntare!',0+48,'Atentie') + + This.Picture = 'unlock.bmp' + This.Parent.lLock = .F. + This.Caption = 'Salveaza' + This.Parent.deblocheaza_campuri() + + ****** + If Type('podg_dg.but_termin1') <> 'U' + podg_dg.deblocheaza_campuri() + Endif + If Type('podg_referinte.but_termin1') <> 'U' + podg_referinte.deblocheaza_campuri() + ENDIF + If Type('podg_obs.but_termin1') <> 'U' + podg_obs.deblocheaza_campuri() + Endif + If Type('podg_link.but_termin1') <> 'U' + podg_link.deblocheaza_campuri() + Endif + + ****** + Else + This.Picture = 'lock.bmp' + This.Parent.lLock = .T. + This.Caption = 'Modifica' + This.Parent.blocheaza_campuri() + + If Isnull(goRegistratura.id_part) + AMESSAGEBOX('Alegeti partenerul!',48,'Atentie') + This.Parent.cmdDenumire.SetFocus() + Return + Endif + Do modifica_reg_dg With goRegistratura In oproceduri_roaregistratura.prg + + If Type('podg_dg.but_termin1') <> 'U' + podg_dg.blocheaza_campuri() + Endif + If Type('podg_referinte.but_termin1') <> 'U' + podg_referinte.blocheaza_campuri() + ENDIF + If Type('podg_obs.but_termin1') <> 'U' + podg_obs.blocheaza_campuri() + Endif + If Type('podg_link.but_termin1') <> 'U' + podg_link.blocheaza_campuri() + Endif + Endif + + + + + + ENDPROC + + PROCEDURE Command2.Refresh + IF THIS.PARENT.lLock + THIS.PICTURE = 'lock.bmp' + THIS.CAPTION = 'Modifica' + ELSE + THIS.PICTURE = 'unlock.bmp' + THIS.CAPTION = 'Salveaza' + ENDIF + + + + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS ct_registratura AS _ctfrmbase OF "..\comun\clase\_ct_base.vcx" + *< CLASSDATA: Baseclass="container" 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="grid_registratura" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNume.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNume.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNr_ctr.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNr_ctr.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cData_ctr.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cData_ctr.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cDescriere.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cDescriere.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNumar_intern.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNumar_intern.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cData_intern.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cData_intern.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cIE.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cIE.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cFel_document.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cFel_document.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cAvizat.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cAvizat.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cPers_contact.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cPers_contact.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cMediu_transmisie.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cMediu_transmisie.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column12.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column12.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column13.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column13.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column14.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column14.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column15.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column15.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column16.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column16.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column17.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column17.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cAre_obs.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cAre_obs.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNresp.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNresp.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNr_pag.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.cNr_pag.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column22.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column22.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column23.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column23.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column23.Command1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_registratura.Column23.Command2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_data" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_listare1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_excel1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_nume" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_numar" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_reset1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_tipdoc" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_lbbase1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_sters" UniqueID="" Timestamp="" /> + + * + *m: arata_linkuri + *m: do_initializeaza_cursor + *p: nireg + * + + * + BackColor = 255,255,255 + cgridsortlist = grid_registratura + Height = 362 + Name = "ct_registratura" + nireg = 0 + Width = 800 + Gridsort1.Left = 528 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 48 + _ct_controller_keypress1.Name = "_ct_controller_keypress1" + * + + ADD OBJECT '_lbbase1' AS _lbbase WITH ; + Caption = "Lista documentelor", ; + ForeColor = 0,0,0, ; + Left = 8, ; + Name = "_lbbase1", ; + Top = 7 + *< END OBJECT: ClassLib="..\comun\clase\_lb_base.vcx" BaseClass="label" /> + + ADD OBJECT '_shape1' AS _shape WITH ; + Anchor = 11, ; + BackColor = 197,214,254, ; + BorderColor = 197,214,254, ; + Height = 24, ; + Left = 0, ; + Name = "_shape1", ; + Top = 0, ; + Width = 804, ; + ZOrderSet = 0 + *< END OBJECT: ClassLib="..\comun\clase\_baza.vcx" BaseClass="shape" /> + + ADD OBJECT 'But_excel1' AS but_excel WITH ; + Anchor = 9, ; + Left = 769, ; + Name = "But_excel1", ; + TabIndex = 12, ; + Top = -1, ; + Visible = .T., ; + ZOrderSet = 9 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_listare1' AS but_listare WITH ; + Anchor = 9, ; + Left = 741, ; + Name = "But_listare1", ; + TabIndex = 11, ; + Top = -1, ; + Visible = .T., ; + ZOrderSet = 8 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 9, ; + Left = 684, ; + Name = "But_nou1", ; + Picture = ..\comun\grafice\nou_sus.bmp, ; + TabIndex = 9, ; + ToolTipText = "Adaugare contract (CTRL+N)", ; + Top = -1, ; + ZOrderSet = 5 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 9, ; + Left = 713, ; + Name = "But_sterge1", ; + TabIndex = 10, ; + Top = -1, ; + Visible = .T., ; + ZOrderSet = 6 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Ck_data' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = data, ; + Caption = "Data doc.", ; + FontName = "Arial Narrow", ; + Left = 93, ; + Name = "Ck_data", ; + TabIndex = 4, ; + tip = D, ; + Top = 46, ; + ZOrderSet = 4 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_numar' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = numar, ; + Caption = "Nr.doc.", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 93, ; + Name = "Ck_numar", ; + TabIndex = 3, ; + Top = 32, ; + ZOrderSet = 11 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_nume' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = denumire, ; + Caption = "Partener", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 8, ; + Name = "Ck_nume", ; + TabIndex = 1, ; + Top = 32, ; + ZOrderSet = 10 + *< END OBJECT: ClassLib="..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'ck_sters' AS _checkbox WITH ; + Alignment = 0, ; + Anchor = 3, ; + Caption = "Sterse", ; + FontName = "Arial Narrow", ; + ForeColor = 255,0,0, ; + Left = 171, ; + Name = "ck_sters", ; + TabIndex = 5, ; + Top = 32 + *< END OBJECT: ClassLib="..\comun\clase\_baza.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_tipdoc' AS ck_filtru_text WITH ; + Alignment = 0, ; + Anchor = 3, ; + AutoSize = .T., ; + camp_nume = fel_document, ; + Caption = "Tip document", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 8, ; + Name = "Ck_tipdoc", ; + TabIndex = 2, ; + Top = 46, ; + ZOrderSet = 15 + *< END OBJECT: ClassLib="..\..\roacont\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Anchor = 12, ; + Height = 27, ; + Left = 632, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 13, ; + Top = 328, ; + Width = 153, ; + ZOrderSet = 7, ; + Text_simplu1.ControlSource = "this.parent.parent.nIreg", ; + Text_simplu1.Height = 21, ; + Text_simplu1.Left = 76, ; + Text_simplu1.Name = "Text_simplu1", ; + Text_simplu1.ReadOnly = .T., ; + Text_simplu1.Top = 3, ; + Text_simplu1.Width = 72, ; + LB_SIMPLU1.Caption = "Inregistrari", ; + LB_SIMPLU1.Name = "LB_SIMPLU1" + *< END OBJECT: ClassLib="..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Anchor = 9, ; + Comment = "*:OnResize=LT", ; + Left = 608, ; + Name = "Cmd_cauta1", ; + TabIndex = 6, ; + Top = 35, ; + Width = 67, ; + ZOrderSet = 13 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_reset1' AS cmd_reset WITH ; + Anchor = 9, ; + Comment = "*:OnResize=LT", ; + Left = 679, ; + Name = "Cmd_reset1", ; + TabIndex = 8, ; + Top = 35, ; + Width = 67, ; + ZOrderSet = 12 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_registratura' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 22, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + GridLineColor = 192,192,192, ; + HeaderHeight = 38, ; + Height = 258, ; + HighlightStyle = 2, ; + Left = 8, ; + Name = "grid_registratura", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "cRegistratura", ; + TabIndex = 7, ; + Top = 66, ; + Width = 784, ; + ZOrderSet = 3, ; + Column1.ColumnOrder = 7, ; + Column1.ControlSource = "denumire", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "cNume", ; + Column1.ReadOnly = .T., ; + Column1.Width = 193, ; + Column2.ColumnOrder = 5, ; + Column2.ControlSource = "numar", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cNr_ctr", ; + Column2.ReadOnly = .T., ; + Column2.Width = 48, ; + Column3.ColumnOrder = 6, ; + Column3.ControlSource = "data", ; + Column3.FontName = "Arial Narrow", ; + Column3.Format = "d", ; + Column3.Name = "cData_ctr", ; + Column3.ReadOnly = .T., ; + Column3.Width = 51, ; + Column4.ColumnOrder = 10, ; + Column4.ControlSource = "descriere", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "cDescriere", ; + Column4.ReadOnly = .T., ; + Column5.ColumnOrder = 3, ; + Column5.ControlSource = "numar_intern", ; + Column5.FontName = "Arial Narrow", ; + Column5.Name = "cNumar_intern", ; + Column5.ReadOnly = .T., ; + Column5.Width = 45, ; + Column6.ColumnOrder = 4, ; + Column6.ControlSource = "data_intern", ; + Column6.FontName = "Arial Narrow", ; + Column6.Name = "cData_intern", ; + Column6.ReadOnly = .T., ; + Column6.Width = 51, ; + Column7.ColumnOrder = 2, ; + Column7.ControlSource = "iif(ie=1,'Intrare',iif(ie=2,'Iesire',''))", ; + Column7.FontName = "Arial Narrow", ; + Column7.Name = "cIE", ; + Column7.ReadOnly = .T., ; + Column7.Width = 59, ; + Column8.ColumnOrder = 12, ; + Column8.ControlSource = "fel_document", ; + Column8.FontName = "Arial Narrow", ; + Column8.Name = "cFel_document", ; + Column8.ReadOnly = .T., ; + Column8.Width = 67, ; + Column9.Alignment = 2, ; + Column9.ColumnOrder = 18, ; + Column9.ControlSource = "avizat", ; + Column9.FontName = "Arial Narrow", ; + Column9.Name = "cAvizat", ; + Column9.ReadOnly = .T., ; + Column9.Sparse = .F., ; + Column9.Width = 41, ; + Column10.ColumnOrder = 8, ; + Column10.ControlSource = "pers_contact", ; + Column10.FontName = "Arial Narrow", ; + Column10.Name = "cPers_contact", ; + Column10.ReadOnly = .T., ; + Column10.Width = 80, ; + Column11.ColumnOrder = 11, ; + Column11.ControlSource = "mediu_transmisie", ; + Column11.FontName = "Arial Narrow", ; + Column11.Name = "cMediu_transmisie", ; + Column11.ReadOnly = .T., ; + Column12.ColumnOrder = 14, ; + Column12.ControlSource = "util", ; + Column12.FontName = "Arial Narrow", ; + Column12.Name = "Column12", ; + Column12.ReadOnly = .T., ; + Column13.ColumnOrder = 15, ; + Column13.ControlSource = "dataora", ; + Column13.FontName = "Arial Narrow", ; + Column13.Name = "Column13", ; + Column13.ReadOnly = .T., ; + Column14.ColumnOrder = 16, ; + Column14.ControlSource = "utils", ; + Column14.FontName = "Arial Narrow", ; + Column14.Name = "Column14", ; + Column14.ReadOnly = .T., ; + Column15.ColumnOrder = 17, ; + Column15.ControlSource = "dataoras", ; + Column15.FontName = "Arial Narrow", ; + Column15.Name = "Column15", ; + Column15.ReadOnly = .T., ; + Column16.ColumnOrder = 19, ; + Column16.ControlSource = "util_avizat", ; + Column16.FontName = "Arial Narrow", ; + Column16.Name = "Column16", ; + Column16.ReadOnly = .T., ; + Column17.ColumnOrder = 20, ; + Column17.ControlSource = "dataora_avizat", ; + Column17.FontName = "Arial Narrow", ; + Column17.Name = "Column17", ; + Column17.ReadOnly = .T., ; + Column18.ColumnOrder = 21, ; + Column18.ControlSource = "are_obs", ; + Column18.FontName = "Arial Narrow", ; + Column18.Name = "cAre_obs", ; + Column18.ReadOnly = .T., ; + Column18.Sparse = .F., ; + Column19.ColumnOrder = 9, ; + Column19.ControlSource = "nresp", ; + Column19.FontName = "Arial Narrow", ; + Column19.Name = "cNresp", ; + Column19.ReadOnly = .T., ; + Column19.Width = 83, ; + Column20.ColumnOrder = 13, ; + Column20.ControlSource = "nr_pag", ; + Column20.FontName = "Arial Narrow", ; + Column20.Name = "cNr_pag", ; + Column20.ReadOnly = .T., ; + Column20.Width = 39, ; + Column21.ColumnOrder = 22, ; + Column21.ControlSource = "proiect", ; + Column21.FontName = "Arial Narrow", ; + Column21.Name = "Column22", ; + Column21.ReadOnly = .T., ; + Column22.ColumnOrder = 1, ; + Column22.ControlSource = "are_link", ; + Column22.CurrentControl = "Command1", ; + Column22.DynamicCurrentControl = "iif(are_link=1,'command1','command2')", ; + Column22.FontName = "Arial Narrow", ; + Column22.Name = "Column23", ; + Column22.ReadOnly = .T., ; + Column22.Sparse = .F., ; + Column22.Width = 47 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_registratura.cAre_obs.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + FontName = "Arial Narrow", ; + Height = 17, ; + Left = 37, ; + Name = "Check1", ; + Top = 48, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'grid_registratura.cAre_obs.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Observatii", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + Picture = ..\grafice\wzedit.bmp + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cAvizat.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + FontName = "Arial Narrow", ; + Height = 17, ; + Left = 54, ; + Name = "Check1", ; + Top = 60, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'grid_registratura.cAvizat.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Avizat", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cData_ctr.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data doc.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cData_ctr.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cData_intern.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data inreg.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cData_intern.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cDescriere.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Descriere", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cDescriere.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cFel_document.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Fel document", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cFel_document.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cIE.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Intrare/Iesire", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cIE.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cMediu_transmisie.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Mediu tr./rec.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cMediu_transmisie.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNr_ctr.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. doc.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNr_ctr.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNr_pag.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. pag.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNr_pag.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNresp.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Responsabil", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNresp.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNumar_intern.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. inreg.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNumar_intern.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cNume.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Partener", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cNume.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column12.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Utilizator", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column12.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column13.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Dataora", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column13.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column14.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Utilizator stergere", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column14.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column15.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Dataora stergerii", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column15.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column16.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Utilzator avizare", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column16.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column17.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Dataora avizarii ", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column17.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column22.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Proiect", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column22.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.Column23.Command1' AS commandbutton WITH ; + Caption = "", ; + Height = 27, ; + Left = 15, ; + Name = "Command1", ; + Picture = ..\comun\grafice\attach_mic.bmp, ; + SpecialEffect = 1, ; + Top = 77, ; + Width = 84 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'grid_registratura.Column23.Command2' AS commandbutton WITH ; + Caption = "", ; + Height = 27, ; + Left = 27, ; + Name = "Command2", ; + SpecialEffect = 1, ; + Top = 125, ; + Width = 84 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'grid_registratura.Column23.Header1' AS header WITH ; + Caption = "Link", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + Picture = ..\comun\grafice\attach_mic.bmp + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.Column23.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_registratura.cPers_contact.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Persoana contact a partenerului", ; + FontName = "Arial Narrow", ; + Name = "Header1", ; + WordWrap = .T. + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_registratura.cPers_contact.Text1' AS textbox WITH ; + Alignment = 3, ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + + LOCAL lcFiltru + lcFiltru = pcFiltru + IF EMPTY(lcFiltru) + lcFiltru = poReg.ca_baza1.cfiltru + ENDIF + + save_grid_tag(THIS.grid_registratura) + poReg.ca_baza1.cfiltru = lcFiltru + poReg.ca_baza1.afisare() + + SELECT cRegistratura + IF RECCOUNT()>0 + THIS.nireg = RECCOUNT() + ELSE + THIS.nireg = 0 + ENDIF + + restore_grid_tag(THIS.grid_registratura) + IF RECCOUNT('cRegistratura')>0 + SELECT cRegistratura + LOCATE FOR id_reg = goRegistratura.id_reg + IF !FOUND() + GO TOP + ENDIF + + THIS.grid_registratura.SETFOCUS() + ENDIF + + THIS.clb_tx_simplu1.text_simplu1.REFRESH + + ENDPROC + + PROCEDURE arata_linkuri + DO arata_linkuri IN oproceduri_atasamente.prg + + ENDPROC + + PROCEDURE do_adauga + Local lcAlias, lnId_reg + lcAlias = This.grid_registratura.RecordSource + Store 0 To lnId_ctr + + Local loGeneratorNumere + loGeneratorNumere = Createobject('oGeneratorNumere') + loGeneratorNumere.creeaza_cursor_serii(10) + ** numar intern ^ + lnId_reg = adauga_registratura(lcAlias, Alltrim(Str(loGeneratorNumere.aloca_numar(10)))) + + This.actualizeaza_grid1() + + + Select (lcAlias) + Locate For id_reg = lnId_reg + If Found() + This.grid_registratura.SetFocus() + + This.Parent.Parent.ActivePage = 3 + Endif + Release loGeneratorNumere + + ***-------------------------- + + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru = "" + + If This.ck_nume.Value = 1 + lcFiltru = lcFiltru + This.ck_nume.filtru + Endif + + If This.ck_numar.Value = 1 + lcFiltru = lcFiltru + This.ck_numar.filtru + Endif + + If This.ck_data.Value = 1 + lcFiltru = lcFiltru + This.ck_data.filtru + ENDIF + + * fel document + IF this.ck_tipdoc.Value = 1 + lcFiltru = lcFiltru + this.ck_tipDoc.filtru + ENDIF + + *!* If !Empty(lcFiltru) + *!* lcFiltru = Substr(lcFiltru,6) + *!* Else + *!* lcFiltru = [1=1] + *!* ENDIF + + * inregistrari sterse + IF this.ck_sters.Value = 1 + lcFiltru = [ 2=2] + lcFiltru + ELSE + lcFiltru = [ STERS=0] + lcFiltru + ENDIF + + + + This.actualizeaza_grid1(lcFiltru) + If Reccount('cRegistratura')=0 + aMessagebox("Cautarea nu a intors rezultate!",0+48,"Info cautare") + + Select cRegistratura + Scatter Name goRegistratura Memo Blank + ENDIF + + This.grid_registratura.SetFocus() + + ENDPROC + + PROCEDURE do_initializeaza_cursor + Do viz_registratura In oproceduri_roaregistratura.prg + Select cRegistratura + Go Top + Scatter Name goRegistratura Blank + Select cRegistratura + If Reccount()>0 + This.nireg = Reccount() + Else + This.nireg = 0 + Endif + This.clb_tx_simplu1.text_simplu1.Refresh + ENDPROC + + PROCEDURE do_reset + With This + For i=1 To .Objects.Count + If Upper(.Objects(i).BaseClass)='CHECKBOX' + .Objects(i).Value=0 + Endif + Endfor + ENDWITH + + *!* this.optIncetat.Value=1 + *!* this.optInactiv.Value=1 + + this.ck_nume.SetFocus() + + ENDPROC + + PROCEDURE inainte_de_do_excel + DO export_excel_grid WITH this.grid_registratura + + + ENDPROC + + PROCEDURE inainte_de_do_listare + *!* modificare v 2.0.3 + *!* *Thisform.AlwaysOnTop = .F. + *!* Private pcDataOra, pcTitlu + *!* pcDataOra = get_ora(2) + *!* pcTitlu = "Lista documentelor" + *!* Local lcTabel + *!* lcTabel = This.grid_registratura.RecordSource + *!* Select (lcTabel) + *!* Report Form rRegistratura.frx To Printer Prompt Preview + *!* *Thisform.AlwaysOnTop = .T. + Thisform.AlwaysOnTop = .F. + goExport.export2frx(This.grid_registratura.RecordSource,[rRegistratura]) + Thisform.AlwaysOnTop = .T. + *!* modificare v 2.0.3 ^ + ENDPROC + + PROCEDURE inainte_de_do_sterge + PRIVATE pnId_ctr, pnTip + + LOCAL lnRaspuns, lcSql, lnSucces, lcId, lcId_util + STORE 0 TO lnRaspuns, lnSucces + STORE '' TO lcSql + + IF !EMPTY(goRegistratura.id_reg) + lnRaspuns = amessagebox('Doriti sa stergeti documentul?',4+32,"Confirmare stergere") + IF lnRaspuns = 7 && 7 = No ; 6 = Yes + RETURN + ENDIF + + lcId = ALLTRIM(STR(goRegistratura.id_reg)) + lcId_util = ALLTRIM(STR(gnIdUtil)) + + lcSql = [begin pack_registratura.sterge_registratura(]+lcId+[,]+lcId_util+[); end;] + lnSucces = goExecutor.oExecute(lcSql) + + IF lnSucces < 0 + AMESSAGEBOX(goExecutor.oprelucrareEroare(),0+16,"Eroare") + RETURN + ENDIF + + THIS.actualizeaza_grid1() + ENDIF + + ENDPROC + + PROCEDURE grid_registratura.AfterRowColChange + LPARAMETERS nColIndex + + LOCAL lcTabel + lcTabel = this.RecordSource + + SELECT (lcTabel) + SCATTER NAME goRegistratura MEMO + ENDPROC + + PROCEDURE grid_registratura.Column23.Command1.Click + this.Parent.Parent.Parent.arata_linkuri() + ENDPROC + + PROCEDURE grid_registratura.Column23.Command2.Click + this.Parent.Parent.Parent.arata_linkuri() + ENDPROC + + PROCEDURE grid_registratura.Init + DODEFAULT() + + * This.SetAll("DynamicForeColor", "IIF(sters=1, RGB(255,0,0), RGB(0,0,0))", "Column") + + this.Parent.grid_registratura.SetAll("DynamicForeColor", "IIF(sters=1, RGB(255,0,0), RGB(0,0,0))", "Column") + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_actaditional AS _cusodatabase OF "..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_actaditional" + * + + PROCEDURE make_sql + LPARAMETERS toRec,tnId + + lcActiune = ALLTRIM(THIS.cActiune) + lcId_util = ALLTRIM(STR(gnidutil)) + + IF INLIST(lcActiune, "UPDATE",'INSERT') AND TYPE('toRec') != "O" + RETURN .F. + ENDIF + + IF INLIST(lcActiune, "UPDATE",'DELETE') AND TYPE('tnId') != "N" + RETURN .F. + ENDIF + + IF INLIST(lcActiune, "UPDATE",'DELETE') + lcId = ALLTRIM(STR(tnId)) + ENDIF + + IF INLIST(lcActiune, "UPDATE",'INSERT') + lcId_ctr = NVL(ALLTRIM(STR(goContract.id_ctr)),"0") + lcId_part = NVL(ALLTRIM(STR(goContract.id_part)),"0") + lcId_tip_ctr = NVL(ALLTRIM(STR(goContract.id_tip_ctr)),"0") + lcNumar = NVL(ALLTRIM(toRec.numar),"0") + lcData = ALLTRIM(DTOS(toRec.data)) + lcDescriere = NVL(ALLTRIM(toRec.descriere),"") + ENDIF + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin pack_crm.adauga_act_aditional(]+lcId_ctr+ [,]+lcId_part+ [,] + lcId_tip_ctr+[,']+ lcNumar+[',]+; + [to_date(']+lcData+[','YYYYMMDD'),']+lcDescriere+ [',]+lcId_util+[); end;] + + Case lcActiune = "UPDATE" + lcSql = [begin pack_def.modifica_contract(]+lcId+[,']+lcNumar+[',]+; + [to_date(']+lcData+[','YYYYMMDD'),]+lcId_tip_ctr + [,]+lcInactiv+[,]+lcId_util+[); end;] + + Case lcActiune = "DELETE" + lcSql = [begin pack_def.sterge_contract(]+lcId+[,]+lcId_util+[); end;] + ENDCASE + + this.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_selectie AS _cusodatabase OF "..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_selectie" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcId_util = Alltrim(Str(gnIdUtil)) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcSelectie = Strtran(Alltrim(toRec.selectie),['],['']) + ENDIF + + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin PACK_CTR_FURNIZORI.adauga_selectie('] + lcSelectie + [',]+lcId_util+[); end;] + + Case lcActiune = "UPDATE" + lcSql = [begin PACK_CTR_FURNIZORI.modifica_selectie(]+lcId +[,']+lcSelectie+ [',]+ lcId_util+[); end;] + + Case lcActiune = "DELETE" + * lcSql = [begin pack_nomenclatoare.sterge_tip_ctr(]+lcId+[,]+lcId_util+[); end;] + lcSql = [begin PACK_CTR_FURNIZORI.sterge_selectie(]+lcId+ [,]+ lcId_util+[); end;] + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_date_generale AS frm_dg OF "..\comun\clase\ferestre_atasamente.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Shape7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData_intern" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtDescriere" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdNresp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdMedii_transmisie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdPers_contact" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="cmdFel_document" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtNresp" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtMediu_transmisie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtPers_contact" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label17" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtFel_document" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="ck_avizat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtNumar_intern" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="optIE" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtNr_pag" UniqueID="" Timestamp="" /> + + * + *p: llock + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 330 + llock = .F. + Name = "frm_dg_date_generale" + Width = 633 + WindowType = 0 + _shape3.Name = "_shape3" + _shape1.Height = 29 + _shape1.Left = -12 + _shape1.Name = "_shape1" + _shape1.Top = 800 + _shape1.Width = 561 + _shape1.ZOrderSet = 3 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Visible = .F. + _shape2.ZOrderSet = 4 + Lb_titlu_alb_b121.Caption = "Date generale" + Lb_titlu_alb_b121.Left = 8 + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 14 + Lb_titlu_alb_b121.ZOrderSet = 5 + Gridsort1.Left = 132 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 12 + BUT_TERMIN1.Left = 530 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 15 + BUT_TERMIN1.Top = 1000 + BUT_TERMIN1.ZOrderSet = 6 + * + + ADD OBJECT 'ck_avizat' AS checkbox WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Avizat", ; + ControlSource = "goRegistratura.avizat", ; + Height = 17, ; + Left = 8, ; + Name = "ck_avizat", ; + ReadOnly = .T., ; + TabIndex = 10, ; + Top = 223, ; + Width = 48, ; + ZOrderSet = 23 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'cmdFel_document' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 24, ; + Left = 277, ; + Name = "cmdFel_document", ; + Picture = ..\..\roacontracte\grafice\find.bmp, ; + TabIndex = 5, ; + Top = 124, ; + Width = 28, ; + ZOrderSet = 11 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdMedii_transmisie' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 24, ; + Left = 277, ; + Name = "cmdMedii_transmisie", ; + Picture = ..\..\roacontracte\grafice\find.bmp, ; + TabIndex = 9, ; + Top = 199, ; + Width = 28, ; + ZOrderSet = 11 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdNresp' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 24, ; + Left = 277, ; + Name = "cmdNresp", ; + Picture = ..\..\roacontracte\grafice\find.bmp, ; + TabIndex = 8, ; + Top = 174, ; + Width = 28, ; + ZOrderSet = 11 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'cmdPers_contact' AS commandbutton WITH ; + Caption = "", ; + Enabled = .F., ; + FontName = "Arial Narrow", ; + Height = 24, ; + Left = 277, ; + Name = "cmdPers_contact", ; + Picture = ..\..\roacontracte\grafice\find.bmp, ; + TabIndex = 7, ; + Top = 149, ; + Width = 28, ; + ZOrderSet = 11 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'Label1' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Persoana contact", ; + Height = 17, ; + Left = 8, ; + Name = "Label1", ; + TabIndex = 23, ; + Top = 153, ; + Width = 98, ; + ZOrderSet = 15 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label17' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Tip document", ; + Height = 17, ; + Left = 8, ; + Name = "Label17", ; + TabIndex = 22, ; + Top = 128, ; + Width = 77, ; + ZOrderSet = 15 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Mediu transmisie", ; + Height = 17, ; + Left = 8, ; + Name = "Label2", ; + TabIndex = 21, ; + Top = 203, ; + Width = 97, ; + ZOrderSet = 15 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Responsabil", ; + Height = 17, ; + Left = 8, ; + Name = "Label3", ; + TabIndex = 24, ; + Top = 178, ; + Width = 73, ; + ZOrderSet = 15 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Descriere", ; + Height = 17, ; + Left = 15, ; + Name = "Label4", ; + TabIndex = 16, ; + Top = 61, ; + Width = 56, ; + ZOrderSet = 40 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label5' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nr. pagini", ; + Height = 17, ; + Left = 319, ; + Name = "Label5", ; + TabIndex = 12, ; + Top = 128, ; + Width = 55, ; + ZOrderSet = 42 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label6' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nr./data inreg. (intrare-iesire)", ; + Height = 17, ; + Left = 15, ; + Name = "Label6", ; + TabIndex = 11, ; + Top = 38, ; + Width = 160, ; + ZOrderSet = 42 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "/", ; + Height = 17, ; + Left = 317, ; + Name = "Label9", ; + TabIndex = 13, ; + Top = 38, ; + Width = 5, ; + ZOrderSet = 44 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'optIE' AS optiongroup WITH ; + BackStyle = 0, ; + ButtonCount = 2, ; + ControlSource = "goRegistratura.ie", ; + Height = 26, ; + Left = 8, ; + Name = "optIE", ; + TabIndex = 4, ; + Top = 90, ; + Value = 1, ; + Width = 122, ; + Option1.AutoSize = .T., ; + Option1.BackStyle = 0, ; + Option1.Caption = "Intrare", ; + Option1.Height = 17, ; + Option1.Left = 5, ; + Option1.Name = "Option1", ; + Option1.Top = 4, ; + Option1.Value = 1, ; + Option1.Width = 53, ; + Option2.AutoSize = .T., ; + Option2.BackStyle = 0, ; + Option2.Caption = "Iesire", ; + Option2.Height = 17, ; + Option2.Left = 65, ; + Option2.Name = "Option2", ; + Option2.Top = 4, ; + Option2.Width = 49 + *< END OBJECT: BaseClass="optiongroup" /> + + ADD OBJECT 'Shape7' AS shape WITH ; + BackStyle = 0, ; + Height = 52, ; + Left = 8, ; + Name = "Shape7", ; + SpecialEffect = 0, ; + Top = 32, ; + Width = 442, ; + ZOrderSet = 0 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'txtData_intern' AS textbox WITH ; + ControlSource = "goRegistratura.data_intern", ; + Height = 21, ; + Left = 324, ; + Name = "txtData_intern", ; + ReadOnly = .T., ; + TabIndex = 2, ; + Top = 36, ; + Width = 119, ; + ZOrderSet = 45 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtDescriere' AS textbox WITH ; + ControlSource = "goRegistratura.descriere", ; + Height = 21, ; + Left = 122, ; + Name = "txtDescriere", ; + ReadOnly = .T., ; + TabIndex = 3, ; + Top = 59, ; + Width = 321, ; + ZOrderSet = 41 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtFel_document' AS textbox WITH ; + ControlSource = "goRegistratura.fel_document", ; + Height = 21, ; + Left = 131, ; + Name = "txtFel_document", ; + ReadOnly = .T., ; + TabIndex = 18, ; + TabStop = .F., ; + Top = 126, ; + Width = 144, ; + ZOrderSet = 16 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtMediu_transmisie' AS textbox WITH ; + ControlSource = "goRegistratura.mediu_transmisie", ; + Height = 21, ; + Left = 131, ; + Name = "txtMediu_transmisie", ; + ReadOnly = .T., ; + TabIndex = 17, ; + TabStop = .F., ; + Top = 201, ; + Width = 144, ; + ZOrderSet = 16 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtNr_pag' AS textbox WITH ; + ControlSource = "goRegistratura.nr_pag", ; + Format = "k", ; + Height = 21, ; + InputMask = "9999", ; + Left = 377, ; + Name = "txtNr_pag", ; + ReadOnly = .T., ; + TabIndex = 6, ; + Top = 126, ; + Width = 48, ; + ZOrderSet = 43 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtNresp' AS textbox WITH ; + ControlSource = "goRegistratura.nresp", ; + Height = 21, ; + Left = 131, ; + Name = "txtNresp", ; + ReadOnly = .T., ; + TabIndex = 19, ; + TabStop = .F., ; + Top = 176, ; + Width = 144, ; + ZOrderSet = 16 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtNumar_intern' AS textbox WITH ; + ControlSource = "goRegistratura.numar_intern", ; + Format = "k", ; + Height = 21, ; + InputMask = "99999999999999", ; + Left = 200, ; + Name = "txtNumar_intern", ; + ReadOnly = .T., ; + TabIndex = 1, ; + Top = 36, ; + Width = 113, ; + ZOrderSet = 43 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtPers_contact' AS textbox WITH ; + ControlSource = "goRegistratura.pers_contact", ; + Height = 21, ; + Left = 131, ; + Name = "txtPers_contact", ; + ReadOnly = .T., ; + TabIndex = 20, ; + TabStop = .F., ; + Top = 151, ; + Width = 144, ; + ZOrderSet = 16 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE blocheaza_campuri + this.txtDescriere.ReadOnly = .T. + *this.txtnumar_intern.ReadOnly = .T. + this.txtData_intern.ReadOnly = .T. + this.txtNr_pag.ReadOnly = .T. + this.cmdFel_document.Enabled = .F. + this.cmdPers_contact.Enabled = .F. + this.cmdNresp.Enabled = .F. + this.cmdMedii_transmisie.Enabled = .F. + this.ck_avizat.ReadOnly = .T. + this.optIE.Enabled = .F. + this.optIE.option1.Enabled = .F. + this.optIE.option2.Enabled = .F. + + + ENDPROC + + PROCEDURE deblocheaza_campuri + this.txtDescriere.ReadOnly = .F. + *this.txtnumar_intern.ReadOnly = .f. + this.txtData_intern.ReadOnly = .F. + this.txtNr_pag.ReadOnly = .F. + this.cmdFel_document.Enabled = .T. + this.cmdPers_contact.Enabled = .T. + this.cmdNresp.Enabled = .T. + this.cmdMedii_transmisie.Enabled = .T. + this.ck_avizat.ReadOnly = .F. + this.optIE.Enabled = .T. + this.optIE.option1.Enabled = .T. + this.optIE.option2.Enabled = .T. + + + + ENDPROC + + PROCEDURE ck_avizat.Valid + PRIVATE pnValue + pnValue = this.Value + + lcSql = [begin pack_registratura.avizeaza_document(?goRegistratura.id_reg,?pnValue,?gnIdUtil); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return + Endif + ENDPROC + + PROCEDURE cmdFel_document.Click + locauta = caut_fdoc(,.T.) + IF buton=2 + RETURN + ENDIF + + goRegistratura.id_fdoc = locauta.id_fdoc + goRegistratura.fel_document = locauta.fel_document + thisform.txtFel_document.Refresh + + + ENDPROC + + PROCEDURE cmdMedii_transmisie.Click + Local loCauta + Store "" To loCauta + + locauta = caut_mediu_transmisie(,.T.) + If buton=2 + Return + Endif + + goRegistratura.id_mediu = locauta.id_mediu + goRegistratura.mediu_transmisie = locauta.mediu_transmisie + thisform.txtMediu_transmisie.Refresh + + + ENDPROC + + PROCEDURE cmdNresp.Click + Local lcIdTipPart, lcTitlu + Store '' To lcIdTipPart, lcTitlu + + lcIdTipPart = [-11,-41] + lcTitlu = 'Responsabili/Angajati' + + loCauta = CautPartenerContabilitate(GetHash([cTitlu=>] + lcTitlu + [??cTipuriParteneri=>] + lcIdTipPart)) + + If buton = 2 + Return + Endif + + goRegistratura.id_responsabil = loCauta.id_part + goRegistratura.nresp = loCauta.denumire + thisform.txtNresp.Refresh + + + ENDPROC + + PROCEDURE cmdPers_contact.Click + If !Empty(goRegistratura.id_part) And !Isnull(goRegistratura.id_part) + Local loCauta + Store "" To loCauta + + lcSelect = [select id_pers, denumire FROM vpers_contact] + lcFiltru = [1=2] + lcSchema = [] + lcOrder = [denumire ] + lccoloane = [denumire] + lcTitlu = [Alegeti persoana de contact] + lcTitluColoane = [Nume] + lcFiltruOriginal = [id_part=]+Alltrim(Str(goRegistratura.id_part)) + lcNumeProc = [] + llToateIreg = .F. + loCauta = cauta_alfa(lcSelect,lcFiltru,lcSchema,lcOrder,lccoloane,lcTitlu,lcTitluColoane, lcNumeProc, llToateIreg, lcFiltruOriginal) && 11.07.2007 + + If buton=2 + Return + Endif + + goRegistratura.id_pers = loCauta.id_pers + goRegistratura.pers_contact = loCauta.denumire + Thisform.txtPers_contact.Refresh + Endif + + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_observatii AS frm_dg OF "..\comun\clase\ferestre_atasamente.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="edtObservatii" UniqueID="" Timestamp="" /> + + * + BorderStyle = 1 + DoCreate = .T. + Height = 330 + Name = "frm_dg_observatii" + Width = 633 + _shape3.Name = "_shape3" + _shape1.Name = "_shape1" + _shape2.Name = "_shape2" + Lb_titlu_alb_b121.Caption = "Observatii" + Lb_titlu_alb_b121.Left = 8 + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Gridsort1.Left = 233 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 4 + BUT_TERMIN1.Name = "BUT_TERMIN1" + * + + ADD OBJECT 'edtObservatii' AS editbox WITH ; + Anchor = 15, ; + ControlSource = "goRegistratura.observatii", ; + Height = 280, ; + Left = 8, ; + Name = "edtObservatii", ; + ReadOnly = .T., ; + Top = 33, ; + Width = 614 + *< END OBJECT: BaseClass="editbox" /> + + PROCEDURE blocheaza_campuri + this.edtObservatii.ReadOnly = .T. + + ENDPROC + + PROCEDURE deblocheaza_campuri + This.edtObservatii.ReadOnly = .F. + + ENDPROC + + PROCEDURE Init + DODEFAULT() + goRegistratura.observatii = NVL(goRegistratura.observatii,'') + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_dg_referinte AS frm_dg OF "..\comun\clase\ferestre_atasamente.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="grid_referinte" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_referinte.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_referinte.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_referinte.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_referinte.Column2.Text1" UniqueID="" Timestamp="" /> + + * + *m: afisactual + *m: do_modifica_ctr_art + *p: clistaidarticole + *p: cnewvalue + *p: coldvalue + *p: cxmlarticole + *p: ncoef_discount + *p: ndiscountmediu + *p: nsumaarticole + *p: nvalcdiscount + *p: nvaldiscount + * + + * + BorderStyle = 1 + cgridsortlist = grid_referinte + clistaidarticole = + cnewvalue = + coldvalue = + cxmlarticole = + DoCreate = .T. + Height = 446 + Name = "frm_dg_referinte" + ncoef_discount = 0 + ndiscountmediu = 0 + nsumaarticole = 0 + nvalcdiscount = 0 + nvaldiscount = 0 + Width = 633 + _shape3.Name = "_shape3" + _shape1.Name = "_shape1" + _shape2.Anchor = 3 + _shape2.Height = 29 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 66 + Lb_titlu_alb_b121.Caption = "Referinte" + Lb_titlu_alb_b121.Left = 6 + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Gridsort1.Left = 60 + Gridsort1.Name = "Gridsort1" + Gridsort1.Top = 0 + BUT_TERMIN1.Name = "BUT_TERMIN1" + * + + ADD OBJECT 'grid_referinte' AS _grdrow WITH ; + ColumnCount = 2, ; + DeleteMark = .F., ; + Height = 147, ; + Left = 6, ; + Name = "grid_referinte", ; + Panel = 1, ; + RecordSource = "cRegReferinte", ; + Top = 33, ; + Width = 263, ; + Column1.ControlSource = "unde", ; + Column1.Name = "Column1", ; + Column1.Width = 161, ; + Column2.ControlSource = "nr_aparitii", ; + Column2.Format = "rk", ; + Column2.InputMask = "99999999999", ; + Column2.Name = "Column2", ; + Column2.Width = 68 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_referinte.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Localizare", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_referinte.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_referinte.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. aparitii", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_referinte.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + +ENDDEFINE diff --git a/Clase/gdiplus.h b/Clase/gdiplus.h new file mode 100644 index 0000000..72395f0 --- /dev/null +++ b/Clase/gdiplus.h @@ -0,0 +1,454 @@ +* +* GDI+ Class library for Visual Foxpro +* +#ifndef _GDIPLUS_H_INCLUDED + +* Localisation +#include "gdiplus_locs.h" + +* Modify_GDIPLUS.VCX behavior (recompile _GDIPLUS.VCX to take effect) +* Set these constants to .F. to bypass most parameter checking +* (Code will run faster, but more dangerously) +#define GDIPLUS_CHECK_PARAMS .T. && Check parameter types +#define GDIPLUS_CHECK_OBJECT .T. && Check GDI+ object handle +#define GDIPLUS_CHECK_GDIPLUSNOTINIT .T. && Throw error if GDI+ not initialised + +* Classes instantiated from gdiplus.vcx +* If you subclass anything in _gdiplus.vcx, you MUST change at least +* GDIPLUS_CLASS_LIBRARY +#define GDIPLUS_CLASS_LIBRARY This.ClassLibrary +* #define GDIPLUS_CLASS_LIBRARY '_gdiplus.vcx' +#define GDIPLUS_CLASS_RECT 'GpRectangle' +#define GDIPLUS_CLASS_POINT 'GpPoint' +#define GDIPLUS_CLASS_SIZE 'GpSize' +#define GDIPLUS_CLASS_FONTFAMILY 'GpFontFamily' +#define GDIPLUS_CLASS_IMAGE 'GpImage' +#define GDIPLUS_CLASS_BITMAP 'GpBitmap' +#define GDIPLUS_CLASS_GRAPHICS 'GpGraphics' + +* Control error handler behavior (default for all objects: you +* can also change this per-object) +* If you want to change these modes in the GpBase.Init() method +* then uncomment and adjust the following +*#define GDIPLUS_ERRHANDLER_ALLOWMODAL (inlist(_VFP.StartMode,0,4)) +*#define GDIPLUS_ERRHANDLER_QUIET (not inlist(_VFP.StartMode,0,4)) +*#define GDIPLUS_ERRHANDLER_IGNOREERRORS .F. +*#define GDIPLUS_ERRHANDLER_APPNAME "GDI+ FFC Library" + +* Set to .T. to rethrow errors inside error handler (eg when debugging) +#define GDIPLUS_ERRHANDLER_RETHROW .F. + + +* Status enumeration +#define GDIPLUS_STATUS_OK 0 +#define GDIPLUS_STATUS_GenericError 1 +#define GDIPLUS_STATUS_InvalidParameter 2 +#define GDIPLUS_STATUS_OutOfMemory 3 +#define GDIPLUS_STATUS_ObjectBusy 4 +#define GDIPLUS_STATUS_InsufficientBuffer 5 +#define GDIPLUS_STATUS_NotImplemented 6 +#define GDIPLUS_STATUS_Win32Error 7 +#define GDIPLUS_STATUS_WrongState 8 +#define GDIPLUS_STATUS_Aborted 9 +#define GDIPLUS_STATUS_FileNotFound 10 +#define GDIPLUS_STATUS_ValueOverflow 11 +#define GDIPLUS_STATUS_AccessDenied 12 +#define GDIPLUS_STATUS_UnknownImageFormat 13 +#define GDIPLUS_STATUS_FontFamilyNotFound 14 +#define GDIPLUS_STATUS_FontStyleNotFound 15 +#define GDIPLUS_STATUS_NotTrueTypeFont 16 +#define GDIPLUS_STATUS_UnsupportedGdiplusVersion 17 +#define GDIPLUS_STATUS_GdiplusNotInitialized 18 +#define GDIPLUS_STATUS_PropertyNotFound 19 +#define GDIPLUS_STATUS_PropertyNotSupported 20 + + + +* Fill mode (how a closed path is filled) +#define GDIPLUS_FillMode_Alternate 0 +#define GDIPLUS_FillMode_Winding 1 + + +* Quality mode constants +#define GDIPLUS_QualityMode_Invalid -1 +#define GDIPLUS_QualityMode_Default 0 +#define GDIPLUS_QualityMode_Low 1 && Best performance +#define GDIPLUS_QualityMode_High 2 && Best rendering quality + +* Alpha Compositing mode constants +#define GDIPLUS_CompositingMode_SourceOver 0 +#define GDIPLUS_CompositingMode_SourceCopy 1 + +* Alpha Compositing quality constants +#define GDIPLUS_CompositingQuality_Invalid GDIPLUS_QualityMode_Invalid +#define GDIPLUS_CompositingQuality_Default GDIPLUS_QualityMode_Default +#define GDIPLUS_CompositingQuality_HighSpeed GDIPLUS_QualityMode_Low +#define GDIPLUS_CompositingQuality_HighQuality GDIPLUS_QualityMode_High +#define GDIPLUS_CompositingQuality_GammaCorrected 3 +#define GDIPLUS_CompositingQuality_AssumeLinear 4 + +* Units +#define GDIPLUS_Unit_World 0 && World coordinate (non-physical unit) +#define GDIPLUS_Unit_Display 1 && Variable -- for PageTransform only +#define GDIPLUS_Unit_Pixel 2 && one device pixel. +#define GDIPLUS_Unit_Point 3 && 1/72 inch. +#define GDIPLUS_Unit_Inch 4 && 1 inch. +#define GDIPLUS_Unit_Document 5 && 1/300 inch. +#define GDIPLUS_Unit_Millimeter 6 && 1 millimeter. + +#define GDIPLUS_MetafileFrameUnit_Pixel GDIPLUS_Unit_Pixel +#define GDIPLUS_MetafileFrameUnit_Point GDIPLUS_Unit_Point +#define GDIPLUS_MetafileFrameUnit_Inch GDIPLUS_Unit_Inch +#define GDIPLUS_MetafileFrameUnit_Document GDIPLUS_Unit_Document +#define GDIPLUS_MetafileFrameUnit_Millimeter GDIPLUS_Unit_Millimeter +#define GDIPLUS_MetafileFrameUnit_Gdi 7 && GDI compatible .01 MM units + + +* Coordinate Space +#define GDIPLUS_CoordinateSpace_World 0 +#define GDIPLUS_CoordinateSpace_Page 1 +#define GDIPLUS_CoordinateSpace_Device 2 + +* Wrap mode for brushes +#define GDIPLUS_WrapMode_Tile 0 +#define GDIPLUS_WrapMode_TileFlipX 1 +#define GDIPLUS_WrapMode_TileFlipY 2 +#define GDIPLUS_WrapMode_TileFlipXY 3 +#define GDIPLUS_WrapMode_Clamp 4 + + +* HatchBrush styles +#define GDIPLUS_HatchStyle_Horizontal 0 +#define GDIPLUS_HatchStyle_Vertical 1 +#define GDIPLUS_HatchStyle_ForwardDiagonal 2 +#define GDIPLUS_HatchStyle_BackwardDiagonal 3 +#define GDIPLUS_HatchStyle_Cross 4 +#define GDIPLUS_HatchStyle_DiagonalCross 5 +#define GDIPLUS_HatchStyle_05Percent 6 +#define GDIPLUS_HatchStyle_10Percent 7 +#define GDIPLUS_HatchStyle_20Percent 8 +#define GDIPLUS_HatchStyle_25Percent 9 +#define GDIPLUS_HatchStyle_30Percent 10 +#define GDIPLUS_HatchStyle_40Percent 11 +#define GDIPLUS_HatchStyle_50Percent 12 +#define GDIPLUS_HatchStyle_60Percent 13 +#define GDIPLUS_HatchStyle_70Percent 14 +#define GDIPLUS_HatchStyle_75Percent 15 +#define GDIPLUS_HatchStyle_80Percent 16 +#define GDIPLUS_HatchStyle_90Percent 17 +#define GDIPLUS_HatchStyle_LightDownwardDiagonal 18 +#define GDIPLUS_HatchStyle_LightUpwardDiagonal 19 +#define GDIPLUS_HatchStyle_DarkDownwardDiagonal 20 +#define GDIPLUS_HatchStyle_DarkUpwardDiagonal 21 +#define GDIPLUS_HatchStyle_WideDownwardDiagonal 22 +#define GDIPLUS_HatchStyle_WideUpwardDiagonal 23 +#define GDIPLUS_HatchStyle_LightVertical 24 +#define GDIPLUS_HatchStyle_LightHorizontal 25 +#define GDIPLUS_HatchStyle_NarrowVertical 26 +#define GDIPLUS_HatchStyle_NarrowHorizontal 27 +#define GDIPLUS_HatchStyle_DarkVertical 28 +#define GDIPLUS_HatchStyle_DarkHorizontal 29 +#define GDIPLUS_HatchStyle_DashedDownwardDiagonal 30 +#define GDIPLUS_HatchStyle_DashedUpwardDiagonal 31 +#define GDIPLUS_HatchStyle_DashedHorizontal 32 +#define GDIPLUS_HatchStyle_DashedVertical 33 +#define GDIPLUS_HatchStyle_SmallConfetti 34 +#define GDIPLUS_HatchStyle_LargeConfetti 35 +#define GDIPLUS_HatchStyle_ZigZag 36 +#define GDIPLUS_HatchStyle_Wave 37 +#define GDIPLUS_HatchStyle_DiagonalBrick 38 +#define GDIPLUS_HatchStyle_HorizontalBrick 39 +#define GDIPLUS_HatchStyle_Weave 40 +#define GDIPLUS_HatchStyle_Plaid 41 +#define GDIPLUS_HatchStyle_Divot 42 +#define GDIPLUS_HatchStyle_DottedGrid 43 +#define GDIPLUS_HatchStyle_DottedDiamond 44 +#define GDIPLUS_HatchStyle_Shingle 45 +#define GDIPLUS_HatchStyle_Trellis 46 +#define GDIPLUS_HatchStyle_Sphere 47 +#define GDIPLUS_HatchStyle_SmallGrid 48 +#define GDIPLUS_HatchStyle_SmallCheckerBoard 49 +#define GDIPLUS_HatchStyle_LargeCheckerBoard 50 +#define GDIPLUS_HatchStyle_OutlinedDiamond 51 +#define GDIPLUS_HatchStyle_SolidDiamond 52 + + +* Dash style constants + +#define GDIPLUS_DashStyle_Solid 0 +#define GDIPLUS_DashStyle_Dash 1 +#define GDIPLUS_DashStyle_Dot 2 +#define GDIPLUS_DashStyle_DashDot 3 +#define GDIPLUS_DashStyle_DashDotDot 4 +#define GDIPLUS_DashStyle_Custom 5 + +* Dash cap constants +#define GDIPLUS_DashCap_Flat 0 +#define GDIPLUS_DashCap_Round 2 +#define GDIPLUS_DashCap_Triangle 3 + +* LineCap +#define GDIPLUS_LineCap_Flat 0 +#define GDIPLUS_LineCap_Square 1 +#define GDIPLUS_LineCap_Round 2 +#define GDIPLUS_LineCap_Triangle 3 +#define GDIPLUS_LineCap_NoAnchor 0x10 && corresponds to flat cap +#define GDIPLUS_LineCap_SquareAnchor 0x11 && corresponds to square cap +#define GDIPLUS_LineCap_RoundAnchor 0x12 && corresponds to round cap +#define GDIPLUS_LineCap_DiamondAnchor 0x13 && corresponds to triangle cap +#define GDIPLUS_LineCap_ArrowAnchor 0x14 && no correspondence +#define GDIPLUS_LineCap_Custom 0xff && custom cap +#define GDIPLUS_LineCap_AnchorMask 0xf0 && mask to check for anchor or not. + +* Custom Line cap type constants +#define GDIPLUS_CustomLineCapType_Default 0 +#define GDIPLUS_CustomLineCapType_AdjustableArrow 1 + +* Line join constants +#define GDIPLUS_LineJoin_Miter 0 +#define GDIPLUS_LineJoin_Bevel 1 +#define GDIPLUS_LineJoin_Round 2 +#define GDIPLUS_LineJoin_MiterClipped 3 + +* Path point types (only the lowest 8 bits are used.) +* The lowest 3 bits are interpreted as point type +* The higher 5 bits are reserved for flags. +#define GDIPLUS_PathPointType_Start 0 && move +#define GDIPLUS_PathPointType_Line 1 && line +#define GDIPLUS_PathPointType_Bezier 3 && default Bezier (= cubic Bezier) +#define GDIPLUS_PathPointType_PathTypeMask 0x07 && type mask (lowest 3 bits). +#define GDIPLUS_PathPointType_DashMode 0x10 && currently in dash mode. +#define GDIPLUS_PathPointType_PathMarker 0x20 && a marker for the path. +#define GDIPLUS_PathPointType_CloseSubpath 0x80 && closed flag +#define GDIPLUS_PathPointType_Bezier3 3 && cubic Bezier + + +* WarpMode constants +#define GDIPLUS_WarpMode_Perspective 0 +#define GDIPLUS_WarpMode_Bilinear 1 + + +* LinearGradient Mode +#define GDIPLUS_LinearGradientMode_Horizontal 0 +#define GDIPLUS_LinearGradientMode_Vertical 1 +#define GDIPLUS_LinearGradientMode_ForwardDiagonal 2 +#define GDIPLUS_LinearGradientMode_BackwardDiagonal 3 + +* CombineMode (for regions) +#define GDIPLUS_CombineMode_Replace 0 +#define GDIPLUS_CombineMode_Intersect 1 +#define GDIPLUS_CombineMode_Union 2 +#define GDIPLUS_CombineMode_Xor 3 +#define GDIPLUS_CombineMode_Exclude 4 +#define GDIPLUS_CombineMode_Complement 5 + +* Image types +#define GDIPLUS_ImageType_Unknown 0 +#define GDIPLUS_ImageType_Bitmap 1 +#define GDIPLUS_ImageType_Metafile 2 + + +* StringAlignment enumeration +* Applies to GpStringFormat::Alignment, GpStringFormat::LineAlignment +#define GDIPLUS_STRINGALIGNMENT_Near 0 && in Left-To-Right locale, this is Left +#define GDIPLUS_STRINGALIGNMENT_Center 1 +#define GDIPLUS_STRINGALIGNMENT_Far 2 && in Left-To-Right locale, this is Right + + +* StringFormatFlags enumeration +* applies to GpStringFormat::FormatFlags +#define GDIPLUS_STRINGFORMATFLAGS_DirectionRightToLeft 1 +#define GDIPLUS_STRINGFORMATFLAGS_DirectionVertical 2 +#define GDIPLUS_STRINGFORMATFLAGS_NoFitBlackBox 4 +#define GDIPLUS_STRINGFORMATFLAGS_DisplayFormatControl 32 +#define GDIPLUS_STRINGFORMATFLAGS_NoFontFallback 1024 +#define GDIPLUS_STRINGFORMATFLAGS_MeasureTrailingSpaces 2048 +#define GDIPLUS_STRINGFORMATFLAGS_NoWrap 4096 +#define GDIPLUS_STRINGFORMATFLAGS_LineLimit 8192 +#define GDIPLUS_STRINGFORMATFLAGS_NoClip 16384 + +* StringTrimming enumeration +#define GDIPLUS_STRINGTRIMMING_None 0 && no trimming. +#define GDIPLUS_STRINGTRIMMING_Character 1 && nearest character. +#define GDIPLUS_STRINGTRIMMING_Word 2 && nearest wor +#define GDIPLUS_STRINGTRIMMING_EllipsisCharacter 3 && nearest character, ellipsis at end +#define GDIPLUS_STRINGTRIMMING_EllipsisWord 4 && nearest word, ellipsis at end +#define GDIPLUS_STRINGTRIMMING_EllipsisPath 5 && ellipsis in center, favouring last slash-delimited segment + +* StringDigitSubstitute +#define GDIPLUS_STRINGDIGITSUBSTITUTE_User 0 +#define GDIPLUS_STRINGDIGITSUBSTITUTE_None 1 +#define GDIPLUS_STRINGDIGITSUBSTITUTE_National 2 +#define GDIPLUS_STRINGDIGITSUBSTITUTE_Traditional 3 + +* HotkeyPrefix enumeration +#define GDIPLUS_HOTKEYPREFIX_None 0 && No hot-key prefix. +#define GDIPLUS_HOTKEYPREFIX_Show 1 && display hot-key prefix +#define GDIPLUS_HOTKEYPREFIX_Hide 2 && Do not display the hot-key prefix. + +* FontStyle: face types and common styles +#define GDIPLUS_FontStyle_Regular 0 +#define GDIPLUS_FontStyle_Bold 1 +#define GDIPLUS_FontStyle_Italic 2 +#define GDIPLUS_FontStyle_BoldItalic 3 +#define GDIPLUS_FontStyle_Underline 4 +#define GDIPLUS_FontStyle_Strikeout 8 + +#define GDIPLUS_InterpolationMode_Invalid GDIPLUS_QualityMode_Invalid +#define GDIPLUS_InterpolationMode_Default GDIPLUS_QualityMode_Default +#define GDIPLUS_InterpolationMode_LowQuality GDIPLUS_QualityMode_Low +#define GDIPLUS_InterpolationMode_HighQuality GDIPLUS_QualityMode_High +#define GDIPLUS_InterpolationMode_Bilinear 3 +#define GDIPLUS_InterpolationMode_Bicubic 4 +#define GDIPLUS_InterpolationMode_NearestNeighbor 5 +#define GDIPLUS_InterpolationMode_HighQualityBilinear 6 +#define GDIPLUS_InterpolationMode_HighQualityBicubic 7 + +#define GDIPLUS_PenAlignment_Center 0 +#define GDIPLUS_PenAlignment_Inset 1 + +* Brush types +#define GDIPLUS_BrushType_SolidColor 0 +#define GDIPLUS_BrushType_HatchFill 1 +#define GDIPLUS_BrushType_TextureFill 2 +#define GDIPLUS_BrushType_PathGradient 3 +#define GDIPLUS_BrushType_LinearGradient 4 + +* Pen's Fill types +#define GDIPLUS_PenType_SolidColor GDIPLUS_BrushType_SolidColor +#define GDIPLUS_PenType_HatchFill GDIPLUS_BrushType_HatchFill +#define GDIPLUS_PenType_TextureFill GDIPLUS_BrushType_TextureFill +#define GDIPLUS_PenType_PathGradient GDIPLUS_BrushType_PathGradient +#define GDIPLUS_PenType_LinearGradient GDIPLUS_BrushType_LinearGradient +#define GDIPLUS_PenType_Unknown -1 + +* Matrix Order +#define GDIPLUS_MatrixOrder_Prepend 0 +#define GDIPLUS_MatrixOrder_Append 1 + +* SmoothingMode +#define GDIPLUS_SmoothingMode_Invalid GDIPLUS_QualityMode_Invalid +#define GDIPLUS_SmoothingMode_Default GDIPLUS_QualityMode_Default +#define GDIPLUS_SmoothingMode_HighSpeed GDIPLUS_QualityMode_Low, +#define GDIPLUS_SmoothingMode_HighQuality GDIPLUS_QualityMode_High +#define GDIPLUS_SmoothingMode_None 3 +#define GDIPLUS_SmoothingMode_AntiAlias 4 + +* PixelOffsetMode +#define GDIPLUS_PixelOffsetMode_Invalid GDIPLUS_QualityMode_Invalid +#define GDIPLUS_PixelOffsetMode_Default GDIPLUS_QualityMode_Default +#define GDIPLUS_PixelOffsetMode_HighSpeed GDIPLUS_QualityMode_Low +#define GDIPLUS_PixelOffsetMode_HighQuality GDIPLUS_QualityMode_High +#define GDIPLUS_PixelOffsetMode_None 3 +#define GDIPLUS_PixelOffsetMode_Half 4 + + +* GpGraphics::Flush() modes +#define GDIPLUS_FlushIntention_Flush 0 +#define GDIPLUS_FlushIntention_Sync 1 + + + + +*--------------------------------------------------------------------------- +* Image file format identifiers (GUIDs) +#define GDIPLUS_IMAGEFORMAT_Undefined 0hA93C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_MemoryBMP 0hAA3C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_BMP 0hAB3C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_EMF 0hAC3C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_WMF 0hAD3C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_JPEG 0hAE3C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_PNG 0hAF3C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_GIF 0hB03C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_TIFF 0hB13C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_EXIF 0hB23C6BB92807D3119D7B0000F81EF32E +#define GDIPLUS_IMAGEFORMAT_Icon 0hB53C6BB92807D3119D7B0000F81EF32E + +* Pixel formats +#define GDIPLUS_PIXELFORMAT_Indexed 0x00010000 && Indexes into a palette +#define GDIPLUS_PIXELFORMAT_GDI 0x00020000 && Is a GDI-supported format +#define GDIPLUS_PIXELFORMAT_Alpha 0x00040000 && Has an alpha component +#define GDIPLUS_PIXELFORMAT_PAlpha 0x00080000 && Pre-multiplied alpha +#define GDIPLUS_PIXELFORMAT_Extended 0x00100000 && Extended color 16 bits/channel +#define GDIPLUS_PIXELFORMAT_Canonical 0x00200000 +#define GDIPLUS_PIXELFORMAT_Undefined 0 +#define GDIPLUS_PIXELFORMAT_DontCare 0 + +#define GDIPLUS_PIXELFORMAT_1bppIndexed 0x00030101 +#define GDIPLUS_PIXELFORMAT_4bppIndexed 0x00030402 +#define GDIPLUS_PIXELFORMAT_8bppIndexed 0x00030803 +#define GDIPLUS_PIXELFORMAT_16bppGrayScale 0x00101004 +#define GDIPLUS_PIXELFORMAT_16bppRGB555 0x00021005 +#define GDIPLUS_PIXELFORMAT_16bppRGB565 0x00021006 +#define GDIPLUS_PIXELFORMAT_16bppARGB1555 0x00061007 +#define GDIPLUS_PIXELFORMAT_24bppRGB 0x00021808 +#define GDIPLUS_PIXELFORMAT_32bppRGB 0x00022009 +#define GDIPLUS_PIXELFORMAT_32bppARGB 0x0026200A +#define GDIPLUS_PIXELFORMAT_32bppPARGB 0x000E200B +#define GDIPLUS_PIXELFORMAT_48bppRGB 0x0010300C +#define GDIPLUS_PIXELFORMAT_64bppPARGB 0x001C400E + +* -------------- +* Image flags (see GpImage::Flags property) + #define GDIPLUS_ImageFlags_None 0 + #define GDIPLUS_ImageFlags_Scalable 0x0001 + #define GDIPLUS_ImageFlags_HasAlpha 0x0002 + #define GDIPLUS_ImageFlags_HasTranslucent 0x0004 + #define GDIPLUS_ImageFlags_PartiallyScalable 0x0008 + #define GDIPLUS_ImageFlags_ColorSpaceRGB 0x0010 + #define GDIPLUS_ImageFlags_ColorSpaceCMYK 0x0020 + #define GDIPLUS_ImageFlags_ColorSpaceGRAY 0x0040 + #define GDIPLUS_ImageFlags_ColorSpaceYCBCR 0x0080 + #define GDIPLUS_ImageFlags_ColorSpaceYCCK 0x0100 + #define GDIPLUS_ImageFlags_HasRealDPI 0x1000 + #define GDIPLUS_ImageFlags_HasRealPixelSize 0x2000 + #define GDIPLUS_ImageFlags_ReadOnly 0x00010000 + #define GDIPLUS_ImageFlags_Caching 0x00020000 + + + +* ------------- +* Encoder parameter type +#define GDIPLUS_ValueDataType_Byte 1 && 8-bit unsigned +#define GDIPLUS_ValueDataType_ASCII 2 && character string +#define GDIPLUS_ValueDataType_Short 3 && 16-bit unsigned +#define GDIPLUS_ValueDataType_Long 4 && 32-bit unsigned +#define GDIPLUS_ValueDataType_Rational 5 && fraction ulong/ulong +#define GDIPLUS_ValueDataType_LongRange 6 && Two ulongs (min,max) +#define GDIPLUS_ValueDataType_Undefined 7 && array of bytes +#define GDIPLUS_ValueDataType_RationalRange 8 && four ulongs +#define GDIPLUS_ValueDataType_Pointer 9 && pointer + +#define GDIPLUS_ENCODER_Compression 0h9D739DE0D4CCEE448EBA3FBF8BE4FC58 +#define GDIPLUS_ENCODER_ColorDepth 0h5570086666AD7C4C9A1838A2310B8337 +#define GDIPLUS_ENCODER_ScanMethod 0h61264E3A0931564E853642C156E7DCFA +#define GDIPLUS_ENCODER_Version 0h768CD1244A81A441BF531C219CCCF797 +#define GDIPLUS_ENCODER_RenderMethod 0h3AC5426D9A2225488BB75C99E2B9A8B8 +#define GDIPLUS_ENCODER_Quality 0hB5E45B1D4AFA2D459CDD5DB35105E7EB +#define GDIPLUS_ENCODER_Transformation 0hD1B20E8D8EA5A84EAA14108074B7B6F9 +#define GDIPLUS_ENCODER_LuminanceTable 0hCE3BB3ED6602774AB90427216099E717 +#define GDIPLUS_ENCODER_ChrominanceTable 0hDC55E4F2B30916438260676ADA32481C +#define GDIPLUS_ENCODER_SaveFlag 0hFC66222940ACBF478CFCA85B89A655DE + +* GpImage::RotateFlip() parameter +#define GDIPLUS_ROTATEFLIPTYPE_RotateNoneFlipNone 0 +#define GDIPLUS_ROTATEFLIPTYPE_Rotate90FlipNone 1 +#define GDIPLUS_ROTATEFLIPTYPE_Rotate180FlipNone 2 +#define GDIPLUS_ROTATEFLIPTYPE_Rotate270FlipNone 3 + +#define GDIPLUS_ROTATEFLIPTYPE_RotateNoneFlipX 4 +#define GDIPLUS_ROTATEFLIPTYPE_Rotate90FlipX 5 +#define GDIPLUS_ROTATEFLIPTYPE_Rotate180FlipX 6 +#define GDIPLUS_ROTATEFLIPTYPE_Rotate270FlipX 7 + +#define GDIPLUS_ROTATEFLIPTYPE_RotateNoneFlipY GDIPLUS_ROTATEFLIPTYPE_Rotate180FlipX +#define GDIPLUS_ROTATEFLIPTYPE_Rotate90FlipY GDIPLUS_ROTATEFLIPTYPE_Rotate270FlipX +#define GDIPLUS_ROTATEFLIPTYPE_Rotate180FlipY GDIPLUS_ROTATEFLIPTYPE_RotateNoneFlipX +#define GDIPLUS_ROTATEFLIPTYPE_Rotate270FlipY GDIPLUS_ROTATEFLIPTYPE_Rotate90FlipX + +#define GDIPLUS_ROTATEFLIPTYPE_RotateNoneFlipXY GDIPLUS_ROTATEFLIPTYPE_Rotate180FlipNone +#define GDIPLUS_ROTATEFLIPTYPE_Rotate90FlipXY GDIPLUS_ROTATEFLIPTYPE_Rotate270FlipNone +#define GDIPLUS_ROTATEFLIPTYPE_Rotate180FlipXY GDIPLUS_ROTATEFLIPTYPE_RotateNoneFlipNone +#define GDIPLUS_ROTATEFLIPTYPE_Rotate270FlipXY GDIPLUS_ROTATEFLIPTYPE_Rotate90FlipNone + +#endif && _GDIPLUS_H_INCLUDED \ No newline at end of file diff --git a/Clase/oOptiuni.vc2 b/Clase/oOptiuni.vc2 new file mode 100644 index 0000000..f3f8d91 --- /dev/null +++ b/Clase/oOptiuni.vc2 @@ -0,0 +1,1456 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="ooptiuni.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS cus_odata_cote AS _cusodatabase OF "..\libs\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "..\..\program files\microsoft visual foxpro 8\foxpro.h" + * + *p: cschema + * + + * + cschema = + Name = "cus_odata_cote" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcs = this.cschema + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + IF INLIST(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + + ENDIF + + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcnume = Nvl(STRTRAN(Alltrim(Upper(toRec.descriere)),['],['']),"") + lcLuna = ALLTRIM(STR(toRec.luna)) + lcAn = ALLTRIM(STR(toRec.an)) + lcProcent = ALLTRIM(STR(toRec.procent)) + lcproc = ALLTRIM(STR(toRec.proc_tva,5,2)) + + Endif + + + Do Case + Case lcActiune = "INSERT" + + lcSql = [INSERT INTO ] + lcS + [.cote_tva (descriere,procent,proc_tva,an,luna) VALUES ('] +; + lcnume + [',] + lcProcent + [,] + lcproc + [,] + lcan + [,] + lcluna + [)] + + Case lcActiune = "UPDATE" + + lcSql = [UPDATE ] + lcS + [.cote_tva SET descriere = '] + lcnume + ; + [', procent = ] + lcprocent + [,proc_tva = ] + lcproc + [, an = ] + lcan + [, luna = ] + lcluna +; + [ where id_proc_tva = ] + lcId + + + Case lcActiune = "DELETE" + + lcSql = [delete from ] + lcS + [.cote_tva where id_proc_tva=] + lcId + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_exceptii AS _cusodatabase OF "..\libs\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "..\..\program files\microsoft visual foxpro 8\foxpro.h" + * + *p: cschema + * + + * + cschema = + Name = "cus_odata_exceptii" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcs = this.cschema + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + IF INLIST(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + + ENDIF + + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcCont = Nvl(STRTRAN(Alltrim(Upper(toRec.cont)),['],['']),"") + lcContC = Nvl(STRTRAN(Alltrim(Upper(toRec.cont_c)),['],['']),"") + lcDebit = ALLTRIM(STR(toRec.debit)) + lcInvers = '1' + + Endif + + + Do Case + Case lcActiune = "INSERT" + + lcSql = [INSERT INTO ] + lcS + [.exceptii_ireg (cont,cont_c,debit,invers) VALUES ('] +; + lcCont + [','] + lcContC + [',] + lcDebit + [,] + lcInvers + [)] + + Case lcActiune = "UPDATE" + + lcSql = [UPDATE ] + lcS + [.exceptii_ireg SET cont = '] + lccont + ; + [', cont_c = '] + lcContC + [',debit = ] + lcDebit + [, invers = ] + lcInvers +; + [ where id_exceptii = ] + lcId + + + Case lcActiune = "DELETE" + + lcSql = [delete from ] + lcS + [.exceptii_ireg where id_exceptii = ] + lcId + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_optiuni AS _cusodatabase OF "..\libs\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "..\..\program files\microsoft visual foxpro 8\foxpro.h" + * + *p: cschema + * + + * + cschema = + Name = "cus_odata_optiuni" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcs = this.cschema + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + IF INLIST(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + + ENDIF + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcnume = Nvl(STRTRAN(Alltrim(Upper(toRec.varname)),['],['']),"") + lctip = Nvl(STRTRAN(Alltrim(Upper(toRec.vartype)),['],['']),"") + lcval = Nvl(STRTRAN(Alltrim(Upper(toRec.varvalue)),['],['']),"") + lcdesc = Nvl(STRTRAN(Alltrim(Upper(toRec.vardesc)),['],['']),"") + + + Endif + + + Do Case + Case lcActiune = "INSERT" + + lcSql = [INSERT INTO ] + lcS + [.optiuni (varname,vartype,varvalue,vardesc) VALUES ('] +; + lcnume + [','] + lctip + [','] + lcval + [','] + lcdesc + [')] + + Case lcActiune = "UPDATE" + + lcSql = [UPDATE ] + lcS + [.optiuni SET varname = '] + lcnume + ; + [', vartype = '] + lctip + [',varvalue = '] + lcval + [', vardesc = '] + lcdesc + ; + [' where id_optiuni = ] + lcId + + Case lcActiune = "DELETE" + + lcSql = [delete from ] + lcS + [.optiuni where id_optiuni=] + lcId + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_cote_nou AS _frmbase OF "..\..\comun\clase\_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="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_cote1" UniqueID="" Timestamp="" /> + + * + *p: cschema + *p: nid + *p: orec + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 165 + Name = "frm_cote_nou" + Width = 314 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 252 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 76 + Lb_titlu_alb_b121.Caption = "Cote tva" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 7 + BUT_TERMIN1.Left = 283 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 5 + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Left = 253, ; + Name = "But_renunt1", ; + TabIndex = 6, ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 1, ; + Top = 44, ; + Text_simplu1.ControlSource = "porec.descriere", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Descriere", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu2' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu2", ; + TabIndex = 2, ; + Top = 72, ; + Text_simplu1.ControlSource = "porec.procent", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Procent", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu3' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu3", ; + TabIndex = 3, ; + Top = 100, ; + Text_simplu1.ControlSource = "porec.luna", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Luna", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu6' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu6", ; + TabIndex = 4, ; + Top = 128, ; + Text_simplu1.ControlSource = "porec.an", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "An", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_cote1' AS cus_odata_cote WITH ; + Left = 120, ; + Name = "Cus_odata_cote1", ; + Top = 26 + *< END OBJECT: ClassLib="ooptiuni.vcx" BaseClass="custom" /> + + PROCEDURE inainte_de_do_termin + LOCAL PLRETURN + + lccontrol = UPPER(this.ActiveControl.BaseClass ) + IF INLIST(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.Activecontrol.controlsource + &lcval=thisform.ActiveControl.value + ENDIF + + + Do Case + Case Empty(porec.descriere) + Messagebox('Nu ati completat descrierea cotei de tva!',0+48,"Atentie") + This.clb_tx_simplu1.SetFocus() + plreturn=.F. + + *!* Case Empty(porec.procent) + *!* Messagebox('Nu ati completat procentul de tva!',0+48,"Atentie") + *!* This.clb_tx_simplu2.SetFocus() + *!* plreturn=.F. + + Case Empty(porec.luna) + Messagebox('Nu ati completat luna!',0+48,"Atentie") + This.clb_tx_simplu3.SetFocus() + plreturn=.F. + + Case Empty(porec.an) + Messagebox('Nu ati completat anul!',0+48,"Atentie") + This.clb_tx_simplu6.SetFocus() + plreturn=.F. + + OTHERWISE + this.cus_odata_cote1.cschema=this.cschema + PLRETURN=This.cus_odata_cote1.salvare(This.OREC,This.NID) + ENDCASE + + Return PLRETURN + + ENDPROC + + PROCEDURE Init + LPARAMETERS toRec, tnId, tcActiune + + DODEFAULT() + + this.orec= toRec + this.nid = tnId + this.cus_odata_cote1.cactiune = tcActiune + ENDPROC + + PROCEDURE Clb_tx_simplu2.Text_simplu1.Valid + + porec.proc_tva = (100+this.value)/100 + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_cote_tva AS _frmbase OF "..\libs\_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="grid_cot" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_cot.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_nom_cot" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + + * + *p: cschema + * + + * + BorderStyle = 1 + cschema = CONTAFIN_ORACLE + DoCreate = .T. + Height = 351 + Name = "frm_cote_tva" + Width = 524 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 522 + _shape2.Height = 29 + _shape2.Left = 402 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 120 + Lb_titlu_alb_b121.Caption = "COTE TVA" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Left = 494 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Left = 434, ; + Name = "But_modifica1", ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Left = 403, ; + Name = "But_nou1", ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Left = 463, ; + Name = "But_sterge1", ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Left = 299, ; + Name = "Cmd_cauta1", ; + TabIndex = 2, ; + Top = 52 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_cot' AS _grid WITH ; + ColumnCount = 4, ; + DeleteMark = .F., ; + Height = 264, ; + Left = 5, ; + Name = "grid_cot", ; + Panel = 1, ; + RecordSource = "v_cote_tva", ; + RowHeight = 23, ; + Top = 84, ; + Width = 513, ; + Column1.ControlSource = "descriere", ; + Column1.Name = "Column1", ; + Column1.Width = 305, ; + Column2.ControlSource = "procent", ; + Column2.Name = "Column2", ; + Column2.Width = 66, ; + Column3.ControlSource = "luna", ; + Column3.Name = "Column3", ; + Column3.Width = 43, ; + Column4.ControlSource = "an", ; + Column4.Name = "Column4", ; + Column4.Width = 64 + *< END OBJECT: ClassLib="..\libs\_baza.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_cot.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Descriere", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_cot.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_cot.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Procent %", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_cot.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_cot.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Luna", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_cot.Column3.Text1' AS textbox WITH ; + Height = 23, ; + Left = 31, ; + Name = "Text1", ; + Top = 35, ; + Width = 100 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_cot.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "An", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_cot.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'lb_nom_cot' AS clb_tx_simplu WITH ; + Left = 8, ; + Name = "lb_nom_cot", ; + TabIndex = 1, ; + Top = 52, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Nume", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru=pcFiltru + IF EMPTY(lcFiltru) + lcFiltru=pcot.ca_baza1.cfiltru + ENDIF + save_grid_tag(thisform.grid_cot) + pcot.ca_baza1.cfiltru=lcFiltru + pcot.ca_baza1.afisare() + restore_grid_tag(thisform.grid_cot) + IF RECCOUNT('v_cote_tva')>0 + thisform.grid_cot.SetFocus() + ELSE + thisform.lb_nom_cot.SetFocus() + ENDIF + + ENDPROC + + PROCEDURE do_adauga + SELECT v_cote_tva + SCATTER NAME loRec BLANK + PRIVATE lcot,poRec + lcot='' + poRec = loRec + DO Adauga_Modifica_Inregistrare WITH "cote",loRec,,"INSERT",.t.,'lcot' + lcot.cschema = this.cschema + lcot.show(1) + RELEASE lcot,poRec + this.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru=[] + lcNume = STRTRAN(Upper(Alltrim(This.lb_nom_cot.text_simplu1.value)),['],['']) + If !Empty(lcNume) + lcFiltru=[descriere like ']+lcNume+[%' and an=]+pcAn + ELSE + lcFiltru = [an=]+pcAn + Endif + This.MousePointer= 11 + This.LockScreen=.T. + Thisform.actualizeaza_grid1(lcFiltru) + IF RECCOUNT()=0 + MESSAGEBOX("Cautarea nu a intors rezultate!",0+64,"Info cautare") + ENDIF + This.LockScreen=.F. + This.MousePointer= 0 + ENDPROC + + PROCEDURE do_modifica + Select v_cote_tva + Scatter Name loRec + PRIVATE lcot,poRec + lcot = '' + poRec = loRec + Do Adauga_Modifica_Inregistrare With "cote",loRec,loRec.Id_proc_tva,"UPDATE",.t.,'lcot' + lcot.cschema = this.cschema + lcot.show(1) + RELEASE lcot,poRec + thisform.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_sterge + SELECT v_cote_tva + SCATTER NAME lorec MEMO + PRIVATE lcot + lcot = '' + Do STERGE_INREGISTRARE With "cote",loRec.id_proc_tva,.t.,'lcot' + lcot.cschema = this.cschema + lcot.salvare(,loRec.id_proc_tva) + RELEASE lcot + + this.actualizeaza_grid1() + + + ENDPROC + + PROCEDURE Unload + IF USED('v_cote_tva') + USE IN v_cote_tva + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_exceptii_ireg AS _frmbase OF "..\libs\_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="grid_ex" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column5.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_ex.Column5.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_nom_ex" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + + * + *p: cschema + * + + * + BorderStyle = 1 + cschema = CONTAFIN_ORACLE + DoCreate = .T. + Height = 351 + Name = "frm_exceptii_ireg" + Width = 463 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 466 + _shape2.Height = 29 + _shape2.Left = 346 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 120 + Lb_titlu_alb_b121.Caption = "EXCEPTII" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Left = 433 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Left = 373, ; + Name = "But_modifica1", ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Left = 342, ; + Name = "But_nou1", ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Left = 402, ; + Name = "But_sterge1", ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Left = 299, ; + Name = "Cmd_cauta1", ; + TabIndex = 2, ; + Top = 52 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_ex' AS _grid WITH ; + ColumnCount = 5, ; + DeleteMark = .F., ; + Height = 264, ; + Left = 4, ; + Name = "grid_ex", ; + Panel = 1, ; + RecordSource = "v_exceptii_ireg", ; + RowHeight = 23, ; + Top = 84, ; + Width = 456, ; + Column1.ControlSource = "cont", ; + Column1.Name = "Column1", ; + Column1.Width = 124, ; + Column2.ControlSource = "cont_c", ; + Column2.Name = "Column2", ; + Column2.Width = 119, ; + Column3.ControlSource = "iif(debit=0,'DEBIT','CREDIT')", ; + Column3.Name = "Column3", ; + Column3.Width = 179, ; + Column4.ControlSource = "invers", ; + Column4.Name = "Column4", ; + Column4.Visible = .F., ; + Column4.Width = 59, ; + Column5.ControlSource = "id_set", ; + Column5.Name = "Column5", ; + Column5.Visible = .F., ; + Column5.Width = 70 + *< END OBJECT: ClassLib="..\libs\_baza.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_ex.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Cont", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_ex.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_ex.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Cont_corespondent", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_ex.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_ex.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Pozitie cont", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_ex.Column3.Text1' AS textbox WITH ; + Height = 23, ; + Left = 31, ; + Name = "Text1", ; + Top = 35, ; + Width = 100 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_ex.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Invers", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_ex.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + Visible = .F. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_ex.Column5.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Id_set", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_ex.Column5.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + Visible = .F. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'lb_nom_ex' AS clb_tx_simplu WITH ; + Left = 8, ; + Name = "lb_nom_ex", ; + TabIndex = 1, ; + Top = 52, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Cont", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru=pcFiltru + IF EMPTY(lcFiltru) + lcFiltru=pex.ca_baza1.cfiltru + ENDIF + save_grid_tag(thisform.grid_ex) + pex.ca_baza1.cfiltru=lcFiltru + pex.ca_baza1.afisare() + restore_grid_tag(thisform.grid_ex) + IF RECCOUNT('v_exceptii_ireg')>0 + thisform.grid_ex.SetFocus() + ELSE + thisform.lb_nom_ex.SetFocus() + ENDIF + + ENDPROC + + PROCEDURE do_adauga + SELECT v_exceptii_ireg + SCATTER NAME loRec BLANK + PRIVATE lex,poRec + + lex='' + poRec = loRec + DO Adauga_Modifica_Inregistrare WITH "exceptii",loRec,,"INSERT",.t.,'lex' + lex.cschema = this.cschema + lex.show(1) + RELEASE lex,poRec + this.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru=[] + lcNume = STRTRAN(Upper(Alltrim(This.lb_nom_ex.text_simplu1.value)),['],['']) + If !Empty(lcNume) + lcFiltru=[cont like ']+lcNume+[%'] + ELSE + lcFiltru = [2=2] + Endif + This.MousePointer= 11 + This.LockScreen=.T. + Thisform.actualizeaza_grid1(lcFiltru) + IF RECCOUNT()=0 + MESSAGEBOX("Cautarea nu a intors rezultate!",0+64,"Info cautare") + ENDIF + This.LockScreen=.F. + This.MousePointer= 0 + ENDPROC + + PROCEDURE do_modifica + Select v_exceptii_ireg + Scatter Name loRec + PRIVATE lex,poRec + lex = '' + poRec = loRec + Do Adauga_Modifica_Inregistrare With "exceptii",loRec,loRec.Id_exceptii,"UPDATE",.t.,'lex' + lex.cschema = this.cschema + lex.show(1) + RELEASE lex,poRec + thisform.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_sterge + SELECT v_exceptii_ireg + SCATTER NAME lorec MEMO + PRIVATE lex + lex = '' + Do STERGE_INREGISTRARE With "exceptii",loRec.id_exceptii,.t.,'lex' + lex.cschema = this.cschema + lex.salvare(,loRec.id_exceptii) + RELEASE lex + + this.actualizeaza_grid1() + + + ENDPROC + + PROCEDURE Unload + IF USED('v_exceptii_ireg') + USE IN v_exceptii_ireg + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_exceptii_nou AS _frmbase OF "..\libs\_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="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_exceptii1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cb_tx_simplu1" UniqueID="" Timestamp="" /> + + * + *p: cschema + *p: nid + *p: orec + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 133 + Name = "frm_exceptii_nou" + Width = 314 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 252 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 76 + Lb_titlu_alb_b121.Caption = "Exceptii" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 6 + BUT_TERMIN1.Left = 283 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 4 + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Left = 253, ; + Name = "But_renunt1", ; + TabIndex = 5, ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cb_tx_simplu1' AS cb_tx_simplu WITH ; + Height = 29, ; + Left = 15, ; + Name = "Cb_tx_simplu1", ; + TabIndex = 3, ; + Top = 102, ; + Width = 290, ; + _cbbase1.BoundTo = .T., ; + _cbbase1.Name = "_cbbase1", ; + _cbbase1.RowSource = "DEBIT,CREDIT", ; + _cbbase1.RowSourceType = 1, ; + _lbbase1.Caption = "Pozitie", ; + _lbbase1.Name = "_lbbase1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 1, ; + Top = 44, ; + Text_simplu1.ControlSource = "porec.cont", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Cont", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu2' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu2", ; + TabIndex = 2, ; + Top = 72, ; + Text_simplu1.ControlSource = "porec.cont_c", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Corespondent", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_exceptii1' AS cus_odata_exceptii WITH ; + Left = 168, ; + Name = "Cus_odata_exceptii1", ; + Top = 33 + *< END OBJECT: ClassLib="ooptiuni.vcx" BaseClass="custom" /> + + PROCEDURE inainte_de_do_termin + LOCAL PLRETURN + + porec.debit = IIF(this.cb_tx_simplu1._CBBASE1.Value="DEBIT",0,1) + lccontrol = UPPER(this.ActiveControl.BaseClass ) + IF INLIST(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.Activecontrol.controlsource + &lcval=thisform.ActiveControl.value + ENDIF + + + Do Case + Case Empty(porec.cont) + Messagebox('Nu ati completat contul!',0+48,"Atentie") + This.clb_tx_simplu1.SetFocus() + plreturn=.F. + + Case Empty(porec.cont_c) + Messagebox('Nu ati completat contul corespondent!',0+48,"Atentie") + This.clb_tx_simplu2.SetFocus() + plreturn=.F. + + *!* Case Empty(porec.debit) + *!* Messagebox('Nu ati completat pozitia contului!',0+48,"Atentie") + *!* This.clb_tx_simplu3.SetFocus() + *!* plreturn=.F. + + OTHERWISE + + lcCont = ALLTRIM(porec.cont) + lcContC = ALLTRIM(porec.cont_c) + lcSql = [select * from ] + gcS + [.plcont where cont=]+lcCont + lcCursor = [cur_cont] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() &&Verific contu in plcont + + IF RECCOUNT('cur_cont')=0 + MESSAGEBOX('Contul '+lcCont+' nu este definit in planul de conturi!',0,'Eroare') + PLRETURN=.f. + USE IN cur_cont + RETURN PLRETURN + ENDIF + IF USED('cur_cont') + USE IN cur_cont + ENDIF + + lcSql = [select * from ] + gcS + [.plcont where cont=]+lcContC + lcCursor = [cur_cont_c] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() &&Verific contul corespondent + IF RECCOUNT('cur_cont_c')=0 + MESSAGEBOX('Contul '+lcContC+' nu este definit in planul de conturi!',0,'Eroare') + PLRETURN=.f. + USE IN cur_cont_c + RETURN PLRETURN + ENDIF + IF USED('cur_cont_c') + USE IN cur_cont_c + ENDIF + this.cus_odata_exceptii1.cschema=this.cschema + PLRETURN=This.cus_odata_exceptii1.salvare(This.OREC,This.NID) + ENDCASE + + Return PLRETURN + + ENDPROC + + PROCEDURE Init + LPARAMETERS toRec, tnId, tcActiune + + DODEFAULT() + IF porec.debit=0 + this.cb_tx_simplu1._cBBASE1.DisplayValue='DEBIT' + ELSE + this.cb_tx_simplu1._cBBASE1.DisplayValue='CREDIT' + ENDIF + this.orec= toRec + this.nid = tnId + this.cus_odata_exceptii1.cactiune = tcActiune + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_optiuni AS _frmbase OF "..\..\comun\clase\_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="grid_opt" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column3.Edit1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_opt.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_nom_opt" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + + * + *p: cschema + * + + * + BorderStyle = 1 + cschema = CONTAFIN_ORACLE + DoCreate = .T. + Height = 351 + Name = "frm_optiuni" + Width = 524 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 522 + _shape2.Height = 29 + _shape2.Left = 402 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 120 + Lb_titlu_alb_b121.Caption = "OPTIUNI" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Left = 494 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Left = 434, ; + Name = "But_modifica1", ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Left = 403, ; + Name = "But_nou1", ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Left = 463, ; + Name = "But_sterge1", ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Left = 299, ; + Name = "Cmd_cauta1", ; + TabIndex = 2, ; + Top = 52 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_opt' AS _grid WITH ; + ColumnCount = 4, ; + DeleteMark = .F., ; + Height = 264, ; + Left = 5, ; + Name = "grid_opt", ; + Panel = 1, ; + RecordSource = "v_optiuni", ; + RowHeight = 23, ; + Top = 84, ; + Width = 513, ; + Column1.ControlSource = "varname", ; + Column1.Name = "Column1", ; + Column1.Width = 106, ; + Column2.ControlSource = "vartype", ; + Column2.Name = "Column2", ; + Column2.Width = 70, ; + Column3.ControlSource = "varvalue", ; + Column3.Name = "Column3", ; + Column3.Sparse = .F., ; + Column3.Width = 157, ; + Column4.ControlSource = "vardesc", ; + Column4.Name = "Column4", ; + Column4.Width = 145 + *< END OBJECT: ClassLib="..\..\comun\clase\_baza.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_opt.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nume", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_opt.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_opt.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Tip data", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_opt.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_opt.Column3.Edit1' AS editbox WITH ; + Height = 53, ; + Left = 94, ; + Name = "Edit1", ; + Top = 23, ; + Width = 100 + *< END OBJECT: BaseClass="editbox" /> + + ADD OBJECT 'grid_opt.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Valoare", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_opt.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Descriere", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_opt.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'lb_nom_opt' AS clb_tx_simplu WITH ; + Left = 8, ; + Name = "lb_nom_opt", ; + TabIndex = 1, ; + Top = 52, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Nume", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru=pcFiltru + IF EMPTY(lcFiltru) + lcFiltru=popt.ca_baza1.cfiltru + ENDIF + save_grid_tag(thisform.grid_opt) + popt.ca_baza1.cfiltru=lcFiltru + popt.ca_baza1.afisare() + restore_grid_tag(thisform.grid_opt) + IF RECCOUNT('v_optiuni')>0 + thisform.grid_opt.SetFocus() + ELSE + thisform.lb_nom_opt.SetFocus() + ENDIF + + ENDPROC + + PROCEDURE do_adauga + SELECT v_optiuni + SCATTER NAME loRec MEMO BLANK + PRIVATE lopt,poRec + lopt='' + poRec = loRec + DO Adauga_Modifica_Inregistrare WITH "optiuni",loRec,,"INSERT",.t.,'lopt' + lopt.cschema = this.cschema + lopt.show(1) + RELEASE lopt,poRec + this.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru=[] + lcNume = STRTRAN(Upper(Alltrim(This.lb_nom_opt.text_simplu1.value)),['],['']) + If !Empty(lcNume) + lcFiltru=[varname like ']+lcNume+[%'] + ELSE + lcFiltru = [2=2] + Endif + This.MousePointer= 11 + This.LockScreen=.T. + Thisform.actualizeaza_grid1(lcFiltru) + IF RECCOUNT()=0 + MESSAGEBOX("Cautarea nu a intors rezultate!",0+64,"Info cautare") + ENDIF + This.LockScreen=.F. + This.MousePointer= 0 + ENDPROC + + PROCEDURE do_modifica + Select v_optiuni + Scatter Name loRec MEMO + PRIVATE lopt,poRec + lopt = '' + poRec = loRec + Do Adauga_Modifica_Inregistrare With "optiuni",loRec,loRec.Id_optiuni,"UPDATE",.t.,'lopt' + lopt.cschema = this.cschema + lopt.show(1) + RELEASE lopt,poRec + thisform.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_sterge + SELECT v_optiuni + SCATTER NAME lorec MEMO + PRIVATE lopt + lopt = '' + Do STERGE_INREGISTRARE With "optiuni",loRec.id_optiuni,.t.,'lopt' + lopt.cschema = this.cschema + lopt.salvare(,loRec.id_optiuni) + RELEASE lopt + + this.actualizeaza_grid1() + + + ENDPROC + + PROCEDURE Unload + IF USED('v_optiuni') + USE IN v_optiuni + ENDIF + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_optiuni_nou AS _frmbase OF "..\libs\_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="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_optiuni1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cb_tx_simplu1" UniqueID="" Timestamp="" /> + + * + *p: cschema + *p: nid + *p: orec + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 165 + Name = "frm_optiuni_nou" + Width = 314 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 252 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 76 + Lb_titlu_alb_b121.Caption = "Optiuni" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 7 + BUT_TERMIN1.Left = 283 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 5 + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Left = 253, ; + Name = "But_renunt1", ; + TabIndex = 6, ; + Top = 1 + *< END OBJECT: ClassLib="..\libs\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cb_tx_simplu1' AS cb_tx_simplu WITH ; + Left = 15, ; + Name = "Cb_tx_simplu1", ; + TabIndex = 2, ; + Top = 72, ; + _cbbase1.ControlSource = "porec.vartype", ; + _cbbase1.Name = "_cbbase1", ; + _cbbase1.RowSource = "CHARACTER,CURRENCY,NUMERIC,DATETIME,DATE,LOGICAL", ; + _cbbase1.RowSourceType = 1, ; + _lbbase1.Caption = "Tip data", ; + _lbbase1.Name = "_lbbase1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 1, ; + Top = 44, ; + Text_simplu1.ControlSource = "porec.varname", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Nume", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu3' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu3", ; + TabIndex = 3, ; + Top = 100, ; + Text_simplu1.ControlSource = "porec.varvalue", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Valoare", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu6' AS clb_tx_simplu WITH ; + Left = 15, ; + Name = "Clb_tx_simplu6", ; + TabIndex = 4, ; + Top = 128, ; + Text_simplu1.ControlSource = "porec.vardesc", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Descriere", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\libs\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_optiuni1' AS cus_odata_optiuni WITH ; + Left = 144, ; + Name = "Cus_odata_optiuni1", ; + Top = 24 + *< END OBJECT: ClassLib="ooptiuni.vcx" BaseClass="custom" /> + + PROCEDURE inainte_de_do_termin + LOCAL PLRETURN + + lccontrol = UPPER(this.ActiveControl.BaseClass ) + IF INLIST(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.Activecontrol.controlsource + &lcval=thisform.ActiveControl.value + ENDIF + + + Do Case + Case Empty(porec.varname) + Messagebox('Nu ati completat denumirea variabilei!',0+48,"Atentie") + This.clb_tx_simplu1.SetFocus() + plreturn=.F. + + Case Empty(porec.vartype) + Messagebox('Nu ati completat tipul de data!',0+48,"Atentie") + This.CB_tx_simplu1.SetFocus() + plreturn=.F. + + Case Empty(porec.varvalue) + Messagebox('Nu ati completat valoarea variabilei!',0+48,"Atentie") + This.clb_tx_simplu5.SetFocus() + plreturn=.F. + + OTHERWISE + this.cus_odata_optiuni1.cschema=this.cschema + PLRETURN=This.cus_odata_optiuni1.salvare(This.OREC,This.NID) + ENDCASE + + Return PLRETURN + + ENDPROC + + PROCEDURE Init + LPARAMETERS toRec, tnId, tcActiune + + DODEFAULT() + + this.orec= toRec + this.nid = tnId + this.cus_odata_optiuni1.cactiune = tcActiune + ENDPROC + +ENDDEFINE diff --git a/Clase/ofundal.vc2 b/Clase/ofundal.vc2 new file mode 100644 index 0000000..7f5496e --- /dev/null +++ b/Clase/ofundal.vc2 @@ -0,0 +1,47 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="ofundal.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS pg_meniu AS _pageframe OF "..\..\comun\clase\_baza.vcx" + *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + ErasePage = .T. + Height = 173 + Name = "pg_meniu" + TabStyle = 1 + Page1.BackColor = 255,255,255 + Page1.Name = "Page1" + Page2.BackColor = 255,255,255 + Page2.Name = "Page2" + * + +ENDDEFINE + +DEFINE CLASS pict_liniuta AS _image OF "..\..\comun\clase\_baza.vcx" + *< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Height = 10 + Name = "pict_liniuta" + Picture = ..\grafice\f3.jpg + Stretch = 2 + Width = 120 + * + +ENDDEFINE + +DEFINE CLASS pict_meniu AS _image OF "..\..\comun\clase\_baza.vcx" + *< CLASSDATA: Baseclass="image" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Height = 362 + Name = "pict_meniu" + Picture = ..\grafice\f2.jpg + Stretch = 2 + Width = 133 + * + +ENDDEFINE diff --git a/Clase/ofundal_registratura.vc2 b/Clase/ofundal_registratura.vc2 new file mode 100644 index 0000000..a58ab1a --- /dev/null +++ b/Clase/ofundal_registratura.vc2 @@ -0,0 +1,307 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="ofundal_registratura.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS pg_meniu_princ AS pg_meniu OF "..\comun\clase\ofundal.vcx" + *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Page1.shape1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page1.Cw2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page1.Cw1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page1.Cw4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page2.Ct_registratura1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page3.CT_DATE_GENERALE1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page3.CT_PART_NR_DATA1" UniqueID="" Timestamp="" /> + + * + ActivePage = 2 + Anchor = 15 + ErasePage = .T. + Height = 431 + Name = "pg_meniu_princ" + PageCount = 3 + Width = 800 + Page1.Caption = "Definire" + Page1.Name = "Page1" + Page2.Caption = "Lista documentelor" + Page2.Name = "Page2" + Page3.BackColor = 255,255,255 + Page3.Caption = "Datele documentului" + Page3.Name = "Page3" + * + + ADD OBJECT 'Page1.Cw1' AS cw WITH ; + Height = 20, ; + Left = 4, ; + Name = "Cw1", ; + nid_cw = 1, ; + ntip = 4, ; + Top = 12, ; + Width = 142, ; + Label_item1.Caption = "Parteneri", ; + Label_item1.Name = "Label_item1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page1.Cw2' AS cw WITH ; + Height = 20, ; + Left = 4, ; + Name = "Cw2", ; + nid_cw = 5, ; + ntip = 4, ; + Top = 61, ; + Width = 142, ; + Label_item1.Caption = "Optiuni", ; + Label_item1.Name = "Label_item1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page1.Cw4' AS cw WITH ; + Left = 4, ; + linactiv = .T., ; + Name = "Cw4", ; + nid_cw = 2, ; + ntip = 2, ; + TabIndex = 2, ; + Top = 36, ; + Width = 142, ; + Label_item1.Caption = "Modele de COVER PAGE", ; + Label_item1.Name = "Label_item1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page1.shape1' AS pict_meniu WITH ; + Anchor = 7, ; + Height = 406, ; + Left = 0, ; + Name = "shape1", ; + Picture = ..\grafice\f2.jpg, ; + Top = -2, ; + Width = 160 + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="image" /> + + ADD OBJECT 'Page2.Ct_registratura1' AS ct_registratura WITH ; + Anchor = 15, ; + Height = 356, ; + Left = -2, ; + Name = "Ct_registratura1", ; + Top = 0, ; + Width = 800, ; + _shape1.Name = "_shape1", ; + Gridsort1.Name = "Gridsort1", ; + _ct_controller_keypress1.Name = "_ct_controller_keypress1", ; + grid_registratura.cAre_obs.Check1.Alignment = 0, ; + grid_registratura.cAre_obs.Check1.Name = "Check1", ; + grid_registratura.cAre_obs.Header1.Name = "Header1", ; + grid_registratura.cAre_obs.Name = "cAre_obs", ; + grid_registratura.cAvizat.Check1.Alignment = 0, ; + grid_registratura.cAvizat.Check1.Name = "Check1", ; + grid_registratura.cAvizat.Header1.Name = "Header1", ; + grid_registratura.cAvizat.Name = "cAvizat", ; + grid_registratura.cData_ctr.Header1.Name = "Header1", ; + grid_registratura.cData_ctr.Name = "cData_ctr", ; + grid_registratura.cData_ctr.Text1.Name = "Text1", ; + grid_registratura.cData_intern.Header1.Name = "Header1", ; + grid_registratura.cData_intern.Name = "cData_intern", ; + grid_registratura.cData_intern.Text1.Name = "Text1", ; + grid_registratura.cDescriere.Header1.Name = "Header1", ; + grid_registratura.cDescriere.Name = "cDescriere", ; + grid_registratura.cDescriere.Text1.Name = "Text1", ; + grid_registratura.cFel_document.Header1.Name = "Header1", ; + grid_registratura.cFel_document.Name = "cFel_document", ; + grid_registratura.cFel_document.Text1.Name = "Text1", ; + grid_registratura.cIE.Header1.Name = "Header1", ; + grid_registratura.cIE.Name = "cIE", ; + grid_registratura.cIE.Text1.Name = "Text1", ; + grid_registratura.cMediu_transmisie.Header1.Name = "Header1", ; + grid_registratura.cMediu_transmisie.Name = "cMediu_transmisie", ; + grid_registratura.cMediu_transmisie.Text1.Name = "Text1", ; + grid_registratura.cNresp.Header1.Name = "Header1", ; + grid_registratura.cNresp.Name = "cNresp", ; + grid_registratura.cNresp.Text1.Name = "Text1", ; + grid_registratura.cNr_ctr.Header1.Name = "Header1", ; + grid_registratura.cNr_ctr.Name = "cNr_ctr", ; + grid_registratura.cNr_ctr.Text1.Name = "Text1", ; + grid_registratura.cNr_pag.Header1.Name = "Header1", ; + grid_registratura.cNr_pag.Name = "cNr_pag", ; + grid_registratura.cNr_pag.Text1.Name = "Text1", ; + grid_registratura.cNumar_intern.Header1.Name = "Header1", ; + grid_registratura.cNumar_intern.Name = "cNumar_intern", ; + grid_registratura.cNumar_intern.Text1.Name = "Text1", ; + grid_registratura.cNume.Header1.Name = "Header1", ; + grid_registratura.cNume.Name = "cNume", ; + grid_registratura.cNume.Text1.Name = "Text1", ; + grid_registratura.Column12.Header1.Name = "Header1", ; + grid_registratura.Column12.Name = "Column12", ; + grid_registratura.Column12.Text1.Name = "Text1", ; + grid_registratura.COLUMN13.Header1.Name = "Header1", ; + grid_registratura.COLUMN13.Name = "COLUMN13", ; + grid_registratura.COLUMN13.Text1.Name = "Text1", ; + grid_registratura.Column14.Header1.Name = "Header1", ; + grid_registratura.Column14.Name = "Column14", ; + grid_registratura.Column14.Text1.Name = "Text1", ; + grid_registratura.Column15.Header1.Name = "Header1", ; + grid_registratura.Column15.Name = "Column15", ; + grid_registratura.Column15.Text1.Name = "Text1", ; + grid_registratura.COLUMN16.Header1.Name = "Header1", ; + grid_registratura.COLUMN16.Name = "COLUMN16", ; + grid_registratura.COLUMN16.Text1.Name = "Text1", ; + grid_registratura.COLUMN17.Header1.Name = "Header1", ; + grid_registratura.COLUMN17.Name = "COLUMN17", ; + grid_registratura.COLUMN17.Text1.Name = "Text1", ; + grid_registratura.COLUMN22.Header1.Name = "Header1", ; + grid_registratura.COLUMN22.Name = "COLUMN22", ; + grid_registratura.COLUMN22.Text1.Name = "Text1", ; + grid_registratura.Column23.Command1.Name = "Command1", ; + grid_registratura.Column23.Command2.Name = "Command2", ; + grid_registratura.Column23.Header1.Name = "Header1", ; + grid_registratura.Column23.Name = "Column23", ; + grid_registratura.Column23.Text1.Name = "Text1", ; + grid_registratura.cPers_contact.Header1.Name = "Header1", ; + grid_registratura.cPers_contact.Name = "cPers_contact", ; + grid_registratura.cPers_contact.Text1.Name = "Text1", ; + grid_registratura.Name = "grid_registratura", ; + Ck_data.Alignment = 0, ; + Ck_data.Name = "Ck_data", ; + But_nou1.Name = "But_nou1", ; + But_sterge1.Name = "But_sterge1", ; + Clb_tx_simplu1.Lb_simplu1.Name = "Lb_simplu1", ; + Clb_tx_simplu1.Name = "Clb_tx_simplu1", ; + Clb_tx_simplu1.Text_simplu1.Name = "Text_simplu1", ; + But_listare1.Name = "But_listare1", ; + But_excel1.Name = "But_excel1", ; + Ck_nume.Alignment = 0, ; + Ck_nume.Name = "Ck_nume", ; + Ck_numar.Alignment = 0, ; + Ck_numar.Name = "Ck_numar", ; + Cmd_reset1.Name = "Cmd_reset1", ; + Cmd_cauta1.Name = "Cmd_cauta1", ; + _lbbase1.Name = "_lbbase1", ; + Ck_tipdoc.Alignment = 0, ; + Ck_tipdoc.Name = "Ck_tipdoc", ; + Ck_sters.Alignment = 0, ; + Ck_sters.Name = "Ck_sters" + *< END OBJECT: ClassLib="ferestre_registratura.vcx" BaseClass="container" /> + + ADD OBJECT 'Page3.CT_DATE_GENERALE1' AS ct_date_generale WITH ; + Anchor = 15, ; + Left = -1, ; + Name = "CT_DATE_GENERALE1", ; + Top = 0, ; + OUTLOOK2003BAR1.Name = "OUTLOOK2003BAR1", ; + OUTLOOK2003BAR1.OVERFLOWPANEL.MENUBUTTON.IMGPICTURE.Height = 16, ; + OUTLOOK2003BAR1.OVERFLOWPANEL.MENUBUTTON.IMGPICTURE.Name = "IMGPICTURE", ; + OUTLOOK2003BAR1.OVERFLOWPANEL.MENUBUTTON.IMGPICTURE.Width = 16, ; + OUTLOOK2003BAR1.OVERFLOWPANEL.MENUBUTTON.Name = "MENUBUTTON", ; + OUTLOOK2003BAR1.OVERFLOWPANEL.Name = "OVERFLOWPANEL", ; + OUTLOOK2003BAR1.Panel.Name = "Panel", ; + OUTLOOK2003BAR1.PANES.ErasePage = .T., ; + OUTLOOK2003BAR1.PANES.Height = 328, ; + OUTLOOK2003BAR1.PANES.Name = "PANES", ; + OUTLOOK2003BAR1.PANES.PANE1.Name = "PANE1", ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL1.Height = 328, ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL1.Left = 0, ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL1.Name = "OLECONTROL1", ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL1.Top = 0, ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL1.Width = 198, ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL2.Height = 150, ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL2.Name = "OLECONTROL2", ; + OUTLOOK2003BAR1.PANES.PANE1.OLECONTROL2.Width = 200, ; + OUTLOOK2003BAR1.PANES.PANE2.Name = "PANE2", ; + OUTLOOK2003BAR1.PANES.PANE3.Name = "PANE3", ; + OUTLOOK2003BAR1.PANES.PANE4.Name = "PANE4", ; + OUTLOOK2003BAR1.PANES.Top = 33, ; + OUTLOOK2003BAR1.SplitBar.IMGSPLITTER.Height = 3, ; + OUTLOOK2003BAR1.SplitBar.IMGSPLITTER.Name = "IMGSPLITTER", ; + OUTLOOK2003BAR1.SplitBar.IMGSPLITTER.Width = 35, ; + OUTLOOK2003BAR1.SplitBar.Name = "SplitBar", ; + OUTLOOK2003BAR1.SPLITTER.Name = "SPLITTER", ; + OUTLOOK2003BAR1.TITLE.LBLCAPTION.Name = "LBLCAPTION", ; + OUTLOOK2003BAR1.TITLE.LINBORDER.Name = "LINBORDER", ; + OUTLOOK2003BAR1.TITLE.Name = "TITLE" + *< END OBJECT: ClassLib="ferestre_registratura.vcx" BaseClass="container" /> + + ADD OBJECT 'Page3.CT_PART_NR_DATA1' AS ct_part_nr_data WITH ; + Anchor = 11, ; + Left = 203, ; + Name = "CT_PART_NR_DATA1", ; + Top = 0, ; + cmdDenumire.Name = "cmdDenumire", ; + Label3.Name = "Label3", ; + txtClient.Name = "txtClient", ; + Label4.Name = "Label4", ; + txtNumar.Name = "txtNumar", ; + Label9.Name = "Label9", ; + txtData_ctr.Name = "txtData_ctr", ; + Command2.Name = "Command2" + *< END OBJECT: ClassLib="ferestre_registratura.vcx" BaseClass="container" /> + + PROCEDURE Page1.Activate + If Type('podg_dg.but_termin1') <> 'U' + podg_dg.but_termin1.Click() + Endif + If Type('podg_referinte.but_termin1') <> 'U' + podg_referinte.but_termin1.Click() + Endif + If Type('podg_obs.but_termin1') <> 'U' + podg_obs.but_termin1.Click() + Endif + If Type('podg_link.but_termin1') <> 'U' + podg_link.but_termin1.Click() + Endif + ENDPROC + + PROCEDURE Page1.Cw1.do_actiune + DO viz_parteneri IN onomenclatoare.prg + ENDPROC + + PROCEDURE Page2.Activate + If Type('podg_dg.but_termin1') <> 'U' + podg_dg.but_termin1.Click() + Endif + If Type('podg_referinte.but_termin1') <> 'U' + podg_referinte.but_termin1.Click() + Endif + If Type('podg_obs.but_termin1') <> 'U' + podg_obs.but_termin1.Click() + Endif + If Type('podg_link.but_termin1') <> 'U' + podg_link.but_termin1.Click() + Endif + + This.ct_registratura1.do_cauta() + ENDPROC + + PROCEDURE Page3.Activate + If Empty(goRegistratura.id_reg) + AMESSAGEBOX('Nu este selectat niciun document!',0+48,'Atentie') + This.Parent.ActivePage = 2 + Else + Do make_cursoare_reg In oproceduri_roaregistratura.prg && imi creeaza cursoarele + This.ct_part_nr_data1.Refresh + This.ct_date_generale1.outlook2003bar1.Panel.button1.Click + Endif + ENDPROC + + PROCEDURE Page3.Deactivate + Local lnRaspuns + If !This.ct_part_nr_data1.llock + This.ct_part_nr_data1.llock = .T. + lnRaspuns = AMESSAGEBOX('Doriþi sã salvaþi modificãrile fãcute?',4+32,'Confirmare') + This.ct_part_nr_data1.Refresh() + If lnRaspuns = 7 + Return + Else + Do modifica_reg_dg With goRegistratura In oproceduri_roaregistratura.prg + Endif + Endif + + If Used('cRegLink') + Use In cRegLink + Endif + If Used('cRegReferinte') + Use In cRegReferinte + Endif + ENDPROC + +ENDDEFINE diff --git a/Clase/onom_clienti.vc2 b/Clase/onom_clienti.vc2 new file mode 100644 index 0000000..6cfc6a8 --- /dev/null +++ b/Clase/onom_clienti.vc2 @@ -0,0 +1,3347 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="onom_clienti.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS cus_odata_agenti AS _cusodatabase OF "..\..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_agenti" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcId_util = Alltrim(Str(gnIdUtil)) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcNume = Strtran(Alltrim(toRec.nume_agent),['],['']) + *!* lcPrenume = Strtran(Alltrim(toRec.prenume),['],['']) + lcTelefon1 = Alltrim(NVL(toRec.telefon1,[])) + lcTelefon2 = Alltrim(NVL(toRec.telefon2,[])) + lcIdZona = Alltrim(Str(toRec.id_zona)) + lcFunctia = Alltrim(NVL(porec.functie,[])) + Endif + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin pack_crm.adauga_agent(']+Alltrim(gcS)+[',']+lcNume+[',]+lcIdZona+[,]+; + [']+lcFunctia+[',']+lcTelefon1+[',']+lcTelefon2+[',]+lcId_util+[); end;] + + Case lcActiune = "UPDATE" + lcSql = [begin pack_crm.modifica_agent(']+Alltrim(gcS)+[',]+lcId+[,']+lcNume+[',]+; + lcIdZona+[,']+lcFunctia+[',']+lcTelefon1+[',']+lcTelefon2+[',]+lcId_util+[); end;] + + Case lcActiune = "DELETE" + lcSql = [begin pack_crm.sterge_agent(']+Alltrim(gcS)+[',]+lcId+[,]+lcId_util+[); end;] + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_clienti AS _cusodatabase OF "..\..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_clienti" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + lcnom = gcS + ".nom_parteneri" + lcamp = "id_part" + lclook = gcS + ".dev_masiniclienti" + lclookid = "id_partener" + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcNume = Nvl(Strtran(Alltrim(Upper(toRec.nume)),['],['']),"") + lcCod_fiscal = Nvl(Strtran(Alltrim(Upper(toRec.cod_fiscal)),['],['']),"") + lctelefon = Nvl(Strtran(Alltrim(Upper(toRec.telefon)),['],['']),"") + lcadresa = Nvl(Strtran(Alltrim(Upper(toRec.adresa)),['],['']),"") + lcbanca = Nvl(Strtran(Alltrim(Upper(toRec.banca)),['],['']),"") + lccont_banca = Nvl(Strtran(Alltrim(Upper(toRec.cont_banca)),['],['']),"") + lcreg_comert = Nvl(Strtran(Alltrim(Upper(toRec.reg_comert)),['],['']),"") + *!* lcJudet = Nvl(STRTRAN(Alltrim(Upper(toRec.judet)),['],['']),"") + *!* lcLocalitate = Nvl(STRTRAN(Alltrim(Upper(toRec.localitate)),['],['']),"") + lcIdLoc = Nvl(Alltrim(Str(toRec.id_loc)),0) + Endif + + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin devpartinsproc('] + gcS + [','] + lcNume + [','] + lcCod_fiscal + [','] + lctelefon +[',']+ lcadresa + [','] +lcbanca + ; + [',']+ lccont_banca + [','] + lcreg_comert + [',] + lcIdLoc + [); end;] + + *!* lcSql = [INSERT INTO ] + gcS + [.nom_parteneri (nume,cod_fiscal,telefon,adresa,banca,cont_banca,reg_comert,id_loc) ] + ; + *!* [VALUES ('] + lcnume + [','] + lccod_fiscal + [','] + lctelefon +[',']+ lcAdresa + [','] +lcbanca + ; + *!* [',']+ lcCont_banca + [',']+ lcReg_comert+[',] + lcIdLoc + [)] + Case lcActiune = "UPDATE" + If pnNivelModificare=-1 + lcSql = [UPDATE ] + gcS + [.nom_parteneri SET nume = '] + lcNume; + +[',cod_fiscal = '] + lcCod_fiscal + [',telefon = '] + lctelefon +; + [',adresa = '] + lcadresa + [',banca = '] + lcbanca + [',cont_banca = '] + lccont_banca + [',reg_comert = ']+lcreg_comert+; + [',id_loc = ] + lcIdLoc + [ where id_part = ] + lcId + ELSE + lcSql = [UPDATE ] + gcS + [.nom_parteneri SET telefon = '] + lctelefon + [' ]+; + [ where id_part = ] + lcId + Endif + Case lcActiune = "DELETE" + + *!* lcSql = [update nom_sectii set sters=1,id_util=]+ALLTRIM(STR(gcidutil))+[,id_modif=seq_modif_nomen.nextval where id_banca=]+lcid + lcSql = [begin nomdelproc('] + lcnom + [','] + lcamp + [',] + lcId + [,'] + lclook + [','] + lclookid + ['); end;] + Endcase + This.csql = lcSql + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_curs AS _cusodatabase OF "..\..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_curs" + * + + PROCEDURE make_sql + Lparameters toRec, tnId + + lcActiune = Alltrim(This.cActiune) + lcId_util = Alltrim(Str(gnIdUtil)) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId_curs = Alltrim(Str(tnId)) + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcId_curs = Nvl(Alltrim(Str(toRec.id_curs)),"") + lcCurs = Nvl(Alltrim(Str(toRec.curs,10,4)),"") + lcData = DTOS(toRec.data) + lcData2 = DTOS(toRec.data2) + lcId_valuta = Nvl(Alltrim(Str(toRec.id_valuta)),"") + Endif + + Do Case + Case lcActiune = "INSERT" + lcSql = [begin pack_crm.adauga_curs(']+Alltrim(gcS)+[',]+lcCurs+; + [, TO_DATE(]+IIF(!EMPTY(lcData),[']+lcData+['],[NULL])+[,'YYYY-MM-DD')]+; + [, TO_DATE(]+IIF(!EMPTY(lcData2),[']+lcData2+['],[NULL])+[,'YYYY-MM-DD'),]+; + lcId_valuta+[); end;] + Case lcActiune = "UPDATE" + lcSql = [begin pack_crm.modifica_curs(']+Alltrim(gcS)+[',]+lcId_curs+[,]+; + lcCurs+; + [, TO_DATE(]+IIF(!EMPTY(lcData),[']+lcData+['],[NULL])+[,'YYYY-MM-DD')]+; + [, TO_DATE(]+IIF(!EMPTY(lcData2),[']+lcData2+['],[NULL])+[,'YYYY-MM-DD'),]+; + lcId_valuta+[); end;] + + Case lcActiune = "DELETE" + lcSql = [begin pack_crm.sterge_curs(']+Alltrim(gcS)+[',]+lcId_curs+[); end;] + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_delegati AS _cusodatabase OF "..\..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Name = "cus_odata_delegati" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + lcId_util = Alltrim(Str(gnIdUtil)) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + lcnom = gcS + ".nom_responsabili" + *lcamp = "id_nom_delegati" + *!* lclook = gcS + ".dev_oper_mecanici" + *!* lclookid = "dev_oper_mecanici.id_mecanic" + Endif + If Inlist(lcActiune, "UPDATE",'INSERT') + + lcIdclient = Nvl(Alltrim(Str(toRec.id_part)),"") + lcNume = Nvl(Alltrim(toRec.nume),"") + lcBI_seria = Nvl(Left(Alltrim(toRec.bi_seria),2),"") + lcBI_numar = Nvl(Alltrim(Str(toRec.bi_numar)),"NULL") + lcEliberatde = Nvl(Alltrim(toRec.eliberatde),"") + lcinactiv = Nvl(Alltrim(Str(toRec.inactiv)),"") + Endif + + + Do Case + Case lcActiune = "INSERT" + + lcSql = [begin pack_crm.adauga_delegat(']+Alltrim(gcS)+[',]+lcIdclient+[,']+lcNume+[',']+; + lcBI_seria + [',] + lcBI_numar + [,'] + lcEliberatde + [',] + lcId_util +[); end;] + + Case lcActiune = "UPDATE" + + lcSql = [begin pack_crm.modifica_delegat(']+Alltrim(gcS)+[',]+lcId+[,]+lcIdclient+[,']+; + lcNume+[',']+lcBI_seria +[',]+lcBI_numar+[,']+lcEliberatde +[',]+ lcId_util +[); end;] + + Case lcActiune = "DELETE" + + lcSql = [begin pack_crm.sterge_delegat(']+Alltrim(gcS)+[',]+lcId+[,]+lcId_util+[); end;] + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS cus_odata_responsabili AS _cusodatabase OF "..\..\comun\clase\_cus_odata_base.vcx" + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + #INCLUDE "..\..\program files\microsoft visual foxpro 8\foxpro.h" + * + Name = "cus_odata_responsabili" + * + + PROCEDURE make_sql + Lparameters toRec,tnId + + lcActiune = Alltrim(This.cActiune) + + If Inlist(lcActiune, "UPDATE",'INSERT') And Type('toRec') != "O" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') And Type('tnId') != "N" + Return .F. + Endif + + If Inlist(lcActiune, "UPDATE",'DELETE') + lcId = Alltrim(Str(tnId)) + lcnom = gcS + ".nom_responsabili" + lcamp = "nom_responsabili.id_responsabil" + lclook = gcS + ".act" + lclookid = "act.id_responsabil" + Endif + + If Inlist(lcActiune, "UPDATE",'INSERT') + lcnume = NVL(UPPER(ALLTRIM(toRec.nume)),"") + lcfunct = NVL(UPPER(ALLTRIM(toRec.functie)),"") + lcales = NVL(ALLTRIM(STR(toRec.ales)),"") + lcinactiv = NVL(ALLTRIM(STR(toRec.inactiv)),"") + + Endif + + + Do Case + Case lcActiune = "INSERT" + + lcSql = [INSERT INTO ] + gcS + [.nom_responsabili (nume,functie,ales,inactiv) VALUES ('] + lcnume + ; + [','] + lcfunct + [',] + lcales + [,] + lcinactiv + [)] + + Case lcActiune = "UPDATE" + + lcSql = [UPDATE ] + gcS + [.nom_responsabili SET nume = '] + lcnume + ; + [',functie = '] + lcfunct + [',ales = ] + lcales + [,inactiv = ] + lcinactiv +; + [ where id_responsabil = ] + lcId + + Case lcActiune = "DELETE" + + lcSql = [begin nomdelproc('] + lcnom + [','] + lcamp + [',] + lcid + [,'] + lclook + [','] + lclookid + ['); end;] + + Endcase + + This.csql = lcSql + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_agenti AS _frmbase OF "..\..\comun\clase\_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="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cZona.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cZona.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cNume.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cNume.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cTelefon1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cTelefon1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cFunctia.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cFunctia.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cTelefon2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_agenti.cTelefon2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_reset1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="clb_nume" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_functie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_zona" UniqueID="" Timestamp="" /> + + * + *m: do_adauga2 + *m: do_modifica2 + *m: do_sterge2 + * + + * + DoCreate = .T. + Height = 466 + lactiv3 = .T. + Name = "frm_agenti" + Width = 744 + WindowState = 2 + _shape1.Anchor = 10 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 744 + _shape1.ZOrderSet = 2 + _shape2.Anchor = 8 + _shape2.Height = 29 + _shape2.Left = 601 + _shape2.Name = "_shape2" + _shape2.Top = -1 + _shape2.Width = 143 + _shape2.ZOrderSet = 3 + Lb_titlu_alb_b121.Caption = "AGENTI" + Lb_titlu_alb_b121.FontBold = .T. + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 11 + Lb_titlu_alb_b121.ZOrderSet = 4 + BUT_TERMIN1.Anchor = 8 + BUT_TERMIN1.Left = 708 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 6 + BUT_TERMIN1.Top = 0 + BUT_TERMIN1.ZOrderSet = 5 + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Anchor = 8, ; + Left = 643, ; + Name = "But_modifica1", ; + TabIndex = 8, ; + Top = 0 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 8, ; + Left = 609, ; + Name = "But_nou1", ; + TabIndex = 7, ; + Top = 0 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 8, ; + Left = 676, ; + Name = "But_sterge1", ; + TabIndex = 9, ; + Top = 0 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Clb_functie' AS clb_tx_simplu WITH ; + Anchor = 0, ; + Left = 319, ; + Name = "Clb_functie", ; + TabIndex = 2, ; + Top = 37, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Functie", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'clb_nume' AS clb_tx_simplu WITH ; + Anchor = 0, ; + Left = 30, ; + Name = "clb_nume", ; + TabIndex = 1, ; + Top = 37, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Nume", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_zona' AS clb_tx_simplu WITH ; + Anchor = 0, ; + Left = 30, ; + Name = "Clb_zona", ; + TabIndex = 3, ; + Top = 65, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Zona", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Anchor = 0, ; + Left = 636, ; + Name = "Cmd_cauta1", ; + TabIndex = 4, ; + Top = 36 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_reset1' AS cmd_reset WITH ; + Anchor = 0, ; + Left = 636, ; + Name = "Cmd_reset1", ; + TabIndex = 10, ; + Top = 65 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grd_agenti' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 5, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + Height = 336, ; + Left = 15, ; + Name = "grd_agenti", ; + Panel = 1, ; + RecordSource = "crsagenti", ; + TabIndex = 5, ; + Top = 108, ; + Width = 705, ; + ZOrderSet = 6, ; + Column1.ColumnOrder = 3, ; + Column1.ControlSource = "zona", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "cZona", ; + Column1.Width = 172, ; + Column2.ColumnOrder = 1, ; + Column2.ControlSource = "nume_agent", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cNume", ; + Column2.Width = 205, ; + Column3.ColumnOrder = 4, ; + Column3.ControlSource = "telefon1", ; + Column3.FontName = "Arial Narrow", ; + Column3.Name = "cTelefon1", ; + Column3.Width = 116, ; + Column4.ColumnOrder = 2, ; + Column4.ControlSource = "functie", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "cFunctia", ; + Column4.Width = 127, ; + Column5.ColumnOrder = 5, ; + Column5.ControlSource = "telefon2", ; + Column5.FontName = "Arial Narrow", ; + Column5.Name = "cTelefon2", ; + Column5.Width = 116 + *< END OBJECT: ClassLib="..\..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grd_agenti.cFunctia.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Functie", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_agenti.cFunctia.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_agenti.cNume.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nume", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_agenti.cNume.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_agenti.cTelefon1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Telefon 1", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_agenti.cTelefon1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_agenti.cTelefon2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Telefon 2", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_agenti.cTelefon2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_agenti.cZona.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Zona", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_agenti.cZona.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + Lparameters lcFiltru + If Empty(lcFiltru) + lcFiltru = poagenti.ca_baza1.cfiltru + Endif + Thisform.MousePointer= 11 + Thisform.LockScreen=.T. + save_grid_tag(Thisform.grd_agenti) + poagenti.ca_baza1.cfiltru=lcFiltru + poagenti.ca_baza1.afisare() + restore_grid_tag(Thisform.grd_agenti) + Thisform.LockScreen=.F. + Thisform.MousePointer= 0 + + ENDPROC + + PROCEDURE do_adauga + Private pniesire + pniesire=0 + Select crsagenti + Scatter Name loRec Blank + Do Adauga_Modifica_Inregistrare With "agenti",loRec,,"INSERT" + If pniesire=1 + This.actualizeaza_grid1() + Select crsagenti + Locate For nume_agent=loRec.nume_agent + Thisform.grd_agenti.SetFocus() + Endif + + ENDPROC + + PROCEDURE do_adauga2 + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + Store '' To lcFiltru + lcFiltru=[2=2] + lcNume = Strtran(Upper(Alltrim(This.clb_nume.text_simplu1.Value)),['],['']) + lcFunctie = Strtran(Upper(Alltrim(This.clb_functie.text_simplu1.Value)),['],['']) + lcZona = Strtran(Upper(Alltrim(This.clb_zona.text_simplu1.Value)),['],['']) + If !Empty(lcNume) + lcFiltru=lcFiltru + [ and nume_agent like '] + lcNume + [%'] + Endif + If !Empty(lcFunctie) + lcFiltru=lcFiltru + [ and functie like '] + lcFunctie + [%'] + Endif + If !Empty(lcZona) + lcFiltru=lcFiltru + [ and zona like '] + lcZona + [%'] + Endif + + Thisform.actualizeaza_grid1(lcFiltru) + + If Reccount('crsagenti')>0 + Select crsagenti + Go Top + Thisform.grd_agenti.SetFocus() + Else + Messagebox("Cautarea nu a intors rezultate!",0+64,"Info cautare") + Thisform.clb_nume.SetFocus() + Endif + + ENDPROC + + PROCEDURE do_modifica + If Reccount('crsagenti')>0 + Private pniesire + pniesire=0 + Select crsagenti + Scatter Name loRec + Do Adauga_Modifica_Inregistrare With "agenti",loRec,loRec.id_responsabil,"UPDATE" + If pniesire=1 + This.actualizeaza_grid1() + Endif + Endif + ENDPROC + + PROCEDURE do_modifica2 + ENDPROC + + PROCEDURE do_reset + Thisform.clb_nume.text_simplu1.Value = '' + Thisform.clb_functie.text_simplu1.Value = '' + Thisform.clb_zona.text_simplu1.Value = '' + Thisform.Refresh + Thisform.clb_nume.text_simplu1.SetFocus() + + ENDPROC + + PROCEDURE do_sterge + If Reccount('crsagenti')>0 + Select crsagenti + Scatter Name loRec + Do STERGE_INREGISTRARE With "agenti",loRec.id_responsabil + This.actualizeaza_grid1() + Endif + + ENDPROC + + PROCEDURE do_sterge2 + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_agenti_nou AS _frmbase OF "..\..\comun\clase\_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_nume" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_telefon1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_telefon2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_functie" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_agenti1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_agenti2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_zona" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="img_zona" UniqueID="" Timestamp="" /> + + * + *m: do_alege_zona + *p: cnumevechi + *p: nid + *p: nnivelmodificare && - 1 daca utilizatorul are voie sa modifice toate datele ; 0 daca are voie sa modifice doar nr. de telefon + *p: orec + * + + * + cnumevechi = + DoCreate = .T. + Height = 216 + Name = "frm_agenti_nou" + nnivelmodificare = -1 + Width = 372 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 372 + _shape2.Height = 29 + _shape2.Left = 304 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 69 + Lb_titlu_alb_b121.Caption = "AGENT" + Lb_titlu_alb_b121.FontBold = .T. + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 8 + BUT_TERMIN1.Height = 27 + BUT_TERMIN1.Left = 341 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 6 + BUT_TERMIN1.Top = 1 + BUT_TERMIN1.Width = 30 + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Height = 27, ; + Left = 309, ; + Name = "But_renunt1", ; + TabIndex = 7, ; + Top = 1, ; + Width = 30 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Clb_functie' AS clb_tx_simplu WITH ; + Left = 24, ; + Name = "Clb_functie", ; + TabIndex = 2, ; + Top = 74, ; + Text_simplu1.ControlSource = "porec.functie", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Functie", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_nume' AS clb_tx_simplu WITH ; + Left = 24, ; + Name = "Clb_nume", ; + TabIndex = 1, ; + Top = 46, ; + Width = 290, ; + Text_simplu1.ControlSource = "porec.nume_agent", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Nume:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_telefon1' AS clb_tx_simplu WITH ; + Left = 24, ; + Name = "Clb_telefon1", ; + TabIndex = 3, ; + Top = 102, ; + Text_simplu1.ControlSource = "porec.telefon1", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Telefon 1", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_telefon2' AS clb_tx_simplu WITH ; + Left = 24, ; + Name = "Clb_telefon2", ; + TabIndex = 4, ; + Top = 130, ; + Text_simplu1.ControlSource = "porec.telefon2", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Telefon 2", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_zona' AS clb_tx_simplu WITH ; + Left = 24, ; + Name = "Clb_zona", ; + TabIndex = 5, ; + TabStop = .T., ; + ToolTipText = "Pentru modificare, faceti dublu-click!", ; + Top = 158, ; + Visible = .T., ; + Text_simplu1.ControlSource = "porec.zona", ; + Text_simplu1.Name = "Text_simplu1", ; + Text_simplu1.ReadOnly = .T., ; + Lb_simplu1.Caption = "Zona", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_agenti1' AS cus_odata_agenti WITH ; + Left = 192, ; + Name = "Cus_odata_agenti1", ; + Top = 240 + *< END OBJECT: ClassLib="onom_clienti.vcx" BaseClass="custom" /> + + ADD OBJECT 'Cus_odata_agenti2' AS cus_odata_agenti WITH ; + Left = 324, ; + Name = "Cus_odata_agenti2", ; + Top = 36 + *< END OBJECT: ClassLib="onom_clienti.vcx" BaseClass="custom" /> + + ADD OBJECT 'img_zona' AS _image WITH ; + Height = 24, ; + Left = 322, ; + Name = "img_zona", ; + Picture = ..\..\comun\grafice\alege.bmp, ; + Stretch = 2, ; + ToolTipText = "Alegeti agentul", ; + Top = 160, ; + Visible = .T., ; + Width = 24 + *< END OBJECT: ClassLib="..\..\comun\clase\_baza.vcx" BaseClass="image" /> + + PROCEDURE do_alege_zona + Local lnId,lcNume + lnId=poRec.id_zona + lcNume=poRec.zona + If cauta_zona(@lnId,@lcNume) + poRec.id_zona=lnId + poRec.zona=lcNume + Thisform.clb_zona.Refresh() + Endif + + ENDPROC + + PROCEDURE inainte_de_do_termin + Local PLRETURN + lccontrol = Upper(This.ActiveControl.BaseClass ) + If Inlist(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.ActiveControl.ControlSource + &lcval=Thisform.ActiveControl.Value + Endif + + Do Case + Case Empty(porec.nume_agent) + Messagebox('Nu ati completat numele agentului!',0+48,"Atentie") + This.clb_nume.text_simplu1.SetFocus() + PLRETURN=.F. + *!* Case Empty(porec.prenume) + *!* Messagebox('Nu ati completat prenumele agentului!',0+48,"Atentie") + *!* This.clb_prenume.text_simplu1.SetFocus() + *!* PLRETURN=.F. + Case Empty(porec.id_zona) + Messagebox("Nu ati ales zona!",0+48,"Atentie") + This.clb_zona.text_simplu1.SetFocus() + PLRETURN=.F. + Otherwise + PLRETURN=This.cus_odata_agenti1.salvare(This.OREC,This.NID) + Endcase + + Return PLRETURN + + ENDPROC + + PROCEDURE Init + Lparameters toRec, tnId, tcActiune + *!* Local lnid_prospect + DoDefault() + This.orec= toRec + This.nid = tnId + This.cus_odata_agenti1.cactiune = tcActiune + If tcActiune = 'UPDATE' + *!* Select v_zone + *!* Locate For id_zona=toRec.id_zona + *!* If Found() + *!* Thisform.cb_zona._cbbase1.Value=zona + *!* Thisform.cb_zona._cbbase1.Refresh + *!* Endif + Thisform.nNivelModificare=0 + Endif + ENDPROC + + PROCEDURE Clb_zona.Text_simplu1.DblClick + Thisform.do_alege_zona() + ENDPROC + + PROCEDURE Clb_zona.Text_simplu1.KeyPress + Lparameters nKeyCode, nShiftAltCtrl + If Empty(poRec.id_zona) And Empty(poRec.zona) ; + AND Inlist(nKeyCode,9,13) And nShiftAltCtrl=0 + Thisform.do_alege_zona() + Else + DoDefault() + Endif + + ENDPROC + + PROCEDURE img_zona.Click + Thisform.do_alege_zona() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_clienti AS _frmbase OF "..\comun\clase\_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="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cNume.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cNume.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cCod_fiscal.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cCod_fiscal.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cTelefon.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cTelefon.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cAdresa.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cAdresa.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cBanca.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cBanca.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cCont_banca.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cCont_banca.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cReg_comert.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cReg_comert.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cJudet.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cJudet.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cLocalitate.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grd_clienti.cLocalitate.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_reset1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="clb_client" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + + * + *m: do_adauga2 + *m: do_modifica2 + *m: do_sterge2 + * + + * + DoCreate = .T. + Height = 466 + lactiv3 = .T. + Name = "frm_clienti" + Width = 670 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 672 + _shape1.ZOrderSet = 2 + _shape2.Height = 29 + _shape2.Left = 529 + _shape2.Name = "_shape2" + _shape2.Top = -1 + _shape2.Width = 143 + _shape2.ZOrderSet = 3 + Lb_titlu_alb_b121.Caption = "CLIENTI" + Lb_titlu_alb_b121.FontBold = .T. + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 18 + Lb_titlu_alb_b121.ZOrderSet = 4 + BUT_TERMIN1.Left = 636 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 16 + BUT_TERMIN1.Top = 0 + BUT_TERMIN1.ZOrderSet = 5 + Gridsort1.Name = "Gridsort1" + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Left = 571, ; + Name = "But_modifica1", ; + Top = 0 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Left = 537, ; + Name = "But_nou1", ; + Top = 0 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Left = 604, ; + Name = "But_sterge1", ; + Top = 0 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'clb_client' AS clb_tx_simplu WITH ; + Left = 77, ; + Name = "clb_client", ; + TabIndex = 1, ; + Top = 41, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Client", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Left = 386, ; + Name = "Cmd_cauta1", ; + TabIndex = 2, ; + Top = 42 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_reset1' AS cmd_reset WITH ; + Left = 474, ; + Name = "Cmd_reset1", ; + TabIndex = 17, ; + Top = 42 + *< END OBJECT: ClassLib="..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grd_clienti' AS _grdrow WITH ; + ColumnCount = 9, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + Height = 366, ; + Left = 15, ; + Name = "grd_clienti", ; + Panel = 1, ; + RecordSource = "v_clie", ; + TabIndex = 3, ; + Top = 78, ; + Width = 636, ; + ZOrderSet = 6, ; + Column1.ControlSource = "nume", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "cNume", ; + Column1.Width = 172, ; + Column2.ControlSource = "cod_fiscal", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "cCod_fiscal", ; + Column2.Width = 91, ; + Column3.ControlSource = "telefon", ; + Column3.FontName = "Arial Narrow", ; + Column3.Name = "cTelefon", ; + Column4.ControlSource = "adresa", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "cAdresa", ; + Column4.Width = 270, ; + Column5.ControlSource = "banca", ; + Column5.FontName = "Arial Narrow", ; + Column5.Name = "cBanca", ; + Column5.Width = 114, ; + Column6.ControlSource = "cont_banca", ; + Column6.FontName = "Arial Narrow", ; + Column6.Name = "cCont_banca", ; + Column6.Width = 52, ; + Column7.ControlSource = "reg_comert", ; + Column7.FontName = "Arial Narrow", ; + Column7.Name = "cReg_comert", ; + Column7.Width = 133, ; + Column8.ColumnOrder = 9, ; + Column8.ControlSource = "judet", ; + Column8.FontName = "Arial Narrow", ; + Column8.Name = "cJudet", ; + Column8.Visible = .T., ; + Column8.Width = 68, ; + Column9.ColumnOrder = 8, ; + Column9.ControlSource = "localitate", ; + Column9.FontName = "Arial Narrow", ; + Column9.Name = "cLocalitate", ; + Column9.Width = 127 + *< END OBJECT: ClassLib="..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grd_clienti.cAdresa.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Adresa", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cAdresa.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cBanca.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Banca", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cBanca.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cCod_fiscal.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Cod fiscal", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cCod_fiscal.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cCont_banca.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Cont", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cCont_banca.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cJudet.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Judet", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cJudet.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + Visible = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cLocalitate.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Localitate", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cLocalitate.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cNume.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nume client", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cNume.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cReg_comert.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr.Reg.Com.", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cReg_comert.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grd_clienti.cTelefon.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Telefon", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grd_clienti.cTelefon.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + Lparameters lcFiltru + + If Empty(lcFiltru) + lcFiltru = poclie.ca_baza1.cfiltru + Endif + Thisform.MousePointer= 11 + Thisform.LockScreen=.T. + save_grid_tag(Thisform.grd_clienti) + poclie.ca_baza1.cfiltru=lcFiltru + poclie.ca_baza1.afisare() + restore_grid_tag(Thisform.grd_clienti) + Thisform.LockScreen=.F. + Thisform.MousePointer= 0 + + ENDPROC + + PROCEDURE do_adauga + Private pniesire + pniesire=0 + Select v_clie + Scatter Name loRec Blank + Do Adauga_Modifica_Inregistrare With "clienti",loRec,,"INSERT",,"addclie" + If pniesire=1 + This.actualizeaza_grid1() + Select v_clie + Locate For nume=loRec.nume + Thisform.grd_clienti.SetFocus() + Endif + + ENDPROC + + PROCEDURE do_adauga2 + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + Store '' To lcFiltru + lcFiltru = [a.id_tip_part=16 and b.inactiv=0] + lcNume = Strtran(Upper(Alltrim(This.clb_client.text_simplu1.Value)),['],['']) + If !Empty(lcNume) + lcFiltru=lcFiltru + [ and b.nume like '] + lcNume + [%'] + Endif + + Thisform.actualizeaza_grid1(lcFiltru) + + If Reccount('v_clie')>0 + Select v_clie + Go Top + Thisform.grd_clienti.SetFocus() + Else + Messagebox("Cautarea nu a intors rezultate!",0+64,"Info cautare") + Thisform.clb_client.SetFocus() + Endif + + ENDPROC + + PROCEDURE do_modifica + If Reccount('v_clie')>0 + Private pniesire + pniesire=0 + Select v_clie + Scatter Name loRec + Do Adauga_Modifica_Inregistrare With "clienti",loRec,loRec.id_part,"UPDATE" + If pniesire=1 + This.actualizeaza_grid1() + Endif + Endif + ENDPROC + + PROCEDURE do_modifica2 + ENDPROC + + PROCEDURE do_reset + Thisform.clb_client.text_simplu1.Value = '' + Thisform.Refresh + ENDPROC + + PROCEDURE do_sterge + If Reccount('v_clie')>0 + Select v_clie + Scatter Name loRec + Do STERGE_INREGISTRARE With "clienti",loRec.id_part + This.actualizeaza_grid1() + Endif + + ENDPROC + + PROCEDURE do_sterge2 + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_clienti_nou AS _frmbase OF "..\..\comun\clase\_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="Clb_tx_simplu2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ed_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cb_localitate" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cb_judet" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_clienti1" UniqueID="" Timestamp="" /> + + * + *p: cnumevechi + *p: nid + *p: nnivelmodificare && - 1 daca utilizatorul are voie sa modifice toate datele ; 0 daca are voie sa modifice doar nr. de telefon + *p: orec + * + + * + cnumevechi = + DoCreate = .T. + Height = 338 + Name = "frm_clienti_nou" + nnivelmodificare = -1 + Width = 375 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 311 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 69 + Lb_titlu_alb_b121.Caption = "Client" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 11 + BUT_TERMIN1.Height = 27 + BUT_TERMIN1.Left = 345 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 9 + BUT_TERMIN1.Top = 1 + BUT_TERMIN1.Width = 30 + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Height = 27, ; + Left = 315, ; + Name = "But_renunt1", ; + TabIndex = 10, ; + Top = 1, ; + Width = 30 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cb_judet' AS cb_tx_simplu WITH ; + Left = 13, ; + Name = "Cb_judet", ; + TabIndex = 12, ; + Top = 206, ; + _CBBASE1.Enabled = .F., ; + _CBBASE1.Name = "_CBBASE1", ; + _CBBASE1.RowSource = "v_judete.judet", ; + _CBBASE1.RowSourceType = 6, ; + _LBBASE1.Caption = "Judet", ; + _LBBASE1.Name = "_LBBASE1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cb_localitate' AS cb_tx_simplu WITH ; + Left = 13, ; + Name = "Cb_localitate", ; + TabIndex = 5, ; + Top = 178, ; + _CBBASE1.Name = "_CBBASE1", ; + _CBBASE1.RowSource = "v_localitati.localitate,id_loc", ; + _CBBASE1.RowSourceType = 6, ; + _LBBASE1.Caption = "Localitate", ; + _LBBASE1.Name = "_LBBASE1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Left = 13, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 1, ; + Top = 37, ; + Text_simplu1.ControlSource = "porec.nume", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Nume:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu2' AS clb_tx_simplu WITH ; + Left = 13, ; + Name = "Clb_tx_simplu2", ; + TabIndex = 2, ; + Top = 65, ; + Text_simplu1.ControlSource = "porec.cod_fiscal", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Cod fiscal:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu3' AS clb_tx_simplu WITH ; + Left = 13, ; + Name = "Clb_tx_simplu3", ; + TabIndex = 3, ; + Top = 93, ; + Text_simplu1.ControlSource = "porec.telefon", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Telefon", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu5' AS clb_tx_simplu WITH ; + Left = 13, ; + Name = "Clb_tx_simplu5", ; + TabIndex = 6, ; + Top = 234, ; + Text_simplu1.ControlSource = "porec.banca", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Banca:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu6' AS clb_tx_simplu WITH ; + Left = 13, ; + Name = "Clb_tx_simplu6", ; + TabIndex = 7, ; + Top = 262, ; + Text_simplu1.ControlSource = "porec.cont_banca", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Cont banca:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu7' AS clb_tx_simplu WITH ; + Left = 13, ; + Name = "Clb_tx_simplu7", ; + TabIndex = 8, ; + Top = 290, ; + Text_simplu1.ControlSource = "porec.reg_comert", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Registru comert:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_clienti1' AS cus_odata_clienti WITH ; + Left = 334, ; + Name = "Cus_odata_clienti1", ; + Top = 56 + *< END OBJECT: ClassLib="onom_clienti.vcx" BaseClass="custom" /> + + ADD OBJECT 'Ed_tx_simplu1' AS ed_tx_simplu WITH ; + Left = 13, ; + Name = "Ed_tx_simplu1", ; + TabIndex = 4, ; + Top = 121, ; + _edbase1.ControlSource = "porec.adresa", ; + _edbase1.Format = "!K", ; + _edbase1.Height = 53, ; + _edbase1.Left = 71, ; + _edbase1.Name = "_edbase1", ; + _edbase1.Top = 2, ; + _edbase1.Width = 241, ; + _LBBASE1.Caption = "Adresa", ; + _LBBASE1.Name = "_LBBASE1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + PROCEDURE Destroy + Use In v_judete + Use In v_localitati + ENDPROC + + PROCEDURE inainte_de_do_termin + Local PLRETURN + Private pnNivelModificare + pnNivelModificare=Thisform.nNivelModificare + lccontrol = Upper(This.ActiveControl.BaseClass ) + If Inlist(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.ActiveControl.ControlSource + &lcval=Thisform.ActiveControl.Value + Endif + + If !Empty(Thisform.cb_localitate._CBBASE1.Value) + porec.id_loc=v_localitati.id_loc + Else + porec.id_loc=0 + Endif + + Do Case + Case Empty(porec.nume) + Messagebox('Nu ati completat numele clientului!',0+48,"Atentie") + This.clb_tx_simplu1.text_simplu1.SetFocus() + PLRETURN=.F. + + Otherwise + && tip_modificare + && 1 - nr. de telefon + && 2 - toate + *!* If (Type('poRec.tip_modificare')='U' Or (Type('poRec.tip_modificare')<>'U' And poRec.tip_modificare=1)) And Alltrim(Upper(This.cus_odata_clienti1.cactiune))="UPDATE" + && pnNivelModificare + && 0 - nr. de telefon + && -1 - toate + If pnNivelModificare=0 And Alltrim(Upper(This.cus_odata_clienti1.cactiune))="UPDATE" + PLRETURN=This.cus_odata_clienti1.salvare(This.OREC,This.NID) + Else + lcNumeClient=Strtran(" "+porec.nume," SA ","") + lcNumeClient=Strtran(lcNumeClient," SRL ","") + lcNumeClient=Strtran(lcNumeClient," SC ","") + pcexec=[select id_part,nume from ]+gcS+[.vnom_parteneri where nume like '%]+Strtran(Alltrim(lcNumeClient)," ","%")+[%']+; + IIF(porec.id_part>0,[ and id_part!=]+Alltrim(Str(porec.id_part)),[]) + Do While .T. + pnSucces = SQLExec(GNHANDLE,pcexec,'crsnumeclienti') + If pnSucces = 0 + * instructiunea in curs de executie + Else + Exit + Endif + Enddo + If Reccount('crsnumeclienti')>0 + Select crsnumeclienti + Locate For Alltrim(Upper(nume))=Alltrim(Upper(porec.nume)) + If Found() + Messagebox('Mai exista acest client inregistrat',0+48,"Atentie") + This.clb_tx_simplu1.text_simplu1.SetFocus() + Use In crsnumeclienti + PLRETURN=.F. + Else + If Alltrim(Upper(This.cus_odata_clienti1.cactiune))="INSERT" + lnTip=1 + lcNumeVechi="" + Else + lnTip=2 + lcNumeVechi=Thisform.cnumevechi + Endif + Private pnButon + pnButon=0 + ofrmverifclie=Createobject("frm_clienti_verif",porec.nume,lnTip,lcNumeVechi) + ofrmverifclie.Show(1) + If pnButon=1 + PLRETURN=This.cus_odata_clienti1.salvare(This.OREC,This.NID) + Else + This.clb_tx_simplu1.text_simplu1.SetFocus() + PLRETURN=.F. + Endif + Release ofrmverifclie + Endif + Else + PLRETURN=This.cus_odata_clienti1.salvare(This.OREC,This.NID) + Endif + Endif + Endcase + + Return PLRETURN + + ENDPROC + + PROCEDURE Init + Lparameters toRec, tnId, tcActiune + Local lnid_judet + DoDefault() + This.orec= toRec + This.nid = tnId + This.cus_odata_clienti1.cactiune = tcActiune + If tcActiune = 'UPDATE' + Thisform.cnumevechi=toRec.nume + Select v_localitati + Locate For id_loc=toRec.id_loc + If Found() + Thisform.cb_localitate._cbbase1.Value=localitate + Thisform.cb_localitate._cbbase1.Refresh + lnid_judet = id_judet + Select v_judete + Locate For id_judet = lnid_judet + If Found() + Thisform.cb_judet._cbbase1.Value=judet + Thisform.cb_judet._cbbase1.Refresh + Endif + Endif + && tip_modificare + && 1 - nr. de telefon + && 2 - toate + If TYPE('toRec.tip_modificare')='U' OR (TYPE('toRec.tip_modificare')<>'U' AND toRec.tip_modificare=1) + Thisform.nNivelModificare=0 + Thisform.clb_tx_simplu1.text_simplu1.Enabled=.F. + Thisform.clb_tx_simplu2.text_simplu1.Enabled=.F. + Thisform.cb_judet._cbbase1.Enabled=.F. + Thisform.cb_localitate._cbbase1.Enabled=.F. + Thisform.ed_tx_simplu1._edbase1.Enabled=.F. + Thisform.clb_tx_simplu5.text_simplu1.Enabled=.F. + Thisform.clb_tx_simplu6.text_simplu1.Enabled=.F. + Thisform.clb_tx_simplu7.text_simplu1.Enabled=.F. + Endif + Endif + ENDPROC + + PROCEDURE Load + If Used('v_judete') + Use In v_judete + Endif + lcSql=[select id_judet,judet from ] + gcS + [.vnom_judete] + lnSucces=goExecutor.oExecute(lcSql,'v_judete') + If lnSucces < 0 + Messagebox(goExecutor.cEroare,0+16,'Eroare') + Endif + + If Used('v_localitati') + Use In v_localitati + Endif + lcSql=[select id_loc,localitate,id_judet from ] + gcS + [.vnom_localitati] + lnSucces=goExecutor.oExecute(lcSql,'v_localitati') + If lnSucces < 0 + Messagebox(goExecutor.cEroare,0+16,'Eroare') + Endif + ENDPROC + + PROCEDURE Cb_localitate._CBBASE1.InteractiveChange + Select v_localitati + lnid_judet = id_judet + Select v_judete + Set Filter To id_judet = lnid_judet + Go Top + Thisform.cb_judet._CBBASE1.Value=judet + Thisform.cb_judet._CBBASE1.Requery + Thisform.cb_judet._CBBASE1.Refresh + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_curs AS _frmbase OF "..\..\comun\clase\_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="grid_curs" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="grid_curs.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_data" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_reset1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_numeval" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Ck_data2" UniqueID="" Timestamp="" /> + + * + BorderStyle = 3 + DoCreate = .T. + Height = 420 + Name = "frm_curs" + Width = 274 + _shape1.Anchor = 11 + _shape1.Height = 29 + _shape1.Left = -13 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 303 + _shape2.Anchor = 9 + _shape2.Height = 29 + _shape2.Left = 123 + _shape2.Name = "_shape2" + _shape2.Top = 1 + _shape2.Width = 151 + Lb_titlu_alb_b121.Anchor = 3 + Lb_titlu_alb_b121.Caption = "Curs valutar" + Lb_titlu_alb_b121.Left = 8 + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.Top = 6 + BUT_TERMIN1.Anchor = 9 + BUT_TERMIN1.Left = 243 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.Top = 2 + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Anchor = 9, ; + Left = 154, ; + Name = "But_modifica1", ; + Top = 2 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Anchor = 9, ; + Left = 124, ; + Name = "But_nou1", ; + Top = 2 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Anchor = 9, ; + Left = 214, ; + Name = "But_renunt1", ; + Top = 2 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Anchor = 9, ; + Left = 184, ; + Name = "But_sterge1", ; + Top = 2 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Ck_data' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = data, ; + Caption = "Data", ; + FontName = "Arial Narrow", ; + Left = 54, ; + Name = "Ck_data", ; + TabIndex = 1, ; + tip = D, ; + Top = 39, ; + ZOrderSet = 32 + *< END OBJECT: ClassLib="..\..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_data2' AS ck_filtru_numar WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = data2, ; + Caption = "Data2", ; + FontName = "Arial Narrow", ; + Left = 99, ; + Name = "Ck_data2", ; + TabIndex = 1, ; + tip = D, ; + Top = 39, ; + ZOrderSet = 32 + *< END OBJECT: ClassLib="..\..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Ck_numeval' AS ck_filtru_text WITH ; + Alignment = 0, ; + AutoSize = .T., ; + camp_nume = nume_val, ; + Caption = "Valuta", ; + Comment = "*:OnResize=LT", ; + FontName = "Arial Narrow", ; + Left = 6, ; + Name = "Ck_numeval", ; + TabIndex = 19, ; + Top = 39, ; + ZOrderSet = 12 + *< END OBJECT: ClassLib="..\..\comun\clase\caut_ora.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Anchor = 9, ; + Comment = "*:OnResize=LT", ; + Height = 27, ; + Left = 166, ; + Name = "Cmd_cauta1", ; + TabIndex = 34, ; + Top = 35, ; + Width = 48, ; + ZOrderSet = 20 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_reset1' AS cmd_reset WITH ; + Anchor = 9, ; + Comment = "*:OnResize=LT", ; + Height = 27, ; + Left = 218, ; + Name = "Cmd_reset1", ; + TabIndex = 45, ; + Top = 35, ; + Width = 48, ; + ZOrderSet = 19 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'grid_curs' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 4, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + Height = 341, ; + Left = 8, ; + Name = "grid_curs", ; + Panel = 1, ; + RecordMark = .F., ; + RecordSource = "tCurs", ; + Top = 68, ; + Width = 258, ; + Column1.ControlSource = "nume_val", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "Column1", ; + Column1.Width = 74, ; + Column2.ControlSource = "curs", ; + Column2.FontName = "Arial Narrow", ; + Column2.Format = "rk", ; + Column2.InputMask = (get_mask(10,gnPCurs)), ; + Column2.Name = "Column2", ; + Column2.Width = 58, ; + Column3.ControlSource = "data", ; + Column3.FontName = "Arial Narrow", ; + Column3.Name = "Column3", ; + Column3.Width = 49, ; + Column4.ControlSource = "data2", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "Column4", ; + Column4.Width = 51 + *< END OBJECT: ClassLib="..\..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'grid_curs.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nume valuta", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_curs.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_curs.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Curs", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_curs.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_curs.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_curs.Column3.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'grid_curs.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Data2", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'grid_curs.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru = pcFiltru + IF EMPTY(lcFiltru) + lcFiltru = poCurs.ca_baza1.cfiltru + ENDIF + + *lcOrder = This.corderby + " " + This.Casc + + save_grid_tag(thisform.grid_curs) + poCurs.ca_baza1.cfiltru = lcFiltru + *poCurs.ca_baza1.corder = lcOrder + + poCurs.ca_baza1.afisare() + restore_grid_tag(thisform.grid_curs) + IF RECCOUNT('tCurs')>0 + thisform.grid_curs.SetFocus() + ENDIF + + + + ENDPROC + + PROCEDURE do_adauga + Select tCurs + Scatter Name loRec Blank + loRec.data = DATE() + Do Adauga_Modifica_Inregistrare With "curs",loRec,,"INSERT" + This.actualizeaza_grid1() + + ENDPROC + + PROCEDURE do_cauta + LOCAL lcFiltru + lcFiltru = "" + + * valuta + If thisform.ck_numeval.Value=1 + lcFiltru = lcFiltru + thisform.ck_numeval.filtru + ENDIF + + IF this.ck_data.Value = 1 + lcFiltru = lcFiltru + Thisform.ck_data.filtru + ENDIF + + IF this.ck_data2.Value = 1 + lcFiltru = lcFiltru + Thisform.ck_data2.filtru + ENDIF + + If !Empty(lcFiltru) + lcFiltru = Substr(lcFiltru,6) + ELSE + lcFiltru = [2=2] + ENDIF + + Thisform.actualizeaza_grid1(lcFiltru) + Thisform.grid_curs.SetFocus() + + ENDPROC + + PROCEDURE do_reset + thisform.ck_numeval.Value = 0 + thisform.ck_data.Value = 0 + thisform.ck_data2.Value = 0 + thisform.Refresh() + ENDPROC + + PROCEDURE inainte_de_do_modifica + Select tCurs + Scatter Name loRec + Do Adauga_Modifica_Inregistrare With "curs",loRec,loRec.id_curs,"UPDATE" + thisform.actualizeaza_grid1() + ENDPROC + + PROCEDURE inainte_de_do_sterge + Select tCurs + Scatter Name lorec + Do STERGE_INREGISTRARE With "curs",lorec.id_curs + This.actualizeaza_grid1() + + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_curs_nou AS _frmbase OF "..\..\comun\clase\_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="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtCurs" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtData2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="CUS_ODATA_CURS1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Command2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="txtValuta" UniqueID="" Timestamp="" /> + + * + *p: nid + *p: orec + * + + * + BorderStyle = 3 + DoCreate = .T. + Height = 143 + Name = "frm_curs_nou" + nid = + orec = + Width = 208 + _shape1.Anchor = 11 + _shape1.Name = "_shape1" + _shape2.Anchor = 9 + _shape2.Height = 29 + _shape2.Left = 147 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 61 + Lb_titlu_alb_b121.Caption = "Curs valutar" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 7 + BUT_TERMIN1.Anchor = 9 + BUT_TERMIN1.Left = 178 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 5 + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Anchor = 9, ; + Left = 149, ; + Name = "But_renunt1", ; + TabIndex = 6, ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Command2' AS commandbutton WITH ; + Caption = "", ; + FontName = "Arial Narrow", ; + Height = 25, ; + Left = 168, ; + Name = "Command2", ; + Picture = ..\grafice\find.bmp, ; + TabIndex = 1, ; + Top = 36, ; + Width = 28 + *< END OBJECT: BaseClass="commandbutton" /> + + ADD OBJECT 'CUS_ODATA_CURS1' AS cus_odata_curs WITH ; + Left = 102, ; + Name = "CUS_ODATA_CURS1", ; + Top = 8 + *< END OBJECT: ClassLib="onom_clienti.vcx" BaseClass="custom" /> + + ADD OBJECT 'Label1' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nume valuta", ; + Height = 17, ; + Left = 14, ; + Name = "Label1", ; + TabIndex = 8, ; + Top = 41, ; + Width = 71 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Curs", ; + Height = 17, ; + Left = 14, ; + Name = "Label2", ; + TabIndex = 9, ; + Top = 66, ; + Width = 29 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data 1", ; + Height = 17, ; + Left = 14, ; + Name = "Label3", ; + TabIndex = 10, ; + Top = 91, ; + Width = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Data 2", ; + Height = 17, ; + Left = 14, ; + Name = "Label4", ; + TabIndex = 11, ; + Top = 117, ; + Width = 38 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'txtCurs' AS textbox WITH ; + ControlSource = "porec.curs", ; + Height = 23, ; + Left = 91, ; + Name = "txtCurs", ; + TabIndex = 2, ; + Top = 63, ; + Width = 100 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData1' AS textbox WITH ; + ControlSource = "porec.data", ; + Height = 23, ; + Left = 91, ; + Name = "txtData1", ; + TabIndex = 3, ; + Top = 88, ; + Width = 100 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtData2' AS textbox WITH ; + ControlSource = "porec.data2", ; + Height = 23, ; + Left = 91, ; + Name = "txtData2", ; + TabIndex = 4, ; + Top = 114, ; + Width = 100 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'txtValuta' AS textbox WITH ; + ControlSource = "porec.nume_val", ; + Height = 23, ; + Left = 91, ; + Name = "txtValuta", ; + TabIndex = 12, ; + Top = 36, ; + Width = 75 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE inainte_de_do_termin + Private pnIdCursNou + Local plreturn + Store 0 To pnIdCursNou + + lccontrol = Upper(This.ActiveControl.BaseClass ) + If Inlist(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.ActiveControl.ControlSource + &lcval=Thisform.ActiveControl.Value + Endif + + Do Case + Case Empty(porec.id_valuta) + Messagebox('Nu ati introdus valuta!',0+48,"Atentie") + Thisform.cboValuta.SetFocus() + plreturn = .F. + Case Empty(porec.curs) + Messagebox('Nu ati introdus valoarea cursului!',0+48,"Atentie") + Thisform.txtCurs.SetFocus() + plreturn = .F. + Case Empty(porec.data) + Messagebox('Nu ati introdus data initiala a cursului!',0+48,"Atentie") + Thisform.txtData.SetFocus() + plreturn = .F. + Case Empty(porec.data2) + Messagebox('Nu ati introdus data finala a cursului!',0+48,"Atentie") + Thisform.txtData2.SetFocus() + plreturn = .F. + Otherwise + plreturn=Thisform.cus_odata_curs1.salvare(This.OREC,This.NID) + Endcase + + Return plreturn + ENDPROC + + PROCEDURE Init + Lparameters toRec, tnId, tcActiune + DoDefault() + + This.orec = toRec + This.nid = tnId + This.cus_odata_curs1.cactiune = tcActiune + + ENDPROC + + PROCEDURE Command2.Click + LOCAL lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcFiltruOriginal, lcNumeProc + lcselect = [select v.id_valuta, v.nume_val FROM ] + gcs + [.vnom_valute v where] + lcfiltru = [1=2] + lcschema = [] + lcorder = [v.nume_val] + lccoloane = [nume_val] + lcTitlu = [Alegeti valuta] + lcTitluColoane = [Nume] + lcFiltruOriginal = [v.inactiv = 0] + lcNumeProc = "" + locauta = cauta_alfa(lcselect, lcfiltru, lcschema, lcorder, lccoloane, lcTitlu, lcTitluColoane, lcNumeProc, .F., lcFiltruOriginal) + + IF buton=2 + RETURN + ENDIF + + porec.id_valuta = locauta.id_valuta + porec.nume_val = locauta.nume_val + thisform.txtValuta.Refresh + + + ENDPROC + + PROCEDURE txtData1.Valid + porec.data2 = porec.data + thisform.txtdata2.Refresh + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_delegati AS _frmbase OF "..\..\comun\clase\_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="gdelegati" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column3.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column4.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column5.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column5.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column6.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="gdelegati.Column6.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_delegat" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmd_cauta1" UniqueID="" Timestamp="" /> + + * + *p: nidpartener && Pentru cautarile in functie de un partener. + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 382 + lactiv3 = .T. + lactiv4 = .T. + Name = "frm_delegati" + Width = 587 + _shape1.Height = 29 + _shape1.Left = -3 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 592 + _shape2.Height = 29 + _shape2.Left = 466 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 122 + Lb_titlu_alb_b121.Caption = "Delegati" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 8 + BUT_TERMIN1.Height = 27 + BUT_TERMIN1.Left = 557 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 7 + BUT_TERMIN1.Top = 1 + BUT_TERMIN1.Width = 30 + * + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Height = 27, ; + Left = 498, ; + Name = "But_modifica1", ; + TabIndex = 5, ; + Top = 1, ; + Visible = .T., ; + Width = 30 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Height = 27, ; + Left = 468, ; + Name = "But_nou1", ; + TabIndex = 4, ; + Top = 1, ; + Width = 30 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Height = 27, ; + Left = 527, ; + Name = "But_sterge1", ; + TabIndex = 6, ; + Top = 1, ; + Visible = .T., ; + Width = 30 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Clb_delegat' AS clb_tx_simplu WITH ; + Left = 26, ; + Name = "Clb_delegat", ; + TabIndex = 1, ; + Top = 36, ; + TEXT_SIMPLU1.Name = "TEXT_SIMPLU1", ; + LB_SIMPLU1.Caption = "Delegat", ; + LB_SIMPLU1.Name = "LB_SIMPLU1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Left = 326, ; + Name = "Cmd_cauta1", ; + TabIndex = 2, ; + Top = 37 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'gdelegati' AS _grdrow WITH ; + ColumnCount = 6, ; + DeleteMark = .F., ; + FontName = "Arial Narrow", ; + Height = 300, ; + Left = 12, ; + Name = "gdelegati", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordSource = "v_delegati", ; + TabIndex = 3, ; + Top = 72, ; + Width = 565, ; + Column1.ControlSource = "nume_part", ; + Column1.FontName = "Arial Narrow", ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 168, ; + Column2.ControlSource = "nume", ; + Column2.FontName = "Arial Narrow", ; + Column2.Name = "Column2", ; + Column2.ReadOnly = .T., ; + Column2.Width = 169, ; + Column3.ControlSource = "bi_seria", ; + Column3.FontName = "Arial Narrow", ; + Column3.Name = "Column3", ; + Column3.ReadOnly = .T., ; + Column3.Width = 49, ; + Column4.ColumnOrder = 5, ; + Column4.ControlSource = "eliberatde", ; + Column4.FontName = "Arial Narrow", ; + Column4.Name = "Column4", ; + Column4.ReadOnly = .T., ; + Column4.Width = 77, ; + Column5.ColumnOrder = 6, ; + Column5.ControlSource = "inactiv", ; + Column5.FontName = "Arial Narrow", ; + Column5.Name = "Column5", ; + Column5.ReadOnly = .T., ; + Column5.Sparse = .F., ; + Column5.Width = 48, ; + Column6.ColumnOrder = 4, ; + Column6.ControlSource = "bi_numar", ; + Column6.FontName = "Arial Narrow", ; + Column6.Name = "Column6", ; + Column6.ReadOnly = .T., ; + Column6.Width = 66 + *< END OBJECT: ClassLib="..\..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT 'gdelegati.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Client", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gdelegati.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gdelegati.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Delegat", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gdelegati.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gdelegati.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "BI_seria", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gdelegati.Column3.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gdelegati.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Eliberat de..", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gdelegati.Column4.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'gdelegati.Column5.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + FontName = "Arial Narrow", ; + Height = 17, ; + Left = 16, ; + Name = "Check1", ; + ReadOnly = .T., ; + Top = 71, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT 'gdelegati.Column5.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Inactiv", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gdelegati.Column6.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "BI_numar", ; + FontName = "Arial Narrow", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT 'gdelegati.Column6.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + FontName = "Arial Narrow", ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1" + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru=pcFiltru + IF EMPTY(lcFiltru) + lcFiltru=podelegati.ca_baza1.cfiltru + ENDIF + save_grid_tag(thisform.gdelegati) + podelegati.ca_baza1.cfiltru=lcFiltru + podelegati.ca_baza1.afisare() + restore_grid_tag(thisform.gdelegati) + *!* IF RECCOUNT('v_delegati')>0 + thisform.gdelegati.SetFocus() + *!* ELSE + *!* thisform.lb_delegati.SetFocus() + *!* ENDIF + + ENDPROC + + PROCEDURE do_adauga + Private pniesire + pniesire=0 + Select v_delegati + Scatter Name loRec Blank + If !Empty(Thisform.nidpartener) + loRec.id_part = Thisform.nidpartener + Do update_clienti With Thisform.nidpartener In onom_clienti.prg + Else + Do update_clienti In onom_clienti.prg + Endif + Do Adauga_Modifica_Inregistrare With "delegati",loRec,,"INSERT",,"adddeleg" + If pniesire=1 + This.actualizeaza_grid1() + Endif + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru=[] + lcDelegat = Strtran(Upper(Alltrim(Thisform.clb_delegat.texT_SIMPLU1.Value)),['],['']) + If !Empty(Thisform.nidpartener) + lcFiltru = [id_part = ] + Alltrim(Str(Thisform.nidpartener)) + [ and ] + Endif + If !Empty(lcDelegat) + lcFiltru = lcFiltru + [nume like '] + lcDelegat + [%'] + Else + lcFiltru = lcFiltru + [2=2] + Endif + This.MousePointer= 11 + This.LockScreen=.T. + Thisform.actualizeaza_grid1(lcFiltru) + If Reccount('v_delegati')=0 + Messagebox("Cautarea nu a intors rezultate!",0+64,"Info cautare") + Thisform.clb_delegat.SetFocus() + Endif + This.LockScreen=.F. + This.MousePointer= 0 + ENDPROC + + PROCEDURE do_modifica + Private pniesire + pniesire=0 + Do update_clienti In onom_clienti.prg + Select v_delegati + Scatter Name loRec + Do Adauga_Modifica_Inregistrare With "delegati", loRec, loRec.id_responsabil,"UPDATE",,"moddeleg" + If pniesire=1 + This.actualizeaza_grid1() + Endif + ENDPROC + + PROCEDURE do_sterge + SELECT v_delegati + SCATTER NAME lorec + Do STERGE_INREGISTRARE With "delegati",loRec.id_responsabil + + this.actualizeaza_grid1() + + ENDPROC + + PROCEDURE Init + Lparameters tnidpartener + DODEFAULT() + + If !Empty(tnidpartener) + Thisform.nidpartener=tnidpartener + Endif + ENDPROC + + PROCEDURE KeyPress + Lparameters nKeyCode, nShiftAltCtrl + lcControl = Upper(Alltrim(This.ActiveControl.Name)) + If nKeyCode = 13 And lcControl = 'GDELEGATI' && enter + Nodefault + Thisform.but_TERMIN1.SetFocus + Else + DoDefault(nKeyCode, nShiftAltCtrl) + Endif + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_delegati_nou AS _frmbase OF "..\..\comun\clase\_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="Cus_odata_delegati1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_checkbox1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu4" UniqueID="" Timestamp="" /> + + * + *p: nid + *p: orec + * + + * + DoCreate = .T. + Height = 182 + Name = "frm_delegati_nou" + Width = 375 + _SHAPE1.Name = "_SHAPE1" + _SHAPE2.Height = 29 + _SHAPE2.Left = 312 + _SHAPE2.Name = "_SHAPE2" + _SHAPE2.Top = 0 + _SHAPE2.Width = 65 + LB_TITLU_ALB_B121.Caption = "Delegat" + LB_TITLU_ALB_B121.Name = "LB_TITLU_ALB_B121" + LB_TITLU_ALB_B121.TabIndex = 9 + BUT_TERMIN1.Left = 345 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 7 + BUT_TERMIN1.Top = 1 + * + + ADD OBJECT '_checkbox1' AS _checkbox WITH ; + Alignment = 0, ; + Caption = "Inactiv", ; + ControlSource = "porec.inactiv", ; + Left = 44, ; + Name = "_checkbox1", ; + TabIndex = 6, ; + Top = 156 + *< END OBJECT: ClassLib="..\..\comun\clase\_baza.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Left = 315, ; + Name = "But_renunt1", ; + TabIndex = 8, ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cb_tx_simplu1' AS cb_tx_simplu WITH ; + Left = 42, ; + Name = "Cb_tx_simplu1", ; + TabIndex = 1, ; + Top = 38, ; + _cbbase1.ColumnCount = 2, ; + _cbbase1.ControlSource = "porec.nume_part", ; + _cbbase1.Name = "_cbbase1", ; + _cbbase1.RowSource = "v_clienti.nume,cod_fiscal", ; + _cbbase1.RowSourceType = 2, ; + _lbbase1.Caption = "Client:", ; + _lbbase1.Name = "_lbbase1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Left = 42, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 2, ; + Top = 66, ; + Text_simplu1.ControlSource = "porec.nume", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Delegat:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu2' AS clb_tx_simplu WITH ; + Height = 29, ; + Left = 42, ; + Name = "Clb_tx_simplu2", ; + TabIndex = 3, ; + Top = 94, ; + Width = 146, ; + Text_simplu1.ControlSource = "porec.bi_seria", ; + Text_simplu1.Height = 23, ; + Text_simplu1.Left = 101, ; + Text_simplu1.MaxLength = 10, ; + Text_simplu1.Name = "Text_simplu1", ; + Text_simplu1.Top = 3, ; + Text_simplu1.Width = 42, ; + Lb_simplu1.Caption = "BI serie:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu3' AS clb_tx_simplu WITH ; + Left = 42, ; + Name = "Clb_tx_simplu3", ; + TabIndex = 5, ; + Top = 122, ; + Text_simplu1.ControlSource = "porec.eliberatde", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Eliberat de:", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu4' AS clb_tx_simplu WITH ; + Height = 29, ; + Left = 187, ; + Name = "Clb_tx_simplu4", ; + TabIndex = 4, ; + Top = 94, ; + Width = 145, ; + TEXT_SIMPLU1.ControlSource = "porec.bi_numar", ; + TEXT_SIMPLU1.Format = "rk", ; + TEXT_SIMPLU1.Height = 23, ; + TEXT_SIMPLU1.InputMask = "999999", ; + TEXT_SIMPLU1.Left = 33, ; + TEXT_SIMPLU1.MaxLength = 10, ; + TEXT_SIMPLU1.Name = "TEXT_SIMPLU1", ; + TEXT_SIMPLU1.Top = 3, ; + TEXT_SIMPLU1.Width = 104, ; + LB_SIMPLU1.Caption = "nr.:", ; + LB_SIMPLU1.Name = "LB_SIMPLU1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_delegati1' AS cus_odata_delegati WITH ; + Left = 348, ; + Name = "Cus_odata_delegati1", ; + Top = 48 + *< END OBJECT: ClassLib="onom_clienti.vcx" BaseClass="custom" /> + + PROCEDURE inainte_de_do_termin + LOCAL PLRETURN + + lccontrol = UPPER(this.ActiveControl.BaseClass ) + IF INLIST(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.Activecontrol.controlsource + &lcval=thisform.ActiveControl.value + ENDIF + + + Do Case + Case Empty(porec.nume) + Messagebox('Nu ati completat denumirea delegatului!',0+48,"Atentie") + *!* This.clb_tx_simplu2.Text_simplu1.SetFocus() + this.cb_tx_simplu1._CBBASE1.SetFocus() + + plreturn=.F. + + + + OTHERWISE + If Alltrim(Upper(This.cus_odata_delegati1.cactiune))="INSERT" &&Or (Alltrim(Upper(This.cus_odata_mecanici1.cactiune))="UPDATE") + IF USED('exista_del') + USE IN exista_del + ENDIF + pcexec=[select count(*) as inreg from ]+gcS+[.vnom_delegati ] + ; + [where (TRIM(nume)=']+Alltrim(porec.nume)+[') and ] + ; + [id_part=]+ALLTRIM(STR(porec.id_part)) + *!* [TRIM(nume)=']+ALLTRIM(porec.nume)+['] + Do While .T. + pnSucces = SQLEXEC(GNHANDLE,pcexec,'exista_del') + If pnSucces = 0 + * instructiunea in curs de executie + Else + Exit + Endif + Enddo + Select exista_del + lnInreg=exista_del.inreg + Use In exista_del + If lnInreg>0 + Messagebox('Mai exista acest delegat inregistrat!',0+48,"Atentie") + *!* This.clb_tx_simplu2.Text_simplu1.SetFocus() + this.cb_tx_simplu1._CBBASE1.SetFocus() + plreturn=.F. + ELSE + PLRETURN=This.cus_odata_delegati1.salvare(This.OREC,This.NID) + ENDIF + ELSE + *!* WAIT WINDOW "pe else" + PLRETURN=This.cus_odata_delegati1.salvare(This.OREC,This.NID) + ENDIF + + ENDCASE + + Return PLRETURN + + + + + ENDPROC + + PROCEDURE Init + Lparameters toRec, tnId, tcActiune + + DoDefault() + + This.orec= toRec + This.nid = tnId + This.cus_odata_delegati1.cactiune = tcActiune + Do Case + Case tcActiune='INSERT' And !Empty(toRec.id_part) + Select v_clienti + Locate For id_part = toRec.id_part + If Found() + porec.nume=nume + This.orec.nume=nume + toRec.nume=nume + Thisform.cb_tx_simplu1._cbbase1.Refresh + Thisform.cb_tx_simplu1._cbbase1.Enabled=.F. + Endif + Case tcActiune='UPDATE' + Thisform.cb_tx_simplu1._cbbase1.Enabled=.F. + Endcase + ENDPROC + + PROCEDURE Cb_tx_simplu1._cbbase1.LostFocus + porec.id_part = v_clienti.id_part + *!* POREC.MARCA = V_PERSONAL.MARCA + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_responsabili AS _frmbase OF "..\..\comun\clase\_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="Cmd_cauta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column1.Responsabill" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column3.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column4.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column4.Check1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column5.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_gnom_responsabili.Column5.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_nou1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_sterge1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="But_modifica1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_nom_responsabili" UniqueID="" Timestamp="" /> + + * + *m: log + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 303 + lactiv3 = .T. + lactiv4 = .T. + Name = "frm_responsabili" + Width = 504 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 504 + _shape2.Height = 29 + _shape2.Left = 383 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 121 + Lb_titlu_alb_b121.Caption = "Responsabili" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 8 + BUT_TERMIN1.Left = 472 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 4 + BUT_TERMIN1.Top = 1 + BUT_TERMIN1.Visible = .T. + * + + ADD OBJECT '_gnom_responsabili' AS _grdrow WITH ; + ColumnCount = 5, ; + DeleteMark = .F., ; + Height = 191, ; + Left = 8, ; + Name = "_gnom_responsabili", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordSource = "v_responsabili", ; + TabIndex = 3, ; + Top = 101, ; + Width = 488, ; + Column1.ColumnOrder = 2, ; + Column1.ControlSource = "nume", ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 210, ; + Column2.ColumnOrder = 3, ; + Column2.ControlSource = "functie", ; + Column2.Name = "Column2", ; + Column2.ReadOnly = .T., ; + Column2.Width = 126, ; + Column3.ColumnOrder = 4, ; + Column3.ControlSource = "ales", ; + Column3.Name = "Column3", ; + Column3.ReadOnly = .T., ; + Column3.Sparse = .F., ; + Column3.Width = 46, ; + Column4.ColumnOrder = 5, ; + Column4.ControlSource = "inactiv", ; + Column4.Name = "Column4", ; + Column4.ReadOnly = .T., ; + Column4.Sparse = .F., ; + Column4.Width = 40, ; + Column5.ColumnOrder = 1, ; + Column5.ControlSource = "id_responsabil", ; + Column5.Name = "Column5", ; + Column5.ReadOnly = .T., ; + Column5.Width = 31 + *< END OBJECT: ClassLib="..\..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT '_gnom_responsabili.Column1.Responsabill' AS header WITH ; + Alignment = 2, ; + Caption = "Responsabil", ; + Name = "Responsabill" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_gnom_responsabili.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT '_gnom_responsabili.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Functia", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_gnom_responsabili.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT '_gnom_responsabili.Column3.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + Height = 17, ; + Left = 9, ; + Name = "Check1", ; + ReadOnly = .T., ; + Top = 30, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT '_gnom_responsabili.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Ales", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_gnom_responsabili.Column4.Check1' AS checkbox WITH ; + Alignment = 0, ; + Caption = "", ; + Centered = .T., ; + Height = 17, ; + Left = 22, ; + Name = "Check1", ; + ReadOnly = .T., ; + Top = 30, ; + Width = 60 + *< END OBJECT: BaseClass="checkbox" /> + + ADD OBJECT '_gnom_responsabili.Column4.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Inactiv", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_gnom_responsabili.Column5.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Id", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_gnom_responsabili.Column5.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'But_modifica1' AS but_modifica WITH ; + Left = 415, ; + Name = "But_modifica1", ; + TabIndex = 6, ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_nou1' AS but_nou WITH ; + Left = 385, ; + Name = "But_nou1", ; + TabIndex = 7, ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'But_sterge1' AS but_sterge WITH ; + Left = 443, ; + Name = "But_sterge1", ; + TabIndex = 5, ; + Top = 1, ; + Visible = .T. + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmd_cauta1' AS cmd_cauta WITH ; + Left = 309, ; + Name = "Cmd_cauta1", ; + TabIndex = 2, ; + Top = 44 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'lb_nom_responsabili' AS clb_tx_simplu WITH ; + Left = 8, ; + Name = "lb_nom_responsabili", ; + TabIndex = 1, ; + Top = 44, ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Responsabil", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + PROCEDURE actualizeaza_grid1 + LPARAMETERS pcFiltru + LOCAL lcFiltru + lcFiltru=pcFiltru + IF EMPTY(lcFiltru) + lcFiltru=poresponsabili.ca_baza1.cfiltru + ENDIF + save_grid_tag(thisform._gnom_responsabili) + poresponsabili.ca_baza1.cfiltru=lcFiltru + poresponsabili.ca_baza1.afisare() + restore_grid_tag(thisform._gnom_responsabili) + IF RECCOUNT('v_responsabili')>0 + thisform._gnom_responsabili.SetFocus() + ELSE + thisform.lb_nom_responsabili.SetFocus() + ENDIF + + ENDPROC + + PROCEDURE do_adauga + SELECT v_responsabili + SCATTER NAME loRec blank + DO Adauga_Modifica_Inregistrare WITH "responsabili",loRec,,"INSERT" + this.actualizeaza_grid1() + ENDPROC + + PROCEDURE do_cauta + Local lcFiltru + lcFiltru=[] + lcNume = STRTRAN(Upper(Alltrim(This.lb_nom_responsabili.text_simplu1.value)),['],['']) + If !Empty(lcNume) + lcFiltru=[nume like ']+lcNume+[%'] + ELSE + lcFiltru = [2=2] + Endif + This.MousePointer= 11 + This.LockScreen=.T. + Thisform.actualizeaza_grid1(lcFiltru) + IF RECCOUNT()=0 + MESSAGEBOX("Cautarea nu a intors rezultate!",0+64,"Info cautare") + ENDIF + This.LockScreen=.F. + This.MousePointer= 0 + ENDPROC + + PROCEDURE do_modifica + Select v_responsabili + Scatter Name loRec + Do Adauga_Modifica_Inregistrare With "responsabili",loRec,loRec.Id_responsabil,"UPDATE" + thisform.actualizeaza_grid1() + + + ENDPROC + + PROCEDURE do_sterge + SELECT v_responsabili + SCATTER NAME lorec + Do STERGE_INREGISTRARE With "responsabili",loRec.id_responsabil + + this.actualizeaza_grid1() + + + ENDPROC + + PROCEDURE KeyPress + Lparameters nKeyCode, nShiftAltCtrl + lcActiveControl = UPPER(ALLTRIM(this.ActiveControl.name)) + + IF nKeyCode=13 AND lcActiveControl = '_GNOM_RESPONSABILI' + Nodefault + this.LB_nom_responsabili.SetFocus + ENDIF + + + DODEFAULT(nKeyCode, nShiftAltCtrl) + + + ENDPROC + + PROCEDURE log + LPARAMETERS tctabela,tnId + + lcId = ALLTRIM(STR(tnId)) + lctabela = UPPER(ALLTRIM(tctabela)) + PRIVATE polog,pcschema1,pcselect1 + STORE '' TO polog + pcschema1 = [''] + pcselect1=['select * from ] + gcS + [.vlog where '] + pcorder1=['dataora'] + pcfiltru1 = [tabel = '] + lctabela + [' and id_tabel = ] + lcId + gencursor('polog','v_log',pcselect1,pcfiltru1,pcschema1,pcorder1) + polog.ca_baza1.afisare() + ofrmlog=CREATEOBJECT('frm_log') + ofrmlog.show(1) + RELEASE polog + ENDPROC + + PROCEDURE Unload + IF USED('v_responsabili') + USE IN v_responsabili + ENDIF + ENDPROC + + PROCEDURE _gnom_responsabili.Column1.Text1.DblClick + thisform.log("NOM_RESPONSABILI",v_responsabili.id_responsabil) + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_responsabili_nou AS _frmbase OF "..\..\comun\clase\_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="But_renunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Clb_tx_simplu2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_checkbox1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cus_odata_responsabili1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_checkbox2" UniqueID="" Timestamp="" /> + + * + *p: nid + *p: orec + * + + * + BorderStyle = 1 + DoCreate = .T. + Height = 166 + Name = "frm_responsabili_nou" + Width = 375 + _shape1.Name = "_shape1" + _shape2.Height = 29 + _shape2.Left = 312 + _shape2.Name = "_shape2" + _shape2.Top = 0 + _shape2.Width = 62 + Lb_titlu_alb_b121.Caption = "Responsabili" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + Lb_titlu_alb_b121.TabIndex = 7 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.TabIndex = 5 + * + + ADD OBJECT '_checkbox1' AS _checkbox WITH ; + Alignment = 0, ; + Caption = "Ales", ; + ControlSource = "porec.ales", ; + Height = 17, ; + Left = 33, ; + Name = "_checkbox1", ; + TabIndex = 3, ; + TabStop = .F., ; + Top = 120, ; + Width = 42 + *< END OBJECT: ClassLib="..\..\comun\clase\_baza.vcx" BaseClass="checkbox" /> + + ADD OBJECT '_checkbox2' AS _checkbox WITH ; + Alignment = 0, ; + Caption = "Inactiv", ; + ControlSource = "porec.inactiv", ; + Left = 33, ; + Name = "_checkbox2", ; + TabIndex = 4, ; + TabStop = .F., ; + Top = 144 + *< END OBJECT: ClassLib="..\..\comun\clase\_baza.vcx" BaseClass="checkbox" /> + + ADD OBJECT 'But_renunt1' AS but_renunt WITH ; + Left = 312, ; + Name = "But_renunt1", ; + TabIndex = 6, ; + Top = 1 + *< END OBJECT: ClassLib="..\..\comun\clase\cmd_butoane.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Clb_tx_simplu1' AS clb_tx_simplu WITH ; + Left = 31, ; + Name = "Clb_tx_simplu1", ; + TabIndex = 1, ; + Top = 44, ; + Text_simplu1.ControlSource = "porec.nume", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.InputMask = "", ; + Text_simplu1.Name = "Text_simplu1", ; + Text_simplu1.Value = , ; + Lb_simplu1.Caption = "Responsabil", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Clb_tx_simplu2' AS clb_tx_simplu WITH ; + Left = 31, ; + Name = "Clb_tx_simplu2", ; + TabIndex = 2, ; + Top = 83, ; + Text_simplu1.ControlSource = "porec.functie", ; + Text_simplu1.Format = "!K", ; + Text_simplu1.Name = "Text_simplu1", ; + Lb_simplu1.Caption = "Functie", ; + Lb_simplu1.Name = "Lb_simplu1" + *< END OBJECT: ClassLib="..\..\comun\clase\lb_tx.vcx" BaseClass="container" /> + + ADD OBJECT 'Cus_odata_responsabili1' AS cus_odata_responsabili WITH ; + Left = 336, ; + Name = "Cus_odata_responsabili1", ; + Top = 48 + *< END OBJECT: ClassLib="onom_clienti.vcx" BaseClass="custom" /> + + PROCEDURE inainte_de_do_termin + LOCAL PLRETURN + + lccontrol = UPPER(this.ActiveControl.BaseClass ) + IF INLIST(lccontrol,"TEXTBOX","EDITBOX","COMBOBOX") + lcval=This.Activecontrol.controlsource + &lcval=thisform.ActiveControl.value + ENDIF + + + + PLRETURN=This.cus_odata_responsabili1.salvare(This.OREC,This.NID) + Return PLRETURN + + ENDPROC + + PROCEDURE Init + LPARAMETERS toRec, tnId, tcActiune + + DODEFAULT() + + this.orec= toRec + this.nid = tnId + this.cus_odata_RESPONSABILI1.cactiune = tcActiune + ENDPROC + + PROCEDURE _checkbox1.DblClick + this.Value = ABS(this.Value - 1) + + ENDPROC + + PROCEDURE _checkbox2.DblClick + this.Value = ABS(this.Value - 1) + ENDPROC + +ENDDEFINE + +DEFINE CLASS frm_tipc AS _frmbase OF "..\..\comun\clase\_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="_grdrow1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_grdrow1.Column1.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_grdrow1.Column1.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_grdrow1.Column2.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_grdrow1.Column2.Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_grdrow1.Column3.Header1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_grdrow1.Column3.Text1" UniqueID="" Timestamp="" /> + + * + BorderStyle = 3 + DoCreate = .T. + Height = 153 + Name = "frm_tipc" + Width = 787 + _shape1.Anchor = 11 + _shape1.Height = 29 + _shape1.Left = 0 + _shape1.Name = "_shape1" + _shape1.Top = 0 + _shape1.Width = 788 + _shape2.Anchor = 9 + _shape2.Height = 29 + _shape2.Left = 756 + _shape2.Name = "_shape2" + _shape2.Top = -1 + _shape2.Width = 32 + Lb_titlu_alb_b121.Caption = "Tipuri contracte" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Anchor = 9 + BUT_TERMIN1.Left = 757 + BUT_TERMIN1.Name = "BUT_TERMIN1" + BUT_TERMIN1.Top = 0 + * + + ADD OBJECT '_grdrow1' AS _grdrow WITH ; + Anchor = 15, ; + ColumnCount = 3, ; + DeleteMark = .F., ; + Height = 110, ; + Left = 5, ; + Name = "_grdrow1", ; + Panel = 1, ; + ReadOnly = .T., ; + RecordMark = .F., ; + RecordSource = "tTipc", ; + Top = 37, ; + Width = 775, ; + Column1.ControlSource = "recno()", ; + Column1.Name = "Column1", ; + Column1.ReadOnly = .T., ; + Column1.Width = 39, ; + Column2.ControlSource = "tipc", ; + Column2.Name = "Column2", ; + Column2.ReadOnly = .T., ; + Column2.Width = 148, ; + Column3.ControlSource = "explicatie", ; + Column3.Name = "Column3", ; + Column3.ReadOnly = .T., ; + Column3.Width = 563 + *< END OBJECT: ClassLib="..\..\comun\clase\_grd_base.vcx" BaseClass="grid" /> + + ADD OBJECT '_grdrow1.Column1.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Nr. crt.", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_grdrow1.Column1.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT '_grdrow1.Column2.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Tip contract", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_grdrow1.Column2.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT '_grdrow1.Column3.Header1' AS header WITH ; + Alignment = 2, ; + Caption = "Descriere", ; + Name = "Header1" + *< END OBJECT: BaseClass="header" /> + + ADD OBJECT '_grdrow1.Column3.Text1' AS textbox WITH ; + BackColor = 255,255,255, ; + BorderStyle = 0, ; + ForeColor = 0,0,0, ; + Margin = 0, ; + Name = "Text1", ; + ReadOnly = .T. + *< END OBJECT: BaseClass="textbox" /> + +ENDDEFINE diff --git a/Clase/outlook2003bar.vc2 b/Clase/outlook2003bar.vc2 new file mode 100644 index 0000000..1edf6f1 --- /dev/null +++ b/Clase/outlook2003bar.vc2 @@ -0,0 +1,1564 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="outlook2003bar.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS outlook2003bar AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Panes" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="OverflowPanel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="SplitBar" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="SplitBar.imgSplitter" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Panel" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Splitter" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Title" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Title.lblCaption" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Title.linBorder" UniqueID="" Timestamp="" /> + + * + *m: addbutton && Internal to the class. Add a new button. + *m: adjustpanelheight && Internal to the class. Adjust the panel height to show the buttons. + *m: adjustsplitterlimits && Internal to the class. Adjust splitter RangeMin and RangeMax limits. + *m: creategradientimage && Create a gradient image. + *m: rearrangebuttons && Internal to the class. Rearrange buttons to show in correctly order and position. + *m: selectedbutton_assign && Internal to the class. Occurs when SelectedButton property is changed. + *m: setcolorscheme && Set color scheme. + *m: showless && Internal to the class. Show less buttons in the panel. + *m: showmore && Internal to the class. Show more buttons in the panel. + *m: themenumber_assign && Internal to the class. Occurs when ThemeNumber property is changed. + *m: themessupport_access && Internal to the class. Occurs when ThemesSupport property is accessed. + *p: imgfocusednotselected && Internal to the class. Name and path of the image to show in the background when button receives the focus and is not selected. + *p: imgfocusedselected && Internal to the class. Name and path of the image to show in the background when button receives the focus and is selected. + *p: imgnotfocusednotselected && Internal to the class. Name and path of the image to show in the background when button does not have focus and is not selected. + *p: imgnotfocusedselected && Internal to the class. Name and path of the image to show in the background when button does not have focus and is selected. + *p: imgsplitbar && Internal to the class. Name and path of the image to show in the background of splitbar. + *p: imgtitle && Internal to the class. Name and path of the image to show in the background of title. + *p: maxshowedbuttons && Maximum number of buttons displayed in the panel. + *p: mnushowlesstext && The text that is displayed in the "Show less" shortcut menu item. + *p: mnushowmoretext && The text that is displayed in the "Show more" shortcut menu item. + *p: rgbborder && RGB color of control borders. + *p: rgbfocusednotselectedend && End RGB color (for gradient effect) of focused and not selected button. + *p: rgbfocusednotselectedstart && Start RGB color (for gradient effect) of focused and not selected button. + *p: rgbfocusedselectedend && End RGB color (for gradient effect) of focused and selected button. + *p: rgbfocusedselectedstart && Start RGB color (for gradient effect) of focused and selected button. + *p: rgbnotfocusednotselectedend && End RGB color (for gradient effect) of not focused and not selected button. + *p: rgbnotfocusednotselectedstart && Start RGB color (for gradient effect) of not focused and not selected button. + *p: rgbnotfocusedselectedend && End RGB color (for gradient effect) of not focused and selected button. + *p: rgbnotfocusedselectedstart && Start RGB color (for gradient effect) of not focused and selected button. + *p: rgbtitleend && End RGB color (for gradient effect) of title. + *p: rgbtitlestart && Start RGB color (for gradient effect) of title. + *p: selectedbutton && Internal to the class. The number of selected button. + *p: showedbuttons && Internal to the class. The number of showed buttons. + *p: themenumber && 0- Automatic, 1- Blue, 2- Silver, 3- Olive and 4- User defined. + *p: themessupport && Specifies if the OS support themes. + *p: version && Outlook2003Bar version. + * + + HIDDEN themessupport + PROTECTED version + * + Anchor = 15 + Height = 362 + imgfocusednotselected = + imgfocusedselected = + imgnotfocusednotselected = + imgnotfocusedselected = + imgsplitbar = + imgtitle = + maxshowedbuttons = 7 + mnushowlesstext = Show less + mnushowmoretext = Show more + Name = "outlook2003bar" + rgbborder = (Rgb(0,45,150)) + rgbfocusednotselectedend = (Rgb(247,192,91)) + rgbfocusednotselectedstart = (Rgb(255,255,220)) + rgbfocusedselectedend = (Rgb(255,255,220)) + rgbfocusedselectedstart = (Rgb(247,192,91)) + rgbnotfocusednotselectedend = (Rgb(126,165,224)) + rgbnotfocusednotselectedstart = (Rgb(203,225,252)) + rgbnotfocusedselectedend = (Rgb(238,149,21)) + rgbnotfocusedselectedstart = (Rgb(250,229,147)) + rgbtitleend = (Rgb(8,60,161)) + rgbtitlestart = (Rgb(85,131,211)) + selectedbutton = 0 + showedbuttons = 5 + themenumber = 0 + themessupport = (Null) + version = 1.0.0 + Width = 200 + * + + ADD OBJECT 'OverflowPanel' AS overflowpanel WITH ; + Anchor = 14, ; + Height = 32, ; + Left = 1, ; + Name = "OverflowPanel", ; + Top = 327, ; + Width = 198, ; + MENUBUTTON.imgPicture.Height = 16, ; + MENUBUTTON.imgPicture.Name = "imgPicture", ; + MENUBUTTON.imgPicture.Visible = .F., ; + MENUBUTTON.imgPicture.Width = 16, ; + MENUBUTTON.Name = "MENUBUTTON", ; + MENUBUTTON.Visible = .F. + *< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" /> + + ADD OBJECT 'Panel' AS panel WITH ; + Anchor = 14, ; + Left = 0, ; + Name = "Panel", ; + Top = 327 + *< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" /> + + ADD OBJECT 'Panes' AS pageframe WITH ; + ActivePage = 0, ; + Anchor = 15, ; + BorderWidth = 0, ; + ErasePage = .T., ; + Height = 328, ; + Left = 1, ; + MemberClass = "pane", ; + MemberClassLibrary = outlook2003bar.vcx, ; + Name = "Panes", ; + SpecialEffect = 2, ; + Tabs = .F., ; + Themes = .F., ; + Top = 33, ; + Width = 198 + *< END OBJECT: BaseClass="pageframe" /> + + ADD OBJECT 'SplitBar' AS container WITH ; + Anchor = 14, ; + Height = 7, ; + Left = 0, ; + Name = "SplitBar", ; + Top = 321, ; + Width = 200 + *< END OBJECT: BaseClass="container" /> + + ADD OBJECT 'SplitBar.imgSplitter' AS image WITH ; + Anchor = 768, ; + BackStyle = 0, ; + Height = 3, ; + Left = 81, ; + Name = "imgSplitter", ; + Picture = outlook2003barsplitter.png, ; + Top = 2, ; + Width = 35 + *< END OBJECT: BaseClass="image" /> + + ADD OBJECT 'Splitter' AS splitter2 WITH ; + Anchor = 14, ; + BackStyle = 0, ; + Height = 7, ; + Left = 0, ; + Name = "Splitter", ; + rangemax = 373, ; + rangemin = 365, ; + SpecialEffect = 1, ; + Top = 321, ; + Visible = .F., ; + Width = 200 + *< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="shape" /> + + ADD OBJECT 'Title' AS container WITH ; + Anchor = 11, ; + BorderWidth = 0, ; + Height = 35, ; + Left = 1, ; + Name = "Title", ; + Top = 1, ; + Width = 198 + *< END OBJECT: BaseClass="container" /> + + ADD OBJECT 'Title.lblCaption' AS label WITH ; + BackStyle = 0, ; + Caption = "Caption", ; + FontBold = .T., ; + FontSize = 10, ; + ForeColor = 255,255,255, ; + Height = 30, ; + Left = 7, ; + Name = "lblCaption", ; + Top = 0, ; + Width = 190, ; + WordWrap = .T. + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Title.linBorder' AS line WITH ; + Anchor = 14, ; + Height = 0, ; + Left = 0, ; + Name = "linBorder", ; + Top = 31, ; + Width = 198 + *< END OBJECT: BaseClass="line" /> + + HIDDEN PROCEDURE addbutton && Internal to the class. Add a new button. + Lparameters lcCaption, lcPicture24, lcPicture16 + Thisform.LockScreen = .T. + With This + .Panel.AddButton(lcCaption, lcPicture24) + .OverflowPanel.AddButton(lcCaption, lcPicture16) + If .ShowedButtons<.MaxShowedButtons + .ShowMore() + Endif + .AdjustSplitterLimits() + Endwith + Thisform.LockScreen = .F. + ENDPROC + + PROCEDURE adjustpanelheight && Internal to the class. Adjust the panel height to show the buttons. + Local lnTopoAtual, lnAlturaDoPainel, lnShowedButtons + + With This + With .Splitter + .Anchor = 0 + lnTopoAtual = .Top + Local lnResto + Do While .T. + lnAlturaDoPainel = .Parent.OverflowPanel.Top - 6 - lnTopoAtual + lnResto = Mod(lnAlturaDoPainel,32) + If lnResto <> 0 + lnTopoAtual = lnTopoAtual - (32 - lnResto) + Else + .Top = lnTopoAtual + Exit + Endif + Enddo + .Anchor = 14 + Endwith + + With .SplitBar + .Anchor = 0 + .Top = lnTopoAtual + .Anchor = 14 + Endwith + + With .Panes + .Anchor = 0 + .Height = lnTopoAtual - .Top + .Anchor = 15 + Endwith + + With .Panel + .Anchor = 0 + .Top = lnTopoAtual + 6 + .Height = lnAlturaDoPainel + .Anchor = 14 + lnShowedButtons = Int(lnAlturaDoPainel / 32) + Endwith + + .ShowedButtons = lnShowedButtons + .ReArrangeButtons() + Endwith + ENDPROC + + PROCEDURE adjustsplitterlimits && Internal to the class. Adjust splitter RangeMin and RangeMax limits. + With This + With .Splitter + .RangeMax = This.OverflowPanel.Top + 2 + .RangeMin = .RangeMax - .Height - 1 - ; + (Min(This.Panel.ControlCount,This.MaxShowedButtons) * 32) + Endwith + .AdjustPanelHeight() + Endwith + ENDPROC + + HIDDEN PROCEDURE creategradientimage && Create a gradient image. + Lparameters lnRGBColor1, lnRGBColor2, lnGradPixels, lcGradFile + Local lnGradMode, lnGradPixels, x1, y1, x2, y2, lnWidth, lnHeight + + lnGradMode = 1 + Do Case + Case lnGradMode = 1 && Vertical + x1 = 0 + y1 = 0 + x2 = 1 + y2 = lnGradPixels + Case lnGradMode = 2 && Horizontal + x1 = 0 + y1 = 0 + x2 = lnGradPixels + y2 = 1 + Case lnGradMode = 3 && Diagonal TopLeft -> BottomRight + x1 = 0 + y1 = 0 + x2 = lnGradPixels + y2 = lnGradPixels + Case lnGradMode = 4 && Diagonal BottomLeft -> TopRight + x1 = 0 + y1 = lnGradPixels + x2 = lnGradPixels + y2 = 0 + Endcase + + lnWidth = Iif(lnGradMode = 1, 1, lnGradPixels) + lnHeight = Iif(lnGradMode = 2, 1, lnGradPixels) + + * Create Gradient Image + Set Classlib To _gdiplus Additive + + * Create a colorObject and store ARGB color values to variables + Local loClr As GpColor Of _gdiplus + Local lnColor1, lnColor2 + loClr = Createobject("gpColor") + loClr.FoxRGB = lnRGBColor1 + lnColor1 = loClr.ARGB + loClr.FoxRGB = lnRGBColor2 + lnColor2 = loClr.ARGB + + * Create a bitmap + Local loBmp As GpBitmap Of _gdiplus + loBmp = Createobject("gpBitmap") + loBmp.Create(lnWidth, lnHeight) + + * Get a bitmab graphics object + Local loGfx As GpGraphics Of _gdiplus + loGfx = Createobject("gpGraphics") + loGfx.CreateFromImage(loBmp) + + * Declare API + Declare Long GdipCreateLineBrushI In GDIPlus ; + String point1, String point2, ; + Long color1, Long color2, ; + Long wrapMode, Long @lineGradient + + * Get a gradient brush + Local loBrush As GpBrush Of _gdiplus + Local hBrush && Brush Handle + hBrush = 0 + GdipCreateLineBrushI(BinToC(x1,"4rs")+BinToC(y1,"4rs"), ; + BINTOC(x2,"4rs")+BinToC(y2,"4rs"), ; + lnColor1, lnColor2, 0, @hBrush) + loBrush = Createobject("gpBrush") + loBrush.SetHandle(hBrush, .T.) + + * Fill the bitmap with our gradient + loGfx.FillRectangle(loBrush,0,0,lnWidth, lnHeight) + loBmp.SaveToFile(lcGradFile,"image/bmp") + + Return + + ENDPROC + + PROCEDURE Destroy + With This + If .ThemesSupport + Unbindevents(0, 0x031A) + Endif + Local laImages[6], lnImage + laImages[1] = .ImgFocusedSelected + laImages[2] = .ImgFocusedNotSelected + laImages[3] = .ImgNotFocusedSelected + laImages[4] = .ImgNotFocusedNotSelected + laImages[5] = .ImgTitle + laImages[6] = .ImgSplitBar + Endwith + For lnImage=1 To Alen(laImages,1) + If Not Empty(laImages[lnImage]) + If File(laImages[lnImage]) + Clear Resources (laImages[lnImage]) + Erase (laImages[lnImage]) + Endif + Endif + Endfor + ENDPROC + + PROCEDURE Init + With Thisform + .MinHeight = This.Height + 4 + .MinWidth = This.Width + 4 + .ShowTips = .T. + Endwith + + With This + *!* .ImgFocusedSelected = Addbs(Sys(2023))+Sys(2015)+".bmp" + *!* .ImgFocusedNotSelected = Addbs(Sys(2023))+Sys(2015)+".bmp" + *!* .ImgNotFocusedSelected = Addbs(Sys(2023))+Sys(2015)+".bmp" + *!* .ImgNotFocusedNotSelected = Addbs(Sys(2023))+Sys(2015)+".bmp" + *!* .ImgTitle = Addbs(Sys(2023))+Sys(2015)+".bmp" + *!* .ImgSplitBar = Addbs(Sys(2023))+Sys(2015)+".bmp" + .ImgFocusedSelected = "outlook2003bar_1.bmp" + .ImgFocusedNotSelected = "outlook2003bar_2.bmp" + .ImgNotFocusedSelected = "outlook2003bar_3.bmp" + .ImgNotFocusedNotSelected = "outlook2003bar_4.bmp" + .ImgTitle = "outlook2003bar_5.bmp" + .ImgSplitBar = "outlook2003bar_6.bmp" + .SetColorScheme() + With .Panes + Local loPane + For Each loPane In .Pages + This.AddButton(loPane.Caption,loPane.Picture24,loPane.Picture16) + Endfor + loPane = Null + Endwith + If .ThemesSupport + Bindevent(0, 0x031A, This, "SetColorScheme") + Endif + Endwith + ENDPROC + + HIDDEN PROCEDURE rearrangebuttons && Internal to the class. Rearrange buttons to show in correctly order and position. + With This.OverflowPanel + Local lnLeft, lnMaxShowedButtons, lnControlCount, lnControl, llVisible + With .Menubutton + lnLeft = .Left + lnMaxShowedButtons = Int(.Left / .Width) + Endwith + lnControlCount = .ControlCount + For lnControl=lnControlCount To 2 Step -1 + With .Controls(lnControl) + llVisible = .F. + If .TabIndex > This.ShowedButtons + If lnControl <= (This.ShowedButtons + lnMaxShowedButtons + 1) + lnLeft = lnLeft - .Width + .Anchor = 0 + .Left = lnLeft + .Anchor = 9 + llVisible = .T. + Endif + Endif + .Visible = llVisible + Endwith + Endfor + Endwith + ENDPROC + + HIDDEN PROCEDURE selectedbutton_assign && Internal to the class. Occurs when SelectedButton property is changed. + Lparameters vNewVal + With This + Local lnOldSelectedButton, lcTitle + lnOldSelectedButton = .SelectedButton + .SelectedButton = m.vNewVal + + With .Panel + If lnOldSelectedButton>0 + .Controls(lnOldSelectedButton).ChangeBackground() + Endif + .Controls(m.vNewVal).ChangeBackground() + lcTitle = .Controls(m.vNewVal).lblCaption.Caption + Endwith + + With .OverflowPanel + If lnOldSelectedButton>0 + .Controls(lnOldSelectedButton+1).ChangeBackground() + Endif + .Controls(m.vNewVal+1).ChangeBackground() + Endwith + + .Title.lblCaption.Caption = lcTitle + .Panes.ActivePage = m.vNewVal + Endwith + ENDPROC + + HIDDEN PROCEDURE setcolorscheme && Set color scheme. + Lparameters HWnd As Integer, Msg As Integer, ; + wParam As Integer, Lparam As Integer) + With This + Local lnTheme + If .ThemeNumber==0 && Automatic + lnTheme = 1 && Blue + If .ThemesSupport + Local lnSysColor + Declare Integer GetSysColor In Win32Api Integer + lnSysColor = GetSysColor(2) + Clear Dlls GetSysColor + Do Case + Case lnSysColor == 12632256 && Silver + lnTheme = 2 + Case lnSysColor == 6922635 && Olive + lnTheme = 3 + Endcase + Endif + Else + lnTheme = .ThemeNumber + Endif + + If lnTheme <> 4 && Not user defined + * Focused and selected + .rgbFocusedSelectedStart = Rgb(247,192,91) + .rgbFocusedSelectedEnd = Rgb(255,255,220) + * Focused and not selected + .rgbFocusedNotSelectedStart = Rgb(255,255,220) + .rgbFocusedNotSelectedEnd = Rgb(247,192,91) + * Not Focused and selected + .rgbNotFocusedSelectedStart = Rgb(250,229,147) + .rgbNotFocusedSelectedEnd = Rgb(238,149,21) + Do Case + Case lnTheme = 3 &&6922635 && Olive + * Border + .rgbBorder = Rgb(125,134,118) + * Not Focused and not selected + .rgbNotFocusedNotSelectedStart = Rgb(230,242,200) + .rgbNotFocusedNotSelectedEnd = Rgb(175,191,144) + * Title + .rgbTitleStart = Rgb(174,188,137) + .rgbTitleEnd = Rgb(104,119,74) + Case lnTheme = 2 && 12632256 && Silver + * Border + .rgbBorder = Rgb(132,131,136) + * Not Focused and not selected + .rgbNotFocusedNotSelectedStart = Rgb(220,222,236) + .rgbNotFocusedNotSelectedEnd = Rgb(152,152,177) + * Title + .rgbTitleStart = Rgb(166,167,189) + .rgbTitleEnd = Rgb(118,117,153) + Otherwise && Blue + * Border + .rgbBorder = Rgb(0,45,150) + * Not Focused and not selected + .rgbNotFocusedNotSelectedStart = Rgb(203,225,252) + .rgbNotFocusedNotSelectedEnd = Rgb(126,165,224) + * Title + .rgbTitleStart = Rgb(85,131,211) + .rgbTitleEnd = Rgb(8,60,161) + Endcase + Endif + + Local lnRgbBorder, laColors[6,4], loButton, lnImage + lnRgbBorder = .rgbBorder + + * Focused and selected + laColors[1,1] = .rgbFocusedSelectedStart + laColors[1,2] = .rgbFocusedSelectedEnd + laColors[1,3] = 32 + laColors[1,4] = .ImgFocusedSelected + * Focused and not selected + laColors[2,1] = .rgbFocusedNotSelectedStart + laColors[2,2] = .rgbFocusedNotSelectedEnd + laColors[2,3] = 32 + laColors[2,4] = .ImgFocusedNotSelected + * Not Focused and selected + laColors[3,1] = .rgbNotFocusedSelectedStart + laColors[3,2] = .rgbNotFocusedSelectedEnd + laColors[3,3] = 32 + laColors[3,4] = .ImgNotFocusedSelected + * Not Focused and not selected + laColors[4,1] = .rgbNotFocusedNotSelectedStart + laColors[4,2] = .rgbNotFocusedNotSelectedEnd + laColors[4,3] = 32 + laColors[4,4] = .ImgNotFocusedNotSelected + + * Title + laColors[5,1] = .rgbTitleStart + laColors[5,2] = .rgbTitleEnd + laColors[5,3] = 32 + laColors[5,4] = .ImgTitle + * SplitBar + laColors[6,1] = .rgbTitleStart + laColors[6,2] = .rgbTitleEnd + laColors[6,3] = 7 + laColors[6,4] = .ImgSplitBar + + .Title.Picture = "" + .SplitBar.Picture = "" + For Each loButton In .Panel.Controls + loButton.Picture = "" + Endfor + loButton = Null + With .OverflowPanel + .Picture = "" + For Each loButton In .Controls + loButton.Picture = "" + Endfor + Endwith + loButton = Null + + For lnImage=Iif(Evl(Msg,0)==0,1,4) To 6 + If File(laColors[lnImage,4]) + Clear Resources (laColors[lnImage,4]) + Erase (laColors[lnImage,4]) + Endif + .CreateGradientImage(laColors[lnImage,1], laColors[lnImage,2], ; + laColors[lnImage,3], laColors[lnImage,4]) + Endfor + + .BorderColor = lnRgbBorder + With .Title + .BorderColor = lnRgbBorder + .Picture = This.ImgTitle + .linBorder.BorderColor = lnRgbBorder + Endwith + .Splitter.BorderColor = lnRgbBorder + With .SplitBar + .Picture = This.ImgSplitBar + .BorderColor = lnRgbBorder + Endwith + With .Panel + .BorderColor = lnRgbBorder + For Each loButton In .Controls + With loButton + .ChangeBackground(.F.) + .BorderColor = lnRgbBorder + .linBorder.BorderColor = lnRgbBorder + Endwith + Endfor + Endwith + loButton = Null + With .OverflowPanel + .Picture = laColors[4,4] + For Each loButton In .Controls + loButton.ChangeBackground(.F.) + Endfor + Endwith + loButton = Null + Endwith + Return .T. + ENDPROC + + PROCEDURE showless && Internal to the class. Show less buttons in the panel. + With This + With .Splitter + .Anchor = 0 + .Top = .Top + 32 + Endwith + .AdjustPanelHeight() + Endwith + ENDPROC + + PROCEDURE showmore && Internal to the class. Show more buttons in the panel. + With This + With .Splitter + .Anchor = 0 + .Top = .Top - 32 + Endwith + .AdjustPanelHeight() + Endwith + ENDPROC + + HIDDEN PROCEDURE themenumber_assign && Internal to the class. Occurs when ThemeNumber property is changed. + Lparameters vNewVal + If Between(vNewVal,0,4) + This.ThemeNumber = m.vNewVal + Else + This.ThemeNumber = 1 + Endif + ENDPROC + + HIDDEN PROCEDURE themessupport_access && Internal to the class. Occurs when ThemesSupport property is accessed. + With This + If Isnull(.ThemesSupport) + Local llThemesSupport + llThemesSupport = .F. + If .ThemeNumber==0 && Automatic + If Os(3)=="5" And Os(4)=="1" && Windows XP + Declare Long IsThemeActive In UXTHEME + llThemesSupport = (IsThemeActive()==1) + Clear Dlls IsThemeActive + Endif + Endif + .ThemesSupport = llThemesSupport + Endif + Endwith + Return This.ThemesSupport + ENDPROC + + PROCEDURE Panes.Init + With This + .SetAll("BackColor",.Parent.BackColor,"Page") + Endwith + ENDPROC + + PROCEDURE Splitter.Move + Lparameters nLeft, nTop, nWidth, nHeight + DoDefault(nLeft, nTop, nWidth, nHeight) + This.Parent.AdjustSplitterLimits() + ENDPROC + + PROCEDURE Splitter.split + This.Parent.AdjustPanelHeight() + ENDPROC + +ENDDEFINE + +DEFINE CLASS overflowpanel AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="MenuButton" UniqueID="" Timestamp="" /> + + * + *m: addbutton && Add a new button to panel. + * + + * + BorderWidth = 0 + Height = 32 + Name = "overflowpanel" + Width = 198 + * + + ADD OBJECT 'MenuButton' AS overflowpanelbutton WITH ; + Anchor = 9, ; + Left = 174, ; + Name = "MenuButton", ; + imgPicture.Height = 16, ; + imgPicture.Name = "imgPicture", ; + imgPicture.Picture = outlook2003bararrow.png, ; + imgPicture.Width = 16 + *< END OBJECT: ClassLib="outlook2003bar.vcx" BaseClass="container" /> + + PROCEDURE addbutton && Add a new button to panel. + Lparameters lcCaption, lcPicture + With This + Local lnControlCount + lnControlCount = .ControlCount + 1 + + .Newobject("Button"+Alltrim(Str(lnControlCount - 1)),; + "OverflowPanelButton","Outlook2003Bar",,; + lcCaption,lcPicture) + Endwith + ENDPROC + + PROCEDURE MenuButton.changeselectedbutton + Local lnButtonCount + lnButtonCount = This.Parent.ControlCount - 1 + If lnButtonCount > 0 + Private loBar + loBar = This.Parent.Parent + With This.ShortcutMenu + .NewMenu() + Local laMenu[lnButtonCount, 2] + laMenu="" + Local loButton + For Each loButton In This.Parent.Controls + With loButton + If Upper(.Class) == Upper("OverflowPanelButton") And .Name <> This.Name + laMenu[.TabIndex, 1] = .imgPicture.ToolTipText + laMenu[.TabIndex, 2] = .imgPicture.Picture + Endif + Endwith + Endfor + loButton = Null + Local lnMenuItem + For lnMenuItem=1 To Alen(laMenu,1) + .AddMenuBar( laMenu[lnMenuItem, 1], ; + "loBar.Selectedbutton = Bar()", ; + "Picture '" + laMenu[lnMenuItem, 2] + "'",,; + .F.,.F.,(lnMenuItem==loBar.Selectedbutton) ) + Endfor + .AddMenuSeparator() + .AddMenuBar(loBar.mnuShowMoreText,; + "loBar.ShowMore()",,,.F.,; + loBar.Showedbuttons=loBar.MaxShowedbuttons,.F.) + .AddMenuBar(loBar.mnuShowLessText,; + "loBar.ShowLess()",,,.F.,; + loBar.Showedbuttons=0,.F.) + .ShowMenu() + .SetMenu() + Endwith + Release loBar + Endif + ENDPROC + + PROCEDURE MenuButton.Destroy + With This + .ShortcutMenu.ClearMenu() + .ShortcutMenu = Null + Endwith + ENDPROC + + PROCEDURE MenuButton.Init + Nodefault + This.AddProperty("ShortcutMenu",Newobject("_ShortcutMenu","_menu")) + ENDPROC + +ENDDEFINE + +DEFINE CLASS overflowpanelbutton AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="imgPicture" UniqueID="" Timestamp="" /> + + * + *m: changebackground && Change button's background image. + *m: changeselectedbutton && Change selected button. + * + + * + BorderWidth = 0 + Height = 32 + MousePointer = 15 + Name = "overflowpanelbutton" + Width = 24 + * + + ADD OBJECT 'imgPicture' AS image WITH ; + BackStyle = 0, ; + Height = 16, ; + Left = 4, ; + MousePointer = 15, ; + Name = "imgPicture", ; + Top = 8, ; + Width = 16 + *< END OBJECT: BaseClass="image" /> + + PROCEDURE changebackground && Change button's background image. + Lparameters llGotFocus + #Define lnFocused 8 + #Define lnNotFocused 16 + #Define lnSelected 32 + #Define lnNotSelected 64 + Local lnState, lcImage + With This.Parent.Parent + lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ; + Iif(.SelectedButton==This.TabIndex,lnSelected,lnNotSelected)) + Do Case + Case lnState = (lnFocused + lnSelected) + lcImage = .ImgFocusedSelected + Case lnState = (lnFocused + lnNotSelected) + lcImage = .ImgFocusedNotSelected + Case lnState = (lnNotFocused + lnSelected) + lcImage = .ImgNotFocusedSelected + Case lnState = (lnNotFocused + lnNotSelected) + lcImage = .ImgNotFocusedNotSelected + Otherwise + lcImage = "" + Endcase + Endwith + This.Picture = lcImage + ENDPROC + + PROCEDURE changeselectedbutton && Change selected button. + This.Parent.Parent.SelectedButton = This.TabIndex + ENDPROC + + PROCEDURE Click + This.ChangeSelectedButton() + ENDPROC + + PROCEDURE Init + Lparameters lcToolTipText, lcPicture + With This + .TabIndex = .TabIndex - 1 + .Top = 0 + .SetAll("ToolTipText",lcToolTipText) + .imgPicture.Picture = lcPicture + + If .TabIndex == 1 + .ChangeSelectedButton() + Else + .ChangeBackground(.F.) + Endif + Endwith + ENDPROC + + PROCEDURE MouseEnter + Lparameters nButton, nShift, nXCoord, nYCoord + This.ChangeBackground(.T.) + ENDPROC + + PROCEDURE MouseLeave + Lparameters nButton, nShift, nXCoord, nYCoord + This.ChangeBackground(.F.) + ENDPROC + + PROCEDURE imgPicture.Click + This.Parent.ChangeSelectedButton() + ENDPROC + +ENDDEFINE + +DEFINE CLASS pane AS page + *< CLASSDATA: Baseclass="page" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: picture16 && 16x16 image displayed in the panel buttons. + *p: picture24 && 24x24 image displayed in the panel buttons. + * + + * + BackColor = 255,255,255 + Caption = "Page1" + Height = 195 + Name = "pane" + picture16 = ("") + picture24 = ("") + Width = 195 + * + +ENDDEFINE + +DEFINE CLASS panel AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: addbutton && Add a new button to panel. + * + + * + BackStyle = 0 + Height = 0 + Name = "panel" + Width = 200 + * + + PROCEDURE addbutton && Add a new button to panel. + Lparameters lcCaption, lcPicture + With This + .Newobject("Button"+Alltrim(Str(.ControlCount + 1)),; + "PanelButton","Outlook2003Bar",,; + lcCaption,lcPicture) + Endwith + ENDPROC + +ENDDEFINE + +DEFINE CLASS panelbutton AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="lblCaption" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="linBorder" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="imgPicture" UniqueID="" Timestamp="" /> + + * + *m: changebackground && Change button's background image. + *m: changeselectedbutton && Change selected button. + *m: do_arata_formular + *m: do_date_generale + *m: do_linkuri + *m: do_observatii + *m: do_referinte + * + + * + Height = 32 + MousePointer = 15 + Name = "panelbutton" + Width = 198 + * + + ADD OBJECT 'imgPicture' AS image WITH ; + BackStyle = 0, ; + Height = 24, ; + Left = 4, ; + MousePointer = 15, ; + Name = "imgPicture", ; + Top = 4, ; + Width = 24 + *< END OBJECT: BaseClass="image" /> + + ADD OBJECT 'lblCaption' AS label WITH ; + Anchor = 10, ; + BackStyle = 0, ; + Caption = "", ; + FontBold = .T., ; + FontName = "Arial", ; + Height = 29, ; + Left = 38, ; + MousePointer = 15, ; + Name = "lblCaption", ; + Top = 2, ; + Width = 156, ; + WordWrap = .T. + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'linBorder' AS line WITH ; + Anchor = 14, ; + Height = 0, ; + Left = 0, ; + MousePointer = 15, ; + Name = "linBorder", ; + Top = 31, ; + Width = 198 + *< END OBJECT: BaseClass="line" /> + + PROCEDURE changebackground && Change button's background image. + Lparameters llGotFocus + #Define lnFocused 8 + #Define lnNotFocused 16 + #Define lnSelected 32 + #Define lnNotSelected 64 + Local lnState, lcImage + With This.Parent.Parent + lnState = (Iif(llGotFocus,lnFocused,lnNotFocused) + ; + Iif(.SelectedButton==This.TabIndex,lnSelected,lnNotSelected)) + Do Case + Case lnState = (lnFocused + lnSelected) + lcImage = .ImgFocusedSelected + Case lnState = (lnFocused + lnNotSelected) + lcImage = .ImgFocusedNotSelected + Case lnState = (lnNotFocused + lnSelected) + lcImage = .ImgNotFocusedSelected + Case lnState = (lnNotFocused + lnNotSelected) + lcImage = .ImgNotFocusedNotSelected + Otherwise + lcImage = "" + ENDCASE + + Endwith + This.Picture = lcImage + ENDPROC + + PROCEDURE changeselectedbutton && Change selected button. + This.Parent.Parent.SelectedButton = This.TabIndex + ENDPROC + + PROCEDURE Click + THIS.ChangeSelectedButton() + + this.do_arata_formular() + ENDPROC + + PROCEDURE do_arata_formular + LOCAL loPagina + loPagina = goFundal._pgfrmbase1.page3 + IF !loPagina.ct_part_nr_data1.llock + LOCAL lnRaspuns + loPagina.ct_part_nr_data1.llock = .T. + + lnRaspuns = AMESSAGEBOX('Doriti sa salvati modificarile facute?',4+32,'Atentie') + loPagina.ct_part_nr_data1.REFRESH() + IF lnRaspuns = 7 + RETURN + ELSE + DO modifica_reg_dg WITH goRegistratura IN oproceduri_roaregistratura.prg + ENDIF + ENDIF + + IF TYPE('podg_dg.but_termin1') <> 'U' + podg_dg.but_termin1.CLICK() + ENDIF + IF TYPE('podg_referinte.but_termin1') <> 'U' + podg_referinte.but_termin1.CLICK() + ENDIF + IF TYPE('podg_obs.but_termin1') <> 'U' + podg_obs.but_termin1.CLICK() + ENDIF + IF TYPE('podg_link.but_termin1') <> 'U' + podg_link.but_termin1.CLICK() + ENDIF + + IF !EMPTY(goRegistratura.id_reg) + DO CASE + CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'DATE GENERALE' + THIS.do_date_generale() + CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'REFERINTE' + THIS.do_referinte() + CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'OBSERVATII' + THIS.DO_Observatii() + CASE ALLTRIM(UPPER(THIS.lblCaption.CAPTION)) = 'DOCUMENTE ATASATE' + THIS.DO_Linkuri() + OTHERWISE + && AMESSAGEBOX('Altceva') + ENDCASE + ENDIF + + + ENDPROC + + PROCEDURE do_date_generale + DO FORM 'frm_dg_date_generale' NAME podg_dg + + + ENDPROC + + PROCEDURE do_linkuri + DO FORM 'frm_viz_atasamente' NAME podg_link + ENDPROC + + PROCEDURE do_observatii + DO FORM 'frm_dg_observatii' NAME podg_obs + ENDPROC + + PROCEDURE do_referinte + DO FORM 'frm_dg_referinte' NAME podg_referinte + ENDPROC + + PROCEDURE Init + Lparameters lcCaption, lcPicture + Local lnBorderColor + With This + lnBorderColor = .Parent.Parent.rgbBorder + .Anchor = 0 + .BorderColor = lnBorderColor + .Left = 1 + .Top = ((.TabIndex*(.Height))-.Height) + .Anchor = 10 + + .lblCaption.Caption = lcCaption + .imgPicture.Picture = lcPicture + + .linBorder.BorderColor = lnBorderColor + + .ChangeBackground(.F.) + + .Visible = .T. + Endwith + ENDPROC + + PROCEDURE MouseEnter + Lparameters nButton, nShift, nXCoord, nYCoord + This.ChangeBackground(.T.) + ENDPROC + + PROCEDURE MouseLeave + Lparameters nButton, nShift, nXCoord, nYCoord + This.ChangeBackground(.F.) + ENDPROC + + PROCEDURE imgPicture.Click + This.Parent.ChangeSelectedButton() + + this.Parent.do_arata_formular() + + + + ENDPROC + + PROCEDURE lblCaption.Click + This.Parent.ChangeSelectedButton() + + this.Parent.do_arata_formular() + ENDPROC + +ENDDEFINE + +DEFINE CLASS splitter2 AS shape && Up-Down Splitter class. Support ActiveX controls. Author: gerald.santerre@siteintranet.qc.ca + *< CLASSDATA: Baseclass="shape" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: hidecontrols && internal use + *m: readme + *m: showcontrols && internal use + *m: split && This method is called at the end of the split operation. + *p: rangemax && The splitter can be dragged to the bottom up to this value. Pixels from the top of the parent. Value < 1 is percent of parent height. + *p: rangemin && The splitter can be dragged to the top down to this value. Value < 1 is percent of parent height. + *a: hiddencontrols[1,1] && Array of controls + * + + HIDDEN hiddencontrols + PROTECTED Init,MouseDown + * + Height = 4 + MousePointer = 7 + Name = "splitter2" + rangemax = 0.8 + rangemin = 0.2 + SpecialEffect = 0 + Width = 100 + * + + PROCEDURE Destroy + * decrement instance counter, if 0 release object (this.release Dlls) + + If type("_screen.___SplitterApi")="O" AND !ISNULL(_screen.___SplitterApi) + _screen.___SplitterApi.nInstances = _screen.___SplitterApi.nInstances - 1 + If _screen.___SplitterApi.nInstances <= 0 + _screen.___SplitterApi.nInstances = .Null. + _screen.RemoveObject("___SplitterApi") + Endif + Endif + + + ENDPROC + + HIDDEN PROCEDURE hidecontrols && internal use + * hide all controls include ActiveX with property visible inside container tObject + * without this splitter and form + + LPARAMETERS tObject,nIndex + * tObject is root object, if not passed, thisform is used + IF EMPTY(nIndex) + nIndex=2 + ENDIF + + LOCAL lcObjectBaseClass, lObject, lTempObject + * build collection hidden object for reverse setting in showcontrols + * set valid object + IF VARTYPE(tObject)="O" + lObject= tObject + ELSE + lObject= THISFORM + ENDIF + + * ignore this splitter + IF lObject = THIS + RETURN nIndex + ENDIF + + * unify + lcObjectBaseClass = LOWER(lObject.BASECLASS)+" " && " " for unique (page # pageframe) + + * do not hide form window + IF lcObjectBaseClass # "form " AND PEMSTATUS(lObject,"visible",5) + IF lObject.VISIBLE + DIMENSION this.HiddenControls[nIndex] + this.hiddencontrols[nIndex]=lObject + lObject.VISIBLE = .F. + nIndex=nIndex+1 + ENDIF + ENDIF + + * recurse for all children + DO CASE + CASE INLIST(lcObjectBaseClass,"pageframe ") + FOR EACH lTempObject IN lObject.PAGES + nIndex=THIS.hidecontrols(lTempObject,nIndex) + ENDFOR + CASE INLIST(lcObjectBaseClass,"form ","container ","page ") + FOR EACH lTempObject IN lObject.CONTROLS + nIndex=THIS.hidecontrols(lTempObject,nIndex) + ENDFOR + CASE INLIST(lcObjectBaseClass,"commandgroup ","optiongroup ") + FOR EACH lTempObject IN lObject.BUTTONS + nIndex=THIS.hidecontrols(lTempObject,nIndex) + ENDFOR + ENDCASE + + RETURN nIndex+1 + ENDPROC + + PROTECTED PROCEDURE Init + * API FUNCTIONS - declare only one for all splitter with this class + + IF !VARTYPE(_SCREEN.___SplitterApi)="O" + IF AT(UPPER((this.ClassLibrary)),UPPER(SET("Classlib")))=0 + SET CLASSLIB TO (this.ClassLibrary) ADDITIVE + ENDIF + _SCREEN.AddObject("___SplitterApi","SplitterAPI") + ELSE + _SCREEN.___SplitterApi.nInstances = _SCREEN.___SplitterApi.nInstances + 1 + ENDIF + RETURN VARTYPE(_SCREEN.___SplitterApi)="O" + + ENDPROC + + PROTECTED PROCEDURE MouseDown + Lparameters nButton, nShift, nXCoord, nYCoord + Local lcWindowName,lnScaleMode,lnMinRow,lnMaxRow,lnMRow1,lnMRow2 + Local lnRows,lnTop,lnOldTop,lnMin,oldMRow2 + Local llLockScreen,lnMousePointer + Local lhDC,lhMemDC,lhMemBmp,lHWnd,lnBmpHeight,nLeftOffset,nTopOffset,oContainer,xHeight + Local lcOldFormName,lhMemSplit + + If nButton#1 + Return + Endif + + lcOldFormName = Thisform.Name + Thisform.Name = Sys(2015) + + lcWindowName=Thisform.Name + lnScaleMode=Thisform.ScaleMode + Thisform.ScaleMode=3 && pixels + + oContainer=This.Parent + nLeftOffset=Objtoclient(This,2)-This.Left + nTopOffset=Objtoclient(This,1)-This.Top + + lnMRow1=Mrow(lcWindowName,3) + If Type("lnMRow1")#"N" Or lnMRow1<=0 + Thisform.ScaleMode=lnScaleMode + Thisform.Name = lcOldFormName + Return + Endif + + lnMRow1=lnMRow1-nTopOffset + If lnMRow1 <> This.Top+1 + lnMRow1 = This.Top+1 + Mouse At lnMRow1+nTopOffset, Mcol(lcWindowName,3) Pixels Window (lcWindowName) + Endif + + * set some vars + llLockScreen=Thisform.LockScreen + lnMousePointer=Thisform.MousePointer + Thisform.MousePointer= 7 + lnTop=This.Top + + * check two parent level for Height- suppose that parent form always present + If Pemstatus(oContainer,"Height",5) + xHeight = oContainer.Height + Else + If Pemstatus(oContainer.Parent,"PageHeight",5) + xHeight = oContainer.Parent.PageHeight + Else + * if error that oContainer.Height and oContainer.parent.width not exist, something wrong + xHeight = oContainer.Parent.Height + Endif + Endif + + * RangeMin (RangeMax) < 1 + * RangeMin (RangeMax) are used as coeficient (%/100) + * RangeMin (RangeMax) > 1 + * RangeMin (RangeMax) are used as absolute offset in pixels + * RangeMin (RangeMax) =0 + * RangeMin (RangeMax) are ignored - no restriction + Do Case + Case This.RangeMin <= 0 + lnMinRow=This.Height*2 + Case This.RangeMin > 1 + lnMinRow=Max(This.Height*2,Int(This.RangeMin)) + Case This.RangeMin < 1 + lnMinRow=Max(This.Height*2,Int(This.RangeMin*xHeight)) + Endcase + + Do Case + Case This.RangeMax <= 0 + lnMaxRow=xHeight-(This.Height*3) + Case This.RangeMax > 1 + lnMaxRow=Min(xHeight-(This.Height*3),This.RangeMax) + Case This.RangeMax < 1 + lnMaxRow=Min(xHeight-(This.Height*3),This.RangeMax*xHeight) + Endcase + + If lnMinRow>lnMaxRow + * nothing to move!!! + Thisform.ScaleMode=lnScaleMode + Thisform.Name = lcOldFormName + Return + Endif + + lnMRow2=lnMRow1 + oldMRow2=lnMRow2 + + #Define SRCCOPY 13369376 + + * API CALLS + If Thisform.ShowWindow= 2 + * workaround, when showwindow=2 the handle is not the right one... + * worst if you have a toolbar! + *#define GW_HWNDFIRST 0 + #Define GW_HWNDLAST 1 + *#define GW_HWNDNEXT 2 + *#define GW_HWNDPREV 3 + *#define GW_OWNER 4 + #Define GW_CHILD 5 + + lHWnd=Thisform.HWnd + lHWnd=GS_SplitGetWindow(lHWnd,GW_CHILD) + lHWnd=GS_SplitGetWindow(lHWnd,GW_HWNDLAST) + Else + lHWnd=Thisform.HWnd + Endif + + lhDC = GS_SplitGetDC(lHWnd) + lhMemDC = GS_SplitCreateCompatibleDC(lhDC) + * Take a copy of the portion of the form that can be dragged over + lnBmpHeight=This.Height + lhMemBmp = GS_SplitCreateCompatibleBitmap(lhDC, This.Width, lnBmpHeight) + lhMemSplit = GS_SplitCreateCompatibleBitmap(lhDC, This.Width, lnBmpHeight) + = GS_SplitSelectObject(lhMemDC , lhMemBmp) + = GS_SplitBitBlt(lhMemDC, 0, 0, This.Width, lnBmpHeight, ; + lhDC, This.Left+nLeftOffset, lnMRow1-1+nTopOffset, SRCCOPY) + = GS_SplitSelectObject(lhMemDC , lhMemSplit) + = GS_SplitBitBlt(lhMemDC, 0, 0, This.Width, lnBmpHeight, ; + lhDC, This.Left+nLeftOffset, lnMRow1-1+nTopOffset, SRCCOPY) + + * Stop fox drawing in the screen + Thisform.LockScreen=.T. + This.hidecontrols(oContainer) + + * update the display while dragging + Do While Mdown() + DoEvents + lnMRow2=Mrow(lcWindowName,3)-nTopOffset + If Type("lnMRow2")#"N" Or lnMRow2=0 + Loop + Endif + If lnMRow2<=lnMinRow + *force the mouse to stay at this position + Mouse At lnMinRow+nTopOffset, Mcol(lcWindowName,3) Pixels Window (lcWindowName) + lnMRow2=lnMinRow+1 + Endif + If lnMRow2>=(lnMaxRow-This.Height) + *force the mouse to stay at this position + Mouse At lnMaxRow-This.Height+nTopOffset, Mcol(lcWindowName,3) Pixels Window (lcWindowName) + lnMRow2=lnMaxRow-This.Height + Endif + lnMRow2=Min(Max(lnMRow2,lnMinRow),lnMaxRow) + If oldMRow2=lnMRow2 + Loop + Else + * on mouse move, redraw a part of the screen from the memory copy + * and draw "this" image at the mouse position + * bitblt (dest...source...) + With This + .Top=lnTop+(lnMRow2-lnMRow1) + *restore + = GS_SplitSelectObject(lhMemDC , lhMemBmp) + = GS_SplitBitBlt(lhDC, .Left+nLeftOffset, oldMRow2-1+nTopOffset, .Width, .Height+3,; + lhMemDC, 0, 0, SRCCOPY) + *take a new copy + = GS_SplitBitBlt(lhMemDC, 0, 0, This.Width, lnBmpHeight, ; + lhDC, This.Left+nLeftOffset, lnMRow2-1+nTopOffset, SRCCOPY) + *draw + = GS_SplitSelectObject(lhMemDC , lhMemSplit) + = GS_SplitBitBlt(lhDC, .Left+nLeftOffset, .Top+nTopOffset, .Width, .Height+1,; + lhMemDC, 0, 0, SRCCOPY) + + Endwith + oldMRow2=lnMRow2 + Endif + Enddo + + This.showcontrols() + Thisform.Name = lcOldFormName + + If lnMRow2<0 + lnMRow2=lnMRow1 + Endif + + lnRows=lnMRow2-lnMRow1 + This.Top=lnTop+lnRows + Thisform.ScaleMode=lnScaleMode + Thisform.MousePointer=lnMousePointer + + This.Split() + + Thisform.LockScreen=llLockScreen + + * free the memory + = GS_SplitReleaseDC(lHWnd, lhDC) + = GS_SplitDeleteObject(lhMemBmp) + = GS_SplitDeleteObject(lhMemSplit) + = GS_SplitDeleteDC(lhMemDC) + ENDPROC + + HIDDEN PROCEDURE readme + *!* Splitter class + *!* May 2004 + + *!* Active-X controls always drive me nuts because they use there own windows handle. + *!* You cannot put a fox native control over them to resize the control visually. + *!* You have to use some tricks like changing the control to + *!* another one for this operation and rechange it back after. + *!* ( See the class browser code ) + + *!* What I want is a splitter that can handle this in a visual way + *!* while keeping the form (look) unchanged until the end of the split. + + *!* After many try and fail, I have finally found a way to do it + *!* by the use of API calls. IT WORK!!! + *!* Days of work to end with only a couple of code lines :) + + *!* I am not an API guru, so if you find a way to improve this class + *!* feel free to let me know how :) + + *!* Tested with VFP 8-7 on Windows 2000 + *!* (no animal other than the usual fox was used in the tests) + *!* Disclaimer: (...) <- put the usual disclaimer here! + + *!* Gérald Santerre + *!* gerald.santerre@siteintranet.qc.ca + + + *!* USAGE: + + *!* Drop this class on a form or a container between the objects that share the container. + + *!* New release, complete redesing. + *!* If you already use a previous version of the class, read this carefully. + *!* I have removed a couple of properties and change the way the classes work. + *!* For this reason I have also renamed the classlib to avoid conflicts + *!* with previous version of the class. The new design is cleaner and the control + *!* don't touch anything in the form (except hiding controls during split). + + *!* A large part of the new design is from suggestions received + *!* from "Jaromír Stacha" from Czech Republic. + *!* Thank you Jaromir :). + + *!* The new splitter classes don't move or resize controls anymore. + *!* The splitter.split() method is always called after a split operation + *!* and you have to resize/reposition your controls from this (fake)event. + *!* If you don't put code in the split() method, the form.resize() event + *!* of the form will be called. See the resize() and splitter1.split() + *!* method of the demo form for a working sample. + + *!* You have only 2 properties to set in the class, + *!* RangeMin and RangeMax. + *!* If you set the value of this properties between 0 and 1, + *!* the value is handled as a % of the splitter's parent container width ot height. + *!* For example, if you enter 0.2 as value for RangeMin, + *!* you will be able to move the splitter down to 20% of the width/height + *!* of the splitter's parent container. + *!* Values greater than 1 will be handle as absolute values. + *!* Don't forget to reset absolute values when the splitter's parent container is resized. + + *!* The splitter API is now self contained and you dont have + *!* to worry about releasing the references to API functions. + *!* The splitter now also handle correctly multiple instances + *!* of the same form (or forms with the same name). + *!* The splitter automatically hide every controls that are in + *!* the same parent container (recursive) to avoid side effects + *!* (like mouse cursor beam over text boxes). + + *!* Contact: gerald.santerre@siteintranet.qc.ca + + ENDPROC + + HIDDEN PROCEDURE showcontrols && internal use + * show temporary hidden objects and clear list (collection) + LPARAMETERS toRoot + + IF ALEN(THIS.hiddencontrols,1)<2 + RETURN + ENDIF + FOR i=2 TO ALEN(THIS.hiddencontrols,1) + IF TYPE("THIS.hiddencontrols[i]")="O" + THIS.hiddencontrols[i].Visible=.T. + ENDIF + ENDFOR + + DIMENSION THIS.hiddencontrols[1] + + ENDPROC + + PROCEDURE split && This method is called at the end of the split operation. + *default behaviour + THISFORM.RESIZE() + ENDPROC + +ENDDEFINE + +DEFINE CLASS splitterapi AS custom && Splitter API declaration class + *< CLASSDATA: Baseclass="custom" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *p: ninstances + * + + * + Height = 15 + Name = "splitterapi" + ninstances = 1 + Width = 27 + * + + PROCEDURE Destroy + Clear Dlls ; + "GS_SplitGetDC",; + "GS_SplitCreateCompatibleDC",; + "GS_SplitCreateCompatibleBitmap",; + "GS_SplitSelectObject",; + "GS_SplitReleaseDC",; + "GS_SplitDeleteDC",; + "GS_SplitBitBlt",; + "GS_SplitGetWindow",; + "GS_SplitDeleteObject" + ENDPROC + + PROCEDURE Init + Declare Long GetDC in Win32API as GS_SplitGetDC Long hwnd + Declare Long CreateCompatibleDC in Win32API as GS_SplitCreateCompatibleDC Long hdc + Declare Long CreateCompatibleBitmap in Win32API as GS_SplitCreateCompatibleBitmap Long hdc, Long nWidth, Long nHeight + Declare Long SelectObject in Win32API as GS_SplitSelectObject Long hdc, Long hObject + Declare Long ReleaseDC in Win32API as GS_SplitReleaseDC Long hwnd, Long hdc + Declare Long DeleteDC in Win32API as GS_SplitDeleteDC Long hdc + Declare Long BitBlt in Win32API as GS_SplitBitBlt ; + Long hDestDC, Long x, Long y, Long nWidth, Long nHeight, ; + Long hSrcDC, Long xSrc, Long ySrc, Long dwRop + Declare INTEGER DeleteObject in Win32API as GS_SplitDeleteObject Long hObject + DECLARE INTEGER GetWindow IN user32 as GS_SplitGetWindow ; + INTEGER hwnd,; + INTEGER wFlag + + ENDPROC + +ENDDEFINE diff --git a/Clase/registry.h b/Clase/registry.h new file mode 100644 index 0000000..7e5c569 --- /dev/null +++ b/Clase/registry.h @@ -0,0 +1,79 @@ +*- Registry.h +*- Copyright (c) 1997 Microsoft Corporation + +* Operating System codes +#DEFINE OS_W32S 1 +#DEFINE OS_NT 2 +#DEFINE OS_WIN95 3 +#DEFINE OS_MAC 4 +#DEFINE OS_DOS 5 +#DEFINE OS_UNIX 6 + +* DLL Paths for various operating systems +#DEFINE DLLPATH_NT "\SYSTEM32\" +#DEFINE DLLPATH_WIN95 "\SYSTEM\" + +* DLL files used to read INI files +#DEFINE DLL_KERNEL_NT "KERNEL32.DLL" +#DEFINE DLL_KERNEL_WIN95 "KERNEL32.DLL" + +* DLL files used to read registry +#DEFINE DLL_ADVAPI_NT "ADVAPI32.DLL" +#DEFINE DLL_ADVAPI_WIN95 "ADVAPI32.DLL" + +* DLL files used to read ODBC info +#DEFINE DLL_ODBC_NT "ODBC32.DLL" +#DEFINE DLL_ODBC_WIN95 "ODBC32.DLL" + +* Registry roots +#DEFINE HKEY_CLASSES_ROOT -2147483648 && BITSET(0,31) +#DEFINE HKEY_CURRENT_USER -2147483647 && BITSET(0,31)+1 +#DEFINE HKEY_LOCAL_MACHINE -2147483646 && BITSET(0,31)+2 +#DEFINE HKEY_USERS -2147483645 && BITSET(0,31)+3 + +* Misc +#DEFINE APP_PATH_KEY "\Shell\Open\Command" +#DEFINE OLE_PATH_KEY "\Protocol\StdFileEditing\Server" +#DEFINE VFP_OPTIONS_KEY1 "Software\Microsoft\VisualFoxPro\" +#DEFINE VFP_OPTIONS_KEY2 "\Options" +#DEFINE CURVER_KEY "\CurVer" +#DEFINE ODBC_DATA_KEY "Software\ODBC\ODBC.INI\" +#DEFINE ODBC_DRVRS_KEY "Software\ODBC\ODBCINST.INI\" +#DEFINE SQL_FETCH_NEXT 1 +#DEFINE SQL_NO_DATA 100 + +* Error Codes +#DEFINE ERROR_SUCCESS 0 && OK +#DEFINE ERROR_EOF 259 && no more entries in key + +* Note these next error codes are specific to this Class, not DLL +#DEFINE ERROR_NOAPIFILE -101 && DLL file to check registry not found +#DEFINE ERROR_KEYNOREG -102 && key not registered +#DEFINE ERROR_BADPARM -103 && bad parameter passed +#DEFINE ERROR_NOENTRY -104 && entry not found +#DEFINE ERROR_BADKEY -105 && bad key passed +#DEFINE ERROR_NONSTR_DATA -106 && data type for value is not a data string +#DEFINE ERROR_BADPLAT -107 && platform not supported +#DEFINE ERROR_NOINIFILE -108 && DLL file to check INI not found +#DEFINE ERROR_NOINIENTRY -109 && No entry in INI file +#DEFINE ERROR_FAILINI -110 && failed to get INI entry +#DEFINE ERROR_NOPLAT -111 && call not supported on this platform +#DEFINE ERROR_NOODBCFILE -112 && DLL file to check ODBC not found +#DEFINE ERROR_ODBCFAIL -113 && failed to get ODBC environment + +* Data types for keys +#DEFINE REG_SZ 1 && Data string +#DEFINE REG_EXPAND_SZ 2 && Unicode string +#DEFINE REG_BINARY 3 && Binary data in any form. +#DEFINE REG_DWORD 4 && A 32-bit number. + +* Data types labels +#DEFINE REG_BINARY_LOC "*Binary*" && Binary data in any form. +#DEFINE REG_DWORD_LOC "*Dword*" && A 32-bit number. +#DEFINE REG_UNKNOWN_LOC "*Unknown type*" && unknown type + +* FoxPro ODBC drivers +#DEFINE FOXODBC_25 "FoxPro Files (*.dbf)" +#DEFINE FOXODBC_26 "Microsoft FoxPro Driver (*.dbf)" +#DEFINE FOXODBC_30 "Microsoft Visual FoxPro Driver" + diff --git a/Clase/roaclienti.vc2 b/Clase/roaclienti.vc2 new file mode 100644 index 0000000..1c7dfcf --- /dev/null +++ b/Clase/roaclienti.vc2 @@ -0,0 +1,218 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="roaclienti.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS capplication AS wzapplication OF "appwiz.vcx" && Application class. + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + clastcaption = Microsoft Visual FoxPro + clasticon = + Name = "capplication" + nformcount = 0 + * + + PROCEDURE doform + LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow + LOCAL lcFileName,lcClass,oForm,oForm2,lcName,lnCount,lnTop,lnLeft + LOCAL lcFormName,lnFormCount + + _screen.visible=.t. + + lcFileName=UPPER(ALLTRIM(tcFileName)) + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + lcClass=IIF(TYPE("tcClass")=="C",LOWER(ALLTRIM(tcClass)),"") + lcFileName=LOWER(FULLPATH(lcFileName)) + IF NOT "."$lcFileName + lcFileName=lcFileName+IIF(EMPTY(lcClass),".scx",".vcx") + ENDIF + IF NOT FILE(lcFileName) + this.FileNotFoundMsgBox(lcFileName) + RETURN .F. + ENDIF + lcFormName=IIF(EMPTY(lcClass),lcFileName,lcFileName+","+lcClass) + IF tlNoMultipleInstances + FOR lnCount = 1 TO this.nFormCount + IF this.aFormNames[lnCount]==lcFormName AND ; + TYPE("this.aForms[lnCount]")=="O" AND ; + NOT ISNULL(this.aForms[lnCount]) + this.aForms[lnCount].Show + RETURN .F. + ENDIF + ENDFOR + ENDIF + this.RefreshFormsCollection + this.nFormCount=this.nFormCount+1 + DIMENSION this.aForms[this.nFormCount],this.aFormNames[this.nFormCount] + this.aFormNames[this.nFormCount]=lcFormName + IF NOT EMPTY(lcClass) + SET CLASSLIB TO (lcFileName) ADDITIVE + this.aForms[this.nFormCount]=CREATEOBJECT(lcClass) + IF NOT tlNoShow AND TYPE("this.aForms[this.nFormCount]")=="O" AND ; + NOT ISNULL(this.aForms[this.nFormCount]) + this.aForms[this.nFormCount].Show + ENDIF + ELSE + DO FORM (lcFileName) NAME this.aForms[this.nFormCount] LINKED NOSHOW + ENDIF + lnFormCount=this.nFormCount + this.RefreshFormsCollection + IF this.lCascadeForms AND this.nFormCount>=lnFormCount + oForm=this.aForms[this.nFormCount] + lnTop=oForm.Top + lnLeft=oForm.Left + lcName=oForm.Name + IF WEXIST(lcName) AND oForm.WindowState#2 + FOR lnCount = 1 TO (this.nFormCount-1) + oForm2=this.aForms[lnCount] + IF TYPE("oForm2")#"O" OR ISNULL(oForm2) + LOOP + ENDIF + IF lcName==oForm2.Name AND WLROW(lcName)=WLROW(oForm2.Name) AND ; + WLCOL(lcName)=WLCOL(oForm2.Name) + lnTop=lnTop+this.nPixelOffset + lnLeft=lnLeft+this.nPixelOffset + ENDIF + ENDFOR + IF oForm.Top#lnTop + oForm.Top=lnTop + ENDIF + IF oForm.Left#lnLeft + oForm.Left=lnLeft + ENDIF + ENDIF + ENDIF + + *!* modificat 14.12.2004 + *!* liana + IF !(tlNoShow OR ('LOGIN'$UPPER(lcFileName) and glParametri)) + this.aForms[this.nFormCount].Show + ENDIF + + ENDPROC + +ENDDEFINE + +DEFINE CLASS pg_meniu_princ AS pg_meniu OF "ofundal.vcx" + *< CLASSDATA: Baseclass="pageframe" Timestamp="" Scale="Pixels" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Page1.Pict_meniu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page1.Cw2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page1.Cw3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page1.Pict_liniuta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page2.Pict_meniu1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page2.Pict_liniuta1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page2.Cw2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Page2.Cw3" UniqueID="" Timestamp="" /> + + * + ActivePage = 1 + ErasePage = .T. + Height = 422 + Name = "pg_meniu_princ" + PageCount = 2 + Width = 401 + Page1.Caption = "Leasing" + Page1.Name = "Page1" + Page1.PageOrder = 1 + Page2.Caption = "Furnizori" + Page2.Name = "Page2" + Page2.PageOrder = 2 + * + + ADD OBJECT 'Page1.Cw2' AS cw WITH ; + Height = 20, ; + Left = 11, ; + Name = "Cw2", ; + nid_cw = 1, ; + ntip = 1, ; + TabIndex = 1, ; + Top = 37, ; + Width = 113, ; + LABEL_ITEM1.Caption = "Contracte", ; + LABEL_ITEM1.Name = "LABEL_ITEM1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page1.Cw3' AS cw WITH ; + Height = 20, ; + Left = 11, ; + Name = "Cw3", ; + nid_cw = 1, ; + ntip = 1, ; + TabIndex = 1, ; + Top = 75, ; + Width = 113, ; + LABEL_ITEM1.Caption = "Rapoarte", ; + LABEL_ITEM1.Name = "LABEL_ITEM1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page1.Pict_liniuta1' AS pict_liniuta WITH ; + Left = 7, ; + Name = "Pict_liniuta1", ; + Picture = ..\..\comun\grafice\f3.jpg, ; + Top = 63 + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="image" /> + + ADD OBJECT 'Page1.Pict_meniu1' AS pict_meniu WITH ; + Left = 2, ; + Name = "Pict_meniu1", ; + Picture = ..\grafice\f2.jpg, ; + Top = 8 + *< END OBJECT: ClassLib="ofundal.vcx" BaseClass="image" /> + + ADD OBJECT 'Page2.Cw2' AS cw WITH ; + Height = 20, ; + Left = 11, ; + Name = "Cw2", ; + nid_cw = 1, ; + ntip = 1, ; + TabIndex = 1, ; + Top = 37, ; + Width = 113, ; + Label_item1.Caption = "Contracte", ; + Label_item1.Name = "Label_item1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page2.Cw3' AS cw WITH ; + Height = 20, ; + Left = 11, ; + Name = "Cw3", ; + nid_cw = 1, ; + ntip = 1, ; + TabIndex = 1, ; + Top = 75, ; + Width = 113, ; + Label_item1.Caption = "Rapoarte", ; + Label_item1.Name = "Label_item1" + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="container" /> + + ADD OBJECT 'Page2.Pict_liniuta1' AS pict_liniuta WITH ; + Left = 7, ; + Name = "Pict_liniuta1", ; + Picture = ..\grafice\f3.jpg, ; + Top = 63 + *< END OBJECT: ClassLib="ofundal.vcx" BaseClass="image" /> + + ADD OBJECT 'Page2.Pict_meniu1' AS pict_meniu WITH ; + Left = 2, ; + Name = "Pict_meniu1", ; + Picture = ..\grafice\f2.jpg, ; + Top = 8 + *< END OBJECT: ClassLib="ofundal.vcx" BaseClass="image" /> + + PROCEDURE Page1.Cw3.Init + + + ENDPROC + + PROCEDURE Page2.Cw3.Init + + + ENDPROC + +ENDDEFINE diff --git a/Clase/roaregistratura.vc2 b/Clase/roaregistratura.vc2 new file mode 100644 index 0000000..bee9376 --- /dev/null +++ b/Clase/roaregistratura.vc2 @@ -0,0 +1,98 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="roaregistratura.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS capplication AS wzapplication OF "appwiz.vcx" && Application class. + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + clastcaption = Microsoft Visual FoxPro + clasticon = + Name = "capplication" + nformcount = 0 + * + + PROCEDURE doform + LPARAMETERS tcFileName,tcClass,tlNoMultipleInstances,tlNoShow + LOCAL lcFileName,lcClass,oForm,oForm2,lcName,lnCount,lnTop,lnLeft + LOCAL lcFormName,lnFormCount + + _screen.visible=.t. + + lcFileName=UPPER(ALLTRIM(tcFileName)) + IF EMPTY(lcFileName) + RETURN .F. + ENDIF + lcClass=IIF(TYPE("tcClass")=="C",LOWER(ALLTRIM(tcClass)),"") + lcFileName=LOWER(FULLPATH(lcFileName)) + IF NOT "."$lcFileName + lcFileName=lcFileName+IIF(EMPTY(lcClass),".scx",".vcx") + ENDIF + IF NOT FILE(lcFileName) + this.FileNotFoundMsgBox(lcFileName) + RETURN .F. + ENDIF + lcFormName=IIF(EMPTY(lcClass),lcFileName,lcFileName+","+lcClass) + IF tlNoMultipleInstances + FOR lnCount = 1 TO this.nFormCount + IF this.aFormNames[lnCount]==lcFormName AND ; + TYPE("this.aForms[lnCount]")=="O" AND ; + NOT ISNULL(this.aForms[lnCount]) + this.aForms[lnCount].Show + RETURN .F. + ENDIF + ENDFOR + ENDIF + this.RefreshFormsCollection + this.nFormCount=this.nFormCount+1 + DIMENSION this.aForms[this.nFormCount],this.aFormNames[this.nFormCount] + this.aFormNames[this.nFormCount]=lcFormName + IF NOT EMPTY(lcClass) + SET CLASSLIB TO (lcFileName) ADDITIVE + this.aForms[this.nFormCount]=CREATEOBJECT(lcClass) + IF NOT tlNoShow AND TYPE("this.aForms[this.nFormCount]")=="O" AND ; + NOT ISNULL(this.aForms[this.nFormCount]) + this.aForms[this.nFormCount].Show + ENDIF + ELSE + DO FORM (lcFileName) NAME this.aForms[this.nFormCount] LINKED NOSHOW + ENDIF + lnFormCount=this.nFormCount + this.RefreshFormsCollection + IF this.lCascadeForms AND this.nFormCount>=lnFormCount + oForm=this.aForms[this.nFormCount] + lnTop=oForm.Top + lnLeft=oForm.Left + lcName=oForm.Name + IF WEXIST(lcName) AND oForm.WindowState#2 + FOR lnCount = 1 TO (this.nFormCount-1) + oForm2=this.aForms[lnCount] + IF TYPE("oForm2")#"O" OR ISNULL(oForm2) + LOOP + ENDIF + IF lcName==oForm2.Name AND WLROW(lcName)=WLROW(oForm2.Name) AND ; + WLCOL(lcName)=WLCOL(oForm2.Name) + lnTop=lnTop+this.nPixelOffset + lnLeft=lnLeft+this.nPixelOffset + ENDIF + ENDFOR + IF oForm.Top#lnTop + oForm.Top=lnTop + ENDIF + IF oForm.Left#lnLeft + oForm.Left=lnLeft + ENDIF + ENDIF + ENDIF + + *!* modificat 14.12.2004 + *!* liana + IF !(tlNoShow OR ('LOGIN'$UPPER(lcFileName) and glParametri)) + this.aForms[this.nFormCount].Show + ENDIF + + ENDPROC + +ENDDEFINE diff --git a/Clase/solution.vc2 b/Clase/solution.vc2 new file mode 100644 index 0000000..f826d53 --- /dev/null +++ b/Clase/solution.vc2 @@ -0,0 +1,65 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="solution.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS cmdclose AS commandbutton && Close button + *< CLASSDATA: Baseclass="commandbutton" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + Cancel = .T. + Caption = "Close" + FontBold = .F. + FontName = "MS Sans Serif" + FontSize = 8 + Height = 23 + Name = "cmdclose" + Width = 72 + * + + PROCEDURE Click + IF TYPE("THISFORM.Parent") = "O" + THISFORMSET.Release + ELSE + THISFORM.Release + ENDIF + ENDPROC + + PROCEDURE Error + LPARAMETERS nError, cMethod, nLine + LOCAL lnChoice + #DEFINE CR CHR(13) + DO CASE + CASE nError = 1545 && Uncommitted changes + *------------------------------------ + #DEFINE MSG1_LOC "Do you want to save your changes?" + #DEFINE MSG2_LOC "Uncommitted Changes" + lnChoice = MESSAGEBOX(MSG1_LOC, 4+48+0, MSG2_LOC) + DO CASE + CASE lnChoice = 6 && yes + =TABLEUPDATE(.T., .T.) + CASE lnChoice = 7 && no + =TABLEREVERT(.T.) + ENDCASE + OTHERWISE && Unanticipated error + *-------------------------------------- + #DEFINE NUM_LOC "Error Number: " + #DEFINE PROG_LOC "Program: " + #DEFINE CAP_LOC "ERROR" + lcMsg = NUM_LOC + ALLTRIM(STR(nError)) + CR + CR + ; + MESSAGE()+ CR + CR + PROG_LOC + PROGRAM(1) + lnChoice = MESSAGEBOX(lcMsg, 2+48+512, CAP_LOC) + DO CASE + CASE lnChoice = 3 &&Abort + CANCEL + CASE lnChoice = 4 &&Retry + RETRY + CASE lnChoice = 5 &&Ignore + RETURN + ENDCASE + ENDCASE + + ENDPROC + +ENDDEFINE diff --git a/Clase/utility.vc2 b/Clase/utility.vc2 new file mode 100644 index 0000000..c989b0d --- /dev/null +++ b/Clase/utility.vc2 @@ -0,0 +1,83 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="utility.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS menulib AS container + *< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" /> + + * + *m: deactivatemenu + *m: showmenu + * + + * + BackColor = 0,0,255 + Height = 15 + Name = "menulib" + Visible = .F. + Width = 50 + * + + PROCEDURE deactivatemenu + DEACTIVATE MENU _popShortcutMenu + + ENDPROC + + PROCEDURE Destroy + this.DeactivateMenu + + ENDPROC + + PROCEDURE showmenu + LPARAMETERS taMenu,tcOnSelection + LOCAL lcOnSelection,lnMenuCount,lnCount,llDoubleArray + LOCAL lcMenuItem,lcMenuSelection + EXTERNAL ARRAY taMenu + + IF PARAMETERS()=0 OR TYPE("taMenu")#"C" + RETURN .F. + ENDIF + lnMenuCount=0 + lnMenuCount=ALEN(taMenu,1) + IF lnMenuCount=0 + RETURN .F. + ENDIF + llDoubleArray=(ALEN(taMenu,2)>0) + ACTIVATE SCREEN + DEACTIVATE POPUP _popShortcutMenu + DEFINE POPUP _popShortcutMenu ; + FROM MROW(),MCOL() ; + MARGIN ; + RELATIVE ; + SHORTCUT + FOR lnCount = 1 TO lnMenuCount + lcMenuItem=IIF(llDoubleArray,taMenu[lnCount,1],taMenu[lnCount]) + DEFINE BAR lnCount OF _popShortcutMenu PROMPT (lcMenuItem) + ENDFOR + ON SELECTION POPUP _popShortcutMenu DEACTIVATE POPUP _popShortcutMenu + ACTIVATE POPUP _popShortcutMenu + RELEASE POPUP _popShortcutMenu + IF BAR()=0 + RETURN .F. + ENDIF + IF llDoubleArray + lcMenuSelection=taMenu[BAR(),2] + IF NOT EMPTY(lcMenuSelection) AND TYPE("lcMenuSelection")=="C" + lcOnSelection=ALLTRIM(lcMenuSelection) + ENDIF + IF EMPTY(lcOnSelection) + lcOnSelection=ALLTRIM(IIF(EMPTY(tcOnSelection),"",tcOnSelection)) + ENDIF + ELSE + lcOnSelection=ALLTRIM(IIF(EMPTY(tcOnSelection),"",tcOnSelection)) + ENDIF + IF EMPTY(lcOnSelection) + RETURN .F. + ENDIF + &lcOnSelection + + ENDPROC + +ENDDEFINE diff --git a/Ferestre/ATENTIE1.sc2 b/Ferestre/ATENTIE1.sc2 new file mode 100644 index 0000000..1c6e61a --- /dev/null +++ b/Ferestre/ATENTIE1.sc2 @@ -0,0 +1,75 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="atentie1.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + Name = "Dataenvironment" + * + +ENDDEFINE + +DEFINE CLASS fatentie1 AS fatentie OF "..\clase\ferestrebaza.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="CMDTERMIN1" UniqueID="" Timestamp="" /> + + * + BorderStyle = 3 + DoCreate = .T. + Height = 84 + Name = "Fatentie1" + Width = 353 + WindowType = 0 + Shape1.Height = 75 + Shape1.Left = 4 + Shape1.Name = "Shape1" + Shape1.Top = 4 + Shape1.Width = 344 + IMAGE1.Height = 32 + IMAGE1.Left = 24 + IMAGE1.Name = "IMAGE1" + IMAGE1.Top = 12 + IMAGE1.Width = 32 + Label1.Left = 64 + Label1.Name = "Label1" + Label1.Top = 14 + * + + ADD OBJECT 'CMDTERMIN1' AS cmdtermin WITH ; + AutoSize = .F., ; + Caption = "\ + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + Caption = "Modificarile sunt ireversibile!", ; + FontSize = 12, ; + Height = 21, ; + Left = 129, ; + Name = "Label2", ; + Top = 14, ; + Width = 200 + *< END OBJECT: BaseClass="label" /> + + PROCEDURE Deactivate + thisform.release + ENDPROC + + PROCEDURE LostFocus + thisform.release + + ENDPROC + +ENDDEFINE diff --git a/Ferestre/Vechi/startfirma.sc2 b/Ferestre/Vechi/startfirma.sc2 new file mode 100644 index 0000000..a38f513 --- /dev/null +++ b/Ferestre/Vechi/startfirma.sc2 @@ -0,0 +1,783 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="startfirma.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + Name = "Dataenvironment" + * + +ENDDEFINE + +DEFINE CLASS ffergen1 AS ffergen OF "..\clase\ferestrebaza.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Shape1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label10" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Shape2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label4" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label12" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmdtermin1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Cmdrenunt1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label11" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label8" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label13" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text6" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text9" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text3" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text5" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text7" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text8" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text10" UniqueID="" Timestamp="" /> + + * + *m: seriadebaza + *p: ttanul + *p: ttfirma + *p: ttluna + * + + * + AutoCenter = .T. + BackColor = 255,255,255 + BorderStyle = 2 + DoCreate = .T. + Height = 474 + Name = "Ffergen1" + Picture = + Width = 500 + WindowType = 1 + Line1.Name = "Line1" + * + + ADD OBJECT 'Cmdrenunt1' AS cmdrenunt WITH ; + Left = 305, ; + Name = "Cmdrenunt1", ; + TabIndex = 12, ; + Top = 432 + *< END OBJECT: ClassLib="..\clase\ferestrebaza.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Cmdtermin1' AS cmdtermin WITH ; + Left = 396, ; + Name = "Cmdtermin1", ; + TabIndex = 11, ; + Top = 432 + *< END OBJECT: ClassLib="..\clase\ferestrebaza.vcx" BaseClass="commandbutton" /> + + ADD OBJECT 'Label1' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 255,0,0, ; + BackStyle = 0, ; + Caption = "Bun Venit! ", ; + FontBold = .T., ; + FontItalic = .T., ; + FontName = "Comic Sans MS", ; + FontShadow = .F., ; + FontSize = 18, ; + ForeColor = 255,0,0, ; + Height = 37, ; + Left = 48, ; + Name = "Label1", ; + TabIndex = 24, ; + Top = 60, ; + Width = 128, ; + ZOrderSet = 1 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label10' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "CONT 2003", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 23, ; + ForeColor = 0,0,0, ; + Height = 39, ; + Left = 21, ; + Name = "Label10", ; + TabIndex = 23, ; + Top = 20, ; + Width = 185, ; + ZOrderSet = 3 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label11' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Anul:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 112, ; + Name = "Label11", ; + TabIndex = 16, ; + Top = 403, ; + Width = 44, ; + ZOrderSet = 20 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label12' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Strada:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 94, ; + Name = "Label12", ; + TabIndex = 19, ; + Top = 296, ; + Width = 62, ; + ZOrderSet = 8 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label13' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Numarul:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 80, ; + Name = "Label13", ; + TabIndex = 17, ; + Top = 321, ; + Width = 74, ; + ZOrderSet = 20 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "CONT 2003", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 23, ; + ForeColor = 0,0,0, ; + Height = 39, ; + Left = 22, ; + Name = "Label2", ; + TabIndex = 13, ; + Top = 18, ; + Width = 185, ; + ZOrderSet = 4 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label3' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Luna contabila:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 30, ; + Name = "Label3", ; + TabIndex = 20, ; + Top = 373, ; + Width = 126, ; + ZOrderSet = 8 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label4' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Cod fiscal:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 71, ; + Name = "Label4", ; + TabIndex = 22, ; + Top = 150, ; + Width = 87, ; + ZOrderSet = 8 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label5' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Nr. Inreg. R.C.:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 32, ; + Name = "Label5", ; + TabIndex = 14, ; + Top = 177, ; + Width = 123, ; + ZOrderSet = 20 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label6' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Banca:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 97, ; + Name = "Label6", ; + TabIndex = 21, ; + Top = 204, ; + Width = 59, ; + ZOrderSet = 8 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label7' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Cont bancar:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 49, ; + Name = "Label7", ; + TabIndex = 15, ; + Top = 230, ; + Width = 106, ; + ZOrderSet = 20 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label8' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Localitatea:", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 60, ; + Name = "Label8", ; + TabIndex = 18, ; + Top = 269, ; + Width = 97, ; + ZOrderSet = 20 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label9' AS label WITH ; + Alignment = 0, ; + AutoSize = .T., ; + BackColor = 0,0,0, ; + BackStyle = 0, ; + Caption = "Numele firmei: ", ; + FontBold = .T., ; + FontName = "BankGothic Md BT", ; + FontShadow = .F., ; + FontSize = 12, ; + ForeColor = 0,0,0, ; + Height = 22, ; + Left = 42, ; + Name = "Label9", ; + TabIndex = 25, ; + Top = 122, ; + Width = 122, ; + ZOrderSet = 1 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Shape1' AS shape WITH ; + BackStyle = 0, ; + Height = 458, ; + Left = 10, ; + Name = "Shape1", ; + SpecialEffect = 0, ; + Top = 8, ; + Width = 480, ; + ZOrderSet = 0 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'Shape2' AS shape WITH ; + BackStyle = 0, ; + Height = 0, ; + Left = 10, ; + Name = "Shape2", ; + SpecialEffect = 0, ; + Top = 356, ; + Width = 480, ; + ZOrderSet = 0 + *< END OBJECT: BaseClass="shape" /> + + ADD OBJECT 'Text1' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.cod_fiscal", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K", ; + Height = 23, ; + Left = 192, ; + Name = "Text1", ; + ReadOnly = .F., ; + TabIndex = 2, ; + Top = 148, ; + Value = , ; + Width = 225, ; + ZOrderSet = 25 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text10' AS textbox WITH ; + Alignment = 1, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.numar", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K", ; + Height = 23, ; + Left = 192, ; + Name = "Text10", ; + ReadOnly = .F., ; + TabIndex = 8, ; + Top = 319, ; + Value = , ; + Width = 102, ; + ZOrderSet = 26 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text2' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.luU", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K", ; + Height = 23, ; + Left = 192, ; + Name = "Text2", ; + ReadOnly = .F., ; + TabIndex = 9, ; + ToolTipText = "Introduceti (in cifre) numarul lunii contabile cu care doriti sa incepeti.", ; + Top = 371, ; + Value = , ; + Width = 102, ; + ZOrderSet = 25 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text3' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.an", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K", ; + Height = 23, ; + Left = 192, ; + Name = "Text3", ; + ReadOnly = .F., ; + TabIndex = 10, ; + ToolTipText = "Introduceti anul (inclusiv secolul).", ; + Top = 401, ; + Value = , ; + Width = 102, ; + ZOrderSet = 26 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text4' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.flung", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K!", ; + Height = 23, ; + Left = 192, ; + Name = "Text4", ; + ReadOnly = .F., ; + TabIndex = 1, ; + ToolTipText = "Introduceti numele complet al noii firme", ; + Top = 120, ; + Value = , ; + Width = 225, ; + ZOrderSet = 2 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text5' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.reg_com", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K!", ; + Height = 23, ; + Left = 192, ; + Name = "Text5", ; + ReadOnly = .F., ; + TabIndex = 3, ; + Top = 175, ; + Value = , ; + Width = 225, ; + ZOrderSet = 26 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text6' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.banca", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K!", ; + Height = 23, ; + Left = 192, ; + Name = "Text6", ; + ReadOnly = .F., ; + TabIndex = 4, ; + Top = 202, ; + Value = , ; + Width = 225, ; + ZOrderSet = 25 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text7' AS textbox WITH ; + Alignment = 1, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.cont_banca", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K", ; + Height = 23, ; + Left = 192, ; + Name = "Text7", ; + ReadOnly = .F., ; + TabIndex = 5, ; + Top = 228, ; + Value = , ; + Width = 225, ; + ZOrderSet = 26 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text8' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.localitate", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K!", ; + Height = 23, ; + Left = 192, ; + Name = "Text8", ; + ReadOnly = .F., ; + TabIndex = 6, ; + Top = 267, ; + Value = , ; + Width = 225, ; + ZOrderSet = 26 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text9' AS textbox WITH ; + Alignment = 0, ; + BackColor = 254,255,240, ; + BackStyle = 0, ; + BorderStyle = 1, ; + ControlSource = "m.strada", ; + FontName = "BankGothic Md BT", ; + FontSize = 11, ; + Format = "K!", ; + Height = 23, ; + Left = 192, ; + Name = "Text9", ; + ReadOnly = .F., ; + TabIndex = 7, ; + Top = 293, ; + Value = , ; + Width = 225, ; + ZOrderSet = 25 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE Activate + *public m.luU,M.FSCURT + m.luU=alltrim(STR(MONTH(DATE()))) + m.luu=right(alltrim('0'+m.luu),2) + + *M.AN=ALLTRIM(STR(YEAR(DATE()))) + M.AN=STR(YEAR(DATE()),4) + m.nl=m.luu + + + ENDPROC + + PROCEDURE seriadebaza + LOCAL SB,SN,I,T,TIPAR + STORE '' TO SB,SN + T=RAND(-1) + *TIPAR='VOICUIONEMIL' + + DO seriadebaza IN proceduri.prg + + + *!* FOR I=1 TO 5 + *!* SB=SB+LITERA() + *!* NEXT + + *!* SELE CUL + *!* REPL RED WITH SB + *!* SN=GREEN + + + *!* IF SUBSTR(SN,3,1)=SUBSTR(SB,1,1) AND; + *!* SUBSTR(SN,6,1)=SUBSTR(SB,2,1) AND; + *!* SUBSTR(SN,9,1)=SUBSTR(SB,3,1) AND; + *!* SUBSTR(SN,12,1)=SUBSTR(SB,4,1) AND; + *!* SUBSTR(SN,15,1)=SUBSTR(SB,5,1) AND; + *!* SUBSTR(SN,VAL(M.NL)+floor((VAL(M.NL)-1)/2),1)=SUBSTR(TIPAR,VAL(M.NL),1) + *!* *DO MESAJ WITH 'Seria este corecta','' + *!* RETURN + *!* ELSE + + *!* FOR I=1 TO 17 + *!* SN=SN+LITERA() + *!* NEXT + + *!* FOR I=1 TO 5 + *!* SN=STUFF(SN, I*3, 1, SUBSTR(SB,I,1)) + *!* NEXT + *!* SN=STUFF(SN, VAL(M.NL)+floor((VAL(M.NL)-1)/2), 1, SUBSTR(TIPAR,VAL(M.NL),1)) + + *!* SELE CUL + *!* REPL GREEN WITH SN + *!* ENDIF + ENDPROC + + PROCEDURE Cmdtermin1.Click + *DO NOT RELEASE + ENDPROC + + PROCEDURE Cmdtermin1.Valid + PUBLIC LAN,LLUN + LOCAL I,J,NI + LAN='AN'+M.AN + LLUN='DATE'+M.NL + I=.F. + + *SCRIE NUMELE SCURT AL FIRMEI___________________ + sele firma + M.firma=upper(alltrim(m.flung)) + M.FSCURT=M.FIRMA + M.fscurt=upper(alltrim(m.fSCURT))+space(7) + M.fscurt=ALLTRIM(LEFT(ALLTRIM(M.fscurt),8)) + M.FSCURT=CHRTRAN(M.FSCURT,SPACE(8),'________') + + tt='Numele noii firme nu trebuie sa coincida cu numele altor firme. '+; + 'O firma al carui nume incepe cu <'+LEFT(STRTRAN(m.fscurt,'_',' ')+SPACE(8),8)+; + '> exista deja! '+; + 'Este important ca primele 8 caractere sa fie diferite de <' + IF LEFT(STRTRAN(m.fscurt,'_',' ')+SPACE(8),8)!=LEFT(m.fscurt+"________",8) + ttt=LEFT(STRTRAN(m.fscurt,'_',' ')+SPACE(8),8)+'> sau <'+LEFT(m.fscurt+"________",8)+'>.' + ELSE + ttt=LEFT(m.fscurt+"________",8)+'>.' + endif + + *!* SCAN + *!* IF UPPER(ALLTRIM(FIRMA))==UPPER(ALLTRIM(M.FIRMA)) OR UPPER(ALLTRIM(Fscurt))==UPPER(ALLTRIM(M.Fscurt)) THEN + *!* I=.T. + *!* omm=crea('textmare') + *!* omm.label2.caption=tt+ttt + *!* omm.show(1) + *!* RETURN + *!* ENDIF + *!* ENDSCAN + SCAN + IF UPPER(ALLTRIM(FIRMA))==UPPER(ALLTRIM(M.FIRMA)) + I=.T. + omm=crea('textmare') + omm.label2.caption='Numele noii firme nu trebuie sa coincida cu numele altor firme.' + omm.show(1) + RETURN + ENDIF + ENDSCAN + + SCAN + IF UPPER(ALLTRIM(Fscurt))==UPPER(ALLTRIM(M.Fscurt)) + I=.T. + m.fscurt=LEFT(m.fscurt,2)+LEFT(STRTRAN(TIME(),':',''),6) + exit + ENDIF + ENDSCAN + + + + *DACA FIRMA NU EXISTA DEJA_______________ + IF !I + appe blank + NFSCURT=M.FSCURT + m.calefirm=dirgen+'\'+nfscurt + calefirma=m.calefirm + *m.loctempo='C:\CONTAFIN\TEMP\' + GATHER MEMVAR + repl permis with '*' + REPL locTEMPO WITH '&DIRGEN\' + + *CONSTRUIESC ARBORE FISIERE FIRMA NOUA______________________________ + set defa to c: + if !directory('contafin') + md contafin + endif + set defa to c:\contafin + if !directory('temp') + md temp + endif + set defa to c:\contafin\temp + MD &NFSCURT + set defa to c:\contafin\temp\&nfscurt + md tempo + SET DEFA TO &DIRGEN + + SET DEFA TO &DIRGEN + MD &NFSCURT + CD &NFSCURT + MD DATEAN + MD LUNA + MD TEMPO + MD &LAN + CD &LAN + MD &LLUN + *COPIEZ FISIERELE STANDARD__________________ + close database + SET DEFA TO &DIRGEN + COPY FILE _ALFA\DATEAN\*.* TO &NFSCURT\DATEAN\*.* + COPY FILE _ALFA\LUNA\*.* TO &NFSCURT\LUNA\*.* + COPY FILE _ALFA\TEMPO\*.* TO &NFSCURT\TEMPO\*.* + COPY FILE _ALFA\AN0000\DATE00\*.* TO &NFSCURT\&LAN\&LLUN\*.* + COPY FILE _ALFA\TEMPO\*.* TO c:\contafin\temp\&NFSCURT\TEMPO\*.* + + + *SCRIU IN CALENDAR___________________ + DIRFIRM=DIRGEN+NFSCURT + sele 0 + USE &calefirma\DATEAN\CALENDAR alias cal + APPE BLANK + REPL NL WITH M.NL + REPL AN WITH M.AN + REPL SCONT WITH .T. + M.antet=ALLTRIM(M.FLUNG) + + THISFORM.RELEASE + *____________ + ENDIF + + DO TOTV + + THISFORM.SERIADEBAZA + + SELE LUNILEAN + SEEK (M.NL) + M.LUNA=NUMELUNA + + *schimb titlul__________________ + capapl="CONT2000 Firma "+UPPER(rTRIM(m.flung))+"- Luna contabila: "+RTRIM(M.luna)+" "+M.AN + goApp.SetCaption(capapl) + + + ENDPROC + + PROCEDURE Text2.Valid + m.nl=RIGHT('0'+ALLTRIM(m.lUU),2) + + + + + ENDPROC + + PROCEDURE Text3.Valid + M.AN=ALLTRIM(THIS.VALUE) + + ENDPROC + + PROCEDURE Text4.MouseMove + LPARAMETERS nButton, nShift, nXCoord, nYCoord + ENDPROC + + PROCEDURE Text4.Valid + if alltrim(m.flung)=="" then + wait wind "Introduceti numele firmei!" + return 0 + endif + + ENDPROC + + PROCEDURE Text4.When + *thisform.label8.caption=thisform.ttFIRMA + ENDPROC + +ENDDEFINE diff --git a/Ferestre/frm_dg_date_generale.sc2 b/Ferestre/frm_dg_date_generale.sc2 new file mode 100644 index 0000000..767d2ce --- /dev/null +++ b/Ferestre/frm_dg_date_generale.sc2 @@ -0,0 +1,43 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="frm_dg_date_generale.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + * + +ENDDEFINE + +DEFINE CLASS frm_dg_date_generale1 AS frm_dg_date_generale OF "..\clase\ferestre_registratura.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + * + DoCreate = .T. + Name = "Frm_dg_date_generale1" + Shape7.Name = "Shape7" + _shape1.Name = "_shape1" + Gridsort1.Name = "Gridsort1" + _shape2.Name = "_shape2" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + ck_semnat.Alignment = 0 + ck_semnat.Name = "ck_semnat" + txtData_intern.Name = "txtData_intern" + LABEL4.Name = "LABEL4" + txtDescriere.Name = "txtDescriere" + Label6.Name = "Label6" + txtNumar_intern.Name = "txtNumar_intern" + LABEL9.Name = "LABEL9" + * + +ENDDEFINE diff --git a/Ferestre/frm_dg_link.sc2 b/Ferestre/frm_dg_link.sc2 new file mode 100644 index 0000000..e017fc3 --- /dev/null +++ b/Ferestre/frm_dg_link.sc2 @@ -0,0 +1,47 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="frm_dg_link.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + * + +ENDDEFINE + +DEFINE CLASS frm_dg_link1 AS frm_dg_link OF "..\clase\ferestre_registratura.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + * + DoCreate = .T. + Name = "Frm_dg_link1" + _shape1.Name = "_shape1" + _shape2.Name = "_shape2" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + Gridsort1.Name = "Gridsort1" + grid_linkuri.COLUMN1.HEADER1.Name = "HEADER1" + grid_linkuri.COLUMN1.Name = "COLUMN1" + grid_linkuri.COLUMN1.Text1.Name = "Text1" + grid_linkuri.COLUMN2.HEADER1.Name = "HEADER1" + grid_linkuri.COLUMN2.Name = "COLUMN2" + grid_linkuri.COLUMN2.Text1.Name = "Text1" + grid_linkuri.COLUMN3.HEADER1.Name = "HEADER1" + grid_linkuri.COLUMN3.Name = "COLUMN3" + grid_linkuri.COLUMN3.Text1.Name = "Text1" + grid_linkuri.Name = "grid_linkuri" + BUT_NOU1.Name = "BUT_NOU1" + BUT_STERGE1.Name = "BUT_STERGE1" + But_edit1.Name = "But_edit1" + * + +ENDDEFINE diff --git a/Ferestre/frm_dg_observatii.sc2 b/Ferestre/frm_dg_observatii.sc2 new file mode 100644 index 0000000..4b8ffe9 --- /dev/null +++ b/Ferestre/frm_dg_observatii.sc2 @@ -0,0 +1,35 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="frm_dg_observatii.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + * + +ENDDEFINE + +DEFINE CLASS frm_dg_observatii1 AS frm_dg_observatii OF "..\clase\ferestre_registratura.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + * + DoCreate = .T. + Name = "Frm_dg_observatii1" + _shape1.Name = "_shape1" + _shape2.Name = "_shape2" + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + Gridsort1.Name = "Gridsort1" + Edit1.Name = "Edit1" + * + +ENDDEFINE diff --git a/Ferestre/frm_dg_referinte.sc2 b/Ferestre/frm_dg_referinte.sc2 new file mode 100644 index 0000000..6f24135 --- /dev/null +++ b/Ferestre/frm_dg_referinte.sc2 @@ -0,0 +1,50 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="frm_dg_referinte.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + DataSource = .NULL. + Height = 0 + Left = 0 + Name = "Dataenvironment" + Top = 0 + Width = 0 + * + +ENDDEFINE + +DEFINE CLASS frm_dg_obiectul1 AS frm_dg_referinte OF "..\clase\ferestre_registratura.vcx" + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + * + DoCreate = .T. + Name = "Frm_dg_obiectul1" + _shape1.Name = "_shape1" + _shape2.Name = "_shape2" + _shape2.Visible = .F. + Lb_titlu_alb_b121.Name = "Lb_titlu_alb_b121" + BUT_TERMIN1.Name = "BUT_TERMIN1" + Gridsort1.Name = "Gridsort1" + BUT_NOU1.Name = "BUT_NOU1" + BUT_NOU1.Visible = .F. + BUT_STERGE1.Name = "BUT_STERGE1" + BUT_STERGE1.Visible = .F. + grid_referinte.COLUMN1.Header1.Name = "Header1" + grid_referinte.COLUMN1.Name = "COLUMN1" + grid_referinte.COLUMN1.Text1.Name = "Text1" + grid_referinte.COLUMN1.Text1.Visible = .T. + grid_referinte.COLUMN1.Visible = .T. + grid_referinte.Column2.Header1.Name = "Header1" + grid_referinte.Column2.Name = "Column2" + grid_referinte.Column2.Text1.Name = "Text1" + grid_referinte.Column2.Text1.Visible = .T. + grid_referinte.Column2.Visible = .T. + grid_referinte.Name = "grid_referinte" + * + +ENDDEFINE diff --git a/Ferestre/fundal.sc2 b/Ferestre/fundal.sc2 new file mode 100644 index 0000000..5526caa --- /dev/null +++ b/Ferestre/fundal.sc2 @@ -0,0 +1,410 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="fundal.scx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +* +DEFINE CLASS dataenvironment AS dataenvironment + *< CLASSDATA: Baseclass="dataenvironment" Timestamp="" Scale="" Uniqueid="" ClassIcon="1" /> + + * + DataSource = .NULL. + Height = 200 + Left = 1 + Name = "Dataenvironment" + Top = 220 + Width = 520 + * + +ENDDEFINE + +DEFINE CLASS form1 AS form + *< CLASSDATA: Baseclass="form" Timestamp="" Scale="" Uniqueid="" /> + + *-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder + *< OBJECTDATA: ObjPath="Label1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Text2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Image2" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="_pgfrmbase1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Image1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_utilizator" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="lb_utilizator1" UniqueID="" Timestamp="" /> + *< OBJECTDATA: ObjPath="Imagine01" UniqueID="" Timestamp="" /> + + * + *m: arata_meniu_fluna + *m: statusbarclick + *p: ostatusbar + * + + * + AlwaysOnBottom = .T. + AutoCenter = .T. + BackColor = 255,255,255 + BorderStyle = 0 + Caption = "" + Closable = .F. + ControlBox = .F. + DoCreate = .T. + Enabled = .T. + FillColor = 0,0,0 + HalfHeightCaption = .F. + Height = 429 + MaxButton = .F. + MinButton = .F. + Movable = .F. + Name = "Form1" + ostatusbar = + Picture = ..\..\ + ShowTips = .T. + Themes = .F. + Width = 797 + WindowState = 2 + * + + ADD OBJECT '_pgfrmbase1' AS pg_meniu_princ WITH ; + ErasePage = .T., ; + Height = 457, ; + Left = -2, ; + Name = "_pgfrmbase1", ; + Top = 61, ; + Page1.Cw1.Label_item1.Name = "Label_item1", ; + Page1.Cw1.Name = "Cw1", ; + Page1.Cw2.Label_item1.Name = "Label_item1", ; + Page1.Cw2.Name = "Cw2", ; + Page1.Cw4.Label_item1.Name = "Label_item1", ; + Page1.Cw4.Name = "Cw4", ; + Page1.Name = "Page1", ; + Page1.shape1.Name = "shape1", ; + Page2.Ct_registratura1.But_excel1.Name = "But_excel1", ; + Page2.Ct_registratura1.But_listare1.Name = "But_listare1", ; + Page2.Ct_registratura1.But_nou1.Name = "But_nou1", ; + Page2.Ct_registratura1.But_sterge1.Name = "But_sterge1", ; + Page2.Ct_registratura1.Ck_data.Alignment = 0, ; + Page2.Ct_registratura1.Ck_data.Name = "Ck_data", ; + Page2.Ct_registratura1.Ck_numar.Alignment = 0, ; + Page2.Ct_registratura1.Ck_numar.Name = "Ck_numar", ; + Page2.Ct_registratura1.Ck_nume.Alignment = 0, ; + Page2.Ct_registratura1.Ck_nume.Name = "Ck_nume", ; + Page2.Ct_registratura1.ck_sters.Alignment = 0, ; + Page2.Ct_registratura1.ck_sters.Name = "ck_sters", ; + Page2.Ct_registratura1.Ck_tipdoc.Alignment = 0, ; + Page2.Ct_registratura1.Ck_tipdoc.Name = "Ck_tipdoc", ; + Page2.Ct_registratura1.Clb_tx_simplu1.Lb_simplu1.Name = "Lb_simplu1", ; + Page2.Ct_registratura1.Clb_tx_simplu1.Name = "Clb_tx_simplu1", ; + Page2.Ct_registratura1.Clb_tx_simplu1.Text_simplu1.Name = "Text_simplu1", ; + Page2.Ct_registratura1.Cmd_cauta1.Name = "Cmd_cauta1", ; + Page2.Ct_registratura1.Cmd_reset1.Name = "Cmd_reset1", ; + Page2.Ct_registratura1.Gridsort1.Name = "Gridsort1", ; + Page2.Ct_registratura1.grid_registratura.cAre_obs.Check1.Alignment = 0, ; + Page2.Ct_registratura1.grid_registratura.cAre_obs.Check1.Name = "Check1", ; + Page2.Ct_registratura1.grid_registratura.cAre_obs.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cAre_obs.Name = "cAre_obs", ; + Page2.Ct_registratura1.grid_registratura.cAvizat.Check1.Alignment = 0, ; + Page2.Ct_registratura1.grid_registratura.cAvizat.Check1.Name = "Check1", ; + Page2.Ct_registratura1.grid_registratura.cAvizat.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cAvizat.Name = "cAvizat", ; + Page2.Ct_registratura1.grid_registratura.cData_ctr.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cData_ctr.Name = "cData_ctr", ; + Page2.Ct_registratura1.grid_registratura.cData_ctr.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cData_intern.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cData_intern.Name = "cData_intern", ; + Page2.Ct_registratura1.grid_registratura.cData_intern.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cDescriere.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cDescriere.Name = "cDescriere", ; + Page2.Ct_registratura1.grid_registratura.cDescriere.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cFel_document.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cFel_document.Name = "cFel_document", ; + Page2.Ct_registratura1.grid_registratura.cFel_document.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cIE.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cIE.Name = "cIE", ; + Page2.Ct_registratura1.grid_registratura.cIE.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cMediu_transmisie.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cMediu_transmisie.Name = "cMediu_transmisie", ; + Page2.Ct_registratura1.grid_registratura.cMediu_transmisie.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNresp.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNresp.Name = "cNresp", ; + Page2.Ct_registratura1.grid_registratura.cNresp.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNr_ctr.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNr_ctr.Name = "cNr_ctr", ; + Page2.Ct_registratura1.grid_registratura.cNr_ctr.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNr_pag.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNr_pag.Name = "cNr_pag", ; + Page2.Ct_registratura1.grid_registratura.cNr_pag.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNumar_intern.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNumar_intern.Name = "cNumar_intern", ; + Page2.Ct_registratura1.grid_registratura.cNumar_intern.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cNume.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cNume.Name = "cNume", ; + Page2.Ct_registratura1.grid_registratura.cNume.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN12.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN12.Name = "COLUMN12", ; + Page2.Ct_registratura1.grid_registratura.COLUMN12.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN13.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN13.Name = "COLUMN13", ; + Page2.Ct_registratura1.grid_registratura.COLUMN13.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN14.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN14.Name = "COLUMN14", ; + Page2.Ct_registratura1.grid_registratura.COLUMN14.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN15.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN15.Name = "COLUMN15", ; + Page2.Ct_registratura1.grid_registratura.COLUMN15.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN16.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN16.Name = "COLUMN16", ; + Page2.Ct_registratura1.grid_registratura.COLUMN16.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN17.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN17.Name = "COLUMN17", ; + Page2.Ct_registratura1.grid_registratura.COLUMN17.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN22.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.COLUMN22.Name = "COLUMN22", ; + Page2.Ct_registratura1.grid_registratura.COLUMN22.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.Column23.Command1.Name = "Command1", ; + Page2.Ct_registratura1.grid_registratura.Column23.Command2.Name = "Command2", ; + Page2.Ct_registratura1.grid_registratura.Column23.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.Column23.Name = "Column23", ; + Page2.Ct_registratura1.grid_registratura.Column23.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.cPers_contact.Header1.Name = "Header1", ; + Page2.Ct_registratura1.grid_registratura.cPers_contact.Name = "cPers_contact", ; + Page2.Ct_registratura1.grid_registratura.cPers_contact.Text1.Name = "Text1", ; + Page2.Ct_registratura1.grid_registratura.Name = "grid_registratura", ; + Page2.Ct_registratura1.Name = "Ct_registratura1", ; + Page2.Ct_registratura1._ct_controller_keypress1.Name = "_ct_controller_keypress1", ; + Page2.Ct_registratura1._lbbase1.Name = "_lbbase1", ; + Page2.Ct_registratura1._shape1.Name = "_shape1", ; + Page2.Name = "Page2", ; + Page3.CT_DATE_GENERALE1.Name = "CT_DATE_GENERALE1", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Name = "outlook2003bar1", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.overflowpanel.MenuButton.imgPicture.Height = 16, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.overflowpanel.MenuButton.imgPicture.Name = "imgPicture", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.overflowpanel.MenuButton.imgPicture.Width = 16, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.overflowpanel.MenuButton.Name = "MenuButton", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.overflowpanel.Name = "overflowpanel", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panel.Name = "Panel", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.ErasePage = .T., ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.Height = 328, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.Name = "Panes", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Name = "pane1", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol1.Height = 328, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol1.Left = 0, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol1.Name = "Olecontrol1", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol1.Top = 0, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol1.Width = 198, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol2.Height = 150, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol2.Name = "Olecontrol2", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane1.Olecontrol2.Width = 200, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane2.Name = "pane2", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane3.Name = "pane3", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.pane4.Name = "pane4", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Panes.Top = 33, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.SplitBar.imgSplitter.Height = 3, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.SplitBar.imgSplitter.Name = "imgSplitter", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.SplitBar.imgSplitter.Width = 35, ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.SplitBar.Name = "SplitBar", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Splitter.Name = "Splitter", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Title.lblCaption.Name = "lblCaption", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Title.linBorder.Name = "linBorder", ; + Page3.CT_DATE_GENERALE1.outlook2003bar1.Title.Name = "Title", ; + Page3.CT_PART_NR_DATA1.cmdDenumire.Name = "cmdDenumire", ; + Page3.CT_PART_NR_DATA1.Command2.Name = "Command2", ; + Page3.CT_PART_NR_DATA1.Label3.Name = "Label3", ; + Page3.CT_PART_NR_DATA1.Label4.Name = "Label4", ; + Page3.CT_PART_NR_DATA1.Label9.Name = "Label9", ; + Page3.CT_PART_NR_DATA1.Name = "CT_PART_NR_DATA1", ; + Page3.CT_PART_NR_DATA1.txtClient.Name = "txtClient", ; + Page3.CT_PART_NR_DATA1.txtData_ctr.Name = "txtData_ctr", ; + Page3.CT_PART_NR_DATA1.txtNumar.Name = "txtNumar", ; + Page3.Name = "Page3" + *< END OBJECT: ClassLib="..\clase\ofundal_registratura.vcx" BaseClass="pageframe" /> + + ADD OBJECT 'Image1' AS image WITH ; + Anchor = 12, ; + Height = 220, ; + Left = 228, ; + Name = "Image1", ; + Picture = ..\grafice\roaregistratura.bmp, ; + Stretch = 0, ; + Top = 204, ; + Width = 556 + *< END OBJECT: BaseClass="image" /> + + ADD OBJECT 'Image2' AS image WITH ; + Anchor = 10, ; + Height = 64, ; + Left = -11, ; + Name = "Image2", ; + Picture = ..\comun\grafice\f1.jpg, ; + Stretch = 2, ; + Top = -1, ; + Width = 851 + *< END OBJECT: BaseClass="image" /> + + ADD OBJECT 'Imagine01' AS imagine WITH ; + ccod = A01, ; + Height = 48, ; + Left = 13, ; + Name = "Imagine01", ; + nid_img = 1, ; + ntip = 4, ; + picturedown = clie2.bmp, ; + pictureup = clie1.bmp, ; + ToolTipText = "Vizualizare parteneri", ; + Top = 0, ; + Width = 60 + *< END OBJECT: ClassLib="..\comun\clase\ofundal.vcx" BaseClass="image" /> + + ADD OBJECT 'Label1' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Operator:", ; + FontItalic = .T., ; + ForeColor = 0,0,128, ; + Height = 17, ; + Left = 7, ; + Name = "Label1", ; + Top = 381, ; + Width = 53 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'Label2' AS label WITH ; + AutoSize = .T., ; + BackStyle = 0, ; + Caption = "Nivel de acces:", ; + FontItalic = .T., ; + ForeColor = 0,0,128, ; + Height = 17, ; + Left = 7, ; + Name = "Label2", ; + Top = 401, ; + Width = 85 + *< END OBJECT: BaseClass="label" /> + + ADD OBJECT 'lb_utilizator' AS lb_simplu WITH ; + Anchor = 4, ; + Caption = "Operator:", ; + FontItalic = .T., ; + ForeColor = 255,255,255, ; + Left = 571, ; + Name = "lb_utilizator", ; + Top = 8 + *< END OBJECT: ClassLib="..\comun\clase\lb.vcx" BaseClass="label" /> + + ADD OBJECT 'lb_utilizator1' AS lb_simplu WITH ; + Anchor = 4, ; + Caption = "nume_utilizator", ; + FontBold = .T., ; + FontItalic = .T., ; + ForeColor = 255,255,255, ; + Left = 625, ; + Name = "lb_utilizator1", ; + Top = 8, ; + Visible = .F. + *< END OBJECT: ClassLib="..\comun\clase\lb.vcx" BaseClass="label" /> + + ADD OBJECT 'Text1' AS textbox WITH ; + BackStyle = 0, ; + BorderStyle = 0, ; + ControlSource = "utilizator", ; + FontBold = .T., ; + FontItalic = .T., ; + ForeColor = 0,0,128, ; + Height = 23, ; + Left = 62, ; + Name = "Text1", ; + ReadOnly = .T., ; + TabStop = .F., ; + Top = 380, ; + Width = 147 + *< END OBJECT: BaseClass="textbox" /> + + ADD OBJECT 'Text2' AS textbox WITH ; + BackStyle = 0, ; + BorderStyle = 0, ; + ControlSource = "m.nivel", ; + FontBold = .T., ; + FontItalic = .T., ; + ForeColor = 0,0,128, ; + Height = 23, ; + Left = 93, ; + Name = "Text2", ; + ReadOnly = .T., ; + TabStop = .F., ; + Top = 400, ; + Width = 28 + *< END OBJECT: BaseClass="textbox" /> + + PROCEDURE arata_meniu_fluna + Do start_firma In ostartfirma.prg + verifica_drepturi('gofundal','_pgfrmbase1') + With Thisform._pgfrmbase1.page2.ct_registratura1 + .do_initializeaza_cursor() + .grid_registratura.SetFocus() + Endwith + ENDPROC + + PROCEDURE RightClick + Thisform.arata_meniu_fluna() + ENDPROC + + PROCEDURE Show + Lparameters nStyle + DoDefault(nStyle) + This.AlwaysOnBottom = .T. + + Thisform.arata_meniu_fluna() + primadata = .F. + Thisform.lb_utilizator1.Caption=Alltrim(gcUserNameApp) + Thisform.lb_utilizator1.Visible=.T. + Do lansare_toolbar In oproceduri_comune.prg + DO lansare_help IN oproceduri_comune.prg + ENDPROC + + PROCEDURE statusbarclick + Thisform.oStatusBar.newtooltip() + ENDPROC + + PROCEDURE Image1.RightClick + Thisform.arata_meniu_fluna() + ENDPROC + + PROCEDURE Imagine01.do_actiune + Thisform._pgfrmbase1.page1.cw1.do_actiune() + ENDPROC + + PROCEDURE lb_utilizator.RightClick + Thisform.arata_meniu_fluna() + ENDPROC + + PROCEDURE lb_utilizator1.RightClick + Thisform.arata_meniu_fluna() + ENDPROC + + PROCEDURE _pgfrmbase1.Page1.Activate + DODEFAULT() + Thisform.image1.Visible = .T. + ENDPROC + + PROCEDURE _pgfrmbase1.Page1.RightClick + Thisform.arata_meniu_fluna() + ENDPROC + + PROCEDURE _pgfrmbase1.Page2.Activate + DODEFAULT() + Thisform.image1.Visible = .F. + ENDPROC + + PROCEDURE _pgfrmbase1.Page2.RightClick + Thisform.arata_meniu_fluna() + ENDPROC + + PROCEDURE _pgfrmbase1.Page3.Activate + DODEFAULT() + Thisform.image1.Visible = .F. + ENDPROC + + PROCEDURE _pgfrmbase1.Page3.RightClick + Thisform.arata_meniu_fluna() + ENDPROC + +ENDDEFINE diff --git a/Grafice/C.ico b/Grafice/C.ico new file mode 100644 index 0000000..ce97f71 Binary files /dev/null and b/Grafice/C.ico differ diff --git a/Grafice/CHECKMRK.ICO b/Grafice/CHECKMRK.ICO new file mode 100644 index 0000000..2eb7ca6 Binary files /dev/null and b/Grafice/CHECKMRK.ICO differ diff --git a/Grafice/Calendar Multiweek 16.png b/Grafice/Calendar Multiweek 16.png new file mode 100644 index 0000000..4f29215 Binary files /dev/null and b/Grafice/Calendar Multiweek 16.png differ diff --git a/Grafice/Calendar Multiweek 24.png b/Grafice/Calendar Multiweek 24.png new file mode 100644 index 0000000..2ee9d64 Binary files /dev/null and b/Grafice/Calendar Multiweek 24.png differ diff --git a/Grafice/Cont12.ico b/Grafice/Cont12.ico new file mode 100644 index 0000000..c6360c1 Binary files /dev/null and b/Grafice/Cont12.ico differ diff --git a/Grafice/Contacts 16.png b/Grafice/Contacts 16.png new file mode 100644 index 0000000..b1b03fa Binary files /dev/null and b/Grafice/Contacts 16.png differ diff --git a/Grafice/Contacts 24.png b/Grafice/Contacts 24.png new file mode 100644 index 0000000..108da55 Binary files /dev/null and b/Grafice/Contacts 24.png differ diff --git a/Grafice/EXCLAM1.ICO b/Grafice/EXCLAM1.ICO new file mode 100644 index 0000000..42fcf59 Binary files /dev/null and b/Grafice/EXCLAM1.ICO differ diff --git a/Grafice/EXCLAM2.ICO b/Grafice/EXCLAM2.ICO new file mode 100644 index 0000000..351aa72 Binary files /dev/null and b/Grafice/EXCLAM2.ICO differ diff --git a/Grafice/EXCLEM.ICO b/Grafice/EXCLEM.ICO new file mode 100644 index 0000000..90fe0f2 Binary files /dev/null and b/Grafice/EXCLEM.ICO differ diff --git a/Grafice/EYE.ICO b/Grafice/EYE.ICO new file mode 100644 index 0000000..b1c65e6 Binary files /dev/null and b/Grafice/EYE.ICO differ diff --git a/Grafice/Email Envelope 16.png b/Grafice/Email Envelope 16.png new file mode 100644 index 0000000..daf1ab4 Binary files /dev/null and b/Grafice/Email Envelope 16.png differ diff --git a/Grafice/Email Envelope 24.png b/Grafice/Email Envelope 24.png new file mode 100644 index 0000000..b02ed00 Binary files /dev/null and b/Grafice/Email Envelope 24.png differ diff --git a/Grafice/FIND.BMP b/Grafice/FIND.BMP new file mode 100644 index 0000000..c29fbce Binary files /dev/null and b/Grafice/FIND.BMP differ diff --git a/Grafice/Favourites 16.png b/Grafice/Favourites 16.png new file mode 100644 index 0000000..668daae Binary files /dev/null and b/Grafice/Favourites 16.png differ diff --git a/Grafice/Favourites 24.png b/Grafice/Favourites 24.png new file mode 100644 index 0000000..8ce53f7 Binary files /dev/null and b/Grafice/Favourites 24.png differ diff --git a/Grafice/Games 16.png b/Grafice/Games 16.png new file mode 100644 index 0000000..68e5c02 Binary files /dev/null and b/Grafice/Games 16.png differ diff --git a/Grafice/Games 24.png b/Grafice/Games 24.png new file mode 100644 index 0000000..589d9f7 Binary files /dev/null and b/Grafice/Games 24.png differ diff --git a/Grafice/HLP.BMP b/Grafice/HLP.BMP new file mode 100644 index 0000000..4fbb501 Binary files /dev/null and b/Grafice/HLP.BMP differ diff --git a/Grafice/H_POINT.CUR b/Grafice/H_POINT.CUR new file mode 100644 index 0000000..6d1096b Binary files /dev/null and b/Grafice/H_POINT.CUR differ diff --git a/Grafice/Help 2 16.png b/Grafice/Help 2 16.png new file mode 100644 index 0000000..72e0572 Binary files /dev/null and b/Grafice/Help 2 16.png differ diff --git a/Grafice/Help 2 24.png b/Grafice/Help 2 24.png new file mode 100644 index 0000000..1437723 Binary files /dev/null and b/Grafice/Help 2 24.png differ diff --git a/Grafice/INFO_c.ICO b/Grafice/INFO_c.ICO new file mode 100644 index 0000000..883470b Binary files /dev/null and b/Grafice/INFO_c.ICO differ diff --git a/Grafice/Intreb.ico b/Grafice/Intreb.ico new file mode 100644 index 0000000..a63d9c3 Binary files /dev/null and b/Grafice/Intreb.ico differ diff --git a/Grafice/Music Player 1 16.png b/Grafice/Music Player 1 16.png new file mode 100644 index 0000000..7f020bc Binary files /dev/null and b/Grafice/Music Player 1 16.png differ diff --git a/Grafice/Music Player 1 24.png b/Grafice/Music Player 1 24.png new file mode 100644 index 0000000..77b41f6 Binary files /dev/null and b/Grafice/Music Player 1 24.png differ diff --git a/Grafice/Pics 1 16.png b/Grafice/Pics 1 16.png new file mode 100644 index 0000000..9d06b03 Binary files /dev/null and b/Grafice/Pics 1 16.png differ diff --git a/Grafice/Pics 1 24.png b/Grafice/Pics 1 24.png new file mode 100644 index 0000000..72f8697 Binary files /dev/null and b/Grafice/Pics 1 24.png differ diff --git a/Grafice/Security 1 16.png b/Grafice/Security 1 16.png new file mode 100644 index 0000000..abf85d7 Binary files /dev/null and b/Grafice/Security 1 16.png differ diff --git a/Grafice/Security 1 24.png b/Grafice/Security 1 24.png new file mode 100644 index 0000000..565d5ab Binary files /dev/null and b/Grafice/Security 1 24.png differ diff --git a/Grafice/Tech Support 16.png b/Grafice/Tech Support 16.png new file mode 100644 index 0000000..ef31f1d Binary files /dev/null and b/Grafice/Tech Support 16.png differ diff --git a/Grafice/Tech Support 24.png b/Grafice/Tech Support 24.png new file mode 100644 index 0000000..fdaa5ce Binary files /dev/null and b/Grafice/Tech Support 24.png differ diff --git a/Grafice/WZDELETE.BMP b/Grafice/WZDELETE.BMP new file mode 100644 index 0000000..c8b8bd4 Binary files /dev/null and b/Grafice/WZDELETE.BMP differ diff --git a/Grafice/WZEDIT.BMP b/Grafice/WZEDIT.BMP new file mode 100644 index 0000000..e62ba5b Binary files /dev/null and b/Grafice/WZEDIT.BMP differ diff --git a/Grafice/WZSETUP.INI b/Grafice/WZSETUP.INI new file mode 100644 index 0000000..a95f994 --- /dev/null +++ b/Grafice/WZSETUP.INI @@ -0,0 +1,36 @@ +[Preferences] +DistributionDirectory=C:\VFP\DISTRIB\ +DistributionSourceDirectory=C:\VFP\DISTRIB.SRC\ +SourceDirectory=E:\CONT2000\CONTAB\GRAFICE\ +InstallFoxProRuntime=Y +InstallGraph=N +InstallODBCDrivers=N +AccessDriver=Y +FoxPro2xDriver=Y +dBASEDriver=Y +ParadoxDriver=Y +SQLServerDriver=Y +ExcelDriver=Y +TextDriver=Y +OracleDriver=Y +Oracle7Driver=Y +BtrieveDriver=Y +VFPDriver=Y +InstallWindows95=N +InstallWindowsNT=N +DestinationDirectory=E:\CONTSETUP\ +Make1.44MegDisks=N +Make1.2MegDisks=N +Make720KDisks=N +MakeNetsetup=Y +SetupBanner=gr +Copyright=gr +PostExecute= +UserDefaultDirectory=\GRAFICE\ +ProgManGroup=Visual FoxPro Applications +UserCanModify=1 +SplitSize=363520 +FileCustomizationDelimiter=~ +InstRemoteAuto=N +InstActiveX=N + diff --git a/Grafice/attach.bmp b/Grafice/attach.bmp new file mode 100644 index 0000000..a7ada5f Binary files /dev/null and b/Grafice/attach.bmp differ diff --git a/Grafice/clienti_jos.bmp b/Grafice/clienti_jos.bmp new file mode 100644 index 0000000..5c93821 Binary files /dev/null and b/Grafice/clienti_jos.bmp differ diff --git a/Grafice/clienti_sus.bmp b/Grafice/clienti_sus.bmp new file mode 100644 index 0000000..eebb80b Binary files /dev/null and b/Grafice/clienti_sus.bmp differ diff --git a/Grafice/cont11.ICO b/Grafice/cont11.ICO new file mode 100644 index 0000000..55777df Binary files /dev/null and b/Grafice/cont11.ICO differ diff --git a/Grafice/ctr_jos.bmp b/Grafice/ctr_jos.bmp new file mode 100644 index 0000000..b795244 Binary files /dev/null and b/Grafice/ctr_jos.bmp differ diff --git a/Grafice/ctr_sus.bmp b/Grafice/ctr_sus.bmp new file mode 100644 index 0000000..56b5101 Binary files /dev/null and b/Grafice/ctr_sus.bmp differ diff --git a/Grafice/cump.bmp b/Grafice/cump.bmp new file mode 100644 index 0000000..7fc19e4 Binary files /dev/null and b/Grafice/cump.bmp differ diff --git a/Grafice/curs_jos.bmp b/Grafice/curs_jos.bmp new file mode 100644 index 0000000..9999ebf Binary files /dev/null and b/Grafice/curs_jos.bmp differ diff --git a/Grafice/curs_sus.bmp b/Grafice/curs_sus.bmp new file mode 100644 index 0000000..08f7f8a Binary files /dev/null and b/Grafice/curs_sus.bmp differ diff --git a/Grafice/dkcontrl.db2 b/Grafice/dkcontrl.db2 new file mode 100644 index 0000000..3a99b7a --- /dev/null +++ b/Grafice/dkcontrl.db2 @@ -0,0 +1,4184 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="dkcontrl.dbf" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000030 + Visual FoxPro + + + + FNAME + C + 200 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + FILSIZE + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + FDATE + D + 8 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + FTIME + C + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + FATTRIB + C + 5 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CPRSNAME + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CPRSSIZE + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + EXPNDSIZE + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + FILFOUND + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DEST144 + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DEST12 + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DEST720 + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DESTNET + N + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SETUPFILE + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + EXTRAFILE + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + EXTRATYPE + C + 10 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CPRSFLAG + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + COMPRESS + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PARENT + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SPLITFILE + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + UNIQUEID + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + VERSION + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + LANGUAGE + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + TARGET + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PMGROUP + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DESCRIPT + C + 100 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + COMMAND + C + 100 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + ICON + C + 80 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + REGISTER + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SERVERTYPE + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + NETADDRESS + C + 100 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PROTOCOL + C + 20 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + AUTHENTICA + I + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + INSTLOCAL + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + + + + + + CPRSNAME + REGULAR + UPPER(CPRSNAME) + + ASCENDING + MACHINE + + + CPRSSIZE + REGULAR + STR(100000000-CPRSSIZE,10)+PARENT+CPRSNAME + + ASCENDING + MACHINE + + + CPRSSIZE2 + REGULAR + CPRSNAME+STR(100000000-CPRSSIZE,10) + + ASCENDING + MACHINE + + + DEST12 + REGULAR + STR(DEST12,3)+CPRSNAME + + ASCENDING + MACHINE + + + DEST144 + REGULAR + STR(DEST144,3)+CPRSNAME + + ASCENDING + MACHINE + + + DEST720 + REGULAR + STR(DEST720,3)+CPRSNAME + + ASCENDING + MACHINE + + + DESTNET + REGULAR + STR(DESTNET,3)+CPRSNAME + + ASCENDING + MACHINE + + + FNAME + REGULAR + UPPER(FNAME) + + ASCENDING + MACHINE + + + + + + + + + + + 2000.BMP + 225054 + 1999/01/30 + 18:15:52 + .A... + 2000.BM$ + 55032 + 225054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532372 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + ACHI.BMP + 382 + 2000/01/14 + 4:55:16 + .A... + ACHI.BM$ + 189 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532538 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + ACHIZ.BMP + 382 + 2000/01/06 + 20:28:22 + .A... + ACHIZ.BM$ + 203 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532559 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + AFIS1.BMP + 358 + 1999/01/23 + 9:44:04 + .A... + AFIS1.BM$ + 189 + 358 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532569 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BAL.BMP + 382 + 2000/01/06 + 17:10:58 + .A... + BAL.BM$ + 180 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532578 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BANCA.BMP + 382 + 2000/01/14 + 7:29:38 + .A... + BANCA.BM$ + 158 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532588 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BLUE.BMP + 630 + 1999/03/25 + 18:56:52 + .A... + BLUE.BM$ + 149 + 630 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532598 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BUT.BMP + 382 + 1999/11/25 + 13:01:52 + .A... + BUT.BM$ + 137 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532609 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CALC.BMP + 382 + 1999/11/25 + 13:23:42 + .A... + CALC.BM$ + 169 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532619 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CALENDAR.BMP + 382 + 1995/07/21 + 0:00:00 + .A... + CALENDAR.BM$ + 182 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532629 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CASA.BMP + 382 + 2000/01/14 + 4:49:54 + .A... + CASA.BM$ + 181 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532638 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CLIENT.BMP + 382 + 2000/01/14 + 4:57:38 + .A... + CLIENT.BM$ + 183 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532652 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CLOUDS.BMP + 307514 + 1996/09/24 + 10:00:00 + .A... + CLOUDS.BM$ + 133151 + 307514 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532661 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONT-00.BMP + 225054 + 1999/01/30 + 18:16:06 + .A... + CONT-00.BM$ + 50701 + 225054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532672 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONT-AL.BMP + 54054 + 1999/01/30 + 18:39:46 + .A... + CONT-AL.BM$ + 15478 + 54054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532686 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONT-GA.BMP + 54054 + 1999/01/30 + 18:38:10 + .A... + CONT-GA.BM$ + 15578 + 54054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532709 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONTNOR2.BMP + 720054 + 1999/01/23 + 11:25:44 + .A... + CONTNOR2.BM$ + 227976 + 720054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532725 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CRED.BMP + 382 + 2000/01/06 + 20:31:20 + .A... + CRED.BM$ + 176 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532743 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CREDITOR.BMP + 382 + 2000/01/06 + 18:42:10 + .A... + CREDITOR.BM$ + 200 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532760 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + DELETE.BMP + 246 + 1999/01/27 + 8:20:26 + .A... + DELETE.BM$ + 134 + 246 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532770 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + EDIT1.BMP + 358 + 1999/01/23 + 10:35:16 + .A... + EDIT1.BM$ + 184 + 358 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532780 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + FIND.BMP + 246 + 1995/07/21 + 0:00:00 + .A... + FIND.BM$ + 131 + 246 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532790 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + FURNIZOR.BMP + 382 + 2000/01/14 + 4:58:58 + .A... + FURNIZOR.BM$ + 163 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532800 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + HAND.BMP + 382 + 1999/01/27 + 11:36:02 + .A... + HAND.BM$ + 177 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532810 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + JUR.BMP + 382 + 2000/01/14 + 5:04:28 + .A... + JUR.BM$ + 191 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532820 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + MIJ-AL.BMP + 94734 + 1999/01/30 + 18:44:56 + .A... + MIJ-AL.BM$ + 19929 + 94734 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532831 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + MIJ-GA.BMP + 94734 + 1999/01/30 + 18:44:18 + .A... + MIJ-GA.BM$ + 20270 + 94734 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532855 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + NEW.BMP + 246 + 1999/10/27 + 6:44:50 + .A... + NEW.BM$ + 115 + 246 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532874 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + NOTEP.BMP + 382 + 1999/11/25 + 13:25:46 + .A... + NOTEP.BM$ + 176 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532896 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + PAINT.BMP + 1630 + 1995/07/21 + 0:00:00 + .A... + PAINT.BM$ + 352 + 1630 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532918 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + PER-AL.BMP + 63174 + 1999/01/30 + 18:41:46 + .A... + PER-AL.BM$ + 18798 + 63174 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532929 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + PER-GA.BMP + 63174 + 1999/01/30 + 18:42:26 + .A... + PER-GA.BM$ + 18923 + 63174 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532939 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + TER-AL.BMP + 36054 + 1999/01/30 + 18:46:08 + .A... + TER-AL.BM$ + 8806 + 36054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532958 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + TER-GA.BMP + 36054 + 1999/01/30 + 18:46:46 + .A... + TER-GA.BM$ + 8938 + 36054 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13532989 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VANZ.BMP + 382 + 2000/01/14 + 5:05:14 + .A... + VANZ.BM$ + 178 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533002 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + H_POINT.CUR + 318 + 1999/03/25 + 18:56:52 + .A... + H_POINT.CU$ + 128 + 318 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533023 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BINOCULR.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + BINOCULR.IC$ + 315 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533034 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BOOK01A.ICO + 1078 + 1999/01/30 + 19:04:14 + .A... + BOOK01A.IC$ + 420 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533044 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BOOK01B.ICO + 1078 + 1999/01/30 + 19:15:18 + .A... + BOOK01B.IC$ + 419 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533055 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BOOK01C.ICO + 1078 + 1999/01/30 + 19:10:08 + .A... + BOOK01C.IC$ + 409 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533065 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + BOOK04.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + BOOK04.IC$ + 434 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533076 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONT11.ICO + 766 + 2000/01/16 + 6:38:28 + .A... + CONT11.IC$ + 421 + 766 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533086 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CRDFLE01.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + CRDFLE01.IC$ + 483 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533097 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CRDFLE12.ICO + 1078 + 1999/02/01 + 17:46:48 + .A... + CRDFLE12.IC$ + 506 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533108 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + EXCLAM1.ICO + 1078 + 1999/03/25 + 18:56:52 + .A... + EXCLAM1.IC$ + 465 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533127 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + EXCLAM2.ICO + 1078 + 1999/03/25 + 18:56:52 + .A... + EXCLAM2.IC$ + 531 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533138 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + EXCLEM.ICO + 1846 + 1999/03/25 + 18:56:52 + .A... + EXCLEM.IC$ + 503 + 1846 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533149 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + EYE.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + EYE.IC$ + 520 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533159 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + FILES04.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + FILES04.IC$ + 534 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533170 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + INTREB.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + INTREB.IC$ + 544 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533181 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + MFIX.ICO + 766 + 2000/01/15 + 5:21:42 + .A... + MFIX.IC$ + 432 + 766 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533192 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + NET13.ICO + 1078 + 1999/01/27 + 19:52:56 + .A... + NET13.IC$ + 418 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533203 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + NOTE14.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + NOTE14.IC$ + 541 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533213 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + NOTE16.ICO + 1078 + 1996/01/12 + 0:00:00 + .A... + NOTE16.IC$ + 555 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533224 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + PC02.ICO + 1078 + 1999/01/27 + 19:07:34 + .A... + PC02.IC$ + 562 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533235 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + PERICOL.ICO + 766 + 1999/12/06 + 17:56:36 + .A... + PERICOL.IC$ + 264 + 766 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533246 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + POINT04.ICO + 1078 + 1999/11/02 + 23:31:06 + .A... + POINT04.IC$ + 388 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533257 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SA.ICO + 1078 + 1999/01/30 + 14:04:32 + .A... + SA.IC$ + 360 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533267 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SG.ICO + 1078 + 1999/01/30 + 14:04:48 + .A... + SG.IC$ + 360 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533278 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CUMP.BMP + 1078 + 2000/01/14 + 7:26:42 + .A... + CUMP.BM$ + 559 + 1078 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533289 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONTALBASTRU1.BMP + 1440054 + 2000/01/24 + 4:03:24 + .A... + 13540551.001 + 192347 + 727040 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .T. + 13533300 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + PLUS.BMP + 382 + 1999/11/25 + 13:36:30 + .A... + PLUS.BM$ + 165 + 382 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .T. + .T. + + .F. + 13533335 + + + AppDir + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SETUP.EXE + 74192 + 1996/10/29 + 0:00:00 + .A... + SETUP.EXE + 74192 + 74192 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533400 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SETUP.INI + 149 + 1996/08/21 + 0:00:00 + .A... + SETUP.INI + 149 + 149 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533402 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + ACMSETUP.EX_ + 172454 + 2000/01/30 + 22:52:46 + .A... + ACMSETUP.EX_ + 172454 + 172454 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533404 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + ACMSETUP.HL_ + 7079 + 2000/01/30 + 22:52:46 + .A... + ACMSETUP.HL_ + 7079 + 7079 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533406 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SETUP32.STF + 3337 + 2000/02/01 + 3:45:34 + .A... + SETUP32.STF + 3337 + 3337 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533409 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SETUP.TDF + 84 + 1996/08/21 + 0:00:00 + .A... + SETUP.TDF + 84 + 84 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533411 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + MSSETUP.DL_ + 141323 + 2000/01/30 + 22:53:36 + .A... + MSSETUP.DL_ + 141323 + 141323 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533414 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + WIZSET32.DL_ + 26212 + 2000/01/30 + 22:53:58 + .A... + WIZSET32.DL_ + 26212 + 26212 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533417 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + HLP95EN.DL_ + 19145 + 2000/01/30 + 22:54:00 + .A... + HLP95EN.DL_ + 19145 + 19145 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533420 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SETUP.LST + 1136 + 2000/02/01 + 3:45:44 + .A... + SETUP.LST + 1136 + 1136 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533423 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFPOLE50.DL_ + 84383 + 2000/01/30 + 22:53:18 + .A... + VFPOLE50.DL_ + 84383 + 174592 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533481 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + FOXPRO.IN_ + 21579 + 2000/01/30 + 22:52:50 + .A... + FOXPRO.IN_ + 21579 + 48606 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533485 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP500.DL_ + 346860 + 2000/01/30 + 22:52:54 + .A... + VFP500.DL_ + 346860 + 461824 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .T. + 13533488 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP501.DL_ + 336840 + 2000/01/30 + 22:52:54 + .A... + VFP501.DL_ + 336840 + 459776 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533488 + .T. + 13533490 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP502.DL_ + 333354 + 2000/01/30 + 22:52:56 + .A... + VFP502.DL_ + 333354 + 471040 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533488 + .T. + 13533494 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP503.DL_ + 344327 + 2000/01/30 + 22:52:58 + .A... + VFP503.DL_ + 344327 + 487936 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533488 + .T. + 13533498 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP504.DL_ + 343355 + 2000/01/30 + 22:53:00 + .A... + VFP504.DL_ + 343355 + 488960 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533488 + .T. + 13533501 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP505.DL_ + 345648 + 2000/01/30 + 22:53:00 + .A... + VFP505.DL_ + 345648 + 491520 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533488 + .T. + 13533505 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP506.DL_ + 250121 + 2000/01/30 + 22:53:02 + .A... + VFP506.DL_ + 250121 + 362768 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533488 + .T. + 13533508 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP5ENU.DL_ + 271043 + 2000/01/30 + 22:53:38 + .A... + VFP5ENU.DL_ + 271043 + 727040 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .T. + 13533513 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + VFP5ENV.DL_ + 19595 + 2000/01/30 + 22:53:40 + .A... + VFP5ENV.DL_ + 19595 + 43520 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + 13533513 + .T. + 13533516 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CTL3DNT.DL_ + 15600 + 2000/01/30 + 22:53:16 + .A... + CTL3DNT.DL_ + 15600 + 27136 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533528 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + MSVCRT20.DL_ + 154559 + 2000/01/30 + 22:52:46 + .A... + MSVCRT20.DL_ + 154559 + 253952 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533531 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + MSVCRT40.DL_ + 183001 + 2000/01/30 + 22:53:18 + .A... + MSVCRT40.DL_ + 183001 + 326656 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + 13533534 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + OLEPRO32.DL_ + 15904 + 2000/01/30 + 22:53:18 + .A... + OLEPRO32.DL_ + 15904 + 32528 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533538 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + OLEAUT32.DL_ + 323508 + 2000/01/30 + 22:54:00 + .A... + OLEAUT32.DL_ + 323508 + 491792 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533541 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + ASYCFILT.DL_ + 75818 + 2000/01/30 + 22:54:00 + .A... + ASYCFILT.DL_ + 75818 + 120592 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533545 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + STDOLE.TL_ + 7136 + 2000/01/30 + 22:54:02 + .A... + STDOLE.TL_ + 7136 + 16896 + .T. + 0 + 0 + 0 + 1 + .F. + .T. + + .F. + .F. + + .F. + 13533549 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + CONTALBASTRU1.BMP + 0 + 2000/01/24 + 4:03:24 + .A... + 13540551.002 + 209019 + 713014 + .T. + 0 + 0 + 0 + 1 + .F. + .F. + + .F. + .T. + 13533300 + .T. + 13543016 + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + SETUP.INF + 8759 + 2000/02/01 + 3:45:44 + .A... + SETUP.INF + 8759 + 8759 + .T. + 0 + 0 + 0 + 1 + .T. + .T. + + .F. + .F. + + .F. + + + + + .F. + + + + .F. + 0 + + + 0 + .F. + + + + + +
+ diff --git a/Grafice/entitati1.bmp b/Grafice/entitati1.bmp new file mode 100644 index 0000000..ca87f68 Binary files /dev/null and b/Grafice/entitati1.bmp differ diff --git a/Grafice/entitati2.bmp b/Grafice/entitati2.bmp new file mode 100644 index 0000000..2928dfb Binary files /dev/null and b/Grafice/entitati2.bmp differ diff --git a/Grafice/eye_jos.bmp b/Grafice/eye_jos.bmp new file mode 100644 index 0000000..8096aa7 Binary files /dev/null and b/Grafice/eye_jos.bmp differ diff --git a/Grafice/eye_sus.bmp b/Grafice/eye_sus.bmp new file mode 100644 index 0000000..2837513 Binary files /dev/null and b/Grafice/eye_sus.bmp differ diff --git a/Grafice/f1.jpg b/Grafice/f1.jpg new file mode 100644 index 0000000..3bff03e Binary files /dev/null and b/Grafice/f1.jpg differ diff --git a/Grafice/f2.jpg b/Grafice/f2.jpg new file mode 100644 index 0000000..8e53539 Binary files /dev/null and b/Grafice/f2.jpg differ diff --git a/Grafice/f3.jpg b/Grafice/f3.jpg new file mode 100644 index 0000000..21fd7cd Binary files /dev/null and b/Grafice/f3.jpg differ diff --git a/Grafice/fact_jos.bmp b/Grafice/fact_jos.bmp new file mode 100644 index 0000000..0a1f848 Binary files /dev/null and b/Grafice/fact_jos.bmp differ diff --git a/Grafice/fact_sus.bmp b/Grafice/fact_sus.bmp new file mode 100644 index 0000000..e07603d Binary files /dev/null and b/Grafice/fact_sus.bmp differ diff --git a/Grafice/facturi_jos.bmp b/Grafice/facturi_jos.bmp new file mode 100644 index 0000000..327e09b Binary files /dev/null and b/Grafice/facturi_jos.bmp differ diff --git a/Grafice/facturi_sus.bmp b/Grafice/facturi_sus.bmp new file mode 100644 index 0000000..41ac96f Binary files /dev/null and b/Grafice/facturi_sus.bmp differ diff --git a/Grafice/info_jos.bmp b/Grafice/info_jos.bmp new file mode 100644 index 0000000..e4fbfde Binary files /dev/null and b/Grafice/info_jos.bmp differ diff --git a/Grafice/info_sus.bmp b/Grafice/info_sus.bmp new file mode 100644 index 0000000..a9c617f Binary files /dev/null and b/Grafice/info_sus.bmp differ diff --git a/Grafice/lock.bmp b/Grafice/lock.bmp new file mode 100644 index 0000000..dd380b2 Binary files /dev/null and b/Grafice/lock.bmp differ diff --git a/Grafice/open.bmp b/Grafice/open.bmp new file mode 100644 index 0000000..59c9eeb Binary files /dev/null and b/Grafice/open.bmp differ diff --git a/Grafice/outlook2003bar_1.bmp b/Grafice/outlook2003bar_1.bmp new file mode 100644 index 0000000..5420d8f Binary files /dev/null and b/Grafice/outlook2003bar_1.bmp differ diff --git a/Grafice/outlook2003bar_2.bmp b/Grafice/outlook2003bar_2.bmp new file mode 100644 index 0000000..eefcc28 Binary files /dev/null and b/Grafice/outlook2003bar_2.bmp differ diff --git a/Grafice/outlook2003bar_3.bmp b/Grafice/outlook2003bar_3.bmp new file mode 100644 index 0000000..1308d00 Binary files /dev/null and b/Grafice/outlook2003bar_3.bmp differ diff --git a/Grafice/outlook2003bar_4.bmp b/Grafice/outlook2003bar_4.bmp new file mode 100644 index 0000000..c5bfbdf Binary files /dev/null and b/Grafice/outlook2003bar_4.bmp differ diff --git a/Grafice/outlook2003bar_5.bmp b/Grafice/outlook2003bar_5.bmp new file mode 100644 index 0000000..bc0f627 Binary files /dev/null and b/Grafice/outlook2003bar_5.bmp differ diff --git a/Grafice/outlook2003bar_6.bmp b/Grafice/outlook2003bar_6.bmp new file mode 100644 index 0000000..8cf658c Binary files /dev/null and b/Grafice/outlook2003bar_6.bmp differ diff --git a/Grafice/plcont1.bmp b/Grafice/plcont1.bmp new file mode 100644 index 0000000..5dbe8c6 Binary files /dev/null and b/Grafice/plcont1.bmp differ diff --git a/Grafice/plcont2.bmp b/Grafice/plcont2.bmp new file mode 100644 index 0000000..23d4e7d Binary files /dev/null and b/Grafice/plcont2.bmp differ diff --git a/Grafice/roaregistratura.bmp b/Grafice/roaregistratura.bmp new file mode 100644 index 0000000..cb10d7d Binary files /dev/null and b/Grafice/roaregistratura.bmp differ diff --git a/Grafice/unlock.bmp b/Grafice/unlock.bmp new file mode 100644 index 0000000..da8662d Binary files /dev/null and b/Grafice/unlock.bmp differ diff --git a/Meniuri/roaregistratura.mn2 b/Meniuri/roaregistratura.mn2 new file mode 100644 index 0000000..8f96072 --- /dev/null +++ b/Meniuri/roaregistratura.mn2 @@ -0,0 +1,125 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="roaregistratura.mnx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* +*1 +*REPLACE + +* +DEFINE MENU _msysmenu BAR +DEFINE PAD _000000001 OF _msysmenu PROMPT "\ + +* +PROCEDURE BAR_1_OF_Utile_FB2P + *!* do form start00 + DO start_firma IN ostartfirma.prg +ENDPROC && BAR_1_OF_Utile_FB2P + +PROCEDURE BAR_3_OF_Utile_FB2P + DO apeleaza_calc IN oproceduri_comune +ENDPROC && BAR_3_OF_Utile_FB2P + +PROCEDURE BAR_4_OF_Utile_FB2P + DO apeleaza_notepad IN oproceduri_comune +ENDPROC && BAR_4_OF_Utile_FB2P + +PROCEDURE BAR_6_OF_Utile_FB2P + QUIT +ENDPROC && BAR_6_OF_Utile_FB2P + +PROCEDURE PAD__000000002_OF__msysmenu_FB2P + DO viz_config_serii_complet WITH 10 IN oserii_numere.prg +ENDPROC && PAD__000000002_OF__msysmenu_FB2P + +PROCEDURE BAR_1_OF_NewItem_FB2P + lnRaspuns=aMessagebox('Doriti sa importati in baza de date ca atasamente fisierele din sistemul de fisiere (local/retea)?' ,4,'Import atasamente') + If lnRaspuns=6 + Do import_atasamente In oproceduri_atasamente.prg + Endif +ENDPROC && BAR_1_OF_NewItem_FB2P + +PROCEDURE BAR_1_OF_Ajutor_FB2P + DO arata_manual IN oproceduri_comune.prg +ENDPROC && BAR_1_OF_Ajutor_FB2P + +PROCEDURE BAR_3_OF_Ajutor_FB2P + DO arata_modificari IN oproceduri_comune.prg +ENDPROC && BAR_3_OF_Ajutor_FB2P + +PROCEDURE BAR_4_OF_Ajutor_FB2P + DO arata_versiune IN oproceduri_comune.prg +ENDPROC && BAR_4_OF_Ajutor_FB2P + +* diff --git a/Programe/Vechi/1proverb.prg b/Programe/Vechi/1proverb.prg new file mode 100644 index 0000000..d642c4f --- /dev/null +++ b/Programe/Vechi/1proverb.prg @@ -0,0 +1,107 @@ + +WAIT WIND 'Se genereaza raportul. Asteptati...' nowait +SET SAFETY OFF +COPY FILE &DIRGEN\DEVIZE\DATE\TEMPO\PROVERB.* TO &LOC\&NFSCURT\TEMPO\PROVERB.* + +SELE 0 +USE &LOC\&NFSCURT\TEMPO\PROVERB EXCL ALIAS PROVERB +sele proverb +zap + +public m.g,m.nrinmat,m.tipauto +LOCAL M.DENUMIRE,M.CODMAT,M.CODFURN,M.CANT,M.PRET +STORE '' TO M.DENUMIRE,M.CODMAT,M.CODFURN,m.tipauto +STORE ' ' TO m.nrinmat +STORE 0 TO M.CANT,M.PRET,m.g +sele rul +set filter to subs(nrord,1,1)='G' +SCAN +m.nrord = nrord +M.DENUMIRE = DENUMIRE +M.CODMAT=CODMAT +M.CODFURN=EXP4 +M.CANT=CANTE +M.PRET=PRETV +m.fel = 'A' +do nrcirc +SELE PROVERB +APPE BLANK +GATHER MEMVAR +SELE RUL +ENDSCAN +sele OPER +set filter to subs(nrord,1,1)='G' +SCAN +m.nrord = nrord +M.DENUMIRE = DENOP +M.CODMAT=CODOP +M.CODFURN=codfurn +M.CANT=TIMPN +M.PRET=PRET +m.fel = 'B' +do nrcirc +sele oper +SELE PROVERB +APPE BLANK +GATHER MEMVAR +SELE OPER +ENDSCAN +sele proverb +set order to tag codfel +TOTAL ON DENUMIRE+STR(PRET,10) FIELDS CANT TO &LOC\&NFSCURT\TEMPO\PROVERB1 +SELE 0 +*USE C:\CONTAFIN\AUTOSTAL\TEMPO\PROVERB1 +USE &LOC\&NFSCURT\TEMPO\PROVERB1 +************** +INDEX ON TIPAUTO+CODFURN+DENUMIRE+STR(PRET,10) to &LOC\&NFSCURT\TEMPO\PROVERB1 +*************** +report format proverb TO PRINTER PROMPT preview +USE IN PROVERB +USE IN PROVERB1 +RETURN +************* +procedure nrcirc +m.g=1 +m.tipauto='' +m.nrinmat='' +do case + case subs(nrord,1,1)='/' + m.g=2 + case subs(nrord,2,1)='/' + m.g=3 + case subs(nrord,3,1)='/' + m.g=4 + case subs(nrord,4,1)='/' + m.g=5 + case subs(nrord,5,1)='/' + m.g=6 + case subs(nrord,6,1)='/' + m.g=7 + case subs(nrord,7,1)='/' + m.g=8 + case subs(nrord,8,1)='/' + m.g=9 + case subs(nrord,9,1)='/' + m.g=10 + case subs(nrord,10,1)='/' + m.g=11 + case subs(nrord,11,1)='/' + m.g=12 + case subs(nrord,12,1)='/' + m.g=13 + case subs(nrord,13,1)='/' + m.g=14 + case subs(nrord,14,1)='/' + m.g=15 + case subs(nrord,15,1)='/' + m.g=16 +endcase +m.nrinmat = subs(nrord,m.g,20-m.g) +sele masini +loca for ALLT(m.nrinmat) = ALLT(nrinmat) +if found() +m.tipauto = masina +else +m.tipauto='' +endif +return \ No newline at end of file diff --git a/Programe/Vechi/actualizari.prg b/Programe/Vechi/actualizari.prg new file mode 100644 index 0000000..343b6bc --- /dev/null +++ b/Programe/Vechi/actualizari.prg @@ -0,0 +1,270 @@ + + +SELE CALENDAR +M=4*RECCOUNT()+4 +OP=CREA('PROGRESBAR') +op.titlu.caption='Actualizari' +OP.SHOW() + + + +close database +IF !USED('FISTOTVdev') + do deschidf with '&dirgen\devize\date\datean\','&dirgen\devize\date\datean\','fistotvdev','fistotv','CALE','' +ENDIF + +sele 0 +use &calefirma\datean\calendar alias calendar +sele calendar +J=0 +scan +scatter memvar +date=calefirma+'\AN'+m.an+'\DATE'+M.nl +if file('&date\oper.dbf') +*DO PR WITH J +*do pfactura +DO PR WITH J +do pordl +DO PR WITH J +do poper +DO PR WITH J +do popersal +DO PR WITH J +do psalarii +endif +endscan +*** +DO PR WITH J +do pclie +DO PR WITH J +DO PSECTIE +DO PR WITH J +DO PMECANICI +DO PR WITH J +do pmasini +DO PR WITH J +DO PMARCI +OP.RELEASE +RETURN + + + + +*____________________________________________ +procedure pfactura +dele file &date\facturaa.* +dele file &date\facturav.* +copy file &dirgen\devize\date\date00\factura.* to &date\facturaa.* +sele 0 +use &date\facturaa.dbf AGAIN ALIAS facturaa exclusive +sele facturaa +zap +sele facturaa +append from &date\factura +sele facturaa +reindex +use +rename &date\factura.* to &date\facturav.* +rename &date\facturaa.* to &date\factura.* +*do refRULL +return + +*____________________________________________ +procedure psalarii +dele file &date\salariia.* +dele file &date\salariiv.* +copy file &dirgen\devize\date\date00\salarii.* to &date\salariia.* +sele 0 +use &date\salariia.dbf AGAIN ALIAS salariia exclusive +sele salariia +zap +sele salariia +append from &date\salarii +sele salariia +reindex +use +rename &date\salarii.* to &date\salariiv.* +rename &date\salariia.* to &date\salarii.* +*do refRULL +return + +*____________________________________________ +procedure pordl +dele file &date\ordla.* +dele file &date\ordlv.* +copy file &dirgen\devize\date\date00\ordl.* to &date\ordla.* +sele 0 +use &date\ordla.dbf AGAIN ALIAS ordla exclusive +sele ordla +zap +sele ordla +append from &date\ordl +sele ordla +reindex +use +rename &date\ordl.* to &date\ordlv.* +rename &date\ordla.* to &date\ordl.* +&&&&&&do refact +return + + +*____________________________________________ +procedure poper +dele file &date\opera.* +dele file &date\operv.* +copy file &dirgen\devize\date\date00\oper.* to &date\opera.* +sele 0 +use &date\opera.dbf AGAIN ALIAS opera exclusive +sele opera +zap +sele opera +append from &date\oper +sele opera +reindex +use +rename &date\oper.* to &date\operv.* +rename &date\opera.* to &date\oper.* + +return + +*____________________________________________ +procedure popersal +dele file &date\opersala.* +dele file &date\opersalv.* +copy file &dirgen\devize\date\date00\opersal.* to &date\opersala.* +sele 0 +use &date\opersala.dbf AGAIN ALIAS opersala exclusive +sele opersala +zap +sele opersala +append from &date\opersal +sele opersala +reindex +use +rename &date\opersal.* to &date\opersalv.* +rename &date\opersala.* to &date\opersal.* + +return + + +*______________________________________________________________ +procedure pclie +dele file &calefirma\datean\cliea.* +dele file &calefirma\datean\cliev.* +copy file &dirgen\devize\date\datean\clie.* to &calefirma\datean\cliea.* +sele 0 +use &calefirma\datean\cliea.dbf AGAIN ALIAS cliea exclusive +sele cliea +zap +sele cliea +append from &calefirma\datean\clie +sele cliea +reindex +use + +rename &calefirma\datean\clie.* to &calefirma\datean\cliev.* +rename &calefirma\datean\cliea.* to &calefirma\datean\clie.* +*DO refRUL +return + +*______________________________________________________________ +procedure pSECTIE +dele file &calefirma\datean\SECTIEa.* +dele file &calefirma\datean\SECTIEv.* +copy file &dirgen\devize\date\datean\SECTIE.* to &calefirma\datean\SECTIEa.* +sele 0 +use &calefirma\datean\SECTIEa.dbf AGAIN ALIAS SECTIEa exclusive +sele SECTIEa +zap +sele SECTIEa +append from &calefirma\datean\SECTIE +sele SECTIEa +reindex +use + +rename &calefirma\datean\SECTIE.* to &calefirma\datean\SECTIEv.* +rename &calefirma\datean\SECTIEa.* to &calefirma\datean\SECTIE.* +*DO refRUL +return + +*______________________________________________________________ +procedure pMECANICI +dele file &calefirma\datean\MECANICIa.* +dele file &calefirma\datean\MECANICIv.* +copy file &dirgen\devize\date\datean\MECANICI.* to &calefirma\datean\MECANICIa.* +sele 0 +use &calefirma\datean\MECANICIa.dbf AGAIN ALIAS MECANICIa exclusive +sele MECANICIa +zap +sele MECANICIa +append from &calefirma\datean\MECANICI +sele MECANICIa +reindex +use + +rename &calefirma\datean\MECANICI.* to &calefirma\datean\MECANICIv.* +rename &calefirma\datean\MECANICIa.* to &calefirma\datean\MECANICI.* +*DO refRUL +return + + + + +*______________________________________________________________ +procedure pmasini +dele file &calefirma\datean\masinia.* +dele file &calefirma\datean\masiniv.* +copy file &dirgen\devize\date\datean\masini.* to &calefirma\datean\masinia.* +sele 0 +use &calefirma\datean\masinia.dbf AGAIN ALIAS masinia exclusive +sele masinia +zap +sele masinia +append from &calefirma\datean\masini +sele masinia +reindex +use + +rename &calefirma\datean\masini.* to &calefirma\datean\masiniv.* +rename &calefirma\datean\masinia.* to &calefirma\datean\masini.* +return + +*______________________________________________________________ +procedure pMARCI +dele file &calefirma\datean\MARCIa.* +dele file &calefirma\datean\MARCIv.* +copy file &dirgen\devize\date\datean\MARCI.* to &calefirma\datean\MARCIa.* +sele 0 +use &calefirma\datean\MARCIa.dbf AGAIN ALIAS MARCIa exclusive +sele MARCIa +zap +sele MARCIa +append from &calefirma\datean\MARCI +sele MARCIa +reindex +use + +rename &calefirma\datean\MARCI.* to &calefirma\datean\MARCIv.* +rename &calefirma\datean\MARCIa.* to &calefirma\datean\MARCI.* +return + + + +*____________________________________ +PROC PR +PARAM J +IF J>M +RETURN +ENDIF +OP.PRBAR.VALUE=J +OP.P=ROUND(100*OP.PRBAR.VALUE/OP.PRBAR.MAX,2) +OP.REFRESH +J=J+1 +RETURN + + + + + + + diff --git a/Programe/Vechi/genhtml.db2 b/Programe/Vechi/genhtml.db2 new file mode 100644 index 0000000..af9d4ee --- /dev/null +++ b/Programe/Vechi/genhtml.db2 @@ -0,0 +1,2183 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="genhtml.dbf" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + + 1252 + + + 0x00000030 + Visual FoxPro + + + + TYPE + C + 12 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + ID + C + 24 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + LINKS + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + TEXT + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + DESC + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CLASSNAME + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + CLASSLIB + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + MODULE + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PICTURE + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PROPERTIES + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + HTML + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + STYLE + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SCRIPT + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + PRESCRIPT + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + GENSCRIPT + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + POSTSCRIPT + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + HEADSTART + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + HEADEND + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + BODYSTART + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + BODYEND + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + UPDATED + T + 8 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + COMMENT + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + USER + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + VERSION + M + 4 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + SAVE + L + 1 + 0 + .F. + .F. + + + + + + + + + + + 0 + 0 + + + + + + + + + DEFAULT + VFPDefault + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + LAYOUT + ListTable + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + LAYOUT + DetailTable + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + LAYOUT + TabCtlList + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + LAYOUT + TabCtlDetail + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + LAYOUT + TabCtlHierarchical + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + OPTIONS + ListOptions + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + OPTIONS + TabListOptions + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + OPTIONS + TabDetailOptions + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + OPTIONS + TabHierOptions + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + OPTIONS + StaticOptions + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + GLOBALSTYLE + GlobalTableStyle + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + TropicalParadiseStyle + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + DesertCalmStyle + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + Graffiti + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + TitleHeader + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + LedgerList + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00486 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00516 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00531 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00546 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00673 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00703 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00720 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00742 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00756 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00760 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00780 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00785 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB00819 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01231 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01276 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01306 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01308 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01741 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01844 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01845 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01846 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + STYLE + WB01847 + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + SortTableColumn + + + + + + + + + + +Dim cField +Dim lSortAscend +cField = "" +lSortAscend = True + +Sub tblvfpdataheader_OnClick + Dim cID + cID = window.event.srcElement.ID + if cID = cField then + lSortAscend = Not lSortAscend + else + cField = cId + lSortAscend = true + end if + if lSortAscend = True then + {{_oHTML.cDataSrc}}.SortColumn = "+" & cField + else + {{_oHTML.cDataSrc}}.SortColumn = "-" & cField + end if + {{_oHTML.cDataSrc}}.Reset() + {{IIF(_OHTML.lSkipFrame,"rem ","")}}parent.Frames("Frame2").datafilter({{_oHTML.cDataSrc}}.recordset.Fields(0).Value) +End Sub + + +]]> + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + NavButtonsCode + + + + + + + + + + +Sub backward_onClick() + if {{_oHTML.cDataSrc}}.recordset.AbsolutePosition > 1 then + {{_oHTML.cDataSrc}}.recordset.movePrevious() + end if +End Sub + +Sub forward_onClick() + if {{_oHTML.cDataSrc}}.recordset.AbsolutePosition <> {{_oHTML.cDataSrc}}.recordset.RecordCount then + {{_oHTML.cDataSrc}}.recordset.moveNext() + end if +End Sub + +Sub first_onClick() + {{_oHTML.cDataSrc}}.recordset.moveFirst() +End Sub + +Sub end_onClick() + {{_oHTML.cDataSrc}}.recordset.moveLast() +End Sub + + +]]> + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + NavButtons + + + + + + + + + + + + + + + +
+
+
+
+]]> + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + SetBodyImage + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + DataPaging + + + + + + + + + +' Page methods for use with Tab Data Control + +Sub PagePrevious + {{_oHTML.cTableID}}.previousPage() + nPageSize = 0 - ( {{_oHTML.cTableID}}.rows.length-1) + nCurrentPos = {{_oHTML.cDataSrc}}.recordset.AbsolutePosition + if nCurrentPos+nPageSize > 0 then + {{_oHTML.cDataSrc}}.recordset.Move nPageSize + else + {{_oHTML.cDataSrc}}.recordset.MoveFirst + end if + {{IIF(_OHTML.lSkipFrame,"rem ","")}}parent.Frames("Frame2").datafilter({{_oHTML.cDataSrc}}.recordset.Fields(0).Value) +End Sub + +Sub PageNext + {{_oHTML.cTableID}}.nextPage() + nPageSize = {{_oHTML.cTableID}}.rows.length-1 + nCurrentPos = {{_oHTML.cDataSrc}}.recordset.AbsolutePosition + if nCurrentPos+nPageSize < {{_oHTML.cDataSrc}}.recordset.RecordCount then + {{_oHTML.cDataSrc}}.recordset.Move nPageSize + else + {{_oHTML.cDataSrc}}.recordset.MoveLast + end if + {{IIF(_OHTML.lSkipFrame,"rem ","")}}parent.Frames("Frame2").datafilter({{_oHTML.cDataSrc}}.recordset.Fields(0).Value) +End Sub + + +]]> + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + FrameScript + + + + + + + + + + +Sub selectrecord(oTableRow) + {{_OHTML.cDataSrc}}.recordset.AbsolutePosition=oTableRow.RecordNumber + HilightTableRow("{{_OHTML.cHighlightColor}}") + {{IIF(_OHTML.lSkipFrame,"rem ","")}}parent.Frames("Frame2").datafilter({{_OHTML.cDataSrc}}.recordset.Fields({{TRANS(_OHTML.nLinkField)}}).Value) +End sub + +Sub {{_OHTML.cTableID}}_onreadystatechange() + if {{_OHTML.cTableID}}.readyState = "complete" then + {{_OHTML.cDataSrc}}_onrowenter = HandleRowEnter() + end if +End sub + +Function HandleRowEnter() + HilightTableRow("{{_OHTML.cHighlightColor}}") +End function + +Sub {{_OHTML.cDataSrc}}_onrowexit() + HilightTableRow("") +End sub + +Sub HilightTableRow(cColor) + nRow = {{_OHTML.cDataSrc}}.recordset.AbsolutePosition + nPage = {{_OHTML.cDataSrc}}.recordset.AbsolutePage + nPageMax = {{_OHTML.cTableID}}.rows.length-1 + nPageRows = {{_OHTML.cTableID}}.datapagesize + if nPageMax < 1 then + exit sub + end if + nRow = nRow MOD nPageRows + if nRow = 0 then + nRow = nPageMax + end if + if nRow > nPageRows then + nRow = 1 + end if + {{_OHTML.cTableID}}.rows(nPageMax).style.backgroundColor = "" + {{_OHTML.cTableID}}.rows(nRow).style.backgroundColor = cColor +End sub + + +]]> + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + FilterScript + + + + + + + + + + +function DataFilter(vFilterValue) + {{_OHTML.cDataSrc}}.object.Filter = {{_OHTML.cDataSrc}}.recordset.Fields({{TRANS(_OHTML.nLinkField)}}).Name & " = " & vFilterValue + {{_OHTML.cDataSrc}}.Reset() +end function + + +]]> + + + + + + + + + + / / : : + + + + .F. + + + + SCRIPT + PageButtons + + + + + + + + + +
+ + + "," > ")}}" onclick="PageNext()"> + + +
+
+
+
]]> + + + + + + + + + + / / : : + + + + .F. + + + + WIZARD + WIZARD + + + + + + + + + + + + + + + + + + + / / : : + + + + .F. + + + + + + + diff --git a/Programe/Vechi/mesaje.prg b/Programe/Vechi/mesaje.prg new file mode 100644 index 0000000..ae699a4 --- /dev/null +++ b/Programe/Vechi/mesaje.prg @@ -0,0 +1,43 @@ +*_________________________________________ +PROCEDURE anunta_rezultat + LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, llInTabel, lnId_ref + IF llInTabel + scrie_in_mesaje(lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref) + ELSE + DO mesaj With lcMesaj, '' + ENDIF +ENDPROC + +PROCEDURE scrie_in_mesaje + LPARAMETERS lcCategorie, lcSursa, lcMesaj, llEroare, lnId_ref + LOCAL lnOrdine + SELECT mesaje + CALCULATE MAX(ordine) TO m.lnOrdine + m.lnOrdine = m.lnOrdine + 1 + APPEND BLANK + replace ordine WITH m.lnOrdine, sursa WITH lcSursa, mesaj WITH lcMesaj, ; + eroare WITH llEroare, categorie WITH lcCategorie, id_ref WITH lnId_ref +ENDPROC + +PROCEDURE sterge_mesaje + ZAP IN mesaje +ENDPROC + +PROCEDURE raport_mesaje + PARAMETERS tcPerioada + PRIVATE pcTitlu,pcPerioada,pcDataOra +*!* PRIVATE toFirma +*!* SELECT FIRMA +*!* LOCATE FOR NFSCURT=FSCURT +*!* SCATTER NAME m.toFirma +*!* SELECT mesaje +*!* IF RECNO() > 0 +*!* SET ORDER TO ordine +*!* REPORT FORM mesaje TO PRINTER PROMPT PREVIEW +*!* ENDIF + pcTitlu=[VERIFICARE GLOBALA] + pcPerioada=[Perioada ] + pcdataora = get_ora(2) + SELECT crsverificari + REPORT FORM rap_mesaje TO PRINTER PROMPT preview +ENDPROC \ No newline at end of file diff --git a/Programe/Vechi/onom_clienti.prg b/Programe/Vechi/onom_clienti.prg new file mode 100644 index 0000000..916d2e0 --- /dev/null +++ b/Programe/Vechi/onom_clienti.prg @@ -0,0 +1,214 @@ +******************************************* +Procedure viz_delegati +Lparameters tnidpartener +Private podelegati,pcschema1,pcselect1,odetalii +LOCAL llAfiseaza +Store '' To podelegati +If Used('v_delegati') + Use In v_delegati +Endif +pcschema1=[''] +pcselect1=['select * from ] + gcS + [.vnom_delegati where 1=2'] +pcorder1 = [nume] +*!* pcfiltru1=[sters=0] +pcfiltru1=[1=2] +llAfiseaza=.F. +gencursor('podelegati','v_delegati',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza) +podelegati.ca_baza1.afisare() +ofrmdelegati=Createobject('frm_delegati',tnidpartener) +ofrmdelegati.Show(1) + +Select v_delegati +Scatter Name odetalii +Use In v_delegati +Release podelegati +Return odetalii +ENDPROC && viz_delegati +**********************sfarsit procedura viz_delegati******************* +******************************************* INCEPUT:viz_responsabili ******************************************* +PROCEDURE viz_responsabili( ) + + PRIVATE poresponsabili, pcschema1, pcselect1 + STORE '' TO poresponsabili + pcschema1 = [''] + pcselect1=['select * from ] + gcS + [.vnom_responsabili where 1=2'] + pcorder1=[nume] + pcfiltru1 = [2=2] + llAfiseaza = .F. + gencursor('poresponsabili','v_responsabili',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza) + poresponsabili.ca_baza1.afisare() + ofrmres=CREATEOBJECT('frm_responsabili') + ofrmres.SHOW(1) + RELEASE poresponsabili + + +ENDPROC && viz_responsabili +******************************************* SFARSIT: viz_responsabili ******************************************* +Procedure viz_curs + +Private poCurs +Store '' To poCurs + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = ['id_curs N(10), nume_val C(10), curs N(10,4), data D(8), data2 D(8), id_valuta N(5)'] +lcSelect1 = [select id_curs, nume_val, curs, data, data2, id_valuta from ] + gcS + [.vcrm_curs] +lcOrder1 = [data desc] +lcFiltru1 = [1=2] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. +lcgroup = [] +*gencursor('poCurs','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +gencursor('poCurs','tCurs', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poCurs.ca_baza1.afisare() + +Select tCurs +lovc = Createobject("frm_curs") +lovc.Show(1) + +Release poCurs + +Endproc && viz_curs +***----------------------------------------------------------------------------------------------------------------------------- +Procedure viz_tipc + +Private poTipc +Store '' To poTipc + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = [select * from ] + gcS + [.crm_tipc] +lcOrder1 = [id_tipc] +lcFiltru1 = [2=2] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. +lcgroup = [] +gencursor('poTipc','tTipc', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poTipc.ca_baza1.afisare() + +Select tTipc +lotc = Createobject("frm_tipc") +lotc.Show(1) + +Release poTipc + +Endproc && viz_tipc +***----------------------------------------------------------------------------------------------------------------------------- +********* Inceput: viz_articole +Procedure viz_articole + +Private poArticole +Store '' To poArticole + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = [select * from ] + gcS + [.nom_articole] +lcOrder1 = [denumire] +lcFiltru1 = [1=2] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. +lcgroup = [] +gencursor('poArticole','tArticole', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poArticole.ca_baza1.afisare() + +of_art = Createobject('frm_articole') +of_art.Show(1) + +Endproc +********* Sfarsit: viz_articole +****************************************************************************************************************** +Procedure viz_clienti() +Private poClie,pcschema1,pcselect1 +Local llAfiseaza +Store .F. To llAfiseaza +Store '' To poClie +If Used('v_clie') + Use In v_clie +Endif + +pcschema1=[''] +pcselect1=['select b.* from vcoresp_tip_part a left join vnom_parteneri b '+]+; + ['on a.id_part=b.id_part where a.id_tip_part=16 and b.inactiv=0'] +pcorder1=[b.nume] +pcfiltru1 = [1 = 2] +llAfiseaza = .F. +gencursor('poclie','v_clie',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza) +poClie.ca_baza1.afisare() + +ofrmclienti=Createobject('frm_clienti') +ofrmclienti.Show(1) +Release ofrmclienti,poClie +Endproc && viz_clienti +****************************************************************************************************************** +****************************************************************************************************************** +Procedure viz_agenti +Private poagenti,pcschema1,pcselect1 +Local llAfiseaza +Store .F. To llAfiseaza +Store '' To poagenti +If Used('crsagenti') + Use In crstagenti +Endif + +pcschema1=[''] +pcselect1=['select * from ]+gcS+[.vnom_agenti where 2=2'] +pcorder1=[nume_agent] +pcfiltru1 = [1 = 2] +llAfiseaza = .F. +gencursor('poagenti','crsagenti',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfiseaza) +poagenti.ca_baza1.afisare() + +ofrmagenti=Createobject('frm_agenti') +ofrmagenti.Show(1) +Release ofrmtipuri,potipurieven +Endproc && viz_agenti +****************************************************************************************************************** +***************************************************************************** +function cauta_zona +Lparameters tnIdZona,tcNumeZona +Local locauta,llReturn +Store "" To locauta +Store .F. To llReturn +pcselect = ["select id_zona,zona from ] + gcS + [.crm_vzone where inactiv=0"] +pcfiltru = [1=2] +pcschema = [''] +pcorder = [2] +pccoloane = [Zona] +pcTitlu = [Zona] +pcTitluColoane = [Zona] +locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitluColoane,"") +If !Empty(locauta.id_zona) + tnIdZona=locauta.id_zona + tcNumeZona=Alltrim(locauta.zona) + llReturn=.T. +Endif +Return llReturn +Endfunc && cauta_zona +***************************************************************************** +Procedure update_clienti( ) +LPARAMETERS tnid_partener + +LOCAL lcFiltru +IF !EMPTY(tnid_partener) + lcFiltru = [ and p.id_part=]+ALLTRIM(STR(tnid_partener)) +ELSE + lcFiltru = [] +ENDIF +If Used('v_clienti') + Use In v_clienti +Endif + +lcSql = [select distinct p.nume, p.cod_fiscal, p.id_part FROM ] + gcS + [.vcoresp_tip_part p ] + ; + [join ] + gcS + [.vcoresp_tip_cont c on p.id_tip_part=c.id_tip_part where c.cont ='4111' ] + ; + [and p.inactiv=0 ]+lcFiltru+[ order by p.nume ] +lcCursor = 'v_clienti' +lnSucces = goExecutor.oExecute(lcSql,lcCursor) +goExecutor.oReset() +Return lnSucces + +Endproc +**********************sfarsit procedura update_clienti******************* + + diff --git a/Programe/Vechi/oparteneri.prg b/Programe/Vechi/oparteneri.prg new file mode 100644 index 0000000..f9ffdb0 --- /dev/null +++ b/Programe/Vechi/oparteneri.prg @@ -0,0 +1,687 @@ + +*!* APEL DE PROCEDURA +*!* DO lans_ireg_parteneri WITH tlTest,tcCont,tlActiv + +*----------------------------------------------------------- + +PROCEDURE lans_ireg_parteneri + PARAMETERS tlTest,tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit + *!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri + *!* tcDenumire = titlul balantei + *!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire + *!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire + + LOCAL lcCont, llActiv, llParametri,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit + llParametri = .F. + + IF EMPTY(tlTitluTot) + llTitluTot = .F. + ELSE + llTitluTot = tlTitluTot + ENDIF + + IF EMPTY(tcDenumire) + lcDenumire = "" + ELSE + lcDenumire= tcDenumire + ENDIF + + IF EMPTY(tcDenDebit) + lcDenDebit = "Debit" + ELSE + lcDenDebit = tcDenDebit + ENDIF + IF EMPTY(tcDenCredit) + lcDenCredit = "Credit" + ELSE + lcDenCredit = tcDenCredit + ENDIF + + IF !EMPTY(tcCont) + lcCont = ALLTRIM(tcCont) + ELSE + lcCont = '' + ENDIF + + IF !EMPTY(tlactiv) + llActiv = tlactiv + ELSE + llActiv = .F. + ENDIF + + llParametri = .F. + *If PCOUNT() = 3 + *!* IF !EMPTY(tlActiv) AND !EMPTY(tcCont) AND !EMPTY(tlActiv) + *!* llParametri = .T. + *!* Endif + IF !EMPTY(tcCont) + llParametri = .T. + ENDIF + LOCAL NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista + STORE 0 TO lnTdeb, lnTcred, lnSold + NOU=.T. + + IF glPrimaLuna + NOU = .F. + ENDIF + + PRIVATE plActiv + STORE .T. TO plActiv + PRIVATE eActiv + STORE .T. TO eActiv + IF !llParametri + PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1 + STORE "" TO polista + IF USED('clista') + USE IN clista + ENDIF + pcschema1=['cont c(4),acont c(4),explicatie c(50)'] + pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2'] + pcfiltru1=[2=2] + pcorder1=[cont] + llAfisare=.F. + gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare) + polista.ca_baza1.afisare() + + SELECT clista + loCont=myscatter('blank') + + Ol=CREATEOBJECT("frm_sel_cont") + WITH Ol + .Lb_titlu_alb_b121.CAPTION= 'Selectati contul' + IF EMPTY(.cboCont.ROWSOURCE) + .cboCont.ROWSOURCE="clista.cont,acont" + ENDIF + .ocont=loCont + IF EMPTY(.cAlias) + .cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1) + ENDIF + .HEIGHT = 190 + ENDWITH + Ol.SHOW(1) + + IF buton = 2 + USE IN clista + RETURN + ENDIF + + lcContPart = loCont.CONT + IF !llTitluTot AND EMPTY(lcDenumire) + lcDenumire = "Inregistrari " + ALLTRIM(clista.explicatie) + "( " + lcContPart + " )" + ELSE + IF !EMPTY(lcDenumire) AND !llTitluTot + lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )" + ENDIF + ENDIF + USE IN clista + plActiv = eActiv + ELSE + eActiv = llActiv + plActiv = llActiv + lcContPart = lcCont + IF !llTitluTot AND EMPTY(lcDenumire) + lcDenumire = "Inregistrari " + "( " + lcContPart + " )" + ELSE + IF !EMPTY(lcDenumire) AND !llTitluTot + lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )" + ENDIF + ENDIF + ENDIF + + + *** verificare INAINTE_DE + DO inainte WITH "IREG_PARTENERI",lcContPart IN oinainte_de.prg + IF tlTest + DO test_ireg WITH lcContPart,llActiv + ENDIF + + pcCont = lcContPart + + PRIVATE poireg_parteneri,pcschema1,pcselect1 + STORE '' TO poireg_parteneri + pcschema1 = ['id_ireg_part n(20),an n(4), luna n(2),ID_FACT N(20),id_part n(20),cont c(4),acont c(4), ID_VALUTA N(5), ID_VENCHELT N(5), PROC_TVA N(8,2),' +] + ; + ['PRECDEB N(20,4),PRECCRED N(20,4),PRECVALDEB N(20,4),PRECVALCRED N(20,4),' +] + ; + ['debit n(20,4),credit n(20,4),valdebit n(20,4), valcredit n(20,4),' +] + ; + ['NRACT N(14),DATAACT D,DATAIREG D,DATASCAD D,CURS N(9,3),' +] + ; + ['COD N(20),EXPLICATIA C(100),EXPLICATIA4 C(100),EXPLICATIA5 C(100), ' +] + ; + ['ID_RESPONSABIL N(5),ID_FDOC N(5),ID_LUCRARE N(5),ID_SET N(20),ID_ACT N(20),' +] + ; + ['NUME C(100),COD_FISCAL C(30),FDOC C(50),NRESP C(50),NRORD C(50),NUME_VAL C(10),VENCHELT C(50)' ] + +pcselect1=['SELECT I.ID_IREG_PART, I.AN, I.LUNA, ID_FACT, I.ID_PART, I.CONT, I.ACONT, I.ID_VALUTA, I.ID_VENCHELT, I.PROC_TVA,' + ] +; +['I.PRECDEB, I.PRECCRED, I.PRECVALDEB, I.PRECVALCRED, ' + ] +; +['I.DEBIT, I.CREDIT, I.VALDEBIT, I.VALCREDIT, ' + ] +; +['I.NRACT, I.DATAACT, I.DATAIREG, I.DATASCAD, I.CURS,' + ] +; +['I.COD, I.EXPLICATIA, I.EXPLICATIA4, I.EXPLICATIA5,' + ] +; +['I.ID_RESPONSABIL, I.ID_FDOC, I.ID_LUCRARE, I.ID_SET, I.ID_ACT,' + ] +; +['I.NUME,I.COD_FISCAL,I.FDOC,I.NRESP,I.NRORD,I.NUME_VAL,I.VENCHELT' + ] + ; +[' FROM ] + GCS + [.VIREG_PARTENERI I WHERE 1=2'] + +*!* pcselect1=['select i.*,p.cod_fiscal from ] + gcS + [.vireg_parteneri i join ] + gcS + ; +*!* [.vnom_parteneri p on p.id_part = i.id_part where 1=2'] + pcorder1=[dataact] + pcfiltru1 = [1=2] + *!* pcfiltru1 = [cont = '] + Alltrim(pcCont) + [' and luna = ] + Alltrim(Str(gnLuna)) + [ and an = ] + Alltrim(Str(gnAn)) + gencursor('poireg_parteneri','actcv',pcselect1,pcfiltru1,pcschema1,pcorder1) + poireg_parteneri.ca_baza1.afisare() + + + SELECT actcv + + tcFis2 = "ActCv" + tlVisible = .T. + + LOCAL c + c="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)" + buton=1 + + IF tlTest AND .F. + + PRIVATE pcCampVerif + pcCampVerif = ofis.camp_verif + SELECT (tcFis2) + SET FILTER TO + lcProc='inainte_'+ALLTRIM(tcFis2) + DO &lcProc IN inaintede.prg + IF buton=2 + RETURN + ENDIF + ENDIF + + SELE actcv + + + PRIVATE pcAnalitic,pcLucrare + STORE '' TO pcAnalitic,pcLucrare + + Oreg=CREATEOBJECT("FRM_IREG_PARTENERI") + WITH Oreg + .lActiv = llActiv + .cCont = lcContPart + *!* .LABEL10.Caption=Proper(tctitlu)&&& trebuie facut + .LABEL10.CAPTION= PROPER(lcDenumire) + .grid1.column12.VISIBLE=.T. + .CONT=ALLT(pcCont) + .fisier=ALLTRIM(tcFis2) + .Ck_valuta.VISIBLE=tlVisible + .CK_explicatia.VISIBLE=tlVisible + .CHECK7.VISIBLE=tlVisible + .CHECK9.VISIBLE=tlVisible + .grid1.column2.VISIBLE=tlVisible + .grid1.column11.VISIBLE=tlVisible + .grid1.column13.VISIBLE=tlVisible + .grid1.column14.VISIBLE=tlVisible + .grid1.column7.VISIBLE=tlVisible + .grid1.column8.VISIBLE=tlVisible + .grid1.column10.VISIBLE=tlVisible + IF !tlVisible + .CHECK3.CAPTION='Regularizate' + .CHECK4.CAPTION='Neregularizate' + .check10.CAPTION='Regularizat' + .grid1.column12.header1.CAPTION='Regularizat' + .grid1.column2.WIDTH=0 + ENDIF + IF !plActiv + + .grid1.column9.CONTROLSOURCE = "(preccred+credit)-(precdeb+debit)" + .grid1.column14.CONTROLSOURCE ="(precvalcred+valcredit)-(precvaldeb+valdebit)" + .ck_sold.camp_nume = "credit+preccred-precdeb-debit" + .grid1.column1.CONTROLSOURCE = "preccred+credit" + .grid1.column12.CONTROLSOURCE = "precdeb+debit" + .grid1.column11.CONTROLSOURCE = "precvalcred+valcredit" + .grid1.column13.CONTROLSOURCE = "precvaldeb+valdebit" + .grid1.column20.CONTROLSOURCE = "credit" + .grid1.column21.CONTROLSOURCE = "debit" + .grid1.column22.CONTROLSOURCE = "valcredit" + .grid1.column23.CONTROLSOURCE = "valdebit" + .grid1.column18.CONTROLSOURCE = "preccred" + .grid1.column19.CONTROLSOURCE = "precdeb" + + .grid1.column1.header1.CAPTION = "Total " + lcDenCredit + .grid1.column12.header1.CAPTION = "Total " + lcDenDebit + .grid1.column11.header11.CAPTION = "Total " + lcDenCredit + " valuta" + .grid1.column13.header1.CAPTION = "Total " + lcDenDebit + " valuta" + .grid1.column20.header1.CAPTION = lcDenCredit + .grid1.column21.header1.CAPTION = lcDenDebit + .grid1.column22.header1.CAPTION = lcDenCredit + " valuta" + .grid1.column23.header1.CAPTION = lcDenDebit + " valuta" + .grid1.column18.header1.CAPTION = "Prec " + lcDenCredit + .grid1.column19.header1.CAPTION = "Prec " + lcDenDebit + ELSE + .grid1.column9.CONTROLSOURCE = "(precdeb+debit)-(preccred+credit)" + .grid1.column14.CONTROLSOURCE ="(precvaldeb+valdebit)-(precvalcred+valcredit)" + .ck_sold.camp_nume = "precdeb+debit-credit-preccred" + .grid1.column1.header1.CAPTION = "Total " + lcDenDebit + .grid1.column12.header1.CAPTION = "Total " + lcDenCredit + .grid1.column11.header11.CAPTION = "Total " + lcDenDebit + " valuta" + .grid1.column13.header1.CAPTION = "Total " + lcDenCredit + " valuta" + .grid1.column20.header1.CAPTION = lcDenDebit + .grid1.column21.header1.CAPTION = lcDenCredit + .grid1.column22.header1.CAPTION = lcDenDebit + " valuta" + .grid1.column23.header1.CAPTION = lcDenCredit + " valuta" + .grid1.column18.header1.CAPTION = "Prec " + lcDenDebit + .grid1.column19.header1.CAPTION = "Prec " + lcDenCredit + ENDIF + IF TYPE('pcTotctva')#'U' AND TYPE('pcAchitat')#'U' + .grid1.column12.header1.CAPTION=pcAchitat + .grid1.column1.header1.CAPTION=pcTotctva + ENDIF + IF TYPE('pcSumaTotal')#'U' AND TYPE('pcSumaAchi')#'U' + .CHECK13.CAPTION=pcSumaTotal + .check10.CAPTION=pcSumaAchi + ENDIF + IF TYPE('actcv.nresp') # 'U' + .grid1.column17.VISIBLE= .T. + .grid1.column17.CONTROLSOURCE = 'nresp' + .Ck_responsabil.VISIBLE = .T. + ENDIF + ENDWITH + Oreg.SHOW(1) + *!* Select actcv + *!* If Used('actcv') + *!* Use In actcv + *!* Endif + *!* Release ofis + RELEASE Oreg + USE IN actcv + +ENDPROC && lans_ireg_parteneri +*--------------------------------------------------------------------------------- + +PROCEDURE lans_balanta_parteneri + LPARAMETERS tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit &&initital cu 2 parametrii + *!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri + *!* tcDenumire = titlul balantei + *!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire + *!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire + + LOCAL llParametri, lcCont, llActiv,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit + + llParametri = .F. + lcCont = '' + llActiv = .F. + IF EMPTY(tlTitluTot) + llTitluTot = .F. + ELSE + llTitluTot = tlTitluTot + ENDIF + + IF EMPTY(tcDenumire) + lcDenumire = "" + ELSE + lcDenumire= tcDenumire + ENDIF + + IF EMPTY(tcDenDebit) + lcDenDebit = "Debit" + ELSE + lcDenDebit = tcDenDebit + ENDIF + IF EMPTY(tcDenCredit) + lcDenCredit = "Credit" + ELSE + lcDenCredit = tcDenCredit + ENDIF + *!* IF PCOUNT() < 2 + IF EMPTY(tcCont) AND EMPTY(tlactiv) + llParametri = .F. + ELSE + llParametri = .T. + lcCont = ALLTRIM(tcCont) + llActiv = tlactiv + ENDIF + + LOCAL NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista + STORE 0 TO lnTdeb, lnTcred, lnSold + NOU=.T. + + IF .F. + SELECT calendar + GO TOP + IF an=pcAn AND NL=pcNl + NOU=.F. + ENDIF + ENDIF + *!* IF glPrimaLuna + *!* nou = .F. + *!* ENDIF + + PRIVATE polista,pcschema1,pcselect1,pcfiltru1,pcorder1 + STORE "" TO polista + + + IF !llParametri + + IF USED('clista') + USE IN clista + ENDIF + + + pcschema1=['cont c(4),acont c(4),explicatie c(50)'] + pcselect1=['select distinct cont,rpad(CHR(32),4,CHR(32)) as acont,explicatie from ]+gcS+[.vcoresp_tip_cont where 1=2'] + pcfiltru1=[2=2] + pcorder1=[cont] + llAfisare=.F. + gencursor('polista','clista',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare) + polista.ca_baza1.afisare() + + *!* SELECT DISTINCT cont, '' as acont FROM coresp_tip_cont INTO CURSOR clista + SELECT clista + loCont=myscatter('blank') + + PRIVATE eActiv + STORE .T. TO eActiv + + Ol=CREATEOBJECT("frm_sel_cont") + WITH Ol + .Lb_titlu_alb_b121.CAPTION= 'Selectati contul' + IF EMPTY(.cboCont.ROWSOURCE) + .cboCont.ROWSOURCE="clista.cont,acont" + ENDIF + .ocont=loCont + IF EMPTY(.cAlias) + .cAlias=LEFT(.cboCont.ROWSOURCE,AT(".",.cboCont.ROWSOURCE)-1) + ENDIF + .HEIGHT = 190 + ENDWITH + Ol.SHOW(1) + + IF buton = 2 + USE IN clista + RETURN + ENDIF + + lcContPart = loCont.CONT + IF !llTitluTot AND EMPTY(lcDenumire) + lcDenumire = "Balanta " + ALLTRIM(clista.explicatie) + "( " + lcContPart + " )" + ELSE + IF !EMPTY(lcDenumire) AND !llTitluTot + lcDenumire = "Balanta " + lcDenumire + "( " + lcContPart + " )" + ENDIF + ENDIF + USE IN clista + ELSE + lcContPart = lcCont + eActiv = llActiv + + IF !llTitluTot AND EMPTY(lcDenumire) + lcDenumire = "Balanta " + "( " + lcContPart + " )" + ELSE + IF !EMPTY(lcDenumire) AND !llTitluTot + lcDenumire = "Balanta " + lcDenumire + "( " + lcContPart + " )" + ENDIF + ENDIF + ENDIF + + IF eActiv + lnSemn = -1 + ELSE + lnSemn = 1 + ENDIF + + + *** verificare INAINTE_DE + DO inainte WITH "BALANTA_parteneri",lcContPart IN oinainte_de.prg + + + + + PRIVATE pobalpartext,pcschema2,pcselect2,pcfiltru2,pcorder2,pobalpartint,pcschema3,pcselect3,pcfiltru3,pcorder3,pcgroup3 + STORE "" TO pobalpartext,pobalpartint + pcschema2=['PRECDEB1 N(19,2),PRECCRED1 N(19,2),PRECDEB N(19,2),PRECCRED N(19,2),'+]+; + ['DEB N(19,2),CRED N(19,2),PRECVALDEB1 N(19,2),PRECVALCRED1 N(19,2),PRECVALDEB N(19,2),'+]+; + ['PRECVALCRED N(19,2),VALDEBIT N(19,2),VALCREDIT N(19,2),NUME_VAL C(5),ID_PART N(10),'+]+; + ['NUME C(50),COD_FISCAL C(30),CONT C(4),ACONT C(4),AN N(4),LUNA N(2),TOTCRED N(19,2),TOTDEB N(19,2),'+]+; + ['TOTVALCRED N(19,2),TOTVALDEB N(19,2),ID_VALUTA N(5)'] + pcselect2=['select PRECDEB1,PRECCRED1,PRECDEB,PRECCRED,'+]+; + ['DEBIT as DEB,CREDIT as CRED,PRECVALDEB1,PRECVALCRED1,PRECVALDEB,'+]+; + ['PRECVALCRED,VALDEBIT,VALCREDIT,NUME_VAL,ID_PART,'+]+; + ['NUME,COD_FISCAL,CONT,ACONT,AN,LUNA,'+]+; + ['PRECCRED+CREDIT as TOTCRED,PRECDEB+DEBIT as TOTDEB,'+]+; + ['PRECVALCRED+VALCREDIT as TOTVALCRED,PRECVALDEB+VALDEBIT as TOTVALDEB,ID_VALUTA '+]+; + ['from ]+gcS+[.vbalanta_parteneri where 1=2'] + pcfiltru2=[1=2] + pcorder2=[nume,acont] + llAfisare=.F. + gencursor('pobalpartext','xtemp',pcselect2,pcfiltru2,[''],pcorder2,llAfisare) + pobalpartext.ca_baza1.afisare() + + pcschema3=['PRECDEB1 N(19,2),PRECCRED1 N(19,2),PRECDEB N(19,2),PRECCRED N(19,2),'+]+; + ['DEB N(19,2),CRED N(19,2),PRECVALDEB1 N(19,2),PRECVALCRED1 N(19,2),PRECVALDEB N(19,2),'+]+; + ['PRECVALCRED N(19,2),VALDEBIT N(19,2),VALCREDIT N(19,2),NUME_VAL C(5),ID_PART N(10),'+]+; + ['NUME C(50),COD_FISCAL C(30),CONT C(4),ACONT C(4),AN N(4),LUNA N(2),TOTCRED N(19,2),TOTDEB N(19,2),'+]+; + ['TOTVALCRED N(19,2),TOTVALDEB N(19,2),ID_VALUTA N(5)'] + pcselect3=['select SUM(PRECDEB1) AS PRECDEB1,SUM(PRECCRED1) AS PRECCRED1,SUM(PRECDEB) AS PRECDEB,SUM(PRECCRED) AS PRECCRED,'+]+; + ['SUM(DEBIT) as DEB,SUM(CREDIT) as CRED,0 AS PRECVALDEB1,0 AS PRECVALCRED1,0 AS PRECVALDEB,'+]+; + ["0 AS PRECVALCRED,0 AS VALDEBIT,0 AS VALCREDIT,'LEI' AS NUME_VAL,ID_PART,"+]+; + ['NUME,COD_FISCAL,CONT,ACONT,AN,LUNA,'+]+; + ['SUM(PRECCRED+CREDIT) as TOTCRED,SUM(PRECDEB+DEBIT) as TOTDEB,'+]+; + ['SUM(PRECVALCRED+VALCREDIT) as TOTVALCRED,SUM(PRECVALDEB+VALDEBIT) as TOTVALDEB,0 AS ID_VALUTA '+]+; + ['from ]+gcS+[.vbalanta_parteneri where 1=2'] + pcfiltru3=[1=2] + pcorder3=[nume,acont] + pcgroup3=[CONT,ACONT,AN,LUNA,ID_PART,NUME,COD_FISCAL] + llAfisare=.F. + gencursor('pobalpartint','xtemp',pcselect3,pcfiltru3,[''],pcorder3,llAfisare,pcgroup3) + pobalpartint.ca_baza1.afisare() + + OVIZ=CREATEOBJECT("frm_bal_parteneri") + WITH OVIZ + *!* .LABEL10.Caption='SITUATIA ANALITICA - BALANTA PARTENERI (' + Alltrim(lcContPart) + ')' + .LABEL10.CAPTION = PROPER(lcDenumire) + IF eActiv + .grid1.column6.CONTROLSOURCE='- cred + deb' + .grid1.column10.CONTROLSOURCE='- totcred + totdeb' + .grid1.column9.CONTROLSOURCE='- preccred + precdeb' + + .grid1.column21.CONTROLSOURCE='- totvalcred + totvaldeb' + .grid1.column18.CONTROLSOURCE='- precvalcred + precvaldeb' + *!* .grid1.column6.header1.Caption='Sold (deb-cred)' + *!* .grid1.COLUMN4.header1.Caption='Debit' + *!* .grid1.COLUMN5.header1.Caption='Credit' + .grid1.column6.header1.CAPTION= "Sold("+ALLTRIM(lcDenDebit)+"-"+ALLTRIM(lcDenCredit)+")"&&'Sold (cred-deb)' + .grid1.COLUMN4.header1.CAPTION= lcDenDebit&&Debit' + .grid1.COLUMN5.header1.CAPTION= lcDenCredit&&'Credit' + .grid1.column11.header1.CAPTION= "Prec." + lcDenDebit&&Debit' + .grid1.column12.header1.CAPTION= "Prec." + lcDenCredit&&'Credit' + .grid1.COLUMN15.header1.CAPTION= "Total" + lcDenDebit&&Debit' + .grid1.COLUMN16.header1.CAPTION= "Total" + lcDenCredit&&'Credit' + .pcfel='A' + ELSE + .grid1.column6.CONTROLSOURCE='cred - deb' + .grid1.column10.CONTROLSOURCE='totcred - totdeb' + .grid1.column9.CONTROLSOURCE='preccred - precdeb' + + .grid1.column21.CONTROLSOURCE='totvalcred - totvaldeb' + .grid1.column18.CONTROLSOURCE='precvalcred - precvaldeb' + .grid1.column6.header1.CAPTION= "Sold("+ALLTRIM(lcDenCredit)+"-"+ALLTRIM(lcDenDebit)+")"&&'Sold (cred-deb)' + .grid1.COLUMN4.header1.CAPTION= lcDenDebit&&Debit' + .grid1.COLUMN5.header1.CAPTION= lcDenCredit&&'Credit' + .grid1.column12.header1.CAPTION= "Prec." + lcDenCredit&&'Credit' + .grid1.column11.header1.CAPTION= "Prec." + lcDenDebit&&'Debit' + *!* .grid1.column11.controlsource = "preccred" + *!* .grid1.column12.controlsource = "precdeb" + .grid1.COLUMN16.header1.CAPTION= "Total" + lcDenCredit&&'Credit' + .grid1.COLUMN17.header1.CAPTION= "Total" + lcDenDebit&&'Debit' + *!* .grid1.COLUMN15.controlsource= "totCred" &&Credit' + *!* .grid1.COLUMN16.controlsource= "TotDeb" &&'Debit' + .pcfel='P' + + ENDIF + .grid1.column18.VISIBLE=.F. + .grid1.column19.VISIBLE=.F. + .grid1.column20.VISIBLE=.F. + .grid1.column21.VISIBLE=.F. + .grid1.column22.VISIBLE=.F. + .TABEL = 'BALANTA_PARTENER' + .pcCont = ALLTRIM(lcContPart) + .grid1.column8.WIDTH=0 + .grid1.column13.WIDTH=0 + .grid1.column14.WIDTH=0 + .grid1.column8.VISIBLE=.F. + .grid1.column13.VISIBLE=.F. + .grid1.column14.VISIBLE=.F. + .label7.VISIBLE=.F. + .text4.VISIBLE=.F. + .TEXT5.VISIBLE=.F. + .text9.VISIBLE=.F. + ENDWITH + IF !NOU + WITH OVIZ.grid1 + .column2.COLUMNORDER=2 + FOR I=9 TO 16 + lcViz='.column'+ALLTRIM(STR(I))+'.visible=.f.' + *lcWidth='.column'+ALLTRIM(STR(i))+'.width=0' + &lcViz + *&lcWidth + ENDFOR + ENDWITH + ENDIF + + OVIZ.SHOW(1) + USE IN xtemp + *!* ENDIF +ENDPROC && lans_balanta_parteneri +*---------------------------------------------------------------------------------------------- + + +*---------------------------------- Inceput lans_balanta_cumulata ---------------------------------- +PROCEDURE lans_balanta_cumulata + + +pcselect = [select explicatie, id_coloana from ] + gcs + [.coloane where 2=2] +pcfiltru = [2=2] +pcschema = [''] +pcorder = [explicatie] +pccoloane = [explicatie] +pcTitlu = [Alegeti Balanta] +pcFiltruOriginal = [camp is null and tabel is null and id_prg_owner = 2 and configurabil = 1] +locauta = cauta_alfa(pcselect,pcfiltru,pcschema,pcorder,pccoloane,pcTitlu,pcTitlu,"",.f.,pcFiltruOriginal) + +IF EMPTY(locauta.id_coloana) OR ISNULL(locauta.id_coloana) + RETURN +ENDIF + +pnIdBal = locauta.id_coloana + + +pcTitluCol = [] +pcNumeCol = [] +lcSel = [{call pack_balante_cumulate.balante_cumulate(?@pcNumeCol,?@pcTitluCol,?gcS,?pnIdBal,?gnAn,?gnLuna)}] +lcSchema = [] +lcCursor = 'crs_bal' +lnSucces = goExecutor.oExecute(lcSel,lcCursor) + +IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + RETURN +ENDIF + + +pcNumeCol = [nume;cod_fiscal;acont;] + pcNumeCol +pcTitluCol = [Partener,Cod Fiscal,Analitic,] + pcTitluCol +SELECT (lcCursor) +SCATTER NAME loto BLANK + + +obalp = CREATEOBJECT('frm_bal_parteneri_cumulata') +obalp.ototal = loto +WITH obalp.ct_grid_order1 + .cselect = lcSel + .cschema = lcSchema + .cTitlu_coloane = pcTitluCol + .cNume_coloane = pcNumeCol + .cFiltruOriginal = [] + .cFiltru = [] + .cOrder = [] + .cTitlu = [] + .cnumeCursor = lcCursor + .lmodparam = .T. +ENDWITH +obalp.ctitlu = locauta.explicatie +obalp.show() + +IF USED(lcCursor) + USE IN (lcCursor) +ENDIF + +ENDPROC && lans_balanta_cumulata +*---------------------------------- Sfarsit lans_balanta_cumulata ---------------------------------- + + +*---------------------------------- Inceput configurare_balanta_cumulata ---------------------------------- +PROCEDURE configurare_balanta_cumulata +PRIVATE pnIdBalanta, pnIdColoana +STORE 0 TO pnIdBalanta, pnIdColoana + +pcselect1 = [select explicatie,explicatie2, id_coloana from ] + gcs + [.coloane ] +pcfiltru1 = [camp is null and tabel is null and id_prg_owner = 2 and configurabil = 1] +pcschema1 = [''] +pcorder1 = [explicatie] +pccoloane1 = [explicatie; explicatie2] +pcTitluCol1 = [Titlu Balanta,Conturi] +pcTitlu1 = [Lista Balante Configurate] + +pcselect2 = [select f.id_calcul, f.id_op_col , f.ordine, f.id_coloana, c.camp, c.explicatie from ] + gcs + [.sal_calcul f left join ] + ; + gcs +[.coloane c on f.id_op_col = c.id_coloana and f.coloana = 1] +pcfiltru2 = [f.id_coloana =?pnIdBalanta] +pcschema2 = [''] +pcorder2 = [f.ordine] +pccoloane2 = [explicatie; ordine] +pcMask2 = '[1]=;[2]=REPLICATE("9",3)' +pcTitluCol2 = [Titlu coloana, Ordine] +pcTitlu2 = [Coloane Balanta] + +pcselect3 = [select id_calcul, id_coloana, id_op_col, explicatie, camp, coloana, ordine from ] + gcs + [.cont_vformule_balante ] +pcfiltru3 = [id_coloana =?pnIdColoana] +pcschema3 = [''] +pcorder3 = [ordine] +pccoloane3 = [camp;explicatie;ordine] +pcMask3 = '[1]=;[2]=;[3]=REPLICATE("9",3)' +pcTitluCol3 = [Camp,Explicatie,Ordine] +pcTitlu3 = [Formula Coloane] + + +obalp = CREATEOBJECT('config_balante_parteneri') +WITH obalp.Ct_grid_search1 + .cselect = pcselect1 + .cschema = pcschema1 + .cTitlu_coloane = pcTitluCol1 + .cNume_coloane = pccoloane1 + .cFiltruOriginal = pcfiltru1 + .cFiltru = [2=2] + .cOrder = pcorder1 + .cTitlu = pcTitlu1 + .cnumeCursor = 'crs_NumeBal' + .lmodparam = .T. +ENDWITH +WITH obalp.Ct_grid_search2 + .cselect = pcselect2 + .cschema = pcschema2 + .cTitlu_coloane = pcTitluCol2 + .cNume_coloane = pccoloane2 + .cFiltruOriginal = pcfiltru2 + .cFiltru = [2=2] + .cOrder = pcorder2 + .cTitlu = pcTitlu2 + .cMask = pcMask2 + .cnumeCursor = 'crs_ColoaneBal' + .lmodparam = .t. +ENDWITH +WITH obalp.Ct_grid_search3 + .cselect = pcselect3 + .cschema = pcschema3 + .cTitlu_coloane = pcTitluCol3 + .cNume_coloane = pccoloane3 + .cFiltruOriginal = pcfiltru3 + .cFiltru = [2=2] + .cOrder = pcorder3 + .cTitlu = pcTitlu3 + .cMask = pcMask3 + .cnumeCursor = 'crs_FormulaBal' + .lmodparam = .t. +ENDWITH +obalp.show() + +ENDPROC && configurare_balanta_cumulata +*---------------------------------- Sfarsit configurare_balanta_cumulata ---------------------------------- + diff --git a/Programe/Vechi/oproceduri_preluari.prg b/Programe/Vechi/oproceduri_preluari.prg new file mode 100644 index 0000000..0a3cbfc --- /dev/null +++ b/Programe/Vechi/oproceduri_preluari.prg @@ -0,0 +1,41 @@ +***----------------------------------------------------- +Procedure preluare_curs +PARAMETERS tcTabelCurs + +LOCAL lcTabelCurs +lcTabelCurs = ALLTRIM(tcTabelCurs) + +Select (lcTabelCurs) +SCAN + WAIT WINDOW ALLTRIM(STR(RECNO()))+"/"+ALLTRIM(STR(RECCOUNT())) NOWAIT + pnCurs = Curs + pdData1 = Data + pdData2 = data2 + lnId_valuta = id_tipv + Do Case + Case lnId_valuta = 1 + pnId_valuta = 41695 + Case lnId_valuta = 2 + pnId_valuta = 41692 + Case lnId_valuta = 3 + pnId_valuta = 41694 + Case lnId_valuta = -1 + pnId_valuta = 41697 + OTHERWISE + pnId_valuta = 41696 + Endcase + + + lcSql = [begin pack_crm.adauga_curs(?gcS, ?pnCurs, ?pdData1, ?pdData2, ?pnId_valuta); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.adauga_curs'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +ENDSCAN + +WAIT WINDOW "Preluarea s-a terminat!" +Endproc && preluare_curs +***----------------------------------------------------- + diff --git a/Programe/Vechi/oproceduri_registretva.prg b/Programe/Vechi/oproceduri_registretva.prg new file mode 100644 index 0000000..c87ae9c --- /dev/null +++ b/Programe/Vechi/oproceduri_registretva.prg @@ -0,0 +1,57 @@ +****************************************************************** +PROCEDURE listare_registru_tva +LPARAMETERS tcRegistru + + pcRegistru = UPPER(ALLTRIM(tcRegistru)) + DO CASE + CASE 'VANZ'$pcRegistru + pcContTVA = [4427] + pcListaContTVA = [411,4111,4112,4113,4114,4115,4116,4117,461,635,5311,5121,428,4281,4282,4426,4428] + pcListaContBaza = [411,4111,4112,4113,4114,4115,4116,4117,461,428,4281,4282] + pcListaContExceptii = [667,419] + OTHERWISE + pcContTVA = [4426] + pcListaContTVA = [401,404,5121,5124,542,4427,4428] + pcListaContBaza = [401,404] + pcListaContExceptii = [767] + ENDCASE + + + lcSql = [{call PACK_REGISTRE_TVA.REGISTRUTVA(?gcS, ?gnAn, ?gnLuna, ] + ; + [?pcRegistru, ?pcContTVA, ?pcListaContTVA, ?pcListaContBaza, ?pcListaContExceptii )}] + lcCursor = 'crsRegistruTemp' + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + IF lnSucces < 0 + AMESSAGE(goExecutor.cEroare,0+16,"Eroare") + ELSE + + SELECT nract, dataact, PART AS nume, cod_fiscal, fdoc, baza, proc_tva, tva, baza + tva as totctva, 00000000000.0000 as total ; + FROM crsRegistruTemp ; + INTO CURSOR crsRegistru ; + READWRITE ORDER BY nract, dataact, nume + USE IN crsRegistruTemp + + SELECT nract, dataact, nume,sum(totctva) as total ; + from crsRegistru ; + INTO CURSOR tgrup ; + GROUP BY nract, dataact, nume + + SELECT tgrup + SCAN + SCATTER NAME ot + SELECT crsRegistru + LOCATE FOR nume = ot.nume AND nract = ot.nract AND dataact = ot.dataact + IF FOUND() + REPLACE total WITH ot.total + ENDIF + SELECT tgrup + ENDSCAN + USE IN tgrup + + SELECT crsRegistru + REPORT FORM registru_tva_simplu TO PRINTER PROMPT PREVIEW + USE IN crsRegistru + ENDIF +ENDPROC + +****************************************************************** \ No newline at end of file diff --git a/Programe/Vechi/oproceduri_roaclienti.prg b/Programe/Vechi/oproceduri_roaclienti.prg new file mode 100644 index 0000000..52d7f42 --- /dev/null +++ b/Programe/Vechi/oproceduri_roaclienti.prg @@ -0,0 +1,1814 @@ +Procedure viz_contracte + +Private poCtr +Store '' To poCtr + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +*!* lcSchema1 = [id_ctr N(5), id_part N(10), nume C(30), nr_ctr N(10), data_ctr D(8), obiect C(200), tip N(1), durata N(3), valftva N(20,4), proc_tva N(5,2), avans N(20,4), proc_avans N(5,2),]+; +*!* [val_finant N(20,4), proc_finant N(5,2), dobanda N(20,4), proc_dobanda N(5,2), val_rezid N(20,4), proc_rezid N(5,2), ]+; +*!* [rata N(20,4), comision N(20,4), proc_comision N(5,2), proc_asigurare N(5,2), val_asigurare N(20,4), val_ctr N(20,4), id_valuta N(5), nume_val C(4), curs N(10,4), zi_plata N(2), incetat N(1), sters N(1) ] +*!* +*!* lcSelect1 = [select c.id_ctr, c.id_part, p.nume, c.nr_ctr, c.data_ctr, c.obiect, c.tip, c.durata, c.valftva, c.proc_tva, c.avans, c.proc_avans, ]+; +*!* [c.val_finant, c.proc_finant, c.dobanda, c.proc_dobanda, c.val_rezid, c.proc_rezid, ]+; +*!* [c.rata, c.comision, c.proc_comision, c.proc_asigurare, c.val_asigurare, c.val_ctr, c.id_valuta, v.nume_val, c.curs, c.zi_plata, c.incetat, c.sters from ] + gcS + ; +*!* [.cf_contracte c join ] + gcS + [.nom_parteneri p on p.id_part = c.id_part]+; +*!* [ join ] + gcS + [.nom_valute v on c.id_valuta = v.id_valuta] +lcSelect1 = [select * from ] + gcS + [.vcontracte] +lcOrder1 = [] +lcgroup = [] +lcFiltru1 = [1=2] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. + +gencursor('poCtr','cContracte', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poCtr.ca_baza1.afisare() + +Select cContracte + +lovcL = Createobject("frm_contracte") +lovcL.lb_titlu_alb_b121.Caption = "CONTRACTE CLIENTI" +lovcL.Show(1) + +Release poCtr + +Endproc && viz_contracte +***----------------------------------------------------------------------------------------------------------------------------- +Procedure adauga_contract +Parameters tcAlias + +Local lcAlias +lcAlias = tcAlias + +Private pnId_ctr, pcNr_ctr +Store 0 To pnId_ctr +Store '' To pcNr_ctr + + +Local lnTip, lnCurs_ctr, lnNr_rate +Local lcId_tipc, lcId_tipc, lcId_tipcurs, lcValvaluta, lcvalctva, lcZi_fact, lcziscad, lcId_responsabil, lcId_sectie, lcId_venchelt, lcCoef_pen, lcDescriere + +Store "" To lcId_tipc, lcId_tipc, lcId_tipcurs, lcValvaluta, lcvalctva, lcZi_fact, lcziscad, lcId_responsabil, lcId_sectie, lcId_venchelt, lcCoef_pen, lcDescriere +Store '1' To lcZi_fact + +Select (lcAlias) && cContracte +Scatter Name poRec Blank +poRec.data_ctr = Datetime() +poRec.zi_fact = 1 +poRec.proc_tva = 19 +**--------------------- + +lcSql = [begin pack_crm.next_id_ctr(?gcS, ?@pnId_ctr); end;] +lnSucces = goExecutor.oExecute(lcSql) + +If lnSucces < 0 + Messagebox('pack_crm.next_id_ctr'+goExecutor.cEroare,0+16,"Eroare") + Return +Endif +**--------------------- +poRec.id_ctr = pnId_ctr +**--------------------- +*!* pcTabel = "crm_nrcontr" +*!* pcCamp = "nrcontr" +*!* lcSql = [begin pack_crm.read_nr(?gcS, ?pcTabel, ?pcCamp, ?@pnNr_ctr); end;] +*!* lnSucces = goExecutor.oExecute(lcSql) + +*!* If lnSucces < 0 +*!* Messagebox('pack_crm.read_nr'+goExecutor.cEroare,0+16,"Eroare") +*!* Return +*!* Endif +*!* **--------------------- +*!* poRec.nr_ctr = pnNr_ctr +*!* **--------------------- + +lcSql = [begin pack_crm.next_nr_ctr(?gcS, ?@pcNr_ctr); end;] +lnSucces = goExecutor.oExecute(lcSql) + +If lnSucces < 0 + Messagebox('pack_crm.next_nr_ctr'+goExecutor.cEroare,0+16,"Eroare") + Return +Endif +**--------------------- +poRec.nr_ctr = pcNr_ctr +**--------------------- + +Private poTipc +Store '' To poTipc + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select id_tipc, tipc from ] + gcS + [.crm_tipc where 1=2'] +lcOrder1 = [id_tipc] +lcFiltru1 = [] +llAfiseaza = .F. +gencursor('poTipc','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poTipc.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_tipc Readwrite +Release poTipc + +Select cNom_tipc +Go Top +Scatter Name poTipc +poRec.id_tipc = cNom_tipc.id_tipc +**--------------------- +Private poPrestatii +Store '' To poPrestatii + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vcrm_contracte_articole where 1=2'] +lcOrder1 = [] +lcFiltru1 = [ id_ctr=] + Alltrim(Str(poRec.id_ctr)) +llAfiseaza = .F. +gencursor('poPrestatii','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poPrestatii.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cArticoleCtr Readwrite +Select cArticoleCtr +Release poPrestatii +**--------------------- +Create Cursor cScadentar (id_ctr N(5), id_rata N(10), nr_rata N(10), den_rata C(30), data_rata D, procent N(4,2), valrata N(20,4), valfact N(20,4), id_valuta N(5), nume_val C(4)) +Select cScadentar +**--------------------- +Private poDocumente +Store '' To poDocumente + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vcrm_contracte_documente where 1=2'] +lcOrder1 = [] +lcFiltru1 = [ id_ctr=] + Alltrim(Str(poRec.id_ctr)) +llAfiseaza = .F. +gencursor('poDocumente','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poDocumente.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cLinkuri Readwrite +Select cLinkuri +Release poDocumente +**--------------------- +llNou = .T. +locnC = Createobject("frm_contract_nou",pnId_ctr, llNou) +locnC.Show(1) + +**--------------------- +If Used("cNom_tipc") + Use In cNom_tipc +Endif + +If buton = 2 + Return +Endif + +*!* **--------------------- +*!* pcTabel = "crm_nrcontr" +*!* pcCamp = "nrcontr" +*!* lcSql = [begin pack_crm.write_nr(?gcS, ?pcTabel, ?pcCamp, ?pnNr_ctr); end;] +*!* lnSucces = goExecutor.oExecute(lcSql) + +*!* If lnSucces < 0 +*!* Messagebox('pack_crm.write_nr'+goExecutor.cEroare,0+16,"Eroare") +*!* Return +*!* Endif +*!* **--------------------- +*!* pdData_ctr = Nvl(poRec.data_ctr, {//}) +*!* pcObiect = poRec.obiect + +*!* pnDurata = Nvl(poRec.durata,0) +*!* pnProc_tva = Nvl(poRec.proc_tva,0) +*!* pnId_valuta = Nvl(poRec.id_valuta,0) +*!* pnZi_plata = Nvl(poRec.zi_plata,0) +*!* pnCurs = Nvl(poRec.Curs,0) +*!* pnIncetat = Nvl(poRec.Incetat,0) +*!* pnId_tipc = poRec.id_tipc +*!* pnId_tipcurs = poRec.id_tipcurs +*!* pnValvaluta = poRec.valvaluta +*!* pnvalctva = poRec.valctva +*!* pnziscad = poRec.ziscad +*!* pnId_responsabil = poRec.id_responsabil +*!* pnId_sectie = poRec.id_sectie +*!* pnId_venchelt = poRec.id_venchelt +*!* pnCoef_pen = poRec.coef_pen +*!* pcDescriere = poRec.descriere + +*!* lcSql = [begin pack_crm.adauga_contract(?gcS, ?pnId_ctr, ?pnId_part, ?pnNr_ctr, ?pdData_ctr, ?pcObiect, ?pnDurata,]+; +*!* [ ?pnProc_tva, ?pnId_valuta, ?pnZi_plata, ?pnCurs, ?pnIncetat, ?pnId_tipc, ?pnId_tipcurs, ?pnValvaluta, ?pnvalctva, ]+; +*!* [?pnziscad, ?pnId_responsabil, ?pnId_sectie, ?pnId_venchelt, ?pnCoef_pen, ?pcDescriere, ?gnIdUtil); end;] +*!* lnSucces = goExecutor.oExecute(lcSql) + +lcId_ctr = Alltrim(Str(pnId_ctr)) +lnId_part = poRec.id_part +lcId_part = Alltrim(Str(lnId_part)) +lcNr_ctr = Alltrim(poRec.nr_ctr) +ldData_ctr = Dtos(poRec.data_ctr) +lcObiect = Alltrim(poRec.obiect) + +lcDurata = Alltrim(Str(poRec.durata)) +lcProc_tva = Alltrim(Str(poRec.proc_tva)) +lcId_valuta = Alltrim(Str(poRec.id_valuta)) + +If poRec.zi_fact = 99 + lcZi_fact = '-1' +Else + lcZi_fact = Alltrim(Str(poRec.zi_fact)) +Endif +lcCurs = Alltrim(Str(poRec.Curs)) +lcIncetat = Alltrim(Str(poRec.Incetat)) +lcId_tipc = Alltrim(Str(poRec.id_tipc)) +lcId_categ_ctr = ALLTRIM(STR(porec.id_categ_ctr)) +lcId_tipcurs = Alltrim(Str(poRec.id_tipcurs)) +lcValvaluta = Alltrim(Str(poRec.valvaluta,20,gnPA)) +lcvalctva = Alltrim(Str(poRec.valctva,20,gnPA)) +lcziscad = Alltrim(Str(poRec.ziscad)) +lcId_responsabil = Alltrim(Str(poRec.id_responsabil)) +lcId_sectie = Alltrim(Str(poRec.id_sectie)) +lcId_venchelt = Alltrim(Str(poRec.id_venchelt)) +lcCoef_pen = Alltrim(Str(poRec.coef_pen)) +lcDescriere = Alltrim(poRec.descriere) +lcId_art_fact = Alltrim(Str(poRec.id_art_fact)) +lcIdUtil = Alltrim(Str(gnIdUtil)) + +lcSql = [begin pack_crm.adauga_contract('] + gcS + [',] + lcId_ctr + [,] + lcId_part + [,'] + lcNr_ctr + ; + [', TO_DATE(]+Iif(!Empty(ldData_ctr),[']+ldData_ctr+['],[NULL])+[,'YYYY-MM-DD'),']+; + lcObiect + [',] + lcDurata + [,] + ; + lcProc_tva + [,] + lcId_valuta + [,] + lcZi_fact + [,] + lcCurs + [,] + lcIncetat + [,] + ; + lcId_tipc + [,] + lcId_categ_ctr + [,] + ; + lcId_tipcurs + [,] + lcValvaluta + [,] + lcvalctva + [,] + ; + lcziscad + [,] + lcId_responsabil + [,] + lcId_sectie + [,] + lcId_venchelt + [,] + lcCoef_pen + [,'] + lcDescriere + [',] + ; + lcId_art_fact + [,] + lcIdUtil +[); end;] +lnSucces = goExecutor.oExecute(lcSql) + +Strtofile(lcSql,"c:\sql.txt") + +If lnSucces < 0 + Messagebox('pack_crm.adauga_contract'+goExecutor.cEroare,0+16,"Eroare") + Return +Endif +**--------------------- +&& lcTabelArticole = locnF.grid_articole.RecordSource + +Select cArticoleCtr +Replace All id_ctr With pnId_ctr +Do update_ctr_art With "cArticoleCtr" In oproceduri_roaClienti.prg +If Used("cArticoleCtr") + Use In cArticoleCtr +Endif +**--------------------- +lnId_tipc = poRec.id_tipc +If lnId_tipc = 1 +*!* lcSql = [begin pack_crm.adauga_rate(?gcS, ?pnId_ctr, ?pnDurata, ?pnValvaluta, ?pnId_valuta, ?pdData_ctr, ?pnZi_plata); end;] + lcSql = [begin pack_crm.adauga_rate('] + gcS + [',] + lcId_ctr + [,] + lcDurata + [,] + lcValvaluta + [,] + lcId_valuta + ; + [, TO_DATE(]+Iif(!Empty(ldData_ctr),[']+ldData_ctr+['],[NULL])+[,'YYYY-MM-DD'),]+; + lcZi_fact + [); end;] + + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.adauga_rate'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +ENDIF + +If poRec.id_tipc = 2 && mentenanta + lcSql = [begin pack_crm.mentenanta(] + ALLTRIM(STR(gnAn)) + [,] + ALLTRIM(STR(gnLuna)) + [,] + lcId_ctr + [); end;] + + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.mentenanta'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +Endif + +*!* IF pnId_tipc <> 3 +*!* Do viz_rate With pocontract +*!* Endif +**--------------------- +If Used("cScadentar") + Use In cScadentar +Endif +**--------------------- + +Return pnId_ctr +Endproc && adauga_contract +***----------------------------------------------------------------------------------------------------------------------------- +Procedure modifica_contract +Parameters toContract + +poRec = toContract + +Private pnId_ctr, pnId_part, pnNr_ctr, pdData_ctr, pcObiect, pnDurata, pnProc_tva, pnId_valuta, pnZi_fact, pnId_art_fact +Private pnCurs, pnIncetat, pnVal_ctr, pnVal_ctr_f +**--------------------- +*!* If poRec.zi_fact = -1 +*!* poRec.zi_fact = 99 +*!* Endif + +*!* Private poTipc +*!* Store '' To poTipc + +*!* Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +*!* lcSchema1 = [''] +*!* lcSelect1 = ['select id_tipc, tipc from ] + gcS + [.crm_tipc where 1=2'] +*!* lcOrder1 = [id_tipc] +*!* lcFiltru1 = [] +*!* llAfiseaza = .F. +*!* gencursor('poTipc','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +*!* poTipc.ca_baza1.afisare() + +*!* Select * From cIntermediar Into Cursor cNom_tipc Readwrite +*!* Release poTipc + +*!* Select cNom_tipc +*!* Locate For id_tipc = poRec.id_tipc +*!* Scatter Name poTipc +*!* poRec.id_tipc = cNom_tipc.id_tipc +**--------------------- +Private poCtr_art +Store '' To poCtr_art + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ctr_articole where 1=2'] +lcOrder1 = [] +lcFiltru1 = [ id_ctr=] + Alltrim(Str(poRec.id_ctr)) +llAfiseaza = .F. +gencursor('poCtr_art','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poCtr_art.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cCtrArt Readwrite +Select cCtrArt +Release poCtr_art +**--------------------- +*!* Private poScadentar +*!* Store '' To poScadentar + +*!* Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +*!* lcSchema1 = ['id_ctr n(5), id_rata n(10), nr_rata N(10), den_rata C(30), data_rata D, procent n(4,2), valrata n(20,4), valfact n(20,4), id_valuta n(5), nume_val C(4)'] + +*!* lcSelect1 = ['select id_ctr, id_rata, nr_rata, den_rata, data_rata, procent, valrata, valfact, id_valuta, nume_val from ] + gcS + [.vcrm_rate where 1=2'] +*!* lcOrder1 = [nr_rata] + +*!* lcFiltru1 = [id_ctr=] + Alltrim(Str(poRec.id_ctr)) +*!* llAfiseaza = .F. +*!* gencursor('poScadentar','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +*!* poScadentar.ca_baza1.afisare() + +*!* Select * From cIntermediar Into Cursor cScadentar Readwrite +*!* Release poScadentar + +*!* Select cScadentar +**--------------------- +**--------------------- +*!* Private poDocumente +*!* Store '' To poDocumente + +*!* Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +*!* lcSchema1 = [''] +*!* lcSelect1 = ['select * from ] + gcS + [.vcrm_contracte_documente where 1=2'] +*!* lcOrder1 = [] +*!* lcFiltru1 = [ id_ctr=] + Alltrim(Str(poRec.id_ctr)) +*!* llAfiseaza = .F. +*!* gencursor('poDocumente','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +*!* poDocumente.ca_baza1.afisare() + +*!* Select * From cIntermediar Into Cursor cLinkuri Readwrite +*!* Select cLinkuri +*!* Release poDocumente +**--------------------- + +locnF = Createobject("frm_contract_nou",poRec.id_ctr) +locnF.Show(1) +**--------------------- +If Used("cNom_tipc") + Use In cNom_tipc +Endif + +If buton = 2 + Return +Endif +**--------------------- +pcId_ctr = Alltrim(Str(poRec.id_ctr)) +pcId_part = Alltrim(Str(poRec.id_part)) +pcNr_ctr = Alltrim(poRec.numar) +*pcObiect = Nvl(Alltrim(poRec.obiect),"") + +* pcDurata = Nvl(Alltrim(Str(poRec.durata)),"") +pcProc_tva = Nvl(Alltrim(Str(poRec.proc_tva)),"") +pcId_valuta = Nvl(Alltrim(Str(poRec.id_valuta)),"") +*!* If poRec.zi_fact = 99 +*!* pcZi_fact = '-1' +*!* Else +*!* pcZi_fact = Alltrim(Str(poRec.zi_fact)) +*!* Endif + +* pcCurs = Nvl(Alltrim(Str(poRec.Curs)),"0") +pcIncetat = Nvl(Alltrim(Str(poRec.Incetat)),"") +pcId_tipc = Nvl(Alltrim(Str(poRec.id_tip_ctr)),"") + +pcValftva = Nvl(Alltrim(Str(poRec.valftva,20,gnPA)),"") +pcvalctva = Nvl(Alltrim(Str(poRec.valctva,20,gnPA)),"") +pcziscad = Nvl(Alltrim(Str(poRec.ziscad)),"0") +pcId_responsabil = Nvl(Alltrim(Str(poRec.id_responsabil)),"0") +pcId_sectie = Nvl(Alltrim(Str(poRec.id_sectie)),"0") +pcId_venchelt = Nvl(Alltrim(Str(poRec.id_venchelt)),"0") +pcCoef_pen = Nvl(Alltrim(Str(poRec.coef_pen,6,gnPA)),"0") +pcDescriere = Nvl(Alltrim(poRec.descriere),"") +pcId_art_fact = Nvl(Alltrim(Str(poRec.id_art_fact)),"0") + +ldData_ctr = Dtos(poRec.data_ctr) +lcIdUtil = Alltrim(Str(gnIdUtil)) + +lcSql = [begin pack_crm.modifica_contract('] + gcS + [',] + pcId_ctr + [,] + pcId_part + [,'] + pcNr_ctr +; + [', TO_DATE(]+Iif(!Empty(ldData_ctr),[']+ldData_ctr+['],[NULL])+[,'YYYY-MM-DD'),']+; + pcObiect + [',] + pcDurata +[,]+; + pcProc_tva + [,] + pcId_valuta + [,] + pcZi_fact + [,] + pcCurs +; + [,] + pcIncetat + [,] + pcId_tipc + [,] + pcId_categ_ctr + [,] + pcId_tipcurs + [,] + pcValvaluta + [,] + pcvalctva + [,] +; + pcziscad + [,]+ pcId_responsabil + [,] + pcId_sectie + [,] + pcId_venchelt + [,] + pcCoef_pen + [,'] + ; + pcDescriere + [',] + pcId_art_fact + [,] + lcIdUtil +[); end;] + +Strtofile(lcSql,"c:\sql.txt") + +lnSucces = goExecutor.oExecute(lcSql) + +If lnSucces < 0 + Messagebox('pack_crm.modifica_contract'+goExecutor.cEroare,0+16,"Eroare") + Return +Endif +**--------------------- +&& lcTabelArticole = locnF.grid_articole.RecordSource + +Select cArticoleCtr +Replace All id_ctr With poRec.id_ctr +Do update_ctr_art With "cArticoleCtr" In oproceduri_roaClienti.prg +If Used("cArticoleCtr") + Use In cArticoleCtr +Endif +**--------------------- +**--------------------- +Do update_ctr_doc With "cLinkuri" In oproceduri_roaClienti.prg +If Used("cLinkuri") + Use In cLinkuri +Endif +**--------------------- + +Endproc && modifica_contract +***----------------------------------------------------------------------------------------------------------------------------- +Procedure update_ctr_art +Parameters tcTabelArticole + +Local lcTabelArticole +lcTabelArticole = tcTabelArticole + +Private pnGasit, pnId_ctr_art, pnId_ctr, pnId_art, pnPret_unitar, pnCant, pnValoare,pnDiscount, pnValcdiscount, pcUM, pnId_valuta_art +Store 0 To pnGasit, pnId_ctr_art, pnId_ctr, pnId_art, pnPret_unitar, pnCant, pnValoare, pnDiscount, pnValcdiscount, pnId_valuta_art +Store "" To pcUM + +&& update articole +lcDeleted = Set("Deleted") +Set Deleted Off + +Select (lcTabelArticole) +Scan + pnId_ctr_art = id_ctr_art + pnId_ctr = id_ctr + pnId_art = id_art + pnPret_unitar = pret_unitar + pnCant = cant + pnValoare = valoare + pnDiscount = discount + pnValcdiscount = valcdiscount + pcUM = Alltrim(um) + pnId_valuta_art = id_valuta + + If Deleted() + llsters = .T. + Else + llsters = .F. + Endif + + lcSql = [begin pack_crm.cauta_ctr_art(?gcS, ?pnId_ctr, ?pnId_art, ?@pnGasit); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.cauta_ctr_art'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + If pnGasit = 0 + lcSql = [begin pack_crm.adauga_ctr_art(?gcS, ?pnId_ctr, ?pnId_art, ?pnPret_unitar, ?pnCant, ?pnValoare, ?pnDiscount, ?pnValcdiscount, ?pcUM, ?pnId_valuta_art); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.adauga_ctr_art'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Else + If llsters && sterge_rata + lcSql = [begin pack_crm.sterge_ctr_art(?gcS, ?pnId_ctr_art); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.sterge_ctr_art'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Else + lcSql = [begin pack_crm.modifica_ctr_art(?gcS, ?pnId_ctr_art, ?pnId_ctr, ?Id_art, ?pnPret_unitar, ?pnCant, ?pnValoare, ?pnDiscount, ?pnValcdiscount, ?pcUM, ?pnId_valuta_art); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.modifica_ctr_art'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Endif + Endif + Select (lcTabelArticole) +Endscan + +Set Deleted &lcDeleted + +Endproc && update_ctr_art +***----------------------------------------------------------------------------------------------------------------------------- +***----------------------------------------------------------------------------------------------------------------------------- +Procedure update_ctr_doc +Parameters tcTabelDocumente + +Local lcTabelDocumente +lcTabelDocumente = tcTabelDocumente + +Private pnGasit, pnId_ctr_doc, pnId_ctr, pcDenumire, pcLink +Store 0 To pnGasit, pnId_ctr_doc, pnId_ctr +Store "" To pcDenumire, pcLink + +&& update documente +lcDeleted = Set("Deleted") +Set Deleted Off + +Select (lcTabelDocumente) +Scan + pnId_ctr_doc = id_ctr_doc + pnId_ctr = id_ctr + pcDenumire = denumire + pcLink = Link + + If Deleted() + llsters = .T. + Else + llsters = .F. + Endif + + lcSql = [begin pack_crm.cauta_ctr_doc(?gcS, ?pnId_ctr_doc, ?@pnGasit); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.cauta_ctr_doc'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + If pnGasit = 0 + lcSql = [begin pack_crm.adauga_ctr_doc(?gcS, ?pnId_ctr, ?pcDenumire, ?pcLink); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.adauga_ctr_doc'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Else + If llsters && sterge_doc + lcSql = [begin pack_crm.sterge_ctr_doc(?gcS, ?pnId_ctr_doc); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.sterge_ctr_doc'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Else + lcSql = [begin pack_crm.modifica_ctr_doc(?gcS, ?pnId_ctr_doc, ?pnId_ctr, ?pcDenumire, ?pcLink); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.modifica_ctr_doc'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Endif + Endif + Select (lcTabelDocumente) +Endscan + +Set Deleted &lcDeleted + +Endproc && update_ctr_doc +***----------------------------------------------------------------------------------------------------------------------------- +Procedure factura +Parameters tnId_ctr, tnId_part, tlProforma + +If Empty(tnId_ctr) And Empty(tnId_part) + Return +Endif + +Local llProforma +llProforma = tlProforma + +Private pcMasina +Store "" To pcMasina + +Private pnId_ctr, pnId_part +pnId_ctr = tnId_ctr +pnId_part = tnId_part + +Private pnpretuval, pnId_fact, pnId_proforma +Store 0 To pnpretuval, pnId_fact, pnId_proforma && valoarea cu care intru pe factura (pentru contractele in rate) + +**--------------- +If !Empty(pnId_ctr) + Private poCtr + Store '' To poCtr + + Private pnNr_fact + Store 0 To pnNr_fact + + Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza + lcSchema1 = [''] + lcSelect1 = ['select * from ] + gcS + [.vcrm_contracte where 1=2'] + lcOrder1 = [] + lcFiltru1 = [ id_ctr=]+Alltrim(Str(pnId_ctr)) + llAfiseaza = .F. + gencursor('poCtr','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) + poCtr.ca_baza1.afisare() + + Select * From cIntermediar Into Cursor cCtr Readwrite + Release poCtr + + Select cCtr + Scatter Name poContract + Use In cCtr + +Endif +**--------------- +Private poClient +Store '' To poClient + +Private pnNr_fact +Store 0 To pnNr_fact + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_parteneri where 1=2'] +lcOrder1 = [] +If !Empty(pnId_ctr) + lcFiltru1 = [ id_part=]+Alltrim(Str(poContract.id_part)) +Else + lcFiltru1 = [ id_part=]+Alltrim(Str(pnId_part)) +Endif +llAfiseaza = .F. +gencursor('poClient','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poClient.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cPartener Readwrite +Release poClient +**-- +Select cPartener +Scatter Name poClient +Use In cPartener +**--------------- +Private poFact +Store '' To poFact + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vcrm_facturi where 1=2'] +lcOrder1 = [] +lcFiltru1 = [1=2] +llAfiseaza = .F. +gencursor('poFact','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poFact.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cFact Readwrite +Release poFact + +Select cFact +Scatter Name poFactura Blank +Use In cFact +**--------------- +If !Empty(pnId_ctr) + poFactura.id_ctr = poContract.id_ctr + poFactura.id_valuta = poContract.id_valuta + poFactura.nume_val = poContract.nume_val + poFactura.proc_tva = poContract.proc_tva +Else + poFactura.proc_tva = 19 +Endif +poFactura.id_part = poClient.id_part +poFactura.data_fact = Date() +poFactura.data_curs = {//} +**--------------------- + +If llProforma + lcSql = [begin pack_crm.next_id_proforma(?gcS, ?@pnId_proforma); end;] + lnSucces = goExecutor.oExecute(lcSql) + If lnSucces < 0 + Messagebox('pack_crm.next_id_proforma'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + AddProperty(poFactura,"id_proforma",pnId_proforma) +Else + lcSql = [begin pack_crm.next_id_fact(?gcS, ?@pnId_fact); end;] + lnSucces = goExecutor.oExecute(lcSql) + If lnSucces < 0 + Messagebox('pack_crm.next_id_fact'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + poFactura.id_fact = pnId_fact +Endif +**--------------------- + +poFactura.data_ireg = poFactura.data_fact +If Year(poFactura.data_ireg) * 12 + Month(poFactura.data_ireg) <> gnAn*12 + gnLuna + ldData = Date(gnAn, gnLuna, 1) + ldData = Gomonth(ldData,1)-1 + poFactura.data_ireg = ldData +Endif + +*!* poFactura.data_scad = poFactura.data_fact + poContract.ziscad +*!* If poContract.id_tipcurs=1 +*!* poFactura.data_curs = poFactura.data_fact +*!* Else +*!* pzlc = "1/" + Alltrim(Str(Month(poFactura.data_fact))) + "/" + Alltrim(Str(Year(poFactura.data_fact))) +*!* data1 = Ctod(pzlc) +*!* uzlt = Dtoc(data1-1) + +*!* poFactura.data_curs = uzlt +*!* Endif +**--------------------- +If llProforma + pcTabel = "nrproforme" + pcCamp = "nrproforma" +Else + pcTabel = "nrfact" + pcCamp = "nrfact" +Endif + +lcSql = [begin pack_crm.read_nr(?gcS, ?pcTabel, ?pcCamp, ?@pnNr_fact); end;] +lnSucces = goExecutor.oExecute(lcSql) + +If lnSucces < 0 + Messagebox('pack_crm.read_nr'+goExecutor.cEroare,0+16,"Eroare") + Return +Endif +**--------------------- +poFactura.nr_fact = pnNr_fact +**--------------------- +Private poRespons +Store '' To poRespons + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_responsabili where 1=2'] +lcOrder1 = [nume] +If !Empty(pnId_ctr) And !Isnull(poContract.id_responsabil) + lcFiltru1 = [id_responsabil=] + Alltrim(Str(poContract.id_responsabil)) +Else + lcFiltru1 = [1=2] +Endif +llAfiseaza = .F. +gencursor('poRespons','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poRespons.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_Responsabili Readwrite +Release poRespons + +Select cNom_Responsabili +Scatter Name poResponsabil +Use In cNom_Responsabili +**--------------------- +Private poDeleg +Store '' To poDeleg + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_delegati where 1=2'] +lcOrder1 = [nume] +lcFiltru1 = [id_part =] + Alltrim(Str(poClient.id_part)) +llAfiseaza = .F. +gencursor('poDeleg','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poDeleg.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_Delegati Readwrite +Release poDeleg + +Select cNom_Delegati +Scatter Name poDelegat +Use In cNom_Delegati +***--------------------------------------- +Private poSect +Store '' To poSect + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_sectii where 1=2'] +lcOrder1 = [sectie] +If !Empty(pnId_ctr) And !Isnull(poContract.id_sectie) + lcFiltru1 = [id_sectie =] + Alltrim(Str(poContract.id_sectie)) +Else + lcFiltru1 = [1=2] +Endif +llAfiseaza = .F. +gencursor('poSect','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poSect.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_Sectii Readwrite +Release poSect + +Select cNom_Sectii +Scatter Name poSectie +Use In cNom_Sectii +***--------------------------------------- +Private poVenChe +Store '' To poVenChe + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_venchel where 1=2'] +lcOrder1 = [explicatie] +If !Empty(pnId_ctr) And !Isnull(poContract.id_venchelt) + lcFiltru1 = [id_venchelt =] + Alltrim(Str(poContract.id_venchelt)) +Else + lcFiltru1 = [1=2] +Endif +llAfiseaza = .F. +gencursor('poVenChe','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poVenChe.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_VenChel Readwrite +Release poVenChe + +Select cNom_VenChel +Scatter Name poVenChel +Use In cNom_VenChel +***--------------------------------------- +Private poLucr +Store '' To poLucr + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_lucrari where 1=2'] +lcOrder1 = [nrord] +If !Empty(pnId_ctr) + lcFiltru1 = [ nrord = '] + Alltrim(poContract.nr_ctr)+"/"+Alltrim(Dtoc(poContract.data_ctr)) + ['] +Else + lcFiltru1 = [1=2] +Endif +llAfiseaza = .F. +gencursor('poLucr','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poLucr.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_Lucrari Readwrite +Release poLucr + +Select cNom_Lucrari +Scatter Name poLucrare +Use In cNom_Lucrari +***--------------------------------------- +Private poFDocument +Store '' To poFDocument + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_fdoc where 1=2'] +lcOrder1 = [fel_document] +lcFiltru1 = [ UPPER(fel_document) = 'FACTURA'] +llAfiseaza = .F. +gencursor('poFDocument','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poFDocument.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_FDoc Readwrite +Release poFDocument + +Select cNom_FDoc +Scatter Name poFDoc +Use In cNom_FDoc +***--------------------------------------- +If !Empty(pnId_ctr) + lcSql = [begin pack_crm.calculeaza_val_next_factura(?gcS, ?pocontract.id_ctr, ?@pnpretuval); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.calculeaza_val_next_factura'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +Endif +***--------------------------------------- +Private poFact_elem +Store '' To poFact_elem + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = [select fe.*, 000 as nrcrt,'Denumire articol' as den_articol, ' ' as scd, ' ' as scc, ' ' as ascd, ' ' as ascc from ] + gcS + [.fact_elem fe where 1=2] +* [ left join vnom_articole_crm a on a.id_articol = fe.id_articol where 1=2'] +lcOrder1 = [] +lcFiltru1 = [1=2] +llAfiseaza = .F. +gencursor('poFact_elem','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poFact_elem.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor tFactura Readwrite +Release poFact_elem + +If !Empty(pnId_ctr) + If !Empty(poContract.id_art_fact) And !Isnull(poContract.id_art_fact) + Private poArt_Fact + Store '' To poArt_Fact + + Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza + lcSchema1 = [''] + lcSelect1 = [select id_articol, denumire, scd, scc, ascd, ascc from ] + gcS + [.vcrm_articole_note where 1=2] + lcOrder1 = [] + lcFiltru1 = [id_articol=]+Alltrim(Str(poContract.id_art_fact)) + llAfiseaza = .F. + gencursor('poArt_Fact','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) + poArt_Fact.ca_baza1.afisare() + + Select * From cIntermediar Into Cursor tArt_fact Readwrite + Release poArt_Fact + Else && toate articolele contractate + Private poArt_Fact + Store '' To poArt_Fact + + Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza + lcSchema1 = [''] + lcSelect1 = [select id_art as id_articol, denumire, scd, scc, ascd, ascc from ] + gcS + [.vcrm_contracte_articole_note where 1=2] + lcOrder1 = [] + lcFiltru1 = [id_ctr=]+Alltrim(Str(poContract.id_ctr)) + llAfiseaza = .F. + gencursor('poArt_Fact','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) + poArt_Fact.ca_baza1.afisare() + + Select * From cIntermediar Into Cursor tArt_fact Readwrite + Release poArt_Fact + Endif + + Select tArt_fact + Scan + Select tFactura + Append Blank + Replace denumire With Alltrim(tArt_fact.denumire) + " CONFORM CONTRACTULUI", ; + den_articol With Alltrim(tArt_fact.denumire), ; + id_articol With tArt_fact.id_articol, ; + scd With tArt_fact.scd, ; + scc With tArt_fact.scc, ; + ascd With tArt_fact.ascd, ; + ascc With tArt_fact.ascc, ; + CANTITATE With 1, ; + um With "BUC", ; + nrcrt With 1, ; + pretuval With pnpretuval + + Select tArt_fact + Endscan +Endif + +Select tFactura +Go Top + +**--------------- +lovf = Createobject("frm_factura",llProforma) +lovf.Show(1) +**--------------------- +If buton = 2 + Use In tFactura + Return +Endif +**--------------------- +If llProforma + lcSql = [begin pack_crm.in_proforme(?gcS, ?gnLuna, ?gnAn, ?pofactura.id_proforma, ?pofactura.id_part,NULL,?pofactura.nr_fact, ]+; + [?pofactura.data_fact, ?pofactura.data_ireg, ?pofactura.data_scad, ?pofactura.valftva, ?pofactura.valtva, ?pofactura.valctva, ]+; + [?pofactura.valval, ?pofactura.tvaval, ?pofactura.totval, ?poFactura.id_valuta, ?pofactura.curs, ?pofactura.data_curs, ?pofactura.cod, ?pofactura.proc_tva, ]+; + [?pofactura.explcont, ?gnIdUtil); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.in_proforme'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +**--------------------- + Do in_proforme_elem In oproceduri_roaClienti.prg +**--------------------- +Else + pcTabel = "nrfact" + pcCamp = "nrfact" + lcSql = [begin pack_crm.write_nr(?gcS, ?pcTabel, ?pcCamp, ?pnNr_fact); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.write_nr'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +**--------------------- + Select tFactura + If !Empty(pnId_ctr) + Do make_actactan With poFactura, poClient, poResponsabil, poContract + Else + Do make_actactan With poFactura, poClient, poResponsabil + Endif + + Select actactan + Do Form verificare With .T. + + If buton=2 + Use In actactan + Return + Endif + + Select actactan + Do oscrie_in_fisiere + +**--------------------- + If !Empty(pnId_ctr) + lcSql = [begin pack_crm.in_facturi(?gcS, ?gnLuna, ?gnAn, ?pofactura.id_fact, ?pofactura.id_part, ?pocontract.id_ctr, ?pofactura.nr_fact, ]+; + [?pofactura.data_fact, ?pofactura.data_ireg, ?pofactura.data_scad, ?pofactura.valftva, ?pofactura.valtva, ?pofactura.valctva, ]+; + [?pofactura.valval, ?pofactura.tvaval, ?pofactura.totval, ?poFactura.id_valuta, ?pofactura.curs, ?pofactura.data_curs, ?pofactura.cod, ?pofactura.proc_tva, ]+; + [?pofactura.explcont, ?gnIdUtil); end;] + Else + lcSql = [begin pack_crm.in_facturi(?gcS, ?gnLuna, ?gnAn, ?pofactura.id_fact, ?pofactura.id_part,NULL,?pofactura.nr_fact, ]+; + [?pofactura.data_fact, ?pofactura.data_ireg, ?pofactura.data_scad, ?pofactura.valftva, ?pofactura.valtva, ?pofactura.valctva, ]+; + [?pofactura.valval, ?pofactura.tvaval, ?pofactura.totval, ?poFactura.id_valuta, ?pofactura.curs, ?pofactura.data_curs, ?pofactura.cod, ?pofactura.proc_tva, ]+; + [?pofactura.explcont, ?gnIdUtil); end;] + Endif + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.in_facturi'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif +**--------------------- + Do in_factelem In oproceduri_roaClienti.prg +**--------------------- + If !Empty(pnId_ctr) + lcSql = [begin pack_crm.in_rate(?gcS, ?pocontract.id_ctr, ?pofactura.id_fact, ?pofactura.valval); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.in_rate'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + Endif +**--------------------- +Endif + +Use In tFactura +**--------------------- + +Endproc && factura +***----------------------------------------------------------------------------------------------------------------------------- +***----------------------------------------------------------------------------------------------------------------------------- +Procedure make_actactan +Parameters tofactura, toclient, toresponsabil, toContract + +Local lcscd, lcscc, lcascd, lcascc, lcacronim +Store '' To lcscd, lcscc, lcascd, lcascc, lcacronim + +* actactan = gcTempPath + "actactan.dbf" +***----- +Private poAct +Store '' To poAct + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.act where 1=2'] +lcOrder1 = [] +lcFiltru1 = [1=2] +llAfiseaza = .F. +gencursor('poAct','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poAct.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor actactan Readwrite +Release poAct + +***----- +*!* Select act +*!* Copy To (actactan) With Cdx +*!* Sele 0 +*!* Use (actactan) Excl Alias actactan +*!* Sele actactan +*!* Zap + +Local lcid_set +lnid_set = 50000 + +*!* Select optiuni_program +*!* Locate For Upper(Alltrim(varname))="ID_SET" +*!* If Found() +*!* lnid_set=Eval(varvalue) +*!* Endif + +**** +If gnInreg_fact_linii = 1 && pun atatea linii cate prestatii am (eventual cu liniile de TVA corespunzatoare) + Select tFactura + Scan + Scatter Name loelem Memo + Select actactan + Scatter Name loact Blank + With loact + .COD = tofactura.COD + .dataireg = tofactura.data_ireg + .id_fdoc = poFDoc.id_fdoc + .dataact = tofactura.data_fact + .nract = tofactura.nr_fact + .id_partd = toclient.id_part + .explicatia = tofactura.explcont + .scd = loelem.scd && "411" + .scc = loelem.scc && "704" + .ascd = loelem.ascd && "" + .ascc = loelem.ascc && "" + .suma = Round(loelem.valftva, gnPC) +*!* If glfact_extern && facturile extern +*!* .suma_2 = Round(loelem.valval,pnvalvalfact_tot) +*!* .suma_3 = Round(tofactura.Curs, pncurs_zecimale) +*!* Endif + .datascad = tofactura.data_scad + .id_sectie = poSectie.id_sectie + .id_venchelt = poVenChel.id_venchelt + .id_lucrare = poLucrare.id_lucrare + .proc_tva = (100 + loelem.proc_tva)/100 +*CASE pnCalcTVA = 2 +*.proc_tva = (100 + tofactura.proc_tva)/100 +*ENDCASE + + .dataora = Datetime() + .id_fact = tofactura.id_fact + .id_responsabil = toresponsabil.id_responsabil + .id_set = lnid_set + + Select actactan + Append Blank + Gather Name loact + + If loelem.valtva <> 0 + .suma = Round(loelem.valtva, gnPC) + .scc="4427" + .ascc="" + Select actactan + Append Blank + Gather Name loact + Endif + + Endwith + Select tFactura + Endscan +Else && inregistrez o singura linie pt toata factura (grupuri de scd) + Select Distinct scd, ascd, scc, ascc, ; + ROUND(Sum(valftva), gnPC) As valftva, ; + proc_tva ; + FROM tFactura ; + GROUP By scd, ascd, scc, ascc, proc_tva ; + INTO Cursor tConturi + + Select tConturi + Scan + Select actactan + Scatter Name loact Blank + + With loact + .COD = tofactura.COD + .dataireg = tofactura.data_ireg + .id_fdoc = poFDoc.id_fdoc + .dataact = tofactura.data_fact + + .nract = tofactura.nr_fact + .id_partd = toclient.id_part + .explicatia = tofactura.explcont + + .scd = tConturi.scd + .scc= tConturi.scc + .ascd = tConturi.ascd + .ascc = tConturi.ascc + .suma = Round(tConturi.valftva,gnPC) + +*!* If glfact_extern && facturile extern +*!* .suma_2 = Round(tofactura.valval,pnvalvalfact_tot) +*!* .suma_3 = Round(tofactura.Curs,pncurs_zecimale) +*!* Endif + + .datascad = tofactura.data_scad + .id_sectie = poSectie.id_sectie + .id_venchelt = poVenChel.id_venchelt + .id_lucrare = poLucrare.id_lucrare + .proc_tva = (100 + tConturi.proc_tva) / 100 + .dataora = Datetime() + .id_fact = tofactura.id_fact + .id_responsabil = toresponsabil.id_responsabil + .id_set = lnid_set + + Select actactan + Append Blank + Gather Name loact + + Endwith + + Select tConturi + Endscan + + If Used("tConturi") + Use In tConturi + Endif + +&& scrie linia cu TVA + Select Distinct scd, ascd, proc_tva, ; + ROUND(Sum(valtva), gnPC) As valtva ; + FROM tFactura ; + GROUP By scd, ascd, proc_tva ; + INTO Cursor tCoteTva + + Select tCoteTva + Scan For valtva <> 0 + With loact + .suma = Round(tCoteTva.valtva, gnPC) + .proc_tva = (100 + tCoteTva.proc_tva) / 100 + .scc = "4427" + .ascc = "" + Endwith + + Select actactan + Append Blank + Gather Name loact + + Select tCoteTva + Endscan + + If Used("tCoteTva") + Use In tCoteTva + Endif +Endif + +Return .T. +Endproc && make_actactan +***-------------------------------------------------------------------------------------- +Procedure viz_facturi +Parameters tlProforme + +Local llProforme +llProforme = tlProforme + +Private poFacturi +Store '' To poFacturi + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza + +If llProforme + lcId_tip = [id_proforma N(20),] + lcId = [id_proforma, ] + lcView = [.vcrm_proforme] +Else + lcId_tip = [id_fact N(20),] + lcId = [id_fact, ] + lcView = [.vcrm_facturi] +Endif +lcSchemaComun = [id_ctr N(5), nr_fact N(10), data_fact D(8), data_ireg D(8), data_scad D(8), valftva N(20,4), valtva N(20,4), valctva N(20,4),]+; + [valval N(20,4), tvaval N(20,4), totval N(20,4), curs N(10,4), data_curs D(8), cod N(10), proc_tva N(2), explcont C(30),]+; + [sters N(1), id_util N(8), dataora T, id_part N(10), an N(4), luna N(2), id_valuta N(5),]+; + [nume C(70), nr_ctr C(20), nume_val C(20)] + +lcSchema1 = lcId_tip + lcSchemaComun +lcSelectComun = [id_ctr, nr_fact, data_fact, data_ireg, data_scad, valftva, valtva, valctva, ]+; + [valval, tvaval, totval, curs, data_curs, cod, proc_tva, explcont, ]+; + [sters, id_util, dataora, id_part, an, luna, id_valuta, ]+; + [nume, nr_ctr, nume_val]+; + [ from ] + gcS + +lcSelect1 = [select ] + lcId + lcSelectComun + lcView +lcOrder1 = [data_fact] +lcgroup = [] +lcFiltru1 = [1=2] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. + +gencursor('poFacturi','tFacturi', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poFacturi.ca_baza1.afisare() + +Select tFacturi +loff = Createobject("frm_viz_facturi",llProforme) +loff.Show(1) + +Release poFacturi + +Endproc && viz_facturi +***-------------------------------------------------------------------------------------- +Procedure in_factelem + +Private pnId_fact, pnId_articol, pcDenumire, pcUM, pnCantitate, pnPretUnitar, pnvalftva, pnvaltva, pnvalctva, pnpretuval, pnvalval, pntvaval, pntotval, pnProc_tva +Store 0 To pnId_fact, pnId_articol, pnCantitate, pnPretUnitar, pnvalftva, pnvaltva, pnvalctva, pnpretuval, pnvalval, pntvaval, pntotval, pnProc_tva +Store "" To pcDenumire, pcUM + +Select tFactura +Scan + pnId_fact = poFactura.id_fact + pnId_articol = id_articol + pcDenumire = denumire + pcUM = um + pnCantitate = CANTITATE + pnPretUnitar = pretUnitar + pnvalftva = valftva + pnvaltva = valtva + pnvalctva = valctva + pnpretuval = pretuval + pnvalval = valval + pntotval = totval + pnProc_tva = proc_tva + + lcSql = [begin pack_crm.in_factelem(?gcS, ?gnLuna, ?gnAn, ?pnid_fact, ?pnId_articol, ?pcDenumire, ?pcUm, ?pnCantitate, ?pnPretUnitar, ]+; + [?pnvalftva, ?pnvaltva, ?pnvalctva, ?pnpretuval, ]+; + [?pnvalval, ?pntvaval, ?pntotval, ?pnproc_tva, ?gnIdUtil); end;] + lnSucces = goExecutor.oExecute(lcSql) + + If lnSucces < 0 + Messagebox('pack_crm.in_factelem'+goExecutor.cEroare,0+16,"Eroare") + Return + Endif + + Select tFactura +Endscan + +Endproc && in_factelem +***-------------------------------------------------------------------------------------- +Procedure listfactura +Parameters tnId_fact, tlProforma + +Local llProforma +llProforma = tlProforma + +Private pnId_fact +pnId_fact = tnId_fact && id_fact / id_proforma +**--------------- +Private poFact +Store '' To poFact + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +If llProforma + lcSelect1 = ['select * from ] + gcS + [.proforme where 1=2'] + lcFiltru1 = [id_proforma=]+Alltrim(Str(pnId_fact)) +Else + lcSelect1 = ['select * from ] + gcS + [.facturi where 1=2'] + lcFiltru1 = [id_fact=]+Alltrim(Str(pnId_fact)) +Endif +lcOrder1 = [] +llAfiseaza = .F. +gencursor('poFact','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poFact.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cFact Readwrite +Release poFact + +Select cFact +Scatter Name poFactura +**--------------- +**--------------- +Private poClie +Store '' To poClie + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_parteneri where 1=2'] +lcOrder1 = [] +lcFiltru1 = [id_part=]+Alltrim(Str(poFactura.id_part)) +llAfiseaza = .F. +gencursor('poClie','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poClie.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cClienti Readwrite +Release poClie + +Select cClienti +Scatter Name poClient +**--------------- +**--------------- +Private poVal +Store '' To poVal + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.nom_valute where 1=2'] +lcOrder1 = [] +If !Empty(poFactura.id_valuta) And !Isnull(poFactura.id_valuta) + lcFiltru1 = [id_valuta=]+Alltrim(Str(poFactura.id_valuta)) +Else + lcFiltru1 = [] +Endif +llAfiseaza = .F. +gencursor('poVal','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poVal.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cValute Readwrite +Release poVal + +Select cValute +Scatter Name poValuta +**--------------- +**--------------------- +Private poRespons +Store '' To poRespons + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_responsabili where 1=2'] +lcOrder1 = [nume] +lcFiltru1 = [ales=1] +llAfiseaza = .F. +gencursor('poRespons','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poRespons.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_Responsabili Readwrite +If Used("cIntermediar") + Use In cIntermediar +Endif + +Select cNom_Responsabili +Scatter Name poResponsabil + +Release poRespons +**--------------------- +Private poDeleg +Store '' To poDeleg + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +lcSelect1 = ['select * from ] + gcS + [.vnom_responsabili where 1=2'] +lcOrder1 = [nume] +* lcFiltru1 = [id_partener =] + Alltrim(Str(poFactura.id_part)) +lcFiltru1 = [] +llAfiseaza = .F. +gencursor('poDeleg','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poDeleg.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor cNom_Delegati Readwrite +Select cNom_Delegati +Scatter Name poDelegat + +Release poDeleg +***--------------------------------------- +***--------------------------------------- +Private poFact_elem +Store '' To poFact_elem + +Private pcMasina +Store "" To pcMasina + +Local lcSchema1, lcSelect1, lcOrder1, lcFiltru1, llAfiseaza +lcSchema1 = [''] +If llProforma + lcSelect1 = ['select pe.*, 000 as nrcrt from ] + gcS + [.proforme_elem pe where 1=2'] + lcFiltru1 = [id_proforma=]+Alltrim(Str(poFactura.id_proforma)) +Else + lcSelect1 = ['select fe.*, 000 as nrcrt from ] + gcS + [.fact_elem fe where 1=2'] + lcFiltru1 = [id_fact=]+Alltrim(Str(poFactura.id_fact)) +Endif +lcOrder1 = [] +llAfiseaza = .F. +gencursor('poFact_elem','cIntermediar', lcSelect1, lcFiltru1, lcSchema1, lcOrder1, llAfiseaza) +poFact_elem.ca_baza1.afisare() + +Select * From cIntermediar Into Cursor tFactura Readwrite +Release poFact_elem +***--------------------------------------- +Select tFactura +Replace All nrcrt With Recno() + +If llProforma + Report Form proforma_a4 To Printer Prompt Preview +Else + lcmenu="\Factura A4;\Factura Fanfold - Tractor;\Factura A4 - RMS - lei;\Factura A4 - RMS - valuta fara TVA;\-;\mm,m,mm) +Endscan + +ta=_Tally +If ta=0 + Return '0' +Endif + +If Type("&no")!='O' + Public &no + zz=no+'=crea("menuclasic")' + &zz + + With &no + wm=m*7 + .NUME=no + .ONUMETATA=ONT + .Left=stinga + .Top=sus + .tabela=tabela + .camp1=cc1 + .camp2=cc2 + .sursa=nt + .Width=wm+2*.margine + .NRFII=ta + .rh=.container1.cwm1.Height + .Height=(.rh+1)*.NRFII+2*.margine+2 +*.show() + Endwith +Endif + +Release nt,m +Return no + + + +*------------------------------------------------------------------------------------------ +Procedure deschide_menuuri +*!* If !Used('menu1') +*!* Use &DIRGEN\CONTAB\Date\menu1 In 0 Alias menu1 Order Tag 'nrnod' +*!* Endif +*!* If !Used('menu2') +*!* Use &DIRGEN\CONTAB\Date\menu2 In 0 Alias menu2 Order Tag 'nrnod' +*!* Endif +*!* If !Used('menu3') +*!* Use &DIRGEN\CONTAB\Date\menu3 In 0 Alias menu3 Order Tag 'nrnod' +*!* Endif +*!* If !Used('menu4') +*!* Use &DIRGEN\CONTAB\Date\menu4 In 0 Alias menu4 Order Tag 'nrnod' +*!* Endif + +*!* If PRIMADATA +*!* Do CE_WINDOWS +*!* omenuvertical=Crea('menuvertical') +*!* omenuvertical.Show() +*!* Endif +*deschide_menu(tabela, cc1,cc2,mnrtata,stinga,sus,ONT +Return + + + + +*-------------------------------------- +Procedure CE_WINDOWS +Local vermajor,verminor +Public TIP_MENU,COL_MENU,cewin +Store '' To cewin +Store 0 To vermajor,verminor,TIP_MENU + +vermajor=Val(Os(3)) +verminor=Val(Os(4)) +Do Case +Case vermajor<4 + cewin='95' +Case vermajor=4 + cewin='98' +Case vermajor>=5 + Do Case + Case verminor=0 + cewin='2000' + Case verminor=1 + cewin='XP' + Otherwise + cewin='MAINOU' + Endcase +Endcase + + +*IF INLIST(CEWIN,'95','98','2000') +TIP_MENU=0&&'RAISED' +*ELSE +*TIP_MENU=2&&'FLAT' +*ENDIF + +*!* Do Case +*!* Case Inlist(cewin,'95','98') +*!* COL_MENU=Rgb(192,192,192)&&GRI +*!* Case cewin='2000' +*!* COL_MENU=Rgb(212,208,200)&&NISIP GRI +*!* Case cewin='XP' +*!* COL_MENU=Rgb(236,233,216)&&NISIP BEJ +*!* Otherwise +COL_MENU=Rgb(255,255,255)&&ALB +*!* Endcase + + +Return + + + + +*-------------------------------------- +Function SCRIE_IN_FISIERE +Parameters INFORMGEST + +*!* DEBUG +*!* SUSPEND +Local M.DEB,M.CRED,COND +Store 0 To M.DEB, M.CRED +Public OZ +COND='(Empty(SUMA) AND INLIST(XSETS.ID_SET,70))'&&INREGISTRARI CU SUMA 0 + + +*!* SELECT actactan +*!* SCAN +*!* SCATTER NAME loCont +*!* IF EMPTY(loCont.ascd) +*!* SELECT plcontana +*!* LOCATE FOR cont=locont.scd +*!* IF FOUND() +*!* loCont.ascd='0000' +*!* ENDIF +*!* ENDIF +*!* IF EMPTY(loCont.ascc) +*!* SELECT plcontana +*!* LOCATE FOR cont=locont.scc +*!* IF FOUND() +*!* loCont.ascc='0000' +*!* ENDIF +*!* ENDIF +*!* SELECT actactan +*!* GATHER NAME loCont +*!* ENDSCAN +*!* RELEASE loCont + +DD=Datetime() +Do CODARE +Select ACTACTAN +Replace All COD With M.COD +Replace All UTIL With UTILIZATOR, DATAORA With DD +Go Top +Scatter Name OZ + + + +Select ACTACTAN +Scan For !Empty(SUMA) OR &COND + Scatter Memv + Select ACT + If Flock() + Append Blank + Gather Memv + Endif + Unlock + Select ACTAN + If Flock() + Append Blank + Gather Memv + Endif + Unlock + Select ACTACTAN +Endscan + +Do Case +Case Left(Upper(INFORMGEST),3)='NIR' + Do SCRIE_NIR +Case Left(Upper(INFORMGEST),3)='BON' + Select IESIRI + Replace All COD With M.COD + IF !INLIST(M.ID_SET,70) + Do IERULAJMAGAZII + Do IESTOCURIMAGAZII + ENDIF + If Inlist(M.ID_SET,74,75,76)&&TRANSFER + Select INTRARI + Replace All COD With M.COD + Do INRULAJMAGAZII + Do INSTOCURIMAGAZII + Endif +Case Upper(INFORMGEST)='SCHIMBPRET' + Select INTRARI + Replace All COD With M.COD + Select IESIRI + Replace All COD With M.COD + Do IERULAJMAGAZII + Do IESTOCURIMAGAZII + Do INRULAJMAGAZII + Do INSTOCURIMAGAZII +Endcase + + +&& TABELA DE CONTURI +*!* IF USED('conturi') +*!* USE IN conturi +*!* ENDIF + +*!* IF USED('cc') +*!* USE IN cc +*!* ENDIF + + + +IF _program='cont' + Select Distinct SCD As Cont,ascd as acont,99999999999999 As DEB,; + 99999999999999 As CRED,99999999999999.99 As DEBVAL,99999999999999.99 As CREDVAL; + FROM ACTACTAN Into Table &LOC\&NFSCURT\TEMPO\CONTURI +ELSE + Select Distinct SCD As Cont,ascd as acont,99999999999999 As DEB,; + 99999999999999 As CRED,99999999999999.99 As DEBVAL,99999999999999.99 As CREDVAL; + FROM ACTACTAN Into Table &LOC\&NFSCURT\TEMPO\CONTURI_g + USE IN conturi_g + USE &LOC\&NFSCURT\TEMPO\CONTURI_g IN 0 ALIAS conturi +ENDIF + +Select CONTURI +Replace All DEB With 0, CRED With 0,DEBVAL With 0, CREDVAL With 0 +Select Distinct SCC As Cont,ascc as acont From ACTACTAN; + WHERE SCC+ASCC Not In (Sele Distinct Cont+ACONT From CONTURI); + INTO Cursor CC +Select CONTURI +Append From Dbf('CC') + +Select CONTURI +Scan + Scatter Memv + Select ACTACTAN + Sum SUMA To M.DEB For SCD=M.CONT AND ascd=m.acont + Sum SUMA To M.CRED For SCC=M.CONT AND ascc=m.acont + Sum SUMA_2 To M.DEBVAL For SCD=M.CONT AND ascd=m.acont + Sum SUMA_2 To M.CREDVAL For SCC=M.CONT AND ascc=m.acont + Select CONTURI + Gather Fields DEB, CRED,DEBVAL,CREDVAL Memv +Endscan + + +&& SCRIE IN BALANTA +Select CONTURI +Scan + Scatter Memv + Select BAL + If Flock() + LOCATE FOR cont=M.CONT + If !Found() + Sele PLCONT + Locate For Left(CIMP1,4)=Left(M.CONT,4) + If Found() + Do MESAJ With 'Se introduce in balanta contul',M.CONT + Scatter Memvar + m.CONT=M.CIMP1 + m.denumire=m.cimp2 + Sele BAL + If Flock() + Append Blank + Gather Memvar + Endif + Unlock + Else + Do MESAJ With 'Contul '+M.CONT+' nu este introdus','nici in planul de conturi si nici in balanta!' + Do Form contnou + Endif + Endif + Select BAL + Replace RULDEB With RULDEB+M.DEB, TOTDEB With TOTDEB+M.DEB,; + RULCRED With RULCRED+M.CRED, TOTCRED With TOTCRED+M.CRED + SOLD=TOTDEB-TOTCRED + Replace SOLDDEB With Iif(SOLD>0,SOLD,0), SOLDCRED With Iif(SOLD<0,-SOLD,0) + Endif + Unlock + Select CONTURI +Endscan + +&&scrie in balanta analitica +Select ascd,ascc From ACTACTAN Where !Empty(ascd) Or !Empty(ascc) Into Cursor aacont +If _Tally<>0 + Select balana + If Flock() + Select ACTACTAN + Scan + Scatter Memv + &&deb + IF !EMPTY(m.ascd) + Select balana + Seek m.SCD+m.ascd + If !Found() + Seek m.SCD+'0000' + If !Found() + Append Blank + Replace Cont With m.SCD + Replace acont With '0000' + Endif + Endif + Replace RULDEB With RULDEB+M.suma, TOTDEB With TOTDEB+M.suma + SOLD=TOTDEB-TOTCRED + Replace SOLDDEB With Iif(SOLD>0,SOLD,0) + endif + &&cred + IF !EMPTY(m.ascc) + Select balana + Seek m.SCc+m.ascc + If !Found() + Seek m.SCc+'0000' + If !Found() + Append Blank + Replace Cont With m.SCc + Replace acont With '0000' + Endif + Endif + Replace RULcred With RULcred+M.suma, TOTcred With TOTcred+M.suma + SOLD=TOTDEB-TOTCRED + Replace SOLDcred With Iif(SOLD<0,-SOLD,0) + endif + Select ACTACTAN + Endscan + Endif + Unlock In balana +Endif + +&& SCRIE IN FISIERE +Select Distinct A.Cont,b.acont,A.FPROC,B.DEB,B.CRED,B.DEBVAL,B.CREDVAL From INFISIERE A, CONTURI B ; + WHERE A.Cont=B.Cont ; + INTO Cursor COM + +*!* SELECT com +*!* BROWSE + +Select COM +Scan + Scatter Memv + zz='Do '+Alltrim(FPROC)+' with m.deb,m.cred,M.DEBVAL,M.CREDVAL' + &zz +SELECT COM +Endscan + +SELECT com +LOCATE FOR INLIST(cont,'4426','4427') +IF !FOUND() + DO caut_neimpozab WITH 'actactan' +ENDIF + +m.NNIR=OZ.NNIR +If Type('OXSET')='O' + If !Empty(OXSET.LISTARE) + zz=Alltrim(OXSET.LISTARE) + zz='DO '+zz + If !Empty(OXSET.PARAM2) + zz=zz+' WITH '+OXSET.PARAM2 + Endif + &zz + Endif +Endif + +DO inchid_actcv +Do STERGE +Release OZ +Return 0 + + + + + +*----------------------------------------------- +Procedure _401 +Parameters debit,credit,VALDEBIT,VALCREDIT +&&&&&&&&&&& FURNIZOR + +Select FURNIZOR +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit + Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit +Endif +Unlock + +Local di,din,div +SELECT actactan +Sum SUMA To di For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount +Sum neimpozab To din For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount +Sum SUMA_2 To div For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount valuta + +&&&&&&&&&&&CUMPLUN +Local nui +Select cumplun +Set Order To nract +&&creditul=factura + +If credit!=0 OR din!=0 && discount neimpozabil + nui=.F. + Select ACTACTAN + Locate For SCC=m.CONT AND ascc=m.acont + Scatter NAME o401 + + Select cumplun + Seek o401.nract + If Found() + Locate For nract=o401.nract And dataact=o401.dataact And NUME=o401.NUME AND acont=o401.ascc + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Memv + Replace totctva With 0,SUMAVAL WITH 0 + Endif + Replace totctva With totctva+credit-di + Replace SUMAVAL With SUMAVAL+VALcredit-div + REPLACE cursschimb WITH o401.suma_3 + REPLACE ACONT WITH o401.ascc + Endif + Unlock +Endif + +RELEASE o401 +&&debitul=plata +If debit!=0 OR (credit=0 AND debit=0) && atunci cand sunt sume cu + si -, cu total 0 + nui=.F. + Select ACTACTAN + Locate For SCD=m.CONT AND ascd=m.acont + Scatter Memv + + Select cumplun + DO CASE + CASE !(COD=M.COD) AND !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_plati With 'cumplun','ascd','nume' + OTHERWISE + Select cumplun + If Flock() + Replace achitat With achitat+debit-di + Replace achitatVAL With achitatVAL+VALdebit-div + Endif + Unlock + ENDCASE +Endif + +Select cumplun +Set Order To Tag dataireg + +&&&&&&&&&&&CUMP + +*!* If credit!=0 OR din!=0 && discount neimpozabil + +*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* Select ACTACTAN +*!* Locate For SCC=m.CONT +*!* Scatter Memv +*!* Sum neimpozab To m.neimpozab For SCC=m.CONT AND ascc=m.acont +*!* m.neimpozab=m.neimpozab-din + +*!* * Sum SUMA To di For Left(SCC,1)='7' And SCD=m.CONT &&discount + +*!* m.totctva=credit-di +*!* +*!* * Sum suma To m.tvam For Left(scd,3)='442' AND SCC=m.CONT AND ascc=m.acont +*!* Select CONTURI +*!* Locate For Left(Cont,3)='442' +*!* If Found() +*!* m.tvam=DEB-CRED +*!* Endif + +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* ** m.totctva=m.totftvam+m.neimpozab+m.tvam + +*!* Select cump +*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME +*!* IF !FOUND() +*!* If Flock() +*!* Append Blank +*!* Gather Memv +*!* Endif +*!* UNLOCK +*!* ELSE +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* Endif + +Return + + +*----------------------------------------------- +Procedure _404 +Parameters debit,credit,VALDEBIT,VALCREDIT +Select FURNIZ404 +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit + Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit +Endif +UNLOCK + +Local di,din,div +SELECT actactan +Sum SUMA To di For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount +Sum neimpozab To din For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount +Sum SUMA_2 To div For Left(SCC,3)='767' And SCD=m.CONT AND ascd=m.acont &&discount valuta + +&&&&&&&&&&&CUMPLUN +Local nui +Select cumplun404 +Set Order To nract +&&creditul=factura +If credit!=0 OR din!=0 && discount neimpozabil + nui=.F. + Select ACTACTAN + Locate For SCC=m.CONT AND ascc=m.acont + *Scatter Memv + SCATTER NAME o404 + + Select cumplun404 + Seek o404.nract + If Found() + Locate For nract=o404.nract And dataact=o404.dataact And NUME=o404.NUME AND acont=o404.ascc + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Memv + GATHER NAME o404 + Replace totctva With 0,SUMAVAL WITH 0 + Endif + Replace totctva With totctva+credit-di + Replace SUMAVAL With SUMAVAL+VALcredit-div + REPLACE cursschimb WITH o404.suma_3 + REPLACE ACONT WITH o404.ascc + Endif + Unlock +Endif + +&&debitul=plata +If debit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For SCD=m.CONT AND ascd=m.acont + Scatter Memv + + Select cumplun404 + DO CASE + CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_plati With 'cumplun404','ascd','nume' + OTHERWISE + Select cumplun404 + If Flock() + Replace achitat With achitat+debit-di + Replace achitatVAL With achitatVAL+VALdebit-div + Endif + Unlock + ENDCASE +Endif + +Select cumplun404 +Set Order To Tag dataireg + +&&&&&&&&&&&CUMP + +*!* If credit!=0 OR din!=0 && discount neimpozabil + +*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* Select ACTACTAN +*!* Locate For SCC=m.CONT +*!* Scatter Memv +*!* Sum neimpozab To m.neimpozab For SCC=m.CONT +*!* m.neimpozab=m.neimpozab-din +*!* * Sum SUMA To di For Left(SCC,1)='7' And SCD=m.CONT &&discount + +*!* m.totctva=credit-di + +*!* Select CONTURI +*!* Locate For Left(Cont,3)='442' +*!* If Found() +*!* m.tvam=DEB-CRED +*!* Endif + +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* **m.totctva=m.totftvam+m.neimpozab+m.tvam + +*!* Select cump +*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME +*!* IF !FOUND() +*!* If Flock() +*!* Append Blank +*!* Gather Memv +*!* Endif +*!* UNLOCK +*!* ELSE +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* Endif + +RETURN + + +*----------------------------------------------- +PROCEDURE _4426 +Parameters debit,credit,VALDEBIT,VALCREDIT +Store 0 To m.totctvam,m.totftvam,m.tvam,neimpozab,totftvai,tvai + +SELECT infisiere +LOCATE FOR cont='4426' +SCATTER NAME ofis +lcCoresp_d=ALLTRIM(ofis.coresp_d) +lcCoresp_c=ALLTRIM(ofis.coresp_c) + + +SELECT actactan +SUM suma TO tvam_deb FOR scd='4426' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scc),&lcCoresp_d) +SUM suma TO tvam_cred FOR scc='4426' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scd),&lcCoresp_c) +m.tvam=tvam_deb-tvam_cred +SUM suma TO tvai_deb FOR scd='4426' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scc),&lcCoresp_d) +SUM suma TO tvai_cred FOR scc='4426' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scd),&lcCoresp_c) +m.tvai=tvai_deb-tvai_cred + + +IF debit#0 OR (credit=0 AND debit=0) + *m.tvam=debit-credit + + SELECT SUM(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),neimpozab,IIF(ALLTRIM(scc)='767' AND INLIST(ALLTRIM(scd),&lcCoresp_d),-neimpozab,0))) as neimpozab; + FROM actactan INTO CURSOR tcn + + SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),suma,IIF(ALLTRIM(scc)='767' AND INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0))) as totctvam; + FROM actactan WHERE proc_tva=m.ctvam ; + INTO CURSOR tvam + + SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),suma,IIF(ALLTRIM(scc)='767' AND INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0))) as totctvai; + FROM actactan WHERE proc_tva=m.ctvai ; + INTO CURSOR tvai + + SELECT tvam + SCATTER MEMVAR + SELECT tcn + SCATTER MEMVAR + SELECT tvai + SCATTER MEMVAR + + USE IN tvam + USE IN tcn + USE IN tvai + + m.totftvam=m.totctvam-m.tvam + m.totftvai=m.totctvai-m.tvai + m.totctva=m.totctvam+m.totctvai+m.neimpozab + + IF EMPTY(m.totctva) + RELEASE ofis + RELEASE o4426 + RETURN + ENDIF + + SELECT actactan + LOCATE FOR scd='4426' + IF !FOUND() OR scc='4428' + GO top + ENDIF + SCATTER NAME o4426 + o4426.scd=o4426.scc + + Select cump + Locate For nract=o4426.nract AND cod=o4426.cod &&And dataact=m.dataact And NUME=m.NUME + IF !FOUND() + If Flock() + Append Blank + Gather NAME o4426 + GATHER MEMVAR + Endif + UNLOCK + ELSE + REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; + tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ; + tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab + ENDIF +ENDIF + +IF credit#0 + *m.tvam=debit-credit + SELECT SUM(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),-neimpozab,0)) as neimpozab ; + FROM actactan INTO CURSOR tcn + + SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0)) as totctvam ; + FROM actactan WHERE proc_tva=m.ctvam; + INTO CURSOR tvam + + SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0)) as totctvai ; + FROM actactan WHERE proc_tva=m.ctvai ; + INTO CURSOR tvai + + SELECT tvam + SCATTER MEMVAR + SELECT tcn + SCATTER MEMVAR + SELECT tvai + SCATTER MEMVAR + + USE IN tvam + USE IN tcn + USE IN tvai + + m.totftvam=m.totctvam-m.tvam + m.totftvai=m.totctvai-m.tvai + m.totctva=m.totctvam+m.totctvai+m.neimpozab + + IF EMPTY(m.totctva) + RELEASE ofis + RELEASE o4426 + RETURN + ENDIF + + SELECT actactan + LOCATE FOR scc='4426' + SCATTER NAME o4426 + + + Select cump + Locate For nract=o4426.nract AND cod=o4426.cod &&And dataact=m.dataact And NUME=m.NUME + IF !FOUND() + If Flock() + Append Blank + Gather NAME o4426 + GATHER MEMVAR + Endif + UNLOCK + ELSE + REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; + tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ; + tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab + ENDIF +ENDIF + +RELEASE ofis +RELEASE o4426 +RETURN + +*----------------------------------------------- +Procedure _408 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select ana408 +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit + Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit +Endif +Unlock + + +SELECT DISTINCT scd as cont,ascd as acont,proc_tva,sum(suma) as suma408,sum(suma_2) as suma408_2,"D" as tip ; +from actactan WHERE scd='408 ' AND ascd=m.acont GROUP BY ascd,proc_tva INTO CURSOR t408 ; +UNION ; +SELECT DISTINCT scc as cont,ascc as acont,proc_tva,sum(suma) as suma408,sum(suma_2) as suma408_2,"C" as tip ; +from actactan WHERE scc='408 ' AND ascc=m.acont GROUP BY ascc,proc_tva; +order BY tip + +SELECT t408 +SCAN FOR tip='C' + SCATTER MEMVAR +&&&&&&&&&&& FACT408 +Local nui +Select fact408 +Set Order To nract + +Select fact408 +&&creditul=factura +*If credit!=0 + nui=.F. + Select ACTACTAN + Locate For SCC=m.CONT AND ascc=m.acont AND proc_tva=m.proc_tva + Scatter Memv + + Select fact408 + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont AND proc_tva=m.proc_tva + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Memv + Replace totctva With 0 + Replace SUMAVAL With 0 + Endif + + Select fact408 + Replace totctva With totctva+m.suma408 &&credit + Replace SUMAVAL With SUMAVAL+m.suma408_2 &&VALcredit + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascc + ENDIF + Unlock +*Endif +ENDSCAN +&&debitul=plata + +If debit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For SCD=m.CONT AND ascd=m.acont + Scatter Memv + + Select fact408 + If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_plati With 'fact408','ascd','nume' + Else + Select fact408 + If Flock() + Replace achitat With achitat+debit + Replace achitatVAL With achitatVAL+VALdebit + Endif + Unlock + Endif +Endif + +Select fact408 +Set Order To Tag dataireg + +&&&&&&&&&&&CUMP + +*!* LOCAL di +*!* If credit!=0 +*!* +*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* Select ACTACTAN +*!* Locate For SCC=m.CONT +*!* Scatter Memv +*!* Sum neimpozab To m.neimpozab For SCC=m.CONT +*!* SUM suma TO di FOR LEFT(scc,1)='7' AND SCd=m.CONT&&discount + +*!* m.totctva=credit-di + +*!* Select CONTURI +*!* Locate For LEFT(Cont,3)='442' +*!* If Found() +*!* m.tvam=DEB-cred +*!* Endif + +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam + +*!* Select cump +*!* If Flock() +*!* Append Blank +*!* Gather Memv +*!* Endif +*!* Unlock +*!* Endif + +Return + + + + +*------------------------------------------------------------- +Procedure _409 +Parameters debit,credit,VALDEBIT,VALCREDIT +Select AVANS409 +If debit#0 + If Flock() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME + If !Found() + Append Blank + Gather Fields Except achitat,facturat,achitatval,factval Memv + Endif + Replace achitat With achitat+debit &&, facturat With facturat+credit + Replace achitatVAL With achitatVAL+VALdebit + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascd + Endif + Unlock +ENDIF + +If credit#0 +*!* If Used('actcv1') +*!* Select actcv1 +*!* Scan For ALES +*!* Scatter Name av +*!* Select AVANS409 +*!* Locate For nract=av.nract And dataact=av.dataact And NUME=av.NUME +*!* If Flock() +*!* Replace facturat With facturat+av.sumaachi +*!* Replace factVAL With factVAL+av.sumaachi2 +*!* Endif +*!* Unlock +*!* Select actcv1 +*!* ENDSCAN +*!* Release av +*!* ELSE &&la modificare + SELECT actactan + LOCATE FOR LEFT(scc,3)='409' + SCATTER NAME omodif +*!* lcDat=Right(Allt(omodif.NRORD),10) +*!* ldDAT=Ctod(lcDat) +*!* lcNr=Strtran(Strtran(omodif.NRORD,lcDat,''),'/','') +*!* lnNr=Val(lcNr) + Select AVANS409 + Locate For nract=omodif.pereche2 And NUME=omodif.NUME + IF FOUND() + If Flock() + Replace facturat With facturat+CREDIT + Replace factVAL With factVAL+valCREDIT + Endif + UNLOCK + ENDIF + Release omodif +*!* ENDIF +*!* +Endif + + +Select FURNIZOR +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace avans With avans+debit-credit + Replace avansVAL With avansVAL+VALdebit-VALcredit +Endif +Unlock +IF USED('actcv1') + USE IN actcv1 +ENDIF +Return + +*----------------------------------------------- +Procedure _411 +Parameters debit,credit,VALDEBIT,VALCREDIT +Select clienti + +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace productie With productie +debit, incasat With incasat+credit + Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit +Endif +UNLOCK + + +IF id_set=10421 + DO regularizare_clienti + IF USED('actcv') + USE IN actcv + ENDIF + RETURN +ENDIF + +Local di,din,div +SELECT actactan +Sum SUMA To di For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount +Sum neimpozab To din For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount +Sum SUMA_2 To div For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount valuta + +&&&&&&&&&&&vanzLUN +Local nui +Select vanzlun +Set Order To nract +&&debitul=factura +If (debit!=0 OR din!=0) &&AND xsets.id_set!=10421 && discount neimpozabil + regularizari avans-facturi(e uraaaaaaaaaaaaaaaaaat) + nui=.F. + Select ACTACTAN + Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont + Scatter Memv + +*!* IF m.ctvam#m.ctvai +*!* SUM suma TO m.totftvam FOR Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont AND proc_tva=m.ctvam +*!* SUM suma TO m.tvam FOR SCc='4427' AND ascd=m.acont AND proc_tva=m.ctvam +*!* SUM suma TO m.totftvai FOR Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont AND proc_tva=m.ctvai +*!* SUM suma TO m.tvai FOR SCc='4427' AND ascd=m.acont AND proc_tva=m.ctvai +*!* SUM suma TO m.neimpozab FOR Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont AND neimpozab#0 +*!* ENDIF + + Select vanzlun + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + ENDIF + + If Flock() + If nui + Append Blank + Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv + ENDIF + + Replace totctva With totctva+debit-di + Replace SUMAVAL With SUMAVAL+VALdebit-div +*!* REPLACE totftvam WITH totftvam+m.totftvam-di,totftvai WITH totftvai+m.totftvai-di,tvam WITH tvam+m.tvam,tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascd + Endif + Unlock +Endif + + +&&creditul=plata +If credit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont + Scatter Memv + Select vanzlun + DO CASE + CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_incasari With 'vanzlun','ascc','nume' + OTHERWISE + Select vanzlun + If Flock() + Replace achitat With achitat+credit-di + Replace achitatVAL With achitatVAL+VALcredit-div + Endif + Unlock + ENDCASE + +Endif + +Select vanzlun +Set Order To Tag dataireg + +&&&&&&&&&&&vanz + +*!* If debit!=0 OR din!=0 && discount neimpozabil +*!* m.totctva=debit-di +*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* Select ACTACTAN +*!* Locate For SCD=m.CONT +*!* Scatter Memv +*!* Sum neimpozab To m.neimpozab For Left(SCD,3)=Left(m.CONT,3) +*!* m.neimpozab=m.neimpozab-din + +*!* Select CONTURI +*!* Locate For Cont='4427' +*!* If Found() +*!* m.tvam=CRED +*!* Endif + +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam + +*!* Select vanz +*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME +*!* IF !FOUND() +*!* If Flock() +*!* Append Blank +*!* Gather Memv +*!* Endif +*!* UNLOCK +*!* ELSE +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* Endif + +Return + + +*----------------------------------------------- + +PROCEDURE _4427 +Parameters debit,credit,VALDEBIT,VALCREDIT +Store 0 To m.totctvam,m.totftvam,m.tvam,m.neimpozab,m.totftvai,m.tvai + +SELECT infisiere +LOCATE FOR cont='4427' +SCATTER NAME ofis +lcCoresp_c=ALLTRIM(ofis.coresp_c) +lcCoresp_d=ALLTRIM(ofis.coresp_d) + +SELECT actactan +SUM suma TO tvam_deb FOR scd='4427' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scc),&lcCoresp_d) +SUM suma TO tvam_cred FOR scc='4427' AND proc_tva=m.ctvam AND INLIST(ALLTRIM(scd),&lcCoresp_c) +m.tvam=tvam_cred-tvam_deb +SUM suma TO tvai_deb FOR scd='4427' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scc),&lcCoresp_d) +SUM suma TO tvai_cred FOR scc='4427' AND proc_tva=m.ctvai AND INLIST(ALLTRIM(scd),&lcCoresp_c) +m.tvai=tvai_cred-tvai_deb + + +IF credit#0 OR (credit=0 AND debit=0) + SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),neimpozab,IIF(ALLTRIM(scd)='667' AND INLIST(ALLTRIM(scc),&lcCoresp_c),-neimpozab,0))) as neimpozab ; + FROM ACTACTAN INTO CURSOR tcn + + SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),suma,IIF(ALLTRIM(scd)='667' AND INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0))) as totctvam; + FROM actactan WHERE proc_tva=m.ctvam ; + INTO CURSOR tvam + + SELECT sum(IIF(INLIST(ALLTRIM(scd),&lcCoresp_c) AND !INLIST(ALLTRIM(scc),&lcCoresp_c),suma,IIF(ALLTRIM(scd)='667' AND INLIST(ALLTRIM(scc),&lcCoresp_c),-suma,0))) as totctvai; + FROM actactan WHERE proc_tva=m.ctvai ; + INTO CURSOR tvai + + SELECT tvam + SCATTER MEMVAR + SELECT tcn + SCATTER MEMVAR + SELECT tvai + SCATTER MEMVAR + + USE IN tvam + USE IN tcn + USE IN tvai + + m.totftvam=m.totctvam-m.tvam + m.totftvai=m.totctvai-m.tvai + m.totctva=m.totctvam+m.totctvai+m.neimpozab + + IF EMPTY(m.totctva) + RELEASE ofis + RETURN + ENDIF + + SELECT actactan + LOCATE FOR scc='4427' + IF !FOUND() OR scd='4428' + GO top + ENDIF + SCATTER FIELDS EXCEPT neimpozab MEMVAR + + Select vanz + Locate For nract=m.nract AND cod=m.cod &&And dataact=m.dataact And NUME=m.NUME + IF !FOUND() + If Flock() + Append Blank + Gather Memv + Endif + UNLOCK + ELSE + REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; + tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ; + tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab + ENDIF +ENDIF + +IF debit#0 +*!* SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0)) as totctva,; +*!* sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-neimpozab,0)) as neimpozab ; +*!* FROM actactan ; +*!* INTO CURSOR tva +*!* +*!* SELECT tva +*!* SCATTER MEMVAR +*!* m.tvam=credit-debit +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam + + SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-neimpozab,0)) as neimpozab ; + FROM actactan INTO CURSOR tcn + + SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0)) as totctvam ; + FROM actactan WHERE proc_tva=m.ctvam ; + INTO CURSOR tvam + + SELECT sum(IIF(INLIST(ALLTRIM(scc),&lcCoresp_d) AND !INLIST(ALLTRIM(scd),&lcCoresp_d),-suma,0)) as totctvai ; + FROM actactan WHERE proc_tva=m.ctvai ; + INTO CURSOR tvai + + SELECT tvam + SCATTER MEMVAR + SELECT tcn + SCATTER MEMVAR + SELECT tvai + SCATTER MEMVAR + + USE IN tvam + USE IN tcn + USE IN tvai + + m.totftvam=m.totctvam-m.tvam + m.totftvai=m.totctvai-m.tvai + m.totctva=m.totctvam+m.totctvai+m.neimpozab + + IF EMPTY(m.totctva) + RELEASE ofis + RETURN + ENDIF + + SELECT actactan + LOCATE FOR scd='4427' + SCATTER FIELDS EXCEPT neimpozab MEMVAR + m.scd=m.scc + + Select vanz + Locate For nract=m.nract AND cod=m.cod &&And dataact=m.dataact And NUME=m.NUME + IF !FOUND() + If Flock() + Append Blank + Gather Memv + Endif + UNLOCK + ELSE + REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; + tvam WITH tvam+m.tvam,totftvai WITH totftvai+m.totftvai, ; + tvai WITH tvai+m.tvai,neimpozab WITH neimpozab+m.neimpozab + ENDIF +ENDIF + + + +RELEASE ofis +RETURN +*---------------------------------------------------------------- + +Procedure _4118 +Parameters debit,credit,VALDEBIT,VALCREDIT +Select client4118 + +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace productie With productie +debit, incasat With incasat+credit + Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit +Endif +Unlock + +&&&&&&&&&&&vanzLU4118 +Local nui +Select vanzlu4118 +Set Order To nract +&&debitul=factura +If debit!=0 + nui=.F. + Select ACTACTAN + Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont + Scatter Memv + + Select vanzlu4118 + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv + Endif + Replace totctva With totctva+debit + Replace SUMAVAL With SUMAVAL+VALdebit + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascd + Endif + Unlock +Endif + + + +&&creditul=plata +If credit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont + Scatter Memv + Select vanzlu4118 + If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_incasari With 'vanzlu4118','ascc','nume' + Else + Select vanzlu4118 + If Flock() + Replace achitat With achitat+credit + Replace achitatVAL With achitatVAL+VALcredit + Endif + Unlock + Endif + +Endif + + +Select vanzlu4118 +Set Order To Tag dataireg + +&&&&&&&&&&&vanz + +*!* if debit!=0 +*!* SELECT vanz +*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME +*!* If Found() +*!* IF FLOCK() +*!* REPLACE scd WITH m.cont +*!* ENDIF +*!* ENDIF + +*!* *!* m.totctva=debit +*!* *!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* *!* Select ACTACTAN +*!* *!* Locate For SCD=m.CONT +*!* *!* Scatter Memv +*!* *!* Sum neimpozab To m.neimpozab For Left(SCC,3)=Left(m.CONT,3) + + +*!* *!* Select CONTURI +*!* *!* Locate For Cont='4427' +*!* *!* If Found() +*!* *!* m.tvam=CRED +*!* *!* Endif + +*!* *!* m.totftvam=m.totctva-m.neimpozab-m.tvam + +*!* *!* Select vanz +*!* *!* If Flock() +*!* *!* Append Blank +*!* *!* Gather Memv +*!* *!* Endif +*!* *!* Unlock +*!* Endif + + +RETURN + +*----------------------------------------------- +Procedure _418 +Parameters debit,credit,VALDEBIT,VALCREDIT +Select ana418 + +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace productie With productie +debit, incasat With incasat+credit + Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit +Endif +Unlock + +*!* &&&&&&&&&&&vanzLUN +*!* Local nui +*!* Select fact418 +*!* Set Order To nract +*!* &&debitul=factura +*!* If debit!=0 +*!* nui=.F. +*!* Select ACTACTAN +*!* Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont +*!* Scatter Memv + +*!* Select fact418 +*!* Seek m.nract +*!* If Found() +*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont +*!* If !Found() +*!* nui=.T. +*!* Endif +*!* Else +*!* nui=.T. +*!* Endif +*!* If Flock() +*!* If nui +*!* Append Blank +*!* Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv +*!* Endif +*!* Replace totctva With totctva+debit +*!* Replace SUMAVAL With SUMAVAL+VALdebit +*!* REPLACE cursschimb WITH m.suma_3 +*!* REPLACE ACONT WITH m.ascd +*!* Endif +*!* Unlock +*!* Endif + + +SELECT DISTINCT scd as cont,ascd as acont,proc_tva,sum(suma) as suma418,sum(suma_2) as suma418_2,"D" as tip ; +from actactan WHERE scd='418 ' AND ascd=m.acont GROUP BY ascd,proc_tva INTO CURSOR t418 ; +UNION ; +SELECT DISTINCT scc as cont,ascc as acont,proc_tva,sum(suma) as suma418,sum(suma_2) as suma418_2,"C" as tip ; +from actactan WHERE scc='418 ' AND ascc=m.acont GROUP BY ascc,proc_tva; +order BY tip + +&&&&&&&&&&& FACT418 +SELECT t418 +SCAN FOR tip='D' + SCATTER MEMVAR + Local nui + Select fact418 + Set Order To nract + + Select fact418 + nui=.F. + Select ACTACTAN + Locate For SCD=m.CONT AND ascd=m.acont AND proc_tva=m.proc_tva + Scatter Memv + + Select fact418 + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont AND proc_tva=m.proc_tva + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Memv + Replace totctva With 0 + Replace SUMAVAL With 0 + Endif + + Select fact418 + Replace totctva With totctva+m.suma418 &&credit + Replace SUMAVAL With SUMAVAL+m.suma418_2 &&VALcredit + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascd + ENDIF + UNLOCK +ENDSCAN +&&creditul=plata +If credit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont + Scatter Memv + Select fact418 + If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_incasari With 'fact418','ascc','nume' + Else + Select fact418 + If Flock() + Replace achitat With achitat+credit + Replace achitatVAL With achitatVAL+VALcredit + Endif + Unlock + Endif + +Endif + + +Select fact418 +Set Order To Tag dataireg + +Return + +*----------------------------------------------- +Procedure _461 +Parameters Tndebit,Tncredit,TnVALDEBIT,TnVALCREDIT +Select debitor + +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace DEBIT With DEBIT+tndebit, CREDIT With CREDIT+tncredit + Replace VALDEBIT With VALDEBIT +tnVALdebit, VALCREDIT With VALCREDIT+tnVALcredit +Endif +UNLOCK + +LOCAL di,din +SELECT actactan +Sum SUMA To di For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount +Sum neimpozab To din For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount +Sum SUMA_2 To div For Left(SCd,3)='667' And SCc=m.CONT AND ascc=m.acont &&discount valuta + +&&&&&&&&&&&vanzLUN +Local nui +Select deblun +Set Order To nract +&&debitul=factura +If tndebit!=0 + nui=.F. + Select ACTACTAN + Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont + Scatter Memv + + Select deblun + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv + ENDIF + Replace totctva With totctva+TnDebit-di + Replace SUMAVAL With SUMAVAL+TnVALdebit-div + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascd + Endif + Unlock +Endif + + + +&&creditul=plata +If tnCredit!=0 OR (tnCredit=0 AND tnDebit=0) + nui=.F. + Select ACTACTAN + Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont + Scatter Memv + Select deblun + DO CASE + CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_incasari With 'deblun','ascc','nume' + OTHERWISE + Select deblun + If Flock() + Replace achitat With achitat+tnCredit-di + Replace achitatVAL With achitatVAL+TnVALcredit-div + Endif + Unlock + ENDCASE + +Endif + + +Select deblun +Set Order To Tag dataireg + +&&&&&&&&&&&vanz + +*!* If tnDebit!=0 OR din!=0 && discount neimpozabil +*!* m.totctva=tndebit-di +*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* Select ACTACTAN +*!* Locate For SCD=m.CONT +*!* Scatter Memv +*!* Sum neimpozab To m.neimpozab For Left(SCD,3)=Left(m.CONT,3) +*!* m.neimpozab=m.neimpozab-din + +*!* Select CONTURI +*!* Locate For Cont='4427' +*!* If Found() +*!* m.tvam=CRED +*!* Endif + +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam + +*!* Select vanz +*!* Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME +*!* IF !FOUND() +*!* If Flock() +*!* Append Blank +*!* Gather Memv +*!* Endif +*!* UNLOCK +*!* ELSE +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* Endif + + +Return +*----------------------------------------------- +Procedure _462 +Parameters Tndebit,Tncredit,TnVALDEBIT,TnVALCREDIT +Select CREDITOR + +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace DEBIT With DEBIT+tndebit, CREDIT With CREDIT+tncredit + Replace VALDEBIT With VALDEBIT +tnVALdebit, VALCREDIT With VALCREDIT+tnVALcredit +Endif +UNLOCK + +&&&&&&&&&&&CREDLUN +Local nui +Select CREDlun +Set Order To nract +&&creditul=factura +If TNcredit!=0 + nui=.F. + Select ACTACTAN + Locate For SCC=m.CONT AND ascc=m.acont + Scatter Memv + + Select CREDlun + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Fields Except totctva Memv + Endif + Replace totctva With totctva+TNcredit + Replace SUMAVAL With SUMAVAL+TnVALcredit + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascc + Endif + Unlock +Endif + + +&&debitul=plata +If TNdebit!=0 OR (TNcredit=0 AND TNdebit=0) + nui=.F. + Select ACTACTAN + Locate For SCD=m.CONT AND ascd=m.acont + Scatter Memv + + Select CREDlun + DO CASE + CASE !(COD=M.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_plati With 'CREDlun','ascd','nume' + OTHERWISE + Select CREDlun + If Flock() + Replace achitat With achitat+TNdebit + Replace achitatVAL With achitatVAL+TnVALdebit + Endif + Unlock + ENDCASE +Endif + +Select CREDlun +Set Order To Tag dataireg + +&&&&&&&&&&& CUMP NU STIU ???????????????? + +*!* Local di +*!* If credit!=0 + +*!* Store 0 To m.totftvam,m.tvam,neimpozab,totftvai,tvai + +*!* Select ACTACTAN +*!* Locate For SCC=m.CONT +*!* Scatter Memv +*!* Sum neimpozab To m.neimpozab For SCC=m.CONT +*!* Sum SUMA To di For Left(SCC,1)='7' And SCD=m.CONT&&discount + +*!* m.totctva=credit-di + +*!* Select CONTURI +*!* Locate For Left(Cont,3)='442' +*!* If Found() +*!* m.tvam=DEB-CRED +*!* Endif + + +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* *m.totctva=m.totftvam+m.neimpozab+m.tvam + +*!* Select cump +*!* If Flock() +*!* Append Blank +*!* Gather Memv +*!* Endif +*!* Unlock +*!* Endif + +Return + + +*----------------------------------------------- +Procedure _419 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select AVANS419 +If credit#0 + If Flock() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME + If !Found() + Append Blank + Gather Fields Except achitat,facturat,achitatval,factval Memv + Endif + Replace achitat With achitat+credit &&, facturat With facturat+credit + Replace achitatVAL With achitatVAL+VALcredit + REPLACE cursschimb WITH m.suma_3 + REPLACE ACONT WITH m.ascc + Endif + Unlock +Endif +If debit#0 +*!* If Used('actcv1') +*!* Select actcv1 +*!* Scan For ALES +*!* Scatter Name av +*!* Select AVANS419 +*!* Locate For nract=av.nract And dataact=av.dataact And NUME=av.NUME +*!* If Flock() +*!* Replace facturat With facturat+av.sumaachi +*!* Replace factVAL With factVAL+av.sumaachi2 +*!* Endif +*!* Unlock +*!* Select actcv1 +*!* Endscan +*!* Release av +*!* ELSE &&la modificare + SELECT actactan + LOCATE FOR LEFT(scd,3)='419' + SCATTER NAME omodif +*!* lcDat=Right(Allt(omodif.NRORD),10) +*!* ldDAT=Ctod(lcDat) +*!* lcNr=Strtran(Strtran(omodif.NRORD,lcDat,''),'/','') +*!* lnNr=Val(lcNr) + Select AVANS419 + Locate For nract=omodif.pereche And NUME=omodif.NUME + IF FOUND() + If Flock() + Replace facturat With facturat+debit + Replace factVAL With factVAL+valdebit + Endif + UNLOCK + ENDIF + Release omodif +*!* Endif +Endif + + +Select clienti +If Flock() + If Alltrim(NUME)!=Alltrim(M.NUME) + Seek Alltrim(M.NUME) + If !Found() + Append Blank + Gather Fields NUME,COD_FISCAL Memv + Endif + Endif + Replace avans With avans-debit+credit + Replace avansVAL With avansVAL-VALdebit+VALcredit +Endif +Unlock + +DO inchid_actcv + +Return + +*----------------------------------------------- +Procedure _5311 +Parameters debit,credit,VALDEBIT,VALCREDIT +STORE 0 TO m.plati,m.incasari + +&&credit=casa plateste + +IF CREDIT#0 + Select ACTACTAN + Locate For SCC=m.CONT + Scatter Memv + *m.casa=m.CASACRED + m.casa=ALLTRIM(m.nume_3) + + Select casa + If Flock() + Append Blank + Gather Memv + Replace plati With credit + Endif + Unlock + + Select casanume + *Locate For casa=m.casaCRED + Locate For ALLTRIM(casa)=m.casa + If Flock() + If !Found() + Append Blank + *Gather Fields casa Memv + REPLACE CASA WITH M.CASA + Endif + Replace plati With plati+credit + Endif + Unlock +ENDIF + +&&debit=casa incas +IF DEBIT#0 + Select ACTACTAN + Locate For SCD=m.CONT + Scatter Memv + *m.casa=m.CASADEB + m.casa=ALLTRIM(m.nume_3) + + Select casa + If Flock() + Append Blank + Gather Memv + Replace incasari With debit + Endif + Unlock + + Select casanume + Locate For ALLTRIM(casa)=m.casa + If Flock() + If !Found() + Append Blank + *Gather Fields casa Memv + REPLACE CASA WITH M.CASA + Endif + Replace incasari With incasari+debit + Endif + Unlock +ENDIF + + +Return + +*----------------------------------------------- +Procedure _5314 +Parameters debit,credit,VALDEBIT,VALCREDIT + +STORE 0 TO m.plati,m.incasari,m.platival,m.incasval + +&&credit=casa plateste +IF CREDIT#0 + IF EMPTY(M.CASAVALCRE) && pt modificare + Select ACTACTAN + Locate For SCC=m.CONT + M.CASAVALCRE=nume_5 + ENDIF + Select casVnume + Locate For NUME_5=M.CASAVALCRE + If Flock() + If !Found() + Append Blank + REPLACE NUME_5 WITH M.CASAVALCRE + *Gather Fields NUME_5 Memv + Endif + Replace plati With plati+credit + Replace platiVAL With platiVAL+VALcredit + REPLACE numeval WITH m.nume_4 + Endif + UNLOCK + + Select ACTACTAN + SCAN For SCC=m.CONT && din cauza diferentelor de curs valutar + Scatter Memv + *m.casa=m.nume_5 + M.CASA=M.CASAVALCRE + Select casaVAL + If Flock() + Append Blank + Gather Memv + Replace plati With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4 + Replace platiVAL With m.suma_2 + Endif + UNLOCK + SELECT actactan + ENDSCAN +ENDIF + +&&debit=casa incas +IF DEBIT#0 + IF EMPTY(M.CASAVALDEB) && pt modificare + Select ACTACTAN + Locate For SCD=m.CONT + M.CASAVALDEB=nume_5 + ENDIF + + Select casVnume + Locate For NUME_5=m.CASAVALDEB + SELECT casvnume + If Flock() + If !Found() + Append Blank + *Gather Fields NUME_5 Memv + REPLACE NUME_5 WITH m.CASAVALDEB + Endif + Replace incasari With incasari+debit + Replace incasVAL With incasVAL+VALdebit + REPLACE numeval WITH m.nume_4 + Endif + UNLOCK + + Select ACTACTAN + SCAN For SCD=m.CONT && din cauza diferentelor de curs valutar + Scatter Memv + *m.casa=m.nume_5 + M.CASA=m.CASAVALDEB + + Select casaVAL + If Flock() + Append Blank + Gather Memv + Replace incasari With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4 + Replace incasVAL With m.suma_2 + Endif + UNLOCK + + SELECT actactan + ENDSCAN +ENDIF +Return + +*----------------------------------------------- +Procedure _5121 +Parameters debit,credit,VALDEBIT,VALCREDIT + +STORE 0 TO m.plati,m.incasari + +&&credit=banca plateste +IF CREDIT#0 + Select ACTACTAN + Locate For SCC=m.CONT + Scatter Memv + m.BANCACRED=ALLTRIM(m.nume_2) + m.banca=m.BANCACRED + + Select banca + If Flock() + Append Blank + Gather Memv + Replace plati With credit + Endif + Unlock + + Select bannume + Locate For ALLTRIM(nume_2)=m.bancaCRED + If Flock() + If !Found() + Append Blank + *Gather Fields nume_2 Memv + REPLACE NUME_2 WITH M.BANCACRED + Endif + Replace plati With plati+credit + Endif + Unlock +ENDIF + +&&debit=banca incas +IF DEBIT#0 + Select ACTACTAN + Locate For SCD=m.CONT + Scatter Memv + m.bancadeb=ALLTRIM(m.nume_2) + m.banca=m.BANCADEB + + Select banca + If Flock() + Append Blank + Gather Memv + Replace incasari With debit + Endif + Unlock + + Select bannume + Locate For ALLTRIM(nume_2)=m.bancaDEB + If Flock() + If !Found() + Append Blank + *Gather Fields nume_2 Memv + REPLACE NUME_2 WITH m.bancaDEB + Endif + Replace incasari With incasari+debit + Endif + Unlock +ENDIF + +Return + +*----------------------------------------------- +Procedure _5124 +Parameters debit,credit,VALDEBIT,VALCREDIT + +STORE 0 TO m.plati,m.incasari,m.platival,m.incasval + +&&credit=banca plateste +IF CREDIT#0 + IF EMPTY(m.banvalcred) && pt modificare + Select ACTACTAN + Locate For SCC=m.CONT + m.BANVALCRED=nume_3 + ENDIF + + Select banVnume + Locate For nume_3=m.BANVALCRED + If Flock() + If !Found() + Append Blank + *Gather Fields nume_3 Memv + REPLACE NUME_3 WITH m.BANVALCRED + Endif + Replace plati With plati+credit + Replace platiVAL With platiVAL+VALcredit + REPLACE numeval WITH m.nume_4 + Endif + UNLOCK + + Select ACTACTAN + SCAN For SCC=m.CONT && din cauza diferentelor de curs valutar + Scatter Memv + m.banca=m.BANVALCRED + + Select bancaVAL + If Flock() + Append Blank + Gather Memv + Replace plati With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4 + Replace platiVAL With m.suma_2 + Endif + UNLOCK + Select ACTACTAN + ENDSCAN +ENDIF + +&&debit=banca incas +IF DEBIT#0 + IF EMPTY(m.banvaldeb) && pt modificare + Select ACTACTAN + Locate For SCD=m.CONT + m.BANVALDEB=nume_3 + ENDIF + + Select banVnume + Locate For nume_3=m.BANVALDEB + If Flock() + If !Found() + Append Blank + *Gather Fields nume_3 Memv + REPLACE NUME_3 WITH m.BANVALDEB + Endif + Replace incasari With incasari+debit + Replace incasVAL With incasVAL+VALdebit + REPLACE numeval WITH m.nume_4 + Endif + UNLOCK + + + Select ACTACTAN + SCAN For SCD=m.CONT && din cauza diferentelor de curs valutar + Scatter Memv + m.banca=m.BANVALDEB + + Select bancaVAL + If Flock() + Append Blank + Gather Memv + Replace incasari With m.suma,cursschimb WITH m.suma_3,numeval WITH m.nume_4 + Replace incasVAL With m.suma_2 + Endif + UNLOCK + Select ACTACTAN + ENDSCAN +ENDIF +Return + + + +*----------------------------------------------- +Procedure _542 +Parameters Tndebit,Tncredit,TnVALDEBIT,TnVALCREDIT + + +Select achit542 +If Flock() + If Alltrim(NUME_2)!=Alltrim(M.NUME_2) + Seek Alltrim(M.NUME_2) + If !Found() + Append Blank + Gather Fields NUME_2,COD_FISCAL Memv + Endif + Endif + Replace DEBIT With DEBIT+tndebit, CREDIT With CREDIT+tncredit + Replace VALDEBIT With VALDEBIT +tnVALdebit, VALCREDIT With VALCREDIT+tnVALcredit +Endif +UNLOCK + + +&&&&&&&&&&& achiLUN +Local nui +Select achilun +Set Order To nract +&&debitul=factura +If tndebit!=0 + nui=.F. + Select ACTACTAN + Locate For Left(SCD,3)=Left(m.CONT,3) AND ascd=m.acont + Scatter Memv + + Select achilun + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME_2 AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Fields Except achitat,totctva,ACHITATVAL,SUMAVAL Memv + ENDIF + Replace totctva With totctva+TnDebit + Replace SUMAVAL With SUMAVAL+TnVALdebit + REPLACE cursschimb WITH m.suma_3 + REPLACE nume WITH m.nume_2 + REPLACE ACONT WITH m.ascd + Endif + Unlock +Endif + + + +&&creditul=plata +If tnCredit!=0 OR (tnCredit=0 AND tnDebit=0) + nui=.F. + Select ACTACTAN + Locate For Left(SCC,3)=Left(m.CONT,3) AND ascc=m.acont + Scatter Memv + Select achilun +*!* DO CASE +*!* CASE !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_incasari With 'achilun','ascc','nume_2' +*!* OTHERWISE +*!* Select achilun +*!* If Flock() +*!* Replace achitat With achitat+tnCredit +*!* Replace achitatVAL With achitatVAL+TnVALcredit +*!* Endif +*!* Unlock +*!* ENDCASE + +Endif + + +Select achilun +Set Order To Tag dataireg + +*!* Parameters debit,credit,VALDEBIT,VALCREDIT +*!* &&&&&&&&&&& achit542 +*!* Select ACTACTAN +*!* Locate For SCC=m.CONT Or SCD=m.CONT +*!* Scatter Fields nume_2 Memv + +*!* Select achit542 +*!* If Flock() +*!* If Upper(Alltrim(nume_2))!=Upper(Alltrim(M.nume_2)) +*!* Seek Upper(Alltrim(M.nume_2)) +*!* If !Found() +*!* Append Blank +*!* Gather Fields nume_2 Memv +*!* Endif +*!* Endif +*!* Replace dat With dat+credit, luat With luat+debit +*!* Endif +*!* Unlock +Endproc +*----------------------------------------------- +Procedure _455 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select actionar +If Flock() + If Upper(Alltrim(nume_2))!=Upper(Alltrim(M.nume_2)) + Seek Upper(Alltrim(M.nume_2)) + If !Found() + Append Blank + Gather Fields nume_2 Memv + Endif + Endif + Replace dat With dat+debit, luat With luat+credit +Endif +Unlock +Endproc + + +*-------------------------------------------------------- +Procedure _471 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Local nui +Select chavans +Set Order To nract + +Select chavans + +If debit!=0 + nui=.F. + Select ACTACTAN + Locate For SCD=m.CONT AND ascd=m.acont + Scatter Memv + Select chavans + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Memv + Replace totctva With 0 + Endif + + Select chavans + Replace totctva With totctva+debit + Endif + Unlock +Endif + +&&debitul=plata +If credit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For SCC=m.CONT AND ascc=m.acont + Scatter Memv + Select chavans + If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_incasari With 'chavans','ascc','nume' + ELSE + Select chavans + * LOCATE FOR ALLTRIM(nume)=ALLTRIM(m.nume) AND ALLTRIM(dst_chlt)=ALLTRIM(m.dst_chlt) + * IF FOUND() + If Flock() + Replace achitat With achitat+credit + Endif + UNLOCK + * ENDIF + Endif +Endif + +Select chavans +Set Order To Tag dataireg +Endproc + +*-------------------------------------------------------- + +Procedure _472 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Local nui +Select vnavans +Set Order To nract + +Select vnavans + +If credit!=0 + nui=.F. + Select ACTACTAN + Locate For SCc=m.CONT AND ascc=m.acont + Scatter Memv + Select vnavans + Seek m.nract + If Found() + Locate For nract=m.nract And dataact=m.dataact And NUME=m.NUME AND acont=m.acont + If !Found() + nui=.T. + Endif + Else + nui=.T. + Endif + If Flock() + If nui + Append Blank + Gather Memv + Replace totctva With 0 + Endif + + Select vnavans + Replace totctva With totctva+credit + Endif + Unlock +Endif + +&&debitul=plata +If debit!=0 OR (credit=0 AND debit=0) + nui=.F. + Select ACTACTAN + Locate For SCC=m.CONT AND ascd=m.acont + Scatter Memv + Select vnavans + If !(COD=m.COD) And !Empty(XSETS.frm_plata) &&daca plata nu e cuplata cu factura + Do trezorerie_plati With 'vnavans','ascd','nume' + ELSE + Select vnavans + * LOCATE FOR ALLTRIM(nume)=ALLTRIM(m.nume) AND ALLTRIM(dst_chlt)=ALLTRIM(m.dst_chlt) + * IF FOUND() + If Flock() + Replace achitat With achitat+credit + Endif + UNLOCK + * ENDIF + Endif +Endif + +Select vnavans +Set Order To Tag dataireg +ENDPROC + +*----------------------------------------------------------------- +Procedure _5112 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select ACTACTAN +Locate For SCD=m.CONT Or SCC=m.CONT +Scatter Memv + +Select cecnume +If Flock() + If Upper(Alltrim(cec))!=Upper(Alltrim(M.explicatia)) + Seek Upper(Alltrim(M.explicatia)) + If !Found() + Append Blank + Replace cec With m.explicatia + Endif + Endif + Replace incarcat With incarcat+debit,plati With plati+credit +Endif +Unlock +Sele cec +If Flock() + Go Bottom + Appe Blank + m.plati=credit + m.incarcat=debit + Gather Memvar +Endif +Unlock +Endproc +*-------------------------------------------------------- + +*!* PROCEDURE _667 +*!* PARAMETERS debit,credit,valdebit,valcredit + +*!* SELECT actactan +*!* LOCATE FOR scd=m.cont +*!* lcScc=scc +*!* SELECT infisiere +*!* LOCATE FOR cont=lcScc +*!* SCATTER NAME ofis +*!* SELECT (ofis.fisier) + +*!* ENDPROC + + + +Procedure SCRIE_NIR + +DD=Datetime() +Select INTRARI +Replace All COD With M.COD +Replace All UTIL With UTILIZATOR +Replace All DATAORA With DD +Do INRULAJMAGAZII +Do INSTOCURIMAGAZII +Return + + +*-------------------------------------------------------- +Function LANS +Parameters IDS + +*DO STERGE + +m.ID_SET=IDS +Select XSETS +Seek IDS +Scatter Name OXSET +oitem=Crea('actbaza') +oitem.ID_SET=IDS +oitem.Show(1) +If OXSET.nu_sterg=.F. And buton!=2 + Do danu With 'Doriti sa continuati cu operatii de acest fel?' + If buton=1 + LANS(IDS) + Endif +Endif +Release OXSET +Return + + + + +*---------------------------------------------- +Procedure afis_operatii +PARAMETERS tcFis,tlVisible +SELECT (tcFis) +Scatter Fields COD,SCD,SCC,nume_2 Memvar +Select * From &tcFis Where &tcFis..COD=m.COD Into Cursor AAA NOFILTER +Select AAA +N=Reccount() + +Public camp +Scatter Name camp + +Do Form vizpage +*ov=CREATEOBJECT('vizpage') && NU MERGE SI NU INTELEG DE CE :( +*ov.bandablOC1.visible=tlVisible +*ov.banda21.visible=!tlVisible +*ov.blocbuton1.visible=!tlVisible +*ov.show() + +Release camp +Select rull +Set Filter To +Select &tcfis +Endproc + + + + + + + +*!* *------------------------------------------- + +*!* Function BLOCHEZ_NIR +*!* Select NRNIR +*!* Flock() + +*!* DO case +*!* case nr_bonuri=0 +*!* Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST +*!* m=m+1 +*!* m.NNIR='1'+Str(NR_GEST,1,0)+Str(m.GEST,3,0)+Str(m,5,0) +*!* m.NNIR=Strtran(M.NNIR,' ','0') +*!* case nr_bonuri=1 +*!* Calculate Max(NR) To m +*!* m=m+1 +*!* m.NNIR=Alltrim(Str(m)) +*!* case nr_bonuri=2 +*!* Calculate Max(NR) To m For NRGEST=idutil +*!* m=m+1 +*!* m.NNIR=Alltrim(Str(m)) +*!* Endcase +*!* Append Blank +*!* Gather Fields NNIR Memv +*!* Replace NRGEST With idutil,NR With m +*!* *Replace NRGEST With m.nr_gest,NR With m +*!* Unlock +*!* Return M.NNIR + +*------------------------------------------- +Function BLOCHEZ_NIR +LOCAL G,M +STORE 0 TO M,G +Select NRNIR +Flock() + +DO case +case nr_bonuri=0 + Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST + m=m+1 + m.NNIR='1'+Str(NR_GEST,1,0)+Str(m.GEST,3,0)+Str(m,5,0) + m.NNIR=Strtran(M.NNIR,' ','0') + G= m.nr_gest +case nr_bonuri=1 + Calculate Max(NR) To m + m=m+1 + m.NNIR=Alltrim(Str(m)) +case nr_bonuri=2 + Calculate Max(NR) To m For NRGEST=idutil + m=m+1 + m.NNIR=Alltrim(Str(m)) + G= idutil +ENDCASE +Select NRNIR +Append Blank +Gather Fields NNIR,GEST Memv +*Replace NRGEST With idutil,NR With m +*Replace NRGEST With m.nr_gest,NR With m +REPLACE NR WITH M,NRGEST WITH G +Unlock +Return M.NNIR + + + + +*---------------------------------- +Function ELIB_NIR +Parameters N +Select NRNIR +Seek N +If Found() + If Flock() + Delete + Endif + Unlock +Endif +Return + + + +*!* *------------------------------------------- + +*!* Function BLOCHEZ_BON +*!* Select nrbon +*!* Flock() +*!* DO case +*!* case nr_bonuri=0 +*!* Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST +*!* m=m+1 +*!* m.NNIR='2'+Str(NR_GEST,1,0)+Str(M.GEST,3,0)+Str(m,5,0) +*!* m.NNIR=Strtran(M.NNIR,' ','0') +*!* case nr_bonuri=1 +*!* Calculate Max(NR) To m +*!* m=m+1 +*!* m.NNIR=Alltrim(Str(m)) +*!* case nr_bonuri=2 +*!* Calculate Max(NR) To m For NRGEST=idutil +*!* m=m+1 +*!* m.NNIR=Alltrim(Str(m)) +*!* Endcase +*!* Append Blank +*!* Gather Fields NNIR Memv +*!* Replace NRGEST With idutil,NR With m +*!* *!* Gather Fields NNIR,gest Memv +*!* *!* Replace NRGEST With m.nr_gest,NR With m +*!* Unlock +*!* Return M.NNIR + +*------------------------------------------- +Function BLOCHEZ_BON +LOCAL G,M +STORE 0 TO G,M +Select nrbon +Flock() + +DO case +case nr_bonuri=0 + Calculate Max(NR) To m For NRGEST=NR_GEST And GEST=M.GEST + m=m+1 + m.NNIR='2'+Str(NR_GEST,1,0)+Str(M.GEST,3,0)+Str(m,5,0) + m.NNIR=Strtran(M.NNIR,' ','0') + G= m.nr_gest +case nr_bonuri=1 + Calculate Max(NR) To m + m=m+1 + m.NNIR=Alltrim(Str(m)) +case nr_bonuri=2 + Calculate Max(NR) To m For NRGEST=idutil + m=m+1 + m.NNIR=Alltrim(Str(m)) + G= idutil +ENDCASE +SELECT NRBON +Append Blank +Gather Fields NNIR,GEST Memv +*Replace NRGEST With idutil,NR With m +*!* Gather Fields NNIR,gest Memv +*!* Replace NRGEST With m.nr_gest,NR With m +REPLACE NR WITH M,NRGEST WITH G +Unlock +Return M.NNIR + +*---------------------------------- + +Function ELIB_BON +Parameters N +Select nrbon +Seek N +If Found() + If Flock() + Delete + Endif + Unlock +Endif +Return +*______________________________________________________________________________ + +Procedure aleg_doc_plata +Parameters tcfis,tcNume,tlval,tcFelCont + +If Used('actcv') + Use In actcv +Endif + +tcNume=Upper(Alltrim(tcNume)) +tcfis=Alltrim(tcfis) +IF tlval + lccond=[ABS(&tcfis..sumaval-&tcfis..achitatval)>0] +ELSE + IF existacamp('&tcfis','sumaval') + lccond=[&tcfis..sumaval-&tcfis..achitatval=0] + ELSE + lccond='.t.' + ENDIF +ENDIF + + +Sele distinct &tcfis..* ; + FROM &tcfis ; + WHERE Upper(Alltrim(&tcfis..NUME))==Upper(Allt(tcNume)) And ; + !(Abs(&tcfis..totctva-&tcfis..achitat)=0 Or (&tcfis..totctva<&tcfis..achitat And &tcfis..totctva>0)) and ; + &lccond ; + into TABLE &LOC\&NFSCURT\TEMPO\actcv order by &tcfis..dataact + + +*!* SELECT DISTINCT actan.cod,actan.nrord FROM actan,&tcfis WHERE actan.cod=&tcfis..cod AND actan.NRACT=&tcfis..NRACT ; +*!* INTO CURSOR actfis +*!* SELECT &tcfis..*,actfis.nrord ; +*!* FROM (&tcfis left join actfis on &tcfis..cod=actfis.cod) ; +*!* WHERE Upper(Alltrim(&tcfis..NUME))==Upper(Allt(tcNume)) And ; +*!* !(Abs(&tcfis..totctva-&tcfis..achitat)=0 Or (&tcfis..totctva<&tcfis..achitat And &tcfis..totctva>0)) and ; +*!* &lccond ; +*!* into TABLE &LOC\&NFSCURT\TEMPO\actcv order by &tcfis..dataact +*!* USE IN actfis + + +DO CASE + CASE ALLTRIM(UPPER(tcFelCont))='A' + ALTER TABLE actcv rename COLUMN ACONT to ascc + CASE ALLTRIM(UPPER(tcFelCont))='P' + ALTER TABLE actcv rename COLUMN ACONT to ascd +ENDCASE + +Alter Table actcv Add Column ALES L Add Column sumaachi N(14) Add Column SUMAACHI2 N(14,2) Add Column achilei N(14) +IF tlval + Alter Table actcv ADD COLUMN difplus n(14) ADD COLUMN difminus n(14) Add Column cursval n(7) Add Column cursdif n(7) +ENDIF + +Sele actcv +Go Top + +Endproc && aleg_doc_plata + +*______________________________________________________________________________ + +Procedure trezorerie_plati +Parameters tcfis,tcAcont,tcCol + +tcAcont=ALLTRIM(tcAcont) +lcAcont='trez.'+tcAcont +lcCol='trez.'+ALLTRIM(tcCol) + +*!* IF USED('actcv') +*!* Select actcv +*!* Scan For ALES +*!* Scatter Name trez +*!* +*!* IF existacamp('actcv',tcAcont) +*!* Select (tcfis) +*!* IF TYPE('actcv.proc_tva')#'U' +*!* Locate For nract=trez.nract And dataact=trez.dataact And NUME=trez.NUME AND acont=&lcAcont AND proc_tva=trez.proc_tva +*!* ELSE +*!* Locate For nract=trez.nract And dataact=trez.dataact And NUME=trez.NUME AND acont=&lcAcont +*!* ENDIF +*!* ELSE +*!* Select (tcfis) +*!* Locate For nract=trez.nract And dataact=trez.dataact And NUME=trez.NUME +*!* ENDIF +*!* If Flock() +*!* Replace achitat With achitat+trez.sumaachi +*!* IF existacamp('&tcfis','achitatval') +*!* Replace achitatval With achitatval+trez.sumaachi2 +*!* ENDIF +*!* Endif +*!* UNLOCK +*!* Select actcv +*!* ENDSCAN +*!* ELSE && pt modificare sau analitice diferite + + SELECT actactan + Scan For pereche#0 AND &tcAcont=m.acont + Scatter Name trez + IF TYPE(tcfis+'.acont')#'U' + Select (tcfis) + IF TYPE(tcfis+'.proc_tva')#'U' + Locate For nract=trez.pereche And NUME=&lcCol AND acont=&lcAcont AND proc_tva=trez.proc_tva + ELSE + Locate For nract=trez.pereche And NUME=&lcCol AND acont=&lcAcont + ENDIF + ELSE + Select (tcfis) + Locate For nract=trez.pereche And NUME=&lcCol + ENDIF + + IF FOUND() + If Flock() + Replace achitat With achitat+trez.suma + IF TYPE(tcfis+'.achitatval')#'U' + Replace achitatval With achitatval+trez.suma_2 + ENDIF + ENDIF + UNLOCK + ENDIF + + Select actactan + ENDSCAN +*!* ENDIF +Release trez + +IF USED('actcv') + USE IN actcv +ENDIF +Endproc && trezorerie_incasari_plati + +*______________________________________________________________________________ + +Procedure trezorerie_incasari +Parameters tcfis,tcAcont,tcCol + + +tcAcont=ALLTRIM(tcAcont) +lcAcont='trez.'+tcAcont +lcCol='trez.'+ALLTRIM(tcCol) + +SELECT actactan +Scan For pereche2#0 AND &tcAcont=m.acont + Scatter Name trez + IF TYPE(tcfis+'.acont')#'U' + Select (tcfis) + IF TYPE(tcfis+'.proc_tva')#'U' + Locate For nract=trez.pereche2 And NUME=&lcCol AND acont=&lcAcont AND proc_tva=trez.proc_tva + ELSE + Locate For nract=trez.pereche2 And NUME=&lcCol AND acont=&lcAcont + ENDIF + ELSE + Select (tcfis) + Locate For nract=trez.pereche2 And NUME=&lcCol + ENDIF + + IF FOUND() + If Flock() + Replace achitat With achitat+trez.suma + IF TYPE(tcfis+'.achitatval')#'U' + Replace achitatval With achitatval+trez.suma_2 + ENDIF + ENDIF + UNLOCK + ENDIF + + Select actactan +ENDSCAN + +Release trez + +IF USED('actcv') + USE IN actcv +ENDIF +Endproc && trezorerie_incasari +*------------------------------------------------------------------------------ + + + +PROCEDURE test_facturi +Parameters tcfis,tccont,tcNume,tcfel + +tcNume=Upper(Alltrim(tcNume)) +tcfis=Alltrim(tcfis) + + LcCond=upper(allt(ofis.camp_verif))+[=']+tcnume+[' AND ]+tcfel+[=']+Tccont+['] && ofis.camp_verif---> vezi procedura viz_fact + SELE 0 + USE &DATE/ACT.DBF AGAIN ALIAS ACn1 + + SELECT ACN1 + SET FILTER TO &Lccond + + select &tcfis..nume,&tcfis..dataact,&tcfis..nract,&tcfis..dataireg,&tcfis..totctva as suma,; + &tcfis..achitat,&tcfis..achitat as pereche,&tcfis..fdoc,&tcfis..fdoc as scc,&tcfis..fdoc as scd,&tcfis..fdoc as nume_2,&tcfis..fdoc as explicatia; + FROM &tcfis; + WHERE Upper(Alltrim(&tcfis..NUME))==Upper(Allt(tcNume)) ; + into cursor acn2 order by dataireg + +RETURN LcCond +ENDPROC + +*________________________________________________________________________________ + +PROCEDURE imperechere_fact_avans +PARAMETERS tcfis,tcNume,TnSuma,tlval,tcPereche + +PRIVATE PlStrict +STORE .f. to PlStrict + +tcfis=UPPER(ALLTRIM(tcfis)) +tcNume=Upper(Alltrim(tcNume)) +lcPereche='m.'+ALLTRIM(tcPereche) +IF tlval + lccond=[&tcfis..achitatval-&tcfis..factval>0] +ELSE + lccond=[&tcfis..achitatval-&tcfis..factval=0] +ENDIF + +IF USED('actcv1') + USE IN actcv1 +ENDIF + +SELECT * ; + from &tcfis; + where Upper(Alltrim(&tcfis..NUME))==tcNume AND &tcfis..achitat-&tcfis..facturat#0 AND &lccond; + into Table &loc\&nfscurt\tempo\actcv1 order by dataact + ALTER TABLE actcv1 ADD COLUMN ales l ADD COLUMN sumaachi n(14) ADD COLUMN sumaachi2 n(14,2) ; + ADD COLUMN difplus n(14) ADD COLUMN difminus n(14) + +IF _tally=0 + DO mesaj with 'Nu exista avansuri inregistrate','la acest partener !' + DO STERGE + DO inchid_actcv + DO deschid_actc + RETURN +ENDIF + + +IF xsets.id_set=10421 && regularizari clienti creditori + SELECT actcv + REPLACE ALL sumaachi WITH sumaachi/m.ctva FOR neimpozab=0 AND ales + REPLACE ALL neimpozab WITH sumaachi FOR neimpozab#0 AND ales + SUM sumaachi TO tnsuma FOR ales +ENDIF + +*m.suma=tnsuma + +SELECT actcv1 +IF !tlval + oavans=CREATEOBJECT('avansales') + oavans.suma=tnSuma +ELSE + oavans=CREATEOBJECT('avansval') + oavans.suma_2=m.suma_2 +ENDIF + +oavans.pcfis='AVANS' +oavans.show(1) + +IF buton=2 + DO sterge + DO inchid_actcv + DO deschid_actc + RETURN +ENDIF + +SELECT ACTCV1 +LOCATE FOR ALES +SCATTER NAME av + + +IF av.proc_tva=0 + m.proc_tva=m.ctvam +ELSE + m.proc_tva=av.proc_tva +ENDIF + +lnSumaAchi=av.sumaachi +lnSumaAchiVal=av.sumaachi2 + +NRAVANS=NRACT +DATAAVANS=DATAACT +LcNRORD=ALLT(STR(NRAVANS))+' / '+ALLT(DTOC(DATAAVANS)) + +*!* IF USED('actactan') +*!* USE IN actactan +*!* ENDIF +*!* IF USED('actc') +*!* USE IN actc +*!* ENDIF + +*!* USE &LOC\&NFSCURT\TEMPO\ACTc IN 0 again ALIAS ACTACTAN exclusive ORDER TAG nr_nota +*!* SET DELETED ON + +SELECT actactan +PACK + +IF lnSumaAchi0 OR sumaachi2-LnminVal>0 + REPLACE sumaachi WITH LnMin + REPLACE sumaachi2 WITH LnMinVal + ENDIF + LnSumaAchi=LnSumaAchi-LnMin + LnSumaAchiVal=LnSumaAchiVal-LnMinVal + + SELECT actactan + GOTO lni + + SELECT actactan + REPLACE suma WITH LnMinAct + REPLACE suma_2 WITH LnMinVal + REPLACE &tcPereche WITH av.nract +* REPLACE neimpozab WITH lnNeimpozab + + SELECT actactan + IF tlval + IF suma_3>av.cursschimb + SCATTER NAME oaa + APPEND BLANK + GATHER NAME oaa + IF tcfis='AVANS419' + REPLACE scd WITH '665 ',suma WITH (oaa.suma_3-av.cursschimb)*LnMinVal,; + explicatia WITH 'DIFERENTE NEFAVORABILE',suma_2 WITH 0,suma_3 WITH av.cursschimb + ELSE + REPLACE scc WITH '765 ',suma WITH (oaa.suma_3-av.cursschimb)*LnMinVal,; + explicatia WITH 'DIFERENTE FAVORABILE',suma_2 WITH 0,suma_3 WITH av.cursschimb + ENDIF + ENDIF + IF suma_3m.precdeb Or apreccred<>m.preccred Or aruldeb<>m.RULDEB Or arulcred<>m.RULCRED + Select BALANA + Seek m.cont+acontvid + If !Found() + Append Blank + Gather Memv + REPLACE acont WITH acontvid + Endif + Replace precdeb With m.precdeb-aprecdeb + Replace preccred With m.preccred-apreccred + Replace RULDEB With m.RULDEB-aruldeb + Replace RULCRED With m.RULCRED-arulcred + Endif + Select cc +ENDSCAN + +ENDIF +UNLOCK IN balana +SELECT balana +SET FILTER TO +return + + + +*_______________________________________ +Procedure CALCULEAZABALANTA_ANA +Select BALANA +If Flock() + Replace All TOTDEB With RULDEB+precdeb; + totcred With RULCRED+preccred +Endif +Unlock +Scan + If Flock() + If TOTDEB-totcred>0 + Replace SOLDDEB With TOTDEB-totcred; + SOLDCRED With 0 + Else + Replace SOLDCRED With totcred-TOTDEB; + SOLDDEB With 0 + Endif + Endif + Unlock +Endscan +Return +******************************************** + +PROCEDURE introducere_compacta +PARAMETERS tcfis,tcscd,tcscc,tl_calcTVA,tl_plata,tctitlu,tctva,tn_idset + +*!* tcfis=fisierul din calefirma (achi_mat.dbf) +*!* tcscd=simbol cont debitor +*!* tcscc=simbol cont creditor +*!* tl_calctva=daca se calculeaza TVA-ul per total +*!* tl_plata=daca se achita factura respectiva +*!* tctitlu=titlul formularului frm_introd_compact +*!* tctva=contul de TVA (daca tl_calctva=.t.) +*!* tn_idset=parametrul functiei lans() + +IF USED('introdc') + USE IN introdc +ENDIF + +SELECT (tcfis) +COPY STRUCTURE TO &loc\&nfscurt\tempo\introdc WITH CDX +USE &loc\&nfscurt\tempo\introdc IN 0 SHARED + +SELECT introdc +APPEND FROM &CALEFIRMA\DATEAN\&tcfis FOR id_set=tn_idset +SET ORDER TO tag ordine + +SELECT introdc +IF FLOCK() + IF INLIST(tn_idset,10467,10468) && PLATI IMPOZITE + REPLACE ALL nrcrt WITH 0 + ELSE + REPLACE ALL NRCRT WITH ordine + ENDIF + + IF !EMPTY(tcscd) + REPLACE ALL scd WITH tcscd FOR EMPTY(scd) OR UPPER(scd)='X' + ENDIF + + IF !EMPTY(tcscc) + REPLACE ALL scc WITH tcscc FOR EMPTY(scc) OR UPPER(scc)='X' + ENDIF + + IF m.ctva-1=0 + REPLACE ALL bifa WITH .t. + REPLACE ALL ptva WITH 0 + ENDIF +ENDIF +UNLOCK + +SELECT actactan +ZAP + +SELECT introdc +GO TOP +obj=CREATEOBJECT('FRM_INTROD_COMPACT') +obj.gridb1.column3.backcolor=RGB(255,255,255) +obj.gridb1.column4.backcolor=RGB(255,255,255) + +IF !tl_plata + obj.container2.visible=.f. + obj.container2.optiongroup1.value=0 + OBJ.HEIGHT=obj.container2.TOP +ELSE +obj.container2.optiongroup1.value=1 +ENDIF + +IF !tl_calcTVA + obj.container1.visible=.f. + OBJ.HEIGHT=obj.container1.TOP+10 +ENDIF + +obj.titlufrumos1.caption=tctitlu +obj.show(1) + +IF BUTON=2 + DO deschid_actc + RETURN +ENDIF + +*!* IF tn_idset=10455 && rate leasing +*!* lans(10411) +*!* ENDIF + +SELECT actactan +REPLACE ALL id_set WITH tn_idset + +SELECT actactan +SCRIE_IN_FISIERE(' ') + +DO deschid_actc +ENDPROC &&introducere_compacta + +*___________________________________________________ +PROCEDURE deschid_actc + +IF USED('actactan') + USE IN actactan +ENDIF + +IF !USED('ACTc') + DO DES WITH 'ACTc' +ENDIF + +ENDPROC && deschid_actc + +*____________________________________________________ +PROCEDURE inchid_actcv + +IF USED('actcv') + USE IN actcv +ENDIF + +IF USED('ACTcv1') + USE IN 'ACTcv1' +ENDIF + +ENDPROC && inchid_actcv + + +*_____________________________________________________________________________________________________________________ +PROCEDURE viz_facturi +PARAMETERS tcFis1,tcFis2,tnCont,tlCuTest,tlVisible,tcTitlu,TcColDeb,TcColCred + + +SELECT infisiere +LOCATE FOR VAL(cont)=tnCont +SCATTER NAME ofis + +*!* SELECT(tcfis1) +*!* If EXISTACIMP(tcfis1,'TOTDEB') +*!* If Flock() +*!* DO CASE +*!* CASE UPPER(ofis.fel)='A' +*!* Replace All totdeb With precdeb+productie,totcred With preccred+incasat +*!* CASE UPPER(ofis.fel)='P' +*!* Replace All totdeb With precdeb+platit,totcred With preccred+achizit +*!* ENDCASE +*!* Endif +*!* UNLOCK +*!* ENDIF + +SELECT(tcfis1) +If EXISTACIMP(tcfis1,'TOTDEB') + Replace All totdeb With precdeb+&TcColDeb,totcred With preccred+&TcColCred +ENDIF + + +Local C +C="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)" +buton=1 + +IF tlCuTest + SELECT (tcfis2) + Set Filter To + lcProc='inainte_'+ALLTRIM(tcfis2) + Do &lcProc In inaintede.prg + If buton=2 + Return + ENDIF +ENDIF + +If Used('ACTCV') + Use In actcv +ENDIF + +lcCale='&Date\'+ALLTRIM(tcfis2) +Use &lcCale In 0 Again Alias actcv SHARED order dataireg + +Sele actcv +*!* Index On &C Tag nd Of &loc\&nfscurt\tempo\actcv +*!* Index On DATAireg Tag DATAireg Of &loc\&nfscurt\tempo\actcv additive +*!* Set Order To Tag DATAireg + +PRIVATE pcAnalitic +STORE '' TO pcAnalitic + +Oreg=Createobject("AFCUMPVANZanp") +With Oreg + .LABEL10.Caption=PROPER(tcTitlu) + .grid1.column12.Visible=.T. + .cont=tnCont + .fisier=ALLTRIM(tcFis2) + .CHECK2.Visible=tlVisible + .CHECK6.Visible=tlVisible + .CHECK7.Visible=tlVisible + .CHECK9.Visible=tlVisible + *.command1.Visible=tlVisible + *.command3.Visible=tlVisible + .grid1.column2.Visible=tlVisible + .grid1.column11.Visible=tlVisible + .grid1.column13.Visible=tlVisible + .grid1.column14.Visible=tlVisible + .grid1.column7.Visible=tlVisible + .grid1.column8.Visible=tlVisible + .grid1.column10.Visible=tlVisible + IF !tlVisible + .CHECK3.Caption='Regularizate' + .CHECK4.Caption='Neregularizate' + .check10.Caption='Regularizat' + .grid1.column12.header1.Caption='Regularizat' + .grid1.column2.Width=0 + ENDIF +Endwith +*OREG.cmdlist1.VISIBLE=.f. +Oreg.Show(1) +IF USED('actcv') + Use In actcv +ENDIF +RELEASE ofis +RELEASE oreg + +*?????? Do totv + +ENDPROC && viz_facturi + + + +*-------------------------------------- +Function STERGE_DIN_FISIERE +Parameters PlConfirmare,pnCod +Local M.DEB,M.CRED,COND +Store 0 To M.DEB, M.CRED + +CREATE TABLE &loc\&nfscurt\tempo\conturi.dbf FREE (cont c(4),ana c(4),deb n(14),cred n(14),debval n(14.2),credval n(14.2)) + +SELECT conturi +APPEND BLANK +APPEND BLANK + +DD=Datetime() + +IF PlConfirmare + IF USED('actactan') + USE IN actactan + ENDIF + + SELECT * from actjur WHERE cod=pnCod INTO CURSOR actactan + overif=CREATEOBJECT('verificare') + overif.show(1) + IF buton=2 + USE IN conturi + Release Overif + RETURN + ENDIF +ENDIF + + + +&& sterg efectele neimpozab,TVA si baza din cump si vanz pt toate inregistrarile din nota +&& in loc sa fac o procedura sterg_4426 si sterg_4427 +DO sterg_TVA WITH "actactan" + + +Select ACTJUR +SET FILTER TO +SCAN FOR cod=pnCod +SCATTER NAME osterg + + Replace UTILS With UTILIZATOR, DATAORAS With DD + DELETE + + Select ACTAN + SET DELETED ON + If Flock() + LOCATE FOR cod=osterg.cod AND scd=osterg.scd AND scc=osterg.scc AND suma=osterg.suma + IF FOUND() + DELETE + ENDIF + Endif + UNLOCK + + SELECT conturi + GOTO 1 + REPLACE cont WITH osterg.scd,ana WITH osterg.ascd,deb WITH -osterg.suma,debval WITH -osterg.suma_2 + GOTO 2 + REPLACE cont WITH osterg.scc,ana WITH osterg.ascc,cred WITH -osterg.suma,credval WITH -osterg.suma_2 + + && sterge din balanta si balanta analitica + + Select conturi + SCAN + Scatter Memv + Select BAL + If Flock() + Seek ALLTRIM(M.CONT) + If !Found() + Do MESAJ With 'Contul '+M.CONT+' nu se regaseste in balanta!','' + ELSE + Select BAL + Replace RULDEB With RULDEB+M.DEB, TOTDEB With TOTDEB+M.DEB,; + RULCRED With RULCRED+M.CRED, TOTCRED With TOTCRED+M.CRED + SOLD=TOTDEB-TOTCRED + Replace SOLDDEB With Iif(SOLD>0,SOLD,0), SOLDCRED With Iif(SOLD<0,-SOLD,0) + Endif + Endif + UNLOCK + + SELECT balana + IF FLOCK() + IF !EMPTY(m.ana) + Seek m.cont+m.ana + IF FOUND() + Replace RULDEB With RULDEB+M.deb, TOTDEB With TOTDEB+M.deb, ; + RULcred With RULcred+M.cred, TOTcred With TOTcred+M.cred + SOLD=TOTDEB-TOTCRED + Replace SOLDDEB With Iif(SOLD>0,SOLD,0),SOLDcred With Iif(SOLD<0,-SOLD,0) + ENDIF + ENDIF + ENDIF + UNLOCK + Select conturi + ENDSCAN + + Select Distinct A.Cont,b.ana as acont,A.FPROC,B.DEB,B.CRED,B.DEBVAL,B.CREDVAL From INFISIERE A, conturi B ; + WHERE A.Cont=B.Cont ; + INTO Cursor COM + + Select COM + SCAN + Scatter Memv + zz='Do '+'sterg'+Alltrim(FPROC)+' with m.deb,m.cred,M.DEBVAL,M.CREDVAL' + &zz + SELECT com + ENDSCAN +Select ACTJUR +ENDSCAN + + +&&in gestiuni ???? +sele RUL +set filter to +if flock() + DELETE for cod=osterg.cod +endif +unlock in rul + +sele RULL +set filter to +if flock() + SCAN FOR cod=osterg.cod + IF PlConfirmare + scat memv + sele stoc + if flock() + loca for allt(denumire)=allt(m.denumire) and allt(codmat)=allt(m.codmat) and pret=m.pret and gest=m.gest and scd=m.scd + if found() + if m.cant#0 + repl cant with cant-m.cant + else + repl cante with cante-m.cante + endif + endif + ENDIF + UNLOCK + ENDIF + sele rull + delete + endscan +endif + +unlock in rull + +USE IN conturi +Do STERGE +Release Osterg +Return 0 + + + + + +*----------------------------------------------- +Procedure sterg_401 +Parameters debit,credit,VALDEBIT,VALCREDIT +&&&&&&&&&&& FURNIZOR + +Select FURNIZOR +If Flock() + + Seek Alltrim(osterg.NUME) + + Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit + Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit +Endif +Unlock + +Local di,din,div +IF Left(osterg.SCC,3)='767' And osterg.SCD=m.CONT AND osterg.ascd=m.acont &&discount + di=osterg.suma + din=osterg.neimpozab + div=osterg.SUMA_2 +ELSE + STORE 0 TO di,din,div +ENDIF + +&&&&&&&&&&& CUMPLUN +Select cumplun +IF credit#0 OR di#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+credit+di + Replace SUMAVAL With SUMAVAL+VALcredit+div + Replace achitat With achitat+debit+di + Replace achitatVAL With achitatVAL+VALdebit+div + + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF + Endif + UNLOCK +ENDIF + +&&&&&&&&&&&CUMP + +*!* If credit!=0 OR di#0 + +*!* m.neimpozab=-osterg.neimpozab+din +*!* m.totctva=credit+di + +*!* IF Left(osterg.scd,3)='442' +*!* m.tvam=credit +*!* ELSE +*!* m.tvam=0 +*!* ENDIF +*!* +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* + +*!* Select cump +*!* If Flock() +*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME +*!* IF FOUND() +*!* IF FLOCK() +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* ENDIF +*!* +*!* SELECT cump +*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0 +*!* DELETE +*!* ENDIF +*!* ENDIF +*!* Unlock +*!* Endif +Return + + +*----------------------------------------------- +Procedure sterg_404 +Parameters debit,credit,VALDEBIT,VALCREDIT +&&&&&&&&&&& FURNIZOR + +Select FURNIZ404 +If Flock() + + Seek Alltrim(osterg.NUME) + Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit + Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit +Endif +Unlock + +Local di,din,div +IF Left(osterg.SCC,3)='767' And osterg.SCD=m.CONT AND osterg.ascd=m.acont &&discount + di=osterg.suma + din=osterg.neimpozab + div=osterg.SUMA_2 +ELSE + STORE 0 TO di,din,div +ENDIF + +Select cumplun404 +IF credit#0 OR di#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+credit+di + Replace SUMAVAL With SUMAVAL+VALcredit+div + Replace achitat With achitat+debit+di + Replace achitatVAL With achitatVAL+VALdebit+div + + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF + Endif + UNLOCK +ENDIF + +&&&&&&&&&&&CUMP + +*!* If (credit!=0 OR di#0) AND osterg.neimpozab#0 + +*!* m.neimpozab=-osterg.neimpozab+din +*!* m.totctva=credit+di + +*!* IF Left(osterg.scd,3)='442' +*!* m.tvam=credit +*!* ELSE +*!* m.tvam=0 +*!* ENDIF +*!* +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* + +*!* Select cump +*!* If Flock() +*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME +*!* IF FOUND() +*!* IF FLOCK() +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* ENDIF +*!* +*!* SELECT cump +*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0 +*!* DELETE +*!* ENDIF +*!* ENDIF +*!* Unlock +*!* Endif +Return + +*---------------------------------------------- + +Procedure sterg_408 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select ana408 +If Flock() + Seek Alltrim(osterg.NUME) + Replace PLATIT With PLATIT+debit, ACHIZIT With ACHIZIT+credit + Replace platival With platival+VALdebit, ACHIZITVAL With ACHIZITVAL+VALcredit +Endif +Unlock + + +Select fact408 +IF credit#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva +ELSE + Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva +ENDIF +If Found() + If Flock() + Replace totctva With totctva+credit + Replace SUMAVAL With SUMAVAL+VALcredit + Replace achitat With achitat+debit + Replace achitatVAL With achitatVAL+VALdebit + + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF + Endif + UNLOCK +ENDIF + +*!* IF debit#0 && pt regularizari 408-401,4426-4428 +*!* LOCAL lnSUma +*!* lnSuma=0 +*!* SELECT cump +*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME +*!* IF FOUND() +*!* lnSuma=ROUND(debit*(m.ctva-1)/m.ctva,0) +*!* REPLACE tvam WITH tvam+lnSuma +*!* REPLACE totftvam WITH totftvam-lnSuma +*!* ENDIF +*!* SELECT cump +*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0 +*!* DELETE +*!* ENDIF +*!* ENDIF +RETURN + +*----------------------------------------------- +PROCEDURE sterg_4426 +Parameters debit,credit,VALDEBIT,VALCREDIT +*** vezi sterg_TVA +RETURN + + +*----------------------------------------------- +PROCEDURE sterg_4427 +Parameters debit,credit,VALDEBIT,VALCREDIT +*** vezi sterg_TVA +RETURN + +*----------------------------------------------- +Procedure sterg_409 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select AVANS409 +If debit#0 + If Flock() + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME + If Found() + Replace achitat With achitat+debit &&, facturat With facturat+credit + Replace achitatVAL With achitatVAL+VALdebit + Endif + Endif + Unlock +Endif +If credit#0 +*!* lcDat=Right(Allt(osterg.NRORD),10) +*!* ldDAT=Ctod(lcDat) +*!* lcNr=Strtran(Strtran(osterg.NRORD,lcDat,''),'/','') +*!* lnNr=Val(lcNr) + + Select AVANS409 + Locate For nract=osterg.pereche2 And NUME=osterg.NUME + IF FOUND() + If Flock() + Replace facturat With facturat+credit + Replace factVAL With factVAL+valcredit + Endif + UNLOCK + ENDIF +ENDIF + +SELECT avans409 +IF achitat=0 AND facturat=0 AND achitatval=0 AND factval=0 + DELETE +ENDIF +Select FURNIZOR +If Flock() + Seek Alltrim(osterg.NUME) + If Found() + Replace avans With avans+debit-credit + Replace avansVAL With avansVAL+VALdebit-VALcredit + Endif +Endif +UNLOCK + +Return +*------------------------------------------------------------- +Procedure sterg_419 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select AVANS419 +If credit#0 + If Flock() + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME + If Found() + Replace achitat With achitat+credit &&, facturat With facturat+credit + Replace achitatVAL With achitatVAL+VALcredit + Endif + Endif + Unlock +ENDIF + +If debit#0 +*!* lcDat=Right(Allt(osterg.NRORD),10) +*!* ldDAT=Ctod(lcDat) +*!* lcNr=Strtran(Strtran(osterg.NRORD,lcDat,''),'/','') +*!* lnNr=Val(lcNr) + Select AVANS419 + Locate For nract=osterg.pereche And NUME=osterg.NUME + IF FOUND() + If Flock() + Replace facturat With facturat+debit + Replace factVAL With factVAL+valdebit + Endif + UNLOCK + ENDIF +Endif +SELECT avans419 + +IF achitat=0 AND facturat=0 AND achitatval=0 AND factval=0 + DELETE +ENDIF + +Select clienti +If Flock() + Seek Alltrim(osterg.NUME) + If Found() + Replace avans With avans-debit+credit + Replace avansVAL With avansVAL-VALdebit+VALcredit + Endif +Endif +UNLOCK + +*--------------------------------------------------------------------- + +Procedure sterg_462 +Parameters tndebit,tncredit,tnVALDEBIT,tnVALCREDIT +&&&&&&&&&&& CREDITORI + +Select CREDITOR +If Flock() + Seek Alltrim(osterg.NUME) + Replace debit With debit +TnDebit, credit With Credit+TnCredit + Replace VALdebit With VALdebit +tnVALdebit, VALcredit With VALcredit+tnVALcredit +Endif +Unlock + +Local di,din,div +IF Left(osterg.SCC,3)='767' And osterg.SCD=m.CONT AND ascd=m.acont &&discount + di=osterg.suma + din=osterg.neimpozab + div=osterg.SUMA_2 +ELSE + STORE 0 TO di,din,div +ENDIF + +&&&&&&&&&&& CREDLUN + +Select credlun +IF TNcredit#0 OR di#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + Locate For nract=osterg.pereche And NUME=osterg.NUME AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+TNcredit+di + Replace SUMAVAL With SUMAVAL+TnVALcredit+div + Replace achitat With achitat+TNdebit+di + Replace achitatVAL With achitatVAL+TnVALdebit+div + Endif + UNLOCK + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF +ENDIF + +*---------------------------------------------- + +Procedure sterg_411 +Parameters debit,credit,VALDEBIT,VALCREDIT +&&&&&&&&&&& CLIENTI + +Select clienti +If Flock() + Seek Alltrim(osterg.NUME) + Replace productie With productie +debit, incasat With incasat+credit + Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit +Endif +Unlock + +Local di,din,div,reg +STORE 0 TO di,din,div,reg + +DO CASE + CASE Left(osterg.SCd,3)='667' And osterg.SCc=m.CONT AND osterg.ascc=m.acont &&discount + di=osterg.suma + din=osterg.neimpozab + div=osterg.SUMA_2 + CASE osterg.id_set=10421 AND osterg.scc='4427' &®ularizare facturi-avans + reg=osterg.suma +ENDCASE + +&&&&&&&&&&& VANZLUN + +Select vanzlun +IF (debit#0 OR di#0) AND osterg.id_set#10421 &&discount + regularizare avans-factura + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+debit+di+reg + Replace SUMAVAL With SUMAVAL+VALdebit+div + Replace achitat With achitat+credit+di+reg + Replace achitatVAL With achitatVAL+VALcredit+div + Endif + UNLOCK + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF +ENDIF + + +&&&&&&&&&&&VANZ + +*!* If debit!=0 OR di#0 + +*!* m.neimpozab=-osterg.neimpozab+din +*!* m.totctva=debit+di + +*!* IF Left(osterg.scc,3)='442' +*!* m.tvam=debit +*!* ELSE +*!* m.tvam=0 +*!* ENDIF +*!* +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* +*!* Select vanz +*!* If Flock() +*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME +*!* IF FOUND() +*!* IF FLOCK() +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* ENDIF +*!* +*!* SELECT vanz +*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0 +*!* DELETE +*!* ENDIF +*!* ENDIF +*!* Unlock +*!* Endif +RETURN + +*---------------------------------------------- + +Procedure sterg_461 +Parameters tndebit,tncredit,tnVALDEBIT,tnVALCREDIT +&&&&&&&&&&& DEBITORI + +Select debitor +If Flock() + Seek Alltrim(osterg.NUME) + Replace debit With debit +TnDebit, credit With Credit+TnCredit + Replace VALdebit With VALdebit +tnVALdebit, VALcredit With VALcredit+tnVALcredit +Endif +Unlock + +Local di,din,div +IF Left(osterg.SCd,3)='667' And osterg.SCc=m.CONT AND osterg.ascc=m.ascc &&discount + di=osterg.suma + din=osterg.neimpozab + div=osterg.SUMA_2 +ELSE + STORE 0 TO di,din,div +ENDIF + +&&&&&&&&&&& DEBLUN + +SELECT deblun +IF tnDebit#0 OR di#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+tndebit+di + Replace SUMAVAL With SUMAVAL+tnVALdebit+div + Replace achitat With achitat+tncredit+di + Replace achitatVAL With achitatVAL+tnVALcredit+div + Endif + UNLOCK + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF +ENDIF + +&&&&&&&&&&&VANZ + +*!* If tnDebit!=0 OR di#0 + +*!* m.neimpozab=-osterg.neimpozab+din +*!* m.totctva=tnDebit+di + +*!* IF Left(osterg.scc,3)='442' +*!* m.tvam=tnCredit +*!* ELSE +*!* m.tvam=0 +*!* ENDIF +*!* +*!* m.totftvam=m.totctva-m.neimpozab-m.tvam +*!* + +*!* Select vanz +*!* If Flock() +*!* Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME +*!* IF FOUND() +*!* IF FLOCK() +*!* REPLACE totctva WITH totctva+m.totctva,totftvam WITH totftvam+m.totftvam, ; +*!* tvam WITH tvam+m.tvam,neimpozab WITH neimpozab+m.neimpozab +*!* ENDIF +*!* ENDIF +*!* +*!* SELECT vanz +*!* IF totctva=0 AND totftvam=0 AND neimpozab=0 AND tvam=0 +*!* DELETE +*!* ENDIF +*!* ENDIF +*!* Unlock +*!* Endif +Return + +*--------------------------------------------------------------------------- + +Procedure sterg_4118 +Parameters debit,credit,VALDEBIT,VALCREDIT + +&&&&&&&&&&& CLIENT4118 +Select client4118 +If Flock() + Seek Alltrim(osterg.NUME) + Replace productie With productie +debit, incasat With incasat+credit + Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit +Endif +Unlock + +Local di,din,div +IF Left(osterg.SCd,3)='667' And osterg.SCc=m.CONT AND osterg.ascc=m.acont &&discount + di=osterg.suma + din=osterg.neimpozab + div=osterg.SUMA_2 +ELSE + STORE 0 TO di,din,div +ENDIF + + +&&&&&&&&&&& VANZLU4118 +Select vanzlu4118 +IF debit#0 OR di#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+debit+di + Replace SUMAVAL With SUMAVAL+VALdebit+div + Replace achitat With achitat+credit+di + Replace achitatVAL With achitatVAL+VALcredit+div + Endif + UNLOCK + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF +ENDIF + +RETURN + +*--------------------------------------------------------------------------- + +Procedure sterg_418 +Parameters debit,credit,VALDEBIT,VALCREDIT + +&&&&&&&&&&& ANA418 +Select ana418 +If Flock() + Seek Alltrim(osterg.NUME) + Replace productie With productie +debit, incasat With incasat+credit + Replace prodVAL With prodVAL +VALdebit, incasVAL With incasVAL+VALcredit +Endif +UNLOCK + + +&&&&&&&&&&& FACT418 +Select Fact418 +IF debit#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva +ELSE + LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont AND proc_tva=osterg.proc_tva +ENDIF +If Found() + If Flock() + Replace totctva With totctva+debit + Replace SUMAVAL With SUMAVAL+VALdebit + Replace achitat With achitat+credit + Replace achitatVAL With achitatVAL+VALcredit + + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF + ENDIF + UNLOCK +ENDIF + +*----------------------------------------------------------------------------------- + +Procedure sterg_471 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select chavans +Set Order To nract + +Select chavans +IF debit#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME AND acont=m.acont +ENDIF + +If Found() + If Flock() + Replace totctva With totctva+debit + * Replace SUMAVAL With SUMAVAL+VALdebit + Replace achitat With achitat+credit + * Replace achitatVAL With achitatVAL+VALcredit + Endif + UNLOCK + IF totctva=0 AND achitat=0 + DELETE + ENDIF +ENDIF + +Select chavans +Set Order To Tag dataireg +ENDPROC + +*---------------------------------------------------------------------------------- + +Procedure sterg_472 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select vnavans +Set Order To nract + +Select vnavans +IF credit#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME AND acont=m.acont +ELSE + LOCATE FOR nract=osterg.pereche AND NUME=osterg.NUME AND acont=m.acont +ENDIF + +If Found() + If Flock() + Replace totctva With totctva+credit + * Replace SUMAVAL With SUMAVAL+VALcredit + Replace achitat With achitat+debit + * Replace achitatVAL With achitatVAL+VALdebit + Endif + UNLOCK + IF totctva=0 AND achitat=0 + DELETE + ENDIF +ENDIF + +Select vnavans +Set Order To Tag dataireg +ENDPROC + +*---------------------------------------------------------------------------------- + + +Procedure sterg_455 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Select actionar +If Flock() + Seek Upper(Alltrim(osterg.nume_2)) + If Found() + Replace dat With dat+debit, luat With luat+credit + Endif +Endif +UNLOCK + +ENDPROC + +*-------------------------------------------------------- + +Procedure sterg_5311 +Parameters debit,credit,VALDEBIT,VALCREDIT + +SELECT casa +LOCATE FOR cod=osterg.cod +IF FOUND() + DELETE +ENDIF + +Select casanume +Locate For ALLTRIM(casa)=osterg.nume_3 +If Flock() + If Found() + Replace incasari With incasari+debit + Replace plati With plati+credit + Endif +Endif +Unlock + +Return + +*----------------------------------------------- +Procedure sterg_5314 +Parameters debit,credit,VALDEBIT,VALCREDIT + +STORE 0 TO m.plati,m.incasari,m.platival,m.incasval + +SELECT casaval +LOCATE FOR cod=osterg.cod +IF FOUND() + DELETE +ENDIF + +Select casvnume +Locate For ALLTRIM(nume_5)=osterg.nume_5 +If Flock() + If Found() + Replace incasari With incasari+debit + Replace incasVAL With incasVAL+VALdebit + Replace plati With plati+credit + Replace platiVAL With platiVAL+VALcredit + Endif +Endif +Unlock + +Return + +*----------------------------------------------- +Procedure sterg_5121 +Parameters debit,credit,VALDEBIT,VALCREDIT + +SELECT banca +LOCATE FOR cod=osterg.cod +IF FOUND() + DELETE +ENDIF + +Select bannume +Locate For ALLTRIM(nume_2)=osterg.nume_2 +If Flock() + If Found() + Replace incasari With incasari+debit + Replace plati With plati+credit + Endif +Endif +Unlock + +Return + +*----------------------------------------------- +Procedure sterg_5124 +Parameters debit,credit,VALDEBIT,VALCREDIT + +SELECT bancaval +LOCATE FOR cod=osterg.cod +IF FOUND() + DELETE +ENDIF + +Select banvnume +Locate For ALLTRIM(nume_3)=osterg.nume_3 +If Flock() + If Found() + Replace incasari With incasari+debit + Replace incasVAL With incasVAL+VALdebit + Replace plati With plati+credit + Replace platiVAL With platiVAL+VALcredit + Endif +Endif +Unlock + +*-------------------------------------------------------- +Procedure sterg_5112 +Parameters debit,credit,VALDEBIT,VALCREDIT + +Sele cec +If Flock() + LOCATE FOR cod=osterg.cod + IF FOUND() + DELETE + ENDIF +Endif +UNLOCK + +Select cecnume +If Flock() + LOCATE FOR UPPER(ALLTRIM(cec))=Upper(Alltrim(osterg.explicatia)) + If Found() + Replace incarcat With incarcat+debit,plati With plati+credit + Endif +Endif +UNLOCK + +ENDPROC + +*-------------------------------------------------------- + +Procedure sterg_542 +Parameters tndebit,tncredit,tnVALDEBIT,tnVALCREDIT +&&&&&&&&&&& DEBITORI + +Select achit542 +If Flock() + Seek Alltrim(osterg.NUME_2) + Replace debit With debit +TnDebit, credit With Credit+TnCredit + Replace VALdebit With VALdebit +tnVALdebit, VALcredit With VALcredit+tnVALcredit +Endif +Unlock + +&&&&&&&&&&& achiLUN + +SELECT achilun +IF tnDebit#0 + Locate For nract=osterg.nract And dataact=osterg.dataact And NUME=osterg.NUME_2 AND acont=m.acont +ELSE + LOCATE FOR nract=osterg.pereche2 AND NUME=osterg.NUME_2 AND acont=m.acont +ENDIF +If Found() + If Flock() + Replace totctva With totctva+tndebit + Replace SUMAVAL With SUMAVAL+tnVALdebit + Replace achitat With achitat+tncredit + Replace achitatVAL With achitatVAL+tnVALcredit + Endif + UNLOCK + IF totctva=0 AND achitat=0 AND sumaval=0 AND achitatval=0 + DELETE + ENDIF +ENDIF + +*!* Parameters debit,credit,VALDEBIT,VALCREDIT +*!* &&&&&&&&&&& achit542 +*!* Select achit542 +*!* If Flock() +*!* Seek Upper(Alltrim(osterg.nume_2)) +*!* If Found() +*!* Replace dat With dat+credit, luat With luat+debit +*!* Endif +*!* Endif +*!* Unlock + +ENDPROC + +*----------------------------------------------------------------------- +*** INCEPUT PROCEDURA INTRODUC_TVA +PROCEDURE caut_neimpozab +PARAMETERS tcAlias + + +LOCAL lcAlias, lcTVAD,lcTVAC,llvanz,llcump + +lcAlias = ALLTRIM(tcAlias) +lcTVAD = "4426" +lcTVAC = "4427" + +SELECT infisiere +LOCATE FOR cont=lcTVAD +lclstcDD=coresp_d && lista corespondentelor 4426 pe debit +lclstcDC=coresp_c && lista corespondentelor 4426 pe credit +LOCATE FOR cont=lcTVAC +lclstcCD=coresp_d && lista corespondentelor 4427 pe debit +lclstcCC=coresp_c && lista corespondentelor 4427 pe credit + +STORE .F. to llvanz, llcump + +IF !USED(lcAlias) + RETURN +ENDIF + +*** caut daca exista inregistrari care afecteaza tva-ul +SELECT (lcAlias) +LOCATE FOR neimpozab!=0 +IF !FOUND() + RETURN +ENDIF + +SELECT (lcAlias) +LOCATE FOR neimpozab != 0 +IF FOUND() + IF INLIST(ALLTRIM(scd),&lclstcCC) OR INLIST(ALLTRIM(scc),&lclstcCD) + llvanz = .T. + ENDIF + IF INLIST(ALLTRIM(scd),&lclstcDC) OR INLIST(ALLTRIM(scc),&lclstcDD) + llcump = .T. + ENDIF +ENDIF + + +IF llcump + DO _4426 WITH 0,0,0,0 +ENDIF + +IF llvanz + DO _4427 WITH 0,0,0,0 +ENDIF + +RETURN +*----------------------------------------------------------------------- +*** INCEPUT PROCEDURA STERG_TVA +PROCEDURE sterg_TVA +PARAMETERS tcAlias + + +LOCAL lcAlias, lcTVAD,lcTVAC,llvanz,llcump + +lcAlias = ALLTRIM(tcAlias) +lcTVAD = "4426" +lcTVAC = "4427" + + +lclstcCD = [411;4111;4112;4113;4114;4115;4116;4117;4118;4119;4428] && lista corespondentelor 4427 pe debit +lclstcCC = [411;4111;4112;4113;4114;4115;4116;4117;4118;4119;461;5121;5124;5311;5314;428;635] && lista corespondentelor 4427 pe credit +lclstcDD = [401;404;5121;5124;542] && lista corespondentelor 4426 pe debit +lclstcDC = [4427;4424;635] && lista corespondentelor 4426 pe credit + +STORE .F. to llvanz, llcump + +IF !USED(lcAlias) + RETURN +ENDIF + +*** caut daca exista inregistrari care afecteaza tva-ul +SELECT (lcAlias) +LOCATE FOR neimpozab!=0 OR INLIST(scd,lcTVAD,lcTVAC) OR INLIST(scc,lcTVAD,lcTVAC) +IF !FOUND() + RETURN +ENDIF + +SELECT (lcAlias) +GO top +SCATTER NAME losterg + + +*** verific daca trebuie sa sterg din vanz sau din cump +SELECT (lcAlias) +LOCATE FOR INLIST(lcTVAD,scd,scc) +IF FOUND() + llcump = .T. +ELSE + LOCATE FOR INLIST(lcTVAC,scd,scc) + IF FOUND() + llvanz = .T. + ENDIF +ENDIF + +IF !(llcump OR llvanz) && daca nu am gasit inreg cu TVA caut neimpozab + SELECT (lcAlias) + LOCATE FOR neimpozab != 0 + IF FOUND() + IF ALLTRIM(scd)$lclstcCD OR ALLTRIM(scc)$lclstcCD OR ALLTRIM(scc)$lclstcCC OR ALLTRIM(scd)$lclstcCC + llvanz = .T. + ENDIF + IF ALLTRIM(scc)$lclstcDC OR ALLTRIM(scd)$lclstcDC OR ALLTRIM(scd)$lclstcDD OR ALLTRIM(scc)$lclstcDD + llcump = .T. + ENDIF + ENDIF +ENDIF + +IF llvanz + SELECT vanz + LOCATE FOR cod=losterg.cod AND nract=losterg.nract + IF FOUND() + IF FLOCK() + DELETE + UNLOCK + ENDIF + ENDIF +ENDIF + +IF llcump + SELECT cump + LOCATE FOR cod=losterg.cod AND nract=losterg.nract + IF FOUND() + IF FLOCK() + DELETE + UNLOCK + ENDIF + ENDIF +ENDIF + +ENDPROC && sterg_TVA +*----------------------------------------------- + +PROCEDURE regularizare_clienti + +&&&&&&&&&vanzlun +SELECT actactan +SCAN FOR INLIST(m.acont,ascc,ascd) + SCATTER NAME oreg + SELECT vanzlun + IF FLOCK() + DO CASE + CASE LEFT(OREG.scc,3)='411' + LOCATE FOR nract=oreg.pereche2 AND NUME=oreg.NUME AND acont=oreg.ascc + IF FOUND() + REPLACE achitat WITH achitat+oreg.suma + ENDIF + CASE LEFT(OREG.scd,3)='411' + LOCATE FOR nract=oreg.pereche2 AND NUME=oreg.NUME AND acont=oreg.ascd + IF FOUND() + REPLACE achitat WITH achitat-oreg.suma + ENDIF + ENDCASE + ENDIF + UNLOCK + + SELECT actactan +ENDSCAN +RELEASE oreg + +ENDPROC +*---------------------------------------------------------------------------------------------- + +PROCEDURE afis_sold_casabanca +PARAMETERS tcTip,tcFis,tcTitlu,TcCont,TcNumeCol1,TcNumeCol2,tlVisibil + +Private m.sum1,m.sum2,m.sum3,m.sumA2,m.sumA3,m.sumA4,m.sumA5,m.sumA6,m.sumA7,m.sumA8,m.sumA9,m.sumA10,m.sumA11,m.sumA12,m.sumA13,pcnumele,M.NUMEVAL,; + m.tincasari,m.tplati,sold +STORE 0 TO m.sum1,m.sum2,m.sum3,m.sumA2,m.sumA3,m.sumA4,m.sumA5,m.sumA6,m.sumA7,m.sumA8,m.sumA9,m.sumA10,m.sumA11,m.sumA12,m.sumA13,; + m.tincasari,m.tplati,sold +STORE '' TO pcnumele,M.NUMEVAL +Sele &tcFis + +m.SOLDDEB=0 +m.SOLDCRED=0 +Sum &TcNumeCol2,PLATI To m.sum1,M.sum2 +m.sum3=M.sum1-M.sum2 + +Sele Bal +Seek TcCont +If Found() + Scatter Memvar + If M.SOLDDEB-M.SOLDCRED # M.sum3 + Do mesajval With 'Diferenta este:',M.SOLDDEB-M.SOLDCRED-M.sum3 + Endif +*!* Else +*!* Do mesajval With '',M.SOLDDEB +Endif + +Sele &tcFis + +Obancana=Createobject("afbancanav") +WITH Obancana + .tip=tcTip + .grid1.column1.ControlSource=TcNumeCol1 + .grid1.column3.ControlSource=TcNumeCol2 + .grid1.column3.DynamicForeColor='IIF('+TcNumeCol2+'>=0, RGB(0,0,0), RGB(255,0,0))' + .grid1.column9.ControlSource=TcNumeCol2+'-PLATI' + .grid1.column9.DynamicForeColor='IIF('+TcNumeCol2+'-plati>=0, RGB(0,0,0), RGB(255,0,0))' + .grid1.column3.header3.caption=PROPER(TcNumeCol2) + .TitluFrumos1.Caption=TcTitlu + .check1.visible=TlVisibil + .check3.visible=TlVisibil + .check5.visible=TlVisibil + .check7.visible=TlVisibil + .TEXT14.VISIBLE=TlVisibil + .TEXT15.VISIBLE=TlVisibil + .TEXT16.VISIBLE=TlVisibil + .LABEL2.VISIBLE=TlVisibil + .GRID1.column5.visible=TlVisibil + .GRID1.column6.visible=TlVisibil + .GRID1.column7.visible=TlVisibil + .GRID1.column8.visible=TlVisibil +ENDWITH +Obancana.Show() + +ENDPROC + +*-------------------------------------------------------------------- +procedure umple_log +PARAMETERS textul,textmare +LOCAL datatext +datatext="" +*----------------FACE INREGISTRARI IN LOG_TEXT. +datatext=calefirma+"\logs\contab\log_"+ALLTRIM(STR(DAY(DATE())))+"_"+ALLTRIM(STR(MONTH(DATE())))+"_"+ALLTRIM(STR(YEAR(DATE())))+".txt" +CD &CALEFIRMA +If !Directory("LOGS") + md logs +ENDIF +CD &calefirma\logs +If !Directory("contab") + Md contab +ENDIF +Set Textmerge On +Set Textmerge Noshow +Set Textmerge To &datatext ADDITIVE +\\<>,<>,<>,<> +\ +Set Textmerge To +CD &dirgen + +RETURN &&-------umple_log + + diff --git a/Programe/Vechi/proceduri.prg b/Programe/Vechi/proceduri.prg new file mode 100644 index 0000000..0eb3add --- /dev/null +++ b/Programe/Vechi/proceduri.prg @@ -0,0 +1,935 @@ +*----------------------------------------------- +Function existacamp + Param numef,numec + Sele &numef + For i=1 To Fcount() + If Upper(Allt(Field(i)))=Upper(Allt(numec)) + Return .T. + Endif + Next + Return .F. + *----------------------------------------------- +Function existacimp + Param numef,numec + Sele &numef + For i=1 To Fcount() + If Upper(Allt(Field(i)))=Upper(Allt(numec)) + Return .T. + Endif + Next + Return .F. + ***----------------------------------------------------------------------------------------------------------------- +Procedure CAUT_ALF + Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM + Local MC0,MC1,MC2 + Set Safety Off + MC0='SELE '+NUMEBAZA + MC1='VARMEM=M.'+NUMECIMP + MC2='SET order TO TAG '+NUMECIMP + + &MC0 + Go Top + If Eof() + Appe Blank + Endif + &MC2 + OCA=Createobject("CAUTALF") + OCA.Caption=CAPTEXT + OCA.GRID1.RecordSource=NUMEBAZA + OCA.GRID1.COLUMN1.ControlSource=NUMECIMP + OCA.Show(1) + + Scatter Memvar + &MC1 + + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure CAUT_ALFa + Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM + Local MC0,MC1,MC2 + Set Safety Off + MC0='SELE '+NUMEBAZA + MC1='VARMEM=M.'+NUMECIMP + MC2='SET order TO TAG '+NUMECIMP + + &MC0 + + Go Top + If Eof() + Appe Blank + Endif + + &MC2 + OCA=Createobject("CAUTALFa") + OCA.Caption=CAPTEXT + OCA.GRID1.RecordSource=NUMEBAZA + OCA.GRID1.COLUMN1.ControlSource=NUMECIMP + OCA.cmdrenunt1.Visible=.T. + OCA.Show(1) + + Scatter Memvar + &MC1 + + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure mesaj + Parameters m1,m2 + ot=Create('text') + ot.label2.Caption=m1 + ot.label3.Caption=m2 + ot.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure mesajval + Parameters m1,m2 + ot=Create('textval') + ot.label2.Caption=m1 + ot.valoare=m2 + ot.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure mesajatent + Parameters m1,m2 + ot=Create('atentie') + ot.label2.Caption=m1 + ot.label3.Caption=m2 + ot.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure mesajrosu + Parameters m1,m2 + ot=Create('atentierosu') + ot.label2.Caption=m1 + ot.label3.Caption=m2 + ot.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure alfabeta + Parameters clasa,e5,b5,C5,e6,b6,C6,e7,b7,c7,expl + m.explicatia=expl + clasaact='actverif' + oc=Create(clasa) + With oc + .eti5=e5 + .eti6=e6 + .eti7=e7 + .baza5=b5 + .baza6=b6 + .baza7=b7 + .cimp5=C5 + .cimp6=C6 + .cimp7=c7 + .num=C5 + .num2=C6 + .expl=c7 + Endwith + If expl='do curs.spr' + oc.expl=expl + Endif + If txt2=.F. + m.FDOC="FACTURA" + oc.text2.Enabled=.F. + * oc.text2.controlsource="FACTURA" + Endif + oc.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure alfabetaper + Parameters clasa,e5,b5,C5,e6,b6,C6,e7,b7,c7,expl,cumpvanz + m.explicatia=expl + clasaact='actverif' + oc=Create(clasa) + With oc + .eti5=e5 + .eti6=e6 + .eti7=e7 + .baza5=b5 + .baza6=b6 + .baza7=b7 + .cimp5=C5 + .cimp6=C6 + .cimp7=c7 + .num=C5 + .num2=C6 + .expl=c7 + .cv=cumpvanz + Endwith + oc.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure IESIRE + *close tables + *close database + *set defa to &dirgen + *erase actactan.* + *erase ?temp.* + Quit + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure mesajm + Param txt,i + + Local T,p + p=Iif(i<10,Str(i,1),Str(i,2)) + T='orm.label'+p+'.caption="'+txt+'"' + &T + If i<20 + i=i+1 + Endif + p=Iif(i<10,Str(i,1),Str(i,2)) + T='orm.IMAGE'+p+'.VISIBLE=.T.' + &T + + Return + ***----------------------------------------------------------------------------------------------------------------- +Func ULTIMAZIL + Param LLL,AAA + Local N + Do Case + Case Inlist(LLL,1,3,5,7,8,10,12) + N=31 + Case Inlist(LLL,4,6,9,11) + N=30 + Case Inlist(LLL,2) + N=28 + If Mod(AAA,2)=0 + N=29 + Endif + Endcase + Return N + ***----------------------------------------------------------------------------------------------------------------- +Function SERIA_LUNARA_E_CORECTA + Local TIPAR,LOC,L + L=Val(M.NL) + LOC=L+Floor((L-1)/2) + TIPAR='VOICUIONEMIL' + + Sele cul + Go Top + &&ESTE CORECTA ULTIMA SERIE? + If Substr(TIPAR,L,1)=Substr(GREEN,LOC,1); + AND Substr(red,1,1)=Substr(GREEN,3,1); + AND Substr(red,2,1)=Substr(GREEN,6,1); + AND Substr(red,3,1)=Substr(GREEN,9,1); + AND Substr(red,4,1)=Substr(GREEN,12,1); + AND Substr(red,5,1)=Substr(GREEN,15,1) + Return .T. + Else + Return .F. + Endif + + ***----------------------------------------------------------------------------------------------------------------- +Function e_ultima_luna + Sele calendar + Loca For m.NL=NL And m.an=an + Skip + If Eof() + ultima_luna=.T. + Return .T. + Else + ultima_luna=.F. + Return .F. + Endif + + + ***----------------------------------------------------------------------------------------------------------------- +Procedure danu + Parameters m1 + od=Create('danu') + od.label1.Caption=m1 + od.Show(1) + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure danuquit + Parameters m1 + od=Create('danu') + od.label1.Caption=m1 + od.Show(1) + If buton=2 + Quit + Endif + Return + ***----------------------------------------------------------------------------------------------------------------- +Proc pr + Param j + + If j>M + OP.Release + OP=Crea('progresbar') + j=0 + OP.Show() + Endif + OP.PRBAR.Value=j + OP.p=Round(100*OP.PRBAR.Value/OP.PRBAR.Max,2) + OP.Refresh + j=j+1 + Return + ***----------------------------------------------------------------------------------------------------------------- +Proc MESAJT + Param M.denumire + OTEXT.oleTreeview.NODES.Add(,,,M.denumire,) + STARE=STARE+1 + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure nrord + Parameters ALI + Sele &ALI + A=Reccount() + If A=0 + Return + Endif + If A>65000 + Return 0 + Endif + Declare NROR(A) + K=0 + Scan + K=K+1 + NROR(K)=Recno() + Endscan + Return + +Function NRCRT + NR=Ascan(NROR,Recno()) + Return NR + ***----------------------------------------------------------------------------------------------------------------- +Procedure inchidprog + Local CC,M.NUMESTATIE,UU + Return + UU=utilizator + + If !Used('OPTIUNI') + Return + Endif + + Sele OPTIUNI + Loca For OPTIUNE='RETEA' + If !Found() Or (Found() And !DA) + Sele OPTIUNI + Use + Return + Endif + Sele OPTIUNI + Use + + If !File('C:\CONTAFIN\TEMP\RETEA.DBF') + Return + Endif + Sele 0 + Use C:\CONTAFIN\TEMP\RETEA Shar Alias RETEA + m.NUMESTATIE=Allt(NUMESTATIE) + CC=DIRGEN + Use + + If File('&DIRGEN\Dateretea\istoric.DBF') + Sele 0 + Use &DIRGEN\Dateretea\istoric Share Alias istoric + Else + Sele 0 + Use &CC\START2000\Data\istoric Share Alias istoric + Endif + + Sele istoric + Set Order To DATAORAINT + Loca For Empty(dataoraies) And Allt(statie)=m.NUMESTATIE And Allt(utilizator)=Allt(UU) + If Found() + If Flock() + Repl dataoraies With Datetime() + Unlock + Endif + Endif + Sele istoric + Use + + + If File('&DIRGEN\Dateretea\activ.DBF') + Sele 0 + Use &DIRGEN\Dateretea\Activ Share Alias Activ + Else + Sele 0 + Use &CC\START2000\Data\Activ Share Alias Activ + Endif + + Sele Activ + Loca For Allt(statie)=m.NUMESTATIE + If !Found() + Wait Wind 'Aceasta statie nu este inregistrata in server!' + Else + Sele Activ + If Flock() + Repl DEVIZE With .F. + Endif + Unlock + Endif + Sele Activ + Use + + + Return + ***----------------------------------------------------------------------------------------------------------------- +Proc gendinante + Sele ORDante + Set Filter To + Sele CLIE + Set Filter To + Sele ORDante.*,CLIE.* From ORDante,CLIE Where ORDante.codc=CLIE.codc Into Cursor cliord Order By DATAI + + + ovs=Crea('selante') + ovs.Show(1) + + Return + ***----------------------------------------------------------------------------------------------------------------- +Procedure AFISNOTEPAD + Param NUMEFIS + Do Case + Case File('C:\WINDOWS\NOTEPAD.EXE') + Run /N C:\Windows\NOTEPAD.Exe &NUMEFIS + Case File('C:\WINnt\system32\NOTEPAD.EXE') + Run /N C:\WINnt\system32\NOTEPAD.Exe &NUMEFIS + Otherwise + Do mesajatent With 'Nu se poate vizualiza textul','pe acest sistem!' + Endcase +***----------------------------------------------------------------------------------------------------------------- +Procedure SCRIETEXT + Param NUMEFIS,TEXTUL + + Set Textmerge To &NUMEFIS Additive Noshow + TEXT +<> + ENDTEXT + Return + +Endproc && SCRIETEXT +***----------------------------------------------------------------------------------------------------------------- +Procedure INITTEXT + Param NUMEFIS + + Set Textmerge To &NUMEFIS + Set Textmerge On Noshow + Return +***----------------------------------------------------------------------------------------------------------------- +Procedure SFTEXT + Set Textmerge To + Set Textmerge Off + Return +***----------------------------------------------------------------------------------------------------------------- +Procedure adaugtext + Param fisierul,TEXTUL + Wait Wind TEXTUL Nowait + Set Textmerge On + Set Textmerge Noshow + Set Textmerge To &fisierul Additive +\<> + Set Textmerge To + + Return +***----------------------------------------------------------------------------------------------------------------- +Procedure errq + Do mesaj With 'Pentru moment accesul nu este posibil','Incercati mai tarziu.' + errq=.T. + Return +***----------------------------------------------------------------------------------------------------------------- +Function SUMA_IN_VORBE + Param suma + Local i,lit,numar1 + Store 0 To i + Store '' To lit,numar1 + + numar1=Space(12) + numar1=Str(suma,12) + Dimension A(12) + A(1)=Subs(numar1,12,1) + A(2)=Subs(numar1,11,1) + A(3)=Subs(numar1,10,1) + A(4)=Subs(numar1,9,1) + A(5)=Subs(numar1,8,1) + A(6)=Subs(numar1,7,1) + A(7)=Subs(numar1,6,1) + A(8)=Subs(numar1,5,1) + A(9)=Subs(numar1,4,1) + A(10)=Subs(numar1,3,1) + A(11)=Subs(numar1,2,1) + A(12)=Subs(numar1,1,1) + Sele mila1 + ********************* + Loca For NR=Val(A(12)) + lit=lit+Alltri(cr1) + + If Val(A(11))=1 + If Val(A(10))=0 + Loca For NR=Val(A(11)) + lit=lit+Alltri(cr5) + Else + Loca For NR=Val(A(10)) + lit=lit+Alltri(cr4) + Endif + Else + If Val(A(10))=0 + Loca For NR=Val(A(11)) + lit=lit+Alltrim(cr5) + Else + Loca For NR=Val(A(11)) + lit=lit+Alltrim(cr2) + Loca For NR=Val(A(10)) + lit=lit+Alltrim(cr3) + Endif + Endif + Do Case + Case Val(A(12)) # 0 + lit=lit+' miliarde' + Case Val(A(11)) # 0 + lit=lit+' miliarde' + Case Val(A(10)) # 0 + lit=lit+' miliarde' + Endcase + *********************** + Loca For NR=Val(A(9)) + lit=lit+Alltri(cr1) + + If Val(A(8))=1 + If Val(A(7))=0 + Loca For NR=Val(A(8)) + lit=lit+Alltri(cr5) + Else + Loca For NR=Val(A(7)) + lit=lit+Alltri(cr4) + Endif + Else + If Val(A(7))=0 + Loca For NR=Val(A(8)) + lit=lit+Alltrim(cr5) + Else + Loca For NR=Val(A(8)) + lit=lit+Alltrim(cr2) + Loca For NR=Val(A(7)) + lit=lit+Alltrim(cr3) + Endif + Endif + Do Case + Case Val(A(9)) # 0 + lit=lit+' milioane' + Case Val(A(8)) # 0 + lit=lit+' milioane' + Case Val(A(7)) # 0 + lit=lit+' milioane' + Endcase + *********************** + Loca For NR=Val(A(6)) + lit=lit+Alltri(cr1) + + If Val(A(5))=1 + If Val(A(4))=0 + Loca For NR=Val(A(5)) + lit=lit+Alltri(cr5) + Else + Loca For NR=Val(A(4)) + lit=lit+Alltri(cr4) + Endif + Else + If Val(A(4))=0 + Loca For NR=Val(A(5)) + lit=lit+Alltrim(cr5) + Else + Loca For NR=Val(A(5)) + lit=lit+Alltrim(cr2) + Loca For NR=Val(A(4)) + lit=lit+Alltrim(cr3) + Endif + Endif + Do Case + Case Val(A(6)) # 0 + lit=lit+' mii' + Case Val(A(5)) # 0 + lit=lit+' mii' + Case Val(A(4)) # 0 + lit=lit+' mii' + Endcase + + ********************* + Loca For NR=Val(A(3)) + lit=lit+Alltri(cr1) + + If Val(A(2))=1 + If Val(A(1))=0 + Loca For NR=Val(A(2)) + lit=lit+Alltri(cr5) + Else + Loca For NR=Val(A(1)) + lit=lit+Alltri(cr4) + Endif + Else + If Val(A(1))=0 + Loca For NR=Val(A(2)) + lit=lit+Alltrim(cr5) + Else + Loca For NR=Val(A(2)) + lit=lit+Alltrim(cr2) + Loca For NR=Val(A(1)) + lit=lit+Alltrim(cr3) + Endif + Endif + Do Case + Case Val(A(3)) # 0 + lit=lit+' lei' + Case Val(A(2)) # 0 + lit=lit+' lei' + Case Val(A(1)) # 0 + lit=lit+' lei' + Endcase + + Sele mila1 + *!* use + + lit=Strtran(lit,' ','') + Return lit +***----------------------------------------------------------------------------------------------------------------- +Procedure LIST_EXCEL + Param TTABEL,TTITLU,TAHEADER + + External Array TAHEADER + LCFIS=Allt(LOC)+"\"+Allt(NFSCURT)+"\TEMPO\LIST_"+Sys(2)+".XLS" + LCFIS=Strtran(LCFIS,'\\','\') + + Set Textmerge On To (LCFIS) Noshow + LCANTET=Uppe(Allt(TTITLU))+crlf +\ +\\<> +\ + If Parameters()<3 + LCHEADER="" + Sele (TTABEL) + For i=1 To Fcount() + LCHEADER=LCHEADER+Upper(Allt(Field(i)))+Tab + Endfor + LCHEADER=LCHEADER+crlf +\\<> + Sele (TTABEL) + Scan + LDATE="" + For i=1 To Fcount() + F=Field(i) + T=&F + LDATE=LDATE+Transform(T,"")+Tab + Endfor + LDATE=LDATE+crlf + \\<> + Endscan + Set Textmerge To + Else + LCHEADER="" + NRCOL=Alen(TAHEADER,1) + Sele (TTABEL) + For i=1 To NRCOL + + If Empty(TAHEADER[I,1]) + LCHEADER=LCHEADER+Upper(Allt(TAHEADER[I,2]))+Tab + Else + LCHEADER=LCHEADER+Upper(Allt(TAHEADER[I,1]))+Tab + Endif + + Endfor + LCHEADER=LCHEADER+crlf + +\\<> + + Sele (TTABEL) + Scan + LDATE="" + For i=1 To NRCOL + * F=Field(TAHEADER[I,2]) + F=TAHEADER[I,2] + * IF EXISTACAMP(,F) + T=&F + LDATE=LDATE+Alltrim(Transform(T,""))+Tab + * ELSE + * LDATE=LDATE+" "+Tab + * ENDIF + Endfor + LDATE=LDATE+crlf + \\<> + Endscan + Set Textmerge To + Endif + * WAIT WINDOW "Se deschide Excel..." NOWAIT + + + + OEXCEL = Createobject("Excel.Application") + OEXCEL.WorkBooks.Open(LCFIS) + OEXCEL.Visible=1 + *!* IF TYPE(OEXCEL)='0' + *!* OEXCEL="" + *!* ENDIF + +Endproc && list_excel + + +*__________________________________________________________ + +&& Folosesc un tabel (tabel,id) cu cate o linie pt fiecare tabel +&& aflu id-ul urmator si il scriu in tabela +&& returnez id-ul +&& EX1: LNEW_ID=NEW_ID("GRILA_SAL") --> urmatorul id din fara cautare in tabela originala +&& EX2: LNEW_ID=NEW_ID("GRILA_SAL","ID") --> urmatorul id din cu cautare in tabela originala dupa campul +&& ex3: LNEW_ID=NEW_ID("GRILA_SAL","ID",.T.) --> .T. INSEAMNA CA TABELUL ORIGINAL ESTE INDEXAT DUPA FAC SEEK IN LOC DE LOCATE +Procedure NEW_ID + Parameters TALIAS,TFIELD,TTAG&&,tTipField + *WAIT WINDOW TALIAS + *ON error Errorh(ERROR(),PROGRAM(),LINENO()) + LLLOOKUP=Iif(Type("tfield")="C",.T.,.F.) + LLChar = Iif(Type(TFIELD) = "C",.T.,.F.) + LLTAG=Iif(Type("TTAG")="C",.T.,.F.) + TALIAS=Upper(Alltrim(TALIAS)) + + + *** Save Stats + LCOLDALIAS = Alias() && keep current work area + LNOLDRECNO = Iif(!Eof(),Recno(),0) && save record number + + LCSETDEL=Set("deleted") + && lnmaxval = (10^pcidsize)-1 && wrap around after this val + + *** + && PUN ORDINEA PE ID + If LLLOOKUP And LLTAG + Sele (TALIAS) + Set Order To &TTAG + Endif + *** + LCNEWID = 0 && our return result - NULL if failed + Select IDS + Locate For Upper(Alltrim(TABEL))=TALIAS + If !Found() + If Flock() + Append Blank + Replace TABEL With TALIAS + Unlock + Endif + + Endif + + Set Deleted Off + && acum sunt pe inregistrarea corecta + + + *** lock counter table and update counter + Select IDS + If Rlock() + *** Avoid use of Macros - Convert to mem var & update it + LNCOUNTERVAL = NEW_ID + + *** VERIFY ID NUMBER - search 'til no match + Do While .T. + *** increase the counter - update field and var + LNCOUNTERVAL = LNCOUNTERVAL+1 + + *!* *** check for wraparound + *!* IF lncounterval > lnmaxval + *!* lncounterval = 1 + *!* ENDIF + + Select (TALIAS) + If LLLOOKUP + If LLTAG + LCAUT="SEEK "+Allt(Str(LNCOUNTERVAL)) + Else + If LLChar + LCAUT="LOCATE FOR "+Allt(TFIELD)+"='"+Allt(Str(LNCOUNTERVAL))+"'" + Else + LCAUT="LOCATE FOR "+Allt(TFIELD)+"="+Allt(Str(LNCOUNTERVAL)) + Endif + *** now see if it exists + &LCAUT + * LOCATE FOR &TFIELD=LNCOUNTERVAL + If !Found() + *** No match - DONE + Exit + Endif && !found() + Endif && lltag + Else + Exit + Endif && lllokup + + Enddo && done + + Sele IDS + Replace NEW_ID With LNCOUNTERVAL + LCNEWID=LNCOUNTERVAL + + Unlock In IDS + Endif && rlock() + + *** Reset record number on original file + + If !Empty(LCOLDALIAS) + Sele (LCOLDALIAS) + If LNOLDRECNO#0 + Goto LNOLDRECNO + Endif + Endif + Set Deleted &LCSETDEL + + Return LCNEWID + +Endproc && NEW_ID + + +***------------------------------------------------------------------------------------------------------- +*------------------------------------------------------------------------------------------- + +*** returneaza un obiect cu proprietatile an si nl (de fapt cu toate coloanele din calendar) +Function ret_luna + Parameters tcTitlu + + Private loLuna + + Select calendar + *!* USE DBF('calendar') IN 0 AGAIN ALIAS tsel_luna share + Select * From calendar Into Cursor tsel_luna Order By an Desc ,NL Desc + Select tsel_luna + loLuna=myscatter('blank') + + Ol=Createobject("frm_sel_luna") + With Ol + .lblTitlu.Caption=tcTitlu + If Empty(.cboLuna.RowSource) + .cboLuna.RowSource="tsel_luna.nl,an" + Endif + .oLuna=loLuna + If Empty(.cAlias) + .cAlias=Left(.cboLuna.RowSource,At(".",.cboLuna.RowSource)-1) + Endif + Endwith + Ol.Show(1) + + Use In tsel_luna + + Return loLuna +Endfunc && ret_oluna +***----------------------------------------------------------------------------------------------------------------- +*!* SET CLASSLIB TO d:\contafin\contab\clase\caut.vcx ADDITIVE +*!* oo=ret_luna("Luna de inceput") +*** scattered = MYSCATTER() && This is instead of SCATTER NAME... +Procedure myscatter + Parameters tcBlank + Local llBlank, loScatter + + llBlank=.F. + If Type('tcBlank')='C' + If 'BLANK'$Upper(tcBlank) + llBlank=.T. + Endif + Endif + + myScatterObject = Createobject("myScatterObject") + If !Empty(Alias()) + If llBlank + Scatter Name loScatter Memo Blank + Else + Scatter Name loScatter Memo + Endif + lnFields = Fcount(Alias()) + For N =1 To lnFields + lcField=Field(N) + lcvalue=loScatter.&lcField + myScatterObject.AddProperty(lcField, lcvalue) + Endfor + Release loScatter + Endif + Return myScatterObject && Always return an object, so GATHER command could not choke. +Endproc + +Define Class myScatterObject As Session + * You may use any VFP class directly like myScatterObject = CREATEOBJECT("Session") + * But you may optionally use this DEFINE CLASS + * and declare the native PEMs here as HIDDEN if you want, so they are not exposed + * in case you are using class other than Session or work with VFP version prior to VFP 7.0 +Enddefine + +***----------------------------------------------------------------------------------------------------------------- +Procedure caut_alfa_cursor + Parameters NUMEBAZA,NUMECIMP,CAPTEXT,VARMEM + Local MC0,MC1,MC2, llVizibil + Set Safety Off + llVizibil = .T. + + MC0='SELE '+NUMEBAZA + MC1='VARMEM=M.'+NUMECIMP + *MC2='SET order TO TAG '+NUMECIMP + MC2 = [INDEX ON ] +NUMECIMP+ [ TAG nume OF &loc\&nfscurt\tempo\xindex.idx COMPACT ASCENDING ] + + + *!* &MC0 + *!* &MC2 + *!* GO TOP + + Local lcNumeCol2 + Store '' To lcNumeCol2 + + LcCol = Alltrim(NUMEBAZA) + '.cod_fiscal' + If Type(LcCol) # 'U' + lcNumeCol2 = 'cod_fiscal' + Endif + + LcCol = Alltrim(NUMEBAZA) + '.gest' + If Type(LcCol) # 'U' + lcNumeCol2 = 'gest' + Endif + + LcCol = Alltrim(NUMEBAZA) + '.id_sectie' + If Type(LcCol) # 'U' + lcNumeCol2 = 'id_sectie' + Endif + + If Empty(lcNumeCol2) + lcNumeCol2 = 'space(4)' + llVizibil = .F. + Endif + + LcCol = Alltrim(NUMEBAZA) + '.id' + If Type(LcCol) # 'U' + lcNumeCol3 = 'id' + Else + lcNumeCol3 = 'space(4)' + Endif + + Select Distinct &NUMECIMP, &lcNumeCol2, &lcNumeCol3 From (NUMEBAZA) Into Cursor tnomenclator Readwrite Order By &NUMECIMP + + OCA=Createobject("CAUTALFa") + OCA.Caption=CAPTEXT + OCA.GRID1.RecordSource='tnomenclator' + OCA.GRID1.COLUMN1.ControlSource = NUMECIMP + OCA.GRID1.COLUMN2.ControlSource = lcNumeCol2 + OCA.GRID1.COLUMN2.Visible = llVizibil + OCA.cmdrenunt1.Visible=.T. + OCA.command1.Visible=.F. + OCA.command2.Visible=.F. + OCA.command3.Visible=.F. + OCA.Show(1) + + *!* &MC0 + *!* SCATTER MEMVAR + *!* SET FILTER TO + + If buton=2 + Use In tnomenclator + Return + Endif + + lcFile = Addbs(gcTempPath) + 'xindex.idx' + If File(lcFile) + Set Index To + Delete File &lcFile + Endif + *!* &MC1 + + Select tnomenclator + Scatter Memvar + + &MC1 + + + Use In tnomenclator + Return +***----------------------------------------------------------------------------------------------------------------- diff --git a/Programe/Vechi/quitapp.prg b/Programe/Vechi/quitapp.prg new file mode 100644 index 0000000..c42529b --- /dev/null +++ b/Programe/Vechi/quitapp.prg @@ -0,0 +1,340 @@ +* Program: QUITAPP.PRG +* Description: Client-side of remote termination of applications. +* Created: 07/11/2003 +* Developer: Gregory L Reichert +* Copyright: Copyright (c) 2003 GLR software +*------------------------------------------------------------ +* Id Date By Description +* 1 07/11/2003 Gregory L Reichert Initial Creation +* +*------------------------------------------------------------ + +*!* Overview + +*!* The component is the client-side portion of a Remote Application Killer. +*!* With the use of a shared table, an network administrator can determine +*!* what workstation has what application running, and instruct that application +*!* to quit. + +*!* An administrator can monitor which applications are running, and instruct them +*!* termination themselves. + +*!* Instructions + +*!* This component is based on a Timer class with a one minute interval. Each minute +*!* the application check to see if the administrator wishs the application to +*!* quit. If discovered so, the countdown begins (default 10 minutes). During the +*!* Countdown, a message is displayed notifing the user that the automatic termination of +*!* the application is underway. They can manual exit the application, or wait for the +*!* automatic. Either way, it is intended for the user to complete their current task. +*!* At the end of the countdown, the application issues a QUIT command. + +*!* Call this routine, and a object reference is returned. This object should +*!* remain active throughout the life of the application. + +*!* PRIVATE oQuitApp +*!* oQuitApp = QuitApp( "\\MyServer\MyDrive\CommonFiles\" ) +*!* +*!* When the administrator wish to terminate one or more application, they place +*!* a True (.T.) in the "lQuit" field of the QuitApp.dbf table. As the Application continues +*!* countdown to automated termination, the "Remain" field indicates the number of minutes +*!* remaining. If the Admin changes the value of "Remain", the countdown continues from +*!* that new value. If a value less then zero (0) is entered, the application terminates +*!* the next time the QuitApp timer is fired. + + +*!* Two exposed method are provided to inform the routine that the application +*!* is performing critical operations and can not be interupted. These are called +*!* EnterCritical() and LeaveCritical(). The EnterCritical() should be called when the +*!* critical section begins, and the LeaveCritical() should be called when the section +*!* ends. + +*!* The administrator can check to see a application is running, or if it crashed before hand, +*!* by set the "aLiveTest" field of the QuitApp.dbf to False (.F.). After a couple of minutes, +*!* if the application is still alive, the field will revert to True (.T.). + +*!* The form called Admin_QuitApp.scx is used by the administrator to monitor and control the +*!* remote applications. + +*!* ===================================================================================== + +LPARAMETERS tcPath, tcQuitName + +RETURN CREATEOBJECT("QuitApp", tcPath, tcQuitName) + + +#DEFINE kQuitMax 10 && Wait 10 minutes before auto-quit + +*------------------------------------------------------------ +* Description: QuitApp class +*------------------------------------------------------------ +* Id Date By Description +* 1 07/11/2003 Gregory L Reichert Initial Creation +* +*------------------------------------------------------------ +DEFINE CLASS QuitApp AS TIMER + + INTERVAL = (60*1000) && check once a minute. + ENABLE = .T. + cPath = tcPath + cQuitName ="QuitApp" + cQFile ="QuitApp" + cAlias = "QuitApp" + && Full URN to QuitApp.dbf. Must be at a shared network location for all running application to gain access. + + *------------------------------------------------------------ + * Description: Error Trap + * Parameters: internal + * Return: n/a + * Use: internal + *------------------------------------------------------------ + * Id Date By Description + * 1 07/11/2003 Gregory L Reichert Initial Creation + * + *------------------------------------------------------------ + PROCEDURE ERROR( a,b,c ) + *-- ignore all error from this class + RETURN + ENDPROC + + *------------------------------------------------------------ + * Description: Initializes the timer + * Parameters: cPath: path to the shared QuitApp.dbf - path only + * Return: N/A + * Use: ox = CreateObject( "QuitApp","\\myserver\shared\CommonFiles\" ) + *------------------------------------------------------------ + * Id Date By Description + * 1 07/11/2003 Gregory L Reichert Initial Creation + * + *------------------------------------------------------------ + PROCEDURE INIT( cPath, cQuitName ) + LOCAL lc + lc = SELECT() + + + cPath = ADDBS(IIF(EMPTY(cPath),"", cPath)) + cQuitName = IIF(EMPTY(cQuitName),"QuitApp",JUSTSTEM(cQuitName)) + cQFile = cPath+cQuitName+".dbf" + cAlias = "QuitApp" + + this.cPath = cPath + this.cQuitName = cQuitName + this.cQFile = cQFile + this.cAlias = cAlias + *------------------------------------- + * create QuitApp table if missing. + *------------------------------------- + IF NOT FILE(this.cQFile) + SELECT 0 + CREATE TABLE (this.cQFile) (ws c(40),ID N(10,0), cCaption c(100),lQuit L, remain N(3), Critical L, aLiveTest L) + USE + ENDIF + + SELECT(lc) + ENDPROC + + *------------------------------------------------------------ + * Description: Timer routine + * Parameters: n/a + * Return: n/a + * Use: internal + *------------------------------------------------------------ + * Id Date By Description + * 1 07/11/2003 Gregory L Reichert Initial Creation + * + *------------------------------------------------------------ + PROCEDURE TIMER + + + LOCAL lc + lc = SELECT() + USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias) + SELECT (this.cAlias) + + LOCATE FOR ID=_VFP.HWND AND cCaption=_VFP.CAPTION AND NOT DELETED() + IF NOT FOUND() + + *------------------------------------- + * Add an instence for this workstation / application + INSERT INTO (this.cQFile) (ws,ID,cCaption,lQuit,remain, Critical, aLiveTest) ; + VALUES ( UPPER(SYS(0)),_VFP.HWND, _VFP.CAPTION, .F., kQuitMax, .F., .T.) + ENDIF + + *- Each time, reset the aLiveTest field. + REPLACE aLiveTest WITH .T. + + IF NOT Critical AND TXNLEVEL()=0 + *- do only if not in Critical Section of the code, + * and not in a Transaction block + IF lQuit + *------------------------------------- + * if still timing out, display remaining time. + *------------------------------------- + IF remain>0 + IF remain=kQuitMax + * - if first time displaying the warning, force application on top. + _SCREEN.ALWAYSONTOP=.T. + _SCREEN.ALWAYSONTOP=.F. + ENDIF + *- decrement the counter, and display warning. + REPLACE remain WITH remain -1 + osh=CREATEOBJECT('shell.application') + osh.minimazeall + _screen.windowstate=2 + WAIT WINDOW NOCLEAR NOWAIT "Programul se va inchide automat in " +ALLTRIM(STR(remain,10))+" minute." + ?? CHR(7) + osh.undominimazeall + RELEASE osh + ELSE + *------------------------------------- + * otherwise, quit the application. + *------------------------------------- + USE IN (this.cAlias) + CLEAR EVENTS + glQuit = .T. + QUIT + ENDIF + ELSE + *------------------------------------- + * if nolonger quiing, reset counter. + *------------------------------------- + REPLACE remain WITH kQuitMax + WAIT CLEAR + ENDIF + ENDIF + + USE IN (this.cAlias) + THIS.RESET + SELECT(lc) + ENDPROC + + *------------------------------------------------------------ + * Description: Called when entering a Critical Section of the code. + * Parameters: n/a + * Return: True + * Use: .EnterCritical + *------------------------------------------------------------ + * Id Date By Description + * 1 07/11/2003 Gregory L Reichert Initial Creation + * + *------------------------------------------------------------ + PROCEDURE EnterCritical() + LOCAL lc + lc = SELECT() + USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias) + SELECT (this.cAlias) + + UPDATE (this.cQFile) SET Critical=.T. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION + + USE IN (this.cAlias) + SELECT(lc) + ENDPROC + + *------------------------------------------------------------ + * Description: Called when exitting a Critical Section of the code. + * Parameters: n/a + * Return: True + * Use: .LeaveCritical + *------------------------------------------------------------ + * Id Date By Description + * 1 07/11/2003 Gregory L Reichert Initial Creation + * + *------------------------------------------------------------ + PROCEDURE LeaveCritical() + LOCAL lc + lc = SELECT() + USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias) + SELECT (this.cAlias) + + UPDATE (this.cQFile) SET Critical=.F. WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION + + USE IN (this.cAlias) + SELECT(lc) + ENDPROC + + *------------------------------------------------------------ + * Description: Destroy this object + * Parameters: n/a + * Return: n/a + * Use: internal + *------------------------------------------------------------ + * Id Date By Description + * 1 07/11/2003 Gregory L Reichert Initial Creation + * + *------------------------------------------------------------ + PROCEDURE DESTROY + *----------------------------------------------- + * On destroy, remove the application reference from the QuitApp table. + *----------------------------------------------- + LOCAL lc + lc = SELECT() + USE (this.cQFile) IN 0 SHARED ALIAS (this.cAlias) + SELECT (this.cAlias) + + DELETE FROM (this.cQFile) WHERE ID=_VFP.HWND AND cCaption=_VFP.CAPTION + + USE IN (this.cAlias) + SELECT(lc) + ENDPROC + +ENDDEFINE + + + +&& ------------------------------INCEPUT: Quit_Automat ------------------------------ +*!* Procedura: Quit_Automat +*!* Parametri: tlQuit +*!* Data/Ora generarii: 19/02/2004 12:48 +*!* Autor: MARIUS.MUTU +PROCEDURE Quit_Automat +LPARAMETERS tlQuit + +IF tlQuit + QUIT +ENDIF + +ENDPROC +&& ------------------------------SFARSIT: Quit_Automat ------------------------------ + +* Eof QUITAPP.PRG +*************************** +*!* FUNCTION AppInstance +*!* PARAMETERS WindowName + +*!* #DEFINE GW_OWNER 4 +*!* #DEFINE GW_HWNDFIRST 0 +*!* #DEFINE GW_HWNDNEXT 2 +*!* #DEFINE SW_MAXIMIZE 3 +*!* #DEFINE SW_NORMAL 1 + +*!* DECLARE integer SetForegroundWindow in win32api long lnhWnd +*!* DECLARE integer GetWindowText in win32api integer, string, integer +*!* DECLARE integer GetWindow in win32api integer,INTEGER +*!* DECLARE integer IsWindowVisible in win32api integer +*!* DECLARE integer GetActiveWindow in win32api +*!* DECLARE integer ShowWindow in user32 INTEGER lnhWnd, INTEGER lnCmdShow + +*!* IsWindEx = .F. +*!* if len(WindowName) < 1 +*!* return .t. +*!* endif + +*!* foxhwnd = GetActiveWindow() +*!* hwndNext = GetWindow(foxhwnd,GW_HWNDFIRST) + +*!* DO WHILE hwndNext <> 0 +*!* IF (hwndnext <> foxhwnd .AND. GetWindow(hwndnext,GW_OWNER) = 0) +*!* Stuffer = SPACE(64) +*!* x = GetWindowText(hwndnext,@Stuffer,64) +*!* IF WindowName $ Stuffer +*!* IsWindEx = .T. +*!* =SetForegroundWindow(hwndnext) +*!* =ShowWindow(hwndNext,SW_MAXIMIZE) +*!* EXIT +*!* ENDIF +*!* ENDIF +*!* hwndNext = GetWindow(hwndnext,GW_HWNDNEXT) +*!* ENDDO + +*!* RETURN IsWindEx +*!* ENDFUNC \ No newline at end of file diff --git a/Programe/Vechi/rapbal97.prg b/Programe/Vechi/rapbal97.prg new file mode 100644 index 0000000..f722590 --- /dev/null +++ b/Programe/Vechi/rapbal97.prg @@ -0,0 +1,104 @@ +public wbal +dirfirm=loc+'\'+nfscurt +WBAL=0 + +sele bal +set filter to SUBS(CONT,1,1)='7' +TOTAL ON subs(cont,5,1) TO &dirfirm\tempo\TOTTOT7 +SELE BAL +set filter to SUBS(CONT,1,1)='6' +TOTAL ON SUBS(CONT,5,1) TO &dirfirm\tempo\TOTTOT6 + +SELE 0 +USE &dirfirm\tempo\TOTTOT7 +REPL DENUMIRE WITH 'TOTAL VENITURI'; + CONT WITH '7998' +SELE 0 +USE &dirfirm\tempo\TOTTOT6 +REPL DENUMIRE WITH 'TOTAL CHELTUIELI'; + CONT WITH '6998' +SELE BAL +SET FILTER TO + +SELE BAL +TOTAL ON SUBSTR(CONT,1,3) TO &dirfirm\tempo\TOTBAL + +SELE 0 +*USE DATEAN\TOTBAL +USE &dirfirm\tempo\totbal.dbf exclusive + +SELE BAL +COPY TO &dirfirm\tempo\RAPBAL + +SELE 0 +USE &dirfirm\tempo\RAPBAL +TOTAL ON SUBS(CONT,5,1) TO &dirfirm\tempo\TOTTOT + +SELE TOTBAL +REPL ALL DENUMIRE WITH 'TOTAL '+SUBSTR(CONT,1,3); + cont WITH substr(cont,1,3)+'A' +SELE 190 +USE &dirfirm\tempo\TOTTOT +REPL DENUMIRE WITH 'TOTAL GENERAL'; + CONT WITH '9999' +SELE TOTBAL +USE + +SELE TOTTOT +USE +SELE TOTTOT7 +USE +SELE TOTTOT6 +USE + + +SELE RAPBAL + +APPE FROM &dirfirm\tempo\TOTBAL +APPE FROM &dirfirm\tempo\TOTTOT +APPE FROM &dirfirm\tempo\TOTTOT7 +APPE FROM &dirfirm\tempo\TOTTOT6 + +INDEX ON CONT TO &dirfirm\tempo\BALRAP.CDX +GO TOP +GCONT=CONT +kg=0 +SCAN +SCATTER MEMVAR + +if subs(m.cont,1,3)=subs(gcont,1,3) +kg=kg+1 +else +kg=1 +endif +IF SUBS(M.CONT,4,1)='A' and kg=2 +DELETE +kg=0 +ENDIF +GCONT=M.CONT +ENDSCAN + +m.titlu='' +if a4 + REPORT FORMAT RAPBALa4.FRX TO PRINTER PROMPT preview +else + REPORT FORMAT RAPBALa3.FRX TO PRINTER PROMPT preview +endif + +SELE RAPBAL +USE +ERASE &dirfirm\tempo\RAPBAL.DBF + +ERASE &dirfirm\tempo\BALrap.cdx + +ERASE &dirfirm\tempo\TOTTOT.DBF + +ERASE &dirfirm\tempo\TOTTOT7.DBF + +ERASE &dirfirm\tempo\TOTTOT6.DBF + +ERASE &dirfirm\tempo\totBAL.DBF + + + +RETURN \ No newline at end of file diff --git a/Programe/Vechi/refverif.prg b/Programe/Vechi/refverif.prg new file mode 100644 index 0000000..a60bf51 --- /dev/null +++ b/Programe/Vechi/refverif.prg @@ -0,0 +1,7489 @@ +PROCEDURE REFClienti && REFCLI +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\clienti.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'clienti.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\clienti.DBF IN 0 ALIAS clientiU + +SELECT clientiU + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('clientiu.totdeb') = 'U' + SELECT NUME,COD_FISCAL,avans AS precavans,productie AS precdeb,incasat AS preccred FROM clientiU INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + productie, totcred WITH preccred + incasat, totvaldeb WITH precvaldeb + prodval, totvalcre WITH precvalcre + incasval + REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('clientiu.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(precavans + avans) AS precavans, SUM(precavansv + avansval) AS precavansv, ; + SUM(precdeb + productie) AS precdeb, SUM(preccred+incasat) AS preccred, ; + SUM(precvaldeb + prodval) AS precvaldeb, SUM(precvalcre + incasval) AS precvalcre ; + FROM clientiU INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(precavans + avans) AS precavans, SUM(precavansv + avansval) AS precavansv, ; + SUM(precdeb + productie) AS precdeb, SUM(preccred+incasat) AS preccred, ; + SUM(precvaldeb + prodval) AS precvaldeb, SUM(precvalcre + incasval) AS precvalcre ; + FROM clientiU INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN clientiU + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA + +SELECT NUME, ; +IIF(LEFT(scd,3) = '411', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '411' AND scc # '4118', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '411' AND scd # '4118', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '411' AND scc # '4118', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '411' AND scd # '4118', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE (LEFT(scd, 3)='411' AND scd # '4118') OR (LEFT(scc, 3)='411' AND scc # '4118'); +INTO CURSOR t411 GROUP BY 1, 2, 3 + +SELECT t411 +SCAN + SCATTER NAME o411 + SELECT rcli + SEEK LEFT(o411.NUME,30) + o411.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o411.COD_FISCAL + ENDIF + ELSE + SEEK LEFT(o411.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o411.acont + ELSE + APPEND BLANK + GATHER NAME o411 + ENDIF + ENDIF + REPLACE productie WITH productie + o411.debit, incasat WITH incasat + o411.credit, prodval WITH prodval + o411.valdebit, incasval WITH incasval + o411.valcredit + + SELECT t411 +ENDSCAN +RELEASE o411 +USE IN t411 + +SELECT NUME, ; +IIF(LEFT(scd,3) = '419', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '419', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '419', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '419', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '419', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('419',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t419 GROUP BY 1, 2 + + +SELECT t419 +SCAN + SCATTER NAME o419 + SELECT rcli + SEEK LEFT(o419.NUME,30) + o419.acont + IF !FOUND() + LOCATE FOR ALLTRIM(nume) = ALLTRIM(o419.NUME) + IF !FOUND() + APPEND BLANK + GATHER NAME o419 + ENDIF + ENDIF + REPLACE avans WITH avans - o419.debit + o419.credit + REPLACE avansval WITH avansval - o419.valdebit + o419.valcredit + SELECT t419 +ENDSCAN +RELEASE o419 +USE IN t419 + + +SELECT rcli +REPLACE ALL totdeb WITH precdeb+productie,totcred WITH preccred+incasat,totavans WITH precavans+avans +REPLACE ALL totvaldeb WITH precvaldeb+prodval,totvalcre WITH precvalcre+incasval,totavansv WITH precavansv+avansval + +SELECT clienti +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +*USE IN clientiU + +SELECT clienti +SET ORDER TO TAG NANA +RETURN + + +*_________________________________________ +PROCEDURE REFFurnizor && REFFUR +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\FURNIZOR.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'FURNIZOR.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\FURNIZOR.DBF IN 0 ALIAS FURNIZORU + +SELECT FURNIZORU + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('FURNIZORu.totdeb') = 'U' + SELECT NUME, COD_FISCAL, avans AS precavans, platit AS precdeb, achizit AS preccred FROM FURNIZORU INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + platit, totcred WITH preccred + achizit , totvaldeb WITH precvaldeb + platival, totvalcre WITH precvalcre + achizitval + REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('FURNIZORu.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(precavans + avans) AS precavans, SUM(precavansv + avansval) AS precavansv, ; + SUM(precdeb + platit) AS precdeb, SUM(preccred + achizit) AS preccred, ; + SUM(precvaldeb + platival) AS precvaldeb, SUM(precvalcre + achizitval) AS precvalcre ; + FROM FURNIZORU INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(precavans + avans) AS precavans, SUM(precavansv + avansval) AS precavansv, ; + SUM(precdeb + platit) AS precdeb, SUM(preccred + achizit) AS preccred, ; + SUM(precvaldeb + platival) AS precvaldeb, SUM(precvalcre + achizitval) AS precvalcre ; + FROM FURNIZORU INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN FURNIZORU + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA + +SELECT NUME, ; +IIF(LEFT(scd,3) = '401', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '401', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '401', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '401', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '401', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('401',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t401 GROUP BY 1, 2, 3 + +SELECT t401 +SCAN + SCATTER NAME o401 + SELECT rcli + SEEK LEFT(o401.NUME,30) + o401.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o401.COD_FISCAL + ENDIF + ELSE + SEEK LEFT(o401.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o401.acont + ELSE + APPEND BLANK + GATHER NAME o401 + ENDIF + ENDIF + REPLACE platit WITH platit + o401.debit, achizit WITH achizit + o401.credit, platival WITH platival + o401.valdebit, achizitval WITH achizitval + o401.valcredit + + SELECT t401 +ENDSCAN +RELEASE o401 +USE IN t401 + +SELECT NUME, ; +IIF(LEFT(scd,3) = '409', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '409', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '409', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '409', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '409', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('409',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t409 GROUP BY 1, 2 + + + +SELECT t409 +SCAN + SCATTER NAME o409 + SELECT rcli + SEEK LEFT(o409.NUME,30) + o409.acont + IF !FOUND() + LOCATE FOR ALLTRIM(nume) = ALLTRIM(o409.NUME) + IF !FOUND() + APPEND BLANK + GATHER NAME o409 + ENDIF + ENDIF + REPLACE avans WITH avans + o409.debit - o409.credit + REPLACE avansval WITH avansval + o409.valdebit - o409.valcredit + SELECT t409 +ENDSCAN +RELEASE o409 +USE IN t409 + + +SELECT rcli +REPLACE ALL totdeb WITH precdeb + platit, totcred WITH preccred + achizit, totavans WITH precavans + avans +REPLACE ALL totvaldeb WITH precvaldeb + platival, totvalcre WITH precvalcre + achizitval, totavansv WITH precavansv + avansval + +SELECT FURNIZOR +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +*USE IN FURNIZORU + +SELECT FURNIZOR +SET ORDER TO TAG NANA +RETURN + + + +*!* LOCAL nla,nlb,ana,anb + +*!* IF !se_reface() +*!* RETURN +*!* ENDIF + +*!* nlb=m.nl +*!* anb=m.an +*!* dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +*!* SELE calendar +*!* LOCATE FOR nl=m.nl AND an=m.an +*!* SKIP -1 +*!* IF !BOF() +*!* nla=nl +*!* ana=an +*!* dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +*!* ELSE +*!* dateA=dirgen+'\_alfa\an0000\date00\' +*!* ENDIF + + +*!* SET SAFETY OFF +*!* COPY FILE &dirgen\_alfa\an0000\date00\FURNIZOR.* TO &loc\&nfscurt\tempo\rcli.* + +*!* USE &dateA\FURNIZOR.DBF IN 0 ALIAS FURNIZORU +*!* SELECT FURNIZORU +*!* SET ORDER TO 1 && NUME +*!* TOTAL TO &loc\&nfscurt\tempo\FURNIZORA ON NUME +*!* USE &loc\&nfscurt\tempo\FURNIZORA IN 0 ALIAS FURNIZORA +*!* SELECT FURNIZORA +*!* IF TYPE('FURNIZORa.totdeb') # 'U' +*!* * SUM TOTcred, achizit TO M.TOTcred, M.achizit +*!* REPLACE ALL totdeb WITH precdeb + platit, totcred WITH preccred + achizit +*!* ELSE +*!* SUM platit TO M.platit +*!* m.totdeb=0 +*!* ENDIF + + + +*!* USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +*!* &&precedente--------- +*!* IF TYPE('FURNIZORa.totdeb') = "U" +*!* SELECT NUME,COD_FISCAL,avans AS precavans,platit AS precdeb,achizit AS preccred FROM FURNIZORA INTO CURSOR rrr +*!* ELSE +*!* * Select NUME,COD_FISCAL,totavans As precavans,totdeb As precdeb,totcred As preccred From FURNIZORa Into Cursor rrr +*!* SELECT NUME,COD_FISCAL,NUMEVAL,; +*!* totavans AS precavans,totdeb AS precdeb,totcred AS preccred,; +*!* totavansV AS precavansV,totVALdeb AS precVALdeb,totVALcre AS precVALcre; +*!* FROM FURNIZORA INTO CURSOR rrr +*!* ENDIF + +*!* USE IN FURNIZORA + +*!* SELECT rcli +*!* APPEND FROM DBF('rrr') +*!* USE IN rrr + + +*!* &&rulaje------------ +*!* SELE rcli +*!* SET ORDER TO TAG NUME +*!* DO REDAU WITH 'SCC="401 " ','RCLI','M.NUME','ACHIZIT' +*!* DO REDAU WITH 'SCD="401 " ','RCLI','M.NUME','PLATIT' +*!* DO REDAU WITH 'SCD="409 " ','RCLI','M.NUME','AVANS' +*!* DO REDAUsc WITH 'SCc="409 " ','RCLI','M.NUME','AVANS' + +*!* DO REDAUVAL WITH 'SCC="401 " ','RCLI','M.NUME','ACHIZITVAL' +*!* DO REDAUVAL WITH 'SCD="401 " ','RCLI','M.NUME','PLATIVAL' +*!* DO REDAUVAL WITH 'SCD="409 " ','RCLI','M.NUME','AVANSVAL' +*!* DO REDAUscVAL WITH 'SCc="409 " ','RCLI','M.NUME','AVANSVAL' + +*!* SELECT rcli +*!* REPLACE ALL totdeb WITH precdeb+platit,; +*!* totcred WITH preccred+achizit,; +*!* totavans WITH precavans+avans +*!* REPLACE ALL totVALdeb WITH precVALdeb+PLATIVAL,; +*!* totVALcre WITH precVALcre+ACHIZITVAL,; +*!* totavansV WITH precavansV+AVANSVAL + +*!* *Do suprapune WITH 'FURNIZOR','rcli' +*!* SELECT FURNIZOR +*!* IF FLOCK() +*!* DELETE ALL +*!* APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +*!* ENDIF +*!* UNLOCK +*!* USE IN rcli +*!* USE IN FURNIZORU + +*!* SELECT FURNIZOR +*!* SET ORDER TO TAG NUME +*!* RETURN + + +*_________________________________________ +PROCEDURE VERBAL +LOCAL btotdeb,btotcred,bpreccred,bprecdeb,dateA,dateb,tsuma,ttotdeb,ttotcred +*i=1 +*STARE=1 +*orm=createobj('textmult') +OTEXT=CREATE('text_TREE') +STARE=1 + +CLOSE DATABASE +SELECT 0 +USE datEAN\calendar.DBF; +AGAIN ALIAS calendar ; +ORDER 0 +btotdeb=0 +btotcred=0 +bprecdeb=0 +bpreccred=0 +SELE calendar +SCAN + SCATTER MEMVAR + dateA=calefirma+'\an'+m.an+'\'+'date'+M.nl + + SELE 0 + USE &dateA\BAL.DBF SHARED + SELE 0 + USE &dateA\act.DBF SHARED + SELE BAL + SUM precdeb,preccred,RULDEB,RULCRED TO bprecdeb,bpreccred,ttotdeb,ttotcred + SELE act + SUM suma TO tsuma + + IF ttotdeb# tsuma + m.DENUMIRE='Diferente pe debit in luna '+M.nl+' '+M.an + DO mesajt WITH M.DENUMIRE +* WAIT WIND 'Diferente pe debit in luna '+M.NL+' '+M.AN + ENDIF + + IF ttotcred# tsuma + m.DENUMIRE='Diferente pe credit' + DO mesajt WITH M.DENUMIRE +* WAIT WIND 'Diferente pe credit' + ENDIF + + SELE BAL + IF btotdeb# bprecdeb OR btotcred # bpreccred + m.DENUMIRE='Eroare de preluare in luna '+M.nl+' '+M.an + DO mesajt WITH M.DENUMIRE +* WAIT WIND 'Eroare de preluare in luna '+M.NL+' '+M.AN + ELSE + m.DENUMIRE='Preluare corecta in luna '+M.nl+' '+M.an + DO mesajt WITH M.DENUMIRE +* WAIT WIND 'Preluare corecta in luna '+M.NL+' '+M.AN + ENDIF + + IF M.nl='12' + SUM SOLDDEB,SOLDCRED TO btotdeb,btotcred + ELSE + SUM totdeb,totcred TO btotdeb,btotcred + ENDIF + + SELE BAL + USE + SELE act + USE +ENDSCAN + +IF STARE!=1 + OTEXT.DEUNDE='C' + OTEXT.label10.CAPTION='RAPORT VERIFICARE BALANTA' + OTEXT.CMDLIST1.VISIBLE=.F. + OTEXT.CMDLIST2.VISIBLE=.F. + OTEXT.CMDRENUNT1.VISIBLE=.F. + OTEXT.SHOW(1) +ENDIF + +DO TOTV.PRG +RETURN + + +*_________________________________________ +PROCEDURE vercasa +LOCAL m.ban + +STORE 0 TO TINCASARI,TPLATI +m.ban='' +SELECT BAL +SEEK ('5311 ') +SCATTER MEMVAR +SELE CASA +SUM INCASARI,PLATI TO m.TINCASARI,M.TPLATI +IF M.TINCASARI-M.TPLATI# M.SOLDDEB +***WAIT WINDOWS 'DIFERENTA LA CASA '+STR(M.TINCASARI-M.TPLATI-M.SOLDDEB,10) + DO mesaj WITH 'Diferenta la casa: '+STR(M.TINCASARI-M.TPLATI-M.SOLDDEB,10),'' + +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE LA CASA IN LUNA '+NL+' ANUL '+M.AN + DO mesaj WITH 'Nu sunt deferente la casa in luna: '+nl+' '+M.an,'' + +*** +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE verBANCA +LOCAL m.ban + +STORE 0 TO TINCASARI,TPLATI +m.ban='' +SELECT BAL +SEEK ('5121 ') +SCATTER MEMVAR +SELE BANCA +SUM INCASARI,PLATI TO m.TINCASARI,M.TPLATI +IF M.TINCASARI-M.TPLATI# M.SOLDDEB +***WAIT WINDOWS 'DIFERENTA LA BANCA IN VALUTA '+STR(M.TINCASARI-M.TPLATI-M.SOLDDEB,10) + DO mesaj WITH 'Diferenta la banca in valuta: '+STR(M.TINCASARI-M.TPLATI-M.SOLDDEB,10),'' + +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE LA BANCA IN VALUTA IN LUNA '+NL+' ANUL '+M.AN + DO mesaj WITH 'Nu sunt deferente la banca in valuta in luna: '+nl+'$'+M.an,'' + +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE verVALBANCA +LOCAL m.ban + +STORE 0 TO TINCASARI,TPLATI +m.ban='' +SELECT BAL +SEEK ('5124 ') +SCATTER MEMVAR +SELE BANCAVAL +SUM INCASARI,PLATI TO m.TINCASARI,M.TPLATI +IF M.TINCASARI-M.TPLATI# M.SOLDDEB +***WAIT WINDOWS 'DIFERENTA LA BANCA '+STR(M.TINCASARI-M.TPLATI-M.SOLDDEB,10) + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta la banca: '+STR(M.TINCASARI-M.TPLATI-M.SOLDDEB,10) + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE LA BANCA IN LUNA '+NL+' ANUL '+M.AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Nu sunt diferente la banca in luna: '+nl+' '+M.an + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE VERCUMP +SELE CUMP +SUM totctva,neimpozab,totftvaI,tvaI,totftvaM,tvaM; +TO m.Stotctva,m.Sneimpozab,m.StotftvaI,m.StvaI,; +M.StotftvaM,m.StvaM + +m.ADUN=m.Sneimpozab+m.StotftvaI+m.StvaI+; +M.StotftvaM+m.StvaM + +SELE BAL +SEEK '401 ' +SCATTER MEMVAR +m.f401=m.RULCRED +SEEK '404 ' +SCATTER MEMVAR +m.f404=m.RULCRED +m.f401404=m.f401+m.f404 +IF M.Stotctva-M.ADUN#0 +***WAIT WINDOWS 'DIFERENTA ESTE DE '+STR(M.STOTCTVA-M.ADUN,12,0) + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta este: '+STR(M.Stotctva-M.ADUN,12,0) + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +IF M.Stotctva-M.f401404#0 +***WAIT WINDOWS 'DIFERENTA FATA DE 401+404 ESTE DE '+STR(M.STOTCTVA-M.f401404,12,0)+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta fata de 401+404 este: '+STR(M.Stotctva-M.f401404,12,0) + ot.label3.CAPTION='in luna '+nl+' '+an + ot.SHOW(1) +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE FATA DE 401+404'+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Nu sunt diferente fata de 401+404'+' in luna '+nl+' '+an + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE VERVANZ +SELE VANZ +SUM totctva,neimpozab,totftvaI,tvaI,totftvaM,tvaM; +TO m.Stotctva,m.Sneimpozab,m.StotftvaI,m.StvaI,; +M.StotftvaM,m.StvaM + +m.ADUN=m.Sneimpozab+m.StotftvaI+m.StvaI+; +M.StotftvaM+m.StvaM +SELE BAL +SEEK '411 ' +SCATTER MEMVAR +m.f411=m.RULDEB + +IF M.Stotctva-M.ADUN#0 +***WAIT WINDOWS 'DIFERENTA ESTE DE '+STR(M.STOTCTVA-M.ADUN,12,0) + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta este de: '+STR(M.Stotctva-M.ADUN,12,0) + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +IF M.Stotctva-M.f411#0 +***WAIT WINDOWS 'DIFERENTA FATA DE 411 ESTE DE '+STR(M.STOTCTVA-M.f411,12,0)+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta fata de 411 este de: '+STR(M.Stotctva-M.f411,12,0) + ot.label3.CAPTION='in luna '+nl+' '+an + ot.SHOW(1) +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE FATA DE 411'+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Nu sunt diferente fata de 411 in luna: '+nl+' '+an + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE VERFUR +SELE FURNIZOR +SUM achizit,platit,avans TO M.TACHIZIT,M.TPLATIT,M.TAVANS +SELE BAL +SEEK '401 ' +SCATTER MEMVAR +m.SOLD=M.SOLDCRED +SEEK '404 ' +SCATTER MEMVAR +m.SOLD=M.SOLDCRED+M.SOLD +IF M.SOLD # m.TACHIZIT-M.TPLATIT +***WAIT WINDOWS 'DIFERENTA LA SOLD ESTE DE '+STR(M.SOLD+M.TPLATIT-M.TACHIZIT)+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta la sold este '+STR(M.SOLD+M.TPLATIT-M.TACHIZIT) + ot.label3.CAPTION='in luna '+nl+' '+an + ot.SHOW(1) +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE LA FURNIZORI'+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Nu sunt diferente la furnizori'+' in luna '+nl+' '+an + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE VERCLI +SELECT clienti + +SUM avans,incasat,productie TO m.SUM1,M.SUM2,M.SUM3 +m.SUM4=m.SUM3-M.SUM2 +SELE BAL +SEEK '411 ' +SCATTER MEMVAR + +IF M.SOLDDEB # M.SUM3-M.SUM2 +***WAIT WINDOWS 'DIFERENTA IN SOLD FATA DE 411 ESTE DE '+STR(M.SOLDDEB-M.SUM3+M.SUM2)+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta in sold fata de 411 este '+STR(M.SOLDDEB-M.SUM3+M.SUM2) + ot.label3.CAPTION='in luna '+nl+' '+an + ot.SHOW(1) +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE LA CLIENTI'+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Nu sunt diferente la clienti '+' in luna '+nl+' '+an + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +RETURN + + +*_________________________________________ +PROCEDURE VERACHI +SELECT ACHIT542 +SUM LUAT,DAT TO m.SUM1,M.SUM2 +m.SUM3=M.SUM1-M.SUM2 +SELE BAL +SEEK '542 ' +SCATTER MEMVAR +IF M.SOLDDEB # M.SUM3 +***WAIT WINDOWS 'DIFERENTA SOLDULUI CONT.542 ESTE DE '+STR(M.SOLDDEB-M.SUM3)+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Diferenta soldului cont.542 este de: '+STR(M.SOLDDEB-M.SUM3) + ot.label3.CAPTION='in luna '+nl+' '+an + ot.SHOW(1) +*** +ELSE +***WAIT WINDOWS 'NU SUNT DIFERENTE LA 542'+' IN LUNA '+NL+' ANUL '+AN + ot=CREATEOBJ("text") + ot.label2.CAPTION='Nu sunt diferente la 542'+' in luna: '+nl+' '+an + ot.label3.VISIBLE=.F. + ot.SHOW(1) +*** +ENDIF +RETURN + + +*_________________________________________________________________ +PROCEDURE REFCasa +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + + +USE &dateA\casanume IN 0 SHARED ALIAS CASANUMEP +IF TYPE('casanumep.precdeb') # 'U' + SELECT casa, precdeb + incasari as precdeb, preccred + plati as preccred FROM casanumeP ; + INTO CURSOR tprec ORDER BY casa +ELSE + SELECT casa, incasari as precdeb, plati as preccred FROM casanumeP ; + INTO CURSOR tprec ORDER BY casa +ENDIF + +SELE CASA +IF FLOCK() + DELETE ALL + m.casa = 'SOLD' + m.DATAIREG = {} + m.COD = -1 + m.INCASARI = 0 + m.PLATI = 0 + m.scd = '' + m.scc = '' + SELE tprec + SCAN + SCATTER MEMVAR + SELE CASA + GOTO BOTTOM + APPE BLANK + m.INCASARI=M.precdeb-M.preccred + m.PLATI=0 + GATHER MEMVAR + SELE tprec + ENDSCAN + UNLOCK +ENDIF + +SELECT cod, dataireg, nume_3 as casa, scd, scc,; + IIF(scd = '5311', suma, 00000000000000) as incasari, ; + IIF(scc = '5311', suma, 00000000000000) as plati ; + FROM act WHERE scd = '5311' OR scc = '5311' ; + INTO CURSOR tact + +SELECT casa +APPEND FROM DBF('tact') +USE IN tact + + +SELECT CASANUME +IF FLOCK() + DELE ALL + APPEND FROM DBF('tprec') + + SELECT nume_3 as casa, ; + sum(IIF(scd = '5311', suma, 00000000000000)) as incasari, ; + sum(IIF(scc = '5311', suma, 00000000000000)) as plati ; + FROM act WHERE scd = '5311' OR scc = '5311' ; + INTO CURSOR tact; + GROUP BY 1 + + + SELECT tact + SCAN + SCATTER NAME ot + SELECT casanume + LOCATE FOR ALLTRIM(casa) = ALLTRIM(ot.casa) + IF !FOUND() + APPEND blank + REPLACE casa WITH ot.casa + ENDIF + REPLACE incasari WITH incasari + ot.incasari, plati WITH plati + ot.plati + SELECT tact + ENDSCAN + +UNLOCK +ENDIF + +IF USED('tact') + USE IN tact +ENDIF +USE IN tprec +USE IN CASANUMEP + +*!* SELE act +*!* SCAN FOR scd='5311' +*!* SCATTER MEMVAR +*!* IF LEFT(m.nume_3,2)=' ' +*!* REPL nume_3 WITH 'CENTRALA' +*!* m.nume_3='CENTRALA' +*!* ENDIF +*!* SELE CASA +*!* m.CASA=M.nume_3 +*!* m.INCASARI=M.suma +*!* m.PLATI=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN + +*!* SCAN FOR scc='5311' +*!* SCATTER MEMVAR +*!* IF LEFT(m.nume_3,2)=' ' +*!* REPL nume_3 WITH 'CENTRALA' +*!* m.nume_3='CENTRALA' +*!* ENDIF +*!* SELE CASA +*!* m.CASA=M.nume_3 +*!* m.PLATI=M.suma +*!* m.INCASARI=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN +*!* ENDIF +****WAIT WIND 'J' + + +*!* SELE 0 +*!* USE &DATE\casanume + + +*!* IF FLOCK() + +*!* SELE CASA +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE casanume +*!* LOCA FOR CASA=ALLTRIM(M.CASA) +*!* IF NOT FOUND() +*!* GOTO BOTTOM +*!* APPE BLANK +*!* REPL CASA WITH M.CASA +*!* ENDIF +*!* SELE CASA +*!* ENDSCAN + +*!* SELE casanume +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE CASA +*!* SUM INCASARI,PLATI TO M.INCASARI,M.PLATI FOR ALLTRIM(CASA)=ALLTRIM(M.CASA) +*!* SELE casanume + +*!* REPL INCASARI WITH M.INCASARI +*!* REPL PLATI WITH M.PLATI +*!* SELE casanume +*!* ENDSCAN +*!* ENDIF + +*!* UNLOCK IN CASA +*!* UNLOCK IN casanume + +SELE CASA +SET ORDER TO TAG DATAIREG +RETURN + + + + + + +*__________________________________________________ +PROCEDURE REFBANCA +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +USE &dateA\bannume IN 0 SHARED ALIAS banNUMEP +IF TYPE('bannumep.precdeb') # 'U' + SELECT nume_2, precdeb + incasari as precdeb, preccred + plati as preccred FROM bannumeP ; + INTO CURSOR tprec ORDER BY nume_2 +ELSE + SELECT nume_2, incasari as precdeb, plati as preccred FROM bannumeP ; + INTO CURSOR tprec ORDER BY nume_2 +ENDIF + +SELE banca +IF FLOCK() + DELETE ALL + m.DATAIREG = {} + m.COD = -1 + m.INCASARI = 0 + m.PLATI = 0 + m.scd = '' + m.scc = '' + SELE tprec + SCAN + SCATTER MEMVAR + m.INCASARI = M.precdeb-M.preccred + m.PLATI = 0 + m.banca = m.nume_2 + SELE banca + GOTO BOTTOM + APPE BLANK + GATHER MEMVAR + SELE tprec + ENDSCAN + UNLOCK +ENDIF + +SELECT cod, dataireg, nume_2 as banca, scd, scc,; + IIF(scd = '5121', suma, 00000000000000) as incasari, ; + IIF(scc = '5121', suma, 00000000000000) as plati ; + FROM act WHERE scd = '5121' OR scc = '5121' ; + INTO CURSOR tact + +SELECT banca +APPEND FROM DBF('tact') +USE IN tact + + +SELECT banNUME +IF FLOCK() + DELE ALL + APPEND FROM DBF('tprec') + + SELECT nume_2 as banca, ; + sum(IIF(scd = '5121', suma, 00000000000000)) as incasari, ; + sum(IIF(scc = '5121', suma, 00000000000000)) as plati ; + FROM act WHERE scd = '5121' OR scc = '5121' ; + INTO CURSOR tact; + GROUP BY 1 + + + SELECT tact + SCAN + SCATTER NAME ot + SELECT bannume + LOCATE FOR ALLTRIM(nume_2) = ALLTRIM(ot.banca) + IF !FOUND() + APPEND blank + REPLACE nume_2 WITH ot.banca + ENDIF + REPLACE incasari WITH incasari + ot.incasari, plati WITH plati + ot.plati + SELECT tact + ENDSCAN + +UNLOCK +ENDIF + +IF USED('tact') + USE IN tact +ENDIF +USE IN tprec +USE IN banNUMEP + +*!* SELE BANCA +*!* SET ORDER TO TAG COD +*!* IF FLOCK() +*!* DELE ALL + + +*!* SELE BANNUME +*!* USE +*!* SELE 0 +*!* USE &dateA\BANNUME + +*!* m.DATAIREG={} +*!* m.COD=-1 +*!* m.INCASARI=0 +*!* m.PLATI=0 +*!* m.scd='' +*!* m.scc='' +*!* SELE BANNUME +*!* SCAN +*!* SCATTER MEMVAR +*!* m.BANCA=m.nume_2 +*!* SELE BANCA +*!* GOTO BOTTOM +*!* APPE BLANK +*!* m.INCASARI=M.INCASARI-M.PLATI +*!* m.PLATI=0 +*!* GATHER MEMVAR +*!* SELE BANNUME +*!* ENDSCAN +*!* SELE BANNUME +*!* USE +*!* SELE BANCA +*!* m.BANCA='BANCA COMPENSARI' +*!* m.INCASARI=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR + +*!* SELE act +*!* SCAN FOR scd='5121' +*!* SCATTER MEMVAR +*!* SELE BANCA +*!* m.BANCA=M.nume_2 +*!* m.INCASARI=M.suma +*!* m.PLATI=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN + +*!* SCAN FOR scc='5121' +*!* SCATTER MEMVAR +*!* SELE BANCA +*!* m.BANCA=M.nume_2 +*!* m.PLATI=M.suma +*!* m.INCASARI=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN +*!* ENDIF + + +*!* SELE 0 +*!* USE &DATE\BANNUME +*!* IF FLOCK() +*!* DELE ALL +*!* &&&exclusive +*!* &&&zap + +*!* SELE BANCA +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE BANNUME +*!* LOCA FOR nume_2=ALLTRIM(M.BANCA) +*!* IF NOT FOUND() +*!* GOTO BOTTOM +*!* APPE BLANK +*!* REPL nume_2 WITH M.BANCA +*!* ENDIF +*!* SELE BANCA +*!* ENDSCAN + +*!* SELE BANNUME +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE BANCA +*!* SUM INCASARI,PLATI TO M.INCASARI,M.PLATI FOR BANCA=M.nume_2 +*!* SELE BANNUME +*!* REPL INCASARI WITH M.INCASARI +*!* REPL PLATI WITH M.PLATI +*!* SELE BANNUME +*!* ENDSCAN +*!* ENDIF +*!* UNLOCK IN BANCA +*!* UNLOCK IN BANNUME + +SELE BANCA +SET ORDER TO TAG DATAIREG +RETURN + + + + +*_________________________________________ +PROCEDURE REFBancaVal && REFVALBANCA +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + + +USE &dateA\banvnume IN 0 SHARED ALIAS banvnumeP +IF TYPE('banvnumep.precdeb') # 'U' + SELECT nume_3, numeval, ; + precdeb + incasari as precdeb, preccred + plati as preccred, ; + precvaldeb + incasval as precvaldeb, precvalcre + platival as precvalcre ; + FROM banvnumeP ; + INTO CURSOR tprec ORDER BY nume_3 +ELSE + SELECT nume_3, numeval, incasari as precdeb, plati as preccred, incasval as precvaldeb, platival as precvalcre ; + FROM banvnumeP ; + INTO CURSOR tprec ORDER BY nume_3 +ENDIF + +SELE bancaval +IF FLOCK() + DELETE ALL + m.DATAIREG={} + m.COD=-1 + m.INCASARI=0 + m.PLATI=0 + m.incasval=0 + m.platival=0 + m.scd='' + m.scc='' + m.CURSSCHIMB=0 + m.CURSBNR=0 + + SELE tprec + SCAN + SCATTER MEMVAR + m.INCASARI = M.precdeb-M.preccred + m.PLATI = 0 + m.INCASval = M.precvaldeb-M.precvalcre + m.PLATIval = 0 + m.banca = m.nume_3 + SELE bancaval + GOTO BOTTOM + APPE BLANK + GATHER MEMVAR + SELE tprec + ENDSCAN + UNLOCK +ENDIF + +SELECT cod, dataireg, nume_3 as banca, scd, scc, suma_3 as cursschimb, nume_4 as numeval, ; + IIF(scd = '5124', suma, 00000000000000) as incasari, ; + IIF(scc = '5124', suma, 00000000000000) as plati, ; + IIF(scd = '5124', suma_2, 000000000000.00) as incasval, ; + IIF(scc = '5124', suma_2, 000000000000.00) as platival ; + FROM act WHERE scd = '5124' OR scc = '5124' ; + INTO CURSOR tact + +SELECT bancaval +APPEND FROM DBF('tact') +USE IN tact + + +SELECT banvnume +IF FLOCK() + DELE ALL + APPEND FROM DBF('tprec') + +SELECT nume_3 as bancaval, nume_4 as numeval, ; + sum(IIF(scd = '5124', suma, 00000000000000)) as incasari, ; + sum(IIF(scc = '5124', suma, 00000000000000)) as plati, ; + sum(IIF(scd = '5124', suma_2, 000000000000.00)) as incasval, ; + sum(IIF(scc = '5124', suma_2, 000000000000.00)) as platival ; + FROM act WHERE scd = '5124' OR scc = '5124' ; + INTO CURSOR tact; + GROUP BY 1 + + + SELECT tact + SCAN + SCATTER NAME ot + SELECT banvnume + LOCATE FOR ALLTRIM(nume_3) = ALLTRIM(ot.bancaval) + IF !FOUND() + APPEND blank + REPLACE nume_3 WITH ot.bancaval + REPLACE numeval WITH ot.numeval + ENDIF + REPLACE incasari WITH incasari + ot.incasari, plati WITH plati + ot.plati + REPLACE incasval WITH incasval + ot.incasval, platival WITH platival + ot.platival + SELECT tact + ENDSCAN + +UNLOCK +ENDIF + +IF USED('tact') + USE IN tact +ENDIF +USE IN tprec +USE IN banvnumeP + +*!* SELE BANCAVAL +*!* IF FLOCK() +*!* DELE ALL +*!* SET ORDER TO TAG COD +*!* &&&ZAP + +*!* SELE BANVNUME +*!* USE + +*!* SELE 0 +*!* USE &dateA\BANVNUME + +*!* m.DATAIREG={} +*!* m.COD=-1 +*!* m.INCASARI=0 +*!* m.PLATI=0 +*!* m.incasval=0 +*!* m.platival=0 +*!* m.scd='' +*!* m.scc='' +*!* m.CURSSCHIMB=0 +*!* m.CURSBNR=0 +*!* SELE BANVNUME +*!* SCAN +*!* SCATTER MEMVAR +*!* m.BANCA=m.nume_3 +*!* SELE BANCAVAL +*!* APPE BLANK +*!* m.INCASARI=M.INCASARI-M.PLATI +*!* m.incasval=M.incasval-M.platival +*!* m.PLATI=0 +*!* m.platival=0 +*!* GATHER MEMVAR +*!* SELE BANVNUME +*!* ENDSCAN + +*!* SELE BANVNUME +*!* USE +*!* SELE BANCAVAL +*!* m.BANCA='BANCA COMPENSARI' +*!* m.INCASARI=0 +*!* m.incasval=0 +*!* APPE BLANK +*!* GATHER MEMVAR + +*!* SELE act +*!* SCAN FOR scd='5124' +*!* SCATTER MEMVAR +*!* SELE BANCAVAL +*!* m.BANCA=M.nume_3 +*!* m.INCASARI=M.suma + +*!* m.incasval=M.suma_2 +*!* m.CURSSCHIMB=M.SUMA_3 + +*!* m.SBNR=SUBSTR(M.EXPLICATIA,8,14) +*!* m.CURSBNR=VAL(M.SBNR) +*!* m.PLATI=0 +*!* m.platival=0 +*!* m.NUMEVAL=m.nume_4 +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN + +*!* SELE act +*!* SCAN FOR scc='5124' +*!* SCATTER MEMVAR +*!* SELE BANCAVAL +*!* m.BANCA=M.nume_3 +*!* m.PLATI=M.suma +*!* m.platival=M.suma_2 +*!* m.CURSSCHIMB=M.SUMA_3 +*!* m.SBNR=SUBSTR(M.EXPLICATIA,8,14) +*!* m.CURSBNR=VAL(M.SBNR) +*!* m.INCASARI=0 +*!* m.incasval=0 +*!* m.NUMEVAL=m.nume_4 +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN +*!* ENDIF +*!* &&REFACERE BANVNUME DUPA BANCAVAL===================== +*!* SELE 0 +*!* USE &DATE\BANVNUME +*!* IF FLOCK() +*!* DELE ALL + +*!* &&NUMELE BANCILOR============= +*!* SELE BANCAVAL +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE BANVNUME +*!* LOCA FOR nume_3=M.BANCA +*!* IF NOT FOUND() +*!* GOTO BOTTOM +*!* APPE BLANK +*!* REPL nume_3 WITH M.BANCA +*!* ENDIF +*!* SELE BANVNUME +*!* REPL NUMEVAL WITH m.NUMEVAL +*!* SELE BANCAVAL +*!* ENDSCAN +*!* &&VALORILE========== +*!* SELE BANVNUME +*!* SCAN +*!* SCATTER FIEL nume_3 MEMVAR +*!* SELE BANCAVAL +*!* SUM INCASARI,PLATI,incasval,platival TO M.INCASARI,M.PLATI,M.incasval,M.platival FOR ALLT(BANCA)=ALLT(M.nume_3) +*!* IF EMPTY(ALLT(M.nume_3)) +*!* SUM INCASARI,PLATI,incasval,platival TO M.INCASARI,M.PLATI,M.incasval,M.platival FOR EMPTY(ALLT(BANCA)) +*!* ENDIF +*!* SELE BANVNUME +*!* REPL INCASARI WITH M.INCASARI +*!* REPL PLATI WITH M.PLATI +*!* REPL incasval WITH M.incasval +*!* REPL platival WITH M.platival +*!* SELE BANVNUME +*!* ENDSCAN +*!* ENDIF +*!* UNLOCK IN BANCA +*!* UNLOCK IN BANCAVAL + +SELE BANCAVAL +SET ORDER TO TAG DATAIREG +RETURN + + + + +*__________________________________________________ +PROCEDURE REFCec +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + + +USE &dateA\CECnume IN 0 SHARED ALIAS CECNUMEP +IF TYPE('CECnumep.precdeb') # 'U' + SELECT CEC, precdeb + INCARCAT as precdeb, preccred + plati as preccred FROM CECnumeP ; + INTO CURSOR tprec ORDER BY CEC +ELSE + SELECT CEC, INCARCAT as precdeb, plati as preccred FROM CECnumeP ; + INTO CURSOR tprec ORDER BY CEC +ENDIF + +SELE CEC +IF FLOCK() + DELETE ALL + m.CEC = 'SOLD' + m.DATAIREG = {} + m.COD = -1 + m.INCARCAT = 0 + m.PLATI = 0 + m.scd = '' + m.scc = '' + SELE tprec + SCAN + SCATTER MEMVAR + SELE CEC + GOTO BOTTOM + APPE BLANK + m.INCARCAT=M.precdeb-M.preccred + m.PLATI=0 + GATHER MEMVAR + SELE tprec + ENDSCAN + UNLOCK +ENDIF + +SELECT cod, dataireg, CEC, scd, scc,; + IIF(scd = '5112', suma, 00000000000000) as INCARCAT, ; + IIF(scc = '5112', suma, 00000000000000) as plati ; + FROM act WHERE scd = '5112' OR scc = '5112' ; + INTO CURSOR tact + +SELECT CEC +APPEND FROM DBF('tact') +USE IN tact + + +SELECT CECNUME +IF FLOCK() + DELE ALL + APPEND FROM DBF('tprec') + + SELECT CEC, ; + sum(IIF(scd = '5112', suma, 00000000000000)) as INCARCAT, ; + sum(IIF(scc = '5112', suma, 00000000000000)) as plati ; + FROM act WHERE scd = '5112' OR scc = '5112' ; + INTO CURSOR tact; + GROUP BY 1 + + + SELECT tact + SCAN + SCATTER NAME ot + SELECT CECnume + LOCATE FOR ALLTRIM(CEC) = ALLTRIM(ot.CEC) + IF !FOUND() + APPEND blank + REPLACE CEC WITH ot.CEC + ENDIF + REPLACE INCARCAT WITH INCARCAT + ot.INCARCAT, plati WITH plati + ot.plati + SELECT tact + ENDSCAN + +UNLOCK +ENDIF + +IF USED('tact') + USE IN tact +ENDIF +USE IN tprec +USE IN CECNUMEP + + + +*!* SELE cec +*!* *set order to tag cod +*!* IF FLOCK() +*!* DELE ALL + + +*!* SELE cecnume +*!* USE +*!* IF !FILE('&DATEA\cecnume.dbf') +*!* COPY FILE &dirgen\_alfa\an0000\date00\cecnume.* TO &dateA\*.* +*!* ENDIF +*!* SELE 0 +*!* USE &dateA\cecnume + +*!* m.DATAIREG={} +*!* m.COD=-1 +*!* m.INcarcat=0 +*!* m.PLATI=0 +*!* m.scd='' +*!* m.scc='' +*!* ********incarcare solduri precedente +*!* SELE cecnume +*!* SCAN +*!* SCATTER MEMVAR +*!* *m.cec=m.explicatia +*!* SELE cec +*!* GOTO BOTTOM +*!* APPE BLANK +*!* m.INcarcat=M.INcarcat-M.PLATI +*!* m.PLATI=0 +*!* GATHER MEMVAR +*!* SELE cecnume +*!* ENDSCAN +*!* SELE cecnume +*!* USE + +*!* **********************incarcare in cec lunca curenta +*!* SELE act +*!* SCAN FOR scd='5112' +*!* SCATTER MEMVAR +*!* SELE cec +*!* m.cec=m.EXPLICATIA +*!* m.INcarcat=M.suma +*!* m.PLATI=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN + +*!* SCAN FOR scc='5112' +*!* SCATTER MEMVAR +*!* SELE cec +*!* m.cec=m.EXPLICATIA +*!* m.PLATI=M.suma +*!* m.INcarcat=0 +*!* GOTO BOTTOM +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN +*!* ENDIF + + +*!* SELE 0 +*!* USE &DATE\cecnume +*!* IF FLOCK() +*!* DELE ALL +*!* &&&exclusive +*!* &&&zap +*!* ********************incarcare denumiri in ccecnume +*!* SELE cec +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE cecnume +*!* LOCA FOR ALLTRIM(cec)=ALLTRIM(M.cec) +*!* IF NOT FOUND() +*!* GOTO BOTTOM +*!* APPE BLANK +*!* REPL cec WITH M.cec +*!* ENDIF +*!* SELE cec +*!* ENDSCAN +*!* *************************incarcare soduri in cecnume +*!* SELE cecnume +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE cec +*!* SUM INcarcat,PLATI TO M.INcarcat,M.PLATI FOR cec=M.cec +*!* SELE cecnume +*!* REPL INcarcat WITH M.INcarcat +*!* REPL PLATI WITH M.PLATI +*!* SELE cecnume +*!* ENDSCAN +*!* ENDIF +*!* UNLOCK IN cec +*!* UNLOCK IN cecnume + +SELE cec +SET ORDER TO TAG DATAIREG +RETURN + + + +*_________________________________________ +PROCEDURE REDAU +PARAMETERS CT,ALI,ETI,CIMP +IF ETI='M.NUME_2' + CIMP1='NUME_2' +ELSE + CIMP1='NUME' +ENDIF + +SELE &ALI +SELE act +SCAN FOR &CT + SCATTER MEMVAR + SELE &ALI + SEEK &ETI + IF FOUND() + REPL &CIMP WITH &CIMP +M.suma +*!* IF INLIST(UPPER(ALI),'FURNIZOR','CLIENTI',"RCLI",'ANA408','CLIENT4118') +*!* REPL COD_FISCAL WITH m.COD_FISCAL +*!* ENDIF + lcCod = m.COD_FISCAL + IF EMPTY(COD_FISCAL) AND !EMPTY(lcCod) + REPLACE COD_FISCAL WITH lcCod + ENDIF + + ELSE + GOTO BOTTOM + APPE BLANK + REPL &CIMP1 WITH &ETI + REPL &CIMP WITH &CIMP +M.suma + IF INLIST(UPPER(ALI),'FURNIZOR','CLIENTI',"RCLI",'ANA408','CLIENT4118') + REPL COD_FISCAL WITH m.COD_FISCAL + ENDIF + GO TOP + ENDIF + SELE act +ENDSCAN +RETURN + + +*_________________________________________ +PROCEDURE REDAUVAL +PARAMETERS CT,ALI,ETI,CIMP +IF ETI='M.NUME_2' + CIMP1='NUME_2' +ELSE + CIMP1='NUME' +ENDIF +SELE &ALI +SELE act +SCAN FOR &CT + SCATTER MEMVAR + IF M.SUMA_3#0 + SELE &ALI + SEEK &ETI + IF FOUND() + REPL &CIMP WITH &CIMP +M.suma_2 + REPLACE NUMEVAL WITH M.nume_4 +*If Inlist(Upper(ALI),'FURNIZOR','CLIENTI') +* REPL COD_FISCAL WITH m.COD_FISCAL +*Endif + ELSE + GOTO BOTTOM + APPE BLANK + REPL &CIMP1 WITH &ETI + REPL &CIMP WITH &CIMP +M.suma_2 + REPLACE NUMEVAL WITH M.nume_4 + REPL COD_FISCAL WITH m.COD_FISCAL + GO TOP + ENDIF + ENDIF + SELE act +ENDSCAN +RETURN + +************ +PROCEDURE REDAUsc +PARAMETERS CT,ALI,ETI,CIMP +IF ETI='M.NUME_2' + CIMP1='NUME_2' +ELSE + CIMP1='NUME' +ENDIF +SELE &ALI +SELE act +SCAN FOR &CT + SCATTER MEMVAR + SELE &ALI + SEEK &ETI + IF FOUND() + REPL &CIMP WITH &CIMP -M.suma + ELSE + GOTO BOTTOM + APPE BLANK + REPL &CIMP1 WITH &ETI + REPL &CIMP WITH &CIMP +M.suma + GO TOP + ENDIF + SELE act +ENDSCAN +RETURN + +************ +PROCEDURE REDAUscVAL +PARAMETERS CT,ALI,ETI,CIMP +IF ETI='M.NUME_2' + CIMP1='NUME_2' +ELSE + CIMP1='NUME' +ENDIF +SELE &ALI +SELE act +SCAN FOR &CT + SCATTER MEMVAR + IF M.SUMA_3#0 + SELE &ALI + SEEK &ETI + IF FOUND() + REPL &CIMP WITH &CIMP -M.suma_2 + REPLACE NUMEVAL WITH M.nume_4 + ELSE + GOTO BOTTOM + APPE BLANK + REPL &CIMP1 WITH &ETI + REPL &CIMP WITH &CIMP +M.suma_2 + REPLACE NUMEVAL WITH M.nume_4 + GO TOP + ENDIF + ENDIF + SELE act +ENDSCAN +RETURN + + + + +*_________________________________________ + +PROCEDURE REFDEBITOR +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\DEBITOR.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'DEBITOR.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\DEBITOR.DBF IN 0 ALIAS DEBITORU + +SELECT DEBITORU + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('DEBITORu.totdeb') = 'U' + SELECT NUME,COD_FISCAL, LUAT AS precdeb, DAT AS preccred FROM DEBITORU INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit, totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit +*REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('DEBITORu.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM DEBITORU INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM DEBITORU INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN DEBITORU + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA + +SELECT NUME, ; +IIF(LEFT(scd,3) = '461', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '461', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '461', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '461', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '461', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('461',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t461 GROUP BY 1, 2, 3 + +SELECT t461 +SCAN + SCATTER NAME o461 + SELECT rcli + SEEK LEFT(o461.NUME,30) + o461.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o461.COD_FISCAL + ENDIF + REPLACE debit WITH debit + o461.debit, credit WITH credit + o461.credit, valdebit WITH valdebit + o461.valdebit, valcredit WITH valcredit + o461.valcredit + ELSE + SEEK LEFT(o461.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o461.acont + REPLACE debit WITH debit + o461.debit, credit WITH credit + o461.credit, valdebit WITH valdebit + o461.valdebit, valcredit WITH valcredit + o461.valcredit + ELSE + APPEND BLANK + GATHER NAME o461 + ENDIF + ENDIF + + SELECT t461 +ENDSCAN +RELEASE o461 +USE IN t461 + +SELECT rcli +REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit &&,totavans WITH precavans+avans +REPLACE ALL totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit &&,TOTAVANSV WITH PRECAVANSV+AVANSVAL + +SELECT DEBITOR +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +SELECT DEBITOR +SET ORDER TO TAG NANA +RETURN + + +*_________________________________________ + +PROCEDURE REFCreditor +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\creditor.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'creditor.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\creditor.DBF IN 0 ALIAS creditorU + +SELECT creditorU + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('creditoru.totdeb') = 'U' + SELECT NUME,COD_FISCAL, DAT AS precdeb, LUAT AS preccred FROM creditorU INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit, totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit +*REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('creditoru.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM creditorU INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM creditorU INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN creditorU + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA +SELECT IIF(LEFT(scc,3) = '462' AND INLIST(LEFT(scd,3),'411','451') AND !EMPTY(nume_2), nume_2, NUME) AS NUME, ; +IIF(LEFT(scd,3) = '462', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '462', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '462', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '462', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '462', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('462',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t462 GROUP BY 1, 2, 3 + +SELECT t462 +SCAN + SCATTER NAME o462 + SELECT rcli + SEEK LEFT(o462.NUME,30) + o462.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o462.COD_FISCAL + ENDIF + REPLACE debit WITH debit + o462.debit, credit WITH credit + o462.credit, valdebit WITH valdebit + o462.valdebit, valcredit WITH valcredit + o462.valcredit + ELSE + SEEK LEFT(o462.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o462.acont + REPLACE debit WITH debit + o462.debit, credit WITH credit + o462.credit, valdebit WITH valdebit + o462.valdebit, valcredit WITH valcredit + o462.valcredit + ELSE + APPEND BLANK + GATHER NAME o462 + ENDIF + ENDIF + + SELECT t462 +ENDSCAN +RELEASE o462 +USE IN t462 + +SELECT rcli +REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit &&,totavans WITH precavans+avans +REPLACE ALL totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit &&,TOTAVANSV WITH PRECAVANSV+AVANSVAL + +SELECT creditor +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +SELECT creditor +SET ORDER TO TAG NANA +RETURN + +*_________________________________________ +PROCEDURE VERdebitor +SELECT DEBITOR +SUM LUAT,DAT TO m.SUM1,M.SUM2 +m.SUM3=M.SUM1-M.SUM2 +SELE BAL +SEEK '461 ' +SCATTER MEMVAR +IF M.SOLDDEB # M.SUM3 + DO mesajval WITH 'Diferenta soldului cont.461 este de: ',M.SOLDDEB-M.SUM3 +*** +ELSE + DO mesaj WITH 'Nu sunt diferente la 461',' in luna: '+nl+' '+an +*** +ENDIF +RETURN + +*_________________________________________ +PROCEDURE VERcreditor +SELECT creditor +SUM LUAT,DAT TO m.SUM1,M.SUM2 +m.SUM3=M.SUM1-M.SUM2 +SELE BAL +SEEK '462 ' +SCATTER MEMVAR +IF M.SOLDCRED # M.SUM3 + DO mesajval WITH 'Diferenta soldului cont.462 este de: ',M.SOLDDEB-M.SUM3 +*** +ELSE + DO mesaj WITH 'Nu sunt diferente la 462',' in luna: '+nl+' '+an +*** +ENDIF +RETURN + + + +*____________________________________________________________________________________________________________ +*** INCEPUT PROCEDURA REFCUMP +PROCEDURE REFCump && refcumpnou + + +LOCAL lnTipTVA,llProcTva + + +llProcTva=.F. +SELECT act +IF TYPE('act.proc_tva')!="U" && daca exista campul proc_tva + llProcTva=.T. +ENDIF +DO CASE + CASE m.ctvam = 1 AND m.ctvai = 1 OR !llProcTva && firma neplatitoare de TVA + lnTipTVA = 1 + CASE (m.ctvam >1 AND m.ctvai = m.ctvam) OR !llProcTva && firma platitoare de TVA inainte de TVA REDUS + lnTipTVA = 2 + CASE (m.ctvam >=1 AND m.ctvai != m.ctvam) AND llProcTva && firma platitoare de TVA cu TVA REDUS adica am coloana proc_tva + lnTipTVA = 3 + OTHERWISE && consider firma platitoare de TVA inainte de TVA REDUS + lnTipTVA = 2 +ENDCASE + +locCond = [(SCC='401 ' OR SCC='404 ' OR (SCC='4428' AND SCD='4426'))] +IF gle4511 + SELECT * FROM act WHERE (&locCond OR COD IN (SELE DISTINCT COD FROM act WHERE (scc = '4511' AND (scd = '4426' OR !EMPTY(neimpozab))))) AND scc # '767 ' ; + INTO CURSOR tact +ELSE + SELECT * FROM act WHERE &locCond INTO CURSOR tact +ENDIF + + +*!* IF gle4511 +*!* locCond = [(SCC='401 ' OR SCC='404 ' OR (SCC='4428' AND SCD='4426') OR (scc = '4511' and (scd = '4426' or !EMPTY(neimpozab))))] +*!* ELSE +*!* locCond = [(SCC='401 ' OR SCC='404 ' OR (SCC='4428' AND SCD='4426'))] +*!* ENDIF + +SELE CUMP +IF FLOCK() + DELE ALL + + + SELE tact +*SET FILTER TO SCC='401 ' OR SCC='404 ' OR (SCC='4428' AND SCD='4426') +*SET FILTER TO &locCond + + STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA + SCAN FOR fdoc#'Nota modificare stoc' + SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,scc,scd MEMV + SELE CUMP + LOCA FOR NUME=m.NUME AND dataact=m.dataact AND nract=m.nract + IF !FOUND() + SELE CUMP + APPE BLAN + GATH MEMV +* REPLACE scd WITH m.scc && nu-i bine din cauza selectiei : Marfa - Alte achizitii + ENDIF + SELE tact + ENDSCAN +******* +SELECT cump + + + SELE CUMP + SCAN + SCAT MEMV + SELE tact + STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA + IF USED('tact5') + USE IN tact5 + ENDIF + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + SELECT suma,neimpozab,scd,scc FROM tact ; + WHERE NUME=m.NUME AND dataact=m.dataact AND nract=m.nract ; + INTO CURSOR tact5 NOFILTER + OTHERWISE + SELECT suma,neimpozab,scd,scc,IIF(proc_tva=0 AND neimpozab=0,m.ctvam,proc_tva) AS proc_tva FROM tact ; + WHERE NUME=m.NUME AND dataact=m.dataact AND nract=m.nract ; + INTO CURSOR tact5 NOFILTER + + ENDCASE + SELECT tact5 + SCAN + DO CASE + CASE scd='4426' + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + m.tvaM=M.tvaM+suma + OTHERWISE && dupa tva redus + IF proc_tva=m.ctvam OR proc_tva=0 + m.tvaM=M.tvaM+suma + ELSE + IF proc_tva=m.ctvai + m.tvaI=m.tvaI+suma + ENDIF + ENDIF + ENDCASE + + + CASE scd#'4426' + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + m.totftvaM=M.totftvaM+(suma-neimpozab) + OTHERWISE + IF proc_tva=m.ctvam OR (proc_tva=0 AND neimpozab=0) + m.totftvaM=M.totftvaM+(suma-neimpozab) + ELSE + IF proc_tva=m.ctvai + m.totftvaI=M.totftvaI+(suma-neimpozab) + ENDIF + ENDIF + ENDCASE + + + m.neimpozab=m.neimpozab+neimpozab + + IF LEFT(scd,3)='371' + m.scd=scd + ENDIF +*!* IF SCD='635 ' + +*!* m.neimpozab=m.neimpozab+SUMA +*!* DO CASE +*!* CASE INLIST(lnTipTVA,1,2) && inainte de tva redus +*!* m.totftvaM=m.totftvaM-SUMA +*!* OTHERWISE +*!* IF proc_tva=m.ctvam OR (proc_tva=0 AND neimpozab=0) +*!* m.totftvaM=m.totftvaM-SUMA +*!* ELSE +*!* IF proc_tva=m.ctvai +*!* m.totftvaI=m.totftvaI-SUMA +*!* ENDIF +*!* ENDIF +*!* ENDCASE +*!* ENDIF + ENDCASE + + + ENDSCAN + IF USED('tact5') + USE IN tact5 + ENDIF + +*!* Scan For NUME=m.NUME And dataact=m.dataact And nract=m.nract +*!* Do Case +*!* Case SCD='4426' +*!* m.tvaM=M.tvaM+SUMA + +*!* Case SCD#'4426' +*!* m.totftvaM=M.totftvaM+(SUMA-neimpozab) +*!* m.neimpozab=m.neimpozab+neimpozab +*!* If Left(SCD,3)='371' +*!* m.SCD=SCD +*!* Endif +*!* If SCD='635 ' +*!* m.neimpozab=m.neimpozab+SUMA +*!* m.totftvaM=m.totftvaM-SUMA +*!* Endif +*!* Endcase +*!* ENDSCAN + + +*********** + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + m.totctva=M.tvaM+M.totftvaM+M.neimpozab + SELE CUMP + REPL tvaM WITH M.tvaM; + totftvaM WITH M.totftvaM; + neimpozab WITH M.neimpozab; + totctva WITH M.totctva + OTHERWISE + m.totctva=M.tvaM+M.totftvaM+m.tvaI+m.totftvaI+M.neimpozab + SELE CUMP + REPL tvaM WITH M.tvaM; + totftvaM WITH M.totftvaM; + tvaI WITH M.tvaI; + totftvaI WITH M.totftvaI; + neimpozab WITH M.neimpozab; + totctva WITH M.totctva + ENDCASE +*************************************** + SELECT FURNIZOR + LOCATE FOR NUME = m.NUME + IF FOUND() + lcCodFiscal = COD_FISCAL + SELECT CUMP + REPLACE COD_FISCAL WITH lcCodFiscal + ENDIF +**************************************** + SELECT CUMP + + ENDSCAN + +************** + + SELE act +* SCAN FOR SCD='408 ' + SCAN FOR scd='4426' AND scc='4428' &&&&&&& modificare la 11 martie 2004, Georgiana + SCAT MEMV + SELE CUMP + LOCA FOR NUME=m.NUME AND dataact=m.dataact AND nract=m.nract + IF FOUND() + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus +* REPL totftvaM WITH ROUND(tvaM/(m.ctvam-1),0) + IF totftvaM # 0 && pt 4426 = 4428 fara baza + REPL totftvaM WITH totftvaM - m.suma + ENDIF + REPL totctva WITH totftvaM+tvaM+neimpozab + OTHERWISE + IF m.proc_tva=m.ctvam OR (m.proc_tva=0 AND m.neimpozab=0) +* REPL totftvaM WITH ROUND(tvaM/(m.ctvam-1),0) + IF totftvaM # 0 && pt 4426 = 4428 fara baza + REPLACE totftvaM WITH totftvaM - m.suma + ENDIF + ELSE + IF m.proc_tva=m.ctvai +* REPLACE totftvai WITH ROUND(tvai/(m.ctvai-1),0) + IF totftvaI # 0 && pt 4426 = 4428 fara baza + REPLACE totftvaI WITH totftvaI - m.suma + ENDIF + ENDIF + ENDIF + REPL totctva WITH totftvaM+tvaM+totftvaI+tvaI+neimpozab + ENDCASE + + ENDIF + SELE act + ENDSCAN + + + IF gle4511 + LlCondScan = [INLIST(LEFT(scd, 3), '401', '404', '451')] + ELSE + LlCondScan = [INLIST(LEFT(scd, 3), '401', '404')] + ENDIF + SELE act + SET FILTER TO + SCAN FOR scc='767 ' AND &LlCondScan &&INLIST(LEFT(scd, 3), '401', '404', '451') + + SCAT MEMV + SELE CUMP + LOCA FOR nract=m.nract AND NUME=m.NUME +*REPL TOTFTVAM WITH TOTFTVAM-TVAM+neimpozab + IF FOUND() + IF m.neimpozab#0 + REPLACE neimpozab WITH neimpozab-M.suma + ELSE + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + REPL totftvaM WITH totftvaM-m.suma + OTHERWISE + IF M.proc_tva=m.ctvam OR (M.proc_tva=0 AND M.neimpozab=0) + REPL totftvaM WITH totftvaM - m.suma + ELSE + IF M.proc_tva=m.ctvai + REPL totftvaI WITH totftvaI-m.suma + ENDIF + ENDIF + ENDCASE + ENDIF + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + REPL totctva WITH totftvaM+tvaM+neimpozab + OTHERWISE + REPL totctva WITH totftvaM+tvaM+totftvaI+tvaI+neimpozab + ENDCASE + ENDIF + SELE act + ENDSCAN + + SELE act + SET FILTER TO + IF USED('tact') + USE IN tact + ENDIF + +ENDIF +UNLOCK IN CUMP + + +ENDPROC +*** SFARSIT PROCEDURA REFCUMP +*_________________________________________________________________________________________________ +*_________________________________________________________________________________________________ +*** INCEPUT PROCEDURA REFVANZ +PROCEDURE REFVanz +LOCAL lnTipTVA,llProcTva + +llProcTva=.F. +SELECT act +IF TYPE('act.proc_tva')!="U" && daca exista campul proc_tva + llProcTva=.T. +ENDIF +DO CASE + CASE (m.ctvam = 1 AND m.ctvai = 1) OR !llProcTva && firma neplatitoare de TVA + lnTipTVA = 1 + CASE (m.ctvam >1 AND m.ctvai = m.ctvam) OR !llProcTva && firma platitoare de TVA inainte de TVA REDUS + lnTipTVA = 2 + CASE (m.ctvam >=1 AND m.ctvai != m.ctvam) AND llProcTva && firma platitoare de TVA cu TVA REDUS adica am coloana proc_tva + lnTipTVA = 3 + OTHERWISE && consider firma platitoare de TVA inainte de TVA REDUS + lnTipTVA = 2 +ENDCASE + +COPY FILE &dirgen\_alfa\an0000\date00\VANZ.* TO &loc\&nfscurt\tempo\vanz0.* + +USE &loc\&nfscurt\tempo\vanz0 IN 0 ALIAS vanz0 EXCLUSIVE +SELECT vanz0 +INDEX ON NUME+DTOC(dataact)+STR(nract,14)+scd TAG ndn OF &loc\&nfscurt\tempo\vanz0 +SET ORDER TO TAG ndn + + +*!* Sele VANZ +*!* If Flock() +*!* Dele All +SELECT vanz0 + +IF gle4511 + locCond = [(LEFT(SCD,3)='411' AND SCD#'4118') OR (SCD='635 ' AND SCC='4427') OR (scd = '4511' AND (SCC='4427' OR neimpozab # 0))] +ELSE + locCond = [(LEFT(SCD,3)='411' AND SCD#'4118') OR (SCD='635 ' AND SCC='4427')] +ENDIF + +&& adaug inregistrari pt prima oara--------------------------------------------------- +SELECT act +*SET FILTER TO (LEFT(SCD,3)='411' AND SCD#'4118') OR (SCD='635 ' AND SCC='4427') && OR (LEFT(SCD,3)='428' AND SCC='4427') OR (SCD='4428' AND SCC='4427') +SET FILTER TO &locCond +STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA +SCAN + SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,scd MEMV + SELE vanz0 + SEEK m.NUME+DTOC(m.dataact)+STR(m.nract,14)+m.scd + IF !FOUND() + SELE vanz0 + APPEND BLAN + GATH MEMV + ENDIF + SELE act +ENDSCAN + + +SELECT act +SET FILTER TO + +SELECT DISTINCT COD FROM act WHERE scd='461 ' AND (scc='4427' OR neimpozab # 0) INTO CURSOR C461 +SELECT COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,suma,scd FROM act; +WHERE COD IN (SELECT DISTINCT COD FROM C461); +INTO CURSOR CC461 ORDER BY dataact + +SELECT CC461 +STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA +SCAN + SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,scd MEMV + SELE vanz0 + SEEK m.NUME+DTOC(m.dataact)+STR(m.nract,14)+m.scd + IF !FOUND() + SELE vanz0 + APPE BLAN + GATH MEMV + ENDIF + SELE CC461 +ENDSCAN +USE IN CC461 + +*!* SELECT DISTINCT COD FROM ACT WHERE SCC='4118' AND SCD='4427' INTO CURSOR C4118 +*!* SELECT COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,SUMA,SCD FROM ACT; +*!* WHERE COD IN (SELECT DISTINCT COD FROM C4118); +*!* INTO CURSOR CC4118 ORDER BY dataact + +*!* SELECT CC4118 +*!* STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA +*!* SCAN +*!* SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,SCD MEMV +*!* SELE vanz0 +*!* SEEK m.NUME+DTOC(m.dataact)+STR(m.nract,14) +*!* IF !FOUND() +*!* DO CASE +*!* IF scd#4427 +*!* m.totftvam=-suma +*!* ELSE +*!* m.tvam=-suma +*!* ENDIF +*!* ENDCASE +*!* +*!* SELE vanz0 +*!* APPE BLAN +*!* GATH MEMV + +*!* +*!* ENDIF +*!* SELE CC4118 +*!* ENDSCAN +*!* USE IN CC4118 + +SELECT DISTINCT COD FROM act WHERE scc='4118' AND scd='4427' INTO CURSOR C4118 +SELECT COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,SUM(IIF(scd='4427',-suma,0)) AS tvaM ,SUM(IIF(scd#'4427',-suma,0)) AS totftvaM,scd ; +FROM act GROUP BY act.COD ; +WHERE COD IN (SELECT DISTINCT COD FROM C4118); +INTO CURSOR CC4118 ORDER BY dataact + +SELECT CC4118 +STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA +SCAN + SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL,scd,tvaM,totftvaM MEMV + m.totctva=m.totftvaM+m.tvaM + SELE vanz0 + SEEK m.NUME+DTOC(m.dataact)+STR(m.nract,14)+m.scd + IF !FOUND() + SELE vanz0 + APPE BLAN + GATH MEMV + REPLACE scd WITH '4118' + ENDIF + SELE CC4118 +ENDSCAN +USE IN CC4118 +******* + +SELE vanz0 +SCAN FOR scd#'4118' + SCAT MEMV + SELE act + STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA + + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + SELECT suma,neimpozab,scc,scd FROM act WHERE NUME=m.NUME AND dataact=m.dataact AND nract=m.nract; + AND (scd=m.scd OR (scd='4428' AND scc='4427') OR (scd='635 ' AND scc='4427')); + INTO CURSOR act4 + OTHERWISE + SELECT IIF(LEFT(scd,3) # '419', suma, -suma) AS suma, neimpozab, scc, scd,IIF(neimpozab=0 AND proc_tva=0,m.ctvam,proc_tva) AS proc_tva FROM act WHERE NUME=m.NUME AND dataact=m.dataact AND nract=m.nract; + AND (scd=m.scd OR (scd='4428' AND scc='4427') OR (scd='635 ' AND scc='4427') OR INLIST('419',LEFT(scd,3),LEFT(scc,3))); + INTO CURSOR act4 + ENDCASE + + + SELECT act4 + GO TOP + IF (LEFT(scd,3) = '419' AND LEFT(scc,3) = '411') OR (LEFT(scc,3) = '419' AND LEFT(scd,1) = '5') + lnScd = '419' + ELSE + lnScd = m.scd + ENDIF + +******* de completat + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + SUM suma TO m.tvaM FOR scc='4427' + SUM suma-neimpozab,neimpozab TO m.totftvaM,m.neimpozab FOR scc#'4427' + OTHERWISE + SUM suma TO m.tvaM FOR scc='4427' AND proc_tva=m.ctvam + SUM suma TO m.tvaI FOR scc='4427' AND proc_tva=m.ctvai + SUM IIF(proc_tva=m.ctvam,suma-neimpozab,0),IIF(proc_tva=m.ctvai,suma-neimpozab,0),neimpozab TO m.totftvaM,m.totftvaI,m.neimpozab FOR scc#'4427' + ENDCASE + + USE IN act4 + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus + m.totctva=M.tvaM+M.totftvaM+M.neimpozab + SELE vanz0 + REPL tvaM WITH M.tvaM; + totftvaM WITH M.totftvaM; + neimpozab WITH M.neimpozab; + totctva WITH M.totctva, scd WITH lnScd + OTHERWISE + m.totctva=M.tvaM+M.totftvaM+M.tvaI+M.totftvaI+M.neimpozab + SELE vanz0 + REPL tvaM WITH M.tvaM; + totftvaM WITH M.totftvaM; + tvaI WITH M.tvaI; + totftvaI WITH M.totftvaI; + neimpozab WITH M.neimpozab; + totctva WITH M.totctva, scd WITH lnScd + ENDCASE + +ENDSCAN + + +*********************** +SELE act +SET FILTER TO +*!* SCAN FOR (SCD='667 ' AND LEFT(SCC,3)='411') OR SCC='418 ' +SCAN FOR (INLIST(LEFT(scd,3),'667','622') AND INLIST(LEFT(scc,3),'411', '451')) OR (scd='4428' AND scc='4427') && modificat la 11 martie 2004, Georgiana, 622 - 27 august 2004 Marius + SCAT FIEL NUME,nract,dataact,scc,suma MEMV + IF m.scc = '4427' + m.scc = '411' + ENDIF + m.scd=m.scc + SELE vanz0 + SEEK m.NUME+DTOC(m.dataact)+STR(m.nract,14)+m.scd + IF FOUND() + DO CASE + CASE INLIST(lnTipTVA,1,2) && inainte de tva redus +*!* IF m.SCC='418 ' +*!* REPL totftvaM WITH ROUND(tvaM/(m.ctvam-1),0) +*!* REPL totctva WITH totftvaM+tvaM+neimpozab +*!* ELSE + IF m.ctvam # 1 + REPL totftvaM WITH totftvaM-m.suma + ELSE + REPLACE neimpozab WITH neimpozab-m.suma + ENDIF + + REPL totctva WITH totftvaM+tvaM+neimpozab +*!* ENDIF + OTHERWISE + m.proc_tva=act.proc_tva + IF m.proc_tva=0 AND neimpozab=0 + m.proc_tva=m.ctvam + ENDIF +*!* IF m.SCC='418 ' +*!* IF m.proc_tva=m.ctvam +*!* REPL totftvaM WITH ROUND(tvaM/(m.ctvam-1),0) +*!* ENDIF +*!* IF m.proc_tva=m.ctvai +*!* REPL totftvaI WITH ROUND(tvaI/(m.ctvaI-1),0) +*!* ENDIF +*!* REPL totctva WITH totftvaM+tvaM+totftvaI+tvaI+neimpozab +*!* ELSE + IF m.proc_tva=m.ctvam + REPL totftvaM WITH totftvaM-m.suma + ENDIF + IF m.proc_tva=m.ctvai + REPL totftvaI WITH totftvaI-m.suma + ENDIF + + REPL totctva WITH totftvaM+tvaM+totftvaI+tvaI+neimpozab +*!* ENDIF + ENDCASE + + ENDIF + SELE act +ENDSCAN + +***************** + +SELECT VANZ +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\vanz0 + +ENDIF +UNLOCK IN VANZ +USE IN vanz0 + +*** SFARSIT PROCEDURA REFVANZ************************************************************************ + +*____________________________________________________________________________________________________ + +*** REFACERE BALANTA ANALITICA FARA PRECEDENTE******************************************************* +PROCEDURE REFBALANTA_ANA &&REFBAL_ANA +IF !se_reface() + RETURN +ENDIF + +SELE BALANA +IF FLOCK() + DELETE ALL FOR EMPTY(acont) + REPLACE ALL RULDEB WITH 0; + RULCRED WITH 0 + SCAN + SCATTER MEMVAR + SELE act + IF m.acont#'0000' + SUM suma TO m.RULDEB FOR scd=m.cont AND ASCD=M.acont + SUM suma TO m.RULCRED FOR scc=m.cont AND ASCC=M.acont + ELSE + SUM suma TO m.RULDEB FOR scd=m.cont AND (ASCD=M.acont OR EMPTY(ASCD)) + SUM suma TO m.RULCRED FOR scc=m.cont AND (ASCC=M.acont OR EMPTY(ASCC)) + ENDIF + + SELE BALANA + REPL RULDEB WITH M.RULDEB; + RULCRED WITH M.RULCRED + + ENDSCAN + + IF TYPE('PRECDEB1')!="U" + DELETE ALL FOR PRECDEB1 = 0 AND PRECCRED1 = 0 AND precdeb = 0 AND preccred = 0 AND RULDEB = 0 AND RULCRED = 0 AND totdeb = 0 AND totcred = 0 AND SOLDDEB = 0 AND SOLDCRED = 0 + ELSE + DELETE ALL FOR precdeb = 0 AND preccred = 0 AND RULDEB = 0 AND RULCRED = 0 AND totdeb = 0 AND totcred = 0 AND SOLDDEB = 0 AND SOLDCRED = 0 + ENDIF + +ENDIF + +DO CALCULEAZABALANTA_ANA +*UNLOCK +RETURN + + + + +*** REFACERE BALANTA SINTETICA FARA PRECEDENTE******************************************************* +PROCEDURE REFBalanta && REFBAL +IF !se_reface() + RETURN +ENDIF + +SELE BAL +IF FLOCK() + REPLACE ALL RULDEB WITH 0; + RULCRED WITH 0 + SCAN + SCATTER MEMVAR + SELE act + SUM suma TO m.RULDEB FOR scd=SUBS(m.cont,1,4) + SUM suma TO m.RULCRED FOR scc=SUBS(m.cont,1,4) + SELE BAL + REPL RULDEB WITH M.RULDEB; + RULCRED WITH M.RULCRED + + ENDSCAN + + IF TYPE('PRECDEB1')!="U" + DELETE ALL FOR PRECDEB1 = 0 AND PRECCRED1 = 0 AND precdeb = 0 AND preccred = 0 AND RULDEB = 0 AND RULCRED = 0 AND totdeb = 0 AND totcred = 0 AND SOLDDEB = 0 AND SOLDCRED = 0 + ELSE + DELETE ALL FOR precdeb = 0 AND preccred = 0 AND RULDEB = 0 AND RULCRED = 0 AND totdeb = 0 AND totcred = 0 AND SOLDDEB = 0 AND SOLDCRED = 0 + ENDIF + +ENDIF +DO CALCULEAZABALANTA +*UNLOCK +RETURN + + + +PROCEDURE VERDIFBAL +SELE BAL +IF FLOCK() + SUM RULDEB TO M.RULDEB + SUM RULCRED TO M.RULCRED + SELE act + SUM suma TO M.suma + IF M.RULDEB #M.suma + DO VERDIFDEB + DO REFBalanta + ENDIF + IF M.RULCRED #M.suma + DO VERDIFCRED + DO REFBalanta + ENDIF +ENDIF +UNLOCK IN BAL +RETURN + +************* +PROCEDURE VERDIFDEB +SELE act +DEB=' ' +SCAN + SCATTER MEMVAR + IF M.scd#DEB + DEB=M.scd + SELE BAL + SEEK DEB + IF ! FOUND() +*WAIT WINDOWS 'CONTUL '+DEB+' NU ESTE INTRODUS IN BALANTA' +**** + WAIT WIND 'Se introduce in balanta contul '+ DEB NOWAIT + SELE PLCONT +*LOCATE FOR LEFT(CIMP1,4)=LEFT(DEB,4) + LOCATE FOR ALLTRIM(CIMP1)=ALLTRIM(DEB) + IF FOUND() + SCATTER MEMVAR + m.cont=M.CIMP1 + m.DENUMIRE=m.cimp2 + SELE BAL + APPEND BLANK +*GATHER MEMVAR + REPL CONT WITH M.cont + REPL DENUMIRE WITH M.DENUMIRE + ELSE + WAIT WINDOWS 'CONTUL '+DEB+' NU ESTE INTRODUS IN PLANUL DE CONTURI' + ENDIF + +***** + ENDIF + SELE act + ENDIF +ENDSCAN +RETURN + +PROCEDURE VERDIFCRED +SELE act +DEB=' ' +SCAN + SCATTER MEMVAR + IF M.scc#DEB + DEB=M.scc + SELE BAL + SEEK DEB + IF ! FOUND() +*WAIT WINDOWS 'CONTUL '+DEB+' NU ESTE INTRODUS IN BALANTA' + WAIT WIND 'Se introduce in balanta contul'+DEB NOWAIT + SELE PLCONT +*LOCATE FOR LEFT(CIMP1,4)=LEFT(DEB,4) + LOCATE FOR ALLTRIM(CIMP1)=ALLTRIM(DEB) + IF FOUND() + SCATTER MEMVAR + m.cont=M.CIMP1 + m.DENUMIRE=m.cimp2 + SELE BAL + APPEND BLANK +*GATHER MEMVAR + REPL CONT WITH M.cont + REPL DENUMIRE WITH M.DENUMIRE + ELSE + WAIT WINDOWS 'CONTUL '+DEB+' NU ESTE INTRODUS IN PLANUL DE CONTURI' + ENDIF + ENDIF + SELE act + ENDIF + +ENDSCAN +RETURN + + + + +*___________________________________________________________________ +PROCEDURE refstocinloc &&REFSTOC + +IF !se_reface() + RETURN +ENDIF + + +SELE rull +M=3*RECCOUNT() +OP=CREA('PROGRESBAR') +OP.titlu.CAPTION='Refacere Stocuri' +OP.SHOW() +j=0 + +SELE inloc +*Set Order To Tag CODMAT2 +REPL ALL CANT WITH 0; +CANTE WITH 0 +SELE rull +SET ORDER TO TAG COD +SCAN + SCATTER MEMVAR + SELE W50 + SEEK M.COD + IF NOT FOUND() + SELE rull + IF FLOCK() + DELETE + ENDIF + UNLOCK + ENDIF + DO pr WITH j + SELE rull +ENDSCAN + +SELECT rull +IF FLOCK() + REPLACE ALL pretvtva WITH ROUND(pretv+tvav,0) FOR !EMPTY(pretv) AND !EMPTY(tvav) AND EMPTY(pretvtva) + REPLACE ALL DATAIN WITH dataact FOR CANT#0 AND EMPTY(DATAIN) + REPLACE ALL DATAOUT WITH dataact FOR CANTE#0 AND EMPTY(DATAOUT) +ENDIF +UNLOCK + +SELE inloc +REPL ALL CANT WITH 0; +CANTE WITH 0 + +*********** +&&gestiuni la pret de achizitie: +SELECT rull.* FROM rull WHERE rull.scd # '8039' AND gest in (sele DISTINCT gest FROM numegest WHERE nrg<>6 ) ; +INTO CURSOR rullachi + +SELECT inloc +SET ORDER TO TAG achi + +SELE rullachi +SCAN + m.cants=0 + m.CANT=0 + m.CANTE=0 + SCATTER MEMVAR + SELE inloc + SEEK STR(m.gest,3)+m.scd+STR(m.PRET,14,2)+m.CODMAT+m.DENUMIRE + IF FOUND() + REPL CANTE WITH CANTE+M.CANTE + REPL CANT WITH CANT+M.CANT + IF M.CANT#0 + REPLACE DATAIN WITH M.DATAIN + ELSE + REPLACE DATAOUT WITH M.DATAOUT + ENDIF + ELSE + APPEND BLANK + GATHER MEMV + ENDIF + + DO pr WITH j + SELE rullachi +ENDSCAN +USE IN rullachi + +&&gestiuni la pret de vanzare: +SELECT rull.* FROM rull WHERE gest in (sele DISTINCT gest FROM numegest WHERE nrg=6 ); +INTO CURSOR rullvanz + +SELECT inloc +SET ORDER TO TAG VANZ + +SELE rullvanz +SCAN + m.cants=0 + m.CANT=0 + m.CANTE=0 + SCATTER MEMVAR + SELE inloc + SEEK STR(m.gest,3)+m.scd+STR(m.PRET,14,2)+STR(m.pretvtva,14,2)+ m.CODMAT+m.DENUMIRE + +*!* Loca For GEST=M.GEST And SCD=M.SCD ; +*!* AND PRET=M.PRET AND PRETvtva=M.PRETvtva ; +*!* And Allt(CODMAT)=Allt(M.CODMAT) And Allt(DENUMIRE)=Allt(M.DENUMIRE) + IF FOUND() + REPL CANTE WITH CANTE+M.CANTE + REPL CANT WITH CANT+M.CANT + IF M.CANT#0 + REPLACE DATAIN WITH M.DATAIN + ELSE + REPLACE DATAOUT WITH M.DATAOUT + ENDIF + ELSE + APPEND BLANK + GATHER MEMV + ENDIF + + DO pr WITH j + SELE rullvanz +ENDSCAN +USE IN rullvanz + +OP.RELEASE +RETURN + + +*________________________________________________________________ +PROCEDURE refstoc &&refstint +LOCAL lp,ap +_SCREEN.MOUSEPOINTER=11 + +SET SAFETY OFF + +SELE calendar +LOCA FOR nl=m.nl AND an=m.an +SKIP -1 +IF BOF() + + dateA=dirgen+'\_alfa\an0000\date00' +ELSE + lp=nl + ap=an + dateA=calefirma+'\an'+ap+'\'+'date'+lp +ENDIF +dateb=calefirma+'\an'+m.an+'\'+'date'+M.nl + +SELE rull +SET FILTER TO + +SELE STOC +SET FILTER TO + +&&refacere fisier inlocuitor inloc +COPY FILE &dateA\STOC.* TO &loc\&nfscurt\tempo\inloc.* + +USE &loc\&nfscurt\tempo\inloc IN 0 ALIAS inloc EXCL +SELECT inloc +REPL ALL cants WITH cants+CANT-CANTE +DELE ALL FOR cants=0 +DELETE ALL FOR scd = '8039' +PACK + +SELECT inloc +INDEX ON STR(gest,3)+scd+STR(PRET,14,2)+ CODMAT+DENUMIRE TAG achi OF &loc\&nfscurt\tempo\inloc +INDEX ON STR(gest,3)+scd+STR(PRET,14,2)+STR(pretvtva,14,2)+ CODMAT+DENUMIRE TAG VANZ OF &loc\&nfscurt\tempo\inloc + + +DO refstocinloc &&REFSTOC + +SELECT inloc +ALTER TABLE inloc ADD COLUMN detoate c(175) +SET FILTER TO +INDEX ON detoate TAG detoate OF &loc\&nfscurt\tempo\inloc +SET ORDER TO TAG detoate +REPLACE ALL detoate WITH STR(gest,3)+scd+STR(PRET,14,2)+STR(pretvtva,14,2)+ CODMAT+DENUMIRE + +SELECT inloc +SET FILTER TO +TOTAL TO &loc\&nfscurt\tempo\inloctot ON detoate FIELDS CANT,CANTE,cants + + +USE &loc\&nfscurt\tempo\inloctot IN 0 ALIAS inloctot + +*DO suprapune WITH 'stoc','inloc' +SELECT STOC +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\inloctot +ENDIF +UNLOCK +USE IN inloc +USE IN inloctot + +SELECT STOC +SET ORDER TO TAG DENUMIRE + +_SCREEN.MOUSEPOINTER=0 +RETURN + + + + + + + +*________________________________________________________________ +PROCEDURE REFCumpAn && refcumpnouAN +LOCAL L,A +LOCAL M.BAZA, M.NE, M.TX + +L=M.nl +A=M.an + +SELE actan +M=3*RECCOUNT() +OP=CREA('PROGRESBAR') +OP.titlu.CAPTION='Refacere Total Cumparari' +OP.SHOW() +j=0 + +SELE CUMPAN +USE +SELE CUMP +USE +SELE act +USE +SELECT 0 +USE &datEAN\CUMPAN.DBF EXCLUSIVE ALIAS CUMP +ZAP +SELE actan +SET FILTER TO scc='401 ' OR scc='404 ' OR (scc='4428' AND scd='4426') +*SET FILTER TO SCC='401 ' OR SCC='404 ' OR SCC='4428' +*SET FILTER TO SCC='401 ' OR SCC='404 ' +STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA +SCAN + SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL MEMV + SELE CUMP + LOCA FOR NUME=m.NUME AND dataact=m.dataact AND nract=m.nract + IF !FOUND() + SELE CUMP + GO BOTTOM + APPE BLAN + GATH MEMV + ENDIF + DO pr WITH j + SELE actan +ENDSCAN +******* +SELE CUMP +SCAN + SCAT MEMV + SELE actan + STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA + SCAN FOR NUME=m.NUME AND dataact=m.dataact AND nract=m.nract + DO CASE + CASE scd='4426' + m.tvaM=M.tvaM+suma + + CASE scd#'4426' + m.totftvaM=M.totftvaM+(suma-neimpozab) + m.neimpozab=m.neimpozab+neimpozab + IF scd='635 ' +*M.TX=.T. + m.neimpozab=m.neimpozab+suma + m.totftvaM=m.totftvaM-suma + ENDIF + ENDCASE + + ENDSCAN + +*********** + + m.totctva=M.tvaM+M.totftvaM+M.neimpozab + SELE CUMP + REPL tvaM WITH M.tvaM; + totftvaM WITH M.totftvaM; + neimpozab WITH M.neimpozab; + totctva WITH M.totctva + DO pr WITH j +ENDSCAN +SELE actan +SCAN FOR scd='408 ' + SCAT MEMV + SELE CUMP + LOCA FOR nract=m.nract AND NUME=m.NUME +*REPL TOTFTVAM WITH TOTFTVAM-TVAM + REPL totftvaM WITH ROUND(tvaM/(m.ctvam-1),0) + REPL totctva WITH totftvaM+tvaM+neimpozab + DO pr WITH j + SELE actan +ENDSCAN + +SELE CUMP +USE + +OP.RELEASE +*SELECT 0 +*USE &dateAN\cumpAN.dbf alias cumpan + +************DO RC1.PRG +m.an=A +m.nl=L +CLOSE DATABASE +DO TOTV.PRG +RETURN + + +*___________________________________________________________________________________________ +PROCEDURE refVANZAN +LOCAL L,A +LOCAL M.BAZA, M.NE, M.TX + +L=M.nl +A=M.an + +SELE actan +M=2*RECCOUNT() +OP=CREA('PROGRESBAR') +OP.titlu.CAPTION='Refacere Total Vanzari' +OP.SHOW() +j=0 + +SELE VANZAN +USE +SELE VANZ +USE +SELE CUMP +USE +SELE act +USE +SELECT 0 +USE &datEAN\VANZAN.DBF EXCLUSIVE ALIAS CUMP +ZAP +SELE actan +SET FILTER TO INLIST(scd,'411 ','461 ','4118') OR (scd='4428' AND scc='4427') OR (scd='635 ' AND scc='4427') +&&SET FILTER TO SCd='411 ' or (scd='4428' and scc='4427') +*OR (SCD='635 ' AND SCC='4427') +*SET FILTER TO SCD='411 ' or (scd='4428' and !inlist(left(scc,3),'371','408')) +STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA +SCAN + SCAT FIEL COD,DATAIREG,dataact,NUME,fdoc,nract,datascad,COD_FISCAL MEMV + SELE CUMP + LOCA FOR NUME=m.NUME AND dataact=m.dataact AND nract=m.nract + IF !FOUND() + SELE CUMP + GO BOTTOM + APPE BLAN + GATH MEMV + ENDIF + DO pr WITH j + SELE actan +ENDSCAN +******* +SELE CUMP +SCAN + SCAT MEMV + SELE actan + STORE 0 TO M.totftvaI,M.totftvaM,M.neimpozab,M.tvaI,M.tvaM,M.totctva,M.BAZA + SCAN FOR NUME=m.NUME AND dataact=m.dataact AND nract=m.nract + DO CASE + CASE scc='4427' + m.tvaM=M.tvaM+suma + + CASE scc#'4427' + m.totftvaM=M.totftvaM+(suma-neimpozab) + m.neimpozab=m.neimpozab+neimpozab + m.sumaval=m.sumaval+suma_2 + m.NUMEVAL=nume_4 + m.CURSSCHIMB=SUMA_3 + + + ENDCASE + + ENDSCAN + +*********** + + m.totctva=M.tvaM+M.totftvaM+M.neimpozab + SELE CUMP + REPL tvaM WITH M.tvaM; + totftvaM WITH M.totftvaM; + neimpozab WITH M.neimpozab; + totctva WITH M.totctva + DO pr WITH j + SELE actan +ENDSCAN + +SELE CUMP +USE + +SELECT 0 +USE &datEAN\VANZAN.DBF ALIAS VANZAN + +OP.RELEASE +*********************DO RV1.PRG +m.an=A +m.nl=L +CLOSE DATABASE +DO TOTV.PRG +RETURN + +*-------------------------------------------------------------- + +*** REFACERE BALANTA SINTETICA CU PRECEDENTE +PROCEDURE REFBal && REFBalanta +LOCAL dateA + +IF !se_reface() + RETURN +ENDIF +SET SAFETY OFF + + +*** adaug in balanta curenta balanta din luna precedenta +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +IF FOUND() + SKIP -1 + IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla + ELSE + dateA=dirgen+'\_alfa\an0000\date00\' && 'Aceasta este prima luna deschisa!','' + ENDIF + DATE=calefirma+'\an'+m.an+'\date'+m.nl +ELSE + DO mesaj WITH 'Fisierul Calendar.dbf este defect!','' + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + + +SELE BAL +IF FLOCK() + DELE ALL + APPE FROM &dateA\BAL.DBF FOR !DELETED() + UNLOCK +ENDIF + + +*** verific daca am campurile de solduri la 1 ianuarie +llNuSold=.F. +IF TYPE('precdeb1')!="U" && am campurile precdeb1, deci trebuie sa completez soldul de la 1 ianuarie + llNuSold=.T. +ENDIF + + +*** caut prima balanta din anul curent care are campuri cu solduri de la 1 ianuarie +llgasit=.F. +lcBal1ian=calefirma+'\an'+m.an+'\date01\bal.dbf' +IF llNuSold + lnan=VAL(m.an) + + FOR i=1 TO 12 + SELECT calendar + LOCATE FOR VAL(an)=lnan AND VAL(nl)=i AND VAL(nl)!=VAL(m.nl) + IF FOUND() + lcBal1ian=calefirma+'\an'+calendar.an+'\date'+calendar.nl+'\bal.dbf' + IF FILE(lcBal1ian) + USE (lcBal1ian) IN 0 AGAIN SHARED ALIAS bal1ian + SELECT bal1ian + IF TYPE("precdeb1")!="U" && exxista campul precdeb1 in balanta selectata + USE IN bal1ian + llgasit=.T. + EXIT + ENDIF + USE IN bal1ian + ENDIF + ENDIF + ENDFOR +ENDIF + + + +*** daca am campul de sold la 1 ianuarie le preiau din prima balanta cu solduri la 1 ianuarie din anul respectiv +IF llNuSold + IF llgasit && daca am gasit prima balanta sintetica cu solduri la 1 ianuarie + + USE (lcBal1ian) IN 0 AGAIN SHARED ALIAS bal1ian + SELECT CONT,PRECDEB1,PRECCRED1 FROM bal1ian INTO CURSOR t1ian ORDER BY CONT + SELECT BAL + IF FLOCK() + REPLACE ALL PRECDEB1 WITH 0,PRECCRED1 WITH 0 + SCAN + lcCont=CONT + lnprecdeb1=PRECDEB1 + lnpreccred1=PRECCRED1 + + SELECT t1ian + LOCATE FOR CONT=lcCont + IF FOUND() + lnprecdeb1=PRECDEB1 + lnpreccred1=PRECCRED1 + ENDIF + + SELECT BAL + REPLACE PRECDEB1 WITH lnprecdeb1,PRECCRED1 WITH lnpreccred1 + ENDSCAN + UNLOCK IN BAL + ENDIF + USE IN bal1ian + USE IN t1ian + ENDIF + +ENDIF + + +SELE BAL +SET ORDER TO TAG CONT + +SELE BAL +IF FLOCK() + IF m.nl='01' + REPL ALL precdeb WITH 0,preccred WITH 0 + REPL ALL precdeb WITH SOLDDEB,preccred WITH SOLDCRED + IF llNuSold && AM CAMPURILE DE SOLDURI LA 1 IANUARIE + REPLACE ALL PRECDEB1 WITH SOLDDEB,PRECCRED1 WITH SOLDCRED + ENDIF + ELSE + + REPL ALL precdeb WITH 0, preccred WITH 0 + REPL ALL RULDEB WITH 0, RULCRED WITH 0 + REPL ALL precdeb WITH totdeb, preccred WITH totcred + ENDIF + UNLOCK +ENDIF + +DO REFBalanta +DO VERDIFBAL +DO CALCULEAZABALANTA + + +DO REFBALANA +RETURN + +*_______________________________________________________________________________________ + +*** REFACERE BALANTA ANALITICA CU PRECEDENTE*** +PROCEDURE REFBALANA && RefBalanta_ana +LOCAL dateA + +IF !se_reface() + RETURN +ENDIF + +SET SAFETY OFF + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' && 'Aceasta este prima luna deschisa!','' +ENDIF +DATE=calefirma+'\an'+m.an+'\date'+m.nl + + +*** caut bal si balana din prima luna din anul curent pt soldurile de la 1 ianuarie in caz ca nu gasesc in balanta precedenta +llgasit=.F. +lcBal1ian=calefirma+'\an'+m.an+'\date01\bal.dbf' +lnan=VAL(m.an) + +FOR i=1 TO 12 + SELECT calendar + LOCATE FOR VAL(an)=lnan AND VAL(nl)=i + IF FOUND() + lcBal1ian=calefirma+'\an'+calendar.an+'\date'+calendar.nl+'\balana.dbf' + IF FILE(lcBal1ian) + USE (lcBal1ian) IN 0 AGAIN SHARED ALIAS bal1ian + SELECT bal1ian + IF TYPE("precdeb1")!="U" && exxista campul precdeb1 in balanta selectata + USE IN bal1ian + llgasit=.T. + EXIT + ENDIF + USE IN bal1ian + ENDIF + ENDIF +ENDFOR + +SELE BALANA +IF FLOCK() + DELE ALL + IF FILE('&dateA\BALANA.DBF') + APPE FROM &dateA\BALANA.DBF FOR !DELETED() + ENDIF + + +*** verific daca am soldurile de la 1 ianuarie + llNuSold=.F. + STORE 0 TO lnprecdeb1,lnpreccred1 + IF existacamp('bal','precdeb1') +*!* CALCULATE sum(precdeb1),sum(preccred1) TO lnprecdeb1,lnpreccred1 +*!* +*!* IF lnprecdeb1=0 && nu am soldurile de la 1 ianuarie + llNuSold=.T. +*!* ENDIF + ENDIF + +*** Daca nu am soldurile de la 1 ianuarie dupa ce am facut append inseamna ca nu le am nici in balanta precedenta, +*** deci o sa le caut in prima balanta din anul respectiv + IF llNuSold + IF llgasit && daca am gasit prima balanta analitica + USE (lcBal1ian) IN 0 AGAIN SHARED ALIAS bal1ian + IF existacamp('bal1ian','precdeb1') AND existacamp('bal1ian','preccred1') + SELECT CONT,acont,PRECDEB1,PRECCRED1 FROM bal1ian INTO CURSOR t1ian ORDER BY CONT + SELECT BALANA + SCAN + lcCont=CONT + lcACont=acont + lnprecdeb1=PRECDEB1 + lnpreccred1=PRECCRED1 + + SELECT t1ian + LOCATE FOR CONT=lcCont AND acont=lcACont + IF FOUND() + lnprecdeb1=PRECDEB1 + lnpreccred1=PRECCRED1 + ENDIF + + SELECT BALANA + REPLACE PRECDEB1 WITH lnprecdeb1,PRECCRED1 WITH lnpreccred1 + ENDSCAN + USE IN bal1ian + USE IN t1ian + ENDIF + ENDIF + ENDIF + + + + SELE BALANA + SET ORDER TO TAG CONTACONT + + SELECT PLCONTANA + SCAN + SCATTER MEMV + SELECT BALANA + SEEK M.cont+M.acont + IF !FOUND() + APPEND BLANK + REPLACE CONT WITH M.cont, acont WITH M.acont, DENUMIRE WITH M.DENUMIRE + ENDIF + SELECT PLCONTANA + ENDSCAN + + SELECT DISTINCT scd AS CONT,ASCD AS acont ; + FROM act ; + WHERE !EMPTY(ASCD) AND LEFT(scd,4)+LEFT(ASCD,4) NOT IN ; + (SELE LEFT(CONT,4)+LEFT(acont,4) FROM BALANA) ; + INTO CURSOR tscd + + SELE BALANA + APPEND FROM DBF('tscd') + USE IN tscd + + SELECT DISTINCT scc AS CONT,ASCC AS acont ; + FROM act ; + WHERE !EMPTY(ASCC) AND LEFT(scc,4)+LEFT(ASCC,4) NOT IN ; + (SELE LEFT(CONT,4)+LEFT(acont,4) FROM BALANA) ; + INTO CURSOR tscc + + SELE BALANA + APPEND FROM DBF('tscc') + USE IN tscc + + IF m.nl='01' + REPL ALL precdeb WITH 0, preccred WITH 0 + REPL ALL precdeb WITH SOLDDEB, preccred WITH SOLDCRED + IF llNuSold && AM CAMPURILE DE SOLDURI LA 1 IANUARIE + REPLACE ALL PRECDEB1 WITH SOLDDEB,PRECCRED1 WITH SOLDCRED + ENDIF + + ELSE + + REPL ALL precdeb WITH 0, preccred WITH 0 + REPL ALL RULDEB WITH 0, RULCRED WITH 0 + REPL ALL precdeb WITH totdeb, preccred WITH totcred + ENDIF + + DO REFBALANTA_ANA +*DO VERDIFBAL_ANA + DO verif_balana + DO CALCULEAZABALANTA_ANA +ENDIF +UNLOCK IN BALANA +RETURN + +*______________________________________________________ + +PROCEDURE REFCasaVal && REFVALCASA +LOCAL ap,lp,D +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +USE &dateA\casvnume IN 0 SHARED ALIAS casvnumeP +IF TYPE('casvnumep.precdeb') # 'U' + SELECT nume_5, numeval, ; + precdeb + incasari as precdeb, preccred + plati as preccred, ; + precvaldeb + incasval as precvaldeb, precvalcre + platival as precvalcre ; + FROM casvnumeP ; + INTO CURSOR tprec ORDER BY nume_5 +ELSE + SELECT nume_5, numeval, incasari as precdeb, plati as preccred, incasval as precvaldeb, platival as precvalcre ; + FROM casvnumeP ; + INTO CURSOR tprec ORDER BY nume_5 +ENDIF + +SELE casaval +IF FLOCK() + DELETE ALL + m.DATAIREG={} + m.COD=-1 + m.INCASARI=0 + m.PLATI=0 + m.incasval=0 + m.platival=0 + m.scd='' + m.scc='' + m.CURSSCHIMB=0 + m.CURSBNR=0 + + SELE tprec + SCAN + SCATTER MEMVAR + m.INCASARI = M.precdeb-M.preccred + m.PLATI = 0 + m.INCASval = M.precvaldeb-M.precvalcre + m.PLATIval = 0 + m.casa = m.nume_5 + SELE casaval + GOTO BOTTOM + APPE BLANK + GATHER MEMVAR + SELE tprec + ENDSCAN + UNLOCK +ENDIF + +SELECT cod, dataireg, nume_5 as casa, scd, scc, suma_3 as cursschimb, nume_4 as numeval, ; + IIF(scd = '5314', suma, 00000000000000) as incasari, ; + IIF(scc = '5314', suma, 00000000000000) as plati, ; + IIF(scd = '5314', suma_2, 000000000000.00) as incasval, ; + IIF(scc = '5314', suma_2, 000000000000.00) as platival ; + FROM act WHERE scd = '5314' OR scc = '5314' ; + INTO CURSOR tact + +SELECT casaval +APPEND FROM DBF('tact') +USE IN tact + + +SELECT casvnume +IF FLOCK() + DELE ALL + APPEND FROM DBF('tprec') + +SELECT nume_5 as casaval, nume_4 as numeval, ; + sum(IIF(scd = '5314', suma, 00000000000000)) as incasari, ; + sum(IIF(scc = '5314', suma, 00000000000000)) as plati, ; + sum(IIF(scd = '5314', suma_2, 000000000000.00)) as incasval, ; + sum(IIF(scc = '5314', suma_2, 000000000000.00)) as platival ; + FROM act WHERE scd = '5314' OR scc = '5314' ; + INTO CURSOR tact; + GROUP BY 1 + + + SELECT tact + SCAN + SCATTER NAME ot + SELECT casvnume + LOCATE FOR ALLTRIM(nume_5) = ALLTRIM(ot.casaval) + IF !FOUND() + APPEND blank + REPLACE nume_5 WITH ot.casaval + REPLACE numeval WITH ot.numeval + ENDIF + REPLACE incasari WITH incasari + ot.incasari, plati WITH plati + ot.plati + REPLACE incasval WITH incasval + ot.incasval, platival WITH platival + ot.platival + SELECT tact + ENDSCAN + +UNLOCK +ENDIF + +IF USED('tact') + USE IN tact +ENDIF +USE IN tprec +USE IN casvnumeP + + +*!* SELE CASAVAL +*!* SET ORDER TO TAG COD +*!* IF FLOCK() +*!* DELE ALL + +*!* SELE CASVNUME +*!* USE + +*!* IF !FILE('&DATEA\CASVNUME.DBF') +*!* COPY FILE &dirgen\_alfa\an0000\date00\CASVNUME.* TO &dateA\CASVNUME.* +*!* ENDIF +*!* SELE 0 +*!* USE &dateA\CASVNUME + +*!* m.DATAIREG={} +*!* m.COD=-1 +*!* m.INCASARI=0 +*!* m.PLATI=0 +*!* m.incasval=0 +*!* m.platival=0 +*!* m.scd='' +*!* m.scc='' +*!* m.CURSSCHIMB=0 +*!* m.CURSBNR=0 + +*!* &&REFACERE SOLDURI IN CASAVAL DUPA CASVNUME DIN LUNA PRECEDENTA======================= +*!* SELE CASVNUME +*!* SCAN +*!* SCATTER MEMVAR +*!* m.CASA=m.nume_5 +*!* SELE CASAVAL +*!* APPE BLANK +*!* m.INCASARI=M.INCASARI-M.PLATI +*!* m.incasval=M.incasval-M.platival +*!* m.PLATI=0 +*!* m.platival=0 +*!* GATHER MEMVAR +*!* SELE CASVNUME +*!* ENDSCAN + +*!* SELE CASVNUME +*!* USE + +*!* &&REFACERE SUME IN CASAVAL DUPA ACT====================== +*!* &&IN DEB====================== +*!* SELE act +*!* SCAN FOR scd='5314' +*!* SCATTER MEMVAR +*!* SELE CASAVAL +*!* m.CASA=M.nume_5 +*!* m.INCASARI=M.suma +*!* m.incasval=M.suma_2 +*!* m.CURSSCHIMB=M.SUMA_3 +*!* m.SBNR=SUBSTR(M.EXPLICATIA,8,14) +*!* m.CURSBNR=VAL(M.SBNR) +*!* m.PLATI=0 +*!* m.platival=0 +*!* m.NUMEVAL=m.nume_4 +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN&& +*!* &&IN CRED======================= +*!* SELE act +*!* SCAN FOR scc='5314' +*!* SCATTER MEMVAR +*!* SELE CASAVAL +*!* m.CASA=M.nume_5 +*!* m.PLATI=M.suma +*!* m.platival=M.suma_2 +*!* m.CURSSCHIMB=M.SUMA_3 +*!* m.SBNR=SUBSTR(M.EXPLICATIA,8,14) +*!* m.CURSBNR=VAL(M.SBNR) +*!* m.INCASARI=0 +*!* m.incasval=0 +*!* m.NUMEVAL=m.nume_4 +*!* APPE BLANK +*!* GATHER MEMVAR +*!* SELE act +*!* ENDSCAN +*!* ENDIF +*!* &&REFACERE CASVNUME DUPA CASAVAL=================== +*!* SELE 0 +*!* USE &DATE\CASVNUME +*!* &&& exclusive +*!* &&&zap +*!* IF FLOCK() +*!* DELE ALL +*!* &&NUMELE CASELOR=========== +*!* SELE CASAVAL +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE CASVNUME +*!* LOCA FOR nume_5=M.CASA +*!* IF NOT FOUND() +*!* GOTO BOTTOM +*!* APPE BLANK +*!* REPL nume_5 WITH M.CASA +*!* ENDIF +*!* REPL NUMEVAL WITH m.NUMEVAL +*!* SELE CASAVAL +*!* ENDSCAN +*!* &&VALORILE=============== +*!* SELE CASVNUME +*!* SCAN +*!* SCATTER MEMVAR +*!* SELE CASAVAL +*!* SUM INCASARI,PLATI,incasval,platival TO M.INCASARI,M.PLATI,M.incasval,M.platival FOR ALLT(CASA)=ALLT(M.nume_5) +*!* IF EMPTY(ALLT(M.nume_5)) +*!* SUM INCASARI,PLATI,incasval,platival TO M.INCASARI,M.PLATI,M.incasval,M.platival FOR EMPTY(ALLT(CASA)) +*!* ENDIF +*!* SELE CASVNUME +*!* REPL INCASARI WITH M.INCASARI +*!* REPL PLATI WITH M.PLATI +*!* REPL incasval WITH M.incasval +*!* REPL platival WITH M.platival +*!* SELE CASVNUME +*!* ENDSCAN +*!* ENDIF +*!* UNLOCK IN CASAVAL +*!* UNLOCK IN CASVNUME +SELE CASAVAL +SET ORDER TO TAG DATAIREG +RETURN + + + +***____________________________________________________ +PROCEDURE CURATARE &&CURATARE INREGISTRARI STERSE +DO CURATARE1 +ON ERROR +RETURN + +*______________________ +PROCEDURE CURATARE1 +SELECT REFACERI +SCAN + LcFisier=ALLTRIM(tabel) + DO pack_fisier WITH LcFisier + SELECT REFACERI +ENDSCAN + +DO pack_fisier WITH 'BALANA' +DO pack_fisier WITH 'BALANTA_PARTENER' + +RETURN + +*___________________________ +*** INCEPUT PROCEDURA PACK_FISIER +PROCEDURE pack_fisier +PARAM numefis + +SELE &numefis +USE +SELE 0 + +lcOldError=ON("error") +ON ERROR DO daca_ruleaza1 +USE &DATE\&numefis EXCL ALIAS &numefis +PACK +SELE &numefis +USE + +DO des WITH numefis +ON ERROR &lcOldError +ENDPROC +*** SFARSIT PROCEDURA PACK_FISIER + +*_______________________ +PROC daca_ruleaza1 +DO daca_ruleaza +RETURN TO CURATARE + +*_______________________ +PROC daca_ruleaza +DO mesajmare WITH ' Inainte de a executa aceasta operatiune trebuie sa va asigurati ca programul nu mai ruleaza pe alte statii din retea.'+; ++SPACE(50)+'Inchideti programele CONTAFIN deschise pe toate celelalte statii si apoi reveniti.' +semafor1=.T. +RETURN +RETURN + + + + + + + +*_________________________________________ +PROCEDURE REFCumplun +LOCAL nla,nlb,ana,anb,cond,cond1 + +IF !se_reface() + RETURN +ENDIF + + +cond='(year(dataireg)0 + SCAT MEMV + SELE cumplun + LOCA FOR nract=m.nract AND NUME=m.NUME +*REPL TOTFTVAM WITH TOTFTVAM-TVAM+neimpozab + REPL totftvaM WITH totftvaM-M.suma + REPL neimpozab WITH M.suma + + REPL totctva WITH totftvaM+tvaM+neimpozab + SELE act + ENDSCAN +*************BILETE MASA********* + SELE act + SCAN FOR scd='5328' AND LEFT(EXPLICATIA,7)='TICHETE' AND neimpozab=0 + SCAT MEMV + SELE cumplun + LOCA FOR nract=m.nract AND NUME=m.NUME +* BROWSE +* SELECT cumplun +*REPL TOTFTVAM WITH TOTFTVAM-TVAM+neimpozab + REPL totftvaM WITH totftvaM-M.suma + REPL neimpozab WITH M.suma + + REPL totctva WITH totftvaM+tvaM+neimpozab +* BROWSE + SELE act + ENDSCAN +************* + SELE act + SET FILTER TO +*SCAN FOR SCc='4428' and LEFT(scd,3)='371' +*SCAT MEMV +*SELE cumplun +*loca for nract=m.nract and nume=m.nume + +*if found() +*m.neimpozab=totftvam*(-1) +*REPL TOTFTVAM WITH totftvam+m.neimpozab +*REPL neimpozab WITH m.neimpozab +*REPL TOTCTVA WITH TOTFTVAM+TVAM+neimpozab +*endif +*SELE act +*ENDSCAN +*endif + + SELE cumplun + SET FILTER TO + GO TOP +*BROW + +&&ca in rc1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& + SELE cumplun + REPL ALL achitat WITH 0 FOR !&cond + + SELE act + SET ORDER TO TAG PERECHE +*Set Filter To (ACT.SCD='401 ' Or ACT.SCD='404 ') And PERECHE#0 + SET FILTER TO act.scd='401 ' AND PERECHE#0 + + SELE act + GO TOP + DO WHILE !EOF() + m.achitat=0 + m.achitatval=0 + SCAT MEMV + DO WHILE PERECHE=M.PERECHE AND ALLTR(NUME)=ALLT(M.NUME) AND ASCD=m.ASCD + m.achitat=m.achitat+suma + m.achitatval=m.achitatval+suma_2 + SKIP + ENDDO + SELE cumplun + LOCA FOR nract=m.PERECHE AND ALLTR(NUME)=ALLT(M.NUME) AND acont=m.ASCD + IF !FOUND() + LOCATE FOR nract=m.PERECHE AND ALLT(NUME)=ALLT(M.NUME) + ENDIF + IF FOUND() + REPL achitat WITH m.achitat+achitat + REPL achitatval WITH m.achitatval+achitatval + ENDIF +*SET FILTER TO ACHITAT=0 + SELE act + ENDDO + + +ENDIF +UNLOCK IN cumplun +SELE cumplun +SET FILTER TO +SELECT act +SET FILTER TO +RETURN + + +*------------------------------------------------------------------------------------ + +PROCEDURE REFvanzlun +LOCAL nla,nlb,ana,anb,cond,cond1 +STORE 0 TO M.suma_2, M.achitatval,M.suma,M.sumaval,M.achitat + + +IF !se_reface() + RETURN +ENDIF + +*** actualizez act cu pereche si pereche2 daca am optiunea refac=.T. +DO refac_act WITH "411" IN actualizare_act.PRG + +cond='(year(dataireg)'4118') AND !(LEFT(scd,3)='411' AND scc='4427') AND id_set != 90501 AND ; + NUME+'/'+DTOC(dataact)+'/'+STR(nract,14)+'/'+ASCD NOT IN (SELE NUME+'/'+DTOC(dataact)+'/'+STR(nract,14)+'/'+ACONT FROM vanzlun) ; + INTO CURSOR tact ; + GROUP BY NUME,dataact,nract,ASCD + + + lnrec = _TALLY + SELECT vanzlun + APPEND FROM DBF('tact') + USE IN tact + + + +************************************************************************************************* + lcfis = ALLTRIM(loc) + [\] + ALLTRIM(nfscurt) + [\tempo\tact.dbf] + + + SELE NUME,nract,dataact,ASCD, ; + SUM(suma) AS totctva, SUM(suma_2) AS sumaval ; + FROM act ; + WHERE LEFT(scd,3)='411' AND scd<>'4118' ; + INTO TABLE (lcfis) ; + GROUP BY NUME,dataact,nract,ASCD ; + ORDER BY NUME,dataact,nract,ASCD + + SELECT tact + INDEX ON NUME+[\]+DTOC(dataact)+[\]+STR(nract)+[\]+ASCD TAG ordine + SET ORDER TO ordine + + SELECT vanzlun + SET FILTER TO !&cond + SCAN + lcFactura = NUME+[\]+DTOC(dataact)+[\]+STR(nract)+[\]+acont + lnSumaVal=sumaval + lnTotctva = totctva + + SELECT tact + IF SEEK(lcFactura) + + lnTotctva = lnTotctva + totctva + lnSumaVal = lnSumaVal + sumaval + SELECT vanzlun + REPL totctva WITH lnTotctva, sumaval WITH lnSumaVal + ENDIF + SELECT vanzlun + + ENDSCAN + + USE IN tact +************************************************************************************************* + + + SELE act + SET FILTER TO + SCAN FOR INLIST(LEFT(scd,3),'667','622') AND LEFT(scc,3)='411' && 622 la 27 august 2004 Marius (Conpress - comision agent vanzare) + SCAT MEMV + SELE vanzlun + LOCA FOR nract=m.nract AND NUME=m.NUME AND acont=m.ASCC + + IF FOUND() + REPLACE totctva WITH totctva - m.suma + ENDIF + SELE act + ENDSCAN + + + lModifAct=.T. +******** + SELE vanzlun + SET FILTER TO + + REPL ALL achitat WITH 0 FOR !&cond + + +&& id_set = 90501 diferente de curs provenite din actualizarea facturilor la 31.12.NN + SELECT nract, NUME, ASCC AS acont, pereche2, ; + SUM(suma) AS achitat, SUM(suma_2) AS achitatval ; + FROM act WHERE LEFT(scc,3)='411' AND scc<>'4118' AND pereche2#0 AND id_set != 90501; + GROUP BY pereche2, NUME, ASCC ; + INTO CURSOR t411 + + SELECT t411 + SCAN + SCATTER NAME o411 + SELECT vanzlun + LOCATE FOR nract=o411.pereche2 AND ALLT(NUME)=ALLTRIM(o411.NUME) AND acont=o411.acont + IF !FOUND() + LOCATE FOR nract=o411.pereche2 AND ALLTRIM(NUME)=ALLTRIM(o411.NUME) + ENDIF + + IF FOUND() + REPLACE achitat WITH achitat + o411.achitat + REPLACE achitatval WITH achitatval + o411.achitatval + ENDIF + SELECT t411 + ENDSCAN + + RELEASE o411 + USE IN t411 + + + + +*** actualizarea soldurilor facturilor in valuta la 31.12.NN + SELECT nract, NUME, IIF(LEFT(scd,3)='411',ASCD,ASCC) AS acont, pereche2, ; + IIF(LEFT(scd,3)='411',suma,(-1)*suma) AS diferenta, SUMA_3 AS CURSSCHIMB ; + FROM act WHERE (LEFT(scc,3)='411' OR LEFT(scd,3)='411') AND scc<>'4118' AND pereche2#0 AND id_set = 90501; + INTO CURSOR tactualizare + + SELECT tactualizare + SCAN + SCATTER NAME lo501 + SELECT vanzlun + LOCATE FOR nract = lo501.pereche2 AND ALLT(NUME)=ALLTRIM(lo501.NUME) AND acont=lo501.acont + IF FOUND() + REPLACE totctva WITH totctva + lo501.diferenta, CURSSCHIMB WITH lo501.CURSSCHIMB + ENDIF + SELECT tactualizare + ENDSCAN + RELEASE lo501 + USE IN tactualizare + + + SELE act + SET FILT TO +******* +&&pt regularizare clienti creditori +&& and id_set#10421 + + + SELE DISTINCT COD,pereche2 FROM &DATE\act WHERE scd='419 ' AND LEFT(scc,3)='411' INTO CURSOR c419 ORDER BY COD &&pt regularizare clienti creditori + SELE act + SET FILT TO + SELE c419 + SCAN + SCAT FIEL COD,pereche2 MEMV + SELE act + LOCA FOR COD=m.COD AND pereche2=m.pereche2 AND LEFT(scd,3)='411' AND scd#'4118' AND scc='4427' + IF !FOUND() + LOOP + ENDIF + SCAT MEMV + + SELE vanzlun + LOCA FOR NUME=m.NUME AND nract=m.pereche2 AND acont=m.ASCD + IF !FOUND() + LOCA FOR NUME=m.NUME AND nract=m.pereche2 + ENDIF + IF FOUND() + REPL achitat WITH achitat+ABS(m.suma) + ENDIF + SELE c419 + ENDSCAN + USE IN c419 +&&pt regularizare clienti creditori +ENDIF +UNLOCK IN vanzlun +SELE vanzlun +SET FILTER TO +RETURN + +*_________________________________________ +PROCEDURE REFobinvent +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +SELECT rull +SCAN FOR scd = '8039' AND EMPTY(nresp) + lnR = RECNO() + lnC = COD + LOCATE FOR COD = lnC AND !EMPTY(nresp) + lcResp = nresp + IF FOUND() + GOTO lnR + REPLACE nresp WITH lcResp + ELSE + GOTO lnR + ENDIF + + SELECT rull +ENDSCAN + + +SELE obinvent +IF FLOCK() + DELE ALL + APPEND FROM &DATE\rull FOR scd = '8039' +ENDIF +UNLOCK IN obinvent + +SELE rull +SET FILTER TO + +SELE STOC_obinv +SET FILTER TO + + +&&refacere stoc obiecte de inventar aflate in folosinta +lcfis = dateA+'\stoc_obinv.Dbf' +lcStoc = dateA+'\stoc.Dbf' + +IF FILE(lcfis) + COPY FILE &dateA\STOC_obinv.* TO &loc\&nfscurt\tempo\inloc.* + USE &loc\&nfscurt\tempo\inloc IN 0 ALIAS inloc EXCL +ELSE + COPY FILE &dirgen\_alfa\an0000\date00\STOC_obinv.* TO &loc\&nfscurt\tempo\inloc.* + USE &loc\&nfscurt\tempo\inloc IN 0 ALIAS inloc EXCL + SELECT inloc + APPEND FROM &lcStoc FOR scd = '8039' +ENDIF + + +SELECT inloc +REPL ALL cants WITH cants+CANT-CANTE +DELE ALL FOR cants=0 +PACK +REPL ALL CANT WITH 0, CANTE WITH 0 + +SELECT inloc +INDEX ON STR(PRET,14,2)+ nresp+ CODMAT + DENUMIRE TAG achi OF &loc\&nfscurt\tempo\inloc + +SELECT rull +SCAN FOR scd = '8039' + SCATTER NAME orull + SELECT inloc + SEEK STR(orull.PRET,14,2)+ orull.nresp+ orull.CODMAT+orull.DENUMIRE +*LOCATE FOR GEST = orull.gest AND PRET = orull.pret AND CODMAT = orull.codmat AND DENUMIRE = orull.denumire AND nresp = orull.nresp + IF FOUND() + IF FLOCK() + REPLACE CANT WITH CANT + orull.CANT, CANTE WITH CANTE + orull.CANTE, DATAOUT WITH orull.DATAOUT + ENDIF + UNLOCK + ELSE + APPEND BLANK + GATHER NAME orull + ENDIF +ENDSCAN + +SELECT inloc +ALTER TABLE inloc ADD COLUMN detoate c(175) +SET FILTER TO +INDEX ON detoate TAG detoate OF &loc\&nfscurt\tempo\inloc +SET ORDER TO TAG detoate +REPLACE ALL detoate WITH STR(PRET,14,2)+ nresp+ CODMAT+DENUMIRE + +SELECT inloc +SET FILTER TO +TOTAL TO &loc\&nfscurt\tempo\inloctot ON detoate FIELDS CANT,CANTE,cants + + +USE &loc\&nfscurt\tempo\inloctot IN 0 ALIAS inloctot + +SELECT STOC_obinv +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\inloctot +ENDIF +UNLOCK +USE IN inloc +USE IN inloctot + +SELECT STOC_obinv +SET ORDER TO TAG DENUMIRE + +RETURN + +*_________________________________________ + + +PROCEDURE REFrespons +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +SELE respons +IF FLOCK() + DELE ALL + + APPEND FROM &dateA\respons.DBF FOR !DELETED() AND !EMPTY(nume_2) + + SELE DISTINCT act.nresp FROM act INTO CURSOR ttt + SELE ttt + SCAN + SCAT MEMV + SELE respons + LOCA FOR ALLT(m.nresp)=ALLT(nume_2) + IF !FOUND() + APPE BLAN + REPL nume_2 WITH m.nresp + ENDIF + SELE ttt + ENDSCAN + +ENDIF +UNLOCK IN respons +RETURN + + + + +*----------------------------------------- +PROCEDURE refavans409 +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +DO refac_act WITH "409" IN actualizare_act.PRG + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +IF !FILE('&dateA\avans409.dbf') + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +SELE avans409 +IF FLOCK() + DELE ALL + APPEND FROM &dateA\avans409.DBF FOR achitat<>facturat OR achitatval<>factval + SELE nract,dataact,COD,NUME,fdoc,suma AS achitat,suma_2 AS achitatval,SUMA_3 AS CURSSCHIMB,; + nume_4 AS NUMEVAL,DATAIREG,datascad,m.nl AS nl,m.an AS an, scd as cont, ASCD AS acont ; + FROM act WHERE LEFT(scd, 3)='409' INTO CURSOR aaa ORDER BY dataact + + SELE avans409 + APPE FROM DBF('aaa') + + SELE act + SCAN FOR LEFT(scc,3) = '409' + SCAT MEMV + SELE avans409 + LOCA FOR NUME=m.NUME AND nract=m.pereche2 AND cont = m.scc and acont=m.ASCC &&And dataact=DAT + IF !FOUND() + LOCA FOR NUME=m.NUME AND nract=m.pereche2 + ENDIF + IF FOUND() + REPL facturat WITH facturat+m.suma + REPL factval WITH factval+m.suma_2 + ENDIF + SELE act + ENDSCAN + + +ENDIF +UNLOCK IN avans409 + +RETURN + +*----------------------------------------- +PROCEDURE refavans419 +LOCAL nla,nlb,ana,anb + + + +IF !se_reface() + RETURN +ENDIF + +DO refac_act WITH "419" IN actualizare_act.PRG + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +IF !FILE('&dateA\avans419.dbf') + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + + +SELE avans419 +IF FLOCK() + DELE ALL + APPEND FROM &dateA\avans419.DBF FOR achitat<>facturat OR achitatval<>factval + + SELE nract,dataact,COD,NUME,fdoc,suma AS achitat,suma_2 AS achitatval,SUMA_3 AS CURSSCHIMB,; + nume_4 AS NUMEVAL,DATAIREG,datascad,m.nl AS nl,m.an AS an, ASCC AS acont, scc as cont ; + FROM act WHERE LEFT(scc, 3) = '419' INTO CURSOR aaa ORDER BY dataact + + SELE avans419 + APPE FROM DBF('aaa') + + SELE act + SCAN FOR ALLTRIM(scd)='419' + SCAT MEMV + SELE avans419 + LOCA FOR NUME=m.NUME AND nract=m.PERECHE AND acont=m.ASCD &&And dataact=DAT + IF !FOUND() + LOCA FOR NUME=m.NUME AND nract=m.PERECHE + ENDIF + IF FOUND() + REPL facturat WITH facturat+m.suma + REPL factval WITH factval+m.suma_2 + ENDIF + SELE act + ENDSCAN + + +ENDIF +UNLOCK IN avans419 +RETURN + + + + + + +*-------------------------------------------------------------------------------------- +PROCEDURE completeaza_analitic +SET SAFETY OFF +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +IF !FILE('&datea\analitic.dbf') + COPY FILE _alfa\an0000\date00\analitic.* TO &dateA\analitic.* +ENDIF + +WAIT WINDOW 'Se calculeaza precedentele conturilor bifate...' NOWAIT +&& precedente pentru toate conturile recalculabile------------------- +USE &dateA\analitic.DBF IN 0 ALIAS analitica +SELECT analitica +*BROW +IF existacimp('analitica','totdeb') + SELECT CONT,NUME,totdeb AS precdeb,totcred AS preccred FROM analitica ; + WHERE CONT IN (SELECT CONT FROM f_analitic WHERE f_analitic.ales); + INTO CURSOR rrr +ELSE + SELECT CONT,NUME,DEB AS precdeb,cred AS preccred FROM analitica INTO CURSOR rrr +ENDIF +USE IN analitica +SELECT rrr +*BROW + +WAIT WINDOW 'Se readuc precedentele conturilor NEbifate...' NOWAIT +* conturi nerecalculabile------------------------ +SELECT * FROM analitic ; +WHERE CONT NOT IN (SELECT CONT FROM f_analitic WHERE f_analitic.ales); +INTO CURSOR sss + + + +*aduc in ana-------------------- +SELE analitic +COPY STRUCTURE TO &loc\&nfscurt\tempo\ana WITH CDX + +USE &loc\&nfscurt\tempo\ana IN 0 EXCL ALIAS ana ORDER TAG cn +SELE ana +APPEND FROM DBF('rrr') +APPEND FROM DBF('sss') + +USE IN rrr +USE IN sss + +WAIT WINDOW 'Se calculeaza rulajele...' NOWAIT + +SELECT * FROM act WHERE ; +scd IN (SELECT CONT FROM f_analitic WHERE f_analitic.ales) OR ; +scc IN (SELECT CONT FROM f_analitic WHERE f_analitic.ales); +INTO CURSOR aaa + +SELECT A.*,b.NUME AS numescd FROM aaa A FULL JOIN f_analitic b; +ON A.scd=b.CONT AND b.ales INTO CURSOR bbb + +SELECT A.*,b.NUME AS numescc FROM bbb A FULL JOIN f_analitic b; +ON A.scc=b.CONT AND b.ales INTO CURSOR actmic ORDER BY DATAIREG + +SELECT actmic +*brow + +*refacere ana--- +SELE actmic +*!* Set Filter To +*!* Set Order To DATAIREG +SCAN FOR !ISNULL(COD) + SCAT MEMV + + IF !ISNULL(numescd) + T='m.nume='+numescd + &T +* WAIT WINDOW t +* WAIT WINDOW m.nume + WAIT WINDOW 'Data: '+DTOC(DATAIREG) NOWAIT + SELE ana + SEEK m.scd+m.NUME + + IF FOUND() + REPL DEB WITH DEB+m.suma + ELSE + m.cont=m.scd + m.DEB=m.suma + m.cred=0 + APPE BLAN + GATH FIEL CONT,DEB,NUME MEMV + ENDIF + ENDIF + + SELE actmic + IF !ISNULL(numescc) + T='m.nume='+numescc + &T + SELE ana + SEEK m.scc+m.NUME + IF FOUND() + REPL cred WITH cred+m.suma + ELSE + m.cont=m.scc + m.cred=m.suma + m.DEB=0 + APPE BLAN + GATH FIEL CONT,cred,NUME MEMV + ENDIF + ENDIF + SELE actmic +ENDSCAN +SELE ana +DELE FOR EMPTY(CONT) +IF existacimp('ana','totdeb') + REPLACE ALL totdeb WITH DEB+precdeb,totcred WITH preccred+cred +ENDIF +PACK +*din ana in analitic----- +WAIT WINDOW 'Se salveaza datele...' NOWAIT +DO suprapune WITH 'analitic','ana' +SELECT analitic +SET ORDER TO TAG NUME + +USE IN ana + +RETURN + + + +*------------------------------------------------------------------------------- +PROCEDURE suprapune +PARAMETERS DEST,sursa +LOCAL R +R=0 +**golire +SELECT &DEST +SCATTER MEMVAR BLANK +SCAN + GATHER MEMV +ENDSCAN + +SELECT &DEST +SET ORDER TO +ON ERROR APPE BLAN +GOTO 1 +*BROWSE TITLE 'DEST' +IF FLOCK() + RECALL ALL + + SELECT &sursa + SET ORDER TO +*BROWSE TITLE 'SURSA' + SCAN + R=RECNO() + SCATTER MEMV + SELECT &DEST +*SKIP +*!* If Eof() +*!* Append Blank +*!* ELSE + ON ERROR APPE BLAN + GOTO R +*!* ENDIF + GATHER MEMV + SELECT &sursa + ENDSCAN + + SELECT &DEST + R=RECNO() + DELETE FOR RECNO()>R + +ENDIF +UNLOCK IN &DEST + +RETURN + + + + +*-------------------------------------------------------------------------------------------------------------- +FUNCTION se_reface +LOCAL SE,PRIMALUNA,ACTGOL +SE=.T. +STORE .F. TO PRIMALUNA,ACTGOL + +&&E PRIMA LUNA? +SELECT calendar +GO TOP +IF an=M.an AND nl=M.nl + PRIMALUNA=.T. +ENDIF +SELECT * FROM act INTO CURSOR bbb +IF _TALLY<3 + ACTGOL=.T. +ENDIF + +buton=1 +IF PRIMALUNA AND !ACTGOL + OTM=CREA('TEXTMARER') + OTM.label2.CAPTION='Aceasta este prima luna deschisa. Prin refacere se sterg toate acele date de initializare inscrise'+; + ' manual direct in fisiere si carora nu le corespund inregistrari in registrul jurnal. Doriti ca totusi sa execute refacerea?' + OTM.SHOW(1) + IF buton=2 + RETURN .F. + ENDIF +ENDIF + +SE=!(PRIMALUNA AND ACTGOL) +IF !SE + DO mesaj WITH 'Aceasta este prima luna iar registrul jurnal este gol.','Refacerea nu se executa!' +ENDIF +RETURN SE + + + + + + +*_________________________________________ +PROCEDURE REFcredlun +LOCAL nla,nlb,ana,anb,cond,cond1 + +IF !se_reface() + RETURN +ENDIF + + +cond='(year(dataireg)10000) + IF FOUND() + REPL achitat WITH m.achitat+achitat + REPL achitatval WITH achitatval+m.achitatval + ENDIF + SELE act + ENDDO + +ENDIF + + +SELE act +SET FILT TO + +UNLOCK IN deblun +SELE deblun +SET FILTER TO +RETURN + + +*---------------------------------------------------------------------------------------------- +PROCEDURE refchavans +LOCAL nla,nlb,ana,anb,cond,cond1 +STORE 0 TO M.suma_2, M.achitatval,M.suma,M.sumaval,M.achitat + + +IF !se_reface() + RETURN +ENDIF + +DO refac_act WITH "471" IN actualizare_act.PRG + +cond='(year(dataireg)10000) + IF FOUND() + REPL achitat WITH m.achitat+achitat + REPL achitatval WITH achitatval+m.achitatval + ENDIF +* SET FILTER TO ACHITAT=0 + SELE act + ENDDO + +ENDIF + +UNLOCK IN vanzlu4118 +SELE vanzlu4118 +SET FILTER TO +SELECT act +SET FILTER TO +RETURN + + + +*_______________________________________ +PROCEDURE CALCULEAZABALANTA +SELECT BAL +IF FLOCK() + REPLACE ALL totdeb WITH RULDEB+precdeb; + totcred WITH RULCRED+preccred +ENDIF +UNLOCK +SCAN + IF FLOCK() + IF totdeb-totcred>0 + REPLACE SOLDDEB WITH totdeb-totcred; + SOLDCRED WITH 0 + ELSE + REPLACE SOLDCRED WITH totcred-totdeb; + SOLDDEB WITH 0 + ENDIF + ENDIF + UNLOCK +ENDSCAN +RETURN + +*_________________________________________ + +PROCEDURE RefAna418 +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\ANA418.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'ANA418.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\ANA418.DBF IN 0 ALIAS ANA418U + +SELECT ANA418U + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('ANA418u.totdeb') = 'U' + SELECT NUME,COD_FISCAL, productie AS precdeb,incasat AS preccred FROM ANA418U INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + productie, totcred WITH preccred + incasat, totvaldeb WITH precvaldeb + prodval, totvalcre WITH precvalcre + incasval +*REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('ANA418u.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(PRECdeb + productie) AS precdeb, SUM(preccred + incasat) AS preccred, ; + SUM(precvaldeb + prodval) AS precvaldeb, SUM(precvalcre + incasval) AS precvalcre ; + FROM ANA418U INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(PRECdeb + productie) AS precdeb, SUM(preccred + incasat) AS preccred, ; + SUM(precvaldeb + prodval) AS precvaldeb, SUM(precvalcre + incasval) AS precvalcre ; + FROM ANA418U INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN ANA418U + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA + +SELECT NUME, ; +IIF(LEFT(scd,3) = '418', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '418', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '418', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '418', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '418', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('418',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t418 GROUP BY 1, 2, 3 + +SELECT t418 +SCAN + SCATTER NAME o418 + SELECT rcli + SEEK LEFT(o418.NUME,30) + o418.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o418.COD_FISCAL + ENDIF + ELSE + SEEK LEFT(o418.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o418.acont + ELSE + APPEND BLANK + GATHER NAME o418 + ENDIF + ENDIF + REPLACE productie WITH productie + o418.debit, incasat WITH incasat + o418.credit, prodval WITH prodval + o418.valdebit, incasval WITH incasval + o418.valcredit + + SELECT t418 +ENDSCAN +RELEASE o418 +USE IN t418 + +SELECT rcli +REPLACE ALL totdeb WITH precdeb+productie,totcred WITH preccred+incasat &&,totavans WITH precavans+avans +REPLACE ALL totvaldeb WITH precvaldeb+prodval,totvalcre WITH precvalcre+incasval &&,TOTAVANSV WITH PRECAVANSV+AVANSVAL + +SELECT ANA418 +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +SELECT ANA418 +SET ORDER TO TAG NANA +RETURN + + +*_________________________________________ +PROCEDURE RefFact418 +LOCAL nla,nlb,ana,anb,cond,cond1 +STORE 0 TO M.suma_2, M.achitatval,M.suma,M.sumaval,M.achitat + + +IF !se_reface() + RETURN +ENDIF + +DO refac_act WITH "418" IN actualizare_act.PRG + +cond='(year(dataireg)10000) + IF FOUND() + REPL achitat WITH m.achitat+achitat + REPL achitatval WITH achitatval+m.achitatval + ENDIF +* SET FILTER TO ACHITAT=0 + SELE act + ENDDO + +ENDIF +UNLOCK IN Fact418 +SELECT act +SET FILTER TO +SELE Fact418 +SET FILTER TO +RETURN + + +*---------------------------------------------------------------------------------------------- +PROCEDURE REFVNAvans && refVENITavans +LOCAL nla,ana,anb,cond,cond1,dateA +*Store 0 To M.SUMA_2, M.achitatval,M.SUMA,M.sumaval,M.achitat + + +IF !se_reface() + RETURN +ENDIF + +cond='(year(dataireg)10000) + IF FOUND() + REPL achitat WITH m.achitat+achitat + REPL achitatval WITH achitatval+m.achitatval + REPLACE nume_4 WITH m.EXPLICATIA + ENDIF + SELE act + ENDDO + + +ENDIF + + +SELE act +SET FILT TO + +UNLOCK IN ACHILUN +SELE ACHILUN +SET FILTER TO +RETURN + +*___________________________________________________________________________ + +PROCEDURE REFdividende +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\dividende.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'dividende.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\dividende.DBF IN 0 ALIAS dividendeU + +SELECT dividendeU + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('dividendeu.totdeb') = 'U' + SELECT NUME,COD_FISCAL, LUAT AS precdeb, DAT AS preccred FROM dividendeU INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit, totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit +*REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('dividendeu.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM dividendeU INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM dividendeU INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN dividendeU + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA + +SELECT NUME, ; +IIF(LEFT(scd,3) = '457', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '457', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '457', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '457', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '457', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('457',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t457 GROUP BY 1, 2, 3 + +SELECT t457 +SCAN + SCATTER NAME o457 + SELECT rcli + SEEK LEFT(o457.NUME,30) + o457.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o457.COD_FISCAL + ENDIF + REPLACE debit WITH debit + o457.debit, credit WITH credit + o457.credit, valdebit WITH valdebit + o457.valdebit, valcredit WITH valcredit + o457.valcredit + ELSE + SEEK LEFT(o457.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o457.acont + REPLACE debit WITH debit + o457.debit, credit WITH credit + o457.credit, valdebit WITH valdebit + o457.valdebit, valcredit WITH valcredit + o457.valcredit + ELSE + APPEND BLANK + GATHER NAME o457 + ENDIF + ENDIF + + SELECT t457 +ENDSCAN +RELEASE o457 +USE IN t457 + +SELECT rcli +REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit &&,totavans WITH precavans+avans +REPLACE ALL totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit &&,TOTAVANSV WITH PRECAVANSV+AVANSVAL + +SELECT dividende +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +SELECT dividende +SET ORDER TO TAG NANA +RETURN + +*_________________________________________ + +PROCEDURE refdivLUN +LOCAL nla,nlb,ana,anb,cond,cond1 +STORE 0 TO M.suma_2, M.achitatval,M.suma,M.sumaval,M.achitat + + +IF !se_reface() + RETURN +ENDIF + +cond='(year(dataireg)10000) + IF FOUND() + REPL achitat WITH m.achitat+achitat + REPL achitatval WITH achitatval+m.achitatval + REPLACE nume_4 WITH m.EXPLICATIA + ENDIF + SELE act + ENDDO + + +ENDIF + + +SELE act +SET FILT TO + +UNLOCK IN divLUN +SELE divLUN +SET FILTER TO +RETURN + +*________________________________________________________ + +PROCEDURE REFActionar +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +COPY FILE &dirgen\_alfa\an0000\date00\ACTIONAR.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'ACTIONAR.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\ACTIONAR.DBF IN 0 ALIAS ACTIONARU + +SELECT ACTIONARU + + +USE &loc\&nfscurt\tempo\rcli IN 0 ALIAS rcli + +&&precedente--------- +IF TYPE('ACTIONARu.totdeb') = 'U' + SELECT NUME,COD_FISCAL, DAT AS precdeb, LUAT AS preccred FROM ACTIONARU INTO CURSOR rrr +ELSE + REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit, totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit +*REPLACE ALL totavans WITH precavans + avans, totavansv WITH precavansv + avansval + IF TYPE('ACTIONARu.acont') # 'U' + SELECT NUME, acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM ACTIONARU INTO CURSOR rrr GROUP BY NUME, acont + + ELSE + SELECT NUME, SPACE(4) AS acont, COD_FISCAL, NUMEVAL, ; + SUM(precdeb + debit) AS precdeb, SUM(preccred + credit) AS preccred, ; + SUM(precvaldeb + valdebit) AS precvaldeb, SUM(precvalcre + valcredit) AS precvalcre ; + FROM ACTIONARU INTO CURSOR rrr GROUP BY NUME + ENDIF +ENDIF + +USE IN ACTIONARU + +SELECT rcli +APPEND FROM DBF('rrr') +USE IN rrr + + +&&rulaje------------ +SELE rcli +SET ORDER TO TAG NANA + +SELECT NUME, ; +IIF(LEFT(scd,3) = '455', ASCD, ASCC) AS acont, ; +COD_FISCAL, nume_4 AS NUMEVAL, ; +SUM(IIF(LEFT(scc,3) = '455', suma, 00000000000000)) AS credit, ; +SUM(IIF(LEFT(scd,3) = '455', suma, 00000000000000)) AS debit, ; +SUM(IIF(LEFT(scc,3) = '455', suma_2, 00000000000000.00)) AS valcredit, ; +SUM(IIF(LEFT(scd,3) = '455', suma_2, 00000000000000.00)) AS valdebit ; +FROM act ; +WHERE INLIST('455',LEFT(scd, 3), LEFT(scc,3)) ; +INTO CURSOR t455 GROUP BY 1, 2, 3 + +SELECT t455 +SCAN + SCATTER NAME o455 + SELECT rcli + SEEK LEFT(o455.NUME,30) + o455.acont + IF FOUND() + IF EMPTY(COD_FISCAL) + REPLACE COD_FISCAL WITH o455.COD_FISCAL + ENDIF + REPLACE debit WITH debit + o455.debit, credit WITH credit + o455.credit, valdebit WITH valdebit + o455.valdebit, valcredit WITH valcredit + o455.valcredit + ELSE + SEEK LEFT(o455.NUME,30) + SPACE(4) + IF FOUND() + REPLACE acont WITH o455.acont + REPLACE debit WITH debit + o455.debit, credit WITH credit + o455.credit, valdebit WITH valdebit + o455.valdebit, valcredit WITH valcredit + o455.valcredit + ELSE + APPEND BLANK + GATHER NAME o455 + ENDIF + ENDIF + + SELECT t455 +ENDSCAN +RELEASE o455 +USE IN t455 + +SELECT rcli +REPLACE ALL totdeb WITH precdeb + debit, totcred WITH preccred + credit &&,totavans WITH precavans+avans +REPLACE ALL totvaldeb WITH precvaldeb + valdebit, totvalcre WITH precvalcre + valcredit &&,TOTAVANSV WITH PRECAVANSV+AVANSVAL + +SELECT ACTIONAR +IF FLOCK() + DELETE ALL + APPEND FROM &loc\&nfscurt\tempo\rcli FOR !DELETED() +ENDIF +UNLOCK +USE IN rcli +SELECT ACTIONAR +SET ORDER TO TAG NANA +RETURN + + +*_________________________________________ + +PROCEDURE ref_balanta_partener +LOCAL nla,nlb,ana,anb + +IF !se_reface() + RETURN +ENDIF + +nlb=m.nl +anb=m.an +dateb=calefirma+'\an'+anb+'\'+'date'+nlb + +SELE calendar +LOCATE FOR nl=m.nl AND an=m.an +SKIP -1 +IF !BOF() + nla=nl + ana=an + dateA=calefirma+'\an'+ana+'\date'+nla &&DATE PREC +ELSE + dateA=dirgen+'\_alfa\an0000\date00\' +ENDIF + +SET SAFETY OFF +COPY FILE &dirgen\_alfa\an0000\date00\balanta_partener.* TO &loc\&nfscurt\tempo\rcli.* + +lcFile = ADDBS(dateA) + 'balanta_partener.dbf' +IF !FILE(lcFile) + dateA = dirgen+'\_alfa\an0000\date00' +ENDIF + +USE &dateA\balanta_partener.DBF IN 0 ALIAS balanta_partenerU + +SELECT balanta_partenerU +SELECT * FROM balanta_partenerU WHERE CONT = loCont.CONT INTO CURSOR balanta_partenerA READWRITE +USE IN balanta_partenerU + +SELECT balanta_partenerA +REPLACE ALL precdeb WITH precdeb + debit, preccred WITH preccred + credit, ; +precvaldeb WITH precvaldeb + valdebit, precvalcre WITH precvalcre + valcredit + +REPLACE ALL debit WITH 0, credit WITH 0, valdebit WITH 0, valcredit WITH 0 + +*!* SELECT SUM(IIF(SCD = loCont.CONT, SUMA, 0)) AS debit, SUM(IIF(SCC = loCont.CONT, SUMA, 0)) AS credit, ; +*!* SUM(IIF(SCD = loCont.CONT, SUMA_2, 0)) AS VALDEBIT, SUM(IIF(SCC = loCont.CONT, SUMA_2, 0)) AS VALCREDIT, ; +*!* id_partd, id_partc, IIF(SCD = loCont.CONT, ASCD, IIF(SCC = loCont.CONT, ASCC, '')) AS acont ; +*!* FROM ACT ; +*!* WHERE (!EMPTY(id_partd) OR !EMPTY(id_partc)) AND INLIST(loCont.CONT,SCD,SCC) ; +*!* INTO CURSOR tact ; +*!* GROUP BY id_part, acont + +SELECT SUM(suma) AS debit, SUM(suma_2) AS valdebit, id_partd, ASCD ; +FROM act ; +WHERE !EMPTY(id_partd) AND scd = loCont.CONT ; +INTO CURSOR tactd ; +GROUP BY id_partd, ASCD + +&&& debit +SELECT tactd +SCAN + SCATTER NAME oact + SELECT balanta_partenerA + LOCATE FOR IDpart = oact.id_partd AND CONT = loCont.CONT AND acont = oact.ASCD + IF FLOCK() + IF !FOUND() + APPEND BLANK + GATHER NAME oact + REPLACE IDpart WITH oact.id_partd, CONT WITH loCont.CONT, acont WITH oact.ASCD + ELSE + REPLACE debit WITH debit + oact.debit, ; + valdebit WITH valdebit + oact.valdebit + ENDIF + + ENDIF + UNLOCK + SELECT tactd +ENDSCAN +RELEASE oact +USE IN tactd + +&&& credit +SELECT SUM(suma) AS credit, SUM(suma_2) AS valcredit, id_partc, ASCC ; +FROM act ; +WHERE !EMPTY(id_partc) AND scc = loCont.CONT ; +INTO CURSOR tactc ; +GROUP BY id_partc, ASCC + +SELECT tactc +SCAN + SCATTER NAME oact + SELECT balanta_partenerA + LOCATE FOR IDpart = oact.id_partc AND CONT = loCont.CONT AND acont = oact.ASCC + IF FLOCK() + IF !FOUND() + APPEND BLANK + GATHER NAME oact + REPLACE IDpart WITH oact.id_partc, CONT WITH loCont.CONT, acont WITH oact.ASCC + ELSE + REPLACE credit WITH credit + oact.credit, ; + valcredit WITH valcredit + oact.valcredit + ENDIF + ENDIF + UNLOCK + SELECT tactc +ENDSCAN +RELEASE oact +USE IN tactc + +SELECT balanta_partenerA +REPLACE ALL totdeb WITH precdeb + debit, totvaldeb WITH precvaldeb + valdebit +REPLACE ALL totcred WITH preccred + credit, totvalcre WITH precvalcre + valcredit + +SELECT balanta_partener +SET FILTER TO +IF FLOCK() + DELETE ALL FOR CONT = loCont.CONT + APPEND FROM DBF('balanta_partenerA') +ENDIF +UNLOCK + + +USE IN balanta_partenerA + +ENDPROC && ref_balanta_partener diff --git a/Programe/Vechi/shutdown.prg b/Programe/Vechi/shutdown.prg new file mode 100644 index 0000000..04ae62a --- /dev/null +++ b/Programe/Vechi/shutdown.prg @@ -0,0 +1,3 @@ +IF TYPE("goApp")=="O" AND NOT ISNULL(goApp) + RETURN goApp.OnShutDown() +ENDIF diff --git a/Programe/Vechi/update_roadef_sal.prg b/Programe/Vechi/update_roadef_sal.prg new file mode 100644 index 0000000..7c43d22 --- /dev/null +++ b/Programe/Vechi/update_roadef_sal.prg @@ -0,0 +1,119 @@ + +******************************************* +* PROCEDURE update_responsabil( ) +* Date : 05/23/05, 12:25:08 +* author : liana.macinic +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* +PROCEDURE update_responsabil( ) +If Used('v_resp') + Use In v_resp +Endif + +lcSql = [select * from ] + gcS + [.sal_responsabil where ales = 1] +lcCursor = [v_resp] +lnSucces = goExecutor.oExecute(lcSql,lcCursor) +goExecutor.oReset() + +ENDPROC +*----------------------------------sfarsit procedura update_responsabil---------------------------------- + +******************************************* +* PROCEDURE update_sectie( ) +* Data/ora : 12/16/04, 14:26:22 +* autor : liana.macinic +* descriere: + +****** PARAMETER BLOCK ************** +* Parametri : 0 +* +******************************************* +Procedure update_sectie( ) +If Used('v_sectie') + Use In v_sectie +Endif + +lcSql = [select * from ] + gcS + [.nom_sectii order by sectie]&& where inactiv = 0] +lcCursor = [v_sectie] +lnSucces = goExecutor.oExecute(lcSql,lcCursor) +goExecutor.oReset() + +Return lnSucces + +Endproc +******************************************* +* PROCEDURE update_transe( ) +* Date : 05/26/05, 16:25:42 +* author : liana.macinic +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* +PROCEDURE update_transe( ) +If Used('v_transe') + Use In v_sectie +Endif + +lcSql = [select * from ] + gcS + [.SAL_NOM_TRANSE where inactiv = 0 and sters = 0] +lcCursor = [v_transe] +lnSucces = goExecutor.oExecute(lcSql,lcCursor) +goExecutor.oReset() + +Return lnSucces + +ENDPROC +*----------------------------------sfarsit procedura update_transa---------------------------------- +******************************************* +* PROCEDURE update_ore( ) +* Date : 05/26/05, 16:25:42 +* author : liana.macinic +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* +PROCEDURE update_ore( ) +If Used('v_nomore') + Use In v_nomore +Endif + +lcSql = [select * from ] + gcS + [.SAL_NOMORE where inactiv = 0 and sters = 0] +lcCursor = [v_nomore] +lnSucces = goExecutor.oExecute(lcSql,lcCursor) +goExecutor.oReset() + +Return lnSucces + +ENDPROC +*----------------------------------sfarsit procedura update_ore---------------------------------- +******************************************* +* PROCEDURE update_calcdin( ) +* Date : 06/17/05, 12:52:29 +* author : liana.macinic +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* +PROCEDURE update_calcdin( ) +If Used('v_calcdin') + Use In v_calcdin +Endif + +lcSql = [select id_calcdin,camp,denumire as nume_camp,tabel from ] + gcS + [.sal_nom_calcdin where 2=2] +lcCursor = [v_calcdin] +lnSucces = goExecutor.oExecute(lcSql,lcCursor) +goExecutor.oReset() + +Return lnSucces + +ENDPROC +*----------------------------------sfarsit procedura update_calcdin---------------------------------- \ No newline at end of file diff --git a/Programe/Vechi/updateserver.prg b/Programe/Vechi/updateserver.prg new file mode 100644 index 0000000..49bcb15 --- /dev/null +++ b/Programe/Vechi/updateserver.prg @@ -0,0 +1,497 @@ +********************************************************** +PROCEDURE update_nomenclator + + *!* DO update_coresp_tip_part + *!* DO update_coresp_tip_cont + DO update_lunilean + + *** tabele meniu deschise din proiect + LOCAL lcCaleDateMenu + + lcCaleDateMenu=gcAppPath+[DATEMENU\] + + IF !USED('XREQUEST') + USE &lcCaleDateMenu.XREQUEST IN 0 ALIAS XREQUEST + ENDIF + IF !USED('xitems') + USE &lcCaleDateMenu.xitems IN 0 ALIAS xitems + ENDIF + IF !USED('YACT') + USE &lcCaleDateMenu.YACT IN 0 ALIAS YACT + ENDIF + IF !USED('XSETS') + USE &lcCaleDateMenu.XSETS IN 0 ALIAS XSETS ORDER TAG ID_SET + ENDIF + IF !USED('xACT') + USE &lcCaleDateMenu.xACT IN 0 ALIAS xACT + ENDIF + IF !USED('xnote') + USE &lcCaleDateMenu.xnote IN 0 ALIAS xnote + ENDIF + + IF !USED('menu1') + USE &lcCaleDateMenu.menu1 IN 0 ALIAS menu1 EXCL + ENDIF + + IF !USED('INFISIERE') + USE &lcCaleDateMenu.INFISIERE IN 0 ALIAS INFISIERE + ENDIF + + IF !USED('nom_meniu') + USE &lcCaleDateMenu.nom_meniu IN 0 ALIAS nom_meniu + ENDIF + + IF !USED('refaceri') + USE &lcCaleDateMenu.refaceri IN 0 ALIAS refaceri + ENDIF + + IF !USED('tabela_fisa_cont') + USE &lcCaleDateMenu.tabela_fisa_cont IN 0 ALIAS tabela_fisa_cont + ENDIF + + +ENDPROC && update_nomenclator + +* PROCEDURE update_lunilean( ) +* Date : 06/10/2004, 13:27:54 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_lunilean******************************************* +PROCEDURE update_lunilean( ) + + IF USED('lunilean') + USE IN lunilean + ENDIF + + lcSql = [select * from contafin_oracle.lunilean] + lcCursor = [lunilean] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_lunilean ******************************************* + + +* PROCEDURE update_calendar( ) +* Date : 06/10/2004, 13:27:54 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_calendar ******************************************* +PROCEDURE update_calendar( ) + + IF USED('calendar') + USE IN calendar + ENDIF + + lcSql = [select * from ] + gcS + [.calendar] + lcCursor = [calendar] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_calendar ******************************************* + + +* PROCEDURE update_firme( ) +* Date : 06/10/2004, 13:27:08 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_firme ******************************************* +PROCEDURE update_firme( ) + + *** selectez firmele + IF USED('v_firme') + USE IN v_firme + ENDIF + + lcSql = [select * from nom_firme order by firma] + lcCursor = [v_firme] + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_firme ******************************************* + + +* PROCEDURE update_utilizatori( ) +* Date : 06/10/2004, 13:26:23 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_utilizatori ******************************************* +PROCEDURE update_utilizatori( ) + + IF USED('v_utilizatori') + USE IN v_utilizatori + ENDIF + + lcSql = [SELECT * from utilizatori] + lcCursor = [v_utilizatori] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_utilizatori ******************************************* + +* PROCEDURE update_judete( ) +* Date : 11.10.2004, 15:24:02 +* author : catalin.neagu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_judete ******************************************* +PROCEDURE update_judete( ) + + IF USED('v_jud') + USE IN v_jud + ENDIF + + lcSql = [SELECT * from ] + gcS + [.vnom_judete] + lcCursor = [v_jud] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + + RETURN lnSucces +ENDPROC +******************************************* SFARSIT: update_judete ******************************************* + +********************************************************************** +PROCEDURE cclocalitati + + IF USED('v_nom_localitati') + USE IN v_nom_localitati + ENDIF + + lcSql = 'select id_loc,localitate from '+gcS+'.vnom_localitati order by localitate' + lcCursor = 'v_nom_localitati' + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +*********************************************************************** +************************** +PROCEDURE cctipuri + + IF USED('v_nom_tip_parteneri') + USE IN v_nom_tip_parteneri + endif + + lcSql='select id_tip_part,tip_partener from '+gcS+'.vnom_tip_parteneri order by tip_partener' &&id_tip_part' + lcCursor = 'v_nom_tip_parteneri' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +*********************************************************************** + +* PROCEDURE update_coresp_tip_part( ) +* Date : 13/10/2004, 10:46:59 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_coresp_tip_part******************************************* +PROCEDURE update_coresp_tip_part( ) + + IF USED('coresp_tip_part') + USE IN coresp_tip_part + endif + + *** deschid corespondentele parteneri + lcSql = [select * from ] + gcS + [.coresp_tip_part] + lcCursor = [coresp_tip_part] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_coresp_tip_part******************************************* + + +* PROCEDURE update_coresp_tip_cont( ) +* Date : 13/10/2004, 10:49:03 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_coresp_tip_cont ******************************************* +PROCEDURE update_coresp_tip_cont( ) + + IF USED('coresp_tip_cont') + USE IN coresp_tip_cont + ENDIF + + lcSql = [select * from ] + gcS + [.coresp_tip_cont] + lcCursor = [coresp_tip_cont] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_coresp_tip_cont ******************************************* + +PROCEDURE cctipuri_selectate + LPARAMETERS tnId_part + lnId_part = tnId_part + + IF USED('v_nom_tip_parteneri_selectati') + USE IN v_nom_tip_parteneri_selectati + endif + + lcSql='select id_tip_part,tip_partener from '+gcS+'.VCORESP_TIP_PART where id_part = '+ALLTRIM(STR(lnId_part))+ 'order by tip_partener ' + lcCursor = 'v_nom_tip_parteneri_selectati' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +*********************************************************************** + +PROCEDURE cctipuri_selectate_NOU + LPARAMETERS tnId_TIP_part + lnId_TIP_part = tnId_TIP_part + + IF USED('v_nom_tip_parteneri_selectati') + USE IN v_nom_tip_parteneri_selectati + ENDIF + + lcSql='select id_tip_part,tip_partener from '+gcS+'.VNOM_TIP_PARTENERI where id_TIP_part = '+ALLTRIM(STR(lnId_TIP_part))+ 'order by tip_partener ' + lcCursor = 'v_nom_tip_parteneri_selectati' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +*********************************************************************** + +PROCEDURE ccvalute + IF USED('v_nom_valute') + USE IN v_nom_valute + ENDIF + + lcSql='select id_valuta,nume_val from '+gcS+'.vnom_valute order by nume_val' + lcCursor = 'v_nom_valute' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC + +*********************************************************************** + +PROCEDURE ccsectii + + IF USED('v_nom_sectii') + USE IN v_nom_sectii + ENDIF + + lcSql='select id_sectie,sectie from '+gcS+'.vnom_sectii order by sectie' + lcCursor = 'v_nom_sectii' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +*********************************************************************** + +PROCEDURE ccnorme + IF USED('v_denop') + USE IN v_denop + ENDIF + + lcSql='select id_norme,denop from '+gcS+'.dev_vnorme order by denop' + lcCursor = 'v_denop' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +*********************************************************************** + +PROCEDURE ccmecanici + IF USED('v_mecanici') + USE IN v_mecanici + ENDIF + + lcSql='select id_mecanic,nume||CHR(32)||prenume as nume from '+gcS+'.dev_vmecanici order by nume' + lcCursor = 'v_mecanici' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC + +******************************************* SFARSIT: update_parteneri ******************************************* +* PROCEDURE update_actper( ) +* Date : 09.11.2004, 09:33:32 +* author : catalin.neagu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_actper ******************************************* +PROCEDURE update_actper(tnCod) + IF USED('actact') + USE IN actact + ENDIF + + lcCod = ALLTRIM(STR(tnCod)) + lcSql = [SELECT * from ] + gcS + [.vact where cod = ] + lcCod + lcCursor = [ACTACT] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + + IF lnSucces>0 + SELECT * FROM actact INTO CURSOR actactan READWRITE + ENDIF + IF USED('actact') + USE IN actact + ENDIF + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_actper ******************************************* + + +* PROCEDURE Get_Lista_Act +* Date : 09/11/2004, 15:05:42 +* author : marius.mutu +* description: creeaza o lista cu campurile din act + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:Get_Lista_Act******************************************* +PROCEDURE Get_Lista_Act + LOCAL lcLista + lcLista = [] + IF USED('crs_act') + USE IN crs_act + ENDIF + + lcSql = [select * from ] + gcS + [.ACT WHERE 1=2] + lcCursor = [CRS_ACT] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + goExecutor.oReset() + IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + ENDIF + IF lnSucces > 0 + SELECT CRS_ACT + lnCount = FCOUNT() + FOR i = 1 TO lnCount + SELECT CRS_ACT + lcFieldName = UPPER(ALLTRIM(FIELD(i))) + lcLista = lcLista + [,] + lcFieldName + ENDFOR + lcLista = SUBSTR(lcLista,2) + ENDIF + IF USED('crs_Act') + USE IN CRS_ACT + ENDIF + + RETURN lcLista +ENDPROC +******************************************* SFARSIT: Get_Lista_Act ******************************************* + + +* PROCEDURE update_optiuni( ) +* Date : 15.11.2004, 10:08:49 +* author : catalin.neagu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:update_optiuni ******************************************* +PROCEDURE update_optiuni( ) + IF USED('v_optiuni') + USE IN v_optiuni + ENDIF + + lcSql='select * from '+gcS+'.optiuni order by varname' + lcCursor = 'v_optiuni' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT: update_optiuni ******************************************* + +******************************************* INCEPUT:update_exceptii_ireg ************************************** +PROCEDURE update_exceptii_ireg( ) + + lcSql = [select * from ] + gcS + [.exceptii_ireg] + lcCursor = [exceptii_ireg] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT:update_exceptii_ireg *************************************** + +******************************************* INCEPUT:update_cote_TVA ************************************** +PROCEDURE update_cote_TVA( ) + + lcSql = [select * from ] + gcS + [.cote_TVA where an =] + pcAn + [ and luna = ] + pcNl + lcCursor = [cote_TVA] + lnSucces = goExecutor.oExecute(lcSql,lcCursor) + RETURN lnSucces + +ENDPROC +******************************************* SFARSIT:update_cote_TVA *************************************** + +******************************************* +* PROCEDURE update_optiuni_util( ) +* Data/ora : 02/11/05, 11:07:19 +* autor : liana.macinic +* descriere: + +****** PARAMETER BLOCK ************** +* Parametri : 0 +* +******************************************* +PROCEDURE update_optiuni_util( ) + IF USED('v_optiuni_util') + USE IN v_optiuni_util + ENDIF + + lcSql='select * from optiuni_util where id_util = '+ALLTRIM(STR(gnIdUtil)) + [ or id_util = 0 order by varname] + lcCursor = 'v_optiuni_util' + + lnSucces = goExecutor.oExecute(lcSql,lcCursor) +*!* MESSAGEBOX('v_optiuni_util') + RETURN lnSucces + +ENDPROC + +**********************sfarsit procedura update_optiuni_util******************* \ No newline at end of file diff --git a/Programe/Vechi/verifica.prg b/Programe/Vechi/verifica.prg new file mode 100644 index 0000000..42bfdfe --- /dev/null +++ b/Programe/Vechi/verifica.prg @@ -0,0 +1,1486 @@ +&& ------------------------------ INCEPUT: VerFurnizor ------------------------------ +*!* Procedura: VerFurnizor +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 23-01-2004 15:18:03 +*!* Autor: ANDREI.BAUTU + +PROCEDURE VerFurnizor + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Balanta de furnizori' + + SELE FURNIZOR + SET FILTER TO + SUM PLATIT, TOTDEB, totcred TO M.PLATIT, M.TOTDEB, m.totcred + + IF FLOCK() + REPLACE ALL totdeb WITH precdeb+platit, totcred WITH preccred+achizit, TOTAVANS WITH PRECAVANS+AVANS + UNLOCK + ENDIF + SUM totcred, totdeb, totAVANS TO M.TACHIZIT, M.TPLATIT, M.TAVANS + + SELE BAL + SET FILTER TO + SUM soldcred TO m.soldcred FOR LEFT(cont,3)='401' + M.SOLD=M.SOLDCRED + SUM totdeb-totcred TO m.solddeb FOR LEFT(cont,3)='409' + + if m.tavans # m.solddeb + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta avans fata de sold debitor 409 este ' + LTRIM(STR(M.solddeb-M.TAVANS,12)), .T., llInTabel, lnId_ref + ENDIF + + m.sold=m.sold-m.solddeb + + IF M.sold # m.Tachizit-M.TPLATIT-M.TAVANS + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + '401;409 Diferenta in sold este de: '+ LTRIM(STR(M.SOLD+M.TPLATIT-M.TACHIZIT+M.TAVANS,12)), .T., llInTabel, lnId_ref + + *'Diferenta fata de sold creditor 401-sold debitor 409 este ' + LTRIM(STR(M.SOLD+M.TPLATIT-M.TACHIZIT+M.TAVANS,12)), .T., llInTabel + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold creditor 401-sold debitor 409.', .F., llInTabel, lnId_ref + ENDIF + ENDIF +ENDPROC + +&& ------------------------------ SFARSIT: VerFurnizor ------------------------------ + +&& ------------------------------ INCEPUT: VerCumpLun ------------------------------- +*!* Procedura: VerCumpLun +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:38:37 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCumpLun + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Facturi cumparari' + + LOCAL soldcump + SELE CUMPlun + SET FILTER TO + SUM totctva-achitat TO m.soldcump + + SELECT furnizor + SET FILTER TO + SUM totcred - totdeb TO m.sold + + IF m.sold <> m.soldcump + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta intre sold furnizor si sold facturi este ' + LTRIM(STR(m.sold - m.soldcump, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente Diferenta intre sold furnizor si sold facturi.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCumpLun ------------------------------ + +&& ------------------------------INCEPUT: Verfurniz404 ------------------------------ +*!* Procedura: Verfurniz404 +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 10:08:37 +*!* Autor: ANDREI.BAUTU +PROCEDURE Verfurniz404 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Balanta furnizori imobilizari' + + SELE furniz404 + SET FILTER TO + SUM PLATIT,TOTDEB,totcred TO M.PLATIT,M.TOTDEB,m.totcred + + IF FLOCK() + REPLACE ALL totdeb WITH precdeb+platit, totcred WITH preccred+achizit + UNLOCK + ENDIF + SUM totcred,totdeb TO M.TACHIZIT, M.TPLATIT + + SELE BAL + SET FILTER TO + SUM soldcred TO m.soldcred FOR LEFT(cont,3)='404' + m.sold=m.soldCRED + + IF M.sold # m.Tachizit-M.TPLATIT + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 404 este ' + LTRIM(STR(M.SOLD+M.TPLATIT-M.TACHIZIT, 12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 404 .', .F., llInTabel, lnId_ref + ENDIF + ENDIF +ENDPROC +&& ------------------------------SFARSIT: Verfurniz404 ------------------------------ + +&& ------------------------------ INCEPUT: VerCumpLun404 ------------------------------ +*!* Procedura: VerCumpLun404 +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 15:27:19 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCumpLun404 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Facturi cumparari 404' + + LOCAL soldcump + SELECT cumplun404 + SET FILTER TO + SUM totctva - achitat TO m.soldcump + + SELECT furniz404 + SET FILTER TO + SUM totcred - totdeb TO m.sold + + IF m.sold <> m.soldcump + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de balanta analitica de facturi este ' + LTRIM(STR(m.sold - m.soldcump, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de balanta analitica de facturi.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCumpLun404 ------------------------------ + +&& ------------------------------INCEPUT: Verana408 ------------------------------ +*!* Procedura: Verana408 +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 10:21:58 +*!* Autor: ANDREI.BAUTU +PROCEDURE Verana408 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Balanta facturi nesosite' + + SELE ANA408 + SET FILTER TO + + IF FLOCK() + REPLACE ALL totdeb WITH precdeb+platit,totcred WITH preccred+achizit + UNLOCK + ENDIF + SUM totcred,totdeb TO M.TACHIZIT,M.TPLATIT + + SELE BAL + SET FILTER TO + SUM soldcred TO m.soldcred FOR LEFT(cont,3)='408' + M.SOLD=M.SOLDCRED + *!* M.SOLD=M.SOLDCRED+M.SOLD + + IF M.sold # m.Tachizit-M.TPLATIT + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 408 este ' + LTRIM(STR(M.SOLD+M.TPLATIT-M.TACHIZIT, 12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 408.', .F., llInTabel, lnId_ref + ENDIF + ENDIF +ENDPROC +&& ------------------------------SFARSIT: Verana408 ------------------------------ + +&& ------------------------------ INCEPUT: VerFact408 ------------------------------ +*!* Procedura: VerFact408 +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 15:19:38 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerFact408 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Facturi nesosite' + + LOCAL soldcump + SELECT FACT408 + SET FILTER TO + SUM totctva - achitat to m.soldcump + + SELECT ANA408 + SET FILTER TO + SUM totcred - totdeb TO m.sold + + IF m.sold <> m.soldcump + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de balanta analitica facturi 408 este ' + LTRIM(STR(m.sold - m.soldcump, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de balanta analitica facturi 408.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerFact408 ------------------------------ + + + + + + + + + +&& ------------------------------ INCEPUT: verClienti ------------------------------ +*!* Procedura: verClienti +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 23-01-2004 14:46:21 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerClienti + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Balanta de clienti' + + LOCAL M.SUM1,M.SUM2,M.SUM3,M.SUM4 + + SELECT CLIENTI + SET FILTER TO + IF FLOCK() + REPLACE ALL TOTDEB WITH precdeb + PRODUCTIE, ; + totcred WITH preccred + INCASAT, ; + TOTAVANS WITH PRECAVANS + AVANS + UNLOCK + ENDIF + + SUM TOTAVANS, totcred, TOTDEB TO m.SUM1, M.SUM2, M.SUM3 + + SELE BAL + SET FILTER TO + SUM SOLDDEB TO M.SOLD FOR LEFT(CONT,3)='411' AND CONT<>"4118" + SUM totcred-totdeb TO M.SOLDcred FOR LEFT(CONT,3)='419' + + m.SOLD = m.SOLD + m.SOLDcred + m.SUM4 = M.SUM3-M.SUM2 + m.SUM1 + + IF M.SOLD # M.SUM4 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + '411+419 Diferenta soldului este de: '+ LTRIM(STR(M.SUM4-M.SOLD, 12)), .T., llInTabel, lnId_ref + + *'Diferenta fata de sold debitor 411-sold creditor 419 este ' + LTRIM(STR(M.SUM4-M.SOLD, 12)), .T., llInTabel + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold debitor 411-sold creditor 419.', .F., llInTabel, lnId_ref + ENDIF + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: verClienti ------------------------------ + +&& ------------------------------ INCEPUT: VerVanzLun ------------------------------ +*!* Procedura: VerVanzLun +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:51:07 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerVanzLun + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Facturi de vanzari' + + LOCAL soldvanz + SELECT VANZlun + SET FILTER TO + SUM totctva-achitat TO m.soldvanz + + SELECT clienti + SET FILTER TO + SUM totdeb-totcred TO m.sold + + IF m.sold <> m.soldvanz + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de clienti este ' + LTRIM(STR(m.sold - m.soldvanz, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de clienti.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerVanzLun ------------------------------ + +&& ------------------------------INCEPUT: VerClient4118 ------------------------------ +*!* Procedura: VerClient4118 +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 12:57:43 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerClient4118 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Balanta clienti incerti' + + Local M.SUM2,M.SUM3 + Select CLIENT4118 + Set Filter To + If Flock() + Replace All TOTDEB With precdeb+PRODUCTIE,totcred With preccred+INCASAT + Endif + Unlock + Sum totcred, TOTDEB To M.SUM2,M.SUM3 + + Sele BAL + Set Filter To + Sum SOLDDEB To M.sold For Left(Cont,4)='4118' + + IF M.sold#M.SUM3-M.SUM2 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 4118 este ' + LTRIM(STR(-(M.sold-M.SUM3+M.SUM2),12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 4118.', .F., llInTabel, lnId_ref + ENDIF + ENDIF +ENDPROC +&& ------------------------------SFARSIT: VerClient4118 ------------------------------ + +&& ------------------------------ INCEPUT: VerVanzLu4118 ------------------------------ +*!* Procedura: VerVanzLu4118 +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 15:47:03 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerVanzLu4118 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Facturi clienti incerti sau in litigiu' + + LOCAL soldcump + SELECT VANZlu4118 + SET FILTER TO + SUM totctva - achitat TO soldcump + + SELECT client4118 + SET FILTER TO + SUM totdeb - totcred TO m.sold + + IF m.sold <> m.soldcump + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta intre sold clienti si sold facturi este ' + LTRIM(STR(m.sold - m.soldcump, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente intre sold client si sold facturi.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerVanzLu4118 ------------------------------ + +&& ------------------------------INCEPUT: Verana418 ------------------------------ +*!* Procedura: Verana418 +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 12:30:51 +*!* Autor: ANDREI.BAUTU +PROCEDURE Verana418 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Balanta facturi neintocmite' + + LOCAL M.SUM2,M.SUM3,M.SUM4 + SELECT ANA418 + SET FILTER TO + + IF FLOCK() + REPLACE ALL totdeb WITH precdeb+productie,totcred WITH preccred+incasat + ENDIF + UNLOCK + + sum totcred, totdeb to M.SUM2, M.SUM3 + + M.SUM4=m.sum3-M.SUM2 + + SELE BAL + SET FILTER TO + SUM SOLDDEB TO M.SOLD FOR LEFT(CONT,3)='418' + + IF M.SOLD#M.SUM4 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 418 este '+ LTRIM(STR(M.SUM4-M.SOLD, 12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 418.', .F., llInTabel, lnId_ref + ENDIF + ENDIF +ENDPROC +&& ------------------------------SFARSIT: Verana418 ------------------------------ + +&& ------------------------------ INCEPUT: VerFact418 ------------------------------ +*!* Procedura: VerFact418 +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 15:56:05 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerFact418 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Clienti - facturi de intocmit' + + LOCAL soldcump + SELECT Fact418 + SET FILTER TO + SUM totctva - achitat TO m.soldcump + + SELECT ana418 + SET FILTER TO + SUM totdeb - totcred TO m.sold + + IF m.sold <> m.soldcump + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta intre sold 418 si sold facturi 418 este ' + LTRIM(STR(m.sold - m.soldcump, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente intre sold 418 si sold facturi 418.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerFact418 ------------------------------ + + + + + + + + + + + + +&& ------------------------------ INCEPUT: VerDebitor ------------------------------ +*!* Procedura: VerDebitor +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 23-01-2004 16:35:34 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerDebitor + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Balanta de debitori' + + Local m.SUM1,M.SUM2,M.SUM3,M.SUM4 + + Select DEBITOR + Set Filter To + + Select DEBITOR + If Flock() + Replace All TOTDEB With precdeb+DEBIT, totcred With preccred+CREDIT + Unlock + Endif + Sum totcred,TOTDEB To M.SUM2, M.SUM3 + m.Sum3 = m.Sum3 - m.sum2 + + Sele BAL + Sum SOLDDEB, SOLDcred To M.SOLDDEB, M.SOLDcred For Left(Cont,3)='461' + m.SOLD=m.SOLDDEB-m.SOLDcred + + IF M.SOLD # m.Sum3 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de sold 461 este ' + LTRIM(STR(m.Sum3-M.SOLD,12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold 461.', .F., llInTabel, lnId_ref + ENDIF + ENDIF + +ENDPROC +&& ------------------------------ SFARSIT: VerDebitor ------------------------------ + +&& ------------------------------ INCEPUT: VerCreditor ------------------------------ +*!* Procedura: VerCreditor +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 23-01-2004 16:43:56 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCreditor + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Balanta de creditori' + + LOCAL M.SUM2,M.SUM3 + + SELECT CREDITOR + SET FILTER TO + IF FLOCK() + REPLACE ALL TOTDEB WITH precdeb+DEBIT,totcred WITH preccred+CREDIT + UNLOCK + ENDIF + SUM totcred,TOTDEB TO M.SUM2,M.SUM3 + m.sum2 = m.sum2 - m.sum3 + + SELE BAL + SET FILTER TO + SUM SOLDDEB, SOLDcred TO M.SOLDdeb, M.SOLDcred FOR LEFT(CONT,3)='462' + + m.SOLD=m.SOLDcred - m.SOLDdeb + + IF M.SOLD # m.Sum2 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de sold 462 este ' + LTRIM(STR(m.Sum2-M.SOLD,12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold 462.', .F., llInTabel, lnId_ref + ENDIF + ENDIF + +ENDPROC +&& ------------------------------ SFARSIT: VerCreditor ------------------------------ + +&& ------------------------------ INCEPUT: VerDividende ------------------------------ +*!* Procedura: VerDividende +*!* Parametrii: llInTabel, lnId_ref +*!* Data/Ora generarii: 14-04-2004 12:51:56 +*!* Autor: GEORGIANA.VOICU +PROCEDURE VerDividende + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Balanta dividende' + + LOCAL M.SUM2,M.SUM3 + + SELECT dividende + SET FILTER TO + IF FLOCK() + REPLACE ALL TOTDEB WITH precdeb+DEBIT,totcred WITH preccred+CREDIT + UNLOCK + ENDIF + SUM totcred,TOTDEB TO M.SUM2,M.SUM3 + m.sum2 = m.sum2 - m.sum3 + + SELE BAL + SET FILTER TO + SUM SOLDDEB, SOLDcred TO M.SOLDdeb, M.SOLDcred FOR LEFT(CONT,3)='457' + + m.SOLD=m.SOLDcred - m.SOLDdeb + + IF M.SOLD # m.Sum2 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de sold 457 este ' + LTRIM(STR(m.Sum2-M.SOLD,12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold 457.', .F., llInTabel, lnId_ref + ENDIF + ENDIF + +ENDPROC +&& ------------------------------ SFARSIT: VerDividende ------------------------------ + +&& ------------------------------ INCEPUT: VerDebLun ------------------------------ +*!* Procedura: VerDebLun +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 15:12:53 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerDebLun + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Inregistrari debitori diversi' + + LOCAL solddeb + SELECT deblun + SET FILTER TO + sum totctva - achitat TO m.solddeb + + SELECT debitor + set filter to + SUM totdeb - totcred TO m.sold + + IF m.sold <> m.solddeb + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de balanta analitica debitori este ' + LTRIM(STR(m.sold - m.solddeb, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de balanta analitica debitori.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerDebLun ------------------------------ + +&& ------------------------------ INCEPUT: VerCredLun ------------------------------ +*!* Procedura: VerCredLun +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:57:39 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCredLun + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Inregistrari creditori diversi' + + LOCAL soldcred + + SELECT credlun + SET FILTER TO + sum totctva - achitat to m.soldcred + + SELECT creditor + SET FILTER TO + SUM totcred - totdeb TO m.sold + + IF m.sold <> m.soldcred + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de balanta analitica creditori este ' + LTRIM(STR(m.sold - m.soldcred, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de balanta analitica creditori.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCredLun ------------------------------ + +&& ------------------------------ INCEPUT: VerDivLun ------------------------------ +*!* Procedura: VerDivLun +*!* Parametrii: llInTabel, lnId_ref +*!* Data/Ora generarii: 14-04-2004 12:47:39 +*!* Autor: GEORGIANA.VOICU +PROCEDURE VerDivLun + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Inregistrari dividende' + + LOCAL soldcred + + SELECT divlun + SET FILTER TO + sum totctva - achitat to m.soldcred + + SELECT dividende + SET FILTER TO + SUM totcred - totdeb TO m.sold + + IF m.sold <> m.soldcred + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de balanta dividende este ' + LTRIM(STR(m.sold - m.soldcred, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de balanta dividende.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerDivLun ------------------------------ + +&& ------------------------------ INCEPUT: VerActionar ------------------------------ +*!* Procedura: VerActionar +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 10:18:05 +*!* Autor: ANDREI.BAUTU + +PROCEDURE VerActionar + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Alti' + lcSursa = 'Balanta de actionari' + + LOCAL M.SUM2,M.SUM3 + + SELECT actionar + SET FILTER TO + IF FLOCK() + REPLACE ALL TOTDEB WITH precdeb+DEBIT,totcred WITH preccred+CREDIT + UNLOCK + ENDIF + SUM totcred,TOTDEB TO M.SUM2,M.SUM3 + m.sum2 = m.sum2 - m.sum3 + + SELE BAL + SET FILTER TO + SUM SOLDDEB, SOLDcred TO M.SOLDdeb, M.SOLDcred FOR LEFT(CONT,3)='455' + + m.SOLD=m.SOLDcred - m.SOLDdeb + + IF M.SOLD # m.Sum2 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de sold 455 este ' + LTRIM(STR(m.Sum2-M.SOLD,12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold 455.', .F., llInTabel, lnId_ref + ENDIF + ENDIF + + +ENDPROC +&& ------------------------------ SFARSIT: VerActionar ------------------------------ + + + + + + + + + +&& ------------------------------INCEPUT: VerCasaNume ------------------------------ +*!* Procedura: VerCasaNume +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 14:05:56 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCasaNume + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Casa' + lcSursa = 'Solduri case' + + LOCAL m.sum1,m.sum2,m.sum3 + Sele CASANUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.sum3=M.sum1-M.sum2 + m.SOLDDEB=0 + m.SOLDCRED=0 + Sele Bal + Seek '5311' + IF FOUND() + Scatter Memvar + ENDIF + + IF M.SOLDDEB-M.SOLDCRED # M.sum3 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 5311 este ' + LTRIM(STR(M.SOLDDEB-M.SOLDCRED-M.sum3,12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 5311.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC + +&& ------------------------------SFARSIT: VerCasaNume ------------------------------ + +&& ------------------------------ INCEPUT: VerCasa ------------------------------ +*!* Procedura: VerCasa +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:16:47 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCasa + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Casa' + lcSursa = 'Registrul de casa' + +*!* SELECT BAL +*!* LOCATE FOR cont='5311' +*!* m.solddeb = solddeb + Sele CASANUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.solddeb=M.sum1-M.sum2 + + SELE CASA + SUM INCASARI, PLATI TO m.tINCASARI, M.tPLATI + IF M.TINCASARI-M.TPLATI# M.SOLDDEB + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de solduri case este ' + LTRIM(STR(M.TINCASARI-M.TPLATI-M.SOLDDEB, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de de solduri case.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCasa ------------------------------ + +&& ------------------------------INCEPUT: VerCASVNUME ------------------------------ +*!* Procedura: VerCASVNUME +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 13:52:28 +*!* Autor: ANDREI.BAUTU + +PROCEDURE VerCASVNUME + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Casa' + lcSursa = 'Solduri case in valuta' + + LOCAL m.sum1,m.sum2,m.sum3 + Sele CASVNUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.sum3=M.sum1-M.sum2 + + Sele Bal + Seek '5314' + m.SOLDDEB=0 + m.SOLDCRED=0 + If Found() + Scatter Memvar + ENDIF + IF M.SOLDDEB-M.SOLDCRED # M.sum3 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 5314 este ' + LTRIM(STR(M.SOLDDEB-M.SOLDCRED-M.sum3,12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 5314.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------SFARSIT: VerCASVNUME ------------------------------ + +&& ------------------------------ INCEPUT: VerCasaVal ------------------------------ +*!* Procedura: VerCasaVal +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:16:47 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCasaVal + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Casa' + lcSursa = 'Registrul de casa in valuta' + +*!* SELECT BAL +*!* LOCATE FOR cont='5314' +*!* m.solddeb = solddeb + Sele CASVNUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.solddeb=M.sum1-M.sum2 + + SELE CASAVal + SUM INCASARI, PLATI TO m.tINCASARI, M.tPLATI + IF M.TINCASARI-M.TPLATI# M.SOLDDEB + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de solduri case este ' + LTRIM(STR(M.TINCASARI-M.TPLATI-M.SOLDDEB, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de solduri case.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCasaVal ------------------------------ + + + + + + + + + + + +&& ------------------------------INCEPUT: VerBanNume ------------------------------ +*!* Procedura: VerBanNume +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 14:23:52 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerBanNume + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Banca' + lcSursa = 'Solduri banci' + + LOCAL m.sum1,m.sum2,m.sum3 + Sele BANNUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.sum3=M.sum1-M.sum2 + m.SOLDDEB=0 + m.SOLDCRED=0 + + Sele Bal + Seek '5121' + IF FOUND() + Scatter Memvar + ENDIF + IF M.SOLDDEB-M.SOLDCRED # M.sum3 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 5121 este ' + LTRIM(STR(M.SOLDDEB-M.SOLDCRED-M.sum3,12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 5121.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------SFARSIT: VerBanNume ------------------------------ + +&& ------------------------------ INCEPUT: VerBanca ------------------------------ +*!* Procedura: VerBanca +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:16:47 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerBanca + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Banca' + lcSursa = 'Registrul de banca' + +*!* SELECT BAL +*!* LOCATE FOR cont='5121' +*!* m.solddeb = solddeb + Sele BANNUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.solddeb=M.sum1-M.sum2 + + SELE BANCA + SUM INCASARI, PLATI TO m.tINCASARI, M.tPLATI + + IF M.TINCASARI-M.TPLATI# M.SOLDDEB + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de solduri banci este ' + LTRIM(STR(M.TINCASARI-M.TPLATI-M.SOLDDEB, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de solduri banci.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerBanca ------------------------------ + +&& ------------------------------INCEPUT: VerBanVNume ------------------------------ +*!* Procedura: VerBanVNume +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 14:18:18 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerBanVNume + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Banca' + lcSursa = 'Solduri banci in valuta' + + LOCAL m.sum1,m.sum2,m.sum3 + Sele BANVNUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.sum3=M.sum1-M.sum2 + m.SOLDDEB=0 + m.SOLDCRED=0 + Sele Bal + Seek '5124' + IF FOUND() + Scatter Memvar + ENDIF + IF M.SOLDDEB-M.SOLDCRED # M.sum3 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 5124 este ' + LTRIM(STR(M.SOLDDEB-M.SOLDCRED-M.sum3,12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 5124.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------SFARSIT: VerBanVNume ------------------------------ + +&& ------------------------------ INCEPUT: VerBancaVal ------------------------------ +*!* Procedura: VerBancaVal +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:16:47 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerBancaVal + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Banca' + lcSursa = 'Registrul de banca in valuta' + +*!* SELECT BAL +*!* LOCATE FOR cont='5124' +*!* m.solddeb = solddeb + Sele BANVNUME + Sum INCASARI +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.solddeb=M.sum1-M.sum2 + + SELE BANCAVal + SUM INCASARI, PLATI TO m.tINCASARI, M.tPLATI + IF M.TINCASARI-M.TPLATI# M.SOLDDEB + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de solduri banci este ' + LTRIM(STR(M.TINCASARI-M.TPLATI-M.SOLDDEB, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de solduri banci.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerBancaVal ------------------------------ + + + + + + + +&& ------------------------------INCEPUT: VerCecNume ------------------------------ +*!* Procedura: VerCecNume +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 14:30:32 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCecNume + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Alte' + lcSursa = 'Cec - Solduri' + + LOCAL m.sum1,m.sum2,m.sum3 + Sele CecNume + Sum INCARCAT +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.sum3=M.sum1-M.sum2 + m.SOLDDEB=0 + m.SOLDCRED=0 + Sele Bal + Seek '5112' + IF FOUND() + Scatter Memvar + ENDIF + IF M.SOLDDEB-M.SOLDCRED # M.sum3 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta in sold 5112 este ' + LTRIM(STR(M.SOLDDEB-M.SOLDCRED-M.sum3,12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente in sold 5112.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------SFARSIT: VerCecNume ------------------------------ + +&& ------------------------------ INCEPUT: VerCec ------------------------------ +*!* Procedura: VerCec +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 14:16:47 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCec + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Alte' + lcSursa = 'Cec - Registrul de operatiuni' + +*!* SELECT BAL +*!* LOCATE FOR cont='5112' +*!* m.solddeb = solddeb + Sele CecNume + Sum INCARCAT +PRECDEB ,PLATI + preccred TO m.sum1,M.sum2 + m.solddeb=M.sum1-M.sum2 + + SELE CEC + SUM INCARCAT, PLATI TO m.tINCASARI, M.tPLATI + IF M.TINCASARI-M.TPLATI# M.SOLDDEB + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de solduri CEC este ' + LTRIM(STR(M.TINCASARI-M.TPLATI-M.SOLDDEB, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de solduri CEC.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCec ------------------------------ + +&& ------------------------------ INCEPUT: VerAchit542 ------------------------------ +*!* Procedura: VerAchit542 +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 09:51:54 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerAchit542 + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Alte' + lcSursa = 'Balanta de achizitori' + + Local m.SUM1,M.SUM2,M.SUM3,M.SUM4 + Select achit542 + Set Filter To + + IF Flock() + Replace All TOTDEB With precdeb+DEBIT, totcred With preccred+CREDIT + UNLOCK + ENDIF + Sum totcred, TOTDEB To M.SUM2, M.SUM3 + M.SUM1 = M.Sum3-m.sum2 + + Sele BAL + Set Filter To + Sum SOLDDEB, SOLDcred To M.SOLDDEB, M.SOLDcred For Left(Cont,3)='542' + m.SOLD=m.SOLDDEB-m.SOLDcred + + If M.SOLD # M.SUM1 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de sold 542 este ' + LTRIM(STR(m.Sum1-M.SOLD,12)), .T., llInTabel, lnId_ref + ELSE + IF llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente fata de sold 542.', .F., llInTabel, lnId_ref + ENDIF + ENDIF + +ENDPROC +&& ------------------------------ SFARSIT: VerAchit542 ------------------------------ + +&& ------------------------------ INCEPUT: VerAchiLun ------------------------------ +*!* Procedura: VerAchiLun +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 16:08:22 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerAchiLun + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Trezorerie - Alte' + lcSursa = 'Avansuri de trezorerie' + + LOCAL soldcump + SELE achilun + SET FILTER TO + SUM totctva - achitat TO m.soldcump + + sele achit542 + set filter to + SUM totdeb - totcred TO m.sold + + IF m.sold <> m.soldcump + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta intre sold achizitori si sold inregistrari este ' + LTRIM(STR(m.sold - m.soldcump, 12)), .T., llInTabel, lnId_ref + ELSE + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente intre sold achizitori si sold inregistrari.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerAchiLun ------------------------------ + + + + + + +&& ------------------------------ INCEPUT: VerCump ------------------------------ +*!* Procedura: VerCump +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 11:33:20 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerCump + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Furnizori' + lcSursa = 'Registrul de cumparari' + + LOCAL llDiferente + m.stotctva=0 + SELE act + SUM suma TO m.f767 FOR LEFT(scc,3) = '767' AND INLIST(LEFT(scd,3),'401','404') + + SELECT BAL +*!* SEEK '767 ' +*!* m.f767=rulcred + SEEK '401 ' + m.f401=rulcred + SEEK '404 ' + m.f404=rulcred + m.f401404=m.f401+m.f404-M.F767 + seek '4426' + m.f4426=ruldeb + + SELECT CUMP + SUM totctva, neimpozab, totftvaI, tvaI, totftvaM, tvaM ; + TO m.Stotctva, m.Sneimpozab, m.StotftvaI, m.StvaI, m.StotftvaM, m.StvaM + M.ADUN=m.Sneimpozab + m.StotftvaI + m.StvaI + m.StotftvaM + m.StvaM + IF M.STOTCTVA # M.ADUN + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta este ' + LTRIM(STR(M.STOTCTVA-M.ADUN, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + SELECT cump + SUM totctva TO m.stotctva FOR INLIST(LEFT(scc,3),'401','404') + + IF M.STOTCTVA # M.f401404 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de 401+404 este ' + LTRIM(STR(M.STOTCTVA-M.f401404, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF m.f4426 # m.StvaM + m.stvai + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta de TVA este ' + LTRIM(STR(m.f4426-m.StvaM-m.stvai, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF !llDiferente AND llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerCump ------------------------------ + +&& ------------------------------ INCEPUT: VerVanz ------------------------------ +*!* Procedura: VerVanz +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 11:48:29 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerVanz + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Terti - Clienti' + lcSursa = 'Registrul de vanzari' + + LOCAL m.f461, llDiferente + SELECT vanz + SUM totctva, neimpozab, totftvaI, tvaI, totftvaM, tvaM ; + TO m.Stotctva, m.Sneimpozab, m.StotftvaI, m.StvaI, m.StotftvaM, m.StvaM + M.ADUN=m.Sneimpozab+m.StotftvaI+m.StvaI+m.StotftvaM+m.StvaM + + IF M.STOTCTVA # M.ADUN + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta este ' + LTRIM(STR(M.STOTCTVA-M.ADUN, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + + SELE act + SUM suma TO m.f667 FOR LEFT(scd,3) = '667' AND INLIST(LEFT(scc,3),'411') + + SELE BAL +*!* SEEK '667 ' +*!* m.f667=rulDEB + + SEEK '461 ' + m.f461=IIF(FOUND(), rulDEB, 0) + + SUM RULDEB TO M.RULDEB FOR LEFT(CONT,3)='411' AND cont<>'4118' + + sele vanz + Sum totctva,neimpozab,totftvaI,tvaI,totftvaM,tvaM; + TO m.stotctva,m.Sneimpozab,m.StotftvaI,m.StvaI,; + M.StotftvaM,m.StvaM For Left(SCD,3)='411' And scd<>'4118' + + SUM tvam, tvai TO tvam419, tvai419 FOR LEFT(scd,3) = '419' + + m.ADUN=m.Sneimpozab+m.StotftvaI+m.StvaI+; + M.StotftvaM+m.StvaM + + If M.stotctva + (tvam419 + tvai419) != M.ruldeb - M.f667 + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta fata de 411 este: '+ LTRIM(STR(M.stotctva + (tvam419 + tvai419)-M.ruldeb+M.f667,12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + + +*!* SUM totctva, neimpozab, totftvaI, tvaI, totftvaM, tvaM ; +*!* TO m.Stotctva, m.Sneimpozab, m.StotftvaI, m.StvaI, m.StotftvaM, m.StvaM ; +*!* FOR LEFT(SCD,3)='411' AND cont<>'4118' +*!* +*!* M.ADUN=m.Sneimpozab+m.StotftvaI+m.StvaI+m.StotftvaM+m.StvaM +*!* +*!* IF M.STOTCTVA != M.RULDEB-M.F667 +*!* DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; +*!* 'Diferenta fata de 411 este ' + LTRIM(STR(M.STOTCTVA-M.RULDEB+M.F667, 12)), .T., llInTabel, lnId_ref +*!* llDiferente = .T. +*!* ENDIF + + IF !llDiferente AND llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerVanz ------------------------------ + +&& ------------------------------ INCEPUT: VerBal ------------------------------- +*!* Procedura: VerBal +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 12:00:13 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerBal + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = '' + lcSursa = 'Balanta' + + local trd, trc, s, pd, pc, td, tc, llDiferente + store 0 to trd,trc,s,pd,pc,td,tc + SELECT ACT + SET FILTER TO + SUM SUMA to S + + SELE BAL + SUM RULDEB, RULCRED, precdeb, preccred TO TRD, TRC, pd, pc + IF TRD<>TRC + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Balanta dezechilibrata cu ' + LTRIM(STR(TRC-TRD, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF TRc<>s + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferente intre jurnal si balanta pe credit este ' + LTRIM(STR(TRC-S, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF TRD<>s + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferente intre jurnal si balanta pe debit este ' + LTRIM(STR(TRD-S, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + + SELECT calendar + LOCATE FOR nl=pcnl and an=pcan + SKIP -1 + if bof() OR !FOUND() + RETURN + ENDIF + dateprec = calefirma+'\an'+an+'\date'+nl + use &dateprec\bal in 0 alias bal_prec + SELECT bal_prec + SUM totdeb, totcred, solddeb, soldcred to td, tc, sd, sc + + IF m.nl<>'01' + IF pd<>td + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta de preluare a balantei din precedent este ' + LTRIM(STR(pd-td, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF pc<>tc + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta de preluare a balantei din precedent este ' + LTRIM(STR(pc-tc, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + ELSE + IF pd<>sd + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta de preluare a balantei din precedent este ' + LTRIM(STR(pd-sd, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF pc<>sc + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta de preluare a balantei din precedent este ' + LTRIM(STR(pc-sc, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + ENDIF + use in bal_prec + IF !llDiferente AND llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente.', .F., llInTabel, lnId_ref + ENDIF + +m.nl=pcnl +m.an=pcan + +ENDPROC +&& ------------------------------ SFARSIT: VerBal ------------------------------ + +&& ------------------------------ INCEPUT: VerAct ------------------------------ +*!* Procedura: VerAct +*!* Parametrii: llInTabel +*!* Data/Ora generarii: 27-01-2004 12:14:27 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerAct + LPARAMETERS llInTabel, lnId_ref + + LOCAL lcCategorie, lcSursa + lcCategorie = 'Diverse' + lcSursa = 'Registrul jurnal' + + local trd,trc,s,pd,pc,td,tc, llDiferente + store 0 to trd,trc,s,pd,pc,td,tc + SELECT ACT + SET FILTER TO + sum SUMA to S + + SELE BAL + SUM RULDEB,RULCRED,precdeb,preccred TO TRD,TRC,pd,pc + IF TRD<>TRC + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Balanta dezechilibrata cu ' + LTRIM(STR(TRC-TRD, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF (TRc<>s) + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta intre jurnal si balanta pe credit este ' + LTRIM(STR(TRC-S, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + endif + IF (TRD<>s) + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Diferenta intre jurnal si balanta pe debit este ' + LTRIM(STR(TRD-S, 12)), .T., llInTabel, lnId_ref + llDiferente = .T. + ENDIF + IF !llDiferente AND llInTabel + DO anunta_rezultat IN MESAJE WITH lcCategorie, lcSursa, ; + 'Nu sunt diferente.', .F., llInTabel, lnId_ref + ENDIF +ENDPROC +&& ------------------------------ SFARSIT: VerAct ------------------------------------- + +&& ------------------------------INCEPUT: VerificareLunaDeschisa ------------------------------ +*!* Procedura: VerificareLunaDeschisa +*!* Parametri: llInTabel +*!* Data/Ora generarii: 03-02-2004 14:39:07 +*!* Autor: ANDREI.BAUTU +PROCEDURE VerificareLunaDeschisa + LPARAMETERS llInTabel + sterge_mesaje() + +&& Diverse + DO VerBal IN verifica WITH llInTabel, 1 + + *DO VerAct IN verifica WITH llInTabel, 36 + +&& Terti - Furnizori + DO VerCump IN verifica WITH llInTabel, 11 + + DO VerFurnizor IN verifica WITH llInTabel, 9 + DO VerCumpLun IN verifica WITH llInTabel, 10 + + DO Verfurniz404 IN verifica WITH llInTabel, 13 + DO VerCumpLun404 IN verifica WITH llInTabel, 14 + + DO Verana408 IN verifica WITH llInTabel, 19 + DO VerFact408 IN verifica WITH llInTabel, 20 + +* DO VerAvans409 in verifica WITH llInTabel + +&& Terti - Clienti + DO VerVanz IN verifica WITH llInTabel, 5 + + DO VerClienti IN verifica WITH llInTabel, 3 + DO VerVanzLun IN verifica WITH llInTabel, 4 + + DO VerClient4118 IN verifica WITH llInTabel, 7 + DO VerVanzLu4118 IN verifica WITH llInTabel, 8 + + DO Verana418 IN verifica WITH llInTabel, 25 + DO VerFact418 IN verifica WITH llInTabel, 26 + +* DO VerAvans419 in verifica WITH llInTabel + +&& Terti - Alti + DO VerDebitor IN verifica WITH llInTabel, 15 + DO VerDebLun IN verifica WITH llInTabel, 16 + + DO VerCreditor IN verifica WITH llInTabel, 17 + DO VerCredLun IN verifica WITH llInTabel, 18 + + DO VerDividende IN verifica WITH llInTabel, 34 + DO VerDivLun IN verifica WITH llInTabel, 35 + + DO VerActionar IN verifica WITH llInTabel, 36 + +&& Trezorerie - Casa + DO VerCasaNume IN verifica WITH llInTabel, 21 + DO VerCasa IN verifica WITH llInTabel, 21 + + DO VerCASVNUME IN verifica WITH llInTabel, 22 + DO VerCASAVal IN verifica WITH llInTabel, 22 + +&& Trezorerie - Banca + DO VerBanNume IN verifica WITH llInTabel, 23 + DO VerBanca IN verifica WITH llInTabel, 23 + + DO VerBanVNume IN verifica WITH llInTabel, 24 + DO VerBancaVal IN verifica WITH llInTabel, 24 + +&& Trezorerie - Alte + DO VerCecNume IN verifica WITH llInTabel, 31 + DO VerCec IN verifica WITH llInTabel, 31 + + DO VerAchit542 IN verifica WITH llInTabel, 28 + DO VerAchiLun IN verifica WITH llInTabel, 29 + + + +*!* if(llInTabel) +*!* raport_mesaje() +*!* ENDIF +ENDPROC +&& ------------------------------SFARSIT: VerificareLunaDeschisa ------------------------------ \ No newline at end of file diff --git a/Programe/oparteneri_contracte.prg b/Programe/oparteneri_contracte.prg new file mode 100644 index 0000000..cb392e9 --- /dev/null +++ b/Programe/oparteneri_contracte.prg @@ -0,0 +1,355 @@ + +*!* APEL DE PROCEDURA +*!* DO lans_ireg_parteneri WITH tlTest,tcCont,tlActiv + +*----------------------------------------------------------- +Procedure lans_ireg_parteneri +Parameters tlTest,tcCont,tlactiv,tlTitluTot,tcDenumire,tcDenDebit,tcDenCredit, tlContract +*!* tlTitluTot = daca denumirea titlului este totala i.e.: Nu trebuie sa mai adaug Balanta parteneri +*!* tcDenumire = titlul balantei +*!* tcDenDebit = peste tot pe unde apare debit se va inlocui cu aceasta denumire +*!* tcDenCredit = peste tot pe unde apare credit se va inlocui cu aceasta denumire +Local lcCont, llActiv, llParametri,llTitluTot,lcDenumire,lcDenDebit,lcDenCredit +llParametri = .F. + +If Empty(tlTitluTot) + llTitluTot = .F. +Else + llTitluTot = tlTitluTot +Endif + +If Empty(tcDenumire) + lcDenumire = "" +Else + lcDenumire= tcDenumire +Endif + +If Empty(tcDenDebit) + lcDenDebit = "Debit" +Else + lcDenDebit = tcDenDebit +Endif +If Empty(tcDenCredit) + lcDenCredit = "Credit" +Else + lcDenCredit = tcDenCredit +Endif + +If !Empty(tcCont) + lcCont = Alltrim(tcCont) +Else + lcCont = '' +Endif + +If !Empty(tlactiv) + llActiv = tlactiv +Else + llActiv = .F. +Endif + + +llParametri = .F. +If !Empty(tcCont) + llParametri = .T. +Endif +Local NOU, lnTdeb, lnTcred, lnSold, lcContPart, lclista +Store 0 To lnTdeb, lnTcred, lnSold +NOU=.T. + +If glPrimaLuna + NOU = .F. +Endif + +Private plActiv +Store .T. To plActiv +Private eActiv +Store .T. To eActiv + +If llParametri + eActiv = llActiv + plActiv = llActiv + lcContPart = lcCont + If !llTitluTot And Empty(lcDenumire) + lcDenumire = "Inregistrari " + "( " + lcContPart + " )" + Else + If !Empty(lcDenumire) And !llTitluTot + lcDenumire = "Inregistrari " + lcDenumire + "( " + lcContPart + " )" + Endif + Endif +Endif + +pcCont = lcContPart + +Private poireg_parteneri,pcschema1,pcselect1 +Store '' To poireg_parteneri + +*!* lcschema1 = [id_ireg_part n(20), an n(4), luna n(2), ID_FACT N(20), rate_acoperite C(200), id_part n(20), cont c(4), acont c(4), ID_VALUTA N(5), ID_VENCHELT N(5), PROC_TVA N(8,2), ] + ; +*!* [PRECDEB N(20,4), PRECCRED N(20,4), PRECVALDEB N(20,4), PRECVALCRED N(20,4), ] + ; +*!* [debit n(20,4), credit n(20,4), valdebit n(20,4), valcredit n(20,4), ] + ; +*!* [NRACT N(14), DATAACT D, DATAIREG D, DATASCAD D, CURS N(10,4), ] + ; +*!* [COD N(20), EXPLICATIA C(100), EXPLICATIA4 C(100), EXPLICATIA5 C(100), ] + ; +*!* [ID_RESPONSABIL N(5), ID_FDOC N(5), ID_LUCRARE N(10), ID_CTR N(5), ID_SET N(20), ID_ACT N(20), ] + ; +*!* [NUME C(100), COD_FISCAL C(30), FDOC C(50), NRESP C(50), NRORD C(50), CONTRACT C(30), NUME_VAL C(10), VENCHELT C(50) ] + +lcschema1 = [ an n(4), luna n(2), ID_FACT N(20), rate_acoperite C(200), id_part n(20), cont c(4), acont c(4), ID_VALUTA N(5), ]+; + [ ID_VENCHELT N(5), PROC_TVA N(8,2), ] + ; + [PRECDEB N(20,4), PRECCRED N(20,4), PRECVALDEB N(20,4), PRECVALCRED N(20,4), ] + ; + [debit n(20,4), credit n(20,4), valdebit n(20,4), valcredit n(20,4), ] + ; + [NRACT N(14), DATAACT D, DATAIREG D, DATASCAD D, CURS N(10,4), ] + ; + [COD N(20), EXPLICATIA C(100), EXPLICATIA4 C(100), EXPLICATIA5 C(100), ] + ; + [ID_RESPONSABIL N(5), ID_FDOC N(5), ID_LUCRARE N(10), ID_CTR N(5), ID_SET N(20), ID_ACT N(20), ] + ; + [NUME C(100), COD_FISCAL C(30), FDOC C(50), NRESP C(50), NRORD C(50), CONTRACT C(30), NUME_VAL C(10), ]+; + [ VENCHELT C(50) ] + +lcPA = Alltrim(Str(gnPA)) +*!* lcSelect1 = [ select i.an, i.luna, i.id_fact, ra.rate_acoperite, i.id_part, i.cont, i.acont, i.id_valuta, ]+; +*!* [ i.id_venchelt, i.proc_tva, ] + ; +*!* [ 000000000000000.0000 as PRECDEB, 000000000000000.0000 as PRECCRED, 000000000000000.0000 as PRECVALDEB, 000000000000000.0000 as PRECVALCRED, ]+; +*!* [ s2.debit, s2.credit, s2.valdebit, s2.valcredit, ]+; +*!* [ i.nract, i.dataact, i.dataireg, i.datascad, i.curs, ]+; +*!* [ i.cod, i.explicatia, i.explicatia4, i.explicatia5, ]+; +*!* [ i.id_responsabil, i.id_fdoc, i.id_lucrare, i.id_ctr, i.id_set, i.id_act, ]+; +*!* [ p.nume, p.cod_fiscal, f.FEL_DOCUMENT as fdoc, r.nume as nresp, l.nrord, ]+; +*!* [ (case when ctr.numar is not null then ctr.numar || '/' else '' end) || TO_CHAR(ctr.data, 'DD.MM.YYYY') as contract, ]+; +*!* [ v.nume_val, vc.explicatie as VENCHELT ]+; +*!* [ from (select an, luna, id_fact, id_part, cont, acont, id_valuta, ]+; +*!* [ id_venchelt, proc_tva, nract, dataact, dataireg, datascad, ]+; +*!* [ curs, cod, explicatia, explicatia4, explicatia5, id_responsabil, id_fdoc, id_lucrare, id_ctr, id_set, id_act ]+; +*!* [ from ireg_parteneri ]+; +*!* [ WHERE extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna and id_part = ]+ ALLTRIM(STR(goContract.id_part))+[ and cont = '4111') i ]+; +*!* [ left join (select id_fact, cont,]+; +*!* [ sum(pack_sesiune.suma_ron(debit,an,luna,]+ lcPA + [)) as debit, ]+; +*!* [ sum(pack_sesiune.suma_ron(credit,an,luna,]+ lcPA + [)) as credit, ]+; +*!* [ sum(pack_sesiune.suma_ron(valdebit,an,luna,]+ lcPA + [)) as valdebit, ]+; +*!* [ sum(pack_sesiune.suma_ron(valcredit,an,luna,]+ lcPA + [)) as valcredit ]+; +*!* [ from ireg_parteneri where id_part = ]+ ALLTRIM(STR(goContract.id_part)) + [ and cont = '4111' group by id_fact,cont) s2 ]+; +*!* [ on i.id_fact = s2.id_fact ]+; +*!* [ left join (select s.id_ctr, ]+; +*!* [ rf.id_fact, stringAgg(s.den_rata) as rate_acoperite from vctr_rate_facturi rf ]+; +*!* [ left join (select * from vctr_scadentar order by id_ctr, den_rata) s on s.id_rata = rf.ID_RATA ]+; +*!* [ group by s.id_ctr, rf.id_fact) ra ]+; +*!* [ on i.id_fact = ra.id_fact ]+; +*!* [ LEFT JOIN CONTRACTE CTR ON i.ID_CTR = CTR.ID_CTR ]+; +*!* [ LEFT JOIN nom_venit_cheltuieli VC ON i.ID_VENCHELT = VC.ID_VENCHELT ]+; +*!* [ LEFT JOIN NOM_VALUTE V ON i.ID_VALUTA = V.ID_VALUTA ]+; +*!* [ LEFT JOIN VNOM_LUCRARI L ON i.ID_LUCRARE = L.ID_LUCRARE ]+; +*!* [ LEFT JOIN NOM_PARTENERI R ON i.ID_RESPONSABIL = R.ID_part ]+; +*!* [ LEFT JOIN NOM_FDOC F ON i.ID_FDOC = F.ID_FDOC ]+; +*!* [ LEFT JOIN NOM_PARTENERI P ON i.ID_PART = P.ID_PART ] + +If tlContract + lcSelect1 = [ select i.* from (select ir.an, ir.luna, ir.id_fact, ra.rate_acoperite, ir.id_part, ir.cont, ir.acont, ir.id_valuta, ]+; + [ ir.id_venchelt, ir.proc_tva, ] + ; + [ 000000000000000.0000 as PRECDEB, 000000000000000.0000 as PRECCRED, 000000000000000.0000 as PRECVALDEB, 000000000000000.0000 as PRECVALCRED, ]+; + [ s2.debit, s2.credit, s2.valdebit, s2.valcredit, ]+; + [ ir.nract, ir.dataact, ir.dataireg, ir.datascad, ir.curs, ]+; + [ ir.cod, ir.explicatia, ir.explicatia4, ir.explicatia5, ]+; + [ ir.id_responsabil, ir.id_fdoc, ir.id_lucrare, ir.id_ctr, ir.id_set, ir.id_act, ]+; + [ p.nume, p.cod_fiscal, f.FEL_DOCUMENT as fdoc, r.nume as nresp, l.nrord, ]+; + [ (case when ctr.numar is not null then ctr.numar || '/' else '' end) || TO_CHAR(ctr.data, 'DD.MM.YYYY') as contract, ]+; + [ v.nume_val, vc.explicatie as VENCHELT ]+; + [ from (select an, luna, id_fact, id_part, cont, acont, id_valuta, ]+; + [ id_venchelt, proc_tva, nract, dataact, dataireg, datascad, ]+; + [ curs, cod, explicatia, explicatia4, explicatia5, id_responsabil, id_fdoc, id_lucrare, id_ctr, id_set, id_act ]+; + [ from ireg_parteneri ]+; + [ WHERE extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna and ]+; + [ id_part = ]+ Alltrim(Str(goContract.id_part))+; + [ and id_ctr = ] + Alltrim(Str(goContract.id_ctr)) +; + [ and cont = ] + tcCont + [) ir ]+; + [ left join (select id_fact, cont,]+; + [ sum(pack_sesiune.suma_ron(debit,an,luna,]+ lcPA + [)) as debit, ]+; + [ sum(pack_sesiune.suma_ron(credit,an,luna,]+ lcPA + [)) as credit, ]+; + [ sum(pack_sesiune.suma_ron(valdebit,an,luna,]+ lcPA + [)) as valdebit, ]+; + [ sum(pack_sesiune.suma_ron(valcredit,an,luna,]+ lcPA + [)) as valcredit ]+; + [ from ireg_parteneri ]+; + [ where id_part = ]+ Alltrim(Str(goContract.id_part)) + ; + [ and id_ctr = ] + Alltrim(Str(goContract.id_ctr)) +; + [ and cont = ] + tcCont + [ group by id_fact,cont) s2 ]+; + [ on ir.id_fact = s2.id_fact ]+; + [ left join (select s.id_ctr, ]+; + [ rf.id_fact, stringAgg(s.den_rata) as rate_acoperite from vctr_rate_facturi rf ]+; + [ left join (select * from vctr_scadentar order by id_ctr, den_rata) s on s.id_rata = rf.ID_RATA ]+; + [ group by s.id_ctr, rf.id_fact) ra ]+; + [ on ir.id_fact = ra.id_fact ]+; + [ LEFT JOIN CONTRACTE CTR ON ir.ID_CTR = CTR.ID_CTR ]+; + [ LEFT JOIN nom_venit_cheltuieli VC ON ir.ID_VENCHELT = VC.ID_VENCHELT ]+; + [ LEFT JOIN NOM_VALUTE V ON ir.ID_VALUTA = V.ID_VALUTA ]+; + [ LEFT JOIN VNOM_LUCRARI L ON ir.ID_LUCRARE = L.ID_LUCRARE ]+; + [ LEFT JOIN NOM_PARTENERI R ON ir.ID_RESPONSABIL = R.ID_part ]+; + [ LEFT JOIN NOM_FDOC F ON ir.ID_FDOC = F.ID_FDOC ]+; + [ LEFT JOIN NOM_PARTENERI P ON ir.ID_PART = P.ID_PART) i ] +Else + lcSelect1 = [ select i.* from (select ir.an, ir.luna, ir.id_fact, ra.rate_acoperite, ir.id_part, ir.cont, ir.acont, ir.id_valuta, ]+; + [ ir.id_venchelt, ir.proc_tva, ] + ; + [ 000000000000000.0000 as PRECDEB, 000000000000000.0000 as PRECCRED, 000000000000000.0000 as PRECVALDEB, 000000000000000.0000 as PRECVALCRED, ]+; + [ s2.debit, s2.credit, s2.valdebit, s2.valcredit, ]+; + [ ir.nract, ir.dataact, ir.dataireg, ir.datascad, ir.curs, ]+; + [ ir.cod, ir.explicatia, ir.explicatia4, ir.explicatia5, ]+; + [ ir.id_responsabil, ir.id_fdoc, ir.id_lucrare, ir.id_ctr, ir.id_set, ir.id_act, ]+; + [ p.nume, p.cod_fiscal, f.FEL_DOCUMENT as fdoc, r.nume as nresp, l.nrord, ]+; + [ (case when ctr.numar is not null then ctr.numar || '/' else '' end) || TO_CHAR(ctr.data, 'DD.MM.YYYY') as contract, ]+; + [ v.nume_val, vc.explicatie as VENCHELT ]+; + [ from (select an, luna, id_fact, id_part, cont, acont, id_valuta, ]+; + [ id_venchelt, proc_tva, nract, dataact, dataireg, datascad, ]+; + [ curs, cod, explicatia, explicatia4, explicatia5, id_responsabil, id_fdoc, id_lucrare, id_ctr, id_set, id_act ]+; + [ from ireg_parteneri ]+; + [ WHERE extract(year from dataireg) * 12 + extract(month from dataireg) = an * 12 + luna and id_part = ]+ Alltrim(Str(goContract.id_part))+[ and cont = ] + tcCont + [) ir ]+; + [ left join (select id_fact, cont,]+; + [ sum(pack_sesiune.suma_ron(debit,an,luna,]+ lcPA + [)) as debit, ]+; + [ sum(pack_sesiune.suma_ron(credit,an,luna,]+ lcPA + [)) as credit, ]+; + [ sum(pack_sesiune.suma_ron(valdebit,an,luna,]+ lcPA + [)) as valdebit, ]+; + [ sum(pack_sesiune.suma_ron(valcredit,an,luna,]+ lcPA + [)) as valcredit ]+; + [ from ireg_parteneri ]+; + [ where id_part = ]+ Alltrim(Str(goContract.id_part)) + ; + [ and cont = ] + tcCont + [ group by id_fact,cont) s2 ]+; + [ on ir.id_fact = s2.id_fact ]+; + [ left join (select s.id_ctr, ]+; + [ rf.id_fact, stringAgg(s.den_rata) as rate_acoperite from vctr_rate_facturi rf ]+; + [ left join (select * from vctr_scadentar order by id_ctr, den_rata) s on s.id_rata = rf.ID_RATA ]+; + [ group by s.id_ctr, rf.id_fact) ra ]+; + [ on ir.id_fact = ra.id_fact ]+; + [ LEFT JOIN CONTRACTE CTR ON ir.ID_CTR = CTR.ID_CTR ]+; + [ LEFT JOIN nom_venit_cheltuieli VC ON ir.ID_VENCHELT = VC.ID_VENCHELT ]+; + [ LEFT JOIN NOM_VALUTE V ON ir.ID_VALUTA = V.ID_VALUTA ]+; + [ LEFT JOIN VNOM_LUCRARI L ON ir.ID_LUCRARE = L.ID_LUCRARE ]+; + [ LEFT JOIN NOM_PARTENERI R ON ir.ID_RESPONSABIL = R.ID_part ]+; + [ LEFT JOIN NOM_FDOC F ON ir.ID_FDOC = F.ID_FDOC ]+; + [ LEFT JOIN NOM_PARTENERI P ON ir.ID_PART = P.ID_PART) i ] +Endif + +lcOrder1 = [i.dataact] +lcgroup = [] + +lcFiltru1 = [] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. + +gencursor('poireg_parteneri','actcv', lcSelect1, lcFiltru1, lcschema1, lcOrder1, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poireg_parteneri.ca_baza1.afisare() +******** + +tcFis2 = "ActCv" +tlVisible = .T. + +Local c +c="nume+ALLTRIM(STR(YEAR(dataact)))+RIGHT('0'+ALLTRIM(STR(MONTH(dataact))),2)+RIGHT('0'+ALLTRIM(STR(DAY(dataact))),2)" +buton=1 + +If tlTest And .F. + Private pcCampVerif + pcCampVerif = ofis.camp_verif + Select (tcFis2) + Set Filter To + lcProc='inainte_'+Alltrim(tcFis2) + Do &lcProc In inaintede.prg + If buton=2 + Return + Endif +Endif + +Sele actcv + + +Private pcAnalitic,pcLucrare +Store '' To pcAnalitic,pcLucrare + +Oreg=Createobject("FRM_IREG_PARTENERI") +With Oreg + .lActiv = plActiv + .cCont = lcContPart +*!* .LABEL10.Caption=Proper(tctitlu)&&& trebuie facut + .lb_titlu_alb_b121.Caption = Proper(lcDenumire) + .grid1.cTotCred.Visible = .T. + .Cont = Allt(pcCont) + .fisier = Alltrim(tcFis2) + .Ck_valuta.Visible = tlVisible + .CK_explicatia.Visible = tlVisible + .ck_scadente.Visible = tlVisible +* .CHECK9.VISIBLE = tlVisible + .grid1.cDataScad.Visible = tlVisible + .grid1.cTotDebVal.Visible = tlVisible + .grid1.cTotCredVal.Visible = tlVisible + .grid1.cSoldVal.Visible = tlVisible + .grid1.cNume_val.Visible = tlVisible + .grid1.cCurs.Visible = tlVisible + .grid1.cExplicatia.Visible = tlVisible + If !tlVisible + .CHECK3.Caption = 'Regularizate' + .CHECK4.Caption = 'Neregularizate' + .check10.Caption = 'Regularizat' + .grid1.cTotCred.header1.Caption = 'Regularizat' + .grid1.cDataScad.Width = 0 + Endif + If !plActiv + + .grid1.cSoldFinal.ControlSource = "(preccred+credit)-(precdeb+debit)" + .grid1.cSoldVal.ControlSource ="(precvalcred+valcredit)-(precvaldeb+valdebit)" + .ck_sold.camp_nume = "credit+preccred-precdeb-debit" + .grid1.cTotDeb.ControlSource = "preccred+credit" + .grid1.cTotCred.ControlSource = "precdeb+debit" + .grid1.cTotDebVal.ControlSource = "precvalcred+valcredit" + .grid1.cTotCredVal.ControlSource = "precvaldeb+valdebit" + .grid1.cDebit.ControlSource = "credit" + .grid1.cCredit.ControlSource = "debit" + .grid1.cValDebit.ControlSource = "valcredit" + .grid1.cValCredit.ControlSource = "valdebit" + .grid1.cPrecDeb.ControlSource = "preccred" + .grid1.cPrecCred.ControlSource = "precdeb" + + .grid1.cTotDeb.header1.Caption = "Total " + lcDenCredit + .grid1.cTotCred.header1.Caption = "Total " + lcDenDebit + .grid1.cTotDebVal.header1.Caption = "Total " + lcDenCredit + " valuta" + .grid1.cTotCredVal.header1.Caption = "Total " + lcDenDebit + " valuta" + .grid1.cDebit.header1.Caption = lcDenCredit + .grid1.cCredit.header1.Caption = lcDenDebit + .grid1.cValDebit.header1.Caption = lcDenCredit + " valuta" + .grid1.cValCredit.header1.Caption = lcDenDebit + " valuta" + .grid1.cPrecDeb.header1.Caption = "Prec " + lcDenCredit + .grid1.cPrecCred.header1.Caption = "Prec " + lcDenDebit + .grid1.cPrecValDeb.header1.Caption = "Prec Valuta " + lcDenCredit + .grid1.cPrecValCred.header1.Caption = "Prec Valuta " + lcDenDebit + Else + .grid1.cSoldFinal.ControlSource = "(precdeb+debit)-(preccred+credit)" + .grid1.cSoldVal.ControlSource ="(precvaldeb+valdebit)-(precvalcred+valcredit)" + .ck_sold.camp_nume = "precdeb+debit-credit-preccred" + .grid1.cTotDeb.header1.Caption = "Total " + lcDenDebit + .grid1.cTotCred.header1.Caption = "Total " + lcDenCredit + .grid1.cTotDebVal.header1.Caption = "Total " + lcDenDebit + " valuta" + .grid1.cTotCredVal.header1.Caption = "Total " + lcDenCredit + " valuta" + .grid1.cDebit.header1.Caption = lcDenDebit + .grid1.cCredit.header1.Caption = lcDenCredit + .grid1.cValDebit.header1.Caption = lcDenDebit + " valuta" + .grid1.cValCredit.header1.Caption = lcDenCredit + " valuta" + .grid1.cPrecDeb.header1.Caption = "Prec " + lcDenDebit + .grid1.cPrecCred.header1.Caption = "Prec " + lcDenCredit + .grid1.cPrecValDeb.header1.Caption = "Prec Valuta " + lcDenDebit + .grid1.cPrecValCred.header1.Caption = "Prec Valuta " + lcDenCredit + Endif + If Type('pcTotctva')#'U' And Type('pcAchitat')#'U' + .grid1.cTotCred.header1.Caption = pcAchitat + .grid1.cTotDeb.header1.Caption = pcTotctva + Endif + If Type('pcSumaTotal')#'U' And Type('pcSumaAchi')#'U' + .CHECK13.Caption = pcSumaTotal + .check10.Caption = pcSumaAchi + Endif + If Type('actcv.nresp') # 'U' + .grid1.cNresp.Visible= .T. + .grid1.cNresp.ControlSource = 'nresp' + .Ck_responsabil.Visible = .T. + Endif + If plActiv + .grid1.SetAll("DynamicForeColor", "IIF(ABS((preccred+credit)-(precdeb+debit))=0,RGB(0,0,0), iif(((precdeb+debit) < (preccred+credit)),RGB(255,0,0),RGB(0,0,255)))", "Column") + Else + .grid1.SetAll("DynamicForeColor", "IIF(ABS((preccred+credit)-(precdeb+debit))=0,RGB(0,0,0), iif(((precdeb+debit) > (preccred+credit)),RGB(255,0,0),RGB(0,0,255)))", "Column") + Endif +Endwith +Oreg.do_cauta() +Oreg.Show(1) + +Release Oreg +Use In actcv + +Endproc && lans_ireg_parteneri +*--------------------------------------------------------------------------------- diff --git a/Programe/oproceduri_roaregistratura.prg b/Programe/oproceduri_roaregistratura.prg new file mode 100644 index 0000000..a6462e9 --- /dev/null +++ b/Programe/oproceduri_roaregistratura.prg @@ -0,0 +1,139 @@ +Procedure viz_registratura + +Local lcSchema, lcSelect, lcOrder, lcFiltru, lcFiltruOriginal, llAfiseaza, lcgroup, lcFiltruOriginal +lcSchema = [id_reg n(8), id_part n(10), denumire c(70), id_pers n(10), pers_contact c(70), data d, numar c(20), numar_intern c(20), data_intern d, ]+; + [descriere c(100), ie N(1), observatii M, ]+; + [id_fdoc n(5), fel_document c(30), id_mediu n(5), mediu_transmisie c(30), avizat n(1), ]+; + [util c(30), dataora t , ]+; + [utils c(30), dataoras t , ]+; + [util_avizat c(30), dataora_avizat t, are_obs N(1), are_link n(1), ]+; + [id_responsabil n(10), nresp c(70), nr_pag N(4), sters n(1),id_proiect n(10),proiect v(200)] + +lcSelect = [select id_reg, id_part, denumire, id_pers, pers_contact, data, numar, numar_intern, data_intern, ]+; + [ descriere, ie, observatii, id_fdoc, fel_document, id_mediu, mediu_transmisie, avizat, ]+; + [ util, dataora, utils, dataoras, util_avizat, dataora_avizat, are_obs, are_link, id_responsabil, nresp, nr_pag, sters,id_proiect,proiect ]+; + [from vregistratura] + +lcOrder = [] +lcgroup = [] +lcFiltru = [sters=0] +lcFiltruOriginal = [] +llModParam = .T. +llAfiseaza = .F. + +gencursor('poReg','cRegistratura', lcSelect, lcFiltru, lcSchema, lcOrder, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +poReg.ca_baza1.afisare() + +Endproc && viz_registratura +*!* ***----------------------------------------------------------------------------------------------------------------------------- +Procedure make_cursoare_reg +Parameters tlToate +&& imi creeaza cursoarele pt. modificare date generale contract + +Local llToate && pt. toate contractele (folosesc la listare fisa contractului) +llToate = tlToate + +DO make_crsAtasamente IN oproceduri_atasamente.prg +Do make_cRegReferinte + +Endproc && make_cursoare_reg +*!* ***----------------------------------------------------------------------------------------------------------------------------- +*!* Procedure make_cRegLink +*!* Parameters tlToate + +*!* Private poLink +*!* Store '' To poLink + +*!* Local lcSchema, lcSelect, lcOrder, lcFiltru, lcFiltruOriginal, llAfiseaza, lcgroup, lcFiltruOriginal +*!* lcSchema = [id_link N(5), id_reg n(5), denumire_link c(50), link c(200), nume_fisier c(200), fisier w, dataora t, utilizator c(100) ] + +*!* lcSelect = [select l.id_link, l.id_reg, l.denumire as denumire_link, l.link, l.nume_fisier , '' as fisier, ]+; +*!* [ l.dataora, u.utilizator ]+; +*!* [ from reg_linkuri l ]+; +*!* [ left join syn_vutilizatori u on l.id_util = u.id_util ] + +*!* lcOrder = [l.nume_fisier, l.denumire] +*!* lcgroup = [] +*!* lcFiltru = [] +*!* lcFiltruOriginal = [l.sters=0 and l.nume_fisier is not null and l.id_reg =]+Alltrim(Str(goRegistratura.id_reg)) +*!* llModParam = .T. +*!* llAfiseaza = .F. + +*!* gencursor('poLink','cRegLink', lcSelect, lcFiltru, lcSchema, lcOrder, llAfiseaza, lcgroup, llModParam, lcFiltruOriginal) +*!* poLink.ca_baza1.afisare() + +*!* Endproc && cRegLink +***----------------------------------------------------------------------------------------------------------------------------- +Procedure make_cRegReferinte + +lcSel = [{call pack_registratura.caut_referinte(?goRegistratura.numar,?goRegistratura.Data,?goRegistratura.id_part)}] +lcCursor = 'cRegReferinte' +lnSucces = goExecutor.oExecute(lcSel,lcCursor) +If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return +Endif + +Endproc && make_cRegReferinte +***----------------------------------------------------------------------------------------------------------------------------- +Procedure adauga_registratura +Parameters tcAlias, tnNumarIntern + +Local lcAlias +lcAlias = tcAlias + +Private pnId_reg, pnNumarIntern +Store 0 To pnId_reg +pnNumarIntern = tnNumarIntern + +lcSql = [begin pack_registratura.adauga_registratura(?@pnId_reg, ?pnNumarIntern); end;] +lnSucces = goExecutor.oExecute(lcSql) + +If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") + Return +Endif + +Return pnId_reg +Endproc && adauga_registratura +***----------------------------------------------------------------------------------------------------------------------------- +Procedure modifica_reg_dg +Parameters toRegistratura + +Local loRegistratura +loRegistratura = toRegistratura + +Local lcId_reg, lcId_part, lcId_pers, lcData, lcNumar, lcData_intern, lcNumar_intern, lcDescriere, lcObservatii, lcIdUtil +Local lnSucces +lnSucces = -1 + +lcId_reg = Alltrim(Str(loRegistratura.id_reg)) +lcId_part = Alltrim(Str(loRegistratura.id_part)) +lcId_pers = Nvl(Alltrim(Str(loRegistratura.id_pers)),'NULL') +lcId_responsabil = Nvl(Alltrim(Str(loRegistratura.id_responsabil)),'NULL') +lcData = Dtos(loRegistratura.Data) +lcNumar = Nvl(Alltrim(loRegistratura.numar),"") +lcData_intern = Dtos(loRegistratura.Data_intern) +lcNumar_intern = Nvl(Alltrim(loRegistratura.numar_intern),"") +lcIE = Nvl(Alltrim(Str(loRegistratura.ie)),'0') +lcDescriere = Nvl(Alltrim(loRegistratura.descriere),"") +lcObservatii = Nvl(Alltrim(loRegistratura.observatii)," ") +lcId_fdoc = Nvl(Alltrim(Str(loRegistratura.id_fdoc)),'NULL') +lcId_mediu = Nvl(Alltrim(Str(loRegistratura.id_mediu)),'NULL') +lcNr_pag = Alltrim(Str(loRegistratura.nr_pag)) +lcIdUtil = Alltrim(Str(gnIdUtil)) + +lcSql = [begin pack_registratura.modifica_registratura(] + lcId_reg + [,] + lcId_part + [,] + lcId_pers + [,] + lcId_responsabil + ; + [, TO_DATE(]+Iif(!Empty(lcData) And !Isnull(lcData),[']+lcData+['],[NULL])+[,'YYYY-MM-DD'),']+lcNumar + ; + [', TO_DATE(]+Iif(!Empty(lcData_intern) And !Isnull(lcData_intern),[']+lcData_intern+['],[NULL])+[,'YYYY-MM-DD'),']+lcNumar_intern + [',]+; + lcIE + [,'] + lcDescriere + [','] + lcObservatii + [',] + lcId_fdoc + [,] + lcId_mediu + [,] + lcNr_pag + [,] + lcIdUtil + [); end;] + +lnSucces = goExecutor.oExecute(lcSql) + +If lnSucces < 0 + AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare") +Endif + +Endproc && modifica_reg_dg +***----------------------------------------------------------------------------------------------------------------------------- + diff --git a/Programe/ovariabile_globale.prg b/Programe/ovariabile_globale.prg new file mode 100644 index 0000000..c318582 --- /dev/null +++ b/Programe/ovariabile_globale.prg @@ -0,0 +1,12 @@ +PUBLIC gcCondLuna +*!* gcCondLuna = [((((extract(month from datafact) =]+Alltrim(Str(gnLuna))+; +*!* [ and extract(year from datafact) =]+Alltrim(Str(gnAn))+[) or (datafact is null )); +*!* and ]+; +*!* [ (extract (month from datai)<=]+Alltrim(Str(gnLuna)) + [ and extract(year from datai)<= ]+Alltrim(Str(gnAn))+[))]+; +*!* [ or ((extract (month from dataoravalid)>= ]+Alltrim(Str(gnLuna))+[ and extract(year from dataoravalid)>=]+Alltrim(Str(gnAn)) +[)]+; +*!* [ and id_tip > 1)]+ [)] + +*!* lcDataFact= [ (a.facturat=1 and (extract(month from a.datafact) =]+Alltrim(Str(gnLuna))+[ and extract(year from a.datafact) =]+Alltrim(Str(gnAn))+[))] +*!* lcDataValid = [ (a.validat=1 and (extract (month from a.dataoravalid)>= ]+Alltrim(Str(gnLuna))+[ and extract(year from a.dataoravalid)>=]+Alltrim(Str(gnAn)) +[)) ] +*!* gcCondLuna = [ ((extract (month from a.datai)=]+Alltrim(Str(gnLuna)) + [ and extract(year from a.datai)= ]+Alltrim(Str(gnAn))+[) or ]+; +*!* [ (a.id_tip=1 and (a.facturat=0 or ] + lcDataFact + [) ) or (a.id_tip>1 and (a.validat=0 or ] + lcDataValid + [))) ] \ No newline at end of file diff --git a/Programe/roaregistratura.prg b/Programe/roaregistratura.prg new file mode 100644 index 0000000..ea5f344 --- /dev/null +++ b/Programe/roaregistratura.prg @@ -0,0 +1,1161 @@ +Parameters tparam + +Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp +Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp +Store 0 To lnIdUtil, lnIdProgram +Public gcNumeProgram + +gcNumeProgram = "ROAREGISTRATURA" +_Screen.Icon=gcNumeProgram+'.ico' +IF !LIKE(gcNumeProgram + '*', UPPER(ALLTRIM(JUSTSTEM(SYS(16,0))))) + Messagebox("Nu puteti porni acest program!",0+16,"Atentie") + RETURN +ENDIF + +Set Century On +Set Deleted On +Set Date To Dmy +Set Exclusive Off +Set Cpdialog Off +Set Talk Off +Set Safety Off +Set Escape Off +Set Exact On +Set Mark To '/' +Set Ansi On +Set Console Off +Set Notify Off +Set Seconds Off +Set NullDisplay To '' +Set Decimals To 4 +_Screen.Visible=.F. +_Screen.AutoCenter=.T. +SET SQLBUFFERING ON + + + +*VARIABILE_______ +Local lcMainClassLib +Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown + + +*VARIABILE__________________________________________________________________________ +Declare nror[65000] +Declare RTVA[22,2] + + + +Public CRLF,CR,LF,Tab +Store Chr(13) + Chr(10) To CRLF +Public pcNl,pcAn +Store "" To pcNl,pcAn && se initializeaza in start00 +CR=Chr(13) +LF=Chr(10) +Tab=Chr(9) + +Public pcTitlu,pl_verificat +Store "" To pcTitlu +Store .F. To pl_verificat +Public BUTON, luna_inchisa, luna_neplatita, PRIMADATA, m.ctva, m.ctvam, m.ctvai, antet, m.nivel +Public OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc,DIRGEN +Public pcapsocsub,pcapsocvar +pcapsocsub=0 +pcapsocvar=0 +Public a4 +a4=.T. +m.nrgrup=999 + +Store .F. To luna_inchisa,tlbr_INSTRum,tlbr_VIZ +Store 1 To BUTON,col_menu +Store .T. To PRIMADATA,luna_neplatita + + +*** DECLARATII DE VARIABILE PUBLICE + +********************************************************************************************** +*-- Save and configure environment.*********************** +lcLastSetTalk=Set("TALK") +Set Talk Off +lcLastSetPath=Set("PATH") + +Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;html; + PUSH Menu _Msysmenu +lcLastSetClassLib=Set("CLASSLIB") +lcMainClassLib="clase\roaregistratura" + +*CLASE__________________________________________________________ +Set Classlib To (lcMainClassLib) Additive +Set Classlib To CAUT Additive +Set Classlib To ooptiuni Additive +*SET CLASSLIB TO ferestre_cere_date ADDITIVE +Set Classlib To registry Additive +Set Classlib To decabaza Additive +Set Classlib To cauta_alfa_forms Additive +Set Classlib To ferestre_oracle Additive +Set Classlib To caut_ora Additive +Set Classlib To ferestre_registratura Additive +Set Classlib To onomenclatoare Additive +*!* Set Classlib To ofundal_roaclienti Additive && modificare v 2.0.4 +*!* messagebox in romana - ar trebui bagat intr-o librarie de utilitati +*!* messagebox.vcx, functia amessagebox in oproceduri_comune, imagini mb_*.bmp, messagebox.h +Set Classlib To Messagebox Additive +Set Classlib To otoolbar Additive +Set Classlib To ferestre_cere_date Additive +Set Classlib To orapoarte_comun Additive +* SET CLASSLIB TO outlook2003bar ADDITIVE +Set Classlib To onom_articole Additive +SET CLASSLIB TO serii_numere.vcx ADDITIVE +SET CLASSLIB TO ferestre_atasamente.vcx ADDITIVE +SET CLASSLIB TO wwdialogs.vcx additive && modificare v 2.0.3 +SET CLASSLIB TO appwiz.vcx additive && modificare v 2.0.4 +SET CLASSLIB TO accessibility.vcx additive && modificare v 2.0.4 +Set Classlib To ofundal_registratura.vcx Additive && modificare v 2.0.4 +*PROCEDURI______________________________________________________ +Set Procedure To quitapp Additive +Set Procedure To init_program Additive +Set Procedure To oproceduri_comune Additive +Set Procedure To gencursor.prg Additive +Set Procedure To updateserver.prg Additive +Set Procedure To update_nomenclator.prg Additive +Set Procedure To onomenclatoare Additive +Set Procedure To oproceduri_ams Additive +Set Procedure To ocautare Additive +Set Procedure To oinit_optiuni Additive +Set Procedure To osecurity Additive +Set Procedure To proceduri Additive +Set Procedure To oproceduri_roaregistratura Additive +Set Procedure To acces_meniu Additive +Set Procedure To proceduri Additive +Set Procedure To oheader Additive +Set Procedure To oparteneri_contracte Additive +Set Procedure To oproceduri_maintenance.prg Additive && modifica_id_partener +Set Procedure To proceduri_excel Additive +Set Procedure To cauta_alfa Additive +SET PROCEDURE TO ini.prg ADDITIVE +Set Procedure To wwxmlhttp.prg Additive +SET PROCEDURE TO wwutils.prg ADDITIVE +SET PROCEDURE TO oserii_numere additive +SET PROCEDURE TO oproceduri_atasamente ADDITIVE +*!* modificare v 2.0.3 +SET PROCEDURE TO wwconfig.prg ADDITIVE +SET PROCEDURE TO oexport.prg ADDITIVE +SET PROCEDURE TO iniacces.prg ADDITIVE +SET PROCEDURE TO oupdate.prg additive +SET PROCEDURE TO procese.prg additive +SET PROCEDURE TO version.prg additive +SET PROCEDURE TO xmlaccess.prg additive +SET PROCEDURE TO xmlparser.prg additive +SET PROCEDURE TO filebringer.prg additive +SET PROCEDURE TO wwcodeupdate.prg additive +SET PROCEDURE TO wwhttp.prg ADDITIVE +Set Procedure To wwApi.prg Additive + +Declare Integer GetPrivateProfileString In Kernel32 ; + string, String, String, String @, Integer, String +Declare Integer WritePrivateProfileString In Kernel32 ; + string, String, String, String +Declare Integer CopyFile In kernel32; + STRING lpExistingFileName,; + STRING lpNewFileName,; + INTEGER bFailIfExists +Declare Integer URLDownloadToFile In urlmon.Dll; + INTEGER pCaller, String szURL, String szFileName,; + INTEGER dwReserved, Integer lpfnCB +Declare Integer PathFileExists In shlwapi; + STRING pszPath +*!* modificare v 2.0.3 ^ +*---------------------------------------------------------------------------- + +If Pcount() = 1 And Type('tparam') = 'C' + glParametri = .T. + Private laParametri + Declare laParametri[1] + lcParam = Alltrim(tparam) + lnNr = lista2array(lcParam,@laParametri,";") + If lnNr < 6 + Messagebox('Numar incorect de parametri',0+16,'Eroare') + Return + Endif + lchost = laParametri[1] + lcUserName = laParametri[2] + lcPassword = laParametri[3] + lnIdUtil = Round(Val(laParametri[4]),0) + lnIdProgram = Round(Val(laParametri[5]),0) + lnParametru_prog = Round(Val(laParametri[6]),0) +Else + glParametri = .F. + lchost = 'JCSSERVER' + lcUserName = 'CONTAFIN_ORACLE' + lcPassword = '' + lnIdUtil = 0 + lnIdProgram = 0 + lnParametru_prog = 0 + +Endif + +*!* IF PCOUNT() = 1 AND TYPE('tparam') = 'C' +*!* glParametri = .T. +*!* PRIVATE laParametri +*!* DECLARE LAPARAMETRI[1] +*!* lcParam = ALLTRIM(tParam) +*!* lnNr = lista2array(lcParam,@laParametri,";") +*!* IF lnNr < 5 +*!* MESSAGEBOX('Numar incorect de parametri',0+16,'Eroare') +*!* RETURN +*!* ENDIF +*!* lcHost = laParametri[1] +*!* lcUserName = laParametri[2] +*!* lcPassword = laParametri[3] +*!* lnIdUtil = ROUND(VAL(laParametri[4]),0) +*!* lnIdProgram = ROUND(VAL(laParametri[5]),0) +*!* ELSE +*!* glParametri = .F. +*!* lcHost = 'JCSSERVER' +*!* lcUserName = 'CONTAFIN_ORACLE' +*!* lcPassword = '' +*!* lnIdUtil = 8 +*!* lnIdProgram = 1 +*!* +*!* ENDIF + +*------------------------------------- +Public glVerificTabel && daca se verifica structura tabelelor in totv.prg +glVerificTabel=.T. + +Public glQuit +glQuit = .F. + +Public gnIdIstoric +gnIdIstoric = 0 + + +Public gcAppPath,gcAppName,gcAppDataPath, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp, gcDirMare +Store '' To gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces, gcDirMare +*!* Public gcSchemaPath +*!* Store '' To gcSchemaPath + +*!* gcAppPath=Addbs(Justpath(Sys(16,0))) && d:\contafin\devize\ +gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg +gcAppName=Allt(Uppe(Juststem(Sys(16,0)))) && "DEVIZE" +Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive && modificare v 2.0.3 + +*!* gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\" && D:\CONTAFIN\TRANS\DATE_TRANS && PT OPTIUNI , FISIERE SPECIFICE PROGRAMULUI SI +gcUtilizatoriPath = gcAppPath + "UTILIZATORI\" + +Store "" To gcTempPath, gcCaleServerDate + +*!* If !Directory(gcAppDataPath) +*!* Md (gcAppDataPath) +*!* Endif +*--------------------------------------- +*** DIRGEN +liat=Rat("\",gcAppPath,2) +*!* modificare v 2.0.3 +gcDirMare = Addbs(Left(gcAppPath,liat-1)) +*!* DIRGEN=Addbs(Left(gcAppPath,liat-1)) +dirgen = gcDirMare +*!* modificare v 2.0.3 ^ +Cd &DIRGEN + +*!* 21.06.2006 +*!* marius.mutu +Private gcGeneralIniFile,gcSettingsFile +gcGeneralIniFile = DIRGEN + "settings.ini" +gcSettingsFile = gcGeneralIniFile +If !File(gcGeneralIniFile) + + TEXT TO lcSettings NOSHOW +[errors] +host=http://romfast.dnsalias.com:3000/errors/create_xml + ENDTEXT + + Strtofile(lcSettings, gcGeneralIniFile) +Endif + +gcSecurityPath = DIRGEN + 'Security\' +gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT' + +*!* Locale +Set Classlib To locale Additive +Private gcLocalePath, goLocale, gcLocale +gcLocalePath = gcAppPath + "Locale\" +*!* lcLocaleDb = gcLocalePath + "locale.dbc" +*!* Open Database (m.lcLocaleDb) +*!* modificare +*!* goLocale=Newobject("Locale","Locale.vcx") +lcLanguage = getini(gcGeneralIniFile,"locale","lang") +llLocale= getini(gcGeneralIniFile,"locale","llocale") +*!* IF !EMPTY(m.llLocale) AND m.llLocale<>'0' +*!* goLocale.llocale=.T. +*!* ENDIF +*!* modificare ^ +If Empty(m.lcLanguage) + gcLocale = 'Romana' +Else + gcLocale = m.lcLanguage +Endif +*!* modificare +Local lcObjLocale +If gcLocale = 'Romana' + lcObjLocale = [Locale_dummy] +Else + lcObjLocale = [Locale] +Endif +goLocale=Newobject(lcObjLocale,"Locale.vcx") +If !Empty(m.llLocale) And m.llLocale<>'0' + goLocale.llocale=.T. +Endif +Release lcObjLocale +*!* modificare ^ +goLocale.locale = gcLocale +*!* Locale ^ + +Private poLog,goLog && obiect pt logarea mesajelor sistemului +poLog = Newobject("Log_Mesaje","Log_Mesaje.prg") +goLog = poLog + +*!* public poLog && obiect pt logarea mesajelor sistemului +*!* poLog = NEWOBJECT("Log_Mesaje","Log_Mesaje.prg") + +Public glQuit +glQuit = .F. + +*!* Public gnIdIstoric +*!* gnIdIstoric = 0 + +*!* If verificari() +*!* _Screen.Visible=.T. +*!* Do mesaj With "Se fac verificari programului","Va rugam reveniti" +*!* glQuit= .T. +*!* Quit +*!* Endif + +*!* If !Debug_Start() +*!* lcParam=tparam +*!* If Empty(tparam) Or (Type('tParam')='C' And !verific_start(tparam,DIRGEN,gcAppName)) +*!* _Screen.Visible=.T. +*!* Do mesaj With "Programul trebuie pornit doar din START","" +*!* Quit +*!* Endif +*!* Endif + +*** verificare serie permanenta +*!* modificare v 2.0.3 +*!* Public tipar,SER_PERM,SER_PERI,VERSIUNE +*!* Store .F. To SER_PERM,SER_PERI +*!* modificare v 2.0.3 ^ +***************************** VARIABILE ORACLE +Private goUtilizator +Private gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA,GNDIFZILE, gcUserNameApp, gcPasswordApp +Private gnButon && variabila pentru renunt si terminat +Store 2 To gnButon +Store '' To GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, gcAcces +gnHandle = -1 +gnidutil = 0 + +Private gcHost, gcUserName, gcPassword, gofundal, gnIdProgram, gnId_prg_owner +Store 0 To gnIdProgram, gnId_prg_owner +gofundal='' + +Private goFirma,gnId_Firma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC +Store Null To goFirma +Store 0 To gnId_Firma, gnIdFirma, gnAn, gnLuna +Store '' To gcFirma + +Private glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa + +Store .F. To glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa + +***toolbar*** +PRIVATE otool,ohelp +STORE '' TO otool,ohelp +***toolbar*** + +Private gcS && schema firmei +Store 'DEMO' To gcS + +If Type('laparametri',1)="A" + If Alen(laParametri,1)=10 + gnAn = Val(laParametri[7]) + gnLuna = Val(laParametri[8]) &&lansare noua + gcS = laParametri[9] + gnIdFirma = laParametri[10] && modificare v 2.0.3 + Endif +Endif + +Private gcCopyRight +gcCopyRight = '© ROA Romfast SRL' + +&& obiect global wrap pt sqlexec cu text eroare si succes +Private goExecutor, goConn +goExecutor = Createobject("oExecutor") +goConn = Createobject("oConn") + +*!* modificare v 2.0.3 +Private goExport +goExport = CREATEOBJECT("oExportConfig") +*!* modificare v 2.0.3 ^ +*!* 21.06.2006 +*!* marius.mutu +Private goMyXMLHTTP +lcHostErrors = getini(gcGeneralIniFile,'errors','host') +goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors) + +&& obiect global pt luna aleasa din calendar +Private goCalendar +Store Null To goCalendar + +gcHost = lchost +gcUserName = lcUserName +gcPassword = lcPassword +gcUserNameApp = lcUserNameApp +gcPasswordApp = lcPasswordApp +gnidutil = lnIdUtil +gnIdProgram = lnIdProgram + +If !glParametri + lnValid = getcrsSecurity(gcSecurityFile) + If lnValid > 0 + If Used('crsHost') + Select crsHost + Go Top + gcHost = Alltrim(Host) + gcUserName = Alltrim(schema) + gcPassword = Alltrim(pwd) + Use In crsHost + Endif + Endif +Endif + +*!* IF glParametri +*!* gcHost = lcHost +*!* gcUserName = lcUserName +*!* gcPassword = lcPassword +*!* gcUserNameApp = lcUserNameApp +*!* gcPasswordApp = lcPasswordApp +*!* gnIdUtil = lnIdUtil +*!* gnIdProgram = lnIdProgram +*!* ELSE +*!* gcHost = "jcsserver" +*!* gcUserName = "contafin_ORACLE" +*!* gcPassword = "123" +*!* gcUserNameApp = '' +*!* gcPasswordApp = '' +*!* gnIdUtil = 1 +*!* gnIdProgram = 8 +*!* ENDIF +***************************** VARIABILE ORACLE + + +*!* modificare v 2.0.3 +*!* Use &gcAppPath\SER In 0 Alias SER Shared +*!* Select SER +*!* Go Top +*!* tipar=TIP +*!* SER_PERM=SER_PERMAN +*!* SER_PERI=SER_PERIOD +*!* VERSIUNE=VERcont +*!* MODEL_PROGRAM=MODEL +*!* Use In SER +*!* parolamea=Substr(tipar,Month(Date()),1) +*!* parolamea=parolamea+Allt(Str(Day(Date())))+Allt(Str(Month(Date()))) + +*!* If !_DEBUG() +*!* If SER_PERM And !verif_ser_perm() +*!* Quit +*!* Endif +*!* Endif + +*!* Public cales,eserver,loc,numestatie +*!* eserver=.F. +*!* Store '' To cales,loc,numestatie +*!* modificare v 2.0.3 ^ + +*!* Public NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM +*!* NUMEPROGRAM = 'ROAREGISTRATURA' +*!* MENIUPROGRAM=gcAppPath+"meniuri\cont2000.mpr" +*!* FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx" +*!* _program='roaregistre' + +*** INITIALIZEZ CAI DATE +*!* If .F. +*!* If !Start_Nou() +*!* _Screen.WindowState=2 +*!* Cd \ +*!* If !Directory('c:\contafin') +*!* Md contafin +*!* Endif +*!* Cd c:\contafin\ +*!* If !Directory('temp') +*!* Md temp +*!* Endif + + +*!* Sele 0 +*!* Use c:\contafin\temp\ceprogram Alias ceprogram +*!* Scat Memv +*!* *wait wind m.util +*!* Sele ceprogram +*!* Use +*!* utilizator=m.UTIL +*!* GRUPUL=M.nrgrup +*!* If M.nrgrup=0 +*!* E_UN_SUPERVIZOR=.T. +*!* Else +*!* E_UN_SUPERVIZOR=.F. +*!* Endif + +*!* If File('&DIRGEN\START2000\DATA\RETEA.DBF') +*!* If !File('c:\contafin\temp\RETEA.dbf') +*!* Copy File &DIRGEN\START2000\Data\RETEA.* To c:\contafin\temp\RETEA.* +*!* Endif +*!* Sele 0 +*!* Use c:\contafin\temp\RETEA +*!* eserver=Server +*!* cales=Allt(CALESERVER) +*!* Use In RETEA +*!* Endif +*!* Else + +*!* gcTempPath = Init_Cale_Temp(DIRGEN) +*!* If !Directory(gcTempPath) +*!* Md (gcTempPath) +*!* Endif + +*!* cales = Init_Cale_Server_Date(DIRGEN) +*!* eserver = .T. +*!* numestatie = Init_Nume_Statie(DIRGEN) +*!* utilizator = Init_Nume_Utilizator(DIRGEN) +*!* m.nivel = Round(Val(Init_Nivel_Utilizator(DIRGEN)),0) +*!* m.CONTAB = Upper(Alltrim(Init_NumeAlternativ(DIRGEN))) + +*!* lcQuitData = Alltrim(DIRGEN)+"\dateretea" +*!* lcQuitName = "start_quitapp" +*!* Private goQuitApp && I'm making it private so it will die with the application. +*!* goQuitApp = quitapp(lcQuitData,lcQuitName) + +*!* gnIdIstoric = Start_Istoric(m.utilizator, gcAppName, numestatie, Addbs(DIRGEN)+"DATERETEA\", "START_ISTORIC","start_ids") + + +*!* Endif +*!* Endif + +lcOnShutdown="ShutDown()" +On Shutdown &lcOnShutdown +On Error ErrorHandler(Error(),Program(),Lineno()) +_Shell="DO Cleanup IN progs\ROACLIENTI" + +*-- Instantiate application object.*************************** +Release goApp +Public goApp +goApp=Createobject("wzApplication") + +*-- Configure application object.***************************** +*!* goApp.SetCaption("DEVIZE") +Local laVersion +Dimension laVersion(12) +If Agetfileversion(laVersion, Sys(16,0)) > 0 + goApp.SetCaption(laVersion(10)) +Else + goApp.SetCaption(gcNumeProgram) +Endif +Release laVersion + +goApp.cStartupMenu=m.gcAppPath + "\meniuri\RoaRegistratura" +*!* goApp.cStartupForm=DIRGEN+"\devize\FERESTRE\FUNDAL" +goApp.cStartupForm = gcAppPath + 'ferestre\frm_login.scx' + +_Screen.WindowState=2 +*-- Show application. + +Public poReg, goRegistratura +Store '' To poReg, goRegistratura + +Public podg_dg, podg_referinte, podg_obs, podg_link +* STORE '' TO podg_dg, podg_ob, podg_tf, podg_tl, podg_obs, podg_link, podg_fact + +*!* Private poCtrScadentar, poCtrFactGarant +*!* Store '' To poCtrScadentar, poCtrFactGarant +*!* && folosesc gencursorul pt ca am nevoie de schema pt. DATA_rata + +goApp.Show + + +*-- Release application. +Release goApp + + +*-- Restore default menu. +Pop Menu _Msysmenu + +*-- Restore environment. +On Error +On Shutdown +If Not lcLastSetClassLib==Set("classlib") + Release Classlib (lcMainClassLib) +Endif +If Empty(lcLastSetPath) + Set Path To +Else + Set Path To &lcLastSetPath +Endif +If lcLastSetTalk=="ON" + Set Talk On +Else + Set Talk Off +Endif + +Return + + + + +* FUNCTII______________________________________________________________________ +Function ErrorHandler(nError,cMethod,nLine) +Local lcErrorMsg,lcCodeLineMsg + +Wait Clear +lcErrorMsg=Message()+Chr(13)+Chr(13) +lcErrorMsg=lcErrorMsg+"Method: "+cMethod +lcCodeLineMsg=Message(1) +If Between(nLine,1,10000) And Not lcCodeLineMsg="..." + lcErrorMsg=lcErrorMsg+Chr(13)+"Line: "+Alltrim(Str(nLine)) + If Not Empty(lcCodeLineMsg) + lcErrorMsg=lcErrorMsg+Chr(13)+Chr(13)+lcCodeLineMsg + Endif +Endif + +If Type('goMyXMLHTTP') = 'O' + lcLunaHTTP = Iif(Type('gnLuna') = 'N', Transform(gnLuna) + "/","") + Iif(Type('GNAN') = 'N', Transform(gnAn),"") + lcErrorMsgHTTP = Sys(0) + ":" + Iif(Type('GCS')='C'," " + gcS,"") + ": " + lcLunaHTTP + Chr(13) +Chr(10) + lcErrorMsg + ; + CHR(13) +Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK() + lcUserName = gcUserNameApp + lcProgram = Juststem(Sys(16,0)) + goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram) +Endif + +If AMESSAGEBOX(lcErrorMsg,17,_Screen.Caption)#1 + On Error + On Shutdown + If _vfp.StartMode = 0 + Debug + Suspend + Else + Quit + Endif +*!* RETURN .F. +Endif + +Endfunc + + + +Function Shutdown + +*!* =End_Istoric(gnIdIstoric, Addbs(DIRGEN)+"DATERETEA\", "START_ISTORIC") +If Type("goApp")=="O" And Not Isnull(goApp) + Return goApp.OnShutDown() +Endif +Cleanup() +Quit +Endfunc + + +Function Cleanup + +If Cntbar("_msysmenu")=7 + Return +Endif +On Error +On Shutdown +Set Classlib To +Set Path To +Clear All +Close All +Pop Menu _Msysmenu +Return + + + +*----------------------------------------------------- + +Function verif_ser_perm +Clear + +Return PORNIRE() +******** +*?pornire() + +*!* Function PORNIRE +*!* Set Exact On +*!* Private calewin,calesys,checksum1,checksum2,serinreg,serdisk,file1,file2,valret,serdisktemp,ser1,ser2,key1,KEY2 +*!* Store '' To calewin,serinreg,serdisk,calesys,serdisktemp,catehd,ser1,ser2,key1,KEY2 +*!* Store 0 To checksum1,checksum2 +*!* Store .T. To valret +*!* Declare Integer SHGetFolderPath In SHFOLDER.Dll ; +*!* INTEGER hwndOwner, ; +*!* INTEGER nFolder, ; +*!* INTEGER hToken, ; +*!* INTEGER dwFlags, ; +*!* STRING @ pszPath +*!* Declare Integer GetActiveWindow In WIN32API +*!* #Define CSIDL_WINDOWS 36 +*!* #Define CSIDL_SYSTEM 37 +*!* #Define CSIDL_PROGRAMS 38 +*!* lcPath = Repl(Chr(0),261) +*!* =SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath) +*!* calewin=Left(lcPath,At(Chr(0),lcPath)-1) +*!* lcPath = Repl(Chr(0),261) +*!* =SHGetFolderPath(GetActiveWindow(),CSIDL_SYSTEM,0,0,@lcPath) +*!* calesys=Left(lcPath,At(Chr(0),lcPath)-1) +*!* &&se verifica existenta celor trei fisiere +*!* If (Not File(calesys+'\diskserial.dll')) Or (Not File(calesys+'\getmacip.dll')) Or (Not File(calewin+'\comdir.snr')) +*!* valret=.F. +*!* Endif +*!* If valret +*!* file1=Filetostr(calesys+'\diskserial.dll') +*!* checksum1=Sys(2007,file1) +*!* file2=Filetostr(calesys+'\getmacip.dll') +*!* checksum2=Sys(2007,file2) +*!* &&severifica daca dll-urile nu au fost modificate +*!* If (Val(checksum1) != 58755) Or (Val(checksum2) != 30476) +*!* valret=.F. +*!* Endif +*!* Endif +*!* &&se citesc seriile tutturor celor patru hard disk-uri posibile(pe IDE primary master,primary slave...) +*!* &&se tine minte primul cu seria nenula-daca nu s-a putut citi seria de la nici unul se pune o serie default +*!* &&seria default este "NUAREHAR" +*!* If valret +*!* Declare Integer GetSerialNumber In diskSerial.Dll Integer ,String +*!* catehd=0 +*!* For i=0 To 3 +*!* serdisktemp=Space(40) +*!* GetSerialNumber(i,@serdisktemp) +*!* If (Len(Alltrim(serdisktemp))!=0) And (catehd=0) +*!* serdisktemp=sircaracter(serdisktemp) +*!* serdisk=serdisktemp +*!* catehd=catehd+1 +*!* Endif +*!* Endfor +*!* If (Len(Alltrim(serdisk))=0) +*!* serdisk='NUAREHAR' +*!* Else +*!* If ((Len(Alltrim(serdisk))>0) And (Len(Alltrim(serdisk))<8)) +*!* serdisk=serdisk+Replicate('1',8-Len(Alltrim(serdisk))) +*!* Endif +*!* Endif +*!* serdisk=Substr(Alltrim(serdisk),Len(Alltrim(serdisk))-7,8) +*!* Endif +*!* &&se citeste din comdir.snr seria de inregistrare si se verifica egalitatea cu seria obtinuta anterior +*!* If valret +*!* gnFileHandle = Fopen(calewin+'\comdir.snr') +*!* nSize = Fseek(gnFileHandle, 0, 2) && Move pointer to EOF +*!* If nSize!=9 +*!* valret=.F. +*!* Else +*!* = Fseek(gnFileHandle, 0, 0) && Move pointer to BOF +*!* cString = Fread(gnFileHandle,9) +*!* ser1=Substr(cString,1,4) +*!* ser2=Substr(cString,5,4) +*!* key1=Substr(cString,9,1) +*!* KEY2=DECTOBIN(Alltrim(HEXDEC(key1))) +*!* serinreg=decodare1(Alltrim(Upper(ser1)),KEY2)+decodare1(Alltrim(Upper(ser2)),KEY2) +*!* If serdisk!=serinreg +*!* valret=.F. +*!* Endif +*!* Endif +*!* = Fclose(gnFileHandle) +*!* Endif +*!* seriedisk1=serdisk +*!* serieinreg1=serinreg +*!* On Error valret=.F. +*!* Return valret + +*!* FUNCTION PORNIRE +*!* SET EXACT ON +*!* PRIVATE calewin,calesys,checksum1,checksum2,serinreg,serdisk,file1,file2,valret,serdisktemp,ser1,ser2,key1,KEY2 +*!* STORE '' TO calewin,serinreg,serdisk,calesys,serdisktemp,catehd,ser1,ser2,key1,KEY2 +*!* STORE 0 TO checksum1,checksum2 +*!* STORE .T. TO valret +*!* DECLARE INTEGER SHGetFolderPath IN SHFOLDER.DLL ; +*!* INTEGER hwndOwner, ; +*!* INTEGER nFolder, ; +*!* INTEGER hToken, ; +*!* INTEGER dwFlags, ; +*!* STRING @ pszPath +*!* DECLARE INTEGER GetActiveWindow IN WIN32API +*!* #DEFINE CSIDL_WINDOWS 36 +*!* #DEFINE CSIDL_SYSTEM 37 +*!* #DEFINE CSIDL_PROGRAMS 38 +*!* lcPath = REPL(CHR(0),261) +*!* =SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath) +*!* calewin=LEFT(lcPath,AT(CHR(0),lcPath)-1) +*!* lcPath = REPL(CHR(0),261) +*!* =SHGetFolderPath(GetActiveWindow(),CSIDL_SYSTEM,0,0,@lcPath) +*!* calesys=LEFT(lcPath,AT(CHR(0),lcPath)-1) +*!* &&se verifica existenta celor trei fisiere +*!* lcTextEroare = "" +*!* IF (NOT FILE(calesys+'\diskserial.dll')) OR (NOT FILE(calesys+'\getmacip.dll')) OR (NOT FILE(calewin+'\comdir.snr')) +*!* valret=.F. +*!* lcTextEroare = lcTextEroare + calesys + '\diskserial.dll ' + TRANSFORM(FILE(calesys+'\diskserial.dll')) + ; +*!* ' ' + calesys+'\getmacip.dll' + TRANSFORM(FILE(calesys+'\getmacip.dll')) + ' ' + calewin+'\comdir.snr' + TRANSFORM(FILE(calewin+'\comdir.snr')) + CHR(13) + CHR(10) +*!* ENDIF +*!* IF valret +*!* file1=FILETOSTR(calesys+'\diskserial.dll') +*!* checksum1=SYS(2007,file1) +*!* file2=FILETOSTR(calesys+'\getmacip.dll') +*!* checksum2=SYS(2007,file2) +*!* &&severifica daca dll-urile nu au fost modificate +*!* IF (VAL(checksum1) != 58755) OR (VAL(checksum2) != 30476) +*!* valret=.F. +*!* lcTextEroare = lcTextEroare + 'checksum1 ' + checksum1 + ' checksum2 ' + checksum2 + CHR(13) + CHR(10) +*!* ENDIF +*!* ENDIF +*!* &&se citesc seriile tutturor celor patru hard disk-uri posibile(pe IDE primary master,primary slave...) +*!* &&se tine minte primul cu seria nenula-daca nu s-a putut citi seria de la nici unul se pune o serie default +*!* &&seria default este "NUAREHAR" +*!* IF valret +*!* DECLARE INTEGER GetSerialNumber IN diskSerial.DLL INTEGER ,STRING +*!* catehd=0 +*!* FOR i=0 TO 3 +*!* serdisktemp=SPACE(40) +*!* GetSerialNumber(i,@serdisktemp) +*!* IF (LEN(ALLTRIM(serdisktemp))!=0) AND (catehd=0) +*!* serdisktemp=sircaracter(serdisktemp) +*!* serdisk=serdisktemp +*!* catehd=catehd+1 +*!* ENDIF +*!* ENDFOR +*!* IF (LEN(ALLTRIM(serdisk))=0) +*!* serdisk='NUAREHAR' +*!* ELSE +*!* IF ((LEN(ALLTRIM(serdisk))>0) AND (LEN(ALLTRIM(serdisk))<8)) +*!* serdisk=serdisk+REPLICATE('1',8-LEN(ALLTRIM(serdisk))) +*!* ENDIF +*!* ENDIF +*!* serdisk=SUBSTR(ALLTRIM(serdisk),LEN(ALLTRIM(serdisk))-7,8) +*!* ENDIF +*!* &&se citeste din comdir.snr seria de inregistrare si se verifica egalitatea cu seria obtinuta anterior +*!* IF valret +*!* gnFileHandle = FOPEN(calewin+'\comdir.snr') +*!* nSize = FSEEK(gnFileHandle, 0, 2) && Move pointer to EOF +*!* IF nSize!=9 +*!* valret=.F. +*!* lcTextEroare = lcTextEroare + 'nSize ' + TRANSFORM(nSize) + CHR(13) + CHR(10) +*!* ELSE +*!* = FSEEK(gnFileHandle, 0, 0) && Move pointer to BOF +*!* cString = FREAD(gnFileHandle,9) +*!* ser1=SUBSTR(cString,1,4) +*!* ser2=SUBSTR(cString,5,4) +*!* key1=SUBSTR(cString,9,1) +*!* KEY2=DECTOBIN(ALLTRIM(HEXDEC(key1))) +*!* serinreg=decodare1(ALLTRIM(UPPER(ser1)),KEY2)+decodare1(ALLTRIM(UPPER(ser2)),KEY2) +*!* IF serdisk!=serinreg +*!* valret=.F. +*!* lcTextEroare = lcTextEroare + 'serdisk ' + serdisk + ' serinreg ' + serinreg + CHR(13) + CHR(10) +*!* ENDIF +*!* ENDIF +*!* = FCLOSE(gnFileHandle) +*!* ENDIF +*!* seriedisk1=serdisk +*!* serieinreg1=serinreg +*!* ON ERROR valret=.F. +*!* poLog.Log('Eroare verificare serie ' + CHR(13) + CHR(10) + lcTextEroare, PROGRAM()) +*!* IF TYPE('goMyXMLHTTP') = 'O' +*!* IF !EMPTY(lcTextEroare) +*!* goMyXMLHTTP.postError('Eroare verificare serie ' + CHR(13) + CHR(10) + lcTextEroare, gcUserNameApp, JUSTSTEM(SYS(16,0))) +*!* ENDIF +*!* ENDIF +*!* RETURN valret +************* + +************* +Function decodare1 +Parameters lstring,CHEIE +Local lens,poz1,poz2,POZ3,lret,LRET2,lcstring,val1,lret1 +lret='' +lret1='' +LRET2='' +lcstring=Alltrim(Upper(lstring)) +lens=Len(lcstring) +For i=1 To 4 + poz1=Substr(lcstring,i,1) + val1=Asc(poz1) + POZ3=Substr(CHEIE,i,1) + Do Case + Case val1>=48 And val1<=57 + If ((val1-47)+Int(Val(POZ3)))<=10 + poz2=Chr(val1+Int(Val(POZ3))) + Else + poz2=Chr(val1+Int(Val(POZ3))-10) + Endif + Case val1>=65 And val1<=90 + If ((val1-64)+2*Int(Val(POZ3)))<=26 + poz2=Chr(val1+2*Int(Val(POZ3))) + Else + poz2=Chr(val1+2*Int(Val(POZ3))-26) + Endif + Endcase + LRET2=LRET2+poz2 +Endfor +For i=1 To lens + poz1=Substr(LRET2,i,1) + val1=Asc(poz1) + Do Case + Case val1>=48 And val1<=57 + If ((val1-47)+i)<=10 + poz2=Chr(val1+i) + Else + poz2=Chr(val1+i-10) + Endif + Case val1>=65 And val1<=90 + If ((val1-64)+2*i)<=26 + poz2=Chr(val1+2*i) + Else + poz2=Chr(val1+2*i-26) + Endif + Endcase + lret=lret+poz2 +Endfor +lens=Len(lret) +For i=1 To lens + poz1=Substr(lret,i,1) + val1=Asc(poz1) + Do Case + Case val1>=48 And val1<=57 + poz2=Chr(val1+17)&& din 0-9 in A-J + Case val1>=65 And val1<=74 + poz2=Chr(val1-17)&& din A-J in 0-9 + Case val1>=75 And val1<=82 + poz2=Chr(val1+8)&&din K-R in S-Z + Case val1>=83 And val1<=90 + poz2=Chr(val1-8)&&din S-Z in K-R + Endcase + lret1=lret1+poz2 +Endfor +Return lret1 +*********** +&&transformarea in decimal a unui caracter hexa +Function HEXDEC +Lparameters LC +Local LV +Do Case +Case LC=='0' + LV='0' +Case LC=='1' + LV='1' +Case LC=='2' + LV='2' +Case LC=='3' + LV='3' +Case LC=='4' + LV='4' +Case LC=='5' + LV='5' +Case LC=='6' + LV='6' +Case LC=='7' + LV='7' +Case LC=='8' + LV='8' +Case LC=='9' + LV='9' +Case LC=='A' + LV='10' +Case LC=='B' + LV='11' +Case LC=='C' + LV='12' +Case LC=='D' + LV='13' +Case LC=='E' + LV='14' +Case LC=='F' + LV='15' +Endcase +Return LV +**************** +&&codarea binara din hexa pe patru biti +Function DECTOBIN +Parameters sc +Local lretf +Do Case +Case sc=='0' + lretf='0000' +Case sc=='1' + lretf='0001' +Case sc=='2' + lretf='0010' +Case sc=='3' + lretf='0011' +Case sc=='4' + lretf='0100' +Case sc=='5' + lretf='0101' +Case sc=='6' + lretf='0110' +Case sc=='7' + lretf='0111' +Case sc=='8' + lretf='1000' +Case sc=='9' + lretf='1001' +Case sc=='10' + lretf='1010' +Case sc=='11' + lretf='1011' +Case sc=='12' + lretf='1100' +Case sc=='13' + lretf='1101' +Case sc=='14' + lretf='1110' +Case sc=='15' + lretf='1111' +Endcase +Return lretf +*********** +Function ECARACTER +Parameters strg1 +Private pz,ch,lcstring,vret,lg1 +Store 0 To pz,lg1 +Store '' To ch,lcstring +Store .T. To vret +lcstring=Upper(strg1) +lg1=Len(lcstring) +For ind1=1 To lg1 + ch=Substr(lcstring,ind1,1) + If (Not Between(Asc(ch),48,57)) And (Not Between(Asc(ch),65,90)) + vret=.F. + Exit + Endif +Endfor +Return vret +************ +Function sircaracter +Parameters strg1 +Private pz,ch,lcstring,vret,lg1,lciesire +Store 0 To pz,lg1 +Store '' To ch,lcstring,lciesire +Store .T. To vret +strg1=Strtran(strg1,Alltrim(Chr(39)),'')&&caracterul ' +strg1=Strtran(strg1,Alltrim(Chr(39)),'')&&caracterul " +lcstring=Upper(Alltrim(strg1)) +lg1=Len(lcstring) +For ind1=1 To lg1 + ch=Substr(lcstring,ind1,1) + If Between(Asc(ch),48,57) Or Between(Asc(ch),65,90) + lciesire=lciesire+ch + Endif +Endfor +Return lciesire + + + +***------------------------------------- +Procedure _DEBUG + +Private lcret,lcfisier,lcPath,lccalewin +Declare Integer SHGetFolderPath In SHFOLDER.Dll ; + INTEGER hwndOwner, ; + INTEGER nFolder, ; + INTEGER hToken, ; + INTEGER dwFlags, ; + STRING @ pszPath +Declare Integer GetActiveWindow In WIN32API +#Define CSIDL_WINDOWS 36 + + +lcPath = Repl(Chr(0),261) +=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath) +lccalewin=Left(lcPath,At(Chr(0),lcPath)-1) + +lcret=.F. +lcfisier=Addbs(lccalewin)+[DEBUG.TXT] + +lcLog = '1 ' + lcfisier +poLog.Log(lcLog,Program()) + +If File(lcfisier) + LCVAL=Filetostr(lcfisier) + + LNVAL1=Mod(Val(Right(LCVAL,1)),2) && restul 1 sau 0; daca e impar e 1 + lnval2=Val(Left(LCVAL,Len(LCVAL)-1)) + + lcLog = Transform(LNVAL1) + ' ' + Transform(lnval2) + poLog.Log(lcLog,Program()) + + If LNVAL1=1 Or Year(Date())-Month(Date())=lnval2 + lcret=.T. + Endif +Endif + +lcLog = Transform(lcret) +poLog.Log(lcLog,Program()) + +Return lcret + +Endproc + + +Function Start_Nou +*!* llExista_Branch = Exista_Branch(,,dirgen) + +*!* lcLog = TRANSFORM(llExista_Branch) +*!* poLog.log(lcLog,PROGRAM()) +Return Exista_Branch(,,DIRGEN) +Return llExista_Branch + +Endfunc && start_nou + +Procedure Debug_Start + +lcFile = gcAppPath + "debug.txt" +If File(lcFile) + lcLog = 'debug_start' + poLog.Log(lcLog,Program()) +Else + lcLog = '!debug_start' + poLog.Log(lcLog,Program()) +Endif + +If File(lcFile) Or !Start_Nou() + Return .T. +Endif +Return .F. + +Endproc && Debug_Start +************************************************************************ +Procedure verificari +Parameters tcFisierVerif + +lcverificari = Addbs(gcAppPath)+gcAppName+".txt" + + +If File(lcverificari) + Return .T. +Endif +Return .F. + +Endproc && verificari*************** + +Procedure myinstance +Parameters myApp +=Ddesetoption("SAFETY",.F.) +ichannel = Ddeinitiate(myApp,"ZOOM") +If ichannel =>0 + =Ddeterminate(ichannel) + Quit +Endif +=Ddesetservice(myApp,"define") +=Ddesetservice(myApp,"execute") +=Ddesettopic(myApp,"","ddezoom") +Return +****************************************** +Procedure ddezoom +Parameter ichannel,saction,sitem,sdata,sformat,istatus +Zoom Window Screen Norm +Return +********************************************************** +** EOF +********************************************************** diff --git a/Programe/update_nomenclator.prg b/Programe/update_nomenclator.prg new file mode 100644 index 0000000..fbd3ec2 --- /dev/null +++ b/Programe/update_nomenclator.prg @@ -0,0 +1,61 @@ +********************************************************** +PROCEDURE update_nomenclator + + *!* DO update_coresp_tip_part + *!* DO update_coresp_tip_cont + DO update_lunilean + + *** tabele meniu deschise din proiect + LOCAL lcCaleDateMenu + + lcCaleDateMenu=gcAppPath+[DATEMENU\] + +*!* IF !USED('MILA1') +*!* USE &lcCaleDateMenu.MILA1 IN 0 ALIAS MILA1 +*!* ENDIF + +*!* modificare v 2.0.3 +*!* IF !USED('XREQUEST') +*!* USE &lcCaleDateMenu.XREQUEST IN 0 ALIAS XREQUEST +*!* ENDIF +*!* IF !USED('xitems') +*!* USE &lcCaleDateMenu.xitems IN 0 ALIAS xitems +*!* ENDIF +*!* IF !USED('YACT') +*!* USE &lcCaleDateMenu.YACT IN 0 ALIAS YACT +*!* ENDIF +*!* IF !USED('XSETS') +*!* USE &lcCaleDateMenu.XSETS IN 0 ALIAS XSETS ORDER TAG ID_SET +*!* ENDIF +*!* IF !USED('xACT') +*!* USE &lcCaleDateMenu.xACT IN 0 ALIAS xACT +*!* ENDIF +*!* IF !USED('xnote') +*!* USE &lcCaleDateMenu.xnote IN 0 ALIAS xnote +*!* ENDIF +*!* modificare v 2.0.3 ^ + +*!* IF !USED('menu1') +*!* USE &lcCaleDateMenu.menu1 IN 0 ALIAS menu1 EXCL +*!* ENDIF + +*!* modificare v 2.0.3 +*!* IF !USED('INFISIERE') +*!* USE &lcCaleDateMenu.INFISIERE IN 0 ALIAS INFISIERE +*!* ENDIF +*!* modificare v 2.0.3 ^ + +*!* IF !USED('nom_meniu') +*!* USE &lcCaleDateMenu.nom_meniu IN 0 ALIAS nom_meniu +*!* ENDIF + +*!* IF !USED('refaceri') +*!* USE &lcCaleDateMenu.refaceri IN 0 ALIAS refaceri +*!* ENDIF + +*!* IF !USED('tabela_fisa_cont') +*!* USE &lcCaleDateMenu.tabela_fisa_cont IN 0 ALIAS tabela_fisa_cont +*!* ENDIF + + +ENDPROC && update_nomenclator \ No newline at end of file diff --git a/Rapoarte/rregistratura.fr2 b/Rapoarte/rregistratura.fr2 new file mode 100644 index 0000000..cb3a842 --- /dev/null +++ b/Rapoarte/rregistratura.fr2 @@ -0,0 +1,686 @@ +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!! +*-------------------------------------------------------------------------------------------------------------------------------------------------------- +*< FOXBIN2PRG: Version="1.21" SourceFile="rregistratura.frx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries) +* + + + + +