• Home
 · 
• Custom Controls/Forms/Menus
 · 
• How to show the text shaped form? Solution is here...

How to show the text shaped form? Solution is here...

How to show the text shaped form? Solution is here...

API Declarations


Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal i As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const FW_BOLD = 700



Rate How to show the text shaped form? Solution is here...

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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