AllAPI Network - The KPD-Team

 
Allapi Network
 API-Guide
 ApiViewer

 API List

 
API Resources
 Tips & Tricks
 VB Tutorials
 Error Lookup
 
Misc Stuff
 VB examples
 VB Tools
 VB Links
 Top Downloads
 
This Site
 Search Engine
 Contact Form
 

Donate to AllAPI.net

Rotating Text

Use this subroutine to put text on your form or picture box at different angles. For vertically down, use the angle on 270, and vertically up, use the angle of 90.

Declarations

Public Declare Function CreateFont Lib _
"gdi32" Alias "CreateFontA" (ByVal _
Height As Long, ByVal Width As Long, _
ByVal Escapement As Long, ByVal _
Orientation As Long, ByVal Weight _
As Long, ByVal Italic As Long, ByVal _
Underline As Long, ByVal StrikeOut As _
Long, ByVal CharSet As Long, ByVal _
OutputPrecision As Long, ByVal _
ClipPrecision As Long, ByVal Quality _
As Long, ByVal PitchAndFamily As _
Long, ByVal Face As String) 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 Const FW_BOLD = 700
Public Const FW_NORMAL = 400
Public Const ANSI_CHARSET = 0
Public Const OUT_DEFAULT_PRECIS = 0
Public Const CLIP_DEFAULT_PRECIS = 0
Public Const PROOF_QUALITY = 2
Public Const DEFAULT_PITCH = 0
Public Const FF_DONTCARE = 0

Module Code

Paste the following code into a module.

Public Sub dotext(angpict As Object, _
angfont As StdFont, angtext As String, _
angle As Single)

' Parameters:
' angpict: picture box, etc to draw text in
' angfont: Font object with info about font to use
' angtext: text to print
' angle : angle, measured anti-clockwise from horizontal: ----->

Dim newfont As Long
Dim oldfont As Long
Dim angweight As Long

If angfont.Bold = True Then 
  angweight = FW_BOLD 
Else
  angweight = FW_NORMAL
End If

newfont = CreateFont(angfont.Size * 2, _
0, angle * 10, 0, angweight, _
angfont.Italic, angfont.Underline, _
angfont.Strikethrough, ANSI_CHARSET, _
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
PROOF_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, _
angfont.Name)

oldfont = SelectObject(angpict.hdc, newfont)

angpict.CurrentX = 1000
angpict.CurrentY = 1000
angpict.Print angtext

newfont = SelectObject(angpict.hdc, oldfont)

If DeleteObject(newfont) = 0 Then
' could not remove font from GDI heap
End If

End Sub

Breakdown:

This sub works by creating a logical font in the GDI heap. It then sets the font of the control to this logical font, keeping a record of the old logical font. It then prints the font, then resets the old font. Lastly, to free up memory, it deletes the logical font from the GDI heap.

Jargon

GDI Heap:
Area of system memory used to store infomation about the graphical interface of windows.

Logical font:
This a pointer to a physical font file on disk.

 

 


Copyright © 1998-2007, The Mentalis.org Team - Privacy statement
Did you find a bug on this page? Tell us!
This site is located at http://allapi.mentalis.org/