TextOut - making the font thinner-VBForums
Results 1 to 6 of 6

Thread: TextOut - making the font thinner

  1. #1

    Thread Starter
    New Member
    Join Date
    Sep 2016
    Posts
    12

    TextOut - making the font thinner

    Hello,
    In my project, I have a timer with its interval set to 2000. Every 2 seconds, the timer sends
    the string "hello" to the desktop position where the mouse pointer actually is.
    -But the font on the desktop is too thick. It looks like a bold font. -How can i make a thinner font?

    Code:
    Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private 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
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Dim Pt As POINTAPI, hw As Long, hdcc As Long
        Private Type POINTAPI
            X As Long
            Y As Long
        End Type
    Private Sub Timer1_Timer()
        GetCursorPos Pt
        hw = WindowFromPoint(Pt.X, Pt.Y): hdcc = GetDC(hw)
        TextOut hdcc, Pt.X, Pt.Y, "hello", Len("hello")
    End Sub
    Name:  textout.jpg
Views: 130
Size:  21.3 KB
    Last edited by vb_elmar; Mar 19th, 2017 at 10:58 AM.

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    15,786

    Re: TextOut - making the font thinner

    I think you will have to
    - create a font. maybe: CreateFontIndirect
    - select that font into the dc while caching the font that's already there. Use SelectObject
    - print to desktop
    - put previous font back into that hdc: use SelectObject
    - destroy the font you created. Use DeleteObjedct
    Insomnia is just a byproduct of, "It can't be done"

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {GDI+ Classes/Samples} {Unicode Open/Save Dialog} {Icon Organizer/Extractor}
    {VB and DPI Tutorial} {XP/Vista Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    New Member
    Join Date
    Sep 2016
    Posts
    12

    Re: TextOut - making the font thinner

    can you make a sample code ?

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    15,786

    Re: TextOut - making the font thinner

    You can, search the forum for the APIs I mentioned. The gist would look like
    Code:
    hFont = CreateFontIndirect(LOGFONT) ' fill in that UDT
    hFontOld = SelectObject(hDC, hFont)
    TextOut ....
    DeleteObject SelectObject(hDC, hFontOld)
    More notes:
    1. You may be creating a memory leak every two seconds. When you use GetDC, you should release it with ReleaseDC
    2. You shouldn't need to use WindowFromPoint. If drawing to the desktop, maybe use this instead: GetDesktopWindow
    3. The font you create can be done when form loads and destroyed when form closes if you don't want to create it every 2 seconds. If so, the last line of code above would change to: SelectObject hDC, hFontOld. Then the CreateFontIndirect call is placed in form load and DeleteObject hFont is placed in form unload; hFont would be a variable declared at form-level
    Last edited by LaVolpe; Mar 19th, 2017 at 11:03 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {GDI+ Classes/Samples} {Unicode Open/Save Dialog} {Icon Organizer/Extractor}
    {VB and DPI Tutorial} {XP/Vista Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5

    Thread Starter
    New Member
    Join Date
    Sep 2016
    Posts
    12

    Re: TextOut - making the font thinner

    I made a sample project. Now the output font is as small as I wanted.

    Code:
    'in Form1 (set timer1.interval to 2000)
    Private Sub Timer1_Timer()
       txtOutAtMousePosition "hello"
    End Sub
    
    Private Sub Form_Unload(Cancel As Integer)
        DeleteObject rfont
    End Sub
    'end Form1
    
    'in a module
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private 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
    Private Declare Function ReleaseDC Lib "user32" (ByVal HWND As Long, ByVal hdc As Long) As Long
    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 GetDC Lib "user32" (ByVal HWND As Long) As Long
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Public rfont: Private Const LF_FACESIZE = 32
    Dim Pt As POINTAPI, hw As Long, hdcc As Long, RotateMe As LOGFONT, Inited As Boolean
        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
        End Type
        Private Type POINTAPI
            X As Long
            Y As Long
        End Type
        
    Public Sub txtOutInit()
        hw = GetDesktopWindow
        Inited = True
        RotateMe.lfHeight = 11 'font size 11px
        rfont = CreateFontIndirect(RotateMe)
    End Sub
    
    Public Sub txtOutAtMousePosition(ByVal L As String)
        If Inited = False Then Call txtOutInit
        GetCursorPos Pt
        hdcc = GetDC(hw)
        SelectObject hdcc, rfont
        TextOut hdcc, Pt.X + 12, Pt.Y, L, Len(L)
        ReleaseDC hw, hdcc
    End Sub
    'end module
    Last edited by vb_elmar; Mar 20th, 2017 at 02:05 AM.

  6. #6
    Lively Member
    Join Date
    Mar 2017
    Posts
    100

    Re: TextOut - making the font thinner

    I'm a little lost here. Are you supposed to fill in the information needed into the LOGFONT structure. I don't see in your code that you do this other than setting the font height in sub txtOutInit. Your first example works but running your second example does nothing so that is why I am asking
    Last edited by Ordinary Guy; Mar 20th, 2017 at 01:16 PM.

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.