Rotate Text

Category: Rotation

Date: 03-28-2012

Return to Index


 
'Credit: Borje
 
'Compilable Example:
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' 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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm