• Home
 · 
• Graphics
 · 
• this is a bit of fun, included is a function that draws text onto a picture box or form and can eve

this is a bit of fun, included is a function that draws text onto a picture box or form and can eve

by DoctorMO & Dave Edwards (2 Submissions)
Category: Graphics
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Fri 22^nd June 2001
Date Added: Mon 8^th February 2021
Rating: (1 Votes)

this is a bit of fun, included is a function that draws text onto a picture box or form and can even rotate the text, bt thats not the point

API Declarations


'or picture box
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 FontFace As String) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
'used with fnWeight
Const FW_DONTCARE = 0
Const FW_THIN = 100
Const FW_EXTRALIGHT = 200
Const FW_LIGHT = 300
Const FW_NORMAL = 400
Const FW_MEDIUM = 500
Const FW_SEMIBOLD = 600
Const FW_BOLD = 700
Const FW_EXTRABOLD = 800
Const FW_HEAVY = 900
Const FW_BLACK = FW_HEAVY
Const FW_DEMIBOLD = FW_SEMIBOLD
Const FW_REGULAR = FW_NORMAL
Const FW_ULTRABOLD = FW_EXTRABOLD
Const FW_ULTRALIGHT = FW_EXTRALIGHT
'used with fdwCharSet
Const ANSI_CHARSET = 0
Const DEFAULT_CHARSET = 1
Const SYMBOL_CHARSET = 2
Const SHIFTJIS_CHARSET = 128
Const HANGEUL_CHARSET = 129
Const CHINESEBIG5_CHARSET = 136
Const OEM_CHARSET = 255
'used with fdwOutputPrecision
Const OUT_CHARACTER_PRECIS = 2
Const OUT_DEFAULT_PRECIS = 0
Const OUT_DEVICE_PRECIS = 5
'used with fdwClipPrecision
Const CLIP_DEFAULT_PRECIS = 0
Const CLIP_CHARACTER_PRECIS = 1
Const CLIP_STROKE_PRECIS = 2
'used with fdwQuality
Const DEFAULT_QUALITY = 0
Const DRAFT_QUALITY = 1
Const PROOF_QUALITY = 2
'used with fdwPitchAndFamily
Const DEFAULT_PITCH = 0
Const FIXED_PITCH = 1
Const VARIABLE_PITCH = 2
'used with SetBkMode
Const OPAQUE = 2
Const TRANSPARENT = 1

Public Type Font_Style
Bold As Long
Italic As Boolean
Underline As Boolean
StrikeThough As Boolean
Name As String
Size As Long
End Type

Public Function DrawText(FontStyle As Font_Style, strText As String, Angle As Integer, PicDrawInto As PictureBox, X1 As Long, Y1 As Long) As Long
Dim OldFont As Long
Dim FontWeight As Long

'If FontStyle.Bold Then
' FontWeight = FW_BOLD
'Else
' FontWeight = FW_NORMAL
'End If

NewFont = CreateFont(FontStyle.Size, 0, Angle * 10, 0, FontStyle.Bold, FontStyle.Italic, FontStyle.Underline, FontStyle.StrikeThough, ANSI_CHARSET Or DEFAULT_CHARSET Or SYMBOL_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, DEFAULT_PITCH Or FF_DONTCARE, FontStyle.Name)
OldFont = SelectObject(PicDrawInto.hdc, NewFont)

PicDrawInto.CurrentX = X1
PicDrawInto.CurrentY = Y1

PicDrawInto.Print strText

NewFont = SelectObject(PicDrawInto.hdc, OldFont)
'DeleteObject OldFont
DeleteObject NewFont

End Function

Public Function DrawOptionBox(PicDest As PictureBox, X As Long, Y As Long)
'Draw n (FFFFFF) l (000000) m (C0C0C0) j (808080) k (FFFFFF)
Dim MyFont As Font_Style

With MyFont
.Bold = False
.Italic = False
.Size = 12
.StrikeThough = False
.Underline = False
.Name = "Marlett"
End With

PicDest.ForeColor = &HFFFFFF
Call DrawText(MyFont, "n", 0, PicDest, X, Y)
PicDest.ForeColor = &H0
Call DrawText(MyFont, "l", 0, PicDest, X, Y)
PicDest.ForeColor = &HC0C0C0
Call DrawText(MyFont, "m", 0, PicDest, X, Y)
PicDest.ForeColor = &H808080
Call DrawText(MyFont, "j", 0, PicDest, X, Y)
PicDest.ForeColor = &HFFFFFF
Call DrawText(MyFont, "k", 0, PicDest, X, Y)

End Function

Public Function DrawOptionBoxDot(PicDest As PictureBox, X As Long, Y As Long, Optional iOption As Byte)
'Draw n (FFFFFF) l (000000) m (C0C0C0) j (808080) k (FFFFFF)
Dim MyFont As Font_Style

With MyFont
.Bold = False
.Italic = False
.Size = 12
.StrikeThough = False
.Underline = False
.Name = "Marlett"
End With

PicDest.ForeColor = &H0
Call DrawText(MyFont, Chr(Asc("i") - iOption), 0, PicDest, X, Y)

End Function



Download this snippet    Add to My Saved Code

this is a bit of fun, included is a function that draws text onto a picture box or form and can eve Comments

No comments have been posted about this is a bit of fun, included is a function that draws text onto a picture box or form and can eve. Why not be the first to post a comment about this is a bit of fun, included is a function that draws text onto a picture box or form and can eve.

Post your comment