Code: Select all
*************************************
PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN
*************************************
PROCEDURE Main()
LOCAL GetList := {}, oStatic
LOCAL oPS, oDevice, oDlg
DC_IconDefault(1000)
SET COLLATION TO SYSTEM // Руссификация
@0, 0 DCSAY "Gra Fonts" FONT ("22.HelveticalBold") SIZE 0
PUBLIC X_MaxW := 1280, Y_MaxW := 850 // Размер графического окна в пикселях
kD = 40
FOR ki=1 TO 1681 STEP kD // Цикл по шрифтам
@ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE X_MaxW, Y_MaxW PIXEL; // Размер окна для отображения графика
OBJECT oStatic;
EVAL {|| _PresSpace(oStatic, ki, kD ) }
DCREAD GUI ;
TITLE "Графические шрифты"; // Надпись на окне графика
FIT ;
BUTTONS DCGUI_BUTTON_EXIT
NEXT
RETURN
*************************************************
STATIC FUNCTION _PresSpace( oStatic, ki, kD )
LOCAL oPS, oDevice
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_MultiLine( oPS, oStatic, ki, kD ) }
RETURN NIL
*******************************************************
STATIC FUNCTION LC_MultiLine( oPS, oStatic, mi, mD )
LOCAL GetList[0], GetOptions
LOCAL oSourcePS, oBitmap, oClipBoard, aPos
****** Исследование графических шрифтов
****** Инициализация графического шрифта для надписи внизу графической экранной формы
aFonts := XbpFont():new():list() // Все доступные шрифты
* oFont := XbpFont():new():create("48.Helvetica") // Конкретный шрифт с указанием размера
oFont := aFonts[1] // Конкретный шрифт по номеру из списка (всего доступно 1681 графических шрифтов)
GraSetFont(oPS , oFont) // установить шрифт
aAttrF := ARRAY( GRA_AS_COUNT )
aAttrF [ GRA_AS_COLOR ] := GRA_CLR_BLACK
* aAttrF [ GRA_AS_BOX ] := { 300, 50 } // Размер поля вывода (только для векторных шрифтов)
aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_CENTER // Выравнивание символов по горизонтали по центру относительно точки начала вывода
aAttrF [ GRA_AS_VERTALIGN ] := GRA_VALIGN_HALF // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
GraSetAttrString( oPS, aAttrF )
GraStringAt( oPS, { 200, 10 }, "Всего шрифтов:"+ALLTRIM(STR(LEN(aFonts),15)) )
S = 1
FOR j=mi TO mi+mD
IF j <= 1681
oFont := aFonts[j]
GraSetFont(oPS , oFont) // установить шрифт
aAttrF := ARRAY( GRA_AS_COUNT )
aAttrF [ GRA_AS_COLOR ] := GRA_CLR_BLACK
* aAttrF [ GRA_AS_BOX ] := { 300, 50 } // Размер поля вывода
aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_LEFT // Выравнивание символов по горизонтали по центру относительно точки начала вывода
aAttrF [ GRA_AS_VERTALIGN ] := GRA_VALIGN_HALF // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
GraSetAttrString( oPS, aAttrF ) // Установить символьные атрибуты
GraStringAt( oPS, { 100, 20+(S-1)*20 }, "Шрифт №"+ALLTRIM(STR(j,15))+IF(oFont:vector,"-векторный","") )
S++
ENDIF
NEXT
**** Записать графический файл
cFileName = "Fonts"+STRTRAN(STR(mi,4)," ","0")+"-"+STRTRAN(STR(mi+mD,4)," ","0")+".bmp"
DC_Scrn2ImageFile( oStatic, cFileName )
*** Конец исследования шрифтов ********************
RETURN NIL
FUNCTION DC_Scrn2ImageFile( oXbp, cFileName, nFormat )
LOCAL oSourcePS, oBitmap, oClipBoard, aPos
oSourcePS := oXbp:lockPS()
IF oXbp:isDerivedFrom('XbpDialog')
aPos := { -4, -4 }
ELSE
aPos := { 0, 0 }
ENDIF
oBitmap := GraSaveScreen( oSourcePS, aPos, oXbp:currentSize() )
RETURN oBitMap:saveFile( cFileName, nFormat )