Земля планета              Об авторе сайта                                                             Статистика, картография и ГИС!


             Комментарии


Программа
*Прототип
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                                     

Сайт управляется системой uCoz