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