Results 1 to 35 of 35

Thread: Rotated text

  1. #1

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Rotated text

    I have found this code for printing rotated text on a picturebox somewhere and have modified it, but apparently not properly,as it does not want to print transparent text.

    If someone can help me make it a robust routine I would appreciate it.

    In my declarations I have:
    Code:
    Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LogFont) As Long
    Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long                                                 ' or Boolean
    
    Public Const LF_FACESIZE = 32
    Public 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 As String * LF_FACESIZE
    End Type
    Code:
    Public Sub PrintRotatedText(pic As PictureBox, MyText As String, X As Single, Y As Single, Degrees As Single, FontName As String, FontSize As Integer, FontBold As Boolean, FontTransparent As Boolean, Optional FontItalic As Boolean = False, Optional FontUnderline As Boolean = False)
    Dim Angle As Long, Pic_hDC As Long, Log_Font As LogFont, New_Font As Long, Old_Font As Long
    Dim picFontname As String, picFontsize As Integer, picFontTransparent As Boolean, picFontBold As Boolean, picFontItalic As Boolean, picFontUnderline As Boolean, picForeColour As Long, picScaleMode As Integer
    
    'get the default properties of this picturebox
    picFontname = pic.FontName
    picFontsize = pic.FontSize
    picFontTransparent = pic.FontTransparent
    picFontItalic = pic.FontItalic
    picFontUnderline = pic.FontUnderline
    picFontBold = pic.FontBold
    picForeColour = pic.ForeColor
    picScaleMode = pic.ScaleMode
    
    pic.FontTransparent = FontTransparent
    'pic.ScaleMode = vbTwips
    pic.FontName = FontName
    pic.FontSize = FontSize
    pic.FontBold = FontBold
    pic.FontItalic = FontItalic
    pic.FontUnderline = FontUnderline
    pic.FontTransparent = FontTransparent
    'Picture1.FontStrikethru = False
    'Picture1.Print "A Rotated Text Example"
    With pic
        X = .ScaleX(X - .ScaleLeft, .ScaleMode, vbPixels)
        Y = .ScaleY(Y - .ScaleTop, .ScaleMode, vbPixels)
        Pic_hDC = .hDC
    End With
    With Log_Font
        .lfEscapement = Degrees * 10
        .lfHeight = pic.FontSize / Printer.TwipsPerPixelY
        .lfFaceName = FontName & vbNullChar
        .lfWeight = IIf(pic.FontBold = True, 700, 400)
        .lfItalic = FontItalic
        .lfUnderline = FontUnderline
    End With
    New_Font = CreateFontIndirect(Log_Font)
    Old_Font = SelectObject(Pic_hDC, New_Font)
    Call TextOut(Pic_hDC, X, Y, MyText, Len(MyText))
    Call SelectObject(Pic_hDC, Old_Font)
    Call DeleteObject(New_Font)
    
    'reset the default properties of this picturebox
    pic.FontName = picFontname
    pic.FontSize = picFontsize
    pic.FontTransparent = picFontTransparent
    pic.FontItalic = picFontItalic
    pic.FontUnderline = picFontUnderline
    pic.FontBold = picFontBold
    pic.ForeColor = picForeColour
    'pic.ScaleMode = picScaleMode
    
    End Sub
    Thanks
    PK

  2. #2
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,163

    Re: Rotated text

    After a litle searching I found this: https://social.msdn.microsoft.com/Fo...forum=winforms.

    Does that help?

  3. #3
    Member
    Join Date
    Nov 2020
    Posts
    32

    Re: Rotated text

    Quote Originally Posted by Peter Swinkels View Post
    .

    Does that help?
    No because is for C#, not for VB6

  4. #4

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Quote Originally Posted by Peter Swinkels View Post
    After a litle searching I found this: https://social.msdn.microsoft.com/Fo...forum=winforms.

    Does that help?
    Unfortunately the link is written in C#.
    PK

  5. #5
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    4,426

    Re: Rotated text

    Maybe this code sample is of any help to you:
    http://www.vb-helper.com/howto_center_rotated_text.html

    And another sample on VBForums with some explanations:
    https://www.vbforums.com/showthread....-I-Rotate-Text
    Last edited by Arnoutdv; Apr 14th, 2021 at 04:02 AM.

  6. #6
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,163

    Re: Rotated text

    @peekay: as far as I can tell it uses the API. It should be possible to translate the code.

  7. #7

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Thanks so much Arnoutdv, I will study that.

    Peter Swinkels, I do not know C# or D# apart from playing the piano. Sorry.

    PK

  8. #8
    Frenzied Member
    Join Date
    Mar 2008
    Posts
    1,182

    Re: Rotated text

    Did you try using ..
    Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
    'with nBkMode Constants
    Public Const TRANSPARENT = 1
    Public Const OPAQUE = 2

    ..before printing

  9. #9

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Quote Originally Posted by Magic Ink View Post
    Did you try using ..
    Public Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
    'with nBkMode Constants
    Public Const TRANSPARENT = 1
    Public Const OPAQUE = 2

    ..before printing
    I am experimenting with that as suggested by Olaf in #2 of https://www.vbforums.com/showthread....ansparent-text

    Done experimenting. It works excellently.

    PK
    Last edited by Peekay; Apr 14th, 2021 at 10:54 PM.

  10. #10

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Quote Originally Posted by Arnoutdv View Post
    Maybe this code sample is of any help to you:
    http://www.vb-helper.com/howto_center_rotated_text.html

    And another sample on VBForums with some explanations:
    https://www.vbforums.com/showthread....-I-Rotate-Text
    In the latter link given there is this routine:

    Code:
    Public Sub GetCurrentLogFont(Byval frmIn As Form, lfIn as LOGFONT)
    What parameter would I use for lfIn? It's most probably a property of my picturebox, but would picture1.font be a logfont?

    Thanks
    PK

  11. #11

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    I have studied and implemented the code of both links given above.

    In fact, both links of Arnoutdv give different and unworkable implementations of the font name, rotation and size.
    Is there somebody with a simple routine not involving unnecessary, unreadable and faulty code?

    Thanks
    PK

  12. #12
    PowerPoster
    Join Date
    Feb 2006
    Posts
    22,171

    Re: Rotated text

    It is probably quicker to just look up the GDI calls yourself. Most of the documentation that came with VB6 is still current enough for most purposes, making the process quicker than searching the web for updated versions of the info.

    Here I target the Form (AutoRedraw = True) itself rather than a PictureBox, but the calls are the same:

    Code:
    Private Sub Form_Load()
        Dim Text As String
        Dim TextColorPrev As Long
        Dim LOGFONT As LOGFONT
        Dim hFont As Long
        Dim hFontPrev As Long
        Dim BkColorPrev As Long
        Dim BkModePrev As BkModes
    
        'Use current font w/o rotation:
        Text = "Plain Text"
        TextColorPrev = SetTextColor(hDC, vbWhite)
        TextOut hDC, 0, 0, StrPtr(Text), Len(Text)
    
        'Use rotated font:
        Text = "Rotated Text"
        With LOGFONT
            .lfEscapement = -900
            .lfOrientation = -900
            .lfHeight = -ScaleY(Font.Size, vbPoints, vbPixels)
            .lfWeight = IIf(Font.Bold, 700, Font.Weight)
            .lfItalic = Font.Italic
            .lfUnderline = Font.Underline
            .lfStrikeOut = Font.Strikethrough
            .lfCharSet = Font.Charset
            .lfFaceName = Font.Name & vbNullChar
        End With
        hFont = CreateFontIndirect(VarPtr(LOGFONT))
        hFontPrev = SelectObject(hDC, hFont)
        SetTextColor hDC, vbYellow
        TextOut hDC, _
                ScaleX(ScaleWidth * 3 / 8, ScaleMode, vbPixels), _
                ScaleY(ScaleHeight / 8, ScaleMode, vbPixels), _
                StrPtr(Text), _
                Len(Text)
        
        'More, with opaque background:
        Text = "More Rotated Text"
        SetTextColor hDC, vbCyan
        BkColorPrev = SetBkColor(hDC, vbBlue)
        BkModePrev = SetBkMode(hDC, BM_OPAQUE)
        TextOut hDC, ScaleX(ScaleWidth * 3 / 4, ScaleMode, vbPixels), 0, StrPtr(Text), Len(Text)
        SetBkMode hDC, BkModePrev
        SetBkColor hDC, BkColorPrev
    
        'More, with original unrotated font:
        Text = "More Plain Text"
        SelectObject hDC, hFontPrev
        DeleteObject hFont
        SetTextColor hDC, vbGreen
        TextOut hDC, _
                ScaleX(ScaleWidth / 4, ScaleMode, vbPixels), _
                ScaleY(ScaleHeight * 7 / 8, ScaleMode, vbPixels), _
                StrPtr(Text), _
                Len(Text)
    
        'Use another rotated font:
        Text = "abcde"
        With LOGFONT
            .lfEscapement = 450
            .lfOrientation = 450
            .lfHeight = -ScaleY(Font.Size * 1.75, vbPoints, vbPixels)
            .lfWeight = 700
            .lfCharSet = SYMBOL_CHARSET
            .lfFaceName = "Wingdings" & vbNullChar
        End With
        hFont = CreateFontIndirect(VarPtr(LOGFONT))
        hFontPrev = SelectObject(hDC, hFont)
        SetTextColor hDC, vbRed
        TextOut hDC, _
                ScaleX(ScaleWidth / 32, ScaleMode, vbPixels), _
                ScaleY(ScaleHeight * 7 / 8, ScaleMode, vbPixels), _
                StrPtr(Text), _
                Len(Text)
    
        'Clean up:
        SelectObject hDC, hFontPrev
        DeleteObject hFont
        SetTextColor hDC, TextColorPrev
    End Sub
    Name:  sshot.png
Views: 133
Size:  3.5 KB

    But perhaps I have misunderstood what you are after and so maybe this doesn't answer your questions.
    Attached Files Attached Files

  13. #13

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    dilettante,

    Excellent, exactly what I need, thanks.

    I get an error 'byref argument type mismatch' in this code line:
    Code:
    hFont = CreateFontIndirect(VarPtr(LOGFONT))
    And I presume I would also get an error in this (not there yet):
    Code:
    StrPtr(Text)
    Why would that be?

    Thanks,
    PK

    (PS - As always you are on the money!)
    Last edited by Peekay; Apr 17th, 2021 at 11:05 PM.

  14. #14
    PowerPoster
    Join Date
    Feb 2006
    Posts
    22,171

    Re: Rotated text

    You need to compare declarations.

    You were using the ANSI calls which in VB6 results in translation to and then back from ANSI, wasting CPU time on two conversions.

    Unicode (wide) calls don't waste that extra time and accept a broader range of characters, but you must explicitly pass pointers ByVal for a String or UDT argument. Using those types tells VB6 you want translation to and fro. This is a legacy of 16-bit VB.

    The ancient ANSI calls left over from 16-bit Windows will work for this, but you must make sure your declarations match your intent.


    This is covered in the VB6 documentation: "Accessing DLLs and the Windows API." Sadly those articles no longer seem to be online in these days of Microsoft's final decline. Look for this in your MSDN CD Docs.

  15. #15

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Quote Originally Posted by dilettante View Post
    You need to compare declarations.

    You were using the ANSI calls which in VB6 results in translation to and then back from ANSI, wasting CPU time on two conversions.

    Unicode (wide) calls don't waste that extra time and accept a broader range of characters, but you must explicitly pass pointers ByVal for a String or UDT argument. Using those types tells VB6 you want translation to and fro. This is a legacy of 16-bit VB.

    The ancient ANSI calls left over from 16-bit Windows will work for this, but you must make sure your declarations match your intent.

    This is covered in the VB6 documentation: "Accessing DLLs and the Windows API." Sadly those articles no longer seem to be online in these days of Microsoft's final decline. Look for this in your MSDN CD Docs.

    I have tried under the topic and under Adresses in the content search section where they give some code, but none of it is comprehensible for me.
    I do pass the parameters to that routine byval, but it does not help.

    Here is my code:

    Code:
    Friend Sub PrintRotatedText(pic As PictureBox, ByVal Text As String, ByVal TextColour As Long, ByVal Xpos As Single, ByVal Ypos As Single, ByVal Angle As Long, FontSize As Integer, FontBold As Boolean, FontTransparent As Boolean, Optional FontWeight As Integer = 400, Optional FontItalic As Boolean = False, Optional FontUnderline As Boolean = False, Optional FontStrikeThrough As Boolean = False)
    Dim TextColorPrev As Long
    Dim LOGFONT As LOGFONT
    Dim hFont As Long
    Dim hFontPrev As Long
    Dim BkColorPrev As Long
    Dim BkModePrev As BkModes
    
    
    'Use rotated font:
    With LOGFONT
        .lfEscapement = 10 * Angle
        .lfOrientation = 10 * Angle
        .lfHeight = -ScaleY(FontSize, vbPoints, vbPixels)
        .lfWeight = IIf(FontBold, 700, FontWeight)
        .lfItalic = FontItalic
        .lfUnderline = FontUnderline
        .lfStrikeOut = Font.Strikethrough
        .lfCharSet = Charsets.ANSI_CHARSET
        .lfFaceName = "Verdana" & vbNullChar
    End With
    hFont = CreateFontIndirect(VarPtr(LOGFONT))
    hFontPrev = SelectObject(pic.hDC, hFont)
    BkColorPrev = SetBkColor(pic.hDC, pic.BackColor)
    BkModePrev = SetBkMode(pic.hDC, pic.FontTransparent)
    TextColorPrev = pic.ForeColor
    SetTextColor pic.hDC, TextColour
    SetBkMode hDC, BM_TRANSPARENT
    TextOut pic.hDC, pic.ScaleX(ScaleWidth * 3 / 8, picScaleMode, vbPixels), picScaleY(ScaleHeight / 8, pic.ScaleMode, vbPixels), StrPtr(Text), Len(Text)
    SetBkMode hDC, BkModePrev
    SetBkColor hDC, BkColorPrev
    pic.ForeColor = TextColorPrev
    
    'Clean up:
    SelectObject hDC, hFontPrev
    DeleteObject hFont
    SetTextColor hDC, TextColorPrev
    Exit Sub
    
    End Sub

    PK

  16. #16
    PowerPoster
    Join Date
    Feb 2006
    Posts
    22,171

    Re: Rotated text

    As I said, your Declare statements are incorrect. Look at the ones in the code I uploaded.

  17. #17

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Ok, it works perfectly now, thanks.

    PK

  18. #18

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    dilettante,
    Still some teething problems, if you please.
    Please look at my latest routine, which works without error, but:
    1. I get Chinese characters.
    2. The fontsize I pass to the routine is converted from vbPoints to vbPixels. Is a fontsize of 9, also 9 in vbPoints?
    3. The position of the text is still wrong. I pass it in scale units. Is that right?
    4. Why is the scalewidth multiplied by 3/8 and the scaleheight divided by 8 in the routine?
    5. Is there any bug in the routine which you can see?

    Code:
    Friend Sub PrintRotatedText(pic As PictureBox, ByVal Text As String, ByVal TextColour As Long, ByVal Xpos As Single, ByVal Ypos As Single, ByVal Angle As Long, FontSize As Integer, FontBold As Boolean, FontTransparent As Boolean, Optional FontWeight As Integer = 400, Optional FontItalic As Boolean = False, Optional FontUnderline As Boolean = False, Optional FontStrikeThrough As Boolean = False)
    Dim TextColorPrev As Long
    Dim LOGFONT As LOGFONT
    Dim hFont As Long
    Dim hFontPrev As Long
    Dim BkColorPrev As Long
    Dim BkModePrev As BkModes
    
    With LOGFONT
        .lfEscapement = 10 * Angle
        .lfOrientation = 10 * Angle
        .lfHeight = -pic.ScaleY(FontSize, vbPoints, vbPixels)
        .lfWeight = IIf(FontBold, 700, FontWeight)
        .lfItalic = FontItalic
        .lfUnderline = FontUnderline
        .lfStrikeOut = Font.Strikethrough
        .lfCharSet = Charsets.ANSI_CHARSET
        .lfFaceName = "Verdana" & vbNullChar
    End With
    
    BkColorPrev = SetBkColor(pic.hDC, pic.BackColor)
    BkModePrev = SetBkMode(pic.hDC, pic.FontTransparent)
    TextColorPrev = pic.ForeColor
    
    'Use current font w/o rotation:
    If Angle = 0 Then
        TextColorPrev = SetTextColor(hDC, vbBlack)
        TextOut pic.hDC, 0, 0, StrPtr(Text), Len(Text)
    Else
    'Use rotated font:
        hFont = CreateFontIndirect(VarPtr(LOGFONT))
        hFontPrev = SelectObject(pic.hDC, hFont)
        SetTextColor pic.hDC, TextColour
        SetBkMode hDC, BM_TRANSPARENT
        TextOut pic.hDC, pic.ScaleX(pic.ScaleWidth * 3 / 8, pic.ScaleMode, vbPixels), pic.ScaleY(pic.ScaleHeight / 8, pic.ScaleMode, vbPixels), StrPtr(Text), Len(Text)
    End If
    
    SetBkMode pic.hDC, BkModePrev
    SetBkColor pic.hDC, BkColorPrev
    pic.ForeColor = TextColorPrev
    SelectObject pic.hDC, hFontPrev
    DeleteObject hFont
    SetTextColor pic.hDC, TextColorPrev
    Exit Sub
    
    End Sub
    Thanks
    PK
    Last edited by Peekay; Apr 18th, 2021 at 03:30 AM.

  19. #19
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,419

    Re: Rotated text

    Just in case you don't want to invest "another week" into that simple problem...

    You have the RC5 (or even RC6) installed on your machine...

    So, why don't you use its Drawing-Classes, to solve this problem with less code, via a modern drawing-lib (antialiased)?

    Is it, because the cairo-Objects are "too virtual" (too abstract)?
    ... and that you "have to see something like a PictureBox" on your Form first?

    However, maybe the following code can help you with that first step -
    ensuring "a PictureBox-like Cairo-Canvas-Setup" on a given VB-ParentForm...

    Code:
    Option Explicit
    
    Private PB As cCairoContext
    
    Private Sub Form_Load()
      Set PB = Cairo.CreateSurface(200, 200).CreateContext '<- define the size of your "PicBox" here
      Me.Caption = "Form contains a cairo-PicBox with " & PB.Surface.Width & "x" & PB.Surface.Height & " Pixels"
    End Sub
    
    Private Sub Form_Resize()
      RefreshPBAtOffs 20, 20 '<- define the placement-offsets of the cairo-PicBox on the Form
    End Sub
    
    Public Sub RefreshPBAtOffs(xPxl, yPxl)
      Me.AutoRedraw = True: Cls
        PB.Paint 1, Cairo.CreateSolidPatternLng(vbWhite) 'clear the BackGround (currently in white)
        PB_Paint 'here we call a Sub-routine, named similar to a PicBox_Paint-EventHandler
        PB.Surface.DrawToDC Me.hDC, xPxl, yPxl 'reflect the PB-contents on the Form.hDC
      Me.Refresh
    End Sub
    
    Private Sub PB_Paint() 'here you can now finally place your own drawing-calls, using the PB-Object
      '...
    End Sub
    The above code will produce a "PictureBox-like area having a white Background" (on an otherwise empty Form)


    Ok, the above is "generic" - and could be copied as a "starting-setup, as is",
    onto any other empty Form, where you might need such a PicBox-like cairo-Canvas-area.

    As for concrete Drawing-Code (to be placed in the Event-like "PB_Paint()" routine) -
    perhaps we should start with drawing "simple lines" ... though (judging from your recent Map-threads) -
    we should probably define a small wrapper-routine, which accepts PolarCoords (cx, cy, AngleDeg, Length, ...).
    Code:
    Sub DrawLinePolar(ByVal cx#, ByVal cy#, ByVal AngleDeg#, ByVal Length#, Optional ByVal LineColor&, Optional ByVal LineWidth# = 2)
      PB.Save: PB.TranslateDrawings cx, cy: PB.RotateDrawingsDeg AngleDeg 'save, and transform to PolarCoord-mode
         PB.DrawLine 0, 0, Abs(Length), 0, False, LineWidth, LineColor
      PB.Restore 'restore the previous coord-sys upon return from this routine
    End Sub
    After defining the above DrawLinePolar()-helper, we can now use it within the "Paint-Event" this way:
    Code:
    Private Sub PB_Paint() 'here you can now finally place your own drawing-calls
      DrawLinePolar 15, 70, -30, 90, vbBlue, 3
    
      DrawLinePolar 55, 100, 0, 90, vbCyan, 2
    
      DrawLinePolar 100, 130, 30, 90, vbGreen, 1
    End Sub
    Now producing this output on your white PB-area on the Form...
    (3 lines, having Line-Widths: 3, 2 and 1...)


    Ok, now to the TextOutput ... why not define a second helper-routine,
    which accepts the same first 4 "Polar-Coord-arguments" as the LineDrawing-Helper?
    Code:
    Sub DrawTextPolar(ByVal cx#, ByVal cy#, ByVal AngleDeg#, ByVal Length#, Text$, Optional ByVal TextColor&, Optional ByVal Align As AlignmentConstants, Optional ByVal BaseLineDistance#, Optional ByVal FontName$ = "Arial", Optional ByVal FontSize# = 10, Optional ByVal FontBold&, Optional ByVal FontItalic&)
      PB.Save: PB.TranslateDrawings cx, cy: PB.RotateDrawingsDeg AngleDeg 'save, and transform to PolarCoord-mode
         PB.SelectFont FontName, FontSize, , FontBold, FontItalic 'first select the current font...
         Dim TX#, TW#: TW = PB.GetTextExtents(Text) 'so that we get the right TextWidth-measurement
         Select Case Align
           Case vbCenter:       TX = (Abs(Length) - TW) / 2
           Case vbRightJustify: TX = (Abs(Length) - TW)
         End Select
         PB.TranslateDrawings TX, -BaseLineDistance 'x-alignment + slight "uplifting" of the text relative to the BaseLine
         
         PB.TextOut 0, 0, Text, True, 1, True
         PB.Fill , Cairo.CreateSolidPatternLng(TextColor)
      PB.Restore 'restore the previous coord-sys upon return from this routine
    End Sub
    Ok, and the adjusted Paint-Event-like routine again, which makes use of that new Helper-Sub:
    Code:
    Private Sub PB_Paint() 'here you can now finally place your own drawing-calls
      DrawLinePolar 15, 70, -30, 90, vbBlue, 3
      DrawTextPolar 15, 70, -30, 90, "Left aligned", vbRed, vbLeftJustify, 3 / 2 + 1
    
      DrawLinePolar 55, 100, 0, 90, vbCyan, 2
      DrawTextPolar 55, 100, 0, 90, "Centered", vbBlack, vbCenter, 2 / 2 + 1
    
      DrawLinePolar 100, 130, 30, 90, vbGreen, 1
      DrawTextPolar 100, 130, 30, 90, "Right aligned", vbMagenta, vbRightJustify, 1 / 2 + 1
    End Sub
    So, the polar Text-Outputs will "follow" the polar Line-Outputs exactly -
    (since they got passed the same first 4 arguments) - and will now produce this:



    HTH

    Olaf

  20. #20

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Hi Olaf,

    Is it, because the cairo-Objects are "too virtual" (too abstract)?
    ... and that you "have to see something like a PictureBox" on your Form first?
    You are partly right. The parts of RC5 with which I worked already are excellent, but I do not know it well and I do not have a manual to guide me.

    In any case I am going to give your code a try as well, and you always spend so much time helping me. Thanks

    PK

  21. #21

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Olaf,

    I have downloaded RC6 and registered it in place.
    I have placed the RC6 in my Project References.
    I have 'Public pb As cCairoContext' in my module where I declare public variables.
    I have 'Set pb = Cairo.CreateSurface(200, 200).CreateContext' in my Form_Load routine.
    When it comes to the latter is says: 'Invalid use of property'

    PK

  22. #22
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,419

    Re: Rotated text

    Quote Originally Posted by Peekay View Post
    ...I do not know it well and I do not have a manual to guide me.
    That's not really true.

    The RC5/RC6 vector-drawing-classes do follow the original cairo-API quite well (you even get Intellisense-Popups) -
    therefore you can google easily for the original cairo-API - e.g. with regards to "transforms" (translate, rotate, scale):
    https://developer.gnome.org/cairo/st...airo-translate

    This explains in normal english, what the underlying routines will do to your current coord-system.

    In addition, there is a VB6-code-based Cairo-Tutorial with concrete Examples over 20 separate example-folders here:
    https://www.vbforums.com/showthread....cs-using-Cairo

    No other drawing-lib for VB6 has this kind of coverage (e.g. the above mentioned "transforms" are explained in "Folder #2").

    Quote Originally Posted by Peekay View Post
    ...you always spend so much time helping me...
    That's because I know, that you will not be able to solve your current problem of:
    "drawing advanced stuff properly onto a shiftable, zoomable google-map-background image"
    in a stable, visually satisfying manner without using "Transforms and the related, underlying Transform-Matrices".

    If I make a guess, you have probably invested *at most* half a day into "learning cairo" -
    that's not enough by far... but as I see it, you have "invested" the last 2 weeks on:
    - "trying to solve stitching" (via GDI or PaintPicture)
    - "trying to solve rotated Text" (via GDI)

    I can assure you, that after studying cairo "only half the time" (for just 1 week),
    the above two points won't have come up as "a problem" at all.

    Despite that ... dilettante said it right: "we live in the days of Microsoft's final decline" -
    and that's "just another reason" why I think, "learning a platform-independent drawing-lib" == "time, well-invested".

    Now that the twinBasic-compiler came-up out of nowhere (making good progress)...:
    - RC5/RC6-based VB6-code-snippets *will* work (also) on Linux, unchanged
    - whereas GDI-based VB6-code-snippets (relying on a ton of Windows-specific API-declares), will not

    Olaf

  23. #23

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Olaf,

    I tried to find a manual or tutorial on the internet previously, but I failed. I am gald I have these links now and I will study it.

    Thanks
    PK

  24. #24
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,419

    Re: Rotated text

    Quote Originally Posted by Peekay View Post
    I have 'Public pb As cCairoContext' in my module where I declare public variables.
    Please leave this Variable "PB" Privately declared at the Level of the Form it will then "act-on" as a PicBox-replacement.

    Otherwise, your err-message hints at a "not properly registered RC6".

    JFYI, RC6 will only work (and register) on machines > Vista (Win7 and up) -
    it will not work on XP ... if you're still on XP, then use the RC5 instead (the example should work with it as well).

    Olaf

  25. #25

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Thanks Olaf,

    I do work on Windows 10.

    PK

  26. #26
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,419

    Re: Rotated text

    Quote Originally Posted by Peekay View Post
    I do work on Windows 10.
    In that case it should work...

    Perhaps you should check the following things:
    - close all IDE-instances which might have a reference to RC6
    - make sure, you didn't already have another RC6-version somewhere (in a different Folder)
    - if yes, unregister it there (on an admin-console) via: regsvr32 /u c:\your\path\to\RC6.dll

    And as for the Folder of your last RC6-install attempt:
    - make sure, all the Dlls of the RC6BaseDll-package are located there (beside each other)
    - then try to register it again there (on an admin-console) via: regsvr32 c:\your\path\to\RC6.dll

    Now you should be able to reference (and use) it in a new Project.

    Olaf

  27. #27

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Olaf,

    The code works without error now. I presume I need a picture box in which to render/display it then, or do I not understand it correctly.

    PK

  28. #28
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,419

    Re: Rotated text

    Quote Originally Posted by Peekay View Post
    The code works without error now.
    Ah - good...

    Quote Originally Posted by Peekay View Post
    I presume I need a picture box in which to render/display it then, or do I not understand it correctly.
    No, my intent with the code (as posted in #19) was, to give you a replacement for a PictureBox (on an empty Form).

    If you want to render within the confines of a "real VB6-PictureBox" instead:
    - you should define one on your Form of course (but named different from "PB")
    - e.g. if you named this PicBox as: picCanvas, then the following "setup-code" should work

    Code:
    Option Explicit
    
    Private PB As cCairoContext
    
    Private Sub Form_Load()
      InitCairoContextOnVB6PicBox picCanvas, PB  '<- sync to the size of your PicBox here
      Me.Caption = "Form contains a cairo-PicBox with " & PB.Surface.Width & "x" & PB.Surface.Height & " Pixels"
    End Sub
    
    Sub InitCairoContextOnVB6PicBox(picBox As VB.PictureBox, PB As cCairoContext)
      picBox.ScaleMode = vbPixels
      Set PB = Cairo.CreateSurface(picBox.ScaleWidth, picBox.ScaleHeight).CreateContext
      RefreshPB
    End Sub
    
    Private Sub picCanvas_Resize()
      InitCairoContextOnVB6PicBox picCanvas, PB
    End Sub
    
    Sub RefreshPB()
      picCanvas.AutoRedraw = True: picCanvas.Cls
        PB.Paint 1, Cairo.CreateSolidPatternLng(vbWhite) 'clear the BackGround (currently in white)
        PB_Paint 'here we call a Sub-routine, named similar to a PicBox_Paint-EventHandler
        PB.Surface.DrawToDC picCanvas.hDC 'reflect the PB-contents on the picCanvas.hDC
      picCanvas.Refresh
    End Sub
    The rest of the Code (PB_Paint(), as well as the two helper-routines) can remain as they were...

    HTH

    Olaf

    Edit: FWIW - below the complete example again "en bloc" - mapped to a real VB.PictureBox, named picCanvas
    (at this occasion, I've renamed "PB As cCairoContext" to "Canvas As cCairoContext" to match better with picCanvas)

    Code:
    Option Explicit
    
    Private Canvas As cCairoContext 'Canvas will be "size-synced" and rendered in picCanvas (a VB.PictureBox)
    
    Private Sub Form_Load()
      InitCairoContextOnVB6PicBox picCanvas, Canvas  '<- sync to the size of your PicBox here
      Me.Caption = "Form contains a cairo-PicBox with " & Canvas.Surface.Width & "x" & Canvas.Surface.Height & " Pixels"
    End Sub
    
    Sub InitCairoContextOnVB6PicBox(picBox As VB.PictureBox, Canvas As cCairoContext)
      picBox.ScaleMode = vbPixels
      Set Canvas = Cairo.CreateSurface(picBox.ScaleWidth, picBox.ScaleHeight).CreateContext
      RefreshCanvas
    End Sub
    
    Private Sub picCanvas_Resize()
      InitCairoContextOnVB6PicBox picCanvas, Canvas
    End Sub
    
    Sub RefreshCanvas()
      picCanvas.AutoRedraw = True: picCanvas.Cls
        Canvas.Paint 1, Cairo.CreateSolidPatternLng(vbWhite) 'clear the BackGround (currently in white)
        Canvas_Paint 'here we call a Sub-routine, named similar to a PicBox_Paint-EventHandler
        Canvas.Surface.DrawToDC picCanvas.hDC 'reflect the Canvas-contents on the picCanvas.hDC
      picCanvas.Refresh
    End Sub
    
    Private Sub Canvas_Paint() 'here you can now finally place your own drawing-calls
      DrawLinePolar 15, 70, -30, 90, vbBlue, 3
      DrawTextPolar 15, 70, -30, 90, "Left aligned", vbRed, vbLeftJustify, 3 / 2 + 1.5
    
      DrawLinePolar 55, 100, 0, 90, vbCyan, 2
      DrawTextPolar 55, 100, 0, 90, "Centered", vbBlack, vbCenter, 2 / 2 + 1.5
    
      DrawLinePolar 100, 130, 30, 90, vbGreen, 1
      DrawTextPolar 100, 130, 30, 90, "Right aligned", vbMagenta, vbRightJustify, 1 / 2 + 1.5
    End Sub
    
    Sub DrawLinePolar(ByVal cx#, ByVal cy#, ByVal AngleDeg#, ByVal Length#, Optional ByVal LineColor&, Optional ByVal LineWidth# = 2)
      Canvas.Save: Canvas.TranslateDrawings cx, cy: Canvas.RotateDrawingsDeg AngleDeg 'save, and transform to PolarCoord-mode
         Canvas.DrawLine 0, 0, Abs(Length), 0, False, LineWidth, LineColor
      Canvas.Restore 'restore the previous coord-sys upon return from this routine
    End Sub
    
    Sub DrawTextPolar(ByVal cx#, ByVal cy#, ByVal AngleDeg#, ByVal Length#, Text$, Optional ByVal TextColor&, Optional ByVal Align As AlignmentConstants, Optional ByVal BaseLineDistance#, Optional ByVal FontName$ = "Arial", Optional ByVal FontSize# = 10, Optional ByVal FontBold&, Optional ByVal FontItalic&)
      Canvas.Save: Canvas.TranslateDrawings cx, cy: Canvas.RotateDrawingsDeg AngleDeg 'save, and transform to PolarCoord-mode
         Canvas.SelectFont FontName, FontSize, , FontBold, FontItalic 'first select the current font...
         Dim TX#, TW#: TW = Canvas.GetTextExtents(Text) 'so that we get the right TextWidth-measurement
         Select Case Align
           Case vbCenter:       TX = (Abs(Length) - TW) / 2
           Case vbRightJustify: TX = (Abs(Length) - TW)
         End Select
         Canvas.TranslateDrawings TX, -BaseLineDistance 'x-alignment + slight "uplifting" of the text relative to the BaseLine
         
         Canvas.TextOut 0, 0, Text, True, 1, True
         Canvas.Fill , Cairo.CreateSolidPatternLng(TextColor)
      Canvas.Restore 'restore the previous coord-sys upon return from this routine
    End Sub
    Last edited by Schmidt; Apr 18th, 2021 at 06:42 AM.

  29. #29

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Excellent thanks Olaf,

    Attachment 181048

  30. #30
    Addicted Member
    Join Date
    Jul 2020
    Posts
    168

    Re: Rotated text

    I modified the example from post # 12. declarations and variables left the same. Added 3 variables. Form, PictureBox and two buttons:
    Code:
        Dim X1 As Integer
        Dim Y1 As Integer
        Dim Angle As Integer
    
    Private Sub Command1_Click()    '(+)
    Picture1.Cls
            Angle = Angle + 10
                Draw
    End Sub
    
    Private Sub Command2_Click()    '(-)
    Picture1.Cls
            Angle = Angle - 10
                Draw
    End Sub
    
    Private Sub Form_Load()
    Picture1.ScaleMode = 3
    Picture1.AutoRedraw = True
        Text = "Rotated text"
        X1 = 0
        Y1 = Picture1.ScaleHeight - Font.Size * 2
            Angle = 450
    
         With LOGFONT
            .lfEscapement = Angle
            .lfOrientation = 0
            .lfHeight = -ScaleY(Font.Size * 1.75, vbPoints, vbPixels)
            .lfWeight = 700
            .lfCharSet = ANSI_CHARSET
            .lfFaceName = "Wingdings" & vbNullChar
        End With
    
                Draw
    End Sub
    
    Private Sub Draw()
    LOGFONT.lfEscapement = Angle
        hFont = CreateFontIndirect(VarPtr(LOGFONT))
        hFontPrev = SelectObject(Picture1.hDC, hFont)
        SetTextColor Picture1.hDC, vbRed
        TextOut Picture1.hDC, X1, Y1, _
                StrPtr(Text), _
                Len(Text)
           'Clean up:
        SelectObject Picture1.hDC, hFontPrev
        DeleteObject hFont
        SetTextColor Picture1.hDC, TextColorPrev
    End Sub
    The text rotates when buttons are pressed. For normal operation, you need to add tracking of the origin of coordinates, text output depending on the rotation angle and set traps when the borders of the PictureBox are reached.

  31. #31

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Argus19,
    Thank you for your contribution. I always welcome diverse opinions so that the thread can be insightful for all users in future. It is not only for my edification and enlightenment on the subject. I know contributors like those who contributed here do it for the benefit of the whole forum.
    PK

  32. #32
    PowerPoster
    Join Date
    Feb 2006
    Posts
    22,171

    Re: Rotated text

    I wish we had another answer to Microsoft's self-imposed decline, but sadly Windows remains the only OS that matters. Desktop Linux basically doesn't exist:

    Desktop Operating System Market Share Worldwide

    OS X is more meaningful, but it is nearly as "read only" an operating system (like watching TV, a passive appliance) as Chrome OS and phone OSs.

  33. #33
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,419

    Re: Rotated text

    Quote Originally Posted by dilettante View Post
    Windows remains the only OS that matters.
    Well, and for as long as it does -
    VB6/VBA or twinBasic-Users can handle advanced graphics with a decent Class-wrapper for Cairo...

    The "other OSes" (no matter what they are) usually offer a C-compiler (or LLVM-support)
    which in turn means, that precompiled cairo-binaries either already exist, or can be made available there.

    In a few years, we will be able, to compile and run VB6-sources (with GUI) directly on a Raspberry-Pi -
    but also on Android - not really negligible, if you ask me.

    Besides, for WebApp-scenarios, I'd also like to be able to run my VB6-sources on a cheaper Linux-Host-installation,
    replacing the usual "LAMP" (Linux, Apache, MySQL, PHP/Python) with "LNST" (Linux, Node, SQLite, TwinBasic).

    Currently (at the place where I work), we need to rent twice as expensive Windows-Hosts -
    (which currently run IIS+Node+WinAx+VB6-COM-Dlls, to serve requests).

    Olaf

  34. #34

    Thread Starter
    Fanatic Member Peekay's Avatar
    Join Date
    Sep 2006
    Location
    Witbank, South Africa
    Posts
    571

    Re: Rotated text

    Olaf,
    I do a lot of filled polygons with many sides, which VB6 does quite well. Can you give me a link or some basic code for that.
    Thanks.
    PK

    I got it in tutorial 4, thanks.

    PK
    Last edited by Peekay; Apr 19th, 2021 at 03:11 AM.

  35. #35
    Frenzied Member
    Join Date
    Jan 2020
    Posts
    1,292

    Re: Rotated text

    The text display cannot be seen clearly on the background image. How to display luminous text or white font with black stroke, and how to set the stroke thickness?

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