bb.donnay-software.com

Donnay Software Web Forums
http://donnay-software.com/DONNAY/

I can not make browsing base with advance unknown speakers

http://donnay-software.com/DONNAY/viewtopic.php?f=2&t=1380

Page 1 of 2

I can not make browsing base with advance unknown speakers

Posted: Mon Jan 05, 2015 5:49 am
by Eugene Lutsenko
I want to make a simple database view:

Image

The truth is not quite easy viewing. Cls#a columns may be a different number, as well as columns Att#. And I want to make to the top of the column names were viewing.

I use this program:

Code: Select all

FUNCTION F2_4()

LOCAL GetList := {}, GetOptions, oEventsKO, bItems

IF M_KodAdmAppls = 0  // Выйти из системы если нет авторизации
   LB_Warning("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")
   RETURN NIL
ENDIF

IF ApplChange("2_4")              // Если не запущен режим, работающий с БД,  то перейти в папку выбранного приложения
   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************
   RETURN NIL
ENDIF

IF .NOT.FILE("EventsKO.dbf")          // БД подробных сжатых результатов распознавания: Rsp_it.dbf
   LB_Warning("Необходимо выполнить синтез и верфикацию моделей в режиме 3.5 !!!")
   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************
   RETURN NIL
ENDIF

CLOSE ALL
USE EventsKO   EXCLUSIVE NEW;N_Col = FCOUNT()-2
USE Classes    EXCLUSIVE NEW;N_Cls = RECCOUNT()
USE Attributes EXCLUSIVE NEW;N_Atr = RECCOUNT()

/* ----- Create browse ----- */

SET TAG TO COMMAND

PRIVATE aHeadName[N_Col]

aHeadName[1] = "Наименование объекта;обучающей выборки"

// 3. Заполнять строки заголовков целыми словами до тех пор, пока не превышена макс.ширина заголовка

SELECT Classes

DL = 12                 // Ширина заголовка в кол-ве символов
Max_HeadLines = -999999999

FOR j=1 TO N_Cls

    DBGOTO(j)
    M_NameCls = ALLTRIM(Name_cls)

    aHeadString := {}   // Массив строк заголовка j-й колонки

    AADD(aHeadString, ALLTRIM(STR(j,19))+". ")   // Код класса

    *** Начало цикла по словам
    FOR w=1 TO NUMTOKEN(M_NameCls," ")           // Разделитель между словами - пробел
        M_Word = UPPER(TOKEN(M_NameCls," ",w))
        IF LEN(aHeadString[LEN(aHeadString)]+" "+M_Word) <= DL
           // Если после добавления слова к строке заголовка ее ширина меньше заданной,
           // то добавлять слово к этой же строке заголовка
           aHeadString[LEN(aHeadString)] = aHeadString[LEN(aHeadString)]+" "+M_Word
        ELSE
           // Если после добавления слова к строке заголовка ее ширина больше заданной,
           // то делать новую строку (";") и к ней добавлять слово
           AADD(aHeadString, ";"+M_Word)
        ENDIF
    NEXT
    // Переписать строки заголовка в массив наименований колонок
    aHeadName[1+j] = ""
    FOR s=1 TO LEN(aHeadString)
        aHeadName[1+j] = aHeadName[1+j] + aHeadString[s]
    NEXT
    Max_HeadLines = MAX(Max_HeadLines,LEN(aHeadString))   // Определение максимального количества строк в заголовке
NEXT

SELECT Attributes

FOR j=1 TO N_Atr

    DBGOTO(j)
    M_NameAtr = ALLTRIM(Name_atr)

    aHeadString := {}   // Массив строк заголовка j-й колонки

    AADD(aHeadString, ALLTRIM(STR(j,19))+". ")   // Код класса

    *** Начало цикла по словам
    FOR w=1 TO NUMTOKEN(M_NameAtr," ")           // Разделитель между словами - пробел
        M_Word = UPPER(TOKEN(M_NameAtr," ",w))
        IF LEN(aHeadString[LEN(aHeadString)]+" "+M_Word) <= DL
           // Если после добавления слова к строке заголовка ее ширина меньше заданной,
           // то добавлять слово к этой же строке заголовка
           aHeadString[LEN(aHeadString)] = aHeadString[LEN(aHeadString)]+" "+M_Word
        ELSE
           // Если после добавления слова к строке заголовка ее ширина больше заданной,
           // то делать новую строку (";") и к ней добавлять слово
           AADD(aHeadString, ";"+M_Word)
        ENDIF
    NEXT
    // Переписать строки заголовка в массив наименований колонок
    aHeadName[1+N_Cls+j] = ""
    FOR s=1 TO LEN(aHeadString)
        aHeadName[1+N_Cls+j] = aHeadName[1+N_Cls+j] + aHeadString[s]
    NEXT
    Max_HeadLines = MAX(Max_HeadLines,LEN(aHeadString))   // Определение максимального количества строк в заголовке
NEXT

SELECT EventsKO

DCSETPARENT TO

@ 5, 0 DCBROWSE oEventsKO ALIAS 'EventsKO' SIZE 132,22 ;
       PRESENTATION DC_BrowPres() ;           // Только просмотр БД
       NOSOFTTRACK ;
       HEADLINES Max_HeadLines ;              // Кол-во строк в заголовке (перенос строки - ";")
       SCOPE ;
       ITEMMARKED bItems

DCSETPARENT oEventsKO
DCBROWSECOL FIELD EventsKO->Name_Obj HEADER aHeadName[1] PARENT oEventsKO WIDTH 24

*** Подарок от Роджера
FOR j=2 TO N_Col
    DCBROWSECOL DATA FieldAnchor(j,DL,3) HEADER aHeadName[j] PARENT oEventsKO FONT "9.Courier"
NEXT

DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE

cTitle = '2.4. Просмотр эвентологических баз данных (баз событий)'+'. Текущая модель: "'+UPPER(Ar_Model[M_CurrInf])+'"'

DCREAD GUI ;
   FIT ;
   OPTIONS GetOptions ;
   MODAL ;
   TITLE cTitle ;
   EVAL {|o|SetAppFocus(oEventsKO:GetColumn(1))}

   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************

RETURN NIL
[/size]

However, when this function is called an error:

Image

Another function is used, which gave Roger:

Code: Select all

******* Подарок от Роджера (исходный вариант)
*STATIC FUNCTION FieldAnchor( j )
*RETURN {|x|x:=FIELDGET(j), IIF(Empty(x),'',Str(x,8,3))}

****** Подарок от Роджера (вариант с заданием размера поля и кол-ва десятичных знаков, в т.ч. если их 0 - то выводится как целое)
STATIC FUNCTION FieldAnchor( j , mFSize, mFDeci)
IF mFDeci > 0
   RETURN {|x|x:=FIELDGET(j), IIF(Empty(x),'',Str(x,mFSize,mFDeci))}
ELSE
   RETURN {|x|x:=FIELDGET(j), IIF(Empty(x),'',Str(x,mFSize))}
ENDIF
RETURN NIL
[/size]

Re: I can not make browsing base with advance unknown speake

Posted: Mon Jan 05, 2015 8:40 am
by rdonnay
This is not enough information.

Which line in your source is causing the error?

Re: I can not make browsing base with advance unknown speake

Posted: Mon Jan 05, 2015 9:39 am
by Eugene Lutsenko
I am glad to talk with you, Roger !!!

That's the whole point, that the error window indicates the line that generally has no relation to the executed function or functions, it uses ... If it really points to a string with an error I would have guessed it would be easier to what's the matter, and maybe I would not have asked about it here on the forum.

Just need a view (without editing) database, which is not known beforehand how many columns and it is unknown what the names of these columns. But this information is, in the names of other databases.

Re: I can not make browsing base with advance unknown speake

Posted: Mon Jan 05, 2015 10:23 am
by rdonnay
The error windows states that the error occurred at line 2398.

What is that line of code?

Re: I can not make browsing base with advance unknown speake

Posted: Mon Jan 05, 2015 1:52 pm
by Eugene Lutsenko
This line refers to a completely different functions with function F2_4() is not connected. It surprises me and seems very strange. I am so not previously encountered. Line in 2398 - is ENDIF, bold and underlined.

FUNCTION F2_1()

LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions

IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации
LB_Warning("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")
RETURN NIL
ENDIF

IF ApplChange("2.1()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения
**************************************************************
***** БД, открытые перед запуском главного меню
***** Восстанавливать их после выхода из функций главного меню
**************************************************************
CLOSE ALL
DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
USE PathGrAp EXCLUSIVE NEW
USE Appls EXCLUSIVE NEW
USE Users EXCLUSIVE NEW
** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
IF FILE('_CloseFunct.txt')
ERASE('_CloseFunct.txt')
ENDIF
**************************************************************
RETURN NIL
ENDIF

IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей
M_CurrInf = DC_ARestore("_CurrInf.arx")
ELSE
DC_ASave(M_CurrInf, "_CurrInf.arx")
ENDIF

Flag_Classes = .T.
Flag_ClassSc = .T.
Flag_GrClSc = .T.

IF .NOT. FILE("Class_Sc.dbf") // БД класс.шкал: Class_Sc.dbf
Flag_ClassSc = .F.
GenDbfClSc(.F.)
ENDIF
IF .NOT. FILE("Gr_ClSc.dbf") // БД градаций класс.шкал: Gr_ClSc.dbf
Flag_GrClSc = .F.
GenDbfGrClSc(.F.)
ENDIF
IF .NOT. FILE("Classes.dbf") // БД градаций класс.шкал + градаций класс.шкал: Classes.dbf
Flag_Classes = .F.
GenDbfClass(.F.)
ENDIF

aStructure := { { "Rang" , "N", 8, 0 }, ;
{ "Kod_min" , "N", 8, 0 }, ;
{ "Kod_max" , "N", 8, 0 } }
DbCreate( 'aKodCls', aStructure )

CLOSE ALL
USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT()
USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT()
USE Gr_ClSc EXCLUSIVE NEW;N_GrClSc = RECCOUNT()
USE aKodCls EXCLUSIVE NEW;ZAP

IF N_ClSc * N_GrClSc = 0 .AND. N_Cls > 0
Flag_Classes = .T.
Flag_ClassSc = .F.
Flag_GrClSc = .F.
ENDIF

// Нет БД Class_Sc и Gr_ClSc: однооконный интерфейс, в котором задать и сформировать класс.шкалы и градации
IF Flag_Classes = .T. .AND.;
Flag_ClassSc = .F. .AND.;
Flag_GrClSc = .F.

Mess := {}
AADD(Mess, 'В текущем приложении нет баз данных классификационных шкал и градаций: "Class_Sc", "Gr_ClSc"!')
AADD(Mess, 'Необходимо вручную задать КОДЫ классиф.шкал и нажать кнопку: "Создать класс.шкалы и градации"')
LB_Warning(Mess)

F2_1win1()

ENDIF

// Все нормально, двухоконный интерфейс, аналогичный 2.2() *****************************
IF Flag_Classes = .T. .AND.;
Flag_ClassSc = .T. .AND.;
Flag_GrClSc = .T.

F2_1win2()

ENDIF

// Все нормально, двухоконный интерфейс, аналогичный 2.2() *****************************
IF Flag_Classes = .F. .AND.;
Flag_ClassSc = .F. .AND.;
Flag_GrClSc = .F.

F2_1win2()

ENDIF

* CLOSE ALL
* DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
* PUBLIC aSaveMainM := DC_ARestore("_SaveMainM.arx") // Восстановление вычислительной среды (открытые и текущие БД и индексы) с диска
* DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
* ERASE('_CloseFunct.txt')

**************************************************************
***** БД, открытые перед запуском главного меню
***** Восстанавливать их после выхода из функций главного меню
**************************************************************
CLOSE ALL
DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
USE PathGrAp EXCLUSIVE NEW
USE Appls EXCLUSIVE NEW
USE Users EXCLUSIVE NEW
** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
IF FILE('_CloseFunct.txt')
ERASE('_CloseFunct.txt')
ENDIF
**************************************************************

ReTURN nil


Code: Select all

****************************************************************************************
********  2.1. Классификационные шкалы и градации
****************************************************************************************
FUNCTION F2_1()

LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions

IF M_KodAdmAppls = 0    // Выйти из системы если нет авторизации
   LB_Warning("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")
   RETURN NIL
ENDIF

IF ApplChange("2.1()")              // Если не запущен режим, работающий с БД,  то перейти в папку выбранного приложения
   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************
   RETURN NIL
ENDIF

IF FILE("_CurrInf.arx")             // Файл с информацией о том, какая модель задана текущей
   M_CurrInf = DC_ARestore("_CurrInf.arx")
ELSE
   DC_ASave(M_CurrInf, "_CurrInf.arx")
ENDIF

Flag_Classes = .T.
Flag_ClassSc = .T.
Flag_GrClSc  = .T.

IF .NOT. FILE("Class_Sc.dbf")          // БД класс.шкал: Class_Sc.dbf
   Flag_ClassSc = .F.
   GenDbfClSc(.F.)
ENDIF
IF .NOT. FILE("Gr_ClSc.dbf")           // БД градаций класс.шкал: Gr_ClSc.dbf
   Flag_GrClSc  = .F.
   GenDbfGrClSc(.F.)
ENDIF
IF .NOT. FILE("Classes.dbf")           // БД градаций класс.шкал + градаций класс.шкал: Classes.dbf
   Flag_Classes = .F.
   GenDbfClass(.F.)
ENDIF

aStructure := { { "Rang"      , "N",  8, 0 }, ;
                { "Kod_min"   , "N",  8, 0 }, ;
                { "Kod_max"   , "N",  8, 0 }  }
DbCreate( 'aKodCls', aStructure )

CLOSE ALL
USE Classes   EXCLUSIVE NEW;N_Cls    = RECCOUNT()
USE Class_Sc  EXCLUSIVE NEW;N_ClSc   = RECCOUNT()
USE Gr_ClSc   EXCLUSIVE NEW;N_GrClSc = RECCOUNT()
USE aKodCls   EXCLUSIVE NEW;ZAP

IF N_ClSc * N_GrClSc = 0 .AND. N_Cls > 0
   Flag_Classes = .T.
   Flag_ClassSc = .F.
   Flag_GrClSc  = .F.
ENDIF

// Нет БД Class_Sc и Gr_ClSc: однооконный интерфейс, в котором задать и сформировать класс.шкалы и градации
IF Flag_Classes = .T. .AND.;
   Flag_ClassSc = .F. .AND.;
   Flag_GrClSc  = .F.

   Mess := {}
   AADD(Mess, 'В текущем приложении нет баз данных классификационных шкал и градаций: "Class_Sc", "Gr_ClSc"!')
   AADD(Mess, 'Необходимо вручную задать КОДЫ классиф.шкал и нажать кнопку: "Создать класс.шкалы и градации"')
   LB_Warning(Mess)

   F2_1win1()

ENDIF

// Все нормально, двухоконный интерфейс, аналогичный 2.2() *****************************
IF Flag_Classes = .T. .AND.;
   Flag_ClassSc = .T. .AND.;
   Flag_GrClSc  = .T.

   F2_1win2()

ENDIF

// Все нормально, двухоконный интерфейс, аналогичный 2.2() *****************************
IF Flag_Classes = .F. .AND.;
   Flag_ClassSc = .F. .AND.;
   Flag_GrClSc  = .F.

   F2_1win2()

ENDIF

*  CLOSE ALL
*  DIRCHANGE(Disk_dir)   // Перейти в папку с исполнимым модулем системы
*  PUBLIC aSaveMainM := DC_ARestore("_SaveMainM.arx")  // Восстановление вычислительной среды (открытые и текущие БД и индексы) с диска
*  DC_DataRest( aSaveMainM )    // Восстановление вычислительной среды (открытые и текущие БД и индексы)
*  ERASE('_CloseFunct.txt')

   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************

ReTURN nil
[/size]

Re: I can not make browsing base with advance unknown speake

Posted: Tue Jan 06, 2015 7:36 am
by rdonnay
Is it possible to give me some code that will compile and run?

Re: I can not make browsing base with advance unknown speake

Posted: Tue Jan 06, 2015 10:35 am
by Eugene Lutsenko
Of course, it is possible:

http://lc.kubagro.ru/Roger_all.exe

You can expand the archive and launch a file: _aidos-x.exe. Name = 1, password = 1. Immediately run mode and 2.4, this error occurs. The file _AIDOS-X.PRG a feature that can be found in context: F2_4 ().

Compile and link I do with the file:

Code: Select all

CLS
ARC _Aidos.arc
XPP %1
ALINK %1 _Aidos.res /PM:PM
cl _aidos-x > err.txt

Re: I can not make browsing base with advance unknown speake

Posted: Tue Jan 06, 2015 6:35 pm
by rdonnay
Total Files Listed:
1748 File(s) 581,476,303 bytes
116 Dir(s) 149,070,626,816 bytes free


Are you saying that you could not give me a sample program that didn't consist of 1748 files, 116 directories and 581 mb?

I don't know what to say. :eusa-naughty:

Re: I can not make browsing base with advance unknown speake

Posted: Tue Jan 06, 2015 10:57 pm
by Eugene Lutsenko
Thank you, Roger!
Sometimes you help not only as a programmer with a wealth of experience, but also as a person who can instruct on the right path. After your message, I just got another look at the source code and saw a lot of inaccuracies. How could I do such a thing - to understand. But when I corrected them, all work fine. And it took about 10 minutes (in the morning).

True, I did not understand why the error performance showed in another place, in a line that does not have anything to do with. I had not had meetings so. Maybe it's due to the fact that the prog Amma about 70,000 lines?

PS
And how to make the column names contain characters "CLS" is displayed on the background of a given color?


Image

Code: Select all

*********************************************************************************************************
********  2.4. Просмотр эвентологических баз данных (баз событий), в которых исходные данные закодированы
********       с помощью классификационных и описательных шкал и градаций и представлены в форме кодов
********       событий, между которыми существуют причинно-следственные связи
*********************************************************************************************************
FUNCTION F2_4()

LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions, oEventsKO, bItems

IF M_KodAdmAppls = 0  // Выйти из системы если нет авторизации
   LB_Warning("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")
   RETURN NIL
ENDIF

IF ApplChange("2_4()")              // Если не запущен режим, работающий с БД,  то перейти в папку выбранного приложения
   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************
   RETURN NIL
ENDIF

IF .NOT.FILE("EventsKO.dbf")          // БД подробных сжатых результатов распознавания: Rsp_it.dbf
   LB_Warning("Необходимо выполнить синтез и верфикацию моделей в режиме 3.5 !!!")
   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************
   RETURN NIL
ENDIF

CLOSE ALL
USE EventsKO EXCLUSIVE NEW
USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT()
USE Opis_Sc  EXCLUSIVE NEW;N_OpSc = RECCOUNT()

/* ----- Create browse ----- */

SET TAG TO COMMAND

PRIVATE aHeadName[1+N_ClSc+N_OpSc], aDL[1+N_ClSc+N_OpSc]

aHeadName[1] = "Наименование объекта;обучающей выборки"

// 3. Заполнять строки заголовков целыми словами до тех пор, пока не превышена макс.ширина заголовка

****** ФОРМИРОВАНИЕ ЗАГОЛОВКОВ

SELECT Class_Sc

// Определение ширины заголовка в кол-ве символов DL = длина наиболее длинного слова

AFILL(aDL, -99999999999)

FOR j=1 TO N_ClSc
    DBGOTO(j)
    M_NameClSc = ALLTRIM(Name_ClSc)
    FOR w=1 TO NUMTOKEN(M_NameClSc," ")           // Разделитель между словами - пробел
        M_Word = UPPER(TOKEN(M_NameClSc," ",w))
        IF aDL[1+j] < LEN(M_Word)
           aDL[1+j] = LEN(M_Word)
        ENDIF
    NEXT
NEXT

Max_HeadLines = -999999999

FOR j=1 TO N_ClSc

    DBGOTO(j)
    M_NameClSc = ALLTRIM(Name_ClSc)

    aHeadString := {}   // Массив строк заголовка j-й колонки

    AADD(aHeadString, ALLTRIM(STR(j,19))+". ")   // Код класса

    *** Начало цикла по словам
    FOR w=1 TO NUMTOKEN(M_NameClSc," ")           // Разделитель между словами - пробел
        M_Word = UPPER(TOKEN(M_NameClSc," ",w))
        IF LEN(aHeadString[LEN(aHeadString)]+" "+M_Word) <= aDL[1+j]
           // Если после добавления слова к строке заголовка ее ширина меньше заданной,
           // то добавлять слово к этой же строке заголовка
           aHeadString[LEN(aHeadString)] = aHeadString[LEN(aHeadString)]+" "+M_Word
        ELSE
           // Если после добавления слова к строке заголовка ее ширина больше заданной,
           // то делать новую строку (";") и к ней добавлять слово
           AADD(aHeadString, ";"+M_Word)
        ENDIF
    NEXT
    // Переписать строки заголовка в массив наименований колонок
    aHeadName[1+j] = ""
    FOR s=1 TO LEN(aHeadString)
        aHeadName[1+j] = aHeadName[1+j] + aHeadString[s]
    NEXT
    Max_HeadLines = MAX(Max_HeadLines,LEN(aHeadString))   // Определение максимального количества строк в заголовке
NEXT

SELECT Opis_Sc

// Определение ширины заголовка в кол-ве символов DL = длина наиболее длинного слова

FOR j=1 TO N_OpSc
    DBGOTO(j)
    M_NameOpSc = ALLTRIM(Name_OpSc)
    FOR w=1 TO NUMTOKEN(M_NameOpSc," ")           // Разделитель между словами - пробел
        M_Word = UPPER(TOKEN(M_NameOpSc," ",w))
        IF aDL[1+N_ClSc+j] < LEN(M_Word)
           aDL[1+N_ClSc+j] = LEN(M_Word)
        ENDIF
    NEXT
NEXT

FOR j=1 TO N_OpSc

    DBGOTO(j)
    M_NameOpSc = ALLTRIM(Name_OpSc)

    aHeadString := {}   // Массив строк заголовка j-й колонки

    AADD(aHeadString, ALLTRIM(STR(j,19))+". ")   // Код признака

    *** Начало цикла по словам
    FOR w=1 TO NUMTOKEN(M_NameOpSc," ")           // Разделитель между словами - пробел
        M_Word = UPPER(TOKEN(M_NameOpSc," ",w))
        IF LEN(aHeadString[LEN(aHeadString)]+" "+M_Word) <= aDL[1+N_ClSc+j]
           // Если после добавления слова к строке заголовка ее ширина меньше заданной,
           // то добавлять слово к этой же строке заголовка
           aHeadString[LEN(aHeadString)] = aHeadString[LEN(aHeadString)]+" "+M_Word
        ELSE
           // Если после добавления слова к строке заголовка ее ширина больше заданной,
           // то делать новую строку (";") и к ней добавлять слово
           AADD(aHeadString, ";"+M_Word)
        ENDIF
    NEXT
    // Переписать строки заголовка в массив наименований колонок
    aHeadName[1+N_ClSc+j] = ""
    FOR s=1 TO LEN(aHeadString)
        aHeadName[1+N_ClSc+j] = aHeadName[1+N_ClSc+j] + aHeadString[s]
    NEXT
    Max_HeadLines = MAX(Max_HeadLines,LEN(aHeadString))   // Определение максимального количества строк в заголовке
NEXT

SELECT EventsKO

DCSETPARENT TO

@ 5, 0 DCBROWSE oEventsKO ALIAS 'EventsKO' SIZE 132,22 ;
       PRESENTATION DC_BrowPres() ;           // Только просмотр БД
       NOSOFTTRACK ;
       HEADLINES Max_HeadLines ;              // Кол-во строк в заголовке (перенос строки - ";")
       SCOPE ;
       ITEMMARKED bItems

DCSETPARENT oEventsKO
DCBROWSECOL FIELD EventsKO->Name_Obj HEADER aHeadName[1] PARENT oEventsKO WIDTH 24 FOOTER ALLTRIM(STR(1))

*** Подарок от Роджера

FOR j=2 TO 1+N_ClSc+N_OpSc
    DCBROWSECOL DATA FieldAnchor(j,aDL[j],0) HEADER aHeadName[j] PARENT oEventsKO WIDTH aDL[j]+1 FONT "9.Courier" FOOTER ALLTRIM(STR(j))
NEXT


DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE

cTitle = '2.4. Просмотр эвентологических баз данных (баз событий)'+'. Текущая модель: "'+UPPER(Ar_Model[M_CurrInf])+'"'

DCREAD GUI ;
   FIT ;
   OPTIONS GetOptions ;
   MODAL ;
   TITLE cTitle ;
   EVAL {|o|SetAppFocus(oEventsKO:GetColumn(1))}

   **************************************************************
   ***** БД, открытые перед запуском главного меню
   ***** Восстанавливать их после выхода из функций главного меню
   **************************************************************
   CLOSE ALL
   DIRCHANGE(Disk_dir)                          // Перейти в папку с исполнимым модулем системы
   USE PathGrAp EXCLUSIVE NEW
   USE Appls    EXCLUSIVE NEW
   USE Users    EXCLUSIVE NEW
   ** Если в папке с исполнимым модулем системы есть файл: _CloseFunct.txt, то удалить его
   IF FILE('_CloseFunct.txt')
      ERASE('_CloseFunct.txt')
   ENDIF
   **************************************************************

RETURN NIL
[/size]

Re: I can not make browsing base with advance unknown speake

Posted: Wed Jan 07, 2015 7:48 am
by rdonnay
And how to make the column names contain characters "CLS" is displayed on the background of a given color?
Are you talking about "CLS" in the headings of the columns or in the data cells.
All times are UTC-07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited