Recording character images as files
Posted: Thu Jun 18, 2015 7:46 am
I want to record the image specified categories of characters in a file. While the shows, but does not record. I think something is wrong with the duplicate objects. Can anyone help?
[/size]
Code: Select all
PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN
**********************************************************************************
FUNCTION Main()
LOCAL GetList[0], cFont := Pad('200.Arial Bold',50)
DC_IconDefault(1000)
@ 0,0 DCGROUP oGroup1 CAPTION '' SIZE 90.0, 2.5
@ 1,2 DCSAY 'Задайте тип и размер шрифта:' GET cFont POPUP {|c|DC_PopFont(c)} SAYSIZE 0 SAYBOTTOM PARENT oGroup1
PUBLIC aPar[6]
AFILL(aPar, .F.)
aPar[1] = .T.
@ 3, 0 DCGROUP oGroup2 CAPTION 'Задайте, какие символы отображать:' SIZE 90.0, 7.5
@ 1, 2 DCCHECKBOX aPar[1] PROMPT 'Цифры' PARENT oGroup2
@ 2, 2 DCCHECKBOX aPar[2] PROMPT 'Буквы' PARENT oGroup2
@ 3, 2 DCCHECKBOX aPar[3] PROMPT 'Латинские' PARENT oGroup2
@ 4, 2 DCCHECKBOX aPar[4] PROMPT 'Русские' PARENT oGroup2
@ 5, 2 DCCHECKBOX aPar[5] PROMPT 'Заглавные' PARENT oGroup2
@ 6, 2 DCCHECKBOX aPar[6] PROMPT 'Строчные' PARENT oGroup2
@ 2,55 DCPUSHBUTTON CAPTION 'Отобразить шрифт' SIZE 20, 3.8 ACTION {||DisplayFonts(cFont)} PARENT oGroup2
DCREAD GUI;
TO lExit ;
FIT;
ADDBUTTONS;
MODAL;
TITLE "Запись изображений символов"
********************************************************************
IF lExit
** Button Ok
ELSE
QUIT
ENDIF
********************************************************************
FOR jj = 1 TO 255
DrawSimbol(jj, cFont)
NEXT
QUIT
***** Записать заданные символы в виде графических файлов
FOR mSimb = 1 TO 255
StrFile(ALLTRIM(STR(mSimb)), '_Simb.txt') // Запись текстового файла _Simb.txt
IF aPar[1] // Цифры
IF mSimb <= 48 .AND. mSimb <= 57
DrawSimbol(cFont)
ENDIF
ENDIF
IF aPar[2] // Буквы
IF aPar[3] // Латинские
IF aPar[5] // Заглавные
IF mSimb <= 65 .AND. mSimb <= 90
DrawSimbol(cFont)
ENDIF
ENDIF
IF aPar[6] // Строчные
IF mSimb <= 97 .AND. mSimb <= 122
DrawSimbol(cFont)
ENDIF
ENDIF
ENDIF
IF aPar[4] // Русские
IF aPar[5] // Заглавные
IF mSimb <= 128 .AND. mSimb <= 159
DrawSimbol(cFont)
ENDIF
ENDIF
IF aPar[6] // Строчные
IF mSimb <= 160 .AND. mSimb <= 175
DrawSimbol(cFont)
ENDIF
IF mSimb <= 224 .AND. mSimb <= 239
DrawSimbol(cFont)
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
RETURN nil
* -------------
FUNCTION DisplayFonts( cFont )
LOCAL GetList[0], i, nRow, nCol
cFont := Alltrim(cFont)
nRow := 1
nCol := 0
FOR i := 1 TO 255
@ nRow, nCol DCSAY Str(i,3) FONT '10.Lucida Console' SAYRIGHTBOTTOM SAYSIZE 10
@ DCGUI_ROW, DCGUI_COL + 10 DCSAY Chr(i) FONT cFont SAYSIZE 0 SAYBOTTOM
nRow++
IF nRow % 33 == 0
nRow := 1
nCol += 18
ENDIF
NEXT
DCREAD GUI FIT TITLE 'Displaying Fonts: ' + cFont MODAL
RETURN nil
***********************************************************************************
******** Display a warning message
******** Может выдавать сообщения элементами массива и без ctitle:
*message := {}
*AADD(message,'1-е сообщение')
*AADD(message,'2-е сообщение')
*AADD(message,'3-е сообщение')
*LB_Warning( message )
FUNCTION LB_Warning( message, ctitle )
LOCAL aMsg := {}
DEFAULT cTitle TO ''
IF valtype(message) # 'A'
aadd(aMsg,message)
ELSE
aMsg := message
ENDIF
IF LEN(ALLTRIM(cTitle)) > 0
DC_MsgBox( ,,aMsg,cTitle)
ELSE
DC_MsgBox( ,,aMsg,'(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')
ENDIF
RETURN NIL
**********************************************
******** ВИЗУАЛИЗАЦИЯ СИМВОЛА ****************
**********************************************
FUNCTION DrawSimbol(jj, cFont)
LOCAL GetList := {}, oStatic
PRIVATE nEvent, mp1, mp2, oXbp // Переменные анализа событий
PUBLIC X_MaxW := 1313, Y_MaxW := 640 // Размер графического окна для самого графика в пикселях
@ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE X_MaxW+11, Y_MaxW+20 PIXEL; // Размер окна в пикселях (от Тома)
OBJECT oStatic;
EVAL {|| _PresSpaceSimbol(jj, oStatic, cFont) }
DCREAD GUI ;
TITLE "Рисование изображений символов в системе ЭЙДОС-X++"; // Надпись на окне графика
FIT ;
BUTTONS DCGUI_BUTTON_EXIT
RETURN NIL
*************************************************
STATIC FUNCTION _PresSpaceSimbol(jj, oStatic, cFont )
LOCAL oPS, oDevice
PUBLIC X_MaxW := 1313, Y_MaxW := 640 // Размер графического окна для самого графика в пикселях
oPS := XbpPresSpace():new() // Create a PS
oDevice := oStatic:winDevice() // Get the device context
oPS:create( oDevice ) // Link device context to PS
oPS:SetViewPort( { 0, 0, X_MaxW, Y_MaxW } )
oStatic:paint := {|mp1,mp2,obj| mp1 := LC_DrawSimbol(jj, oPS, oStatic, cFont ) }
RETURN NIL
*******************************************************
STATIC FUNCTION LC_DrawSimbol(jj, oPS, oStatic, cFont )
* mSimbol = VAL(FileStr('_Simb.txt'))
* MsgBox(STR(mSimbol)+' '+CHR(mSimbol))
mSimbol = jj
IF LEN(CHR(mSimbol)) = 0
RETURN NIL
ENDIF
PRIVATE X0 := 0 + X_MaxW/2
PRIVATE Y0 := 5 + Y_MaxW/2 // Начало координат по осям X и Y
PRIVATE W_Wind := X_MaxW - X0 // Ширина окна для самого графика
PRIVATE H_Wind := Y_MaxW - Y0 // Высота окна для самого графика
**** Написать заголовок диаграммы
aFonts := XbpFont():new():list() // Все доступные шрифты
oFont := XbpFont():new():create(cFont)
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 = CHR(mSimbol)
aTxtPar = DC_GraQueryTextbox(mTitle, oFont) // {101,16} Определяет длину и высоту текста в пикселях для некоторых шрифтов
* MsgBox("Длина текста в пикселях="+ALLTRIM(STR(aTxtPar[1]))+". Высота текста в пикселях="+ALLTRIM(STR(aTxtPar[2])))
GraStringAt( oPS, { X_MaxW/2, Y_MaxW/2+aTxtPar[2]+5 }, mTitle)
***** Запись изображения символа в папку с именем - названием шрифта: cFont в виде файла с имененем: Символ: CHR(mSimbol)
cFont = ALLTRIM(cFont)
IF FILEDATE(STRTRAN(cFont,'.','_'),16) = CTOD("//")
DIRMAKE(STRTRAN(cFont,'.','_'))
Mess = 'В папке текущего приложения не было директории: "'+STRTRAN(cFont,'.','_')+'" для изображений символов этого шрифта и она была создана!'
LB_Warning(Mess, 'Рисование изображений символов в системе "ЭЙДОС-X++"' )
ENDIF
cFileName = STRTRAN(cFont,'.','_')+"\Символ: "+CHR(mSimbol)+".bmp"
DC_Scrn2ImageFile( oStatic, cFileName )
RETURN NIL