Date: 02-16-2022
Return to Index
created by gbSnippets
'Credit: Borje
'Compilable Example: (Jose Includes)
'������������������������������������������������������������������������������
' Simple Font rotation in PB by Borje Hagsten, July 2000
' Public Domain
'������������������������������������������������������������������������������
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Include "WIN32API.INC"
Declare Sub RotateText(ByVal hWnd&, ByVal degr%, ByVal Txt$, ByVal x&, ByVal y&)
'������������������������������������������������������������������������������
' Callback for dialog and controls
'������������������������������������������������������������������������������
CallBack Function DlgCallback()
Select Case CbMsg
Case %WM_InitDialog
Static Angle As Integer
Angle = 315
Case %WM_Command
Select Case CbCtl
Case %IdOk
Angle = Angle + 45 : If Angle > 360 Then Angle = 45
InvalidateRect CbHndl, ByVal %NULL, 0 : UpdateWindow CbHndl
Case %IdCancel
Dialog End CbHndl, 1
End Select
Case %WM_Paint
RotateText CbHndl, Angle, "Hello World!", 110, 110
Function = 0
End Select
End Function
'������������������������������������������������������������������������������
' Create dialog and controls
'������������������������������������������������������������������������������
Function PBMain () As Long
Local hDlg As Long
Dialog New 0, "PB Rotate text sample",,, 150, 175, %WS_SysMenu, 0 To hDlg
Control Add Button, hDlg, %IdOk, "Rotate", 15, 140, 60, 14
Control Add Button, hDlg, %IdCancel, "E&xit", 75, 140, 60, 14
Dialog Show Modal hDlg Call DlgCallback
End Function
'������������������������������������������������������������������������������
' Rotate text in any angle (degr%) - x and y are Left and Top position of text
'������������������������������������������������������������������������������
Sub RotateText(ByVal hWnd&, ByVal degr%, ByVal Txt$, ByVal x&, ByVal y&)
Local lFont As LOGFONT, rc As RECT
Local hDc As Long, hfont As Long, newfont As Long
If degr% = 0 Then degr% = 360
lFont.lfescapement = degr% * 10 '<- Set Angle
lFont.lforientation = degr% * 10
lFont.lfHeight = -18 '<- Font Size
lFont.lfWeight = %FW_BOLD '<- Bold
lFont.lfItalic = %FALSE
lFont.lfCharSet = %ANSI_CHARSET
lFont.lfOutPrecision = %OUT_TT_PRECIS
lFont.lfClipPrecision =%CLIP_DEFAULT_PRECIS
lFont.lfQuality = %DEFAULT_QUALITY
lFont.lfPitchAndFamily = %FF_DONTCARE
lFont.lfFaceName = "Times New Roman" '<- Font Name
'create font and assign handle to a variable
hFont = CreateFontIndirect(ByVal VarPtr(lFont))
hDC = getDc(hWnd&)
newfont = selectobject(hDC, hfont)
GetClientRect hWnd&, rc : rc.nBottom = rc.nBottom - 40
FillRect hDC, rc, GetStockObject(%LTGRAY_BRUSH) '<- Erase background
SetBkColor hDC, RGB(192, 192, 192)
SetTextColor hDC, RGB(128, 0, 128)
TextOut hDC, x&, y&, ByVal StrPtr(Txt$), Len(Txt$) '<- Print text
DeleteObject SelectObject(hDC, newfont)
ReleaseDC hWnd&, hDC
End Sub
'gbs_00909
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm