Keskustelu: Koodit: VB6: Tekstin kiertäminen

Private Const LF_FACESIZE = 20
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 As String * LF_FACESIZE
End Type
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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Picture1_click()

    Dim Fontti As LOGFONT
    Dim FonttiKoko As Long
    Dim FonttiHanska As Long
    Dim Fontikka As Long

    FonttiKoko = 20 'fontin koko
    Fontti.lfEscapement = 1800 'rotaatioaste * 10
    Fontti.lfFaceName = "Arial" & Chr(0) 'fontin nimi + terminaattori perään
    Fontti.lfHeight = (FonttiKoko * -20) / Screen.TwipsPerPixelY 'erikoista laskentaa
    FonttiHanska = CreateFontIndirect(Fontti) 'haetaan hanska
    Fontikka = SelectObject(Picture1.hDC, FonttiHanska) 'viedään fontti pictuurilaatikkoon

    Picture1.CurrentX = Picture1.Width / 2 'viedään kursori keskelle
    Picture1.CurrentY = Picture1.Height / 2 'jotta teksti näkyisi kunnolla
    Picture1.Print "Pää alaspäin!" 'ja ulostetaan tekstiä

    SelectObject Picture1.hDC, Fontikka 'ja sitten...
    DeleteObject FonttiHanska '...tapetaan turha fontti

End Sub