FiveTech Support Forums

REDEFINE GET oGet[1] VAR cBFont[1]  ID 110 OF oFld:aDialogs[3]  FONT oFont

REDEFINE SAY oSay[1] PROMPT "Title- font"  ID 120 OF oFld:aDialogs[3]  FONT oBFont[1]   
oSay[1]:lTransparent := .F.
oSay[1]:Setcolor ( nDTxtColor, 16777215 )

REDEFINE BTNBMP oBtn[1] OF oFld:aDialogs[3] ;
ID 130 PIXEL 2007 ;
NOBORDER ;
PROMPT " &1) Title    " ;
FILENAME c_path1 + "Select.Bmp" ;
ACTION ( oFont0 :=  ChooseFont(), ;
     IIF( !empty(oFont0[10]), ;
           ( DeleteObject(oBFont[1]), ; // 1. Font 
             oBFont[1] := BUILDFONT(oFont0), ; 
             cBFont[1] := cFontstr, ; // will be saved to a DBF-field
             oGet[1]:Refresh(), ;
             oSay[1]:SetFont ( oBFont[1] ), oSay[1]:Refresh(), ;
             DeleteObject(oFont0), ;
             oGraph:aFont[1] := oBFont[1], ;                         
             oGraph:Refresh() ), ;
        MsgAlert( "No Font selected ","ATTENTION" ) ) ) ;
FONT oFont  ;
LEFT
oBtn[1]:bClrGrad = { | lMouseOver | If( ! lMouseOver,;
     { { 0.50, 3067734, 16777215 }, ;
     { 0.50, 16777215, 3067734 } }, ;
     { { 0.50, 3145727, 16777215 }, ;
     { 0.50, 16777215, 3145727 } } ) }
oBtn[1]:lTransparent := .t.   
oBtn[1]:cToolTip =  { "Text-Color","Color-Selection", 1, CLR_BLACK, 14089979 }
oBtn[1]:SetColor( 0, )

FUNCTION BUILDFONT( aFont ) 
LOCAL aFTYPE[7], A1, A2, A3, A4, A5, A6

newFont := TFont():New( aFont[ LF_FACENAME ],; 
,; 
aFont[ LF_HEIGHT ],; 
.f.,; 
!( aFont[ LF_WEIGHT ] == 400) ,;
     aFont[ LF_ESCAPEMENT ],; 
     aFont[ LF_ORIENTATION ],; 
     aFont[ LF_WEIGHT ],; 
     aFont[ LF_ITALIC ],; 
     aFont[ LF_UNDERLINE ],; 
     aFont[ LF_STRIKEOUT ],; 
     aFont[ LF_CHARSET ],; 
     aFont[ LF_OUTPRECISION ],; 
     aFont[ LF_CLIPPRECISION ],; 
     aFont[ LF_QUALITY ],; 
     ,; 
     aFont[ LF_PITCHANDFAMILY ] ) 

nHight := INT( aFont[ LF_HEIGHT ] )  

aFTYPE[1]  := ALLTRIM(newFont:cFaceName)
aFTYPE[2]  := 0 // Width
aFTYPE[3]  := newFont:nInpHeight // Size 
aFTYPE[4]  := newFont:lBold
aFTYPE[5]  := 0
aFTYPE[6]  := newFont:lItalic
aFTYPE[7]  := newFont:lUnderline

A1 := LTRIM(STR(aFTYPE[2])) // Width
A2 := LTRIM(STR(aFTYPE[3])) // Size

A3 := ".F." // Bold
IF aFTYPE[4] = .T.
       A3 := ".T."
ENDIF

B_BOLD := aFTYPE[4]

aFTYPE[5]  := 0 // Hor. / Vert.
*IF B_ORIENT = 1
*   aFTYPE[5]  := 900
*ENDIF
A4 := ALLTRIM(STR(aFTYPE[5]))

A5 := ".F."  // Italic
IF aFTYPE[6] = .T.
      A5 := ".T."
ENDIF

B_ITALIC := aFTYPE[6]

A6 := ".F." // Underline
IF aFTYPE[7] = .T.
      A6 := ".T."
ENDIF

B_UNDERL := aFTYPE[7]

// create fontstring ( cFontStr saved to DBF-field-array )
cFontStr :=  '"' + ALLTRIM( aFTYPE[1] ) + '",' + ;
     A1 + "," + A2 + ",.F.," + A3 + "," + A4 + ",0,0," + A5 + "," + A6
// MsgAlert( cFontStr )

RETURN ( newFont )

aPart1 := Array( 10 ) // Font-sections
aPart2 := Array( 4 )  // Logical Font-sections
FOR X := 1 TO 9       // Fonts
     // "Arial",0,-22,F,T,0,0,0,F,F 
     FOR Y := 1 TO 10 // Font-Sectons
          // DBF-font-fields saved to a array
          aPart1[Y] = STRTOKEN( cBFont[X], Y, ',' ) 
          IF Y = 4 // Logic
               IIF( aPart1[Y] = '.T.', aPart2[1] := .T., aPart2[1] := .F. ) // Logic
          ENDIF
          IF Y = 5 // Logic
               IIF( aPart1[Y] = '.T.', aPart2[2] := .T., aPart2[2] := .F. ) // Logic
          ENDIF
          IF Y = 9 // Logic
               IIF( aPart1[Y] = '.T.', aPart2[3] := .T., aPart2[3] := .F. ) // Logic
          ENDIF
          IF Y = 10 // Logic
               IIF( aPart1[Y] = '.T.', aPart2[4] := .T., aPart2[4] := .F. ) // Logic
          ENDIF
          IF Y = 2 .OR. Y = 3 .OR. Y = 6 .OR. Y = 7 .OR. Y = 8 // Numeric
               aPart1[Y] := VAL ( aPart1[Y] )
          ENDIF
     NEXT
     // 9 created fonts
     oBFont[X] :=  TFont():New( aPart1[1], ; 
                                aPart1[2], aPart1[3], aPart2[1], aPart2[2], ;
                                aPart1[6], aPart1[7], aPart1[8], aPart2[3], aPart2[4] )
NEXT