This is all done in Xbase++ and to a very large extent thanks to Your help and Your functions: SetPixel() and GetPixel().
Code: Select all
*****************************************************************
******** 4. Создать БД "Inp_data.dbf" для программного интерфейса
******** - только пиксели
******** - только спектр
******** - пиксели и спектр
*****************************************************************
FUNCTION CreateDBF2325()
LOCAL aPixel, hDC1, GetList[0], oDialog, oProgress
nWidthMax = VAL(FileStr('_WidthMax.txt'))
nHeightMax = VAL(FileStr('_HeightMax.txt'))
IF .NOT. FILE("_FileName.arx")
LB_Warning('Необходимо выполнить п.п.1-2 данного режима', "Оцифровка изображений по всем пикселям" )
RETURN nil
ENDIF
IF .NOT. FILE("Image.dbf")
LB_Warning('Необходимо выполнить п.п.1-2 данного режима', "Оцифровка изображений по всем пикселям" )
RETURN nil
ENDIF
* DC_ASave(aFileName, "_FileName.arx")
aFileName := DC_ARestore("_FileName.arx")
* DC_ASave(aFileNmSh, "_FileNmSh.arx") // Массивы с русскими буквами считыватся не те, что записывались
aFileNmSh := DC_ARestore("_FileNmSh.arx")
* DC_DebugQout( aFileNmSh )
IF LEN(aFileName) = 0
LB_Warning('Необходимо выполнить п.п.1-2 данного режима', "Оцифровка изображений по всем пикселям" )
RETURN nil
ENDIF
IF LEN(aFileNmSh) = 0
LB_Warning('Необходимо выполнить п.п.1-2 данного режима', "Оцифровка изображений по всем пикселям" )
RETURN nil
ENDIF
***** А если считать спектр? *************
***** - только пиксели
***** - только спектр
***** - пиксели и спектр
nRadio = 2
@ 0, 0 DCGROUP oGroup1 CAPTION 'Задайте, как анализировать изображения:' SIZE 60.0, 12.5
@ 1, 2 DCRADIO nRadio VALUE 1 PROMPT '1. Только по пикселям.' PARENT oGroup1
@ 2, 2 DCRADIO nRadio VALUE 2 PROMPT '2. Только по спектру. ' PARENT oGroup1 // Доля (%) пикселей заданного диапазона цветов
@ 3, 2 DCRADIO nRadio VALUE 3 PROMPT '3. По пикселям и спектру.' PARENT oGroup1
*** Если спектр, то: "Сколько цветов в спектре?"
N_ColorSpectr = 35
@ 2.25, 30 DCSAY 'Сколько цветов в спектре?' PARENT oGroup1 EDITPROTECT {|| .NOT.nRadio=2 } HIDE {|| .NOT.nRadio=2 };@ 2.1, 51 DCSAY '' GET N_ColorSpectr PARENT oGroup1 PICTURE "###" EDITPROTECT {|| .NOT.nRadio=2 } HIDE {|| .NOT.nRadio=2 }
@ 3.25, 30 DCSAY 'Сколько цветов в спектре?' PARENT oGroup1 EDITPROTECT {|| .NOT.nRadio=3 } HIDE {|| .NOT.nRadio=3 };@ 3.1, 51 DCSAY '' GET N_ColorSpectr PARENT oGroup1 PICTURE "###" EDITPROTECT {|| .NOT.nRadio=3 } HIDE {|| .NOT.nRadio=3 }
nRadioBlack = 1
@ 4.5, 1 DCGROUP oGroup2 CAPTION 'Как кодировать черный цвет исходных изображений:' SIZE 58.0, 3.5 PARENT oGroup1 HIDE {|| .NOT. nRadio<>1}
@ 1, 2 DCRADIO nRadioBlack VALUE 1 PROMPT 'как истинно-черный цвет' PARENT oGroup2
@ 2, 2 DCRADIO nRadioBlack VALUE 2 PROMPT 'как отсутствие цвета' PARENT oGroup2
nRadioWhite = 1
@ 8.5, 1 DCGROUP oGroup3 CAPTION 'Как кодировать белый цвет исходных изображений:' SIZE 58.0, 3.5 PARENT oGroup1 HIDE {|| .NOT. nRadio<>1}
@ 1, 2 DCRADIO nRadioWhite VALUE 1 PROMPT 'как истинно-белый цвет' PARENT oGroup3
@ 2, 2 DCRADIO nRadioWhite VALUE 2 PROMPT 'как отсутствие цвета' PARENT oGroup3
DCGETOPTIONS TABSTOP
DCREAD GUI ;
TO lExit ;
FIT ;
ADDBUTTONS;
OPTIONS GetOptions ;
MODAL ;
TITLE 'АСК-анализ изображений по пикселям и спектру'
********************************************************************
IF lExit
** Button Ok
ELSE
**************************************************************
***** БД, открытые перед запуском главного меню
***** Восстанавливать их после выхода из функций главного меню
**************************************************************
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 nRadio > 1
IF N_ColorSpectr < 2
aMess := {}
AADD(aMess, 'В спектре должно быть задано не менее 2 цветов!')
AADD(aMess, 'Будет задано 35 цветов в спектре!')
LB_Warning(aMess, "Оцифровка изображений по всем пикселям" )
N_ColorSpectr = 35
ENDIF
IF N_ColorSpectr > 640
aMess := {}
AADD(aMess, 'В спектре должно быть задано не более 640 цветов, т.к.')
AADD(aMess, 'при отображении спектра используется окно 640x480 pix.')
AADD(aMess, 'Будет задано 35 цветов в спектре!')
LB_Warning(aMess, "Оцифровка изображений по всем пикселям" )
N_ColorSpectr = 35
ENDIF
ENDIF
***** Создать БД: "Inp_data.dbf" ****************************
CLOSE ALL
* SpectrInterv: 999/999-{123,123,123}
* 123456789012 R G B
* 12345678901234567890123456789012345
* 10 20 30
aStructure := { { "ScaleName", "C",35, 0 },; // Наименование шкалы
{ "Data_Type", "C", 1, 0 } } // Тип данных в шкале: N - числовой, С - символьный
FOR j=1 TO LEN(aFileNmSh)
mFieldName = "Obj"+ALLTRIM(STR(j))
mLen = MAX(8, LEN(ALLTRIM(aFileNmSh[j])))
AADD(aStructure, { mFieldName, "C", mLen, 0 } )
NEXT
DbCreate( "Inp_data.dbf", aStructure )
*************************************************************
***** Создать БД: "SpectralRanges.dbf" **********************
***** Для определения спектрального дипазона по цвету пикселя
CLOSE ALL
* SpectrInterv: 999/999-{123,123,123}
* 123456789012 R G B
* 12345678901234567890123456789012345
* 10 20 30
aStructure := { { "ScaleName", "C",35, 0 },; // Наименование шкалы
{ "fRed" , "N", 3, 0 },;
{ "fGreen" , "N", 3, 0 },;
{ "fBlue" , "N", 3, 0 } }
DbCreate( "SpectralRanges.dbf", aStructure )
*************************************************************
CLOSE ALL
USE SpectralRanges EXCLUSIVE NEW
* N_ColorSpectr // Число интервалов
ma := 127.5
mb := 127.5
mc := 127.5
mU := 0
mV := 120
mW := 240
mDelta = 360 / N_ColorSpectr
n = 360
aRed := {}
aGreen := {}
aBlue := {}
FOR j=1 TO N_ColorSpectr
mRed := INT( ma * (1 + COS( ( n + mU ) * GradRad ) ) )
mGreen := INT( mb * (1 + COS( ( n + mV ) * GradRad ) ) )
mBlue := INT( mc * (1 + COS( ( n + mW ) * GradRad ) ) )
* fColor := GraMakeRGBColor({ mRed, mGreen, mBlue })
APPEND BLANK
REPLACE ScaleName WITH "SpectrInterv: "+ALLTRIM(STR(j,15))+'/'+ALLTRIM(STR(N_ColorSpectr))+'-{'+STRTRAN(STR(mRed,3),' ','0')+','+STRTRAN(STR(mGreen,3),' ','0')+','+STRTRAN(STR(mBlue,3),' ','0')+'}'
REPLACE fRed WITH mRed
REPLACE fGreen WITH mGreen
REPLACE fBlue WITH mBlue
AADD(aRed , mRed )
AADD(aGreen, mGreen)
AADD(aBlue , mBlue )
n = n - mDelta
NEXT
***** Определение максимального размера изображения
CLOSE ALL
USE Image VIA 'FOXCDX' EXCLUSIVE NEW
nXSize = -999999999
nYSize = -999999999
aFileNmSh := {} // Короткие имена файлов
aFileXSize := {} // Размер изображения по X
aFileYSize := {} // Размер изображения по Y
DO WHILE !IMAGE->(Eof())
aPixel := Bin2Var(IMAGE->array) // Загрузка массива из БД Image
nXSize = MAX(nXSize, Len(aPixel))
nYSize = MAX(nYSize, Len(aPixel[1]))
AADD(aFileNmSh, FIELDGET(2)) // Для формирования имен классов. Вместо записи и считывания массива использовать БД
AADD(aFileXSize, Len(aPixel)) // Размер изображения по оси X
AADD(aFileYSize, Len(aPixel[1])) // Размер изображения по оси Y
IMAGE->(dbSkip())
ENDDO
***** Создание БД Inp_data с пустыми записями
CLOSE ALL
USE Inp_data EXCLUSIVE NEW
****** Наименование классификационной шкалы, тип данных в шкале, а потом значения градаций шкалы, т.е. классы
APPEND BLANK
REPLACE ScaleName WITH "Класс"
REPLACE Data_Type WITH "C" // Символьный тип данных в шкале "Класс" (а данном случае)
FOR j=1 TO LEN(aFileNmSh)
mFileNmSh = ALLTRIM(aFileNmSh[j])
mPos = AT('.bmp', mFileNmSh);IF mPos > 0;mFileNmSh = SUBSTR(mFileNmSh, 1, mPos-1);ENDIF // Взять наименование класса до расширения
mPos = AT('.BMP', mFileNmSh);IF mPos > 0;mFileNmSh = SUBSTR(mFileNmSh, 1, mPos-1);ENDIF // Взять наименование класса до расширения
mPos = AT('.jpg', mFileNmSh);IF mPos > 0;mFileNmSh = SUBSTR(mFileNmSh, 1, mPos-1);ENDIF // Взять наименование класса до расширения
mPos = AT('.JPG', mFileNmSh);IF mPos > 0;mFileNmSh = SUBSTR(mFileNmSh, 1, mPos-1);ENDIF // Взять наименование класса до расширения
mPos = AT('-' , mFileNmSh);IF mPos > 0;mFileNmSh = SUBSTR(mFileNmSh, 1, mPos-1);ENDIF // Взять наименование класса до тире, если оно есть, т.к. после тире идет номер экземляра
FIELDPUT(2+j, ALLTRIM(mFileNmSh))
* MsgBox(mFileNmSh)
NEXT
****** Это нужно для Inp_spectr.dbf для визуализации спектров
APPEND BLANK
REPLACE ScaleName WITH "Размер изображения по X"
REPLACE Data_Type WITH "N" // Размер изображения по X
FOR j=1 TO LEN(aFileNmSh)
FIELDPUT(2+j, ALLTRIM(STR(aFileXSize[j])))
NEXT
APPEND BLANK
REPLACE ScaleName WITH "Размер изображения по Y"
REPLACE Data_Type WITH "N" // Размер изображения по Y
FOR j=1 TO LEN(aFileNmSh)
FIELDPUT(2+j, ALLTRIM(STR(aFileYSize[j])))
NEXT
******* Формирование БД Inp_data.dbf *********
FOR y := 1 TO nYSize
FOR x := 1 TO nXSize
APPEND BLANK
REPLACE ScaleName WITH "Pixel("+ALLTRIM(STR(x))+","+ALLTRIM(STR(y))+")"
REPLACE Data_Type WITH "N" // Числовой тип данных в шкале "Класс" (а данном случае)
NEXT
NEXT
***** Ввод в БД Inp_data оцифрованных изображений из БД Image
CLOSE ALL
USE Image VIA 'FOXCDX' EXCLUSIVE NEW;N_Rec = RECCOUNT()
USE Inp_data EXCLUSIVE NEW
USE SpectralRanges EXCLUSIVE NEW
****************************************************************************************************
*Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time
*nMax = N_InpFiles
*Mess = '2.3.2.6. Объединение нескольких файлов исходных данных в один'
*@ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT nMax COLOR GRA_CLR_CYAN PERCENT EVERY 100
*DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT
*oDialog:show()
*nTime = 0
*DC_GetProgress(oProgress,0,nMax)
*FOR ff=1 TO N_InpFiles
* DC_GetProgress(oProgress, ++nTime, nMax)
*NEXT
**MsgBox('STOP')
*DC_GetProgress(oProgress,nMax,nMax)
*oDialog:Destroy()
*Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time
****************************************************************************************************
nMax = N_Rec * nXSize * nYSize
Mess = 'Создание БД "Inp_data.dbf" для программного интерфейса 2.3.2.3.'
@ 4,5 DCPROGRESS oProgress SIZE 75,1.1 MAXCOUNT nMax COLOR aColor[154] PERCENT EVERY 100
DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT
oDialog:show()
nTime = 0
DC_GetProgress(oProgress,0,nMax)
aInp_name := {} // Массив с наименованиями колонок - объектов обучающей выборки, для формирования файла: Inp_name.txt
SELECT Image
DBGOTOP()
DO WHILE !IMAGE->(Eof())
aPixel := Bin2Var(IMAGE->array) // Загрузка массива из БД Image
nXSizeAr = Len(aPixel)
nYSizeAr = Len(aPixel[1])
AADD(aInp_name, ALLTRIM(IMAGE->image_name))
SELECT Image
mNumImage = RECNO()
* @ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP ;
* COLOR nil, GRA_CLR_PALEGRAY ;
* SIZE Len(aPixel), Len(aPixel[1]) PIXEL ;
* EVAL {|o|hDC1 := GetWindowDC(o:getHWnd())}
* DCREAD GUI FIT TITLE ALLTRIM(IMAGE->image_name) ;
* EVAL {|o|TransferImageDB(hDC1, aPixel), ;
* Sleep(0), ;
* PostAppEvent(xbeP_Close,,,o)}
****** Ввод в БД Inp_data оцифрованного изображения
SELECT Inp_data
FOR y := 1 TO nYSize
FOR x := 1 TO nXSize
IF x <= nXSizeAr .AND. y <= nYSizeAr
nColor = AutomationTranslateColor(aPixel[x, y], .t.)
IF GraIsRGBColor(nColor) // Это цвет?
* aRGB = GraGetRGBIntensity(nColor) // Взаимнообратные операции преобразования формы кодирования цвета в массиве RGB и одним числом
* nColorPix = GraMakeRGBColor(aRGB)
* MsgBox(STR(nColor)+STR(nColorPix)) // nColor === nColorPix
DBGOTO(3+x+(y-1)*nXSize) // Классифкационная шкала: "Класс" и тип данных в ней (+1, т.к. 1-я строка - строка классов),
* nColor = AutomationTranslateColor(aPixel[x, y], .t.) // затем 2 строки с размерами изображения по X и по Y
nColor = aPixel[x, y]
IF nRadio > 1
IF nColor=GraMakeRGBColor({1,1,1})
IF nRadioBlack=2 // Если черный цвет и его кодировать как отсутствие цвета
nColor = 0
ENDIF
ENDIF
IF nColor=GraMakeRGBColor({255,255,255})
IF nRadioWhite=2 // Если белый цвет и его кодировать как отсутствие цвета
nColor = 0
ENDIF
ENDIF
ENDIF
FIELDPUT(2+mNumImage, ALLTRIM(STR(nColor))) // Запись цвета пикселя в текстовом формате (который в 2.3.2.3 используется для все полей)
ENDIF
ENDIF
DC_GetProgress(oProgress, ++nTime, nMax)
NEXT
NEXT
SELECT Image
DBSKIP(1)
ENDDO
*MsgBox('STOP')
DC_GetProgress(oProgress,nMax,nMax)
oDialog:Destroy()
*************************************************************** ###############################
***** Дорасчет спектров объектов в БД Inp_data.dbf ************ ###############################
*************************************************************** ###############################
IF nRadio > 1
oScrn := DC_WaitOn('Идет расчет спектров изображений. Немного подождите!')
SELECT SpectralRanges
aSpectrInterv := {}
DBGOTOP()
DO WHILE .NOT. EOF()
AADD(aSpectrInterv, ALLTRIM(ScaleName))
DBSKIP(1)
ENDDO
SELECT Inp_data
mRecnoSpectr = RECCOUNT()+1
FOR y = 1 TO N_ColorSpectr
APPEND BLANK
REPLACE ScaleName WITH aSpectrInterv[y]
REPLACE Data_Type WITH "N" // Числовой тип данных в шкале "Класс" (в данном случае)
NEXT
nMax = FCOUNT()-3
* Mess = 'Идет расчет спектров изображений. Немного подождите!'
* @ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT nMax COLOR aColor[155] PERCENT EVERY 100
* DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT
* oDialog:show()
* nTime = 0
* DC_GetProgress(oProgress,0,nMax)
FOR mObj = 3 TO FCOUNT()
********* Расчет массива спектра
aSpectrumAbs := {} // Массив числа пикселей объекта с цветом, попадающим в диапазон
FOR j=1 TO N_ColorSpectr
AADD(aSpectrumAbs, 0)
NEXT
mSumPix = 0
DBGOTOP()
DO WHILE .NOT. EOF()
mColor = VAL(ALLTRIM(FIELDGET(mObj))) // ПРЕОБРАЗОВАТЬ В ЧИСЛО
IF mColor > 0
// Для определения цветового диапазона, с которым наиболее сходен цвет пикселя, использовать Евклидово расстояние между цветом пикселя и цветом диапазона
* SpectrInterv: 999/999-{123,123,123}
* 123456789012 R G B
* 12345678901234567890123456789012345
* 10 20 30
nColor = AutomationTranslateColor(mColor, .t.)
aRGB = GraGetRGBIntensity(nColor) // Взаимнообратные операции преобразования формы кодирования цвета в массиве RGB и одним числом
* SELECT SpectralRanges
* mColorDistance = SQRT((aRGB[1]-&fRed)^2+(aRGB[2]-&fGreen)^2+(aRGB[3]-&fBlue)^2)
* INDEX ON STR(SQRT((aRGB[1]-&fRed)^2+(aRGB[2]-&fGreen)^2+(aRGB[3]-&fBlue)^2),8) TO SpectralRanges
* INDEX ON STR( (aRGB[1]-&fRed)^2+(aRGB[2]-&fGreen)^2+(aRGB[3]-&fBlue)^2 ,8) TO SpectralRanges
* INDEX ON STR( ABS(aRGB[1]-&fRed)+ABS(aRGB[2]-&fGreen)+ABS(aRGB[3]-&fBlue) ,8) TO SpectralRanges
mClrDistMin = 9999999
FOR j=1 TO N_ColorSpectr
mColorDistance = SQRT((aRed[j]-aRGB[1])^2+(aGreen[j]-aRGB[2])^2+(aBlue[j]-aRGB[3])^2)
IF mClrDistMin > mColorDistance
mClrDistMin = mColorDistance
mNumDistMin = j
ENDIF
NEXT
* DBGOTOP() // Для варианта с индексным массивом
* mPos1 = 15
* mPos2 = AT('/', ScaleName)-1
* mRanges = VAL(SUBSTR(ScaleName, mPos1, mPos2-mPos1+1))
aSpectrumAbs[mNumDistMin] = aSpectrumAbs[mNumDistMin] + 1
mSumPix++
ENDIF
SELECT Inp_data
DBSKIP(1)
ENDDO
********* Дорасчет массива спектра
aSpectrumPrc := {} // Массив % пикселей объекта с цветом, попадающим в диапазон, от числа всех пикселей объекта
FOR j=1 TO LEN(aSpectrumAbs)
AADD(aSpectrumPrc, aSpectrumAbs[j]/mSumPix*100)
NEXT
********* Запись массива спектра
DBGOTO(mRecnoSpectr)
FOR j=1 TO LEN(aSpectrumPrc)
FIELDPUT(mObj, ALLTRIM(STR(aSpectrumPrc[j],8,4)))
DBSKIP(1)
NEXT
* DC_GetProgress(oProgress, ++nTime, nMax)
NEXT
DC_Impl(oScrn)
* *MsgBox('STOP')
* DC_GetProgress(oProgress,nMax,nMax)
* oDialog:Destroy()
ENDIF
***** Файл: Inp_data.dbf скопировать как Inp_spectr.dbf
IF nRadio > 1
CLOSE ALL
Name_SS = "Inp_data.dbf"
Name_DD = Disk_dir+"\Inp_spectr.dbf"
COPY FILE (Name_SS) TO (Name_DD)
ENDIF
***** Файл: Inp_data.dbf скопировать в папку \AID_DATA\Inp_data
IF nRadio = 1
CLOSE ALL
USE Inp_data EXCLUSIVE NEW
DELETE FOR 1 < RECNO() .AND. RECNO() < 3
PACK
ENDIF
IF nRadio = 2
CLOSE ALL
USE Inp_data EXCLUSIVE NEW
DELETE FOR 1 < RECNO() .AND. RECNO() < mRecnoSpectr
PACK
ENDIF
CLOSE ALL
Name_SS = "Inp_data.dbf"
Name_DD = Disk_dir+"\AID_DATA\Inp_data\Inp_data.dbf"
COPY FILE (Name_SS) TO (Name_DD)
*** Сформировать файл Inp_name.txt с наименованиями колонок - объектов обучающей выборки
CrLf = CHR(13)+CHR(10) // Конец строки (абзаца) (CrLf)
mInp_name = ""
FOR j=1 TO LEN(aInp_name)
mInp_name = mInp_name + aInp_name[j] + CrLf
NEXT
StrFile( mInp_name, Disk_dir+"\AID_DATA\Inp_data\Inp_name.txt") // Записать в папку Inp_data
***** Запись БД Inp_data.dbf в виде Excel-файла с именами колонок из Inp_data.xls
***** Попробовать преобразовать Inp_data.dbf и _ColumnNames.arx в Inp_data.xls
DIRCHANGE(Disk_dir +"\AID_DATA\Inp_data\")
CLOSE ALL
USE Inp_data EXCLUSIVE NEW
SELECT Inp_data
aColumnNames := {}
AADD(aColumnNames, "Наименование шкалы")
AADD(aColumnNames, "Тип данных шкалы")
FOR j=1 TO LEN(aInp_name)
AADD(aColumnNames, aInp_name[j])
NEXT
aFields := {}
FOR j=1 TO FCOUNT()
AADD(aFields, FIELDNAME(j))
NEXT
*FUNCTION DC_WorkArea2Excel( cExcelFile, nOrientation, lDisplayAlerts, ; // Original DC
* lVisible, aFields, lAutoFit, cDateFormat, aFieldEvals, ;
* cPassword, lFreezeRow1, lCsvFallBack, aColumnNames )
// Модифицированная функция Роджера: имена колонок берутся из aColumnNames только если LEN(aFields)=LEN(aColumnNames)
// Убрана пустая строка после нанименований колонок
cExcelFile = Disk_dir +"\AID_DATA\Inp_data\Inp_data.xls" // Необходимо полное имя
DC_WorkArea2Excel(cExcelFile,,,,aFields,,,,,,, aColumnNames )
***** Сформировать файл параметров для интерфейса 2.3.2.3. (точно также сделать после Диминой программы после xls=>dbf)
*************************************************************************************************************
* aParInt[1] = 1 // XLS - MS Excel-2003
* aParInt[1] = 2 // XLSX- MS Excel-2007 (2010 и более поздние)
* aParInt[1] = 3 // DBF - DBASE IV (DBF/NTX)
* aParInt[2] = 1 // Считать нули и пробелы отсутствием данных
* aParInt[2] = 2 // Не считать нули и пробелы отсутствием данных
* aParInt[3] = номер ПЕРВОЙ строки с классификационными шкалами
* aParInt[4] = номер ПОСЛЕДНЕЙ строки с классификационными шкалами
* aParInt[5] = номер ПЕРВОЙ строки с описательными шкалами
* aParInt[6] = номер ПОСЛЕДНЕЙ строки с описательными шкалами
* aParInt[7] = 3 // число градаций в классификационной шкале
* aParInt[8] = 3 // число градаций в описательной шкале
* aParInt[9] = 1 // Формировать классификационные и описательные шкалы и градации и обучающую выборку
* aParInt[9] = 2 // Формировать только распознаваемую выборку
* aParInt[10]= 1 // Наменования ГРАДАЦИЙ числовых шкал - Только интервальные числовые значения
* aParInt[10]= 2 // Наменования ГРАДАЦИЙ числовых шкал - Только наименования интервальных числовых значений
* aParInt[10]= 3 // Наменования ГРАДАЦИЙ числовых шкал - И интервальные числовые значения, и их наименования
*************************************************************************************************************
CLOSE ALL
USE Inp_data EXCLUSIVE NEW
N_Obj = FCOUNT()-2
N_Rec = RECCOUNT()
IF FILE(Disk_dir+"\_2_3_2_3.arx") // Файл параметров
aParInt = DC_ARestore(Disk_dir+"\_2_3_2_3.arx")
aParInt[ 6] = N_Rec // номер ПОСЛЕДНЕЙ строки с описательными шкал
ELSE
PRIVATE aParInt[10]
aParInt[ 1] = 3 // DBF - DBASE IV (DBF/NTX) // Тоже будет работать
* aParInt[ 1] = 1 // XLS - MS Excel-2003
aParInt[ 2] = 1 // Считать нули и пробелы отсутствием данных (1-ДА, 2-НЕТ)
aParInt[ 3] = 1 // номер ПЕРВОЙ строки с классификационными шкалами
aParInt[ 4] = 1 // номер ПОСЛЕДНЕЙ строки с классификационными шкалами
aParInt[ 5] = 4 // номер ПЕРВОЙ строки с описательными шкалами (во 2-й стр. размер изобр.по X, а в 3-й - по Y)
aParInt[ 6] = N_Rec // номер ПОСЛЕДНЕЙ строки с описательными шкалами
aParInt[ 7] = 3 // число градаций в классификационной шкале
aParInt[ 8] = 3 // число градаций в описательной шкале
aParInt[ 9] = 1 // Формировать классификационные и описательные шкалы и градации и обучающую выборку
aParInt[10] = 1 // Наменования ГРАДАЦИЙ числовых шкал - Только интервальные числовые значения
ENDIF
DC_ASave(aParInt, Disk_dir+"\_2_3_2_3.arx")
DC_ASave(aParInt, "_2_3_2_3.arx")
DIRCHANGE(Disk_dir)
LB_Warning('БД "Inp_data.dbf" для программного интерфейса 2.3.2.3 успешно создана', "Оцифровка изображений по всем пикселям" )
RETURN nil
Code: Select all
*****************************************************************
******** Визуализация изображений и их спектров из "Inp_spectr"
*****************************************************************
FUNCTION SpectrView2325()
LOCAL GetList[0], GetOptions, oSay, oDialog, oProgress, oScrn
PUBLIC oBitmap, hDC1, oPS
PUBLIC X_MaxW := 1800, Y_MaxW := 850 // Размер графического окна для самого графика в пикселях
****** Узнать разрешение экрана и не показывать изображений большой размерности ****************
nWidth := AppDeskTop():currentSize()[1] // current screen size width in pixels
nHeight := AppDeskTop():currentSize()[2] // current screen size height in pixels
IF nWidth < X_MaxW
aMess := {}
AADD(aMess, "Для правильного отображения графической формы")
AADD(aMess, "необходимо разрешение экрана: "+ALLTRIM(STR(X_MaxW))+" pix по горизонтали,")
AADD(aMess, "а фактически установлено: "+ALLTRIM(STR(nWidth))+" pix")
LB_Warning(aMess )
ReTURN NIL
ENDIF
IF nHeight < Y_MaxW
aMess := {}
AADD(aMess, "Для правильного отображения графической формы")
AADD(aMess, "необходимо разрешение экрана: "+ALLTRIM(STR(Y_MaxW))+" pix по вертикали,")
AADD(aMess, "а фактически установлено: "+ALLTRIM(STR(nHeight))+" pix")
LB_Warning(aMess )
ReTURN NIL
ENDIF
************************************************************************************************
DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
** Имя графического файла для рисования
DO CASE
CASE FILE('Delone.bmp')
mFileName = 'Delone.bmp'
CASE FILE('Delone.jpg')
mFileName = 'Delone.jpg'
OTHERWISE
LB_Warning( 'В текущей папке системы'+Disk_dir+' должен быть файл: "Delone.bmp" или "Delone.jpg"','4.8. АСК-анализ изображений в системе "Эйдос"' )
RETURN nil
ENDCASE
****** Создание графического окна для рисования изображений в стиле Роджера ********************
*@ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP CAPTION mFileName OBJECT oStatic1 ;
* PREEVAL {|o|o:autoSize := .t.} EVAL {|o|hDC1 := GetWindowDC(o:getHWnd()), o:motion := {|a,b,o|ShowColorTr( hDC1, a, oSay, o )},;
* aPixel := Array(o:caption:xSize,o:caption:ySize), o:paint := {|a,b,o|Gratest(o)}}
***** Здесь могут быть кнопки меню
*DCGETOPTIONS PIXEL
*DCREAD GUI FIT TITLE '4.7. АСК-анализ изображений в системе "Эйдос"' OPTIONS GetOptions ;
* EVAL {||GraTest(oStatic1)} SETAPPWINDOW
************************************************************************************************
***** Если нет базы данных Inp_spectr.dbf, то выдать сообщение и прекратить выполнение режима
IF .NOT.FILE('Inp_spectr.dbf')
aMess := {}
AADD(aMess, 'В текущей папке системы: '+Disk_dir+' должен быть файл: "Inp_spectr.dbf"!!!')
AADD(aMess, 'Чтобы создать этот файл необходимо выполнить подряд режимы подготовки спектрального анализа!')
LB_Warning( aMess,'4.8. АСК-анализ изображений в системе "Эйдос"' )
RETURN nil
ENDIF
IF .NOT.FILE('SpectralRanges.dbf')
aMess := {}
AADD(aMess, 'В текущей папке системы: '+Disk_dir+' должен быть файл: "SpectralRanges.dbf"!!!')
AADD(aMess, 'Чтобы создать этот файл необходимо выполнить подряд режимы подготовки спектрального анализа!')
LB_Warning( aMess,'4.8. АСК-анализ изображений в системе "Эйдос"' )
RETURN nil
ENDIF
***** Вытащить из БД размеры изображения по X и по Y и использовать и при расчете координат изображения слева #######
CLOSE ALL
USE Inp_spectr EXCLUSIVE NEW
USE SpectralRanges EXCLUSIVE NEW
****** Сформировать массивы цветов цветовых диапазонов
SELECT SpectralRanges
aSpectrIntervR := {} // Массив ЦВЕТОВ цветовых интервалов (градаций цвета)
aSpectrIntervG := {} // Массив ЦВЕТОВ цветовых интервалов (градаций цвета)
aSpectrIntervB := {} // Массив ЦВЕТОВ цветовых интервалов (градаций цвета)
DBGOTOP()
DO WHILE .NOT. EOF()
AADD(aSpectrIntervR, fRed ) // Яркость R-луча цветового диапазона
AADD(aSpectrIntervG, fGreen ) // Яркость G-луча цветового диапазона
AADD(aSpectrIntervB, fBlue ) // Яркость B-луча цветового диапазона
DBSKIP(1)
ENDDO
SELECT Inp_spectr
FOR mObj=3 TO FCOUNT()
******** ############################################################################################################
******** Визуализация исходного изображения в стиле: "Витраж" *******************************************************
******** ############################################################################################################
DBGOTO(1);mNameObj = ALLTRIM(FIELDGET(mObj))
DBGOTO(2);mXSizePix = VAL(FIELDGET(mObj))
DBGOTO(3);mYSizePix = VAL(FIELDGET(mObj))
mXSizeSpc = 640
mYSizeSpc = 480
X0pix = ROUND( ( X_MaxW - 2 * mXSizePix ) / 3 + 0.5 * mXSizePix, 0)
X0spc = ROUND( ( X_MaxW - 2 * mXSizeSpc ) / 3 * 2 + 1.5 * mXSizeSpc, 0)
Y0all = ROUND( Y_MaxW / 2 , 0)
ClearImageTr() // Стереть весь экран
**** Написать заголовок диаграммы
oFont := XbpFont():new():create('18.Arial Bold')
GraSetFont(oPS , oFont) // установить шрифт
aAttrF := ARRAY( GRA_AS_COUNT )
aAttrF [ GRA_AS_COLOR ] := GRA_CLR_BLACK
aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_CENTER // Выравнивание символов по горизонтали по центру относительно точки начала вывода
aAttrF [ GRA_AS_VERTALIGN ] := GRA_VALIGN_HALF // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
GraSetAttrString( oPS, aAttrF ) // Установить символьные атрибуты
mTitle = 'ИСХОДНОЕ ИЗОБРАЖЕНИЕ: "'+mNameObj+'" И ЕГО СПЕКТР'
GraStringAt( oPS, { X_MaxW/2, Y_MaxW-30 }, mTitle)
aSpectrIntervV := {} // Массив значенний в % цветовых интервалов (градаций цвета)
*********** Рамка вокруг изображения
aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии
aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DEFAULT // Тонкая сплошная линия
aAttr [ GRA_AL_COLOR ] := 1 // Задать цвет линии
aAttr [ GRA_AL_WIDTH ] := 1 // Задать толщину линии
graSetAttrLine( oPS, aAttr ) // Установить атрибуты
GraSetColor( oPS, BD_INDIGO, BD_INDIGO )
GraBox( oPS, { X0pix-mXSizePix/2-3, Y0all+mYSizePix/2+3}, { X0pix+mXSizePix/2+3, Y0all-mYSizePix/2-3 }, GRA_OUTLINE )
*********** Фон окна для изображения
GraSetColor( oPS, BD_ICEGREY, BD_ICEGREY )
GraBox( oPS, { X0pix-mXSizePix/2-1, Y0all+mYSizePix/2+1}, { X0pix+mXSizePix/2+1, Y0all-mYSizePix/2-1 }, GRA_FILL )
mSpIntVmax = -9999999
DBGOTOP()
DO WHILE .NOT. EOF()
mScName = ALLTRIM(SCALENAME)
** Извлечь из БД Inp_spectr.dbf и цвет fColor и координаты X,Y пикселя
* mScName = 'Pixel(23,11)'
* 12345
IF SUBSTR(mScName,1,5) = 'Pixel'
fColor = VAL(ALLTRIM(FIELDGET(mObj)))
* IF fColor > 0
mPos1x = 7
mPos2x = AT(',', mScName)-1
mPos1y = AT(',', mScName)+1
mPos2y = AT(')', mScName)-1
mX = VAL(SUBSTR(mScName, mPos1x, mPos2x-mPos1x+1))
mY = VAL(SUBSTR(mScName, mPos1y, mPos2y-mPos1y+1))
IF mX <= mXSizePix .AND. mY <= mYSizePix
mXpix = X0pix + VAL(SUBSTR(mScName, mPos1x, mPos2x-mPos1x+1)) - mXSizePix/2
mYpix = Y0all + VAL(SUBSTR(mScName, mPos1y, mPos2y-mPos1y+1)) - mYSizePix/2
SetPixel(hDC1,mXpix,mYpix,fColor)
ENDIF
* ENDIF
ENDIF
** Вытащить из БД данные для отображения спектра
* SpectrInterv: 999/999-{123,123,123}
* 123456789012 R G B
IF SUBSTR(mScName,1,12) = 'SpectrInterv'
mPosR1 = AT('{', mScName)+1
mPosR2 = mPosR1+2
mPosG1 = mPosR2+1
mPosG2 = mPosG1+2
mPosB1 = mPosG2+1
mPosB2 = mPosB1+2
mRed = VAL(SUBSTR(mScName, mPosR1, mPosR2-mPosR1+1))
mGreen = VAL(SUBSTR(mScName, mPosG1, mPosG2-mPosG1+1))
mBlue = VAL(SUBSTR(mScName, mPosB1, mPosB2-mPosB1+1))
* MsgBox(STR(mRed)+STR(mGreen)+STR(mBlue))
mColorV = VAL(ALLTRIM(FIELDGET(mObj)))
AADD(aSpectrIntervV, mColorV) // Доля в изображении пикселей с цветом, попадающим в этот дипазон
mSpIntVmax = MAX(mSpIntVmax, mColorV)
ENDIF
DBSKIP(1)
ENDDO
SET FILTER TO SUBSTR(ALLTRIM(ScaleName),1,12) = 'SpectrInterv'
COUNT TO mNGrad
SET FILTER TO
***** Расчет позиций центров исходного изображения и спектра
PRIVATE X0 := 0
PRIVATE Y0 := 0 // Начало координат по осям X и Y с учетом места для легенды
PRIVATE W_Wind := X_MaxW - X0 // Ширина окна для самого графика
PRIVATE H_Wind := Y_MaxW - Y0 // Высота окна для самого графика
PRIVATE Kx := mXSizeSpc / mNGrad // Коэффициент масштабирования по оси X: преобразует аргумент функции в номер пикселя по оси X
PRIVATE Ky := mYSizeSpc / mSpIntVmax // Коэффициент масштабирования по оси Y: преобразует значение функции в номер пикселя по оси Y
****** Визуализация спектра ************************
*********** Рамка вокруг изображения
aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии
aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DEFAULT // Тонкая сплошная линия
aAttr [ GRA_AL_COLOR ] := 1 // Задать цвет линии
aAttr [ GRA_AL_WIDTH ] := 1 // Задать толщину линии
graSetAttrLine( oPS, aAttr ) // Установить атрибуты
GraSetColor( oPS, BD_INDIGO, BD_INDIGO )
GraBox( oPS, { X0spc-mXSizeSpc/2-3, Y0all+mYSizeSpc/2+3}, { X0spc+mXSizeSpc/2+3, Y0all-mYSizeSpc/2-3 }, GRA_OUTLINE )
*********** Фон окна для изображения
GraSetColor( oPS, BD_ICEGREY, BD_ICEGREY )
GraBox( oPS, { X0spc-mXSizeSpc/2-1, Y0all+mYSizeSpc/2+1}, { X0spc+mXSizeSpc/2+1, Y0all-mYSizeSpc/2-1 }, GRA_FILL )
****** Надпись в верхнем ллевом углу окна спектра (макс.%)
oFont := XbpFont():new():create('14.Arial')
GraSetFont(oPS , oFont) // установить шрифт
aAttrF := ARRAY( GRA_AS_COUNT )
aAttrF [ GRA_AS_COLOR ] := GRA_CLR_BLACK
aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_CENTER // Выравнивание символов по горизонтали по центру относительно точки начала вывода
aAttrF [ GRA_AS_VERTALIGN ] := GRA_VALIGN_HALF // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
GraSetAttrString( oPS, aAttrF ) // Установить символьные атрибуты
*** Может быть сделать штук 5 интервалов по Y и сеточку пунктиром?
aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии
aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DOT // Пунктир
aAttr [ GRA_AL_COLOR ] := GRA_CLR_PALEGRAY // Серого цвета
aAttr [ GRA_AL_WIDTH ] := 1 // Задать толщину линии
graSetAttrLine( oPS, aAttr ) // Установить атрибуты
FOR j=0 TO mSpIntVmax STEP mSpIntVmax/5
* GraStringAt( oPS, { X0spc-mXSizeSpc/2-30, Y0all-mYSizeSpc/2+1 }, ALLTRIM(STR(0,3))+'%' )
* GraStringAt( oPS, { X0spc-mXSizeSpc/2-30, Y0all+mYSizeSpc/2+1 }, ALLTRIM(STR(mSpIntVmax,3))+'%' )
GraStringAt( oPS, { X0spc-mXSizeSpc/2-30, Y0all-mYSizeSpc/2+j * Ky }, ALLTRIM(STR(j,3))+'%' )
GraLine(oPS, { X0spc-mXSizeSpc/2 , Y0all - j * Ky + mYSizeSpc/2 }, {X0spc+mXSizeSpc/2, Y0all - j * Ky + mYSizeSpc/2} ) // Нарисовать пунктирную линию уровня y
NEXT
Column = 0
ma := 127.5
mb := 127.5
mc := 127.5
mU := 0
mV := 120
mW := 240
Delta = 360 / mNGrad
FOR c=1 TO mNGrad
***** Закрасить фон прямоугольника цветом интервала ***************
++Column
X1 := X0spc + (Column-1) * Kx - mXSizeSpc/2
Y1 := Y0all + mYSizeSpc/2
X2 := X0spc + Column * Kx - mXSizeSpc/2
Y2 := Y0all - aSpectrIntervV[c] * Ky + mYSizeSpc/2
fColor := GraMakeRGBColor({ aSpectrIntervR[c], aSpectrIntervG[c], aSpectrIntervB[c]})
FOR y=Y2 TO Y1
FOR x=X1 TO X2
SetPixel(hDC1, x, y, AutomationTranslateColor(fColor,.f.) )
NEXT
NEXT
NEXT
********* Отобразить узкую полоску спектра под реальным спектром
Delta = 360 / mNGrad
Column = 0
n = 360
FOR j=1 TO mNGrad
R := INT( ma * (1 + COS( ( n + mU ) * GradRad ) ) )
G := INT( mb * (1 + COS( ( n + mV ) * GradRad ) ) )
B := INT( mc * (1 + COS( ( n + mW ) * GradRad ) ) )
* MsgBox(STR(R)+STR(G)+STR(B))
fColor := GraMakeRGBColor({ R, G, B })
***** Закрасить фон прямоугольника ***************
GraSetColor( oPS, fColor, fColor )
++Column
X1 := X0spc + (Column-1) * Kx - mXSizeSpc/2
Y1 := Y0all - 1 * Ky - mYSizeSpc/2
X2 := X0spc + Column * Kx - mXSizeSpc/2
Y2 := Y0all - 1 * Ky - mYSizeSpc/2 - 10
GraBox( oPS, { X1, Y1 }, { X2, Y2 }, GRA_FILL)
n=n-Delta
NEXT
********* Запись изображения символа в папку с именем: "InpSpectrPix" в виде графического файла
DIRCHANGE(Disk_dir+"\Aid_data\") // Перейти в папку с исполнимым модулем системы
IF FILEDATE("InpSpectrPix",16) = CTOD("//")
DIRMAKE ("InpSpectrPix")
Mess = 'В папке текущего приложения: "#" не было директории "InpSpectrPix" для изображений и их спектров и она была создана!'
Mess = STRTRAN(Mess, "#", UPPER(ALLTRIM(M_PathAppl)))
LB_Warning(Mess, mTitle )
ENDIF
DIRCHANGE(Disk_dir+"\Aid_data\InpSpectrPix") // Перейти в папку "InpSpectrPix"
cFileName = Disk_dir+"\Aid_data\InpSpectrPix\"+ConvToAnsiCP(mNameObj)+".bmp" // Чтобы в именах файлов можно было использовать русские символы
* MsgBox(cFileName)
ERASE(cFileName)
DC_Scrn2ImageFile( oStatic1, cFileName )
DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
MILLISEC(2000) // Задержка после визуализации спектра, чтобы можно было хоть немного его рассмотреть и чтобы он был виден через teamViewer
NEXT
**************************************************************
***** БД, открытые перед запуском главного меню
***** Восстанавливать их после выхода из функций главного меню
**************************************************************
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
