PureBasic Forums - English

Posted: **Mon Nov 11, 2002 1:41 pm**

Code updated For 5.20+

Restored from previous forum. Originally posted by Danilo.

Cool Fonts for PureBasic.
(workaround until Fred adds all this)

Example 1 (picture):

Code: Select all

;; Cool Fonts 1, by Danilo - 11.11.2002
;
#FONT_NORMAL    = %00000000
#FONT_BOLD      = %00000001
#FONT_ITALIC    = %00000010
#FONT_UNDERLINE = %00000100
#FONT_STRIKEOUT = %00001000


Procedure CreateFont(Name$,Size,Style)
  If (Style & #FONT_BOLD)      : bold = 700    : EndIf
  If (Style & #FONT_ITALIC)    : italic = 1    : EndIf
  If (Style & #FONT_UNDERLINE) : underline = 1 : EndIf
  If (Style & #FONT_STRIKEOUT) : strikeout = 1 : EndIf
  ProcedureReturn CreateFont_(Size,0,0,0,bold,italic,underline,strikeout,0,0,0,0,0,Name$)
EndProcedure

Procedure CreateMyImage()
  Normal    = CreateFont("Verdana",48,#FONT_NORMAL)
  Bold      = CreateFont("Verdana",48,#FONT_BOLD)
  Italic    = CreateFont("Verdana",48,#FONT_ITALIC)
  Underline = CreateFont("Verdana",48,#FONT_UNDERLINE)
  StrikeOut = CreateFont("Verdana",48,#FONT_STRIKEOUT)
  Combined1 = CreateFont("Verdana",48,#FONT_BOLD|#FONT_UNDERLINE)
  Combined2 = CreateFont("Verdana",48,#FONT_ITALIC|#FONT_UNDERLINE|#FONT_STRIKEOUT|#FONT_BOLD)
  
  image = CreateImage(1,600,400)
  StartDrawing(ImageOutput(1))
  DrawingMode(1)
  FrontColor(RGB($FF,$FF,$00))
  
  
  DrawingFont(Normal)
  DrawText(10,10,"PureBasic - normal")
  DrawingFont(Bold)
  DrawText(10,60,"PureBasic - Bold")
  
  DrawingFont(Italic)
  DrawText(10,110,"PureBasic - Italic")
  
  DrawingFont(Underline)
  DrawText(10,160,"PureBasic - Underline")
  
  DrawingFont(StrikeOut)
  DrawText(10,210,"PureBasic - StrikeOut")
  
  DrawingFont(Combined1)
  DrawText(10,260,"PureBasic - Combined 1")
  
  DrawingFont(Combined2)
  DrawText(10,310,"PureBasic - Combined 2")
  StopDrawing()
  
  DeleteObject_(Normal)   : DeleteObject_(Bold)
  DeleteObject_(Italic)   : DeleteObject_(Underline)
  DeleteObject_(StrikeOut): DeleteObject_(Combined1)
  DeleteObject_(Combined2)
  
  ProcedureReturn image
EndProcedure

OpenWindow(1,100,200,600,400,"Cool Fonts 1",#PB_Window_SystemMenu)

myImage = CreateMyImage()

ImageGadget(1,0,0,600,400,myImage)

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow

Example 2 (gadgets):

Code: Select all

    ;
    ; Cool Fonts 2, by Danilo - 11.11.2002
    ;
    #FONT_NORMAL    = %00000000
    #FONT_BOLD      = %00000001
    #FONT_ITALIC    = %00000010
    #FONT_UNDERLINE = %00000100
    #FONT_STRIKEOUT = %00001000

    Procedure SetNewGadgetFont(Gadget,FontID)
       SendMessage_(GadgetID(Gadget),#WM_SETFONT,FontID,#True)
    EndProcedure

    Procedure CreateFont(Name$,Size,Style)
       If (Style & #FONT_BOLD)      : bold = 700    : EndIf
       If (Style & #FONT_ITALIC)    : italic = 1    : EndIf
       If (Style & #FONT_UNDERLINE) : underline = 1 : EndIf
       If (Style & #FONT_STRIKEOUT) : strikeout = 1 : EndIf
       ProcedureReturn CreateFont_(Size,0,0,0,bold,italic,underline,strikeout,0,0,0,0,0,Name$)
    EndProcedure

    Normal    = CreateFont("Courier",14,#FONT_NORMAL)
    Bold      = CreateFont("Courier",14,#FONT_BOLD)
    Italic    = CreateFont("Courier",14,#FONT_ITALIC)
    Underline = CreateFont("Courier",14,#FONT_UNDERLINE)
    StrikeOut = CreateFont("Courier",14,#FONT_STRIKEOUT)
    Combined1 = CreateFont("Courier",14,#FONT_BOLD|#FONT_UNDERLINE)
    Combined2 = CreateFont("Courier",14,#FONT_ITALIC|#FONT_UNDERLINE|#FONT_STRIKEOUT|#FONT_BOLD)
    Combined3 = CreateFont("Arial"  ,20,#FONT_BOLD|#FONT_UNDERLINE)   

    OpenWindow(1,200,200,200,200,"Cool Fonts",#PB_Window_SystemMenu)

       StringGadget(1,10, 10,180,20,"Normal")     : SetNewGadgetFont(1,Normal)
       StringGadget(2,10, 30,180,20,"Bold")       : SetNewGadgetFont(2,Bold)
       StringGadget(3,10, 50,180,20,"Italic")     : SetNewGadgetFont(3,Italic)
       StringGadget(4,10, 70,180,20,"Underline")  : SetNewGadgetFont(4,Underline)
       StringGadget(5,10, 90,180,20,"StrikeOut")  : SetNewGadgetFont(5,StrikeOut)
       StringGadget(6,10,110,180,20,"Combined 1") : SetNewGadgetFont(6,Combined1)
       StringGadget(7,10,130,180,20,"Combined 2") : SetNewGadgetFont(7,Combined2)

       ButtonGadget(8,70,160, 60,30,"Quit")       : SetNewGadgetFont(8,Combined3)

    Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow Or EventGadget() = 8

    CleanUp:
     DeleteObject_(Normal)   : DeleteObject_(Bold)
     DeleteObject_(Italic)   : DeleteObject_(Underline)
     DeleteObject_(StrikeOut): DeleteObject_(Combined1)
     DeleteObject_(Combined2)

But as you can see, there is a problem with
italic used in Gadgets... other styles work fine.

cya,
...Danilo
(registered PureBasic user)