title image


Smiley Re: Hochformatiger Text in PictureBox
Hi,



Du benötigst ein Modul (Nicht Klassenmodul, nicht Form). Diesen Code:







      

Option Explicit



Private Const WM_SETFONT As Long = &H30

Private Const LF_FACESIZE As Long = 32

Private Const HWND_DESKTOP As Long = 0

Private Const LOGPIXELSY As Long = 90

Private Const FF_DONTCARE As Long = 0

Private Const FW_DONTCARE As Long = 0

Private Const FW_NORMAL As Long = 400

Private Const FW_BOLD As Long = 700

Private Const DEFAULT_CHARSET As Long = 1



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.dll" Alias "CreateFontIndirectA" ( _

   ByRef lpLogFont As LOGFONT) As Long



 Private Declare Function SelectObject Lib "gdi32.dll" ( _

   ByVal hDc As Long, _

   ByVal hObject As Long) As Long

   

Private Declare Function GetDC Lib "user32.dll" ( _

   ByVal hWnd As Long) As Long



Private Declare Function ReleaseDC Lib "user32.dll" ( _

   ByVal hWnd As Long, _

   ByVal hDc As Long) As Long



Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _

   ByVal hDc As Long, _

   ByVal nIndex As Long) As Long



   

Public Function CreateNewFont(ByVal sFnName As String, _

                              ByVal nSize As Long, _

                              ByVal nOrientation As Long, _

                              ByVal Bold As Boolean, _

                              ByVal Italic As Boolean, _

                              ByVal UnderLine As Boolean, _

                              ByVal Strikeout As Boolean) As Long

                              

    Dim lf As LOGFONT

    Dim hDc As Long

    Dim lCyPixels As Long

    

    hDc = GetDC(HWND_DESKTOP)

    lCyPixels = GetDeviceCaps(hDc, LOGPIXELSY)

    ReleaseDC HWND_DESKTOP, hDc

    With lf

      .lfHeight = -(nSize * lCyPixels) \ 72

      .lfFaceName = sFnName

      .lfPitchAndFamily = FF_DONTCARE

    If Bold Then

       .lfWeight = FW_BOLD

    Else

       .lfWeight = FW_NORMAL

    End If

      .lfUnderline = UnderLine

      .lfItalic = Italic

      .lfStrikeOut = Strikeout

      .lfCharSet = DEFAULT_CHARSET

      If nOrientation > 359 Or nOrientation < 0 Then nOrientation = 0

      .lfEscapement = (nOrientation * 10)

      .lfOrientation = .lfEscapement

    End With

    

    CreateNewFont = CreateFontIndirect(lf)

End Function



Public Function SetNewFont(ByVal hDc As Long, ByVal hFont As Long) As Long

    SelectObject hDc, hFont

End Function 



Code eingefügt mit Syntaxhighlighter 3.0







So wird die Funktion aufgerufen:





Private hFont As Long



Private Sub Command1_Click()

hFont = CreateNewFont("Arial", 24, 10, True, True, False, False)

WinAPI.SetNewFont Picture1.hDc, hFont

Picture1.Print "Test"



End Sub



Unter nOrientation kannst Du einstellen, wieviel Grad der Font gegen den Uhrzeigersinn gedreht wird (von 1 bis 359 Grad) Minuswerte sind nicht zulässig.



Desweiteren musst Du die Koordinaten bearbeiten, an der der Text ausgegeben wird. Wird der Text in Hochformat gestellt ist currenty mindestens größer als die Textlänge, sonst wird Text "verschuckt"

Programmierst Du noch frei oder wirst Du schon von Microsoft verwaltet ( .NET)?



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: