Results 1 to 3 of 3

Thread: Rotating text on picture, and maximum size of picture

  1. #1

    Thread Starter
    Member
    Join Date
    Aug 1999
    Location
    Houston
    Posts
    48
    I changed a font on my picture object (and form) on which I was successfully rotating text, and now the text won't rotate. Are there only certain fonts that will rotate?

    What the max size of a picture? I need to make one that's about 10 inches wide, and 100 inches tall.

    -lp

  2. #2
    transcendental analytic kedaman's Avatar
    Join Date
    Mar 2000
    Location
    0x002F2EA8
    Posts
    7,221
    The max size of a picturebox is always the screen resolution.
    Code:
    maxx = ScaleX(Screen.Height, vbTwips, vbInches)
    maxy = ScaleY(Screen.Width, vbTwips, vbInches)
    Now with screen object they are specified with twips so you convert to inches with scaleX and scaley methods.

    You can't rotate the text with the standard vb methods and objects, you would have to get an activeX control or something to do that
    Use
    writing software in C++ is like driving rivets into steel beam with a toothpick.
    writing haskell makes your life easier:
    reverse (p (6*9)) where p x|x==0=""|True=chr (48+z): p y where (y,z)=divMod x 13
    To throw away OOP for low level languages is myopia, to keep OOP is hyperopia. To throw away OOP for a high level language is insight.

  3. #3
    Fanatic Member Mad Compie's Avatar
    Join Date
    Aug 2000
    Location
    Kuurne (Belgium)
    Posts
    553
    Sure you can rotate fonts:

    use the CreateFont API

    This is some sample found on the net:

    Use a Form with: AutoRedraw = True, BackColor = &H0&, ForeColor = &HFF& and ScaleMode = vbPixels

    Code:
    'Rotating Text Sample
    'Author: Søren Christensen
    'Date: 13-01-99
    
    Option Explicit
    'API's used in this sample
    Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal U As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) 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 Declare Function GetTickCount Lib "kernel32" () As Long
    
    'Constant text to draw
    Const TEXTOUTPUT As String = "www.vbexplorer.com"
    Const PI As Single = 3.141593
    
    'API constants
    Const ANSI_CHARSET As Long = 0
    Const FF_DONTCARE As Long = 0
    Const CLIP_LH_ANGLES As Long = &H10
    Const CLIP_DEFAULT_PRECIS As Long = 0
    Const OUT_TT_ONLY_PRECIS As Long = 7
    Const PROOF_QUALITY As Long = 2
    Const TRUETYPE_FONTTYPE As Long = &H4
    Const p_WIDTH As Long = 12
    Const p_HEIGHT As Long = 12
    
    
    'Center coordinates
    Dim pXCenter As Long
    Dim pYCenter As Long
    
    'LookUp table with relative coordinates
    Dim LookUp(1 To 2, 1 To 36) As Long
    Dim pRadius As Long
    'ending flag
    Dim TimeToEnd As Boolean
    
    'Main animation procedure
    Private Sub RunMain()
    Const FrameInterval As Long = 35
    Dim LastFrameTime As Long
    Dim Angle As Long
    
    'Show the form
    Me.Show
    
    Angle = 1800
    Do
        'check to see if we have to end
        If TimeToEnd Then Exit Do
        
            
            If GetTickCount() - LastFrameTime > FrameInterval Then  'Time to update
                
                'update angle
                Angle = (Angle Mod 3600) - 100
                'clear the form
                Me.Cls
                
                DrawRotatedText Angle
                
                LastFrameTime = GetTickCount()
                            
            End If
            
        DoEvents
    
    Loop
    
    
    End Sub
    'Draws the rotated text
    Private Sub DrawRotatedText(Angle As Long)
    Dim NewFont As Long
    Dim OldFont As Long
    Static I As Long
    
    'creat the font
    NewFont = CreateFont(p_HEIGHT, p_WIDTH, Angle, 0, FF_DONTCARE, 0, 0, 0, ANSI_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_LH_ANGLES Or CLIP_DEFAULT_PRECIS, PROOF_QUALITY, TRUETYPE_FONTTYPE, "Arial")
    
    'set the new font
    OldFont = SelectObject(Me.hdc, NewFont)
    
    I = (I Mod 36) + 1
    
    CurrentX = pXCenter + LookUp(1, I)
    CurrentY = pYCenter + LookUp(2, I)
    
    Print TEXTOUTPUT
    
    'set the old font back
    NewFont = SelectObject(Me.hdc, OldFont)
    
    'Clean up
    DeleteObject NewFont
    
    End Sub
    
    Private Sub Form_Load()
    
    pRadius = ((Len(TEXTOUTPUT) * p_WIDTH) / 2)
    
    BuildLookupTable
    RunMain
    
    End Sub
    
    Private Sub Form_Resize()
    'calculate center
    pXCenter = Me.ScaleWidth / 2
    pYCenter = Me.ScaleHeight / 2
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
    'flag the end
    TimeToEnd = True
    End Sub
    
    'Builds the lookup table with the circle coordinates
    Private Sub BuildLookupTable()
    Dim I As Long
    Dim Angle As Long
    Const XIndex As Long = 1
    Const YIndex As Long = 2
    
    For I = LBound(LookUp, 2) To UBound(LookUp, 2)
        LookUp(XIndex, I) = CLng(Cos((Angle * PI / 180)) * pRadius)
        LookUp(YIndex, I) = CLng(Sin((Angle * PI / 180)) * pRadius)
        Angle = (Angle Mod 360) + 10
    Next I
    
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width