Author : Sreeram.P
Date Submitted : 9/6/2006
Category : Forms
Compatibility : .NET
This code has been accessed 5296 times.
Task : How to show the text shaped form? Solution is here...
Declarations
Code
'simply pase this below code
Private Sub ShapePicture()
Const TEXT1 = "SREERAM"
Dim new_font As Long
Dim old_font As Long
Dim hRgn As Long
' Prepare the form.
AutoRedraw = True
BorderStyle = vbBSNone
ScaleMode = vbPixels
BackColor = vbBlue
'Me.ForeColor = vbBlack
'Me.DrawWidth = 1
' Make a big font.
new_font = CustomFont(250, 65, 0, 0, _
FW_BOLD, False, False, False, _
"Times New Roman")
old_font = SelectObject(Me.hdc, new_font)
' Make the region.
SelectObject Me.hdc, new_font
BeginPath Me.hdc
Me.CurrentX = (ScaleWidth - Me.TextWidth(TEXT1)) / 2
Me.CurrentY = -40
Me.Print TEXT1
EndPath Me.hdc
hRgn = PathToRegion(Me.hdc)
' Constrain the PictureBox to the region.
SetWindowRgn Me.hWnd, hRgn, False
' Restore the original font.
SelectObject hdc, old_font
' Free font resources (important!)
DeleteObject new_font
' Draw text in the PictureBox.
With Me.Font
.Name = "Times New Roman"
.Size = 8
.Bold = False
End With
End Sub
' Make a customized font and return its handle.
Private Function CustomFont(ByVal hgt As Long, ByVal wid As Long, ByVal escapement As Long, ByVal orientation As Long, ByVal wgt As Long, ByVal is_italic As Long, ByVal is_underscored As Long, ByVal is_striken_out As Long, ByVal face As String) As Long
Const CLIP_LH_ANGLES = 16 ' Needed for tilted fonts.
CustomFont = CreateFont( _
hgt, wid, escapement, orientation, wgt, _
is_italic, is_underscored, is_striken_out, _
0, 0, CLIP_LH_ANGLES, 0, 0, face)
End Function
Private Sub Form_Load()
' Shape the picture.
ShapePicture
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Unload Me
End Sub