Antialiased Screen fonts!

Share your advanced PureBasic knowledge/code with the community.
Post Reply
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:
Contact Num3

Antialiased Screen fonts!

Post by Num3 »

Code updated For 5.20+

Version 2

ClearType Detect :D

Code: Select all

; *************** START OF ANTIALIAS CODE ***************

Structure myFont
  width.l
  spritenb.l
EndStructure

Global Dim Afont.myFont(255)

CompilerIf #PB_OS_Windows
  Procedure.s Reg_GetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s)
    lpData.s
    GetValue.s =""
    
    If Left(sKeyName, 1) = "\"
      sKeyName = Right(sKeyName, Len(sKeyName) - 1)
    EndIf
    
    If ComputerName = ""
      GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
    Else
      lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
      GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
    EndIf
    
    If GetHandle = #ERROR_SUCCESS
      lpcbData = 255
      lpData = Space(255)
      
      GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
      
      If GetHandle = #ERROR_SUCCESS
        Select lType
          Case #REG_SZ
            GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
            
            If GetHandle = 0
              GetValue = Left(lpData, lpcbData - 1)
            Else
              GetValue = ""
            EndIf
            
          Case #REG_DWORD
            GetHandle = RegQueryValueEx_(hKey, sValueName, 0, @lpType, @lpDataDWORD, @lpcbData)
            
            If GetHandle = 0
              GetValue = Str(lpDataDWORD)
            Else
              GetValue = "0"
            EndIf
            
        EndSelect
      EndIf
    EndIf
    RegCloseKey_(hKey)
    ProcedureReturn GetValue
  EndProcedure
CompilerEndIf

Procedure AA_BuildFont(Color.l,Font_ID.l,Font_Y.l)
  
  CompilerIf #PB_OS_Windows_XP
    If Reg_GetValue(#HKEY_CURRENT_USER,"Control Panel\Desktop","FontSmoothingType","")="2"
      DontAA.l=1
    Else
      DontAA.l=0
    EndIf
  CompilerEndIf
  
  If Color=$FF00FF
    Color=$FE00FE
  EndIf
  
  font_color.l=Color.l
  color2=$101010
  i=8
  
  r.f = (Red  (font_color) - Red  (color2))/i
  g.f = (Green(font_color) - Green(color2))/i
  b.f = (Blue (font_color) - Blue (color2))/i
  
  rr.f=Red (font_color)
  gg.f=Green  (font_color)
  bb.f=Blue  (font_color)
  
  color_3=RGB(rr-2*r,gg-2*g,bb-2*b)
  color_2=RGB(rr-4*r,gg-4*g,bb-4*b)
  color_1=RGB(rr-6*r,gg-6*g,bb-6*b)
  
  
  For char=32 To 255
    
    sprite.l=CreateSprite(#PB_Any,1,1)
    
    StartDrawing(SpriteOutput(sprite.l))
    DrawingFont(Font_ID)
    img_length=TextWidth(Chr(char))+1
    StopDrawing()
    
    FreeSprite(sprite.l)
    Afont(char)\width=img_length
    sprite.l=CreateSprite(#PB_Any,img_length,Font_Y*1.5)
    Afont(char)\spritenb=sprite
    
    xsize.l=SpriteWidth(sprite.l)
    ysize.l=SpriteHeight(sprite.l)
    
    StartDrawing(SpriteOutput(sprite.l))
    
    DrawingFont(Font_ID)
    DrawingMode(1)
    FrontColor(RGB(rr,gg,bb))
    DrawText(1,0,Chr(char))
    ;         (
    
    
    If DontAA=0
      
      For xx=0 To xsize-1
        For yy=0 To ysize-1
          
          pixel_intensity=0
          pixel_color.l=Point(xx,yy)
          
          
          If Point(xx-1,yy)=font_color
            pixel_intensity+1
          EndIf
          If Point(xx+1,yy)=font_color
            pixel_intensity+1
          EndIf
          If Point(xx,yy-1)=font_color
            pixel_intensity+1
          EndIf
          If Point(xx,yy+1)=font_color
            pixel_intensity+1
          EndIf
          
          
          If pixel_color=back_color
            Plot(xx,yy,$FF00FF)
          EndIf
          
          
          If pixel_intensity=1
            Plot(xx,yy,color_1)
          ElseIf pixel_intensity=2
            Plot(xx,yy,color_2)
          ElseIf pixel_intensity=3
            Plot(xx,yy,color_3)
          EndIf
          
          
          If pixel_color=font_color
            Plot(xx,yy,font_color)
          EndIf
          
          
        Next
      Next
      
      
    Else
      For xx=0 To xsize-1
        For yy=0 To ysize-1
          
          pixel_intensity=0
          pixel_color.l=Point(xx,yy)
          
          If pixel_color=back_color
            Plot(xx,yy,$FF00FF)
          EndIf
          
          If pixel_color=font_color
            Plot(xx,yy,font_color)
          EndIf
          
          
        Next
      Next
    EndIf
    
    StopDrawing()
  Next
  
EndProcedure

Procedure AA_DrawText(x.l,y.l,Text.s)
  
  For a=1 To Len(Text)
    character.l=Asc(Mid(Text,a,1))
    TransparentSpriteColor(Afont(character.l)\spritenb,RGB(255,0,255))
    DisplayTransparentSprite(Afont(character.l)\spritenb,x,y)
    x+Afont(character.l)\width
  Next
  
EndProcedure

Procedure AA_FreeFont()
  For a=32 To 255
    FreeSprite(Afont(a)\spritenb)
  Next
  Dim Afont.myFont(0)
EndProcedure

; *************** END OF ANTIALIAS CODE ***************




; *************** START OF EXAMPLE ***************

If InitSprite()=0 Or InitKeyboard()=0 : End: EndIf

w=0
size.l=10
Font_ID.l=LoadFont(0,"Impact",size)


Font_red=$CA
Font_green=$9D
Font_blue=$35


If OpenScreen(800,600,32,"")
  
  AA_BuildFont(RGB(Font_red,Font_green,Font_blue),Font_ID,size)
  
  Repeat
    
    If IsScreenActive()
      
      ClearScreen(RGB(20,20,20))
      
      If GetTickCount_() =  > zeit  + 1000
        FrameSek  = Frames
        Frames  = 0
        zeit  = GetTickCount_()
      Else
        Frames  + 1
      EndIf
      
      AA_DrawText(0,0,"FPS: "+Str(FrameSek))
      AA_DrawText(0,40,"I'm a simple test phrase!!!, :P ... -> look at me go -> 1234567890!#$%&/(" )
      
      StartDrawing(ScreenOutput())
      DrawingFont(Font_ID)
      ;           Locate()
      DrawingMode(1)
      FrontColor(RGB(Font_red,Font_green,Font_blue))
      DrawText(0,80,"I'm the same, but *not* anti-aliased!")
      StopDrawing()
      
      Delay(10)
      FlipBuffers()
      ExamineKeyboard()
      
    Else
      
      Delay(100)
      FlipBuffers()
      
    EndIf
    
  Until KeyboardPushed(#PB_Key_Escape)
  
  AA_FreeFont()
  
  CloseScreen()
  
  
EndIf
End

; *************** END OF EXAMPLE ***************

; IDE Options = PureBasic v3.94 (Windows - x86)
; CursorPosition = 141
; FirstLine = 125
; Folding = -
Last edited by Num3 on Sun Aug 28, 2005 4:14 pm, edited 1 time in total.
Top
Jellybean
User
User
Posts: 95
Joined: Wed Aug 24, 2005 7:33 pm

Post by Jellybean »

If a Windows XP user has font smoothing turned off, your code first draws an anti-aliased line of text, then a line of text without antialiasing.

If a Windows XP user has font smoothing turned on (to clear type), your code first draws a line of "more or less antialiased" text with holes in it, then a line of text with antialiasing.

Just thought you would know...
Top
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:
Contact Num3

Post by Num3 »

That's because i'm smoothing an already anti-aliased font :P
(Anyway how many people you know have that on ?)


Anyone knows a way to detect if ClearType is running?


--- EDIT ---

Fixed ! :D
Last edited by Num3 on Sun Aug 28, 2005 4:17 pm, edited 1 time in total.
Top
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

It works nicely here. I dont have ClearType on.
Top
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

@Num3: Not tested but how about this to check for ClearType?

Code: Select all

SystemParametersInfo_(#SPI_GETFONTSMOOTHING, 0, @On_Off, 0)
Debug On_Off
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
Top
Post Reply

Return to “Tricks 'n' Tips”