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
However, when this function is called an error:
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
