Option Explicit
Private Const LF_FACESIZE = 32 Private Const OUT_DEFAULT_PRECIS = 0 Private Const OUT_STRING_PRECIS = 1 Private Const OUT_CHARACTER_PRECIS = 2 Private Const OUT_STROKE_PRECIS = 3 Private Const OUT_TT_PRECIS = 4 Private Const OUT_DEVICE_PRECIS = 5 Private Const OUT_RASTER_PRECIS = 6 Private Const OUT_TT_ONLY_PRECIS = 7 Private Const CLIP_DEFAULT_PRECIS = 0 Private Const CLIP_CHARACTER_PRECIS = 1 Private Const CLIP_STROKE_PRECIS = 2 Private Const CLIP_LH_ANGLES = &H10 Private Const CLIP_TT_ALWAYS = &H20 Private Const CLIP_EMBEDDED = &H80 Private Const DEFAULT_QUALITY = 0 Private Const DRAFT_QUALITY = 1 Private Const PROOF_QUALITY = 2 Private Const DEFAULT_PITCH = 0 Private Const FIXED_PITCH = 1 Private Const VARIABLE_PITCH = 2 Private Const TMPF_FIXED_PITCH = 1 Private Const TMPF_VECTOR = 2 Private Const TMPF_DEVICE = 8 Private Const TMPF_TRUETYPE = 4 Private Const ANSI_CHARSET = 0 Private Const DEFAULT_CHARSET = 1 Private Const SYMBOL_CHARSET = 2 Private Const SHIFTJIS_CHARSET = 128 Private Const OEM_CHARSET = 255 Private Const NTM_REGULAR = &H40& Private Const NTM_BOLD = &H20& Private Const NTM_ITALIC = &H1& Private Const LF_FULLFACESIZE = 64 Private Const RASTER_FONTTYPE = 1 Private Const DEVICE_FONTTYPE = 2 Private Const TRUETYPE_FONTTYPE = 4 Private Const FF_DONTCARE = 0 Private Const FF_ROMAN = 16 Private Const FF_SWISS = 32 Private Const FF_MODERN = 48 Private Const FF_SCRIPT = 64 Private Const FF_DECORATIVE = 80 Private Const FW_DONTCARE = 0 Private Const FW_THIN = 100 Private Const FW_EXTRALIGHT = 200 Private Const FW_LIGHT = 300 Private Const FW_NORMAL = 400 Private Const FW_MEDIUM = 500 Private Const FW_SEMIBOLD = 600 Private Const FW_BOLD = 700 Private Const FW_EXTRABOLD = 800 Private Const FW_HEAVY = 900 Private Const FW_ULTRALIGHT = FW_EXTRALIGHT Private Const FW_REGULAR = FW_NORMAL Private Const FW_DEMIBOLD = FW_SEMIBOLD Private Const FW_ULTRABOLD = FW_EXTRABOLD Private Const FW_BLACK = FW_HEAVY Private Const GCP_DBCS = &H1 Private Const GCP_REORDER = &H2 Private Const GCP_USEKERNING = &H8 Private Const GCP_GLYPHSHAPE = &H10 Private Const GCP_LIGATE = &H20 Private Const GCP_DIACRITIC = &H100 Private Const GCP_KASHIDA = &H400 Private Const GCP_ERROR = &H8000 Private Const FLI_MASK = &H103B Private Const GCP_JUSTIFY = &H10000 Private Const GCP_NODIACRITICS = &H20000 Private Const FLI_GLYPHS = &H40000 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type TEXTMETRIC tmHeight As Long tmAscent As Long tmDescent As Long tmInternalLeading As Long tmExternalLeading As Long tmAveCharWidth As Long tmMaxCharWidth As Long tmWeight As Long tmOverhang As Long tmDigitizedAspectX As Long tmDigitizedAspectY As Long tmFirstChar As Byte tmLastChar As Byte tmDefaultChar As Byte tmBreakChar As Byte tmItalic As Byte tmUnderlined As Byte tmStruckOut As Byte tmPitchAndFamily As Byte tmCharSet As Byte End Type Private Type NEWTEXTMETRIC tmHeight As Long tmAscent As Long tmDescent As Long tmInternalLeading As Long tmExternalLeading As Long tmAveCharWidth As Long tmMaxCharWidth As Long tmWeight As Long tmOverhang As Long tmDigitizedAspectX As Long tmDigitizedAspectY As Long tmFirstChar As Byte tmLastChar As Byte tmDefaultChar As Byte tmBreakChar As Byte tmItalic As Byte tmUnderlined As Byte tmStruckOut As Byte tmPitchAndFamily As Byte tmCharSet As Byte ntmFlags As Long ntmSizeEM As Long ntmCellHeight As Long ntmAveWidth As Long End Type 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(LF_FACESIZE - 1) As Byte End Type Private Declare Function CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) Private Declare Function GetClientRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT) Private Declare Function GetTextMetrics& Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) Private Declare Function GetTextFace& Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long) Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpstring As String, ByVal nCount As Long) As Long Private Declare Function GetFontLanguageInfo& Lib "gdi32" (ByVal hdc As Long) Private Sub Command1_Click() Dim lf As LOGFONT Dim FontToUse As Long Dim oldHdc As Long Dim dl As Long Dim TestoProva As String Dim rc As RECT Dim TempByteArray() As Byte Dim ByteArrayLimit As Long Dim i As Long TestoProva = "Prova" TempByteArray = StrConv("Times" & Chr$(0), vbFromUnicode) ByteArrayLimit = UBound(TempByteArray) For i = 0 To ByteArrayLimit lf.lfFaceName(i) = TempByteArray(i) Next i With lf .lfHeight = 10 .lfWidth = 10 .lfWeight = 400 .lfQuality = DEFAULT_QUALITY .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE .lfCharSet = DEFAULT_CHARSET .lfOutPrecision = OUT_DEFAULT_PRECIS .lfClipPrecision = OUT_DEFAULT_PRECIS .lfEscapement = 300 .lfOrientation = 300 End With '// Creiamo un font ruotato. FontToUse = CreateFontIndirect(lf) If FontToUse = 0 Then Exit Sub '// In caso di Errore '// Selezioniamo il font nel device context della picture oldHdc = SelectObject(pic.hdc, FontToUse) '// Da dove cominciamo a scrivere? pic.CurrentX = (pic.Height - pic.Top) / 2 pic.CurrentY = (pic.Width - pic.Left) / 2 '// Scriviamo pic.Print TestoProva '// Ripristiniamo l'hdc nello stato in cui era prima. dl = SelectObject(pic.hdc, oldHdc) End Sub Private Sub Form_Load() End Sub Fai un progetto con un command button e una picturebox chiamata pic. E' qui che verra' fatta la scritta. Se preferisci scrivere direttamente su form o su un altro controllo, passa a SelectObject l'hDC della finestra sulla quale vuoi scrivere. |