{"id":470,"date":"2009-12-07T15:20:38","date_gmt":"2009-12-07T18:20:38","guid":{"rendered":"http:\/\/leandroascierto.com\/blog\/?p=470"},"modified":"2011-08-27T08:14:12","modified_gmt":"2011-08-27T11:14:12","slug":"clsdrawstring-cls-modulo-para-dibujar-texto-utilizando-gdi","status":"publish","type":"post","link":"https:\/\/leandroascierto.com\/blog\/clsdrawstring-cls-modulo-para-dibujar-texto-utilizando-gdi\/","title":{"rendered":"ClsDrawString.cls Modulo para dibujar texto utilizando GDI+"},"content":{"rendered":"<p style=\"text-align: justify;\">Modulo Clase para dibujar texto utilizando GDI+ tiene funciones b\u00e1sicas como poder asignar la fuente, color, alineaci\u00f3n, alineaci\u00f3n vertical, Flags del formato, Trimming, Opacity. Para los que ya utilizaron alguna vez el api DrawText de \u00abUser32\u00bb no les resultara muy dif\u00edcil de implementar.<\/p>\n<pre class=\"brush: vb; title: ; notranslate\" title=\"\">\r\nOption Explicit\r\n'--------------------------------------------\r\n'Autor: Leandro Ascierto\r\n'Web:   www.leandroascierto.com.ar\r\n'Date:  27\/12\/2009\r\n'--------------------------------------------\r\nPrivate Declare Function GdipCreateFont Lib &quot;gdiplus&quot; (ByVal fontFamily As Long, ByVal emSize As Single, ByVal Style As GDIPLUS_FONTSTYLE, ByVal UNIT As Long, createdfont As Long) As Long\r\nPrivate Declare Function GdipCreateFontFamilyFromName Lib &quot;gdiplus&quot; (ByVal name As String, ByVal fontCollection As Long, fontFamily As Long) As Long\r\nPrivate Declare Function GdipCreateSolidFill Lib &quot;gdiplus&quot; (ByVal argb As Long, brush As Long) As Long\r\nPrivate Declare Function GdipCreateStringFormat Lib &quot;gdiplus&quot; (ByVal formatAttributes As Long, ByVal language As Integer, StringFormat As Long) As Long\r\nPrivate Declare Function GdipDeleteBrush Lib &quot;gdiplus&quot; (ByVal brush As Long) As Long\r\nPrivate Declare Function GdipDeleteFont Lib &quot;gdiplus&quot; (ByVal curFont As Long) As Long\r\nPrivate Declare Function GdipDeleteFontFamily Lib &quot;gdiplus&quot; (ByVal fontFamily As Long) As Long\r\nPrivate Declare Function GdipDeleteStringFormat Lib &quot;gdiplus&quot; (ByVal StringFormat As Long) As Long\r\nPrivate Declare Function GdipDrawString Lib &quot;gdiplus&quot; (ByVal graphics As Long, ByVal str As String, ByVal Length As Long, ByVal thefont As Long, layoutRect As RECTF, ByVal StringFormat As Long, ByVal brush As Long) As Long\r\nPrivate Declare Function GdipSetStringFormatAlign Lib &quot;gdiplus&quot; (ByVal StringFormat As Long, ByVal Align As StringAlignment) As Long\r\nPrivate Declare Function GdipSetStringFormatLineAlign Lib &quot;gdiplus&quot; (ByVal StringFormat As Long, ByVal Align As StringAlignment) As Long\r\nPrivate Declare Function GdipSetStringFormatFlags Lib &quot;GdiPlus.dll&quot; (ByVal mFormat As Long, ByVal mFlags As StringFormatFlags) As Long\r\nPrivate Declare Function GdipSetStringFormatTrimming Lib &quot;GdiPlus.dll&quot; (ByVal mFormat As Long, ByVal mTrimming As StringTrimming) As Long\r\nPrivate Declare Function GdiplusStartup Lib &quot;gdiplus&quot; (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long\r\nPrivate Declare Function GdipCreateFromHDC Lib &quot;gdiplus&quot; (ByVal Hdc As Long, hGraphics As Long) As Long\r\nPrivate Declare Function GdipDeleteGraphics Lib &quot;gdiplus&quot; (ByVal hGraphics As Long) As Long\r\nPrivate Declare Sub GdiplusShutdown Lib &quot;gdiplus&quot; (ByVal Token As Long)\r\nPrivate Declare Sub CopyMemory Lib &quot;kernel32&quot; Alias &quot;RtlMoveMemory&quot; (Destination As Any, Source As Any, ByVal Length As Long)\r\nPrivate Declare Function GetDeviceCaps Lib &quot;gdi32&quot; (ByVal Hdc As Long, ByVal nIndex As Long) As Long\r\nPrivate Declare Function MulDiv Lib &quot;kernel32.dll&quot; (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long\r\n \r\nPrivate Type GdiplusStartupInput\r\n    GdiplusVersion           As Long\r\n    DebugEventCallback       As Long\r\n    SuppressBackgroundThread As Long\r\n    SuppressExternalCodecs   As Long\r\nEnd Type\r\n \r\nPrivate Type RECTF\r\n    Left    As Single\r\n    Top     As Single\r\n    Width   As Single\r\n    Height  As Single\r\nEnd Type\r\n \r\nPublic Enum GDIPLUS_FONTSTYLE\r\n    FontStyleRegular = 0\r\n    FontStyleBold = 1\r\n    FontStyleItalic = 2\r\n    FontStyleBoldItalic = 3\r\n    FontStyleUnderline = 4\r\n    FontStyleStrikeout = 8\r\nEnd Enum\r\n \r\nPublic Enum StringAlignment\r\n    StringAlignmentNear = &amp;H0\r\n    StringAlignmentCenter = &amp;H1\r\n    StringAlignmentFar = &amp;H2\r\nEnd Enum\r\n \r\nPublic Enum StringTrimming\r\n    StringTrimmingNone = &amp;H0\r\n    StringTrimmingCharacter = &amp;H1\r\n    StringTrimmingWord = &amp;H2\r\n    StringTrimmingEllipsisCharacter = &amp;H3\r\n    StringTrimmingEllipsisWord = &amp;H4\r\n    StringTrimmingEllipsisPath = &amp;H5\r\nEnd Enum\r\n \r\nPublic Enum StringFormatFlags\r\n    StringFormatFlagsNone = &amp;H0\r\n    StringFormatFlagsDirectionRightToLeft = &amp;H1\r\n    StringFormatFlagsDirectionVertical = &amp;H2\r\n    StringFormatFlagsNoFitBlackBox = &amp;H4\r\n    StringFormatFlagsDisplayFormatControl = &amp;H20\r\n    StringFormatFlagsNoFontFallback = &amp;H400\r\n    StringFormatFlagsMeasureTrailingSpaces = &amp;H800\r\n    StringFormatFlagsNoWrap = &amp;H1000\r\n    StringFormatFlagsLineLimit = &amp;H2000\r\n    StringFormatFlagsNoClip = &amp;H4000\r\nEnd Enum\r\n \r\nPrivate Const LOGPIXELSY         As Long = 90\r\n \r\nPrivate m_Font                  As StdFont\r\nPrivate m_Color                 As OLE_COLOR\r\nPrivate m_Alignment             As StringAlignment\r\nPrivate m_VerticalAlignment     As StringAlignment\r\nPrivate m_FormatFlags           As StringFormatFlags\r\nPrivate m_Trimming              As StringTrimming\r\nPrivate m_Opacity               As Long\r\n \r\nPrivate Sub Class_Initialize()\r\n    Set m_Font = New StdFont\r\n    m_Font.name = &quot;Tahoma&quot;\r\n    m_Color = vbWindowText\r\n    m_Opacity = 100\r\nEnd Sub\r\n \r\nPrivate Sub Class_Terminate()\r\n    Set m_Font = Nothing\r\nEnd Sub\r\n \r\nPublic Property Get Font() As StdFont\r\n    Set Font = m_Font\r\nEnd Property\r\n \r\nPublic Property Let Font(ByVal NewFont As StdFont)\r\n    Set m_Font = NewFont\r\nEnd Property\r\n \r\nPublic Property Get Color() As OLE_COLOR\r\n    Color = m_Color\r\nEnd Property\r\n \r\nPublic Property Let Color(ByVal NewColor As OLE_COLOR)\r\n    m_Color = NewColor\r\nEnd Property\r\n \r\nPublic Property Get Alignment() As StringAlignment\r\n    Alignment = m_Alignment\r\nEnd Property\r\n \r\nPublic Property Let Alignment(ByVal NewAlignment As StringAlignment)\r\n    m_Alignment = NewAlignment\r\nEnd Property\r\n \r\nPublic Property Get VerticalAlignment() As StringAlignment\r\n    VerticalAlignment = m_VerticalAlignment\r\nEnd Property\r\n \r\nPublic Property Let VerticalAlignment(ByVal NewVerticalAlignment As StringAlignment)\r\n    m_VerticalAlignment = NewVerticalAlignment\r\nEnd Property\r\n \r\nPublic Property Get FormatFlags() As StringFormatFlags\r\n    FormatFlags = m_FormatFlags\r\nEnd Property\r\n \r\nPublic Property Let FormatFlags(ByVal NewFormatFlags As StringFormatFlags)\r\n    m_FormatFlags = NewFormatFlags\r\nEnd Property\r\n \r\nPublic Property Get Trimming() As StringTrimming\r\n    Trimming = m_Trimming\r\nEnd Property\r\n \r\nPublic Property Let Trimming(ByVal NewTrimming As StringTrimming)\r\n    m_Trimming = NewTrimming\r\nEnd Property\r\n \r\nPublic Property Get Opacity() As Long\r\n    Opacity = m_Opacity\r\nEnd Property\r\n \r\nPublic Property Let Opacity(ByVal NewOpacity As Long) \r\n    m_Opacity = NewOpacity \r\n    If m_Opacity &lt; 0 Then\r\n        Opacity = 0\r\n    ElseIf m_Opacity &gt; 100 Then\r\n        m_Opacity = 100\r\n    End If \r\nEnd Property\r\n  \r\nPublic Function DrawString(ByVal Hdc As Long, _\r\n                        ByVal Text As String, _\r\n                        ByVal X As Single, _\r\n                        ByVal Y As Single, _\r\n                        Optional ByVal Width As Single, _\r\n                        Optional ByVal Height As Single) As Boolean\r\n \r\n    On Error Resume Next\r\n \r\n    Dim hGraphic As Long\r\n    Dim lBrush As Long\r\n    Dim lFontFamily As Long\r\n    Dim lCurrentFont As Long\r\n    Dim lFontSize As Long\r\n    Dim lFontStyle As GDIPLUS_FONTSTYLE\r\n    Dim lFormat As Long\r\n    Dim RctText As RECTF\r\n    Dim GdiToken As Long\r\n    Dim GDIsi As GdiplusStartupInput\r\n \r\n    GDIsi.GdiplusVersion = 1&amp;\r\n \r\n    If GdiplusStartup(GdiToken, GDIsi) = 0 Then \r\n        Call GdipCreateFromHDC(Hdc, hGraphic) \r\n        GdipCreateSolidFill ConvertColor(m_Color, m_Opacity), lBrush \r\n        GdipCreateFontFamilyFromName StrConv(m_Font.name, vbUnicode), 0, lFontFamily\r\n \r\n        If m_Font.Bold Then lFontStyle = lFontStyle Or FontStyleBold\r\n        If m_Font.Italic Then lFontStyle = lFontStyle Or FontStyleItalic\r\n        If m_Font.Strikethrough Then lFontStyle = lFontStyle Or FontStyleStrikeout\r\n        If m_Font.Underline Then lFontStyle = lFontStyle Or FontStyleUnderline\r\n \r\n        lFontSize = MulDiv(m_Font.Size, GetDeviceCaps(Hdc, LOGPIXELSY), 72) \r\n        GdipCreateFont lFontFamily, lFontSize, lFontStyle, 0, lCurrentFont\r\n \r\n        If GdipCreateStringFormat(0, 0, lFormat) = 0 Then\r\n            If m_FormatFlags Then GdipSetStringFormatFlags lFormat, m_FormatFlags\r\n            If m_Alignment Then GdipSetStringFormatAlign lFormat, m_Alignment\r\n            If m_Trimming Then GdipSetStringFormatTrimming lFormat, m_Trimming\r\n            If m_VerticalAlignment Then GdipSetStringFormatLineAlign lFormat, m_VerticalAlignment\r\n        End If\r\n \r\n        With RctText\r\n            .Left = X\r\n            .Top = Y\r\n            .Width = Width\r\n            .Height = Height\r\n        End With\r\n \r\n        DrawString = GdipDrawString(hGraphic, StrConv(Text, vbUnicode), -1, lCurrentFont, RctText, lFormat, lBrush) = 0\r\n \r\n        GdipDeleteStringFormat lFormat\r\n        GdipDeleteFont lCurrentFont\r\n        GdipDeleteFontFamily lFontFamily\r\n        GdipDeleteBrush lBrush\r\n        GdipDeleteGraphics hGraphic\r\n        GdiplusShutdown GdiToken\r\n    End If\r\nEnd Function\r\n  \r\nPrivate Function ConvertColor(Color As Long, Opacity As Long) As Long\r\n    Dim BGRA(0 To 3) As Byte\r\n \r\n    BGRA(3) = CByte((Abs(Opacity) \/ 100) * 255)\r\n    BGRA(0) = ((Color \\ &amp;H10000) And &amp;HFF)\r\n    BGRA(1) = ((Color \\ &amp;H100) And &amp;HFF)\r\n    BGRA(2) = (Color And &amp;HFF)\r\n    CopyMemory ConvertColor, BGRA(0), 4&amp;\r\nEnd Function\r\n\r\n<\/pre>\n<p align=\"center\"><a href=\"https:\/\/leandroascierto.com\/blog\/descarga.php?url=GdipDrawString.zip\"><img loading=\"lazy\" decoding=\"async\" class=\"aligncenter\" title=\"Descargar\" src=\"https:\/\/leandroascierto.com\/blog\/descarga.php?file=GdipDrawString.zip\" alt=\"\" width=\"280\" height=\"61\" \/><\/a><\/p>\n","protected":false},"excerpt":{"rendered":"<p>Modulo Clase para dibujar texto utilizando GDI+ tiene funciones b\u00e1sicas como poder asignar la fuente, color, alineaci\u00f3n, alineaci\u00f3n vertical, Flags del formato, Trimming, Opacity. Para los que ya utilizaron alguna vez el api DrawText de \u00abUser32\u00bb no les resultara muy dif\u00edcil de implementar. Option Explicit &#8216;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8211; &#8216;Autor: Leandro Ascierto &#8216;Web: www.leandroascierto.com.ar &#8216;Date: 27\/12\/2009 &#8216;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8212;&#8211; Private <a href='https:\/\/leandroascierto.com\/blog\/clsdrawstring-cls-modulo-para-dibujar-texto-utilizando-gdi\/' class='excerpt-more'>[&#8230;]<\/a><\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[29],"tags":[60,35],"class_list":["post-470","post","type-post","status-publish","format-standard","hentry","category-modulos","tag-gdi-plus","tag-gdi","category-29-id","post-seq-1","post-parity-odd","meta-position-corners","fix"],"_links":{"self":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/470","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/comments?post=470"}],"version-history":[{"count":2,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/470\/revisions"}],"predecessor-version":[{"id":497,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/posts\/470\/revisions\/497"}],"wp:attachment":[{"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/media?parent=470"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/categories?post=470"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/leandroascierto.com\/blog\/wp-json\/wp\/v2\/tags?post=470"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}