Комментарии |
Программа *Прототип PROCEDURE Determin SET TALK OFF SELECT 1 USE ? namen = DBF(1) ALTER TABLE &namen ADD COLUMN one N(1) ALTER TABLE &namen ADD COLUMN two N(2) ALTER TABLE &namen ADD COLUMN three N(3) ALTER TABLE &namen ADD COLUMN four N(4) ALTER TABLE &namen ADD COLUMN summas N(8,2) GO TOP DIMENSION A(4,2) DO WHILE !EOF() REPL summas WITH kl1+kl2+kl3+kl4+kl5 FOR J = 1 TO 5 A(J,1)=EVAL(FIELD(2+J)) A(J,2)=FIELD(2+J) ENDFOR =ASORT(A,1,-1,1) TXT="" FOR ii = 1 TO 5 TXT=TXT+A[ii,2] ENDFOR TXT1 = STRTRAN(TXT,"KL", "") REPL one WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,1))) REPL two WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,2))) REPL three WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,3))) REPL four WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,4))) SKIP ENDDO BROWSE CLOSE ALL *Сортровка, классификация и спектры PROCEDURE classSpectr SET TALK OFF CLEAR IF ALLTRIM(DBF(1))=="" DEFINE POPUP obj_fil PROMPT FILES LIKE *.DBF; MESSAGE "ÂÛÁÐÀÒÜ ÔÀÉË ÄËß ÐÀÑ×ÅÒÀ ÏÎÊÀÇÀÒÅËÅÉ"; TITLE "ÂÛÁÐÀÒÜ ÔÀÉË ÄËß ÐÀÑ×ÅÒÀ ÏÎÊÀÇÀÒÅËÅÉ" ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil ACTIVATE POPUP obj_fil SELECT 1 USE PROMPT() NOUPDATE ENDIF SELECT 1 *Use ? vorname = DBF(1) vorname = SUBSTR(vorname,1,LEN(vorname)-4) imia = "S" viv_file =vorname+ALLTRIM(imia)+'.dbf' COPY TO &viv_file AS 1251 USE &viv_file namen = DBF(1) summel = "" beg = f_fiel() ende = FCOUNT() FOR i= beg TO ende one = "f"+ ALLTRIM(STR(i-beg + 1)) ALTER TABLE &namen ADD COLUMN &one N(i-beg + 1) ENDFOR ALTER TABLE &namen ADD COLUMN summas N(8,2) ALTER TABLE DBF(1) ADD COLUMN "Spectr" C(200) GO TOP DIMENSION A(ende - beg + 1,3) DO WHILE !EOF() FOR J = 1 TO ende - beg + 1 A(J,1)=EVAL(FIELD(beg+J-1)) A(J,2)=FIELD(beg+J-1) A(J,3)=beg+J-1 ENDFOR =ASORT(A,1,-1,1) TXT="" TXT1="" TXT2="" FOR ii = 1 TO ende - beg + 1 TXT=TXT+A[ii,2] TXT1=TXT1+ALLTRIM(STR(A[ii,3])) one = "f"+ ALLTRIM(STR(ii)) REPL &one WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,ii))) TXT2=TXT2+A[ii,2]+" " + STR(A[ii,1],4,1)+" " ENDFOR REPL spectr WITH TXT2 SKIP ENDDO CALC MAX(LEN(ALLTRIM(spectr))) TO dlsp ALTER TABLE DBF(1) ALTER COLUMN "Spectr" C(dlsp) BROWSE *Вызов первого поля PROCEDURE f_fiel DEFINE POPUP obj_fil PROMPT STRUCTURE; MESSAGE "ÂÛÁÐÀÒÜ ÏÅÐÂÛÉ ÝËÅÌÅÍÒ ÄËß ÐÀÑ×ÅÒÀ"; TITLE "ÂÛÁÐÀÒÜ ÏÅÐÂÛÉ ÝËÅÌÅÍÒ ÄËß ÐÀÑ×ÅÒÀ" ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil ACTIVATE POPUP obj_fil beginn = 1 DO WHILE beginn < FCOUNT() IF ALLTRIM(UPPER(FIELD(beginn)))==ALLTRIM(UPPER(PROMPT())) EXIT ELSE beginn = beginn + 1 ENDIF ENDDO RETURN beginn На главную страницу |
brusmann@mail.ru AbacusComp@yandex.ru © Василий Брусницын. Ивдель-Екатеринбург, 2010 г. Св. обл. Мотив +79045490809 |