• Home
 · 
• Windows API Call/Explanation
 · 
• Font orientation in any degree in a picture box control

Font orientation in any degree in a picture box control

Font orientation in any degree in a picture box control

Rate Font orientation in any degree in a picture box control

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
' lfFaceName(LF_FACESIZE) As Byte 'THIS WAS DEFINED IN API-CHANGES MY OWN
  lfFacename As String * 33
End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub CheckVals()
  Command1.Enabled = ((Val(txtDegree.Text) < 360) And Val(txtSize.Text) > 7)
End Sub

Private Sub FontStuff()
  On Error GoTo GetOut
  Dim F As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String
  Dim FONTSIZE As Integer
  FONTSIZE = Val(txtSize.Text)

  F.lfEscapement = 10 * Val(txtDegree.Text) 'rotation angle, in tenths
  FontName = "Arial Black" + Chr$(0) 'null terminated
  F.lfFacename = FontName
  F.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
  hFont = CreateFontIndirect(F)
  hPrevFont = SelectObject(Picture1.hdc, hFont)
  Picture1.CurrentX = Picture1.Width / Screen.TwipsPerPixelX
  Picture1.CurrentY = Picture1.Height / 1.1
  Picture1.Print "Funny Font"
  
'  Clean up, restore original font
  hFont = SelectObject(Picture1.hdc, hPrevFont)
  DeleteObject hFont
  
  Exit Sub
GetOut:
  Exit Sub

End Sub

Private Sub Command1_Click()
  Picture1.Cls
  FontStuff
End Sub


Private Sub txtDegree_Change()
  If Not IsNumeric(txtDegree.Text) Then txtDegree.Text = "90"
  CheckVals
End Sub

Private Sub txtsize_Change()
  If Not IsNumeric(txtSize.Text) Then txtSize.Text = "18"
  CheckVals
End Sub