-
Mar 19th, 2017, 10:36 AM
#1
Thread Starter
Lively Member
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
Last edited by vb_elmar; Mar 19th, 2017 at 10:58 AM.
-
Mar 19th, 2017, 10:38 AM
#2
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
-
Mar 19th, 2017, 10:42 AM
#3
Thread Starter
Lively Member
Re: TextOut - making the font thinner
can you make a sample code ?
-
Mar 19th, 2017, 10:51 AM
#4
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.
-
Mar 20th, 2017, 01:54 AM
#5
Thread Starter
Lively Member
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.
-
Mar 20th, 2017, 12:04 PM
#6
Hyperactive Member
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|