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