Program for Research 1681 graphic fonts

This forum is for eXpress++ general support.
Message
Author
User avatar
Eugene Lutsenko
Posts: 1649
Joined: Sat Feb 04, 2012 2:23 am
Location: Russia, Southern federal district, city of Krasnodar
Contact:

Re: Program for Research 1681 graphic fonts

#21 Post by Eugene Lutsenko »

Well, now thanks to your help all happened. Thank you very much!


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 )
[/size]

User avatar
rdonnay
Site Admin
Posts: 4813
Joined: Wed Jan 27, 2010 6:58 pm
Location: Boise, Idaho USA
Contact:

Re: Program for Research 1681 graphic fonts

#22 Post by rdonnay »

This will display all the font pages, but I'm not sure you will like what you see.

Code: Select all

#INCLUDE "dcdialog.CH"

*************************************
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

   aFonts := XbpFont():new():list()

   FOR ki=1 TO 1681 STEP kD                // ???? ?? ???????

       @ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE X_MaxW, Y_MaxW PIXEL;
         OBJECT oStatic

       DCREAD GUI FIT ;
         EVAL {||_PresSpace(oStatic,ki,kD,aFonts)}

       oStatic := nil

   NEXT

RETURN
*************************************************
STATIC FUNCTION _PresSpace( oStatic, ki, kD, aFonts )

  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, aFonts ) }

RETURN NIL


*******************************************************
STATIC FUNCTION LC_MultiLine( oPS, oStatic, mi, mD, aFonts )

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

      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 )                        // ?????????? ?????????? ????????

      FOR j := mi TO mi + mD

          oFont := aFonts[j]
          GraSetFont(oPS , oFont)       // ?????????? ?????

          GraStringAt( oPS, { 100, 20+(S-1)*20 }, ;
             "????? No"+ALLTRIM(STR(j,15))+IF(oFont:vector,"-?????????","") )
          S++

      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 )
The eXpress train is coming - and it has more cars.

User avatar
Eugene Lutsenko
Posts: 1649
Joined: Sat Feb 04, 2012 2:23 am
Location: Russia, Southern federal district, city of Krasnodar
Contact:

Re: Program for Research 1681 graphic fonts

#23 Post by Eugene Lutsenko »

This is what I wanted to learn!
And I loved it. I only reduced by 3 times the area displaying vector graphics fonts

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 = 33

   aFonts := XbpFont():new():list()

   FOR ki=1 TO LEN(aFonts) STEP kD                //                

       @ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE X_MaxW, Y_MaxW PIXEL;
         OBJECT oStatic

       DCREAD GUI FIT ;
         EVAL {||_PresSpace(oStatic,ki,kD,aFonts)}

       oStatic := nil

   NEXT

RETURN
*************************************************
STATIC FUNCTION _PresSpace( oStatic, ki, kD, aFonts )

  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, aFonts ) }

RETURN NIL


*******************************************************
STATIC FUNCTION LC_MultiLine( oPS, oStatic, mi, mD, aFonts )

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)) )

      aAttrF := ARRAY( GRA_AS_COUNT ) 
      aAttrF [ GRA_AS_COLOR      ] := GRA_CLR_BLACK 
      aAttrF [ GRA_AS_BOX        ] := { 60, 30 }             // Размер поля вывода для векторных шрифтов
      aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_LEFT        // Выравнивание символов по горизонтали по центру относительно точки начала вывода
      aAttrF [ GRA_AS_VERTALIGN  ] := GRA_VALIGN_HALF        // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
      GraSetAttrString( oPS, aAttrF )                        // Установить символьные атрибуты

      S = 1

      FOR j=mi TO mi+mD-1

          IF j <= LEN(aFonts)

             oFont := aFonts[j] 
             GraSetFont(oPS , oFont)       // установить шрифт

             GraStringAt( oPS, { 100, 20+(S-1)*25 }, "Шрифт №"+ALLTRIM(STR(j,15))+IF(oFont:vector,"-векторный","") )
             S++

          ENDIF

      NEXT

      **** Записать графический файл

      cFileName = "Fonts"+STRTRAN(STR(mi,4)," ","0")+"-"+STRTRAN(STR(mi+mD,4)," ","0")+".gif"
      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 )
[/size]

User avatar
Eugene Lutsenko
Posts: 1649
Joined: Sat Feb 04, 2012 2:23 am
Location: Russia, Southern federal district, city of Krasnodar
Contact:

Re: Program for Research 1681 graphic fonts

#24 Post by Eugene Lutsenko »

Little to improve the program

Code: Select all

#include "appevent.ch"
#include "axcdxcmx.ch"
#include "collat.ch"
#include "common.ch"
#include "dbedit.ch"
#include "dbfdbe.ch"
#include "dcapp.ch"
#include "dcbitmap.ch"
#include "dccargo.ch"
#include "dccursor.ch"
#include "dcdialog.ch"
#include "dcdir.ch"
#include "dcfiles.ch"
#include "dcgra.ch"
#include "dcgraph.ch"        // графика
#include "BdColors.Ch"       // графика
#include "dccolors.ch"       // графика
#include "dcprint.ch"        // графика
*#INCLUDE "rmchart.CH"       // графика
#include "dcicon.ch"
#include "dcmsg.ch"
#include "dcpick.ch"
#include "deldbe.ch"
#include "directry.ch"
#include "dmlb.ch"
#include "express.ch"
#include "fileio.ch"
#include "font.ch"
#include "gra.ch"
#include "inkey.ch"
#include "memvar.ch"
#include "natmsg.ch"
#include "prompt.ch"
#include '_dcdbfil.ch'
*#INCLUDE "dcads.CH"
#include "set.ch"
#include "std.ch"
#include "xbp.ch"
#include '_dcappe.ch'
#include 'dcscope.ch'
#include '_dcstru.ch'
#include 'dcfields.ch'
#include 'dccolor.ch'
#include "Fileio.ch"    // Max_DB

#pragma library( "ascom10.lib" )
#pragma library( "dclip1.lib" )
#pragma library( "dclip2.lib" )
#pragma library( "dclipx.lib" )
#pragma library( "xbtbase1.lib" )
#pragma library( "xbtbase2.lib" )
#pragma library( "xppui2.lib" )

*************************************
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 = 33

   aFonts := XbpFont():new():list()

   FOR ki=1 TO LEN(aFonts) STEP kD                //                

       @ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE X_MaxW, Y_MaxW PIXEL;
         OBJECT oStatic

       DCREAD GUI FIT ;
         EVAL {||_PresSpace(oStatic,ki,kD,aFonts)}

       oStatic := nil

   NEXT

RETURN
*************************************************
STATIC FUNCTION _PresSpace( oStatic, ki, kD, aFonts )

  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, aFonts ) }

RETURN NIL


*******************************************************
STATIC FUNCTION LC_MultiLine( oPS, oStatic, mi, mD, aFonts )

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)) )

      aAttrF := ARRAY( GRA_AS_COUNT ) 
      aAttrF [ GRA_AS_COLOR      ] := GRA_CLR_BLACK 
      aAttrF [ GRA_AS_BOX        ] := { 60, 30 }             // Размер поля вывода для векторных шрифтов
      aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_LEFT        // Выравнивание символов по горизонтали по центру относительно точки начала вывода
      aAttrF [ GRA_AS_VERTALIGN  ] := GRA_VALIGN_HALF        // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
      GraSetAttrString( oPS, aAttrF )                        // Установить символьные атрибуты

      S = 1

      LimJ = IF(mi+mD-1 <= LEN(aFonts), mi+mD-1, LEN(aFonts))

      FOR j=mi TO LimJ

          oFont := aFonts[j] 
          GraSetFont(oPS , oFont)       // установить шрифт

          GraStringAt( oPS, { 100, 20+(S-1)*25 }, "Шрифт №"+ALLTRIM(STR(j,15))+IF(oFont:vector,"-векторный","") )
          S++

      NEXT

      **** Записать графический файл

*     cFileName = "Fonts"+STRTRAN(STR(mi,4)," ","0")+"-"+STRTRAN(STR(LimJ,4)," ","0")+".bmp"
*     DC_Scrn2ImageFile( oStatic, cFileName )
*     cFileName = "Fonts"+STRTRAN(STR(mi,4)," ","0")+"-"+STRTRAN(STR(LimJ,4)," ","0")+".jpg"
*     DC_Scrn2ImageFile( oStatic, cFileName )

      cFileName = "Fonts"+STRTRAN(STR(mi,4)," ","0")+"-"+STRTRAN(STR(LimJ,4)," ","0")+".gif"
      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 )
[/size]

User avatar
Eugene Lutsenko
Posts: 1649
Joined: Sat Feb 04, 2012 2:23 am
Location: Russia, Southern federal district, city of Krasnodar
Contact:

Re: Program for Research 1681 graphic fonts

#25 Post by Eugene Lutsenko »

I studied graphic fonts to make such forms:

Image

Image

but in the end I settled on the fonts which have names and are displayed when viewing fonts, as shown by Roger:

DC_PopFont()

The fact that these fonts are displayed higher quality antialiased pixel steps using color and brightness.

These pictures give function F4_2_2_2() and F4_2_3():
http://lc.kubagro.ru/Install_Aidos-X/_AIDOS-X.doc

Post Reply