Code: Select all
/* ----- Create ToolBar ----- */
@ 28.5, 0 DCTOOLBAR oToolBar SIZE 133, 1.5
K=4.15
DCADDBUTTON CAPTION 'Помощь' ;
SIZE K+LEN("Помощь") ;
ACTION {||Help4_2_1(), DC_GetRefresh(GetList)} ;
PARENT oToolBar ;
TOOLTIP 'Помощь по режиму 4.2.1'
DCADDBUTTON CAPTION Ar_Model[1] ;
SIZE K+LEN(Ar_Model[1]) ;
ACTION {||InfPortCls1(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[1]
DCADDBUTTON CAPTION Ar_Model[2] ;
SIZE K+LEN(Ar_Model[2]) ;
ACTION {||InfPortCls2(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[2]
DCADDBUTTON CAPTION Ar_Model[3] ;
SIZE K+LEN(Ar_Model[3]) ;
ACTION {||InfPortCls3(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[3]
DCADDBUTTON CAPTION Ar_Model[4] ;
SIZE K+LEN(Ar_Model[4]) ;
ACTION {||InfPortCls4(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[4]
DCADDBUTTON CAPTION Ar_Model[5] ;
SIZE K+LEN(Ar_Model[5]) ;
ACTION {||InfPortCls5(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[5]
DCADDBUTTON CAPTION Ar_Model[6] ;
SIZE K+LEN(Ar_Model[6]) ;
ACTION {||InfPortCls6(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[6]
DCADDBUTTON CAPTION Ar_Model[7] ;
SIZE K+LEN(Ar_Model[7]) ;
ACTION {||InfPortCls7(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[7]
DCADDBUTTON CAPTION Ar_Model[8] ;
SIZE K+LEN(Ar_Model[8]) ;
ACTION {||InfPortCls8(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[8]
DCADDBUTTON CAPTION Ar_Model[9] ;
SIZE K+LEN(Ar_Model[9]) ;
ACTION {||InfPortCls9(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[9]
DCADDBUTTON CAPTION Ar_Model[10] ;
SIZE K+LEN(Ar_Model[10]) ;
ACTION {||InfPortCls10(), DC_GetRefresh(GetList)};
PARENT oToolBar ;
TOOLTIP 'Генерация информационного портрета в модели: '+Ar_Model[10]
DCADDBUTTON CAPTION 'MS Excel' ;
SIZE K+LEN("MS Excel") ;
ACTION {||Help4_2_1(), DC_GetRefresh(GetList)} ;
PARENT oToolBar ;
TOOLTIP 'Экспорт инф.портрета в MS Excel'
DCADDBUTTON CAPTION 'MS Word' ;
SIZE K+LEN("MS Word") ;
ACTION {||Help4_2_1(), DC_GetRefresh(GetList)} ;
PARENT oToolBar ;
TOOLTIP 'Экспорт инф.портрета в MS Word'
DCADDBUTTON CAPTION 'МультиРежим' ;
SIZE K+LEN("МультиРежим") ;
ACTION {||Help4_2_1(), DC_GetRefresh(GetList)} ;
PARENT oToolBar ;
TOOLTIP 'Задание на формирование и формирование инф.портретов'
@ 1,51 DCSAY MessIPC
/* ----- Create browse Classes ----- */
@ 2, 0 DCBROWSE oBrowse ALIAS 'Classes' SIZE 48.8,26 ;
PRESENTATION aPres ;
DCBROWSECOL FIELD Classes->Kod_cls HEADER "Код" PARENT oBrowse WIDTH 5
DCBROWSECOL FIELD Classes->Name_cls HEADER "Наименование класса" PARENT oBrowse WIDTH 23
DCBROWSECOL FIELD Classes->Int_inf HEADER "Редукция класса" PARENT oBrowse WIDTH 3
DCBROWSECOL FIELD Classes->Abs HEADER "N объектов (абс.)" PARENT oBrowse WIDTH 3
DCBROWSECOL FIELD Classes->Perc_fiz HEADER "N объектов (%)" PARENT oBrowse WIDTH 3
/* ----- Create browse InfPortCls ----- */
PRIVATE bColorBlockZn:={|| iif(InfPortCls->Znach>0,{GRA_CLR_RED,nil},iif(InfPortCls->Znach=0,{GRA_CLR_BLACK,nil},{GRA_CLR_BLUE,nil})) } // Клиффорд
@ 2,51 DCBROWSE oBrowIpc ALIAS 'InfPortCls' SIZE 82,26 ;
PRESENTATION aPres ;
DCSETPARENT oBrowIpc
DCBROWSECOL FIELD InfPortCls->KOD_pr HEADER 'Код' WIDTH 5
DCBROWSECOL FIELD InfPortCls->NAME HEADER 'Наименование признака' WIDTH 37
DCBROWSECOL DATA {|x|x:=InfPortCls->Znach,IIF(Empty(x),'',Str(x,8,3))} HEADER "Значимость" FONT "9.Courier" COLOR bColorBlockZn
DCGETOPTIONS TABSTOP
DCREAD GUI ;
OPTIONS GetOptions ;
MODAL ;
TITLE MessIPC;
FIT ;
CLEAREVENTS
CLOSE ALL
DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
ReTURN nil
***********************************************************************************************************************
********************
FUNCTION Help4_2_1()
ReTURN nil
********************
******** Определение типа модели и обращение к функции с параметром, работающей со всеми моделями
FUNCTION InfPortCls1()
InfPortCls(1)
ReTURN nil
FUNCTION InfPortCls2()
InfPortCls(2)
ReTURN nil
FUNCTION InfPortCls3()
InfPortCls(3)
ReTURN nil
FUNCTION InfPortCls4()
InfPortCls(4)
ReTURN nil
FUNCTION InfPortCls5()
InfPortCls(5)
ReTURN nil
FUNCTION InfPortCls6()
InfPortCls(6)
ReTURN nil
FUNCTION InfPortCls7()
InfPortCls(7)
ReTURN nil
FUNCTION InfPortCls8()
InfPortCls(8)
ReTURN nil
FUNCTION InfPortCls9()
InfPortCls(9)
ReTURN nil
FUNCTION InfPortCls10()
InfPortCls(10)
ReTURN nil
******** Генерация информационного портрета в модели: Ar_Model[M_CurrInf]
******** для класса, на котором стоит курсор в БД Classes.dbf
FUNCTION InfPortCls(M_CurrInf)
SELECT Classes
M_Recno = RECNO()
M_KodCls = Kod_cls
M_NameCls = Name_cls
PUBLIC MessIPC := 'Класс: '+ALLTRIM(STR(M_KodCls, 15))+' "'+ALLTRIM(M_NameCls)+'". Модель: '+ALLTRIM(STR(M_CurrInf, 15))+' "'+Ar_Model[M_CurrInf]
*MsgBox(MessIPC)
SELECT (Ar_Model[M_CurrInf])
INDEX ON STR(9999999999.9999999-FIELDGET(2+M_KodCls),19, 7) TO (Ar_Model[M_CurrInf])
* 123456789012345678
* 12345678901.123456
* 10 19
// Заполнить БД InfPortCls записями с кодами и наименованиями признаков и их значимостью
// взяв из (Ar_Model[M_CurrInf]) поровну записей с начала и с конца, но не более 13
SELECT InfPortCls;ZAP
SELECT (Ar_Model[M_CurrInf])
N_Gos = RECCOUNT()
N_pr = IF(N_Gos/2 <= 7, N_Gos/2, 7)
// Сначала скопировать все записи в отсортированном порядке,
// а потом, если N_Gos > 2*N_pr, удалить столько наименее значимых, чтобы осталось 2*N_pr
DBGOTOP()
N = 0
DO WHILE .NOT. EOF()
M_KodPr = Kod_pr
M_Name = Name
M_Znach = FIELDGET(2+M_KodCls)
IF M_KodPr > 0 .AND. M_Znach <> 0
SELECT InfPortCls
APPEND BLANK
REPLACE Kod_pr WITH M_KodPr
REPLACE Name WITH M_Name
REPLACE Znach WITH M_Znach
ENDIF
++N
SELECT (Ar_Model[M_CurrInf])
DBSKIP(1)
ENDDO
IF N_Gos > 2*N_pr
N_del = N_Gos-2*N_pr
// Удалить N_del наименее значимых записей
SELECT InfPortCls
INDEX ON STR(ABS(Znach),19, 7) TO (Ar_Model[M_CurrInf]+"z")
DBGOTOP()
N = 0
DO WHILE .NOT. EOF() .AND. N <= N_Del
DELETE
++N
DBSKIP(1)
ENDDO
PACK
ENDIF
SELECT InfPortCls
DBGOTOP()
ReTURN(MessIPC)
