Generating and saving images of characters
Posted: Tue Jul 07, 2015 1:50 am
To conduct laboratory studies and debugging work with images I have developed (of course, based on the development of Roger) a program generation and conservation of character images:
http://lc.kubagro.ru/Dima/Gen_fonts.rar
But to go to the next image has to press a key that is not always convenient. Is it possible to somehow make that image appear on the screen one by one from the first to the last non-stop?
Can I use functions DC_Scrn2ImageFile () or otherwise somehow saved as an image file, not all window and part of it, given the coordinates?
[/size]
http://lc.kubagro.ru/Dima/Gen_fonts.rar
But to go to the next image has to press a key that is not always convenient. Is it possible to somehow make that image appear on the screen one by one from the first to the last non-stop?
Can I use functions DC_Scrn2ImageFile () or otherwise somehow saved as an image file, not all window and part of it, given the coordinates?
Code: Select all
STATIC snHdll
PROC appsys ; RETURN
*************************
FUNCTION Main()
LOCAL GetList[0], GetOptions, oSay, hDC1, hDC2, oStatic1, oStatic2, ;
aPixel
DC_IconDefault(1000)
PUBLIC aPar[6]
IF .NOT. FILE('_ParGenSimb.arx')
AFILL(aPar, .T.)
aPar[1] = .T.
ELSE
aPar = DC_ARestore("_ParGenSimb.arx")
ENDIF
PUBLIC cFont := Pad('400.Arial Bold',50)
IF .NOT. FILE('_Font.txt')
cFont := Pad('400.Arial Bold',50)
ELSE
cFont = FileStr('_Font.txt')
ENDIF
cFont = cFont + SPACE(50-LEN(ALLTRIM(cFont))+1)
@ 0,0 DCGROUP oGroup1 CAPTION '1. Задание параметров и генерация изображений символов, просмотр таблицы шрифта' SIZE 90.0, 2.5
@ 1,2 DCSAY 'Задайте тип и размер шрифта:' GET cFont POPUP {|c|DC_PopFont(c)} SAYSIZE 0 SAYBOTTOM PARENT oGroup1
@ 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 "1. Задание параметров и генерация изображений символов, просмотр таблицы шрифта"
********************************************************************
IF lExit
** Button Ok
ELSE
RETURN nil
ENDIF
********************************************************************
DC_ASave(aPar, "_ParGenSimb.arx")
ERASE('_Font.txt')
StrFile(ALLTRIM(cFont), '_Font.txt') // Запись текстового файла _Font.txt
FOR mSimb = 1 TO 255
ERASE('_Simb.txt')
StrFile(ALLTRIM(STR(mSimb)), '_Simb.txt') // Запись текстового файла _Simb.txt
* StrFile(ALLTRIM(STR(mSimb)), ConvToAnsiCP("Привет.ini"))
IF aPar[1] // Цифры
IF 48 <= mSimb .AND. mSimb <= 57
DrawSimbol(cFont)
ENDIF
ENDIF
IF aPar[2] // Буквы
IF aPar[3] // Латинские
IF aPar[5] // Заглавные
IF 65 <= mSimb .AND. mSimb <= 90
DrawSimbol(cFont)
ENDIF
ENDIF
IF aPar[6] // Строчные
IF 97 <= mSimb .AND. mSimb <= 122
DrawSimbol(cFont)
ENDIF
ENDIF
ENDIF
IF aPar[4] // Русские
IF aPar[5] // Заглавные
IF 128 <= mSimb .AND. mSimb <= 159
DrawSimbol(cFont)
ENDIF
ENDIF
IF aPar[6] // Строчные
IF 160 <= mSimb .AND. mSimb <= 175
DrawSimbol(cFont)
ENDIF
IF 224 <= mSimb .AND. mSimb <= 239
DrawSimbol(cFont)
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
RETURN nil
* -------------
FUNCTION DisplayFonts( cFont )
LOCAL GetList[0], i, nRow, nCol
cFont = FileStr('_Font.txt')
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
**********************************************
******** ВИЗУАЛИЗАЦИЯ СИМВОЛА ****************
**********************************************
FUNCTION DrawSimbol( cFont)
LOCAL GetList := {}, oStatic
PRIVATE nEvent, mp1, mp2, oXbp // Переменные анализа событий
PUBLIC X_MaxW := 1313, Y_MaxW := 640 // Размер графического окна для самого графика в пикселях
cFont = FileStr('_Font.txt')
@ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE X_MaxW+11, Y_MaxW+20 PIXEL; // Размер окна в пикселях (от Тома)
OBJECT oStatic;
EVAL {|| _PresSpaceSimbol( oStatic, cFont) }
DCREAD GUI ;
TITLE "Рисование изображений символов в системе ЭЙДОС-X++"; // Надпись на окне графика
FIT ;
BUTTONS DCGUI_BUTTON_EXIT
RETURN NIL
*************************************************
STATIC FUNCTION _PresSpaceSimbol( oStatic, cFont )
LOCAL oPS, oDevice
cFont = FileStr('_Font.txt')
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( oPS, oStatic, cFont ) }
RETURN NIL
*******************************************************
STATIC FUNCTION LC_DrawSimbol( oPS, oStatic, cFont )
LOCAL oBitmap
cFont = FileStr('_Font.txt')
mSimbol = VAL(FileStr('_Simb.txt'))
* MsgBox(STR(mSimbol)+' '+CHR(mSimbol))
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)
* DIRCHANGE(M_ApplsPath+"/Inp_data/")
mFontDir = ALLTRIM(cFont)
mFontDir = STRTRAN(mFontDir,' ','_')
mFontDir = STRTRAN(mFontDir,'.','_')
IF FILEDATE(mFontDir,16) = CTOD("//")
DIRMAKE(mFontDir)
Mess = 'В папке текущего приложения не было директории: "'+mFontDir+'" для изображений символов этого шрифта и она была создана!'
LB_Warning(Mess, 'Рисование изображений символов в системе "ЭЙДОС-X++"' )
ENDIF
DIRCHANGE(mFontDir) // Перейти в папку mFontDir
* cFileName = 'CHR'+STRTRAN(STR(mSimbol,3)," ","0")+".bmp" // Если цифры или латинские буквы - имя = сам символ, а иначе код: CHR###
* cFileName = ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
**** Формирование имени графического файла
IF aPar[1] // Цифры
IF 48 <= mSimb .AND. mSimb <= 57
cFileName = "Num "+ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
ENDIF
ENDIF
IF aPar[2] // Буквы
IF aPar[3] // Латинские
IF aPar[5] // Заглавные
IF 65 <= mSimb .AND. mSimb <= 90
cFileName = "Eng Upper "+ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
ENDIF
ENDIF
IF aPar[6] // Строчные
IF 97 <= mSimb .AND. mSimb <= 122
cFileName = "Eng Lower "+ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
ENDIF
ENDIF
ENDIF
IF aPar[4] // Русские
IF aPar[5] // Заглавные
IF 128 <= mSimb .AND. mSimb <= 159
cFileName = "Rus Upper "+ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
ENDIF
ENDIF
IF aPar[6] // Строчные
IF 160 <= mSimb .AND. mSimb <= 175
cFileName = "Rus Lower "+ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
ENDIF
IF 224 <= mSimb .AND. mSimb <= 239
cFileName = "Rus Lower "+ConvToAnsiCP(CHR(mSimbol))+".bmp" // Чтобы в именах файлов можно было использовать русские символы
ENDIF
ENDIF
ENDIF
ENDIF
DC_Scrn2ImageFile( oStatic, cFileName )
* DIRCHANGE(Disk_dir)
DIRCHANGE('..')
***** Джимми ************
* LOCAL oBitmap // В начале
* oBitmap := GraSaveScreen( oPS, oStatic:CurrentPos() , oStatic:CurrentSize() )
* DIRCHANGE(mFontDir) // Перейти в папку mFontDir
* cFileName = 'CHR'+STRTRAN(STR(mSimbol,3)," ","0")+".bmp" // Если цифры или латинские буквы - имя - прямо сам символ, а иначе код: CHR###
* oBitmap:Savefile(cFileName)
* DIRCHANGE("..") // Перейти в текущую папку
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
*******************************************************
