Post on 04-Jul-2015
//
// ΣΡΗΣΖ 9 ΔΠΣΔΜΒΡΗΟΤ 1997 --- ΧΡΑ: 09.30
//
// ΑΡΥΖ ΣΟΤ ΠΡΟΓΡΑΜΜΑΣΟ " ΚΑΣΑΛΟΓΟ " --- ΔΚΓ. 1.00
//
ANNOUNCE CLIPPER501 // ΥΡΖΖ ΣΖ WINSHADE Δ ΒΗΒΛΗΟΘΖΚΖ
LOCAL MENU1 // ΜΔΣΑΒΛΖΣΔ ΒΑΗΚΖ ΟΘΟΝΖ ΠΡΟΓΡΑΜΜΑΣΟ (ΜΔΝΟΤ)
LOCAL TO,LE,BO,RI // ΜΔΣΑΒΛΖΣΔ ΑΡΥΗΚΖ ΟΘΟΝΖ (ΜΑΚΑ)
PUBLIC EPON,ONOM,PATR // ΜΔΣΑΒΛΖΣΔ ΑΝΑΕΖΣΖΖ ΔΓΓΡΑΦΖ
PUBLIC MASKA // ΟΘΟΝΖ ΔΗΟΓΟΤ-ΔΞΟΓΟΤ ΑΠΟ ΣΟ ΠΡΟΓΡΑΜΜΑ
MAIN()
PUBLIC NAME1 // ΟΝΟΜΑ ΓΗΑ ΣΟ ΑΝΟΗΓΜΑ ΟΠΟΗΟΤΓΖΠΟΣΔ ΑΡΥΔΗΟΤ
SIGN()
PUBLIC NAME // ΜΔΣΑΒΛΖΣΖ ΔΤΡΔΖ ΑΣΟΜΟΤ
PUBLIC VAR // ΜΔΣΑΒΛΖΣΖ ΓΗΑ ΣΖΜ ΜΔΣΡΖΖ ΣΧΝ ΔΓΓΡΑΦΧΝ ΤΠΟ
ΤΝΘΖΚΔ
PUBLIC XSCREEN // ΟΘΟΝΖ ΣΟΤ ΒΑΗΚΟΤ ΜΔΝΟΤ ΠΟΤ ΔΠΗΣΡΔΦΟΤΝ ΟΛΑ ΣΑ
// ΣΜΖΜΑΣΑ ΣΟΤ ΠΡΟΓΡΑΜΜΑΣΟ
PUBLIC FLAG11 // ΑΚΤΡΧΖ ΓΗΑΓΗΚΑΗΑ ΔΓΓΡΑΦΖ,ΓΗΟΡΘΧΖ,ΓΗΑΓΡΑΦΖ
PUBLIC FLAG13 // ΔΠΗΒΔΒΑΗΧΖ ΓΗΑΓΡΑΦΖ ΔΓΓΡΑΦΖ
DIAGRAFH()
PUBLIC FLAG14 // ΑΚΤΡΧΖ ΔΝΔΡΓΧΝ GET
AKYRO()
PUBLIC FLAG22 // ΔΤΡΔΖ ΖΜΔΡΑ ή ΖΜΔΡΟΜΖΝΗΑ ΔΝΖΜΔΡΧΖ ΑΡΥΔΗΟΤ
PUBLIC FLAG23 // ΓΗΟΡΘΧΖ ΣΟΗΥΔΗΧΝ
PUBLIC FLAG24 // ΔΗΑΓΧΓΖ ΣΟΗΥΔΗΧΝ
PUBLIC FLAG25 // ΔΛΔΓΥΟ ΑΝ ΖΓΖ ΔΥΔΗ ΓΧΘΔΗ ΣΟ ΣΖΛΔΦΧΝΟ ΣΖ ΓΗΟΡΘΧΖ
PUBLIC FLAG30:=.F. // ΜΔΣΑΒΛΖΣΖ ΔΚΣΤΠΧΔΧΝ
PUBLIC XNUMBER,XEPONYMO,XONOMA,XATTRIBUTE,XTHLEFONO1,XTHLEFONO2,XTHLEFONO3
PUBLIC XADDRESS1,XADDRESS2,XADDRESS3,XFAX,XNOTES
PUBLIC XNUMB,XSER // ΜΔΣΡΖΖ ΔΓΓΡΑΦΧΝ ΣΟΤ ΑΡΥΔΗΟΤ ΓΗΑ ΠΡΟΘΔΖ ΔΓΓΡΑΦΧΝ
PUBLIC THLE // ΜΔΣΑΒΛΖΣΖ ΑΝΑΕΖΣΖΖ ΣΟΤ ΣΖΛΔΦΧΝΟΤ ΣΟΤ ATOMOY
SET SCOREBOARD OFF // ΝΑ ΜΖΝ ΔΜΦΑΝΗΕΔΗ ΜΤΝΖΜΑΣΑ ΣΖ DBASE
SET DATE BRITISH // HMEΡOMHNIA ΜΔ EΛΛHNIΚΖ ΜΟΡΦΖ
SET MESSAGE TO 23 CENTRE // ΜΤΝΖΜΑΣΑ ΣΖΝ ΓΡΑΜΜΖ 23 ΣΖ ΟΘΟΝΖ
SET CURSOR OFF // ΝΑ ΜΖΝ ΔΜΦΑΝΗΣΔΗ Ο ΓΡΟΜΔΑ
SET CONFIRM ON // XΡΔΗΑΕΔΣΑΗ (ENTER) ΓΗΑ ΝΑ ΔΚΓAΣΑΛΔΗΦΔΗ ΔΝΑ
GET
SET ESCAPE OFF // ΝΑ ΜΖΝ ΔΓΚΑΣΑΛΔΗΠΔΗ GET MEΑ Δ WINSHADE
SET EXACT ON // ΓΗΑ ΝΑ ΛΔΗΣΟΤΡΓΔΗ Ζ ΓΗΑΓΗΚΑΗΑ ΔΤΡΔΖ
ΑΡΥΔΗΟΤ
SET WRAP ON // ΔΠΑΝΑΛΖΦΖ ΣΖ ΦΧΣΔΗΝΖ ΔΠΗΛΟΓΖ ΣΑ ΜΔΝΟΤ
CLS // ΚΑΘΑΡΗΜΟ ΣΖ ΟΘΟΝΖ ΣΖΝ ΔΝΑΡΞΖ
SET COLOR TO "W+/B" // ΥΡΧΜΑΣΑ ΑΠΡΟ-ΜΠΛΔ
SET KEY -1 TO LISTA // ΟΡΗΜΟ ΚΛΔΗΓΗΧΝ ΒΟΖΘΔΗΑ - Fxx
SET KEY -2 TO SYSTEM // ΠΖΡΟΦΟΡΗΔ ΓΗΑ ΣΟ ΤΣΖΜA ΣΟΤ Ζ/Τ
SET KEY -3 TO AKYRO // AKYΡΧΖ GET Δ ΟΠΟΗΑΓΖΠΟΣΔ ΚΑΡΣΑ
SET KEY -4 TO SCRSAVE // ΠΡΟΓΡΑΜΜΑ ΠΡΟΣΑΗΑ ΟΘΟΝΖ
SET KEY -9 TO ANDREAS // ΦΑΖ
TO:=12
LE:=39
BO:=13
RI:=40
//DO WHILE RI <= 80
// @ TO,LE,BO,RI BOX REPLICATE(CHR(177),9)
// TO--
// BO++
// LE=LE-1
// RI=RI+1
// INKEY(0.01)
//ENDDO
@ 0,0,24,79 BOX REPLICATE(CHR(177),9)
SET COLOR TO "GR+/B"
WINSHADE(1,1,4,34,'ON')
SET COLOR TO "W+/B"
@ 02,02 SAY PADC(" Γνπξδήο Η. ηάζεο - Φπζηθόο ",32)
@ 03,02 SAY PADC(" Πξνγξακκαηηζηήο Ζι.Τπνινγηζηώλ ",32)
SET COLOR TO "GR+/B"
WINSHADE(1,39,5,76,'ON')
SET COLOR TO "W+/B"
@ 02,40 SAY PADC(" Γηεύζπλζε: Καξηώηεο - Λεπθάδνο ",36)
@ 03,40 SAY PADC(" Σει: 0645 - 71500 Σ.Κ. 31100 ",36)
@ 04,40 SAY PADC(" Α.Φ.Μ. 73233654 Γ.Ο.Τ. Λεπθάδνο ",36)
MASKA:=SAVESCREEN(0,0,24,79)
SET COLOR TO "GR+/B"
WINSHADE(10,11,13,68,'ON')
SET COLOR TO "BG+/B"
@ 11,12 SAY PADC(" ΚΑΣΑΛΟΓΟ ΔΠΑΓΓΔΛΜΑΣΗΧΝ - Δθδνζε 1.00 (1997) ",56)
@ 12,12 SAY PADC(" Αξρείν δηαρείξηζεο ζηνηρείσλ επαγγεικαηηώλ ",56)
SET COLOR TO "W+/B"
HMEROMHNIA()
INKEY(0)
SET COLOR TO "W+/B"
WINSHADE(18,18,20,61,'OFF')
WINSHADE(10,11,13,68,'OFF')
WINSHADE(1,39,5,76,'OFF')
WINSHADE(1,1,4,34,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(1,1,7,76,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
@ 3,07 PROMPT " Αξρείν " MESSAGE " Γεληθό αξρείν επαγγεικαηηώλ "
@ 3,18 PROMPT " Ζκεξνιόγην " MESSAGE " Ζκεξνιόγην όισλ ησλ εηώλ "
@ 3,32 PROMPT " Γεληθά " MESSAGE " Πιεξνθνξίεο γηα όια ηα αξρεία "
@ 3,44 PROMPT " Σόξνο " MESSAGE " Σν πξόγξακκα γξαθηθώλ ηεο QBASIC
"
@ 3,54 PROMPT " εκεηώζεηο " MESSAGE " Γεληθέο εκεηώζεηο "
@ 5,05 PROMPT " Τπνινγηζηήο " MESSAGE " Τπνινγηζηήο κε ηηο βαζηθέο
πξάμεηο "
@ 5,20 PROMPT " Γίζθνο " MESSAGE " Αληίγξαθα Αξρείσλ - Γεκηνπξγία
Δπξεηεξίσλ "
@ 5,30 PROMPT " Δθηππώζεηο " MESSAGE " Δθηύπσζε όισλ ησλ πεδίσλ
ζεκεηώζεσλ "
@ 5,43 PROMPT " Οδεγίεο " MESSAGE " Δκθάληζε βαζηθώλ νδεγηώλ γηα ην
πξόγξακκα "
@ 5,56 PROMPT " Πεξί... " MESSAGE " ρεηηθά κε ηνλ ππεύζπλν
πξνγξακκαηηζκνύ "
XSCREEN:=SAVESCREEN(0,0,24,79)
MENU TO MENU1
DO CASE
CASE MENU1=0
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
SET COLOR TO "GR+/B"
WINSHADE(14,14,16,63,'ON')
SET COLOR TO "W+/B"
@ 15,15 SAY PadC(" Παηήζηε (ΔSC) γηα ηεξκαηηζκό ηνπ πξνγξάκκαηνο.
",48) COLOR "BG+/B"
INKEY(0)
WINSHADE(14,14,16,63,'OFF')
IF LASTKEY()=27
EXIT
ENDIF
CASE MENU1=1
RESTSCREEN(0,0,24,79,XSCREEN)
KATALOGOS()
CASE MENU1=2
CALENDAR()
CASE MENU1=3
INFO()
CASE MENU1=4
TORUS()
CASE MENU1=5
STATHIS()
CASE MENU1=6
CALC()
CASE MENU1=7
ARXEIA()
CASE MENU1=8
EKTYP()
CASE MENU1=9
HELP()
CASE MENU1=10
PERSONAL()
ENDCASE
RESTSCREEN(0,0,24,79,XSCREEN)
ENDDO
WINSHADE(1,1,7,76,'OFF')
RESTSCREEN(0,0,24,79,MASKA)
SET COLOR TO "GR+/B"
WINSHADE(9,11,12,68,'ON')
SET COLOR TO "BG+/B"
@ 10,12 SAY PADC(" ΚΑΣΑΛΟΓΟ ΔΠΑΓΓΔΛΜΑΣΗΧΝ - Δθδνζε 1.00 (1997) ",56)
@ 11,12 SAY PADC(" Αξρείν δηαρείξηζεο ζηνηρείσλ επαγγεικαηηώλ ",56)
SET COLOR TO "W+/B"
HMEROMHN1()
SET COLOR TO "GR+/B"
WINSHADE(20,26,22,53,'ON')
@ 21,27 SAY PadC(" Σέινο εξγαζηώλ ",26) COLOR "*W+/B"
INKEY(0)
WINSHADE(20,26,22,53,'OFF')
WINSHADE(15,18,17,61,'OFF')
WINSHADE(9,11,12,68,'OFF')
TO:=12
LE:=39
BO:=13
RI:=40
//DO WHILE RI <= 80
// @ TO,LE,BO,RI BOX REPLICATE(CHR(32),9) COLOR "N/N"
// TO--
// BO++
// LE=LE-1
// RI=RI+1
// INKEY(0.01)
//ENDDO
SET COLOR TO
CLS
USE
QUIT
//--------------------------------------------------------------------------
--
EXIT PROCEDURE COPIES
RUN COPY *.DB? C:\ARXEIA
RUN COPY *.N?? C:\ARXEIA
?
?
? " Σα αξρεία απνζεθεύηεθαλ ζε αληίγξαθα ζην C:\ARXEIA.Παηήζηε θάπνην
πιήθηξν... "
INKEY(0)
CLS
RUN DIR C:\ARXEIA /OD
?
?
? " Αξρεία πνπ βξίζθνληαη ζην C:\ARXEIA,θαηά εκεξνκελία.Πιήθηξν γηα έμνδν...
"
INKEY(0)
CLS
RETURN
//
// ΣΡΗΣΖ 9 ΔΠΣΔΜΒΡΗΟΤ 1997
// ΑΡΥΔΗΟ ΜΔ ΣΗ ΒΑΗΚΔ ΛΔΗΣΟΤΡΓΗΔ ΣΟΤ ΓΔΝΗΚΟΤ ΑΡΥΔΗΟΤ ΚΑΣΑΛΟΓΟΤ
//
#INCLUDE "INKEY.CH"
#INCLUDE "MEMOGET.CH"
#INCLUDE "MGDEF1.CH"
#INCLUDE "GETEXIT.CH"
//---------------------------------------------------------------------------
PROCEDURE KATALOGOS
LOCAL PINAKAS,EPILOG,SCREEN1
PINAKAS:={" Δηζαγσγή " ," Γηόξζσζε "," Γηαγξαθή "," ύλνιν ","
Αλαδήηεζε "," πλσλπκίεο "," Δπξεηήξην "}
USE
USE KATALOGO
SET COLOR TO "GR+/B"
WINSHADE(4,4,12,17,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
SET KEY 4 TO RIGHT1_ARROW
SET KEY 19 TO LEFT1_ARROW
EPILOG := ACHOICE(5,5,11,16,PINAKAS)
SCREEN1:=SAVESCREEN(0,0,24,79)
SET KEY 19 TO
SET KEY 4 TO
DO CASE
CASE EPILOG=0
EXIT
CASE EPILOG=1
EISAGOGH()
CASE EPILOG=2
DIORTHOSH()
CASE EPILOG=3
DIAGRAFH()
CASE EPILOG=4
RESTSCREEN(0,0,24,79,XSCREEN)
SYNOLO()
RESTSCREEN(0,0,24,79,SCREEN1)
CASE EPILOG=5
RESTSCREEN(0,0,24,79,XSCREEN)
ANAZHTHSH()
RESTSCREEN(0,0,24,79,SCREEN1)
CASE EPILOG=6
DIADIKASIA()
CASE EPILOG=7
INTEX()
ENDCASE
ENDDO
WINSHADE(4,4,12,17,'OFF')
USE
RETURN
//---------------------------------------------------------------------------
PROCEDURE EISAGOGH
FLAG14:=.F. // ΔΛΔΓΥΟ ΑΝ ΠΑΣΖΘΖΚΔ ΣΟ F8 - Ζ ΑΚΤΡΧΖ ΔΗΑΓΧΓΖ ΣΟΗΥΔΗΧΝ
FLAG11:=.F. // ΑΝ Ζ ΜΔΣΑΒΛΖΣΖ ΓΗΝΔΗ .Σ. ΣΟΣΔ ΔΥΟΤΜΔ ΑΚΤΡΧΖ ΓΗΑΓΗΚΑΗΑ
FLAG24:=.T. // ΓΗΑΓΗΚΑΗΑ ΔΗΑΓΧΓΖ ΓΗΑ ΣΖΝ GETAST()-REPLAST()
@ 23,0,23,79 BOX REPLICATE(CHR(177),9) // ΒΖΝΔΗ ΣΟ ΜΤΝΖΜΑ ΣΖ MESSAGE
DO WHILE .T.
EPON:=SPACE(20)
ONOM:=SPACE(12)
PATR:=SPACE(12)
SET COLOR TO "GR+/B"
WINSHADE(17,27,21,68,'ON')
SET COLOR TO "W+/B"
SET CURSOR ON
@ 18,28 SAY " Δπώλπκν Αηόκνπ:" GET EPON VALID KENA1()
@ 19,28 SAY " Oλνκα Αηόκνπ:" GET ONOM VALID KENA2()
@ 20,28 SAY " Παηξώλπκν Αηόκνπ:" GET PATR VALID KENA3()
READ
SET CURSOR OFF
WINSHADE(17,27,21,68,'OFF')
CLOSE INDEX // ΚΛΔΗΔ ΟΛΑ ΣΑ ΔΤΡΔΣΖΡΗΑ
SET FILTER TO // ΚΑΗ ΑΚΤΡΧΔ ΣΑ ΦΗΛΣΡΑ
COUNT TO XSER // ΓΗΑ ΝΑ ΜΔΣΡΖΘΟΤΝ ΟΛΔ ΟΗ ΔΓΓΡΑΦΔ
XNUMB:=XSER+1 // ΚΑΗ ΝΑ ΤΠΟΛΟΓΗΣΔΗ Ο ΑΡΗΘΜΟ ΚΑΗΝΟΤΡΓΗΑ ΔΓΓΡΑΦΖ
SET FILTER TO EPONYMO=EPON
INDEX ON EPONYMO+ONOMA+PATRONYMO TO GENIKO
INDEX ON ONOMA TO ONOMA FOR ONOMA=ONOM .AND. PATRONYMO=PATR
COUNT TO VAR
GO TOP // ΓΗΑ ΝΑ ΓΔΗΞΔΗ ΣΑ ΣΟΗΥΔΗΑ ΣΟΤ ΠΔΛΑΣΖ ΠΟΤ ΒΡΖΚΔ ΜΗΑ ΦΟΡΑ
IF VAR=0
SET COLOR TO "GR+/B"
WINSHADE(17,22,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,23 SAY PADC(" Γελ ππάξρεη ην Αηόκν κε απηά ηα ζηνηρεία. ",49) COLOR
"BG+/B"
@ 19,23 SAY PADC(" Θα πξνζζέζεηε λέα εγγξαθή ή λα επηζηξέςσ; ",49)
@ 20,23 SAY PADC(" (ΔΝΣΔR) ---> Eγγξαθή (ESC) ---> Δπηζηξνθή ",49)
INKEY(0)
WINSHADE(17,22,21,72,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ENDIF
ENDIF
IF VAR=1
SET COLOR TO "GR+/B"
WINSHADE(17,24,22,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Τπάξρεη ην Αηνκν κε απηά ηα ζηνηρεία. ",45) COLOR
"BG+/B"
@ 19,27 SAY ALLTRIM(EPONYMO)+" "+ALLTRIM(ONOMA)+" "+ALLTRIM(THLEFONO1)
COLOR "G+/B"
@ 20,26 SAY " Γηεύζπλζε: "
@ 20,38 SAY ALLTRIM(ADDRESS1) COLOR "G+/B"
@ 21,25 SAY PADC(" (ΔΝΣΔR) ---> Eγγξαθή (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,22,70,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ENDIF
ENDIF
IF VAR>1
DOUBLE()
SET COLOR TO "GR+/B"
WINSHADE(17,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Θα πξνζζέζεηε λέα εγγξαθή ή λα επηζηξέςσ; ",45) COLOR
"BG+/B"
@ 19,25 SAY PADC(" (ΔΝΣΔR) ---> Eγγξαθή (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,20,70,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ENDIF
ENDIF
SET COLOR TO "GR+/B"
WINSHADE(13,1,23,76,'ON')
SET COLOR TO "W+/B"
PRO() // ΜΖΓΔΝΗΜΟ ΜΔΣΑΒΛΖΣΧΝ
OTHONH() // ΥΔΓΗΑΜΟ ΟΘΟΝΖ ΜΔ ΑΝΔΝΔΡΓΑ GET
GETAST() // ΤΣΖΜA ΔΗΑΓΧΓΖ ΓΔΓΟΜΔΝΧΝ GET - SET
IF !FLAG14
APPEND BLANK
REPLAST() // ANTIKATAΣΑΖ ΣΧΝ ΓΔΓΟΜΔΝΧΝ ΣΖΝ ΔΓΓΡΑΦΖ.
ELSE
FLAG11:=.T.
WINSHADE(13,1,23,76,'OFF')
EXIT
ENDIF
GETASTA()
WINSHADE(13,1,23,76,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" H εγγξαθή πξνζηέζεθε ζην αξρείν. ",45) COLOR "BG+/B"
@ 19,25 SAY PADC(" Θα πξνζζέζεηε λέα εγγξαθή ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Eγγξαθή (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=13
LOOP
ELSE
EXIT
ENDIF
ENDDO
IF FLAG11
SET COLOR TO "G+/B"
WINSHADE(18,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" H εηζαγσγή ζηνηρείσλ αθπξώζεθε. ",45) COLOR "G+/B"
INKEY(0)
WINSHADE(18,24,20,70,'OFF')
ELSE
SET COLOR TO "G+/B"
WINSHADE(18,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" H εηζαγσγή ζηνηρείσλ νινθιεξώζεθε. ",45) COLOR "G+/B"
INKEY(0)
WINSHADE(18,24,20,70,'OFF')
ENDIF
FLAG24:=.F.
FLAG14:=.F.
FLAG11:=.F.
SET FILTER TO
CLOSE INDEX
RETURN
//---------------------------------------------------------------------------
PROCEDURE DIORTHOSH
FLAG14:=.F. // ΔΛΔΓΥΟ ΑΝ ΠΑΣΖΘΖΚE Ζ ΑΚΤΡΧΖ ΔΗΑΓΧΓΖ ΣΟΗΥΔΗΧΝ
FLAG11:=.F. // ΔΛΔΓΥΟ ΑΝ ΑΚΤΡΧΘΖΚΔ Ζ ΓΗΑΓΗΚΑΗΑ ΑΠΟ ΣΟΝ ΥΡΖΣΖ
FLAG23:=.T. // ΓΗΑΓΗΚΑΗΑ ΓΗΟΡΘΧΖ ΣΟΗΥΔΗΧΝ ΓΗΑ ΣΗ REPLAST()-GETAST()
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
DO WHILE .T.
EPON:=SPACE(20)
ONOM:=SPACE(12)
PATR:=SPACE(12)
SET COLOR TO "GR+/B"
WINSHADE(17,27,21,68,'ON')
SET COLOR TO "W+/B"
SET CURSOR ON
@ 18,28 SAY " Δπώλπκν Αηόκνπ:" GET EPON VALID KENA1()
@ 19,28 SAY " Oλνκα Αηόκνπ:" GET ONOM VALID KENA2()
@ 20,28 SAY " Παηξώλπκν Αηόκνπ:" GET PATR VALID KENA3()
READ
SET CURSOR OFF
WINSHADE(17,27,21,68,'OFF')
CLOSE INDEX
SET FILTER TO
SET FILTER TO EPONYMO=EPON
INDEX ON EPONYMO+ONOMA+PATRONYMO TO GENIKO
SEEK EPON
IF !FOUND()
SET COLOR TO "GR+/B"
WINSHADE(17,22,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,23 SAY PADC(" Γελ ππάξρεη Aηνκν κε απηά ηα ζηνηρεία. ",49) COLOR
"BG+/B"
@ 19,23 SAY PADC(" Θα επαλαιάβεηε ηε δηόξζσζε ή λα επηζηξέςσ; ",49)
@ 20,23 SAY PADC(" (ΔΝΣΔR) ---> Γηόξζσζε (ESC) ---> Δπηζηξνθή ",49)
INKEY(0)
WINSHADE(17,22,21,72,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ELSE
LOOP
ENDIF
ENDIF
INDEX ON ONOMA TO ONOMA FOR ONOMA=ONOM .AND. PATRONYMO=PATR
COUNT TO VAR
GO TOP // ΓΗΑ ΝΑ ΓΔΗΞΔΗ ΣΑ ΣΟΗΥΔΗΑ ΣΟΤ ΠΔΛΑΣΖ ΠΟΤ ΒΡΖΚΔ ΜΗΑ ΦΟΡΑ
IF VAR=0
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Γώζαηε ιάζνο Ολνκα ή Παηξώλπκν. ",45) COLOR "BG+/B"
@ 19,25 SAY PADC(" Δπαλαιεςε ηεο δηαδηθαζίαο ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Eπαλάιεςε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ELSE
LOOP
ENDIF
ENDIF
IF VAR>1
DOUBLE()
SET COLOR TO "GR+/B"
WINSHADE(17,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Θα θάλεηε θάπνηα δηόξζσζε ή λα επηζηξέςσ; ",45) COLOR
"BG+/B"
@ 19,25 SAY PADC(" (ΔΝΣΔR) ---> Γηόξζσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,20,70,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ENDIF
SYNVNYMA()
IF !FOUND()
SET COLOR TO "GR+/B"
WINSHADE(17,22,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,23 SAY " Γελ ππάξρεη Aηνκν κε ην ηειέθσλν απηό. " COLOR "BG+/B"
@ 19,23 SAY " Θα επαλαιάβεηε ηελ αλαδήηεζε ή λα επηζηξέςσ; "
@ 20,23 SAY " (ΔΝΣΔR) ---> Δπαλάιεςε (ESC) ---> Δπηζηξνθή "
INKEY(0)
WINSHADE(17,22,21,72,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ELSE
FLAG25:=.F.
LOOP
ENDIF
ENDIF
ENDIF
SET COLOR TO "GR+/B"
WINSHADE(13,1,23,76,'ON')
SET COLOR TO "W+/B"
OTHONH() // ΥΔΓΗΑΜΟ ΟΘΟΝΖ ΜΔ ΑΝΔΝΔΡΓΑ GET
VARAST() // ΑΝΑΚΣΖΖ ΣΧΝ ΓΔΓΟΜΔΝΧΝ ΠΟΤ ΤΠΑΡΥΟΤΝ ΣΖΝ ΔΓΓΡΑΦΖ
SAYAST() // EMΦΑΝΗΖ ΣΧΝ ΓΔΓΟΜΔΝΧΝ ΑΤΣΧΝ
GETAST() // ΤΣΖΜA ΔΗΑΓΧΓΖ ΚΑΗΝΟΤΡΓΗΧΝ ΓΔΓΟΜΔΝΧΝ GET - SET
IF !FLAG14
REPLAST() // ANTIKATAΣΑΖ ΣΧΝ ΓΔΓΟΜΔΝΧΝ ΣΖΝ ΔΓΓΡΑΦΖ
ELSE
FLAG11:=.T.
WINSHADE(13,1,23,76,'OFF')
EXIT
ENDIF
GETASTA()
WINSHADE(13,1,23,76,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" H εγγξαθή δηνξζώζεθε ζην αξρείν. ",45) COLOR "BG+/B"
@ 19,25 SAY PADC(" Θα δηνξζώζεηε άιιε εγγξαθή ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Γηόξζσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=13
FLAG25:=.F.
LOOP
ELSE
EXIT
ENDIF
ENDDO
IF FLAG11
SET COLOR TO "G+/B"
WINSHADE(18,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" H δηόξζσζε ζηνηρείσλ αθπξώζεθε. ",45) COLOR "G+/B"
INKEY(0)
WINSHADE(18,24,20,70,'OFF')
ELSE
SET COLOR TO "G+/B"
WINSHADE(18,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" H δηόξζσζε ζηνηρείσλ νινθιεξώζεθε. ",45) COLOR "G+/B"
INKEY(0)
WINSHADE(18,24,20,70,'OFF')
ENDIF
FLAG23:=.F.
FLAG25:=.F.
FLAG14:=.F.
FLAG11:=.F.
SET FILTER TO
CLOSE INDEX
RETURN
//---------------------------------------------------------------------------
PROCEDURE DIAGRAFH
LOCAL EPILOG
FLAG11:=.F. // ΔΛΔΓΥΟ ΑΝ ΑΚΤΡΧΘΖΚΔ Ζ ΓΗΑΓΗΚΑΗΑ ΑΠΟ ΣΟΝ ΥΡΖΣΖ
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
DO WHILE .T.
FLAG13:=.F. // ΔΛΔΓΥΟ ΑΝ ΔΓΗΝΔ ΓΗΑΓΡΑΦΖ ΔΓΓΡΑΦΖ
EPON:=SPACE(20)
ONOM:=SPACE(12)
PATR:=SPACE(12)
SET COLOR TO "GR+/B"
WINSHADE(17,27,21,68,'ON')
SET COLOR TO "W+/B"
SET CURSOR ON
@ 18,28 SAY " Δπώλπκν Αηόκνπ:" GET EPON VALID KENA1()
@ 19,28 SAY " Oλνκα Αηόκνπ:" GET ONOM VALID KENA2()
@ 20,28 SAY " Παηξώλπκν Αηόκνπ:" GET PATR VALID KENA3()
READ
SET CURSOR OFF
WINSHADE(17,27,21,68,'OFF')
CLOSE INDEX
SET FILTER TO
SET FILTER TO EPONYMO=EPON
INDEX ON EPONYMO+ONOMA+PATRONYMO TO GENIKO
SEEK EPON
IF !FOUND()
SET COLOR TO "GR+/B"
WINSHADE(17,22,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,23 SAY PADC(" Γελ ππάξρεη Aηνκν κε απηά ηα ζηνηρεία. ",49) COLOR
"BG+/B"
@ 19,23 SAY PADC(" Θα επαλαιάβεηε ηε δηαγξαθή ή λα επηζηξέςσ; ",49)
@ 20,23 SAY PADC(" (ΔΝΣΔR) ---> Γηαγξαθή (ESC) ---> Δπηζηξνθή ",49)
INKEY(0)
WINSHADE(17,22,21,72,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ELSE
LOOP
ENDIF
ENDIF
INDEX ON ONOMA TO ONOMA FOR ONOMA=ONOM .AND. PATRONYMO=PATR
COUNT TO VAR
GO TOP // ΓΗΑ ΝΑ ΓΔΗΞΔΗ ΣΑ ΣΟΗΥΔΗΑ ΣΟΤ ΠΔΛΑΣΖ ΠΟΤ ΒΡΖΚΔ ΜΗΑ ΦΟΡΑ
IF VAR=0
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Γώζαηε ιάζνο Ολνκα ή Παηξώλπκν. ",45) COLOR "BG+/B"
@ 19,25 SAY PADC(" Δπαλαιεςε ηεο δηαδηθαζίαο ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Eπαλάιεςε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ELSE
LOOP
ENDIF
ENDIF
IF VAR>1
DOUBLE()
SET COLOR TO "GR+/B"
WINSHADE(17,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Θα θάλεηε θάπνηα δηαγξαθή ή λα επηζηξέςσ; ",45) COLOR
"BG+/B"
@ 19,25 SAY PADC(" (ΔΝΣΔR) ---> Γηαγξαθή (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,20,70,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ENDIF
SYNVNYMA()
IF !FOUND()
SET COLOR TO "GR+/B"
WINSHADE(17,22,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,23 SAY " Γελ ππάξρεη Aηνκν κε ην ηειέθσλν απηό. " COLOR "BG+/B"
@ 19,23 SAY " Θα επαλαιάβεηε ηελ αλαδήηεζε ή λα επηζηξέςσ; "
@ 20,23 SAY " (ΔΝΣΔR) ---> Δπαλάιεςε (ESC) ---> Δπηζηξνθή "
INKEY(0)
WINSHADE(17,22,21,72,'OFF')
IF LASTKEY()=27
FLAG11:=.T.
EXIT
ELSE
FLAG25:=.F.
LOOP
ENDIF
ENDIF
ENDIF
SET COLOR TO "GR+/B"
WINSHADE(13,1,23,76,'ON')
SET COLOR TO "W+/B"
OTHONH() // ΥΔΓΗΑΜΟ ΟΘΟΝΖ ΜΔ ΑΝΔΝΔΡΓΑ GET
VARAST() // ΑΝΑΚΣΖΖ ΣΧΝ ΓΔΓΟΜΔΝΧΝ ΠΟΤ ΤΠΑΡΥΟΤΝ ΣΖΝ ΔΓΓΡΑΦΖ
SAYAST() // EMΦΑΝΗΖ ΣΧΝ ΓΔΓΟΜΔΝΧΝ ΑΤΣΧΝ
EPILOG:=ALERT(" Nα δηαγξαθεί ? ",{" Ναί "," Ορη "})
IF EPILOG=1
DELETE
PACK
FLAG13:=.T.
ELSE
WINSHADE(13,1,23,76,'OFF')
FLAG11:=.T.
EXIT
ENDIF
WINSHADE(13,1,23,76,'OFF')
IF FLAG13
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" H εγγξαθή δηαγξάθηεθε από ην αξρείν. ",45) COLOR
"BG+/B"
@ 19,25 SAY PADC(" Θα δηαγξάςεηε άιιε εγγξαθή ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Γηαγξαθή (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=13
FLAG25:=.F.
LOOP
ELSE
FLAG13:=.F.
EXIT
ENDIF
ENDIF
ENDDO
IF FLAG11
SET COLOR TO "G+/B"
WINSHADE(18,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" H δηαγξαθή ζηνηρείσλ αθπξώζεθε. ",45) COLOR "G+/B"
INKEY(0)
WINSHADE(18,24,20,70,'OFF')
ELSE
SET COLOR TO "G+/B"
WINSHADE(18,24,20,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" H δηαγξαθή ζηνηρείσλ νινθιεξώζεθε. ",45) COLOR "G+/B"
INKEY(0)
WINSHADE(18,24,20,70,'OFF')
ENDIF
FLAG13:=.F. // ΔΛΔΓΥΟ ΔΝ ΔΥΔΗ ΓΗΝΔΗ ΚΑΠΟΗΑ ΓΗΑΓΡΑΦΖ
FLAG11:=.F.
SET FILTER TO
CLOSE INDEX
RETURN
//---------------------------------------------------------------------------
PROCEDURE SYNOLO
LOCAL NT:=8,NL:=1,NB:=23,NR:=76
LOCAL OTBR,DIAL,DIALREC,DIALDEL
LOCAL nKey,lScrlBar,nThumbPos:=NT+3,nRecsSkipped:=1,nRow,nCol
LOCAL COLOR1,COLOR2,COLOR3,lNewRecord:=.F.
CLOSE INDEX
SET FILTER TO
INDEX ON NUMBER TO NUMBER
COLOR1:='N/N'
COLOR2:='GR+/N'
COLOR3:='W+/B'
SET COLOR TO "GR+/B"
WINSHADE(NT,NL,NB,NR,'ON')
@ 8,6 SAY "╡ πλνιηθή εκθάληζε ησλ Αηόκσλ ηνπ αξρείνπ ╞" COLOR "BG+/B"
SET COLOR TO "W+/B"
lScrlBar := If(LastRec()>((nB-nT)-2),.T.,.F.)
OTBR:=TBROWSEDB(NT+1,NL+1,NB-1,NR-1)
oTbr:ColSep := " " + CHR(179) + " "
oTbr:HeadSep := CHR(205)+CHR(209)+CHR(205)
oTbr:ColorSpec:="W+/B,GR+/W,GR+/B"
ADDALL(oTbr)
oTbr:freeze:=3
IF lScrlBar
nThumbPos:=nT+3
SETCOLOR(COLOR1)
@ nT+3,nR,nB-1,nR BOX Chr(177)
SETCOLOR(COLOR2)
@ nThumbPos,nR SAY Chr(178)
SETCOLOR(COLOR3)
ENDIF
SET CURSOR ON
DO WHILE .T.
DO WHILE .T.
DO WHILE !oTbr:stabilize()
nKey:=INKEY()
IF nKey == 0
EXIT
ENDIF
ENDDO
IF lScrlBar
IF nThumbPos <> Int((nRecsSkipped/LastRec())*((nB-1)-(nT+3))+(nT+3))
nRow:=Row()
nCol:=Col()
SETCOLOR(COLOR1)
@ nThumbPos,nR SAY Chr(177)
nThumbPos:=Int((nRecsSkipped/LastRec())*((nB-1)-(nT+3))+(nT+3))
IF nThumbPos < nT+3
nThumbPos:=nT+3
nRecsSkipped:=1
ELSEIF nThumbPos > nB-1
nThumbPos:=nB-1
nRecsSkipped:=LastRec()
ENDIF
SETCOLOR(COLOR2)
@ nThumbPos,nR SAY Chr(178)
DevPos(nRow,nCol)
SETCOLOR(COLOR3)
ENDIF
ENDIF
IF oTbr:stable
IF oTbr:HitTop .AND. !lNewRecord .AND. nKey==K_UP
lNewRecord:=.T.
nKey:=K_UP
ELSE
IF oTbr:Hittop
SET CURSOR OFF
@ 24,2 SAY " Βξηζθόζαζηε ζηελ θνξπθή ηνπ αξρείνπ " COLOR "GR+/B"
INKEY(1)
SET CURSOR ON
SKIA()
ELSEIF oTbr:Hitbottom
SET CURSOR OFF
@ 24,2 SAY " Βξηζθόζαζηε ζην ηέινο ηνπ αξρείνπ " COLOR "GR+/B"
INKEY(1)
SET CURSOR ON
SKIA()
ENDIF
nKey:=INKEY(0)
ENDIF
ENDIF
IF nKey == K_UP .AND. lNewRecord
DIALREC:=ALERT(" Πξνζζήθε εγγξαθήο ",{" Oρη "," Nαί "})
IF DIALREC=2
APPEND BLANK
oTbr:GoTop()
nRecsSkipped:=1
lNewRecord:=.F.
oTbr:RefreshAll()
ENDIF
ELSEIF nKey==K_SPACE
DIALDEL:=ALERT(" Γηαγξαθή εγγξαθήο ",{" Oρη "," Nαί "})
IF DIALDEL=2
DELETE
PACK
oTbr:Up()
nRecsSkipped:=nRecsSkipped-1
oTbr:RefreshAll()
ENDIF
ELSEIF nKey==K_DOWN
oTbr:Down()
lNewRecord:=.F.
nRecsSkipped++
ELSEIF nKey == K_UP
oTbr:up()
lNewRecord:=.F.
nRecsSkipped:=nRecsSkipped-1
ELSEIF nKey == K_PGDN
oTbr:pageDown()
lNewRecord:=.F.
nRecsSkipped+=oTbr:RowCount
oTbr:RefreshAll()
ELSEIF nKey == K_PGUP
oTbr:pageUp()
lNewRecord:=.F.
nRecsSkipped-=oTbr:RowCount
oTbr:RefreshAll()
ELSEIF nKey == K_CTRL_PGUP
oTbr:goTop()
nRecsSkipped:=1
lNewRecord:=.F.
ELSEIF nKey == K_CTRL_PGDN
oTbr:goBottom()
nRecsSkipped:=LastRec()
lNewRecord:=.F.
ELSEIF nKey == K_RIGHT
oTbr:right()
ELSEIF nKey == K_LEFT
oTbr:left()
ELSEIF nKey == K_HOME
oTbr:home()
ELSEIF nKey == K_END
oTbr:end()
ELSEIF nKey == K_CTRL_LEFT
oTbr:panLeft()
ELSEIF nKey == K_CTRL_RIGHT
oTbr:panRight()
ELSEIF nKey == K_CTRL_HOME
oTbr:panHome()
ELSEIF nKey == K_CTRL_END
oTbr:panEnd()
ELSEIF nKey == K_INS
FldEdit(oTbr)
ELSEIF nKey == K_ESC
EXIT
ELSEIF nKey==K_RETURN
GETIT(oTbr)
ELSEIF nKey > 223 .AND. nKey < 241
KEYBOARD Chr(nKey)
GETIT(oTbr)
ELSEIF nKey > 31 .AND. nKey < 176
KEYBOARD Chr(nKey)
GETIT(oTbr)
ENDIF
ENDDO
DIAL:=ALERT(" Δπηζηξνθή ζην κελνύ ",{" Ναί "," Ορη "})
IF DIAL==1
EXIT
ELSE
LOOP
ENDIF
ENDDO
CLOSE INDEX
SET FILTER TO
SET CURSOR OFF
WINSHADE(NT,NL,NB,NR,'OFF')
RETURN
//--------------------------------------------------------------------------
PROCEDURE FldEdit(oTbr)
LOCAL bFldGsb, cFval, cOldkey,cNewKey
LOCAL nOldRecNo, cNewKeyVal, cOldKeyVal
LOCAL lMemoUpdated := .F.,SCREEN1
SCREEN1:=SAVESCREEN(0,0,24,79)
cOldKeyVal := &(IndexKey())
bFldGsb := oTbr:getColumn(oTbr:colPos):block
cFval := Eval(bFldGsb)
IF ValType(cFval) == "C" .AND. cFval == "Memo"
RESTSCREEN(0,0,24,79,XSCREEN)
SET COLOR TO "GR+/B"
WINSHADE(10,1,23,17,'ON')
SET COLOR TO "W+/B"
@ 10,05 SAY "╡ Aηνκν ╞" COLOR "G+/B"
@ 11,02 SAY "Αξ.Μεη.: "
@ 11,COL() SAY PADL(ALLTRIM(STR(FIELDGET(1),5,0)),6) COLOR "R+/B"
@ 12,02 SAY PADL(ALLTRIM(FIELDGET(2)),15)
@ 13,02 SAY PADL(ALLTRIM(FIELDGET(3)),15)
@ 14,02 SAY PADL(ALLTRIM(FIELDGET(4)),15)
@ 15,02 SAY PADL(ALLTRIM(FIELDGET(5)),15)
@ 16,02 SAY "Σει1:"+PADL(ALLTRIM(FIELDGET(6)),10) COLOR "G+/B"
@ 17,02 SAY "Σει2:"+PADL(ALLTRIM(FIELDGET(7)),10) COLOR "G+/B"
@ 18,02 SAY "Σει3:"+PADL(ALLTRIM(FIELDGET(8)),10)
@ 19,02 SAY "FAX:"+PADL(ALLTRIM(FIELDGET(9)),11) COLOR "G+/B"
@ 20,02 SAY PADL(ALLTRIM(FIELDGET(10)),15)
@ 21,02 SAY PADL(ALLTRIM(FIELDGET(11)),15) COLOR "R+/B"
@ 22,02 SAY PADL(ALLTRIM(FIELDGET(12)),15)
bFldGsb := Eval(bFldGsb, .T.)
SET COLOR TO "GR+/B"
WINSHADE(8,21,23,76,'ON')
SET COLOR TO "W+/B"
@ 8,23 SAY "╡ Γεληθέο εκεηώζεηο ╞" COLOR "BG+/B"
cFval := MemoEdit(eval(bFldGsb),9,22,22,75,.T.,"WP_UDF")
lMemoUpdated := LastKey() == K_CTRL_W
WINSHADE(8,21,23,76,'OFF')
WINSHADE(10,1,23,17,'OFF')
ENDIF
IF Updated() .OR. lMemoUpdated
DO WHILE !Rlock()
ENDDO
Eval(bFldGsb, cFval)
UNLOCK
cNewKeyVal := &(IndexKey())
IF cOldKeyVal != cNewKeyVal
DbStabilize(oTbr)
ELSE
oTbr:refreshcurrent()
ENDIF
ENDIF
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//-------------------------------------------------------------------------
PROCEDURE ADDALL(oTbr)
LOCAL oTbc,nFieldNum,nFields
nFields:=Fcount()
FOR nFieldNum := 1 TO nFields
IF NFIELDNUM=1
oTbc := TBColumnNew("Α.A.",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=2
oTbc := TBColumnNew("Δπώλπκν",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=3
oTbc := TBColumnNew("Ολνκα",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=4
oTbc := TBColumnNew("Παηξώλπκν",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=5
oTbc := TBColumnNew("Ηδηόηεηα",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=6
oTbc := TBColumnNew("Σειέθσλν1",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=7
oTbc := TBColumnNew("Σειέθσλν2",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=8
oTbc := TBColumnNew("Σειέθσλν3",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=9
oTbc := TBColumnNew(" FAX ",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=10
oTbc := TBColumnNew("Γηεύζπλζε1",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=11
oTbc := TBColumnNew("Γηεύζπλζε2",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=12
oTbc := TBColumnNew("Γηεύζπλζε3",FIELDBLOCK(FIELD(nFieldNum)))
ELSEIF NFIELDNUM=13
oTbc := TBColumnNew("εκεηώζεηο",MEMOBLOCK(nFieldNum))
ENDIF
oTbr:addColumn(oTbc)
NEXT
RETURN
//---------------------------------------------------------------------------
FUNCTION MemoGet(cVar, bBlock, cName,bValid, bWhen, aMemoCoords, cFile)
LOCAL oGet := GetNew(Row(), Col(), bBlock, cName)
oGet:postBlock := bValid
oGet:preBlock := bWhen
oGet:reader := {|oGet| MemoRed(oGet) }
oGet:cargo := Array(MG_NUM_IVARS)
oGet:var := cVar
oGet:coords := aMemoCoords
oGet:fileName := cFile
RETURN oGet
//--------------------------------------------------------------------------
PROCEDURE MemoRed( oGet )
IF (GetPreValidate(oGet))
oGet:setFocus()
WHILE (oGet:exitState == GE_NOEXIT)
IF (oGet:typeOut)
oGet:exitState := GE_ENTER
ENDIF
WHILE (oGet:exitState == GE_NOEXIT)
GetMemo(oGet,inkey(0))
ENDDO
IF (!GetPostValidate(oGet))
oGet:exitState := GE_NOEXIT
ENDIF
ENDDO
oGet:killFocus()
ENDIF
RETURN
//---------------------------------------------------------------------------
PROCEDURE GetMemo(oGet, nKey)
LOCAL bKeyBlock
IF ((bKeyBlock := SetKey(nKey)) <> NIL)
GetDoSetKey(bKeyBlock,oGet)
RETURN
ENDIF
DO CASE
CASE nKey == K_UP
oGet:exitState := GE_UP
CASE nKey == K_SH_TAB
oGet:exitState := GE_UP
CASE nKey == K_DOWN
oGet:exitState := GE_DOWN
CASE nKey == K_TAB
oGet:exitState := GE_DOWN
CASE nKey == K_ENTER
oGet:exitState := GE_ENTER
CASE nKey == K_ESC
IF Set(_SET_ESCAPE)
oGet:exitState := GE_ESCAPE
ENDIF
CASE nKey == K_PGUP
oGet:exitState := GE_WRITE
CASE nKey == K_PGDN
oGet:exitState := GE_WRITE
CASE nKey == K_CTRL_HOME
oGet:exitState := GE_TOP
CASE nKey == K_INS
EditMemo(oGet)
oGet:exitState := GE_ENTER
CASE nKey == K_END
KEYBOARD CHR(23)
ENDCASE
RETURN
//--------------------------------------------------------------------------
PROCEDURE EditMemo(oGet)
LOCAL t,l,b,r,aCoords,cSaveScreen,nRow,nCol
aCoords := oGet:coords
t := aCoords[1]
l := aCoords[2]
b := aCoords[3]
r := aCoords[4]
nRow := Row()
nCol := Col()
cSaveScreen := SaveScreen(0,0,24,79)
RESTSCREEN(0,0,24,79,XSCREEN)
SET COLOR TO "GR+/B"
WINSHADE(10,1,23,17,'ON')
SET COLOR TO "W+/B"
@ 10,05 SAY "╡ Aηνκν ╞" COLOR "G+/B"
@ 11,02 SAY "Αξ.Μεη.: "
@ 11,COL() SAY PADL(ALLTRIM(STR(FIELDGET(1),5,0)),6) COLOR "R+/B"
@ 12,02 SAY PADL(ALLTRIM(FIELDGET(2)),15)
@ 13,02 SAY PADL(ALLTRIM(FIELDGET(3)),15)
@ 14,02 SAY PADL(ALLTRIM(FIELDGET(4)),15)
@ 15,02 SAY PADL(ALLTRIM(FIELDGET(5)),15)
@ 16,02 SAY "Σει1:"+PADL(ALLTRIM(FIELDGET(6)),10) COLOR "G+/B"
@ 17,02 SAY "Σει2:"+PADL(ALLTRIM(FIELDGET(7)),10) COLOR "G+/B"
@ 18,02 SAY "Σει3:"+PADL(ALLTRIM(FIELDGET(8)),10)
@ 19,02 SAY "FAX:"+PADL(ALLTRIM(FIELDGET(9)),11) COLOR "G+/B"
@ 20,02 SAY PADL(ALLTRIM(FIELDGET(10)),15)
@ 21,02 SAY PADL(ALLTRIM(FIELDGET(11)),15) COLOR "R+/B"
@ 22,02 SAY PADL(ALLTRIM(FIELDGET(12)),15)
SET COLOR TO "GR+/B"
WINSHADE(T,L,B,R,'ON')
SET COLOR TO "W+/B"
@ 8,23 SAY "╡ Γεληθέο εκεηώζεηο ╞" COLOR "BG+/B"
XNOTES := MemoEdit(NOTES,t+1,l+1,b-1,r-1,.T.,"WP_UDF")
REPLACE NOTES WITH XNOTES
WINSHADE(T,L,B,R,'OFF')
WINSHADE(10,1,23,17,'OFF')
RestScreen(0,0,24,79,cSaveScreen)
DevPos(nRow,nCol)
RETURN
//---------------------------------------------------------------------------
PROCEDURE ANAZHTHSH
LOCAL ARAY,SCREEN1,SCREEN2,SCREEN3,ARAY1
ARAY:={"NUMBER","EPONYMO","ONOMA","PATRONYMO","ATTRIBUTE","ADDRESS1","THLEFONO1"
,"THLEFONO2"}
ARAY1:={" Α.Μ. "," ΔΠΧΝΤΜΟ "," ΟΝΟΜΑ "," ΠΑΣΡΧΝΤΜΟ "," ΗΓΗΟΣΖΣΑ "," ΓΗΔΤΘΤΝΖ1
"," ΣΖΛΔΦΧΝΟ1 "," ΣΖΛΔΦΧΝΟ2 "}
SET EXACT OFF
@ 23,0,23,76 BOX REPLICATE(CHR(177),9)
@ 24,12 SAY PADC(" Αλαδήηεζε εγγξαθήο ππό ζπλζήθεο (Γξάκκαηα ή Δθθξάζεηο) ",56)
COLOR "BG+/B"
CLOSE INDEX
SET FILTER TO
INDEX ON EPONYMO+ONOMA+PATRONYMO TO INTEX1
INDEX ON ONOMA+EPONYMO+PATRONYMO TO INTEX2
INDEX ON PATRONYMO+EPONYMO+ONOMA TO INTEX3
SET INDEX TO INTEX1,INTEX2,INTEX3
DO WHILE LASTKEY() <> 27
SET CURSOR ON
EPON=SPACE(20)
ONOM=SPACE(12)
PATR=SPACE(12)
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY " Γώζηε ην Δπώλπκν ή : "
@ 19,25 SAY " Γώζηε ην Ολνκα ή : "
@ 20,25 SAY " Γώζηε ην Παηξώλπκν : "
@ 18,50 SAY EPON
@ 19,50 SAY ONOM
@ 20,50 SAY PATR
@ 18,50 GET EPON
READ
IF UPDATED()
EPON=Upperg(ALLTRIM(EPON))
ENDIF
IF !EMPTY(EPON)
SET ORDER TO 1
SET FILTER TO
SET FILTER TO EPONYMO=EPON
GO TOP
SCREEN1:=SAVESCREEN(0,0,24,79)
RESTSCREEN(0,0,24,79,XSCREEN)
SET COLOR TO "GR+/B"
WINSHADE(8,1,22,76,'ON')
SET COLOR TO "W+/B"
@ 8,7 SAY "╡ Αλαδήηεζε εγγξαθώλ ππό ζπλζήθεο επσλύκνπ ╞" COLOR "BG+/B"
DBEDIT(9,2,21,75,ARAY,,,ARAY1)
WINSHADE(8,1,22,76,'OFF')
RESTSCREEN(0,0,24,79,SCREEN1)
ENDIF
IF EMPTY(EPON) .OR. LEN(EPON) != 20
EPON=SPACE(20)
@ 18,50 SAY EPON
@ 19,50 GET ONOM
READ
IF UPDATED()
ONOM=Upperg(ALLTRIM(ONOM))
ENDIF
IF !EMPTY(ONOM)
SET ORDER TO 2
SET FILTER TO
SET FILTER TO ONOMA=ONOM
GO TOP
SCREEN2:=SAVESCREEN(0,0,24,79)
RESTSCREEN(0,0,24,79,XSCREEN)
SET COLOR TO "GR+/B"
WINSHADE(8,1,22,76,'ON')
SET COLOR TO "W+/B"
@ 8,7 SAY "╡ Αλαδήηεζε εγγξαθώλ ππό ζπλζήθεο νλόκαηνο ╞" COLOR "BG+/B"
DBEDIT(9,2,21,75,ARAY,,,ARAY1)
WINSHADE(8,1,22,76,'OFF')
RESTSCREEN(0,0,24,79,SCREEN2)
ENDIF
IF EMPTY(ONOM) .OR. LEN(ONOM)!= 12
ONOM=SPACE(12)
@ 19,50 SAY ONOM
@ 20,50 GET PATR
READ
IF UPDATED()
PATR=Upperg(ALLTRIM(PATR))
ENDIF
IF !EMPTY(PATR)
SET ORDER TO 3
SET FILTER TO
SET FILTER TO PATRONYMO=PATR
GO TOP
SCREEN3:=SAVESCREEN(0,0,24,79)
RESTSCREEN(0,0,24,79,XSCREEN)
SET COLOR TO "GR+/B"
WINSHADE(8,1,22,76,'ON')
SET COLOR TO "W+/B"
@ 8,7 SAY "╡ Αλαδήηεζε εγγξαθώλ ππό ζπλζήθεο παηξώλπκνπ ╞" COLOR
"BG+/B"
DBEDIT(9,2,21,75,ARAY,,,ARAY1)
WINSHADE(8,1,22,76,'OFF')
RESTSCREEN(0,0,24,79,SCREEN3)
ENDIF
ENDIF
ENDIF
WINSHADE(17,24,21,72,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(17,24,20,72,'ON')
SET COLOR TO "W+/B"
SET CURSOR OFF
@ 18,25 SAY PADC(" Θα επαλαιάβεηε ηελ αλαδήηεζε ή επηζηξνθή; ",47) COLOR
"BG+/B"
@ 19,25 SAY PADC(" (ΔΝΣΔR) ---> Eπαλάιεςε (ESC) ---> Δπηζηξνθή ",47)
INKEY(0)
WINSHADE(17,24,20,72,'OFF')
IF LASTKEY()=27
EXIT
ENDIF
ENDDO
SET EXACT ON
SET FILTER TO
CLOSE INDEX
RETURN
//----------------------------------------------------------------------------
PROCEDURE DIADIKASIA
LOCAL SCREEN1,VAR // ΜΔΣΑΒΛΖΣΖ ΜΔΣΡΖΖ ΔΓΓΡΑΦΧΝ - VAR
SCREEN1:=SAVESCREEN(0,0,24,79)
DO WHILE .T.
EPON:=SPACE(20)
ONOM:=SPACE(12)
PATR:=SPACE(12)
SET COLOR TO "GR+/B"
WINSHADE(17,27,21,68,'ON')
SET COLOR TO "W+/B"
SET CURSOR ON
@ 18,28 SAY " Δπώλπκν Αηόκνπ:" GET EPON VALID KENA1()
@ 19,28 SAY " Oλνκα Αηόκνπ:" GET ONOM VALID KENA2()
@ 20,28 SAY " Παηξώλπκν Αηόκνπ:" GET PATR VALID KENA3()
READ
SET CURSOR OFF
WINSHADE(17,27,21,68,'OFF')
CLOSE INDEX
SET FILTER TO
SET FILTER TO EPONYMO=EPON
INDEX ON EPONYMO+ONOMA+PATRONYMO TO GENIKO
SEEK EPON
IF !FOUND()
SET COLOR TO "GR+/B"
WINSHADE(17,22,21,72,'ON')
SET COLOR TO "W+/B"
@ 18,23 SAY PADC(" Γελ ππάξρεη Aηνκν κε απηά ηα ζηνηρεία. ",49) COLOR
"BG+/B"
@ 19,23 SAY PADC(" Δπαλαιεςε ηεο δηαδηθαζίαο ή λα επηζηξέςσ; ",49)
@ 20,23 SAY PADC(" (ΔΝΣΔR) ---> Eπαλάιεςε (ESC) ---> Δπηζηξνθή ",49)
INKEY(0)
WINSHADE(17,22,21,72,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
INDEX ON ONOMA TO ONOMA FOR ONOMA=ONOM .AND. PATRONYMO=PATR
COUNT TO VAR
IF VAR=1
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Τπάξρεη 1 Aηνκν κε απηά ηα ζηνηρεία. ",45) COLOR "BG+/B"
@ 19,25 SAY PADC(" Δπαλαιεςε ηεο δηαδηθαζίαο ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Eπαλάιεςε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
IF VAR=0
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Γώζαηε ιάζνο Ολνκα ή Παηξώλπκν. ",45) COLOR "BG+/B"
@ 19,25 SAY PADC(" Δπαλαιεςε ηεο δηαδηθαζίαο ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Eπαλάιεςε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
GO TOP
CLS
?
? " Δκθάληζε ησλ Αηόκσλ πνπ έρνπλ ίδην Δπώλπκν - Ολνκα - Παηξώλπκν "
? " ( A.A.E. = Αύμσλ Αξηζκόο Δγγξαθήο ) "
?
? " A.A.E. Ολνκαηεπώλπκν Σειέθσλν Γηεύζπλζε "
? "-----------------------------------------------------------------------------
--"
?
LIST EPONYMO+ONOMA+THLEFONO1+" "+ADDRESS1 FOR ONOMA==ONOM .AND.
PATRONYMO==PATR
?
? " Θα επαλαιάβεηε ηελ δηαδηθαζία ή λα ηεξκαηίζσ επηζηξέθνληαο; (ESC) --->
ΣΔΛΟ "
INKEY(0)
IF LASTKEY()=27
EXIT
ELSE
RESTSCREEN(0,0,24,79,SCREEN1)
LOOP
ENDIF
ENDDO
RESTSCREEN(0,0,24,79,SCREEN1)
SET FILTER TO
CLOSE INDEX
RETURN
//----------------------------------------------------------------------------
PROCEDURE INTEX
LOCAL SCREEN1
SCREEN1:=SAVESCREEN(0,0,24,79)
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
@ 23,15 SAY " Γεκηνπξγία Δπξεηεξίνπ γηα ην αξρείν KATALOGO.DBF " COLOR "BG+/B"
SINDEX("NUMBER","SYNOLO","Eπξεηήξην κε Aύμνληα Αξηζκό Αηόκνπ ")
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//----------------------------------------------------------------------------
PROCEDURE PRO
XATTRIBUTE:=SPACE(15)
XTHLEFONO1:=SPACE(10)
XTHLEFONO2:=SPACE(10)
XTHLEFONO3:=SPACE(10)
XFAX :=SPACE(11)
XADDRESS1 :=SPACE(15)
XADDRESS2 :=SPACE(15)
XADDRESS3 :=SPACE(15)
XNOTES :=SPACE(4)
RETURN
//----------------------------------------------------------------------------
PROCEDURE OTHONH
@ 14,02 SAY " Ζκεξνκελία: ΓΔΝΗΚΑ ΣΟΗΥΔIA ΑΣΟΜΟΤ Χξα:
"
@ 15,01 SAY
"╟──────────────────────────────────────────────────────────────────────────╢"
COLOR "GR+/B"
@ 16,02 SAY " Αξηζκόο Μεηξώνπ: Σειέθσλν-1.:
"
@ 17,02 SAY " Δπώλπκν..: Σειέθσλν-2.:
"
@ 18,02 SAY " Ολνκα....: Σειέθσλν-3.:
"
@ 19,02 SAY " Παηξώλπκν: Γηεύζπλζε-1:
"
@ 20,02 SAY " Ηδηόηεηα.: Γηεύζπλζε-2:
"
@ 21,02 SAY " Γηεύζπλζε-3:
"
@ 22,02 SAY " FAX......: εκεηώζεηο.:
"
@ 14,15 SAY DATE() COLOR "BG+/B"
@ 14,66 SAY TIME() COLOR "BG+/B"
RETURN
//--------------------------------------------------------------------------
PROCEDURE GETAST
SET CURSOR ON
SET ESCAPE ON
IF FLAG24 // ΓΗΑΓΗΚΑΗΑ ΔΗΑΓΧΓΖ - ΑΝΣΗΚΑΣΔΣΖΔ ΜΔ ΣΟΝ ΑΡΗΘMΟ ΔΓΓΡΑΦΧΝ + ΔΝΑ
@ 16,19 SAY XNUMB COLOR "BG+/B"
ELSE
@ 16,19 SAY NUMBER COLOR "BG+/B" // ΓΗΑΓΗΚΑΗΑ ΓΗΟΡΘΧΖ ή ΓΗΑΓΡΑΦΖ
ENDIF // ΓΔΗΞΔ ΣΟΝ ΑΡΗΘΜΟ ΔΓΓΡΑΦΖ
@ 17,13 SAY EPON COLOR "GR+/B"
@ 18,13 SAY ONOM COLOR "GR+/B"
@ 19,13 SAY PATR COLOR "GR+/B"
@ 20,13 GET XATTRIBUTE
@ 16,51 GET XTHLEFONO1
@ 17,51 GET XTHLEFONO2
@ 18,51 GET XTHLEFONO3
@ 19,51 GET XADDRESS1
@ 20,51 GET XADDRESS2
@ 21,51 GET XADDRESS3
@ 22,13 GET XFAX
READ
SET CURSOR OFF
SET ESCAPE OFF
RETURN
//--------------------------------------------------------------------------
PROCEDURE GETASTA
SET CURSOR ON
SET ESCAPE ON
@ 22,51 GET XNOTES MEMO AT 8,21,23,76
READ
SET CURSOR OFF
SET ESCAPE OFF
RETURN
//----------------------------------------------------------------------------
PROCEDURE REPLAST
IF FLAG24
REPLACE NUMBER WITH XNUMB // ΜΟΝΟ ΣΖΝ ΔΗΑΓΧΓΖ ΑΝΣΗΚΑΣΔΣΖΔ ΣΟΝ ΑΡΗΘΜΟ
ENDIF // ΔΓΓΡΑΦΖ ΓΗΑ ΣΟΝ ΓΑΝΔΗΕΟΜΔΝΟ
REPLACE EPONYMO WITH EPON
REPLACE ONOMA WITH ONOM
REPLACE PATRONYMO WITH PATR
REPLACE ATTRIBUTE WITH XATTRIBUTE
REPLACE THLEFONO1 WITH XTHLEFONO1
REPLACE THLEFONO2 WITH XTHLEFONO2
REPLACE THLEFONO3 WITH XTHLEFONO3
REPLACE FAX WITH XFAX
REPLACE ADDRESS1 WITH XADDRESS1
REPLACE ADDRESS2 WITH XADDRESS2
REPLACE ADDRESS3 WITH XADDRESS3
RETURN
//----------------------------------------------------------------------------
PROCEDURE VARAST
XNUMBER :=NUMBER
XEPONYMO :=EPON
XONOMA :=ONOM
XPATRONYMO:=PATR
XATTRIBUTE:=ATTRIBUTE
XTHLEFONO1:=THLEFONO1
XTHLEFONO2:=THLEFONO2
XTHLEFONO3:=THLEFONO3
XFAX :=FAX
XADDRESS1 :=ADDRESS1
XADDRESS2 :=ADDRESS2
XADDRESS3 :=ADDRESS3
RETURN
//---------------------------------------------------------------------------
PROCEDURE SAYAST
@ 16,19 SAY NUMBER COLOR "BG+/B"
@ 17,13 SAY EPON COLOR "GR+/B"
@ 18,13 SAY ONOM COLOR "GR+/B"
@ 19,13 SAY PATR COLOR "GR+/B"
@ 20,13 SAY XATTRIBUTE
@ 22,13 SAY XFAX
@ 16,51 SAY XTHLEFONO1
@ 17,51 SAY XTHLEFONO2
@ 18,51 SAY XTHLEFONO3
@ 19,51 SAY XADDRESS1
@ 20,51 SAY XADDRESS2
@ 21,51 SAY XADDRESS3
@ 22,51 SAY "Memo"
RETURN
//---------------------------------------------------------------------------
PROCEDURE DOUBLE
LOCAL ARAY,SCREEN1,ARAY1
SCREEN1:=SAVESCREEN(0,0,24,79)
ARAY:={"NUMBER","EPONYMO","ONOMA","PATRONYMO","ATTRIBUTE","ADDRESS1","THLEFONO1"
}
ARAY1:={" Α.Μ. "," ΔΠΧΝΤΜΟ "," ΟΝΟΜΑ ","ΠΑΣΡΧΝΤΜΟ"," ΗΓΗΟΣΖΣΑ "," ΓΗΔΤΘΤΝΖ-1
"," ΣΖΛΔΦΧΝΟ-1 "}
@ 23,0,23,76 BOX REPLICATE(CHR(177),9)
RESTSCREEN(0,0,24,79,XSCREEN)
@ 24,10 SAY PADC(" Δκθάληζε Αηόκσλ κε ίδην Δπώλπκν - Ολνκα - Παηξώλπκν ",60)
COLOR "BG+/B"
GO TOP
SET COLOR TO "GR+/B"
WINSHADE(8,1,22,76,'ON')
SET COLOR TO "W+/B"
@ 8,7 SAY "╡ Δκθάληζε Αηόκσλ πνπ είλαη πλώλπκνη ╞" COLOR "BG+/B"
DBEDIT(9,2,21,75,ARAY,,,ARAY1)
WINSHADE(8,1,22,76,'OFF')
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//---------------------------------------------------------------------------
PROCEDURE SYNVNYMA
FLAG25:=.T. // ΖΜΑΗΑ ΔΝΖΜΔΡΧΖ ΓΗΑ ΣΖΝ ΔΗΑΑΓΧΓΖ ΣΟΤ ΣΖΛΔΦΧΝΟΤ
THLE:=SPACE(10)
SET COLOR TO "GR+/B"
WINSHADE(18,23,20,70,'ON')
SET COLOR TO "W+/B"
SET CURSOR ON
@ 19,24 SAY " Γώζηε κνπ ην ηειέθσλν ηνπ Αηόκνπ:" COLOR "BG+/B" GET THLE VALID
KENA4()
READ
SET CURSOR OFF
WINSHADE(18,23,20,70,'OFF')
CLOSE INDEX
INDEX ON THLEFONO1 TO THLEFONO
SEEK THLE
RETURN
//---------------------------------------------------------------------------
FUNCTION KENA4()
IF THLE < '!'
ALERT(" Με δίλεηε θελά... ",{" Δπηζηξνθή "})
RETURN .F.
ENDIF
RETURN .T.
//
// ΠΑΡΑΚΔΤΖ 18 ΗΟΤΛΗΟΤ 1997
// ΑΡΥΔΗΟ ΓΔΝΗΚΧΝ ΔΡΓΑΗΧΝ ΣΟ ΠΡΟΓΡΑΜΜΑ ΒΗΒΛΗΟΘΖΚΖ
//
//---------------------------------------------------------------------------
PROCEDURE ARXEIA
LOCAL PINAKAS,EPILOG,SCREEN1
PINAKAS:={" Αληίγξαθα "," εκεηώζεηο "," Δλεκέξσζε "," Γηαγξαθή Μ "}
SET COLOR TO "GR+/B"
WINSHADE(06,17,11,30,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
SET KEY 4 TO RIGHT_ARROW
SET KEY 19 TO LEFT1_ARROW
EPILOG := ACHOICE(07,18,10,29,PINAKAS)
SCREEN1:=SAVESCREEN(0,0,24,79)
SET KEY 19 TO
SET KEY 4 TO
DO CASE
CASE EPILOG=0
WINSHADE(06,17,11,30,'OFF')
RETURN
CASE EPILOG=1
ANTIGRAFA()
CASE EPILOG=2
SIGN()
CASE EPILOG=3
ENHMERVSH()
CASE EPILOG=4
KEIMENA()
ENDCASE
RESTSCREEN(0,0,24,79,SCREEN1)
ENDDO
RETURN
//---------------------------------------------------------------------------
PROCEDURE ANTIGRAFA
LOCAL MENU1,SCREEN1
SET COLOR TO "GR+/B"
WINSHADE(15,35,19,66,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
@ 16,36 SAY " Αληίγξαθα ζην " COLOR "G+/B"
@ 16,52 PROMPT " C:\KATALOGO "
@ 17,36 SAY " Αληίγξαθα ζην " COLOR "G+/B"
@ 17,52 PROMPT " C:\ARXEIA "
@ 18,36 SAY " Αληίγξαθα ζην " COLOR "BG+/B"
@ 18,52 PROMPT " A:\ "
SCREEN1:=SAVESCREEN(0,0,24,79)
MENU TO MENU1
DO CASE
CASE MENU1=0
EXIT
CASE MENU1=1
CLS
RUN COPY *.DB? C:\KATALOGO
RUN COPY *.NTX C:\KATALOGO
?
?
? " Σα αξρεία απνζεθεύηεθαλ ζε αληίγξαθα ζην C:\KATALOGO.Παηήζηε
θάπνην πιήθηξν... "
INKEY(0)
CASE MENU1=2
CLS
RUN COPY *.DB? C:\ARXEIA
RUN COPY *.NTX C:\ARXEIA
?
?
? " Σα αξρεία απνζεθεύηεθαλ ζε αληίγξαθα ζην C:\ARXEIA.Παηήζηε θάπνην
πιήθηξν... "
INKEY(0)
CASE MENU1=3
CLS
RUN COPY *.DB? A:
RUN COPY *.NTX A:
?
?
? " Σα αξρεία απνζεθεύηεθαλ ζε αληίγξαθα ζην A:\.Παηήζηε θάπνην
πιήθηξν... "
INKEY(0)
ENDCASE
RESTSCREEN(0,0,24,79,SCREEN1)
ENDDO
WINSHADE(15,35,19,66,'OFF')
RETURN
//---------------------------------------------------------------------------
PROCEDURE ENHMERVSH
SET DELETED ON
SET COLOR TO "GR+/B"
WINSHADE(15,39,18,70,'ON')
SET COLOR TO "W+/B"
@ 16,40 SAY " Δλεκέξσζε ηνπ αξρείνπ BASEIS " COLOR "BG+/B"
@ 17,40 SAY " κε όιεο ηηο βάζεηο δεδνκέλσλ "
INKEY(0)
WINSHADE(15,39,18,70,'OFF')
USE
USE BASEIS
ZAP // ΥΑΝΟΝΣΑΗ ΟΜΧ ΚΑΗ ΟΛΑ ΣΑ ΑΡΥΔΗΑ ΚΔΗΜΔΝΟΤ ΓΗΑ ΣΗ ΒΑΔΗ ΓΔΓΟΜΔΝΧΝ
AEVAL(DIRECTORY("*.DBF"),{|ITEM| DBAPPEND(),RECADD(ITEM)})
SET COLOR TO "GR+/B"
WINSHADE(15,40,19,69,'ON')
SET COLOR TO "W+/B"
@ 16,41 SAY PADC(" Οινθιεξώζεθε ε ελεκέξσζε ",28) COLOR "BG+/B"
@ 17,41 SAY PADC("Θα δείηε ην αξρείν; ",28)
@ 18,41 SAY PADC(" (ESC) ---> Δπηζηξνθή ",28)
INKEY(0)
WINSHADE(15,40,19,69,'OFF')
IF LASTKEY()=27
USE
RETURN
ENDIF
SIGN()
SET DELETED OFF
RETURN
//---------------------------------------------------------------------------
PROCEDURE SIGN
LOCAL HEADER
HEADER:={}
AADD(HEADER," Ολνκα αξρείνπ ")
AADD(HEADER," Μέγεζνο ")
AADD(HEADER," Ζκεξνκελία ")
AADD(HEADER," Χξα ")
AADD(HEADER," εκεηώζεηο ")
USE
USE BASEIS
INDEX ON NAMEFILE TO NAMEFILE
SET COLOR TO "GR+/B"
WINSHADE(10,4,20,76,'ON')
SET COLOR TO "W+/B"
DBEDIT(11,5,19,75,,"KEYS",,HEADER)
WINSHADE(10,4,20,76,'OFF')
USE
RETURN
//--------------------------------------------------------------------------
PROCEDURE KEIMENA
PARAMETERS XFILE,XFILE1,XFILE2,XFILE3
LOCAL CHOICE,FILES,SCREEN1
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
@ 24,13 SAY " Δπηιέμηε αξρείν γηα λα ζπκπηύμεηε ηα πεδία θεηκέλνπ " COLOR
"BG+/B"
SET COLOR TO "GR+/B"
WINSHADE(11,31,22,46,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
FILES:={}
AEVAL(DIRECTORY("*.DBF"),{|ITEM| AADD(FILES,ITEM[1])})
NAME1:=SPACE(12)
IF !EMPTY(CHOICE:=ACHOICE(12,33,21,44,FILES))
NAME1:=ALLTRIM(FILES[CHOICE])
ELSE
EXIT
ENDIF
XFILE:=LEFT(NAME1,LEN(NAME1)-1)
XFILE1:=XFILE+"T"
XFILE2:=XFILE+"F"
XFILE3:=LEFT(NAME1,LEN(NAME1)-4)
USE &XFILE3
COPY TO NAME
USE
ERASE &XFILE2
ERASE &XFILE1
RENAME NAME.DBF TO &XFILE2
RENAME NAME.DBT TO &XFILE1
SCREEN1:=SAVESCREEN(0,0,24,79)
CLS
USE &XFILE2
DBEDIT(2,2,22,77)
USE
CLS
RUN DIR *.DBF /OD
INKEY(0)
RUN DIR *.DBT /OD
INKEY(0)
RESTSCREEN(0,0,24,79,SCREEN1)
ENDDO
@ 24,0,24,79 BOX REPLICATE(CHR(177),9)
WINSHADE(11,31,22,46,'OFF')
RETURN
//--------------------------------------------------------------------------
PROCEDURE RECADD(AREC)
AEVAL(AREC,{|ELEM,POSIT| FIELDPUT(POSIT,IF(ELEM==NIL,"",ELEM))})
RETURN
//--------------------------------------------------------------------------
FUNCTION KEYS(MODE,COL)
LOCAL RET:=1,NKEY:=LASTKEY(),SCREEN1,VAR
DO CASE
CASE MODE==1 .OR. MODE==2
KEYBOARD CHR(IF(MODE==2,31,30))
CASE MODE==3
WINSHADE(20,10,22,69,'ON')
@ 21,11 SAY PADC(" Γελ ππάξρνπλ αξρεία ζηε βάζε δεδνκέλσλ ", 58) COLOR
"BG+/B"
INKEY(0)
WINSHADE(20,10,22,69,'OFF')
RET:=0
OTHERWISE
DO CASE
CASE NKEY==27
RET:=0
CASE NKEY==22
IF VALTYPE(&(FIELD(COL)))=="M"
SCREEN1:=SAVESCREEN(0,0,24,79)
SET COLOR TO "G+/B"
WINSHADE(12,7,22,76,'ON')
@ 12,10 SAY "╡ εκεηώζεηο γηα ην αξρείo βάζεο δεδνκέλσλ ╞"
COLOR "BG+/B"
SET COLOR TO "W+/B"
SET CURSOR ON
VAR:=MEMOEDIT(NOTES,13,8,21,75,.T.)
SET CURSOR OFF
WINSHADE(12,7,22,76,'OFF')
REPLACE NOTES WITH VAR
RESTSCREEN(0,0,24,79,SCREEN1)
ENDIF
ENDCASE
ENDCASE
RETURN (RET)
//
// ΑΡΥΔΗΟ ΓΗΑ ΣΗ ΔΚΣΤΠΧΔΗ ΣΟΤ ΠΡΟΓΡΑΜΜΑΣΟ "ΒΗΒΛΗΟΘΖΚΖ" - (1.00)
//
// ΣΡΗΣΖ 2 ΔΠΣΔΜΒΡΗΟΤ 1997
//
//---------------------------------------------------------------------------
PROCEDURE EKTYP
LOCAL PINAKAS,EPILOG
PINAKAS:={" Καηάινγνο ","Γ.εκεηώζεηο"," Αξρείν "}
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
SET COLOR TO "GR+/B"
WINSHADE(6,29,10,42,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
SET KEY 19 TO LEFT_ARROW
SET KEY 4 TO RIGHT1_ARROW
EPILOG := ACHOICE(7,30,9,41,PINAKAS)
SET KEY 4 TO
SET KEY 19 TO
DO CASE
CASE EPILOG=0
WINSHADE(6,29,10,42,'OFF')
RETURN
CASE EPILOG=1
FLAG30:=.T.
EKTYPVSH1()
FLAG30:=.F.
CASE EPILOG=2
EKTYPVSH1()
CASE EPILOG=3
EKTYPVSH2()
ENDCASE
SET COLOR TO "GR+/B"
WINSHADE(18,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" Θα εθηππώζεηε άιιν πεδίν ή λα επηζηξέςσ; ",45) COLOR
"BG+/B"
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Eθηύπσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(18,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDDO
WINSHADE(6,29,10,42,'OFF')
RETURN
//---------------------------------------------------------------------------
PROCEDURE EKTYPVSH1
USE
IF FLAG30
USE KATALOGO
INDEX ON NUMBER TO NUMBER
EKTYPVSH()
ELSE
USE SHMEIVS
DO WHILE .T.
IF ISPRINTER()
SET COLOR TO "GR+/B"
WINSHADE(18,51,20,71,'ON')
SET COLOR TO "W+/B"
@ 19,52 SAY PADC(" Δθηππώζε πεδίνπ ",19) COLOR "BG+/B"
SET DEVICE TO PRINT
LINES:=MLCOUNT(NOTES,71)
MEMOTRAN(NOTES)
FYSIKO()
KART()
FOR I:=1 TO LINES
TEMP:=MEMOLINE(NOTES,71,I)
@ PROW()+1,5 SAY TEMP
NEXT
@ PROW()+1,1 SAY " "
@ PROW()+1,1 SAY " "
@ PROW()+1,53 SAY HMERA()+' '+STR(DAY(DATE()),2)+' '+MHNAS()+'
'+STR(YEAR(DATE()),4)
EJECT
SET DEVICE TO SCREEN
INKEY(0)
WINSHADE(18,51,20,71,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(18,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" Θα επαλαιάβεηε ηελ εθηύπσζε ή λα επηζηξέςσ; ",45)
COLOR "BG+/B"
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Δθηύπσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(18,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ELSE
SET COLOR TO "GR+/B"
WINSHADE(17,11,21,57,'ON')
SET COLOR TO "W+/B"
@ 18,12 SAY PADC(" O Eθηππσηήο είλαη εθηόο ιεηηνπξγίαο. ",45) COLOR
"BG+/B"
@ 19,12 SAY PADC(" Αλνίμηε ηνλ Δθηππσηή ή βάιηε ηελ ελδεηθηηθή ",45)
@ 20,12 SAY PADC(" ιπρλία ζηε ζέζε ON LINE.(ESC) --> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,11,21,57,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
ENDDO
ENDIF
USE
RETURN
//---------------------------------------------------------------------------
PROCEDURE EKTYPVSH
DO WHILE .T.
NAME:=SPACE(5)
SET COLOR TO "GR+/B"
WINSHADE(17,24,19,58,'ON')
SET COLOR TO "W+/B"
SET CURSOR ON
@ 18,25 SAY " Αξηζκόο Μεηξώνπ Αηόκνπ : " COLOR "BG+/B" GET NAME
READ
SET CURSOR OFF
WINSHADE(17,24,19,58,'OFF')
SEEK &NAME
IF !FOUND()
SET COLOR TO "GR+/B"
WINSHADE(17,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 18,25 SAY PADC(" Γελ ππάξρεη εγγξαθή κε απηά ηα ζηνηρεία. ",45) COLOR
"BG+/B"
@ 19,25 SAY PADC(" Θα επαλαιάβεηε ηελ εθηύπσζε ή λα επηζηξέςσ; ",45)
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Δθηύπσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
IF ISPRINTER()
SET COLOR TO "GR+/B"
WINSHADE(18,51,20,71,'ON')
SET COLOR TO "W+/B"
@ 19,52 SAY PADC(" Δθηππώζε πεδίνπ ",19) COLOR "BG+/B"
SET DEVICE TO PRINT
LINES:=MLCOUNT(NOTES,71)
MEMOTRAN(NOTES)
FYSIKO()
KART()
FOR I:=1 TO LINES
TEMP:=MEMOLINE(NOTES,71,I)
@ PROW()+1,5 SAY TEMP
NEXT
@ PROW()+1,1 SAY " "
@ PROW()+1,1 SAY " "
@ PROW()+1,53 SAY HMERA()+' '+STR(DAY(DATE()),2)+' '+MHNAS()+'
'+STR(YEAR(DATE()),4)
EJECT
SET DEVICE TO SCREEN
INKEY(0)
WINSHADE(18,51,20,71,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(18,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" Θα επαλαιάβεηε ηελ εθηύπσζε ή λα επηζηξέςσ; ",45) COLOR
"BG+/B"
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Δθηύπσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(18,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ELSE
SET COLOR TO "GR+/B"
WINSHADE(17,11,21,57,'ON')
SET COLOR TO "W+/B"
@ 18,12 SAY PADC(" O Eθηππσηήο είλαη εθηόο ιεηηνπξγίαο. ",45) COLOR "BG+/B"
@ 19,12 SAY PADC(" Αλνίμηε ηνλ Δθηππσηή ή βάιηε ηελ ελδεηθηηθή ",45)
@ 20,12 SAY PADC(" ιπρλία ζηε ζέζε ON LINE.(ESC) --> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,11,21,57,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
ENDDO
USE
RETURN
//---------------------------------------------------------------------------
PROCEDURE KART
@ 07,03 SAY
"┌────────────────────────────────────────────────────────────────────────┐"
@ 08,03 SAY "│"
IF FLAG30=.T.
@ 08,04 SAY PADC(" εκεηώζεηο γηα ηνλ επαγγεικαηία ",72)+"│"
@ 09,03 SAY
"├────────────┬───────────────────────────────────────────────────────────┤"
@ 10,03 SAY "│ Αξ.Μεηξώνπ │ "+PADR(TRIM(STR(NUMBER,5,0)),58)+"│"
@ 11,03 SAY "│ Eπώλπκν │ "+PADR(TRIM(EPONYMO),58) +"│"
@ 12,03 SAY "│ Oλνκα │ "+PADR(TRIM(ONOMA),58) +"│"
@ 13,03 SAY "│ Παηξώλπκν │ "+PADR(TRIM(PATRONYMO),58) +"│"
@ 14,03 SAY "│ Δπάγγεικα │ "+PADR(TRIM(ATTRIBUTE),58) +"│"
@ 15,03 SAY "│ Γηεύζπλζε │ "+PADR(TRIM(ADDRESS1),58) +"│"
@ 16,03 SAY "│ Σειέθσλν1 │ "+PADR(TRIM(THLEFONO1),58) +"│"
@ 17,03 SAY "│ Σειέθσλν2 │ "+PADR(TRIM(THLEFONO2),58) +"│"
@ 18,03 SAY "│ Χξα │ "+PADR(TIME(),58) +"│"
@ 19,03 SAY
"└────────────┴───────────────────────────────────────────────────────────┘"
@ 20,00 SAY " "
@ 21,00 SAY " "
ELSE
@ 08,04 SAY PADC(" Γεληθέο εκεηώζεηο Καηαιόγνπ ",72)+"│"
@ 09,03 SAY
"└────────────────────────────────────────────────────────────────────────┘"
@ 10,00 SAY " "
@ 11,00 SAY " "
ENDIF
RETURN
//---------------------------------------------------------------------------
PROCEDURE FYSIKO
@ 00,03 SAY
"┌────────────────────────────────────────────────────────────────────────┐"
@ 01,03 SAY "│
│"
@ 02,03 SAY "│ KAΣΑΛΟΓΟ ΔΠΑΓΓΔΛΜΑΣΗΧΝ - ΓΔΝΗΚΔ ΖΜΔΗΧΔΗ
│"
@ 03,03 SAY "│
│"
@ 04,03 SAY
"└────────────────────────────────────────────────────────────────────────┘"
@ 05,00 SAY " "
RETURN
//---------------------------------------------------------------------------
PROCEDURE FYSIKO1
@ 00,03 SAY
"┌────────────────────────────────────────────────────────────────────────┐"
@ 01,03 SAY "│
│"
@ 02,03 SAY "│ KAΣΑΛΟΓΟ ΔΠΑΓΓΔΛΜΑΣΗΧΝ
│"
@ 03,03 SAY "│
│"
@ 04,03 SAY
"└────────────────────────────────────────────────────────────────────────┘"
@ 05,00 SAY " "
RETURN
//---------------------------------------------------------------------------
PROCEDURE EKTYPVSH2
USE
USE KATALOGO
INDEX ON NUMBER TO NUMBER
DO WHILE .T.
IF ISPRINTER()
SET COLOR TO "GR+/B"
WINSHADE(18,51,20,71,'ON')
SET COLOR TO "W+/B"
@ 19,52 SAY PADC(" Δθηππώζε αξρείνπ ",19) COLOR "BG+/B"
SET DEVICE TO PRINT
SET CONSOLE OFF
FYSIKO1()
LIST NUMBER,EPONYMO,ONOMA,ATTRIBUTE,THLEFONO1 TO PRINTER OFF
@ PROW()+1,1 SAY " "
@ PROW()+1,1 SAY " "
@ PROW()+1,53 SAY HMERA()+' '+STR(DAY(DATE()),2)+' '+MHNAS()+'
'+STR(YEAR(DATE()),4)
EJECT
SET DEVICE TO SCREEN
SET CONSOLE ON
INKEY(0)
WINSHADE(18,51,20,71,'OFF')
SET COLOR TO "GR+/B"
WINSHADE(18,24,21,70,'ON')
SET COLOR TO "W+/B"
@ 19,25 SAY PADC(" Θα επαλαιάβεηε ηελ εθηύπσζε ή λα επηζηξέςσ; ",45) COLOR
"BG+/B"
@ 20,25 SAY PADC(" (ΔΝΣΔR) ---> Δθηύπσζε (ESC) ---> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(18,24,21,70,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ELSE
SET COLOR TO "GR+/B"
WINSHADE(17,11,21,57,'ON')
SET COLOR TO "W+/B"
@ 18,12 SAY PADC(" O Eθηππσηήο είλαη εθηόο ιεηηνπξγίαο. ",45) COLOR
"BG+/B"
@ 19,12 SAY PADC(" Αλνίμηε ηνλ Δθηππσηή ή βάιηε ηελ ελδεηθηηθή ",45)
@ 20,12 SAY PADC(" ιπρλία ζηε ζέζε ON LINE.(ESC) --> Δπηζηξνθή ",45)
INKEY(0)
WINSHADE(17,11,21,57,'OFF')
IF LASTKEY()=27
EXIT
ELSE
LOOP
ENDIF
ENDIF
ENDDO
USE
RETURN
//
// ΣΔΣΑΡΣΖ 25/6/1997
// ΑΡΥΔΗΟ ΜΔ ΒΟΖΘΖΣΗΚΔ ΛΔΗΣΟΤΡΓΗΔ ΣΟΤ ΠΡΟΓΡΑΜΜΑΣΟ
//
#INCLUDE "INKEY.CH"
#INCLUDE "MEMOGET1.CH" // ΑΠΟ ΣΟ ΑΝΣΗΚΔΗΜΔΝΟ TBROWSE
#INCLUDE "MGDEF1.CH" // ΓΗΑ ΣΑ ΜΔΜΟ ΠΔΓΗΑ ΣΗ ΚΑΡΣΔ
#INCLUDE "GETEXIT.CH"
#INCLUDE "MEMOEDIT.CH" // ΑΡΥΔΗΑ ΓΗΑ ΣΟ ΖΜΔΡΟΛΟΓΗΟ (ΜΑΛΛΟΝ)
#INCLUDE "SETCURS.CH"
#INCLUDE "SET.CH"
#INCLUDE "DEBUG.CH"
#DEFINE pLINE REPLICATE(CHR(196),4) // ΔΝΣΟΛΔ ΓΗΑ ΣΟ ΖΜΔΡΟΛΟΓΗΟ
#DEFINE pSPACES REPLICATE(CHR(32),4)
#DEFINE LEN_COL_STR 20
#DEFINE LEN_VID_STK_ENTRY LEN_COL_STR + 3
#XCOMMAND UNTIL <EXP> => IF <EXP> ; EXIT ; END ; END
#XTRANSLATE SAY(<R>,<C>,<EXP>) =>(DEVPOS(<R>,<C>),DEVOUT(<EXP>))
//----------------------------------------------------------------------------
PROCEDURE SCRSAVE
LOCAL SCREEN1
SET CURSOR OFF
SCREEN1:=SAVESCREEN(0,0,24,79)
RUN ART
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//----------------------------------------------------------------------------
PROCEDURE TORUS
LOCAL SCREEN1
SET CURSOR OFF
SCREEN1:=SAVESCREEN(0,0,24,79)
RUN TORUS
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//---------------------------------------------------------------------------
PROCEDURE AKYRO
CLEAR GETS
FLAG14:=.T.
RETURN
//---------------------------------------------------------------------------
PROCEDURE LISTA
SET COLOR TO "GR+/B"
WINSHADE(10,15,18,62,'ON')
SET CURSOR OFF
@ 10,30 SAY "╡ Function Keys ╞" COLOR "BG+/B"
@ 11,16 SAY " ΠΛΖΚΣΡΟ ΛΔΗΣΟΤΡΓΗΑ " COLOR "BG+/B"
@ 12,15 SAY "╟──────────────────────────────────────────────╢"
SET COLOR TO "W+/B"
@ 13,16 SAY " F1" COLOR "G+/B"
@ 13,COL() SAY " - Γεληθέο νδεγίεο γηα ην πξόγξακκα "
@ 14,16 SAY " F2" COLOR "G+/B"
@ 14,COL() SAY " - Λεηηνπξγίεο ησλ Function Keys "
@ 15,16 SAY " F3" COLOR "G+/B"
@ 15,COL() SAY " - Γεληθέο πιεξνθνξίεο γηα ηνλ Ζ/Τ "
@ 16,16 SAY " F4" COLOR "G+/B "
@ 16,COL() SAY " - Αθύξσζε ηεο εηζαγσγήο ζηνηρείσλ "
@ 17,16 SAY " F5" COLOR "G+/B"
@ 17,COL() SAY " - Δλεξγνπνίεζε ηνπ ScreenSaver ART "
INKEY(0)
WINSHADE(10,15,18,62,'OFF')
RETURN
//--------------------------------------------------------------------------
PROCEDURE CALENDAR
LOCAL SCREEN1
SCREEN1:=SAVESCREEN(0,0,24,79)
@ 8,0,24,79 BOX REPLICATE(CHR(177),9)
SET CURSOR OFF
SET EXACT OFF
SET DATE AMERICAN
CALENDA(,DATE())
SET DATE BRITISH
SET EXACT ON
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//---------------------------------------------------------------------------
PROCEDURE CALENDA(ASTRUC,DDATE,BACT)
LOCAL NROW,NCOL,CCOLOR,CSCREEN
NROW:=ROW()
NCOL:=COL()
CCOLOR:=SETCOLOR()
CSCREEN:=SAVESCREEN(0,0,24,79)
ASTRUC:={}
BACT:={|| .T.}
IF EMPTY(LEN(ASTRUC))
ASTRUC:={8,41,MONTH(DATE()),YEAR(DATE()),SETCOLOR(),DATE(),{|X,Y|
CALENDARKEYS(X,Y,BACT)}}
ENDIF
ASTRUC[7]:=IF(VALTYPE(ASTRUC[7])="B",ASTRUC[7],{|| .T.})
IF DDATE != NIL
ASTRUC[6] := DDATE
ENDIF
DO WHILE .T.
SETCOLOR(ASTRUC[5])
DISPBEGIN()
DISPBOX(ASTRUC[1],ASTRUC[2],ASTRUC[1]+16,ASTRUC[2]+35,SPACE(9))
SET COLOR TO "GR+/B"
SAY(ASTRUC[1]+1,ASTRUC[2]+2,PADR(SAYDATE(ASTRUC[3],ASTRUC[4]),30))
SET COLOR TO "W+/B"
SAY(ASTRUC[1]+2,ASTRUC[2],CHR(195)+REPLICATE(CHR(196),34)+CHR(180))
SET COLOR TO "G+/B"
SAY(ASTRUC[1]+3,ASTRUC[2]+1,"Κπξ Γεπ Σξη Σεη Πεκ Παξ αβ")
SET COLOR TO "W+/B"
SAY(ASTRUC[1]+4,ASTRUC[2],CHR(195)+REPLICATE(CHR(196),34)+CHR(180))
SAY(ASTRUC[1]+4,ASTRUC[2]+1,REPLICATE(pLINE+CHR(194),6))
SAY(ASTRUC[1]+5,ASTRUC[2]+1,REPLICATE(pSPACES+CHR(179),6))
SAY(ASTRUC[1]+6,ASTRUC[2],CHR(195)+REPLICATE(pLINE+CHR(197),6)+pLINE+CHR(180))
SAY(ASTRUC[1]+7,ASTRUC[2]+1,REPLICATE(pSPACES+CHR(179),6))
SAY(ASTRUC[1]+8,ASTRUC[2],CHR(195)+REPLICATE(pLINE+CHR(197),6)+pLINE+CHR(180))
SAY(ASTRUC[1]+9,ASTRUC[2]+1,REPLICATE(pSPACES+CHR(179),6))
SAY(ASTRUC[1]+10,ASTRUC[2],CHR(195)+REPLICATE(pLINE+CHR(197),6)+pLINE+CHR(180))
SAY(ASTRUC[1]+11,ASTRUC[2]+1,REPLICATE(pSPACES+CHR(179),6))
SAY(ASTRUC[1]+12,ASTRUC[2],CHR(195)+REPLICATE(pLINE+CHR(197),6)+pLINE+CHR(180))
SAY(ASTRUC[1]+13,ASTRUC[2]+1,REPLICATE(pSPACES+CHR(179),6))
SAY(ASTRUC[1]+14,ASTRUC[2],CHR(195)+REPLICATE(pLINE+CHR(197),6)+pLINE+CHR(180))
SAY(ASTRUC[1]+15,ASTRUC[2]+1,REPLICATE(pSPACES+CHR(179),6))
SAY(ASTRUC[1]+16,ASTRUC[2]+1,REPLICATE(pLINE+CHR(193),6))
SET COLOR TO "GR+/B"
DISPBOX(ASTRUC[1],ASTRUC[2],ASTRUC[1]+16,ASTRUC[2]+35,2)
@ 24,41 SAY "╚════╧════╧════╧════╧════╧════╧════╝"
SET COLOR TO "W+/B"
DISPDATES(CTOD(STR(ASTRUC[3],2)+"/01/"+RIGHT(STR(ASTRUC[4],4),2)),ASTRUC[1],ASTR
UC[2],ASTRUC[6])
DISPEND()
UNTIL EVAL(ASTRUC[7],INKEY(0),ASTRUC)
SETPOS(NROW,NCOL)
SETCOLOR(CCOLOR)
RESTSCREEN(0,0,24,79,CSCREEN)
RETURN
//--------------------------------------------------------------------------
FUNCTION CALENDARKEYS(NKEY,AARRAY,BKEYVAL)
LOCAL LRET,CSCREEN
LRET:=.F.
IF (EVAL(BKEYVAL,NKEY,AARRAY[6]))
DO CASE
CASE NKEY==-1
DISPBEGIN()
CSCREEN:=SAVESCREEN(0,0,24,79)
SCROLL(8,1,20,38)
SET COLOR TO "GR+/B"
DISPBOX(8,1,20,38,2)
SET COLOR TO "G+/B"
SAY(9,2," Πιήθηξα ιεηηνπξγηώλ Ζκεξνινγίνπ ")
SET COLOR TO "GR+/B"
SAY(10,1,"╟────────────────────────────────────╢")
SET COLOR TO "W+/B"
SAY(11,2," F2 : Απηή ε νζόλε νδεγηώλ ")
SAY(12,2," + : Aύμεζε ηεο εκεξνκελίαο ")
SAY(13,2," - : Μείσζε ηεο εκεξνκελίαο ")
SAY(14,2," Α.Βέινο : Eπόκελνο κήλαο ")
SAY(15,2," Κ.Βέινο : Πξνεγνύκελνο κήλαο ")
SAY(16,2," Home : Ο Ηαλνπάξηνο ηνπ έηνπο ")
SAY(17,2," End : Ο Γεθέκβξηνο ηνπ έηνπο ")
SAY(18,2," PageUp : 1 Eηνο κεηά,ίδηνο κήλαο ")
SAY(19,2," PageDown : 1 Δηνο πξηλ,ίδηνο κήλαο ")
DISPEND()
INKEY(0)
RESTSCREEN(0,0,24,79,CSCREEN)
CASE NKEY==ASC("+")
AARRAY[3]:=MONTH(++AARRAY[6])
AARRAY[4]:=YEAR(AARRAY[6])
CASE NKEY==ASC("-")
AARRAY[3]:=MONTH(--AARRAY[6])
AARRAY[4]:=YEAR(AARRAY[6])
CASE NKEY==5
AARRAY[4] += IF(++AARRAY[3] > 12,(AARRAY[3]:=1,1),0)
CASE NKEY==24
AARRAY[4] -= IF(--AARRAY[3] < 1,(AARRAY[3]:=12,1),0)
CASE NKEY==1
AARRAY[3]:=1
CASE NKEY==6
AARRAY[3]:=12
CASE NKEY==3
AARRAY[4]--
CASE NKEY==18
AARRAY[4]++
CASE NKEY==27
LRET:=.T.
ENDCASE
ENDIF
RETURN (LRET)
//--------------------------------------------------------------------------
PROCEDURE DISPDATES(DBEGIN,NROW,NCOL,THEDATE)
LOCAL DBEG,OFFSETCOL,OFFSETROW,NEWDATE,CCOLOR
OFFSETROW:=5
NEWDATE:=DBEGIN
CCOLOR:=SETCOLOR()
DO WHILE .T.
DBEG:=DOW(NEWDATE)
OFFSETCOL:=(5*DBEG)-4
OFFSETROW+=IF(DBEG=1,2,0)
IF THEDATE==NEWDATE
SET COLOR TO "N/W+"
ENDIF
SAY(NROW+OFFSETROW,NCOL+OFFSETCOL,DAY(NEWDATE))
SETCOLOR(CCOLOR)
UNTIL MONTH(DBEGIN) != MONTH(++NEWDATE)
RETURN
//--------------------------------------------------------------------------
FUNCTION SAYDATE(NMONTH,NYEAR)
LOCAL AMONTHS:={}
LOCAL NCOUNTER,CRET,VAR1
CRET:=""
FOR NCOUNTER:=1 TO 12
AADD(AMONTHS,CMONTH(CTOD(STR(NCOUNTER,2)+"/01/90")))
NEXT
DO CASE
CASE AMONTHS[NMONTH]="January"
VAR1="Ηαλνπάξηνο"
CASE AMONTHS[NMONTH]="February"
VAR1="Φεβξνπάξηνο"
CASE AMONTHS[NMONTH]="March"
VAR1="Μάξηηνο"
CASE AMONTHS[NMONTH]="April"
VAR1="Απξίιηνο"
CASE AMONTHS[NMONTH]="May"
VAR1="Μάηνο"
CASE AMONTHS[NMONTH]="June"
VAR1="Ηνύληνο"
CASE AMONTHS[NMONTH]="July"
VAR1="Ηνύιηνο"
CASE AMONTHS[NMONTH]="August"
VAR1="Αύγνπζηνο"
CASE AMONTHS[NMONTH]="September"
VAR1="επηέκβξηνο"
CASE AMONTHS[NMONTH]="October"
VAR1="Οθηώβξηνο"
CASE AMONTHS[NMONTH]="November"
VAR1="Ννέκβξηνο"
CASE AMONTHS[NMONTH]="December"
VAR1="Γεθέκβξηνο"
ENDCASE
CRET:=VAR1+" ηνπ "+STR(NYEAR,4)
RETURN (CRET)
//---------------------------------------------------------------------------
PROCEDURE INFO
LOCAL CHOICE,SCREEN1,FILES,ARITHMOS,STRING,MEGETHOS
SCREEN1:=SAVESCREEN(0,0,24,79)
FILES :={}
@ 8,0,24,79 BOX REPLICATE(CHR(177),9)
SET CURSOR OFF
@ 23,1 SAY " Δπηιέμηε αξρείν γηα λα δείηε ηηο γεληθέο πιεξνθνξίεο " COLOR
"BG+/B"
AEVAL(DIRECTORY("*.DBF"),{|ITEM| AADD(FILES,ITEM[1])})
SET COLOR TO "GR+/B"
WINSHADE(8,56,22,71,'ON')
SET COLOR TO "W+/B"
DO WHILE .T.
NAME1:=SPACE(12)
IF !EMPTY(CHOICE:=ACHOICE(9,58,21,69,FILES))
NAME1:=ALLTRIM(FILES[CHOICE])
ELSE
EXIT
ENDIF
USE // ΚΛΔΗΗΜΟ ΟΛΧΝ ΣΝΧ ΑΡΥΔΗΧΝ - ΚΑΗ ΣΟΤ PELATES.DBF
USE &NAME1 // ΑΝΟΗΓΜΑ ΑΡΥΔΗΟ ΓΔΓΟΜΔΝΧΝ ΚΑΣ'ΔΠΗΛΟΓΖ
MEGETHOS:=(RECSIZE()*LASTREC()+HEADER()+1)
ARITHMOS:=LASTREC()
STRING :=NAME1
@ 15,5 SAY " Γεληθέο πιεξνθνξίεο γηα ην αξρείν "+STRING+" " COLOR "BG+/B"
SET COLOR TO "GR+/B"
WINSHADE(8,5,13,48,'ON')
SET COLOR TO "W+/B"
@ 9,6 SAY " Σν αξρείν ελεκεξώζεθε γηα ηειεπηαία θνξά "
@ 10,6 SAY " ηελ "
@ 10,COL()+1 SAY HMERA()+' '+STR(DAY(LUPDATE()),2)+' '+MHNAS()+'
'+STR(YEAR(LUPDATE()),4) COLOR "G+/B"
@ 10,COL()+1 SAY "."
@ 11,6 SAY " Σν κέγεζνο ηνπ είλαη "
@ 11,COL()+1 SAY ALLTRIM(STR(MEGETHOS,10)) COLOR "G+/B"
@ 11,COL()+1 SAY " Bytes, "
@ 12,6 SAY " θαη πεξηέρεη "
@ 12,COL()+1 SAY ALLTRIM(STR(ARITHMOS,4)) COLOR "G+/B"
@ 12,COL()+1 SAY " εγγξαθέο. "
INKEY(0)
SET COLOR TO "GR+/B"
WINSHADE(17,5,20,48,'ON')
SET COLOR TO "W+/B"
@ 18,6 SAY PADC(" Θα δείηε άιιν αξρείν ή λα επηζηξέςσ; ",42) COLOR "BG+/B"
@ 19,6 SAY PADC(" (ENTER) ---> Αξρείν (ESC) ---> Δπηζηξνθή ",42)
INKEY(0)
WINSHADE(17,5,20,48,'OFF')
WINSHADE(8,5,13,48,'OFF')
@ 15,5,15,55 BOX REPLICATE(CHR(177),9)
IF LASTKEY()=27
EXIT
ENDIF
ENDDO
WINSHADE(8,56,22,71,'OFF')
RESTSCREEN(0,0,24,79,SCREEN1)
RETURN
//---------------------------------------------------------------------------
PROCEDURE SYSTEM
SET COLOR TO "GR+/B"
WINSHADE(14,4,18,68,'ON')
SET CURSOR OFF
@ 14,8 SAY "╡ Γεληθέο πιεξνθνξίεο γηα ηνλ Ζιεθηξνληθό Τπνινγηζηή ╞" COLOR
"BG+/B"
SET COLOR TO "W+/B"
@ 15,5 SAY " Ο ειεύζεξνο ρώξνο ζην θιεξό Γίζθν είλαη "
@ 15,COL()+1 SAY STR(DISKSPACE(3),11) COLOR "G+/B"
@ 15,COL()+1 SAY " Bytes. "
@ 16,5 SAY " Διεύζεξε Μλήκε RAM (Tπρ.Πξνζπέιαζεο) "
@ 16,COL()+1 SAY STR(MEMORY(0),4) COLOR "G+/B"
@ 16,COL()+1 SAY " (KB) Kilobytes. "
@ 17,5 SAY " Διεύζεξε Μλήκε γηα έμνδν ζην MS-DOS "
@ 17,COL()+1 SAY STR(MEMORY(3),4) COLOR "G+/B"
@ 17,COL()+1 SAY " (KB) Kilobytes. "
INKEY(0)
WINSHADE(14,4,18,68,'OFF')
RETURN
//--------------------------------------------------------------------------
PROCEDURE OFFCURSOR
SET CURSOR OFF
RETURN
//----------------------------------------------------------------------------
PROCEDURE HMEROMHNIA
SET COLOR TO "GR+/B"
WINSHADE(18,18,20,61,'ON')
SET COLOR TO "G+/B"
@ 19,20 SAY HMERA()+' '+STR(DAY(DATE()),2)+' '+MHNAS()+' '+STR(YEAR(DATE()),4)
@ 18,50 SAY "╤" COLOR "GR+/B"
@ 19,50 SAY "│" COLOR "GR+/B"
@ 20,50 SAY "╧" COLOR "GR+/B"
@ 19,52 SAY TIME()
RETURN
//----------------------------------------------------------------------------
PROCEDURE HMEROMHN1
FLAG22:=.F.
SET COLOR TO "GR+/B"
WINSHADE(15,18,17,61,'ON')
SET COLOR TO "G+/B"
@ 16,20 SAY HMERA()+' '+STR(DAY(DATE()),2)+' '+MHNAS()+' '+STR(YEAR(DATE()),4)
@ 15,50 SAY "╤" COLOR "GR+/B"
@ 16,50 SAY "│" COLOR "GR+/B"
@ 17,50 SAY "╧" COLOR "GR+/B"
@ 16,52 SAY TIME()
RETURN
//---------------------------------------------------------------------------
PROCEDURE HMERA
LOCAL CHOICE
IF !FLAG22
CHOICE:=CDOW(DATE())
ELSE
CHOICE:=CDOW(LUPDATE())
ENDIF
DO CASE
CASE CHOICE="Sunday"
RETURN ("Κπξηαθή")
CASE CHOICE="Monday"
RETURN ("Γεπηέξα")
CASE CHOICE="Tuesday"
RETURN ("Σξίηε")
CASE CHOICE="Wednesday"
RETURN ("Σεηάξηε")
CASE CHOICE="Thursday"
RETURN ("Πέκπηε")
CASE CHOICE="Friday"
RETURN ("Παξαζθεπή")
CASE CHOICE="Saturday"
RETURN ("άββαην")
ENDCASE
RETURN
//---------------------------------------------------------------------------
PROCEDURE MHNAS
LOCAL CHOICE1
IF !FLAG22
CHOICE1:=MONTH(DATE())
ELSE
CHOICE1:=MONTH(LUPDATE())
ENDIF
DO CASE
CASE CHOICE1=01
RETURN ("Ηαλνπαξίνπ")
CASE CHOICE1=02
RETURN ("Φεβξνπαξίνπ")
CASE CHOICE1=03
RETURN ("Μαξηίνπ")
CASE CHOICE1=04
RETURN ("Απξηιίνπ")
CASE CHOICE1=05
RETURN ("Μαίνπ")
CASE CHOICE1=06
RETURN ("Ηνπλίνπ")
CASE CHOICE1=07
RETURN ("Ηνπιίνπ")
CASE CHOICE1=08
RETURN ("Απγνύζηνπ")
CASE CHOICE1=09
RETURN ("επηεκβξίνπ")
CASE CHOICE1=10
RETURN ("Οθησβξίνπ")
CASE CHOICE1=11
RETURN ("Ννεκβξίνπ")
CASE CHOICE1=12
RETURN ("Γεθεκβξίνπ")
ENDCASE
RETURN
//---------------------------------------------------------------------------
FUNCTION KENA1()
IF EPON < '!'
ALERT(" Με δίλεηε θελά... ",{" Δπηζηξνθή "})
RETURN .F.
ENDIF
RETURN .T.
//---------------------------------------------------------------------------
FUNCTION KENA2()
IF ONOM < '!'
ALERT(" Mή δίλεηε θελά... ",{" Δπηζηξνθή "})
RETURN .F.
ENDIF
RETURN .T.
//---------------------------------------------------------------------------
FUNCTION KENA3()
IF PATR < '!'
ALERT(" Με δίλεηε θελά... ",{" Δπηζηξνθή "})
RETURN .F.
ENDIF
RETURN .T.
//--------------------------------------------------------------------------
PROCEDURE SKIA
LOCAL SCREENLINE,SHADOW
@ 24,2,24,76 BOX REPLICATE(CHR(177),9)
SCREENLINE:=SAVESCREEN(24,2,24,76)
SHADOW:=TRANSFORM(SCREENLINE,REPLICATE("X"+CHR(7),LEN(SCREENLINE)))
RESTSCREEN(24,2,24,76,SHADOW)
RETURN
//---------------------------------------------------------------------------
PROCEDURE STATHIS
LOCAL XNOTES1
XNOTES1:=SPACE(10)
USE // ΚΛΔΗΗΜΟ ΟΛΧΝ ΣΧN ΑΡΥΔΗΧΝ - ΚΑΗ ΣΟΤ PELATES.DBF
USE SHMEIVS // XΡΖΖ ΣΟΤ ΑΡΥΔΗΟΤ ΓΔΝΗΚΧΝ ΖΜΔΗΧΔΧΝ
SET CURSOR ON
@ 8,0,24,79 BOX REPLICATE(CHR(177),9)
SET COLOR TO "GR+/B"
WINSHADE(8,1,23,76,'ON')
@ 8,4 SAY "╡ Γεληθέο εκεηώζεηο ╞" COLOR "BG+/B"
SET COLOR TO "W+/B"
XNOTES1:=MemoEdit(NOTES,9,2,22,75,.T.,"WP_UDF")
REPLACE NOTES WITH XNOTES1
WINSHADE(8,1,23,76,'OFF')
SET CURSOR OFF
USE // ΚΛΔΗΗΜΟ ΣΟΤ ΑΡΥΔΗΟΤ ΓΔΝΗΚΧΝ ΖΜΔΗΧΔΧΝ
RETURN
//--------------------------------------------------------------------------
PROCEDURE PERSONAL
SET COLOR TO "BG+/B"
WINSHADE(12,9,18,70,'ON')
SET COLOR TO "W+/B"
@ 13,10 SAY PADC(" Σν πξόγξακκα ΚΑΣΑΛΟΓΟ ΔΠΑΓΓΔΛΜΑΣΗΧΝ δεκηνπξγήζεθε ",60)
@ 14,10 SAY " κε ηελ γιώζζα πξνγξακκαηηζκνύ "
@ 14,COL()+1 SAY VERSION() COLOR "BG+/B"
@ 14,COL()+1 SAY ","
@ 15,10 SAY PADC(" από ηνλ Φπζηθό ηάζε Γνπξδή. Λεπθάδα - επηέκβξηνο 1997
",60)
@ 16,10 SAY PADC(" Γηα νπνηαδήπνηε δηόξζσζε,ππόδεημε ή πιεξνθνξία, ",60)
@ 17,10 SAY PADC(" επηθνηλσλήζηε κε ην ηειέθσλν 0645-71500. ",60)
INKEY(0)
WINSHADE(12,9,18,70,'OFF')
RETURN
//----------------------------------------------------------------------------
FUNCTION WP_UDF
PARAMETERS MODE,LINE,COL
RET_VAL=0
DO CASE
CASE MODE=0
@ 24,47 SAY " ΓΡΑΜΜΖ : "+ALLTRIM(STR(LINE,IF(LINE<100,2,5),0))+" " COLOR
"G+/B"
@ 24,63 SAY " ΣΖΛΖ : "+ALLTRIM(STR(COL,2,0)) COLOR
"G+/B"
CASE NEXTKEY()=-11
RET_VAL:=K_CTRL_W
ENDCASE
RETURN RET_VAL
//---------------------------------------------------------------------------
PROCEDURE LEFT_ARROW
KEYBOARD CHR(27)+CHR(19)+CHR(13)
RETURN
//---------------------------------------------------------------------------
PROCEDURE RIGHT_ARROW
KEYBOARD CHR(27)+CHR(4)+CHR(13)
RETURN
//---------------------------------------------------------------------------
PROCEDURE LEFT1_ARROW
KEYBOARD CHR(27)+CHR(19)
RETURN
//---------------------------------------------------------------------------
PROCEDURE RIGHT1_ARROW
KEYBOARD CHR(27)+CHR(4)
RETURN
//---------------------------------------------------------------------------
Function SIndex
Parameters SField,SIndex,STitle
Private SField,SIndex,STitle
SET COLOR TO "GR+/B"
WINSHADE(15,10,21,68,'ON')
@ 15,11 SAY '╡ '+STitle+' ╞' COLOR "BG+/B"
@ 16,21 Say " Γηαδηθαζία T α μ η λ ό κ ε ζ ε ο" COLOR "W+/B"
@ 17,10 Say "╠"+Replicate("═",57)+"╣"
SET COLOR TO "W+/B"
@ 18,14 Say " Πνζνζηό Σαμηλόκεζεο (%) "
@ 19,14 Say "0 10 20 30 40 50 60 70 80 90 100"
@ 20,14 Say "░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
Index On Bar(&SField) To &SIndex
CLOSE INDEX
INKEY(0)
WINSHADE(15,10,21,68,'OFF')
RELEASE ALL
Return("")
//---------------------------------------------------------------------------
Function Bar
PARAMETERS IField,Index_Flag
PRIVATE IField,Pct
Index_Flag:=.T.
IF Index_Flag
If RecNo() < RecCount() + 1
Pct = RecNo() * 100 / RecCount()
@ 20,14 Say Replicate("▓",(Pct/2)+1) COLOR "G+/B"
EndIf
Endif
Index_Flag:=.F.
RELEASE Pct
Return (IField)
//---------------------------------------------------------------------------
PROCEDURE CALC
PRIVATE adit,mul,div,afer,t,l,v_number
SET ESCAPE ON
v_number=0
adit=0
mul=0
div=0
afer=0
t=12
l=22
@ 23,0,23,79 BOX REPLICATE(CHR(177),9)
SET COLOR TO "GR+/B"
WINSHADE(t-2,l-1,t+10,l+19,'ON')
SET COLOR TO "W+/B"
@t-1,l+1 SAY '┌───────────────┐'
@t ,l+1 SAY '│ │'
@t+1,l+1 SAY '├───┬───┬───┬───┤'
@t+2,l+1 SAY '│ 1 │ 2 │ 3 │ + │'
@t+3,l+1 SAY '├───┼───┼───┼───┤'
@t+4,l+1 SAY '│ 4 │ 5 │ 6 │ - │'
@t+5,l+1 SAY '├───┼───┼───┼───┤'
@t+6,l+1 SAY '│ 7 │ 8 │ 9 │ * │'
@t+7,l+1 SAY '├───┼───┼───┼───┤'
@t+8,l+1 SAY '│ C │ 0 │ = │ / │'
@t+9,l+1 SAY '└───┴───┴───┴───┘'
SET COLOR TO "GR+/B"
WINSHADE(18,46,21,74,'ON')
SET COLOR TO "W+/B"
@ 19,47 SAY PADC(" Mε C θαζαξίδεηε ηε κλήκε ",27) COLOR "BG+/B"
@ 20,47 SAY PADC(" Mε (ESC) ---> Δπηζηξνθή ",27) COLOR "BG+/B"
SET KEY 43 TO MAKE && +
SET KEY 42 TO MAKE && *
SET KEY 45 TO MAKE && -
SET KEY 47 TO MAKE && /
SET KEY 13 TO MAKE && ENTER
SET KEY 67 TO MAKE && C
SET KEY 99 TO MAKE && c
SET KEY 150 TO MAKE && Φ
SET KEY 175 TO MAKE && ς
DO WHILE LASTKEY()<>27
SET CURSOR ON
@T,L+3 GET V_NUMBER PICTURE '9999999999.99' COLOR "G+/B"
READ
SET CURSOR OFF
KEYBOARD(1)
ENDDO
SET KEY 43 TO && +
SET KEY 42 TO && -
SET KEY 45 TO && *
SET KEY 47 TO && /
SET KEY 13 TO && ENTER
SET KEY 67 TO && C
SET KEY 99 TO && c
SET KEY 150 TO && Φ
SET KEY 175 TO && ς
WINSHADE(18,46,21,74,'OFF')
WINSHADE(t-2,l-1,t+10,l+19,'OFF')
RELEASE adit,mul,div,afer,t,l,v_number
SET ESCAPE OFF
RETURN
//---------------------------------------------------------------------------
PROCEDURE MAKE
CLEAR GETS
DO CASE
CASE ADIT=0 .AND. MUL=0 .AND. DIV=0 .AND. AFER=0
ADIT=V_NUMBER
V_NUMBER=ADIT
DO COMP
CASE ADIT<>0
ADIT=V_NUMBER+ADIT
V_NUMBER=ADIT
DO COMP
CASE MUL<>0
MUL=MUL*V_NUMBER
V_NUMBER=MUL
DO COMP
CASE DIV<>0
DIV=DIV/V_NUMBER
V_NUMBER=DIV
DO COMP
CASE AFER<>0
AFER=AFER-V_NUMBER
V_NUMBER=AFER
DO COMP
ENDCASE
RETURN
//--------------------------------------------------------------------------
PROCEDURE COMP
DO CASE
CASE LASTKEY()=43 && +
ADIT=V_NUMBER
MUL=0
DIV=0
AFER=0
CASE LASTKEY()=42 && *
MUL=V_NUMBER
ADIT=0
DIV=0
AFER=0
CASE LASTKEY()=45 && -
AFER=V_NUMBER
ADIT=0
DIV=0
MUL=0
CASE LASTKEY()=47 && /
DIV=V_NUMBER
ADIT=0
MUL=0
AFER=0
CASE LASTKEY()=13 && <enter>
V_NUMBER=V_NUMBER
ADIT=0
AFER=0
DIV=0
MUL=0
CASE CHR(LASTKEY()) $ 'CcςΦ'
V_NUMBER=0
ADIT=0
AFER=0
DIV=0
MUL=0
ENDCASE
IF V_NUMBER>9999999999.99
SET CURSOR OFF
@t,l+2 SAY ' Δθηόο Οξίσλ ' COLOR "GR+/B"
V_NUMBER=0
ADIT=0
AFER=0
DIV=0
MUL=0
INKEY(0)
@t,l+2 SAY ' '
SET CURSOR ON
ENDIF
RETURN
//---------------------------------------------------------------------------
PROCEDURE DbStabilize(oTbr)
LOCAL nSaveRecno := recno()
oTbr:refreshAll()
DO WHILE !oTbr:stabilize()
ENDDO
DO WHILE recno() != nSaveRecno
oTbr:up()
DO WHILE !oTbr:stabilize()
ENDDO
ENDDO
RETURN
//--------------------------------------------------------------------------
FUNCTION MEMOBLOCK(nFieldNum)
RETURN {|nMode| IIF(nMode == NIL,"Memo",FIELDBLOCK(FIELD(nFieldNum)))}
//----------------------------------------------------------------------------
PROCEDURE GETIT(oTbr)
LOCAL lReadExitSet:=READEXIT(.T.),oGet,oGetCol
oGetCol:=oTbr:GetColumn(oTbr:colpos)
oGet:=GetNew(Row(),Col(),oGetCol:Block,oGetCol:Heading)
READMODAL({oGet})
oTbr:refreshCurrent()
oTbr:refreshAll()
IF LastKey()==K_UP .OR. ;
LastKey()==K_DOWN .OR. ;
LastKey()==K_PGUP .OR. ;
LastKey()==K_PGDN
KEYBOARD Chr(LastKey())
ENDIF
READEXIT(lReadExitSet)
RETURN
//---------------------------------------------------------------------------
FUNCTION Upperg
PARAMETERS String
PRIVATE Lower,Upper,i,Char,Length,Distance,Buffer
Lower = 'αβγδεδεζηθικλμνπξζηπθρςσ'
Upper = 'ΑΒΓΓΔΕΖΘΗΚΛΜΝΞΟΠΡΣΤΦΥΦΧ'
Distance = ASC('Α')-ASC('Χ')
Buffer = ''
For i=1 to LEN(TRIM(M->String))
Char = SUBSTR(M->String,M->i ,1 )
Buffer = M->Buffer + IF (M->Char >= 'α' .AND. M->Char <= 'ς' ,;
CHR(ASC(M->Char) + M->Distance),;
IF (M->Char $ M->Lower,;
SUBSTR(M->Upper,AT( M->Char,M->Lower), 1 ),M->Char))
NEXT M->i
RETURN M->Buffer +SPACE(LEN( M->String ) - M->i+1)
//---------------------------------------------------------------------------
PROCEDURE HELP
LOCAL SCREEN
SCREEN:=SAVESCREEN(0,0,24,79)
@ 1,76,24,79 BOX REPLICATE(CHR(177),9)
@ 23,0,24,79 BOX REPLICATE(CHR(177),9)
SET COLOR TO "GR+/B"
WINSHADE(1,1,22,75,'ON')
SET COLOR TO "W+/B"
FINDSTR1()
WINSHADE(1,1,22,75,'OFF')
SET CURSOR OFF
RESTSCREEN(0,0,24,79,SCREEN)
RETURN
//--------------------------------------------------------------------------
PROCEDURE FINDSTR1
LOCAL I,NEWCOL,LINES,VAR
LOCAL SCREEN2,SCREEN3,SCREEN4
MEMVAR STR,ACT,NROW,NCOL,RELROW,RELCOL
PRIVATE STR,ACT,NROW,NCOL,RELROW,RELCOL
ACT:=.T.
NROW:=1
NCOL:=0
RELROW:=0
RELCOL:=0
SET CURSOR ON
@ 1,10 SAY "╡ Οδεγίεο γηα ηηο βαζηθέο ιεηηνπξγίεο ηνπ πξνγξάκκαηνο ╞" COLOR
"BG+/B"
DO WHILE ACT
ACT:=.F.
VAR:=MEMOREAD("HELP.TXT")
SET CURSOR ON
VAR:=MEMOEDIT(VAR,2,2,21,74,.F.,"UFUNC1",,,NROW,NCOL,RELROW,RELCOL)
IF ACT
NEWCOL:=AT(ALLTRIM(STR),SUBSTR(MEMOLINE(VAR,73,NROW),NCOL+1))
IF NEWCOL !=0
NCOL:=NEWCOL-1+NCOL
RELCOL:=NCOL
SCREEN2:=SAVESCREEN(24,60,24,76)
SET COLOR TO "GR+/B"
SET CURSOR OFF
@ 24,60 SAY " Βξέζεθε "
INKEY(0.5)
SET COLOR TO "W+/B"
SET CURSOR ON
RESTSCREEN(24,60,24,76,SCREEN2)
ELSE
LINES:=MLCOUNT(VAR,73)
NEWCOL:=0
I:=NROW+1
DO WHILE NEWCOL==0 .AND. I <= LINES
NEWCOL:=AT(ALLTRIM(STR),MEMOLINE(VAR,73,I))
IF NEWCOL==0
I:=I+1
ENDIF
ENDDO
IF NEWCOL !=0
NCOL:=NEWCOL-1
RELCOL:=NCOL
NROW:=I
RELROW:=(I-1)%14
SCREEN3:=SAVESCREEN(24,60,24,76)
SET COLOR TO "GR+/B"
SET CURSOR OFF
@ 24,60 SAY " Βξέζεθε "
INKEY(0.5)
SET COLOR TO "W+/B"
SET CURSOR ON
RESTSCREEN(24,60,24,76,SCREEN3)
ELSE
SCREEN4:=SAVESCREEN(24,60,24,76)
SET COLOR TO "GR+/B"
SET CURSOR OFF
@ 24,60 SAY " Γελ βξέζεθε "
INKEY(0.5)
SET COLOR TO "W+/B"
SET CURSOR ON
RESTSCREEN(24,60,24,76,SCREEN4)
ENDIF
ENDIF
ENDIF
ENDDO
SET CURSOR OFF
RELEASE ALL
RETURN
//----------------------------------------------------------------------------
FUNCTION UFUNC1(NMODE,NLINE,NCOL1)
MEMVAR NROW,NCOL,RELROW,RELCOL,ACT,STR
LOCAL RETVAL,SAVELINE
LOCAL GETLIST:={}
STR:=SPACE(10)
IF NMODE==ME_INIT
RETVAL:=ME_DEFAULT
ELSEIF LASTKEY()==K_ALT_S
NROW:=NLINE
NCOL:=NCOL1
RELROW:=ROW()-2
RELCOL:=COL()-2
SAVELINE:=SAVESCREEN(24,2,24,35)
SET COLOR TO "G+/B"
@ 24,2 SAY " Αλαδήηεζε γηα: " GET STR
READ
SET COLOR TO "W+/B"
RETVAL:=K_CTRL_W
ACT:=.T.
RESTSCREEN(24,2,24,35,SAVELINE)
ELSE
RETVAL:=ME_DEFAULT
ENDIF
RETURN RETVAL
//--------------------------------------------------------------------------
PROCEDURE ANDREAS
SET COLOR TO "GR+/B"
WINSHADE(14,18,16,62,'ON')
SET COLOR TO "W+/B"
SET CURSOR OFF
@ 15,19 SAY " Aληξέα,είζαη θαη ν πξώηνο,λα πνύκε...!!! " COLOR "*BG+/B"
INKEY(0)
WINSHADE(14,18,16,62,'OFF')
RETURN