api fonts

Share your advanced PureBasic knowledge/code with the community.
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

api fonts

Post by BackupUser »

Code updated for 5.20+ (same as LoadFont() with DrawText() and DrawRotatedText())

Restored from previous forum. Originally posted by Steve.

Code: Select all

; Here' a bit of code that experiments with the 
; api createfont, which I find a bit more flexible
; then PB's font command.
; It must be the longest api, there are 14 parameters,
; most of which can safely be set to 0 - whatever :)
;
; Steve.

;apifont.pb
;tested with pb3.0 and win95

Declare PaintIt()
Quit = 0
#True = 1

If OpenWindow(0, 0, 0, 640, 400, "Api fonts",
              #PB_Window_SystemMenu |
              #PB_Window_ScreenCentered )
  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      Quit = 1
    ElseIf EventID = #PB_Event_Repaint
      If ElapsedMilliseconds() - repaintInterval > 100
        PaintIt()
        repaintInterval = ElapsedMilliseconds()
      EndIf
    EndIf
  Until Quit = 1
EndIf
End   

Procedure PaintIt()
  angle = 0
  color = $00aa3333
  
  *DC = GetDC_(WindowID(0))   ;Get the windows client dc
  SetBkMode_(*DC, #PB_2DDrawing_Transparent)
  
  ;draw some text at different angles
  ;the angle parm is in 1/10th degrees
  For a = 1 To 72
    font1H = CreateFont_(24, 16, angle, 0, 0, 0, 0, 0,
                         0, 0, 0, 0, 0, "Times New Roman")
    SelectObject_(*DC, font1H)
    SetTextColor_(*DC, color)
    TextOut_(*DC, 200, 185, "Pure Basic", 10)
    DeleteObject_(font1H)
    angle = angle + 50
    color = color + $00000040
  Next a
  
  ;underline
  font1H = CreateFont_(30, 14, 0, 0, 0, 0, #True,
                       0, 0, 0, 0, 0, 0, "Courier")
  SelectObject_(*DC, font1H)
  SetTextColor_(*DC, $00ffffff)
  TextOut_(*DC, 410, 90, "Pure Basic", 10)
  DeleteObject_(font1H)
  
  ;italic    
  font1H = CreateFont_(30, 14, 0, 0, 0, #True, 0, 0,
                       0, 0, 0, 0, 0,"Times New Roman")
  SelectObject_(*DC, font1H)
  SetTextColor_(*DC, $0000ffff)
  TextOut_(*DC, 410, 130, "Pure Basic", 10)
  DeleteObject_(font1H)
  
  ; straight down    
  font1H = CreateFont_(30, 16, 2700, 0, 0, 0, 0,
                       0, 0, 0, 0, 0, 0,"Arial")
  SelectObject_(*DC, font1H)
  SetTextColor_(*DC, $0012ee56)
  TextOut_(*DC, 500, 170, "Pure Basic", 10)
  DeleteObject_(font1H)
  ReleaseDC_(WindowID(0), *DC)   ;don't forget this :)  
EndProcedure
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Rings.

nice, thx.


Its a long way to the top if you wanna .....CodeGuru
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by tinman.
; It must be the longest api, there are 14 parameters,
; most of which can safely be set to 0 - whatever :)
IIRC you can also use the CreateFontEx_ API command which takes a pointer to a structure as the only parameter. The structure contains all the data you pass in those 14 parameters, but should be slightly faster because you are only passing one parameter and do not need to set the 0 values every time you call it (unless of course you change them :)

--
It's not minimalist - I'm increasing efficiency by reducing input effort.
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Steve.


;Thanks for that, but did you mean CreatefontIndirect ?

;Which Iam having a problem with, The last entry is
;getting a syntax error.



myfont.LOGFONT
myfont\lfHeight = 20
myfont\lfWidth = 20
myfont\lfEscapement = 0
myfont\lfOrientation = 0
myfont\lfWeight = #FW_BOLD
myfont\lfItalic = 0
myfont\lfUnderline = 0
myfont\lfStrikeOut = 0
myfont\lfCharSet = #ANSI_CHARSET
myfont\lfOutPrecision = #OUT_DEFAULT_PRECIS
myfont\lfClipPrecision = #CLIP_DEFAULT_PRECIS
myfont\lfQuality = #PROOF_QUALITY
myfont\lfPitchAndFamily = #FF_ROMAN
myfont\lfFaceName = "ARIAL" ;***** syntax error reported here *****

font1H = CreateFontIndirect_(@myfont.LOGFONT)
Steve.
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by freak.

Hi Steve,

The problem is, that Windows Structures store Strings as an Array of bytes,
(like lfFaceName.b[#LF_FACESIZE]) because strings have a variable Size, and
size of the Structures should not be variable.

You can set the Font-Face with the following command:

Code: Select all

 PokeS(@myfont\lfFaceName[0], "ARIAL")
Don't forget the [0] at the end because it's an Array.

That's it, hope it helps...

TImo



A debugged program is one for which you have not yet found the conditions that make it fail.


Edited by - freak on 22 April 2002 07:20:47
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Steve.


Ahh now I get it.
Thanks Freak , it works now.

Steve.
Post Reply